Post by Walt Decker on Jan 6, 2021 14:52:35 GMT -5
The following demo is one use of scroll bars.
I wanted to make FN.Scroll.CB() a callback function. Unfortunately a callback will not allow other events to occur so I had to change it to a regular function. This slows the response quite a bit, but it works.
I chose to use a static control for the display because I am more familiar with that than I am with LB's graphic control. Therefore, if you resize the window the static control will revert to the system color.
SCROLL_BARS.ZIP contains the below code excluding the comments plus the dlls you will need to run it.
PS: If there are questions, please ask.
SCROLL_BARS.ZIP (33.47 KB)
NOMAINWIN
SB.HORZ = 0
SB.VERT = 1
SB.CTL = 2
SB.BOTH = 3
SS.CENTER = HEXDEC("&H00000001")
SS.CENTERIMAGE = HEXDEC("&H00000200")
SS.SUNKEN = HEXDEC("&H00001000")
BLACK.BRUSH = 4
GLOBAL RedHndl, GrnHndl, BluHndl, StatHndl
OPEN "User32" FOR DLL AS #USER
OPEN "gdi32" FOR DLL AS #GDI
OPEN "NUMBERMANDLL" FOR DLL AS #NUM
OPEN "SCROLLWIDG" FOR DLL AS #SCRL
STRUCT tRect, _
X AS LONG, _
Y AS LONG, _
X1 AS LONG, _
Y1 AS LONG
STRUCT tScrl, ScrlHndl AS ULONG
UpperLeftX = 300
UpperRightX = 200
WindowWidth = 300
WindowHdight = 300
STYLEBITS #WIN.STAT, SS.CENTER OR SS.CENTERIMAGE OR SS.SUNKEN, 0, 0, 0
STATICTEXT #WIN.STAT, "", 10, 2, 200, 150
OPEN "SCROLL TEST" FOR WINDOW AS #WIN
PRINT #WIN, "RESIZEHANDLER SIZEIT"
PRINT #WIN, "TRAPCLOSE STOPIT"
StatHndl = HWND(#WIN.STAT)
StatDC = 0
StatObj = 0
Kolr = HEXDEC("&H2222B2")
WinHndl = HWND(#WIN)
CALLDLL #SCRL, "FN_MakeBar", WinHndl AS ULONG, _ '<--- Parent window handle
tScrl AS STRUCT, _ '<--- Return: Handle of scroll bar
CodePtr AS ULONG, _ '<--- Reserved: always zero
10 AS LONG, _ '<--- X Position on parent window
160 AS LONG, _ '<--- Y Position on parent window
260 AS LONG, _ '<--- Length of scroll bar
15 AS LONG, _ '<--- Width of scrollbar
SB.HORZ AS LONG, _ '<--- SB.HORZ OR SB.VERT
259 AS LONG, _ '<--- Range withing scroll bar
4 AS LONG, _ '<--- Value when clicking in
_ 'the scroll bar
2 AS LONG, _ '<--- Value when clicking on a
_ 'scroll bar arrow
Kolr AS ULONG, _ '<--- Color of scroll bar
RetVal AS VOID '<--- Return: None
'/===================================================================================/'
' NOTES!!!
'/===================================================================================/'
' SB.HORZ = HORIZONTAL SCROLLBAR
' SB.VERT = VERTICAL SCROLLBAR
'
' WHEN CREATING A VERTICAL SCROLLBAR SWAP THE WIDTH AND HEIGHT VALUES, I. E. MAKE
' THE WIDTH SMALLER THAN THE HEIGHT
'/===================================================================================/'
RedHndl = tScrl.ScrlHndl.struct
Kolr = HEXDEC("&H006400")
CALLDLL #SCRL, "FN_MakeBar", WinHndl AS ULONG, tScrl AS STRUCT, _
CodePtr AS ULONG, 10 AS LONG, 180 AS LONG, 260 AS LONG, 15 AS LONG, _
SB.HORZ AS LONG, 259 AS LONG, 4 AS LONG, _
2 AS LONG, Kolr AS ULONG, RetVal AS VOID
GrnHndl = tScrl.ScrlHndl.struct
Kolr = HEXDEC("&H8B0000")
CALLDLL #SCRL, "FN_MakeBar", WinHndl AS ULONG, tScrl AS STRUCT, _
CodePtr AS ULONG, 10 AS LONG, 200 AS LONG, 260 AS LONG, 15 AS LONG, _
SB.HORZ AS LONG, 259 AS LONG, 4 AS LONG, _
2 AS LONG, Kolr AS ULONG, RetVal AS VOID
BluHndl = tScrl.ScrlHndl.struct
A = SetColor(0)
A = FN.Scroll.CB()
WAIT
'END
'-------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------
SUB STOPIT Hndl$
SC.CLOSE = HEXDEC("&HF060")
WM.SYSCOMMAND = HEXDEC("&H0112")
RetVal = 0
'PRINT "STOPIT"
CALLDLL #USER, "SendMessageA", RedHndl AS ULONG, WM.SYSCOMMAND AS ULONG, _
SC.CLOSE AS ULONG, 0 AS ULONG, RetVal AS VOID
CALLDLL #USER, "SendMessageA", GrnHndl AS ULONG, WM.SYSCOMMAND AS ULONG, _
SC.CLOSE AS ULONG, 0 AS ULONG, RetVal AS VOID
CALLDLL #USER, "SendMessageA", BluHndl AS ULONG, WM.SYSCOMMAND AS ULONG, _
SC.CLOSE AS ULONG, 0 AS ULONG, RetVal AS VOID
'PRINT "STOPIT 2"
CLOSE #USER
CLOSE #WIN
CLOSE #SCRL
CLOSE #GDI
CLOSE #NUM
END
END SUB
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
SUB SIZEIT Hndl$
WM.SIZE = 0005
RetVal = 0
END SUB
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
FUNCTION FN.Scroll.CB()
WIN.MESS = 1574
Colour = 0
RedVal = 0
GrnVal = 0
BluVal = 0
LstClr = 0
RetVal = 0
[SPIN]
CALLDLL #USER, "SendMessageA", RedHndl AS ULONG, WIN.MESS AS ULONG, 0 AS SHORT, _
0 AS SHORT, RedVal AS SHORT
CALLDLL #USER, "SendMessageA", RedHndl AS ULONG, WIN.MESS AS ULONG, 0 AS SHORT, _
0 AS SHORT, RedVal AS SHORT
CALLDLL #USER, "SendMessageA", GrnHndl AS ULONG, WIN.MESS AS ULONG, 0 AS SHORT, _
0 AS SHORT, GrnVal AS SHORT
CALLDLL #USER, "SendMessageA", BluHndl AS ULONG, WIN.MESS AS ULONG, 0 AS SHORT, _
0 AS SHORT, BluVal AS SHORT
CALLDLL #NUM, "FN_SetRGB", RedVal AS USHORT, GrnVal AS USHORT, _
BluVal AS USHORT, Colour AS ULONG
IF Colour = LstClr THEN
SCAN
GOTO [SPIN]
END IF
RetVal = SetColor(Colour)
LstClr = Colour
SCAN
GOTO [SPIN]
END FUNCTION
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
FUNCTION SetColor(Kolr)
StatObj = 0
StatDC = 0
BrsHndl = 0
CALLDLL #GDI, "CreateSolidBrush", Kolr AS ULONG, BrsHndl AS ULONG
CALLDLL #USER, "GetDC", StatHndl AS ULONG, StatDC AS ULONG
CALLDLL #USER, "GetClientRect", StatHndl AS ULONG, tRect AS STRUCT, RetVal AS VOID
CALLDLL #USER, "FillRect", StatDC AS ULONG, tRect AS STRUCT, _
BrsHndl AS ULONG, RetVal AS VOID
CALLDLL #GDI, "DeleteObject", BrsHndl AS ULONG, RetVal AS VOID
CALLDLL #USER, "ReleaseDC", StatHndl AS ULONG, StatDC AS ULONG, RetVal AS VOID
END FUNCTION
'[/div]
