Post by Walt Decker on Sept 5, 2022 14:36:47 GMT -5
For those who want a status bar without resorting to the Win API the following will fit the bill. You can change the font using LB instructions but you can not change the background and text colors. However, you can do so by using the CTL_COLOR.DLL found HERE.
'
RetVal = 0
RetVal = FN.CreateWin()
RetVal = FN.CreateStatBar("#BAR")
WAIT
'----------------------------------------
'----------------------------------------
SUB RESIZE.BAR WinHndl$
Bx = 0 '<--- size of form window client area
By = 0
RetVal = 0
Barlx = 0 '<--- size of status bar
Barly = 0
Barx = 0
Bary = 0
RetVal = FN.ClientSize(WinHndl$, Bx, By) '<--- get client area
RetVal = FN.WindowSize("STAT", Barlx, Barly, Barx, Bary) '<--- size of status bar
Bary = Bary - Barly '<--- height of status bar
RetVal = FN.SetWindowPos("STAT", 0, By - Bary - 2, Bx, Bary) '<--- set status bar
'position
RetVal = FN.WindowSize("STAT", Barlx, Barly, Barx, Bary) '<--- new status bar
'position
RetVal = FN.MapPoints("", WinHndl$, Barlx, Barly, Barx, Bary) '<--- translate
'monitor coords to
'window coords
PRINT #BAR.GFX, "LOCATE 5 5 ";Bx - 10;" ";Barly - 10 '<--- resize gfx control
PRINT #BAR, "REFRESH"
END SUB
'----------------------------------------
'----------------------------------------
SUB BAR.END WinHndl$
CLOSE #STAT
CLOSE #WinHndl$
END
END SUB
'----------------------------------------
'----------------------------------------
SUB MOUSE.MOVE GfxHndl$, Mx, My
'<========== print status to status bar =====================>
PRINT #STAT.POSN, "X,Y: " + STR$(Mx)+ "," + STR$(My)
PRINT #STAT.COLR, "RGB: " + STR$(0) + "," + STR$(0) + "," + STR$(0)
END SUB
'----------------------------------------
'----------------------------------------
FUNCTION FN.SetWinPos(Ulx, Uly)
UpperLeftX = Ulx '<--- set form window position
UpperLeftY = Uly
END FUNCTION
'--------------------------------------
'--------------------------------------
FUNCTION FN.SetWinSize(Xwide, Yhigh)
WindowWidth = Xwide '<--- set form window size
WindowHeight = Yhigh
END FUNCTION
'--------------------------------------
'--------------------------------------
FUNCTION FN.WindowSize(WinTag$, BYREF Ux, BYREF Uy, BYREF Bx, BYREF By)
RetVal = 0
WinHndl = FN.GetHndl(WinTag$)
RetVal = FN.ZeroStructure(0, 0, 0, 0, 0, 0)
'<======= get overall size of window (form or control) ============>
CALLDLL #user32, "GetWindowRect", WinHndl AS ULONG, tRect AS STRUCT, _
RetVal AS VOID
Ux = tRect.X.struct
Uy = tRect.Y.struct
Bx = tRect.X1.struct
By = tRect.Y1.struct
END FUNCTION
FUNCTION FN.ClientSize(WinTag$, BYREF Bx, BYREF By)
RetVal = 0
WinHndl = FN.GetHndl(WinTag$)
RetVal = FN.ZeroStructure(0, 0, 0, 0, 0, 0)
'<========= get client size of window (form or control =============>
CALLDLL #user32, "GetClientRect", WinHndl AS ULONG, tRect AS STRUCT, _
RetVal AS VOID
Bx = tRect.X1.struct
By = tRect.Y1.struct
END FUNCTION
'---------------------------------------------
'---------------------------------------------
FUNCTION FN.CheckTag$(WinTag$)
IF LEFT$(WinTag$, 1) <> "#" THEN WinTag$ = "#" + WinTag$
FN.CheckTag$ = WinTag$
END FUNCTION
'---------------------------------------------
'---------------------------------------------
FUNCTION FN.GetHndl(WinTag$)
WinHndl = 0
WinTag$ = FN.CheckTag$(WinTag$)
WinHndl = HWND(#WinTag$)
FN.GetHndl= WinHndl
END FUNCTION
'---------------------------------------------
'---------------------------------------------
FUNCTION FN.MapPoints(Mfrom$, Mto$, BYREF Ux, BYREF Uy, BYREF Bx, BYREF By)
RetVal = 0
FromHndl = 0
ToHndl = 0
IF Mfrom$ <> "" THEN
FromHndl = FN.GetHndl(Mfrom$)
END IF
IF Mto$ <> "" THEN
ToHndl = FN.GetHndl(Mto$)
END IF
RetVal = FN.ZeroStructure(Ux, Uy, Bx, By, 0, 0)
'<======== translate coordinates from Mfrom$ to those of Mto$ ===========>
CALLDLL #user32, "MapWindowPoints", FromHndl AS ULONG, ToHndl AS ULONG, _
tRect AS STRUCT, 2 AS LONG, RetVal AS VOID
Ux = tRect.X.struct
Uy = tRect.Y.struct
Bx = tRect.X1.struct
By = tRect.Y1.struct
END FUNCTION
'------------------------------------------
'------------------------------------------
FUNCTION FN.ZeroStructure(r1, r2, r3, r4, p1, p2)
STRUCT tRect, _
X AS LONG, _
Y AS LONG, _
X1 AS LONG, _
Y1 AS LONG
STRUCT tPnt, _
X AS LONG, _
Y AS LONG
tRect.X.struct = r1
tRect.Y.struct = r2
tRect.X1.struct = r3
tRect.Y1.struct = r4
tPnt.X.struct = p1
tPnt.Y.struct = p2
END FUNCTION
'-------------------------------------
'-------------------------------------
FUNCTION FN.SetWindowPos(WinTag$, Ux, Uy, Xwide, Yhigh)
WinHndl = 0
RetVal = 0
WinHndl = FN.GetHndl(WinTag$)
'<========== move the window and/or resize it ===========================>
CALLDLL #user32, "MoveWindow", WinHndl AS ULONG, Ux AS LONG, Uy AS LONG, _
Xwide AS LONG, Yhigh AS LONG, 1 AS LONG, RetVal AS VOID
END FUNCTION
'--------------------------------------
'--------------------------------------
FUNCTION FN.CreateWin()
RetVal = 0
GRAPHICBOX #BAR.GFX, 5, 5, 300, 300
RetVal = FN.SetWinPos(1, 1)
RetVal = FN.SetWinSize(328, 375)
OPEN "STATUS BAR" FOR WINDOW AS #BAR
PRINT #BAR.GFX, "when mouseMove MOUSE.MOVE"
PRINT #BAR, "RESIZEHANDLER RESIZE.BAR"
PRINT #BAR, "TRAPCLOSE BAR.END"
END FUNCTION
'--------------------------------------
'--------------------------------------
FUNCTION FN.CreateStatBar(WinTag$)
WS.CHILD = HEXDEC("&H40000000") '<--- window styles
WS.VISIBLE = HEXDEC("&H10000000")
WS.CLIPCHILDREN = HEXDEC("&H02000000")
WS.SYSMENU = HEXDEC("&H00080000")
WS.THICKFRAME = HEXDEC("&H00040000")
SS.SUNKEN = HEXDEC("&H00001000") '<--- static control style
GWL.STYLE = -16
WinStyle = 0
WinHndl = 0
RetVal = 0
Bx = 0 '<--- client size
By = 0
Cx = 0 '<--- window size
Cy = 0
Uy = 0 '<--- upper left y of window
RetVal = FN.ClientSize(WinTag$, Bx, By) '<--- client size of #BAR
STYLEBITS #STAT.POSN, SS.SUNKEN, 0, 0, 0
STATICTEXT #STAT.POSN, "", 2, 2, 100, 20
STYLEBITS #STAT.COLR, SS.SUNKEN, 0, 0, 0
STATICTEXT #STAT.COLR, "", 108, 2, 100, 20
RetVal = FN.SetWinPos(10, 100)
RetVal = FN.SetWinSize(Bx, 30)
WinStyle = WS.CHILD OR WS.VISIBLE OR WS.CLIPCHILDREN
STYLEBITS #STAT, 0, WS.SYSMENU OR WS.THICKFRAME, 0, 0
OPEN "BAR" FOR WINDOW AS #STAT
WinHndl = FN.GetHndl(WinTag$)
StatHndl = HWND(#STAT)
'<========== change window parent from #STAT to #BAR =========================>
CALLDLL #user32, "SetParent", StatHndl AS ULONG, WinHndl AS ULONG, RetVal AS LONG
'<============= change the style to a child window =====================>
CALLDLL #user32, "SetWindowLongA", StatHndl AS ULONG, GWL.STYLE AS LONG, _
WinStyle AS LONG, RetVal AS VOID
RetVal = FN.WindowSize("STAT.POSN", 0, Uy, Cx, Cy) '<--- get size of window #STAT
Uy = Cy - Uy + 2 '<--- new size of #STAT
RetVal = FN.SetWindowPos("STAT", 0, By - Uy - 2, Bx, Uy) '<--- move #STAT and
'resize it
END FUNCTION
'