CheckBox Buttons

[Walt Decker]

While looking through some of my old apps I found this little tidbit in my Civilization III clone directory from about 20 years ago.  The attached zip just has eight supporting bitmaps.

I wanted to use the LB instruction LOADBMP but a system error cropped up stating that 2786 was out of the collection range, so I switched to API.

Anyway, I hope someone can have a little fun with this.

CKB_IMAGES.ZIP (16.16 KB)

'
OPEN "User32.dll" FOR DLL AS #USER

MainHndl = 0
RetVal = 0

RetVal = FN.WINMAIN()

MainHndl = FN.GetHndl("#WINMAIN")
RetVal = FN.TOOLWIN(MainHndl)
WAIT

'---------------------------------------------
'---------------------------------------------

FUNCTION FN.WINMAIN()

Ux = 50
Uy = 50
Bx = 300
By = 500
Ux = FN.LbWinPos(Ux, Uy)
Bx = FN.LbWinSize(Bx, By)

OPEN "TEST" FOR WINDOW AS #WINMAIN
PRINT #WINMAIN, "TRAPCLOSE CLOSE.WINMAIN"
END FUNCTION

'-------------------------------------------
'-------------------------------------------

SUB CLOSE.WINMAIN MainHndl$

CLOSE #TOOLS
CLOSE #USER
CLOSE #MainHndl$

END

END SUB

'-------------------------------------------
'-------------------------------------------

SUB BTN.BMP BtnHndl$

END SUB

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.TOOLWIN(ParentHndl)

DATA "ARROW.BMP"
DATA "GRASSLND.BMP"
DATA "PLAINS.BMP"
DATA "DESERT.BMP"
DATA "TUNDRA.BMP"
DATA "COAST.BMP"
DATA "ICE.BMP"
DATA "OCEAN.BMP"

WS.POPUP          = HEXDEC("&H80000000")
WS.CHILD          = HEXDEC("&H40000000")
WS.MINIMIZE       = HEXDEC("&H20000000")
WS.VISIBLE        = HEXDEC("&H10000000")
WS.DISABLED       = HEXDEC("&H08000000")
WS.CLIPSIBLINGS   = HEXDEC("&H04000000")
WS.CLIPCHILDREN   = HEXDEC("&H02000000")
WS.MAXIMIZE       = HEXDEC("&H01000000")
WS.CAPTION        = HEXDEC("&H00C00000")
WS.BORDER         = HEXDEC("&H00800000")
WS.DLGFRAME       = HEXDEC("&H00400000")
WS.VSCROLL        = HEXDEC("&H00200000")
WS.HSCROLL        = HEXDEC("&H00100000")
WS.SYSMENU        = HEXDEC("&H00080000")
WS.MINIMIZEBOX  = HEXDEC("&H00020000")
WS.MAXIMIZEBOX  = HEXDEC("&H00010000")
WS.THICKFRAME   = HEXDEC("&H00040000")
DS.ABSALIGN     = HEXDEC("&H01")
WS.TABSTOP      = HEXDEC("&H00010000")

BS.CHECKBOX        = HEXDEC("&H00000002")
BS.BITMAP          = HEXDEC("&H00000080")
BS.NOTIFY          = HEXDEC("&H00004000")
BS.PUSHLIKE        = HEXDEC("&H00001000")

WS.EX.TOOLWINDOW      = HEXDEC("&H00000080")
WS.EX.CONTROLPARENT   = HEXDEC("&H00010000")
WS.EX.CLIENTEDGE      = HEXDEC("&H00000200")
WS.EX.DLGMODALFRAME   = HEXDEC("&H00000001")

TOOL.STYLE = WS.POPUP OR WS.CAPTION OR WS.CLIPCHILDREN OR WS.CLIPSIBLINGS OR _
            DS.ABSALIGN 'WS.SYSMENU OR

BTN.STYLE = WS.VISIBLE OR WS.CHILD OR BS.PUSHLIKE OR _
          WS.TABSTOP OR BS.NOTIFY OR BS.CHECKBOX OR BS.BITMAP

'GWL.STYLE         = -16
'GWL.EXSTYLE       = -20
'GWL.ID            = -12
'GWL.WNDPROC       = -4
'GWL.HINSTANCE     = -6
'GWL.HWNDPARENT    = -8

LR.DEFAULTCOLOR     = 00000000
LR.LOADFROMFILE     = HEXDEC("&H00000010")
LR.LOAD = LR.LOADFROMFILE OR LR.DEFABTN.BMPTCOLOR

IMAGE.BITMAP = 0
BM.SETIMAGE  = HEXDEC("&H00F7")

ToolHndl  = 0
ImageHndl = 0

Ux    = 0
Uy    = 0
Xwide = 0
Yhigh = 0
RetVal = 0
I = 0

Tmp$ = ""
StrIn$ = ""

STYLEBITS #TOOLS.CKB1, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0
STYLEBITS #TOOLS.CKB2, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0
STYLEBITS #TOOLS.CKB3, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0
STYLEBITS #TOOLS.CKB4, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0
STYLEBITS #TOOLS.CKB5, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0
STYLEBITS #TOOLS.CKB6, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0
STYLEBITS #TOOLS.CKB7, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0
STYLEBITS #TOOLS.CKB8, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0

CHECKBOX #TOOLS.CKB1, "1", BTN.BMP, BTN.BMP, 5, 5, 38, 38
CHECKBOX #TOOLS.CKB2, "2", BTN.BMP, BTN.BMP, 5, 46, 38, 38
CHECKBOX #TOOLS.CKB3, "3", BTN.BMP, BTN.BMP, 5, 87, 38, 38
CHECKBOX #TOOLS.CKB4, "4", BTN.BMP, BTN.BMP, 5, 128, 38, 38
CHECKBOX #TOOLS.CKB5, "5", BTN.BMP, BTN.BMP, 5, 169, 38, 38
CHECKBOX #TOOLS.CKB6, "6", BTN.BMP, BTN.BMP, 5, 210, 38, 38
CHECKBOX #TOOLS.CKB7, "7", BTN.BMP, BTN.BMP, 5, 251, 38, 38
CHECKBOX #TOOLS.CKB8, "8", BTN.BMP, BTN.BMP, 5, 292, 38, 38

RetVal = FN.ClientSize(ParentHndl, Xwide, Yhigh)
RetVal = FN.MapPoints(ParentHndl, 0, Ux, Uy, 0, 0)

RetVal = FN.LbWinPos(Ux, Uy)
RetVal = FN.LbWinSize(60, 38 * 8 + 30 + 9 * 3)

STYLEBITS #TOOLS, TOOL.STYLE, WS.SYSMENU, WS.EX.TOOLWINDOW OR _
                 WS.EX.CONTROLPARENT, 0

OPEN "TOOLS" FOR DIALOG AS #TOOLS
ToolHndl = FN.GetHndl("#TOOLS")

RetVal = FN.MoveWindow(ToolHndl, Ux, Uy, 60, 38 * 8 + 30 + 9 * 3)

FOR I = 1 TO 8
 Tmp$ = "#TOOLS.CKB" + STR$(I)
 ToolHndl = FN.GetHndl(Tmp$)
 READ StrIn$
 CALLDLL #USER, "LoadImageA", 0 AS LONG, StrIn$ AS PTR, IMAGE.BITMAP AS LONG, _
                0 AS LONG, 0 AS LONG, LR.LOAD AS ULONG, _
                ImageHndl AS ULONG

 CALLDLL #USER, "SendMessageA", ToolHndl AS ULONG, BM.SETIMAGE AS ULONG, _
                IMAGE.BITMAP AS ULONG, ImageHndl AS ULONG, RetVal AS VOID
NEXT I

PRINT #TOOLS.CKB1, "SETFOCUS"
PRINT #TOOLS.CKB1, "SET"
END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.LbWinPos(BTN.BMPx, BTN.BMPy)

UpperLeftX = Ux
UpperLeftY = Uy

END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.LbWinSize(Blx, Bly)

WindowWidth = Blx
WindowHeight = Bly

END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.CheckTag$(Tag$)

IF LEFT$(Tag$, 1) <> "#" THEN Tag$ = "#" + Tag$

FN.CheckTag$ = Tag$
END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.GetHndl(Hndl$)

ObjHndl = 0

Hndl$ = FN.CheckTag$(Hndl$)

ObjHndl = HWND(#Hndl$)

FN.GetHndl = ObjHndl
END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.ClientSize(Hndl, BYREF Bx, BYREF By)

STRUCT tRect, _
 Ux  AS LONG, _
 Uy  AS LONG, _
 Bx  AS LONG, _
 By  AS LONG

RetVal = 0
CALLDLL #USER, "GetClientRect", Hndl AS ULONG, tRect AS STRUCT, RetVal AS VOID
Bx = tRect.Bx.struct
By = tRect.By.struct

END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.MapPoints(PntFrom, PntTo, BYREF X, BYREF Y, BYREF X1, BYREF Y1)

STRUCT tRect, _
 Ux  AS LONG, _
 Uy  AS LONG, _
 Bx  AS LONG, _
 By  AS LONG

tRect.Ux.struct = X
tRect.Uy.struct = Y
tRect.Bx.struct = X1
tRect.By.struct = Y1

RetVal = 0
CALLDLL #USER, "MapWindowPoints", PntFrom AS ULONG, PntTo AS ULONG, _
              tRect AS STRUCT, 2 AS LONG, RetVal AS VOID

X = tRect.Ux.struct
Y = tRect.Uy.struct
X1 = tRect.Bx.struct
Y1 = tRect.By.struct

END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.MoveWindow(Hndl, Ulx, Uly, Xwide, Yhigh)

RetVal = 0
CALLDLL #USER, "MoveWindow", Hndl AS ULONG, Ulx AS LONG, Uly AS LONG, _
               Xwide AS LONG, Yhigh AS LONG, 1 AS LONG, RetVal AS VOID

END FUNCTION

'-------------------------------------------
'-------------------------------------------

'

[Rod]

the bmp files are not recognised by Liberty or Paint Shop Pro.

[Walt Decker]

Mar 28, 2023 11:28:23 GMT -5 Rod said:

the bmp files are not recognised by Liberty or Paint Shop Pro.

Well, what can I say.  They are recognized by MSPAINT and API function LoadImage().  Must be a glitch in LB and your copy of Paint Shop Pro.

[rnbw]

Runs fine for me (Windows 11)

[xxgeek]

I tried running this in LB Pro and all I get is the mainwin, a strip with 6 images named "tools", and an open empty window.

Left click, right click, no matter what I try, and no matter which window, nothing happens?

Did you forget something in the code?

[Walt Decker]

Mar 28, 2023 12:20:20 GMT -5 xxgeek said:

I tried running this in LB Pro and all I get is the mainwin, a strip with 6 images named "tools", and an open empty window.

Left click, right click, no matter what I try, and no matter which window, nothing happens?

Did you forget something in the code?

rnbw stated that it ran fine for him and it works as intended for me.  Only thing I can think of is that there is a huge difference in OS.  Perhaps you did not get all the code copied.

 

[xxgeek]

re-copied the code still same issue.
Running Windows 10 Pro 21H2 Version Build 19044.2728
Same results using LB 4.5.1 eval version.

I did get a Windows update a couple of days ago.
Maybe wait and see if it fixes itself in a few days.

[rnbw]

Mar 28, 2023 12:31:18 GMT -5 Walt Decker said:

Mar 28, 2023 12:20:20 GMT -5 xxgeek said:

I tried running this in LB Pro and all I get is the mainwin, a strip with 6 images named "tools", and an open empty window.

Left click, right click, no matter what I try, and no matter which window, nothing happens?

Did you forget something in the code?

rnbw stated that it ran fine for him and it works as intended for me.  Only thing I can think of is that there is a huge difference in OS.  Perhaps you did not get all the code copied.

 

Let me clarify my statement.   
I've not looked at the code, so I don't know exactly what is supposed to happen. 

I set up a folder and placed all the BMP files in it.   I copied the code and ran it without saving it.   What I got was a vertical column of buttons numbered 1 to 8 and nothing else.   This clearly wasn't correct,  so I saved the code into the same folder as the BMPs and ran it again.   This time the vertical column of buttons no longer contained numbers,  but instead the images of the BMPs were displayed on the buttons.   There was no further action when the buttons were pressed.   I don't know if there should be anything else. 

I hope this clarifies and my apologies to everyone if I caused any confusion. 

[tenochtitlanuk]

It 'works' for me on LB 4.51 under Linux/Wine. But very hard to see any difference on the selection of a button or moving selection click to a new one.

[Walt Decker]

First, it is not supposed to do anything other than show the tool box with the buttons.

Second, playing with it today I found that LB does not know how to handle a button with the BS_CHECKBOX | BS_BITMAP style. I am trying to work around that and will, hopefully, post updated code tomarrow. It will then "do something."

[Walt Decker]

I have made a number of changes. I have replaced the LB statement CHECKBOX with BUTTON. STYLEBITS changes the button to a checkbox. The reason is that with any button two event handlers is silly.

I tried to use REFRESH to redraw the selected button but that statment reduced the buttons to the size of the checkbox icon regardless of the stated size of the control.

LB does not recognize the API functions InvalidateRect() and UpdateWindow() so I had to move the controls, hence the FN.BtnClicked() function.

Anyway, it works.
'
GLOBAL LastId, _
        LoId

DIM BmpHndls(7)

CtlTag$ = ""

OPEN "User32.dll" FOR DLL AS #USER

MainHndl = 0
ToolHndl = 0

RetVal = 0

RetVal = FN.WINMAIN()

MainHndl = FN.GetHndl("#WINMAIN")
LoId = FN.TOOLWIN(MainHndl, LoId)
LastId = LoId
'RetVal = FN.FocusRect("#TOOLS.CKB1")
WAIT

'---------------------------------------------
'---------------------------------------------

SUB CLOSE.WINMAIN MainHndl$

CLOSE #TOOLS
CLOSE #USER
CLOSE #MainHndl$

END

END SUB

'-------------------------------------------
'-------------------------------------------

SUB BTN.BMP BtnHndl$

GWL.EXSTYLE       = -20
GWL.ID            = -12
WS.EX.CLIENTEDGE      = HEXDEC("&H00000200")
WS.EX.DLGMODALFRAME   = HEXDEC("&H00000001")

WS.EX.SELECTED = WS.EX.CLIENTEDGE OR WS.EX.DLGMODALFRAME
WS.EX.NOTSEL = WS.EX.DLGMODALFRAME

ToolHndl = 0
WinHndl  = 0

IdNo = 0

Ux = 0
Uy = 0
Bx = 0
By = 0

LstClick$ = ""
WinHndl = FN.GetHndl("#TOOLS")

ToolHndl = FN.GetHndl(BtnHndl$)
CALLDLL #USER, "GetDlgCtrlID", ToolHndl AS ULONG, IdNo AS LONG

IF IdNo = LastId THEN EXIT SUB

LstClick$ = LEFT$(BtnHndl$, LEN(BtnHndl$) - 1)
LstClick$ = LstClick$ + STR$(LastId MOD 100)

RetVal = FN.BtnClicked(LstClick$, WS.EX.NOTSEL)
RetVal = FN.BtnClicked(BtnHndl$, WS.EX.SELECTED)
LastId = IdNo

RetVal = FN.DrawGfx(IdNo)
END SUB

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.WINMAIN()

WS.BORDER         = HEXDEC("&H00800000")

GfxHndl = 0
RetVal  = 0

Ux = 50
Uy = 50
Bx = 400
By = 400
Ux = FN.LbWinPos(Ux, Uy)
Bx = FN.LbWinSize(Bx, By)

STYLEBITS #WINMAIN.GFX, 0, WS.BORDER, 0, 0
GRAPHICBOX #WINMAIN.GFX, 0, 0, 400, 400

OPEN "TEST" FOR WINDOW AS #WINMAIN
PRINT #WINMAIN, "TRAPCLOSE CLOSE.WINMAIN"

GfxHndl = FN.GetHndl("#WINMAIN")
RetVal = FN.ClientSize(GfxHndl, Bx, By)
GfxHndl = FN.GetHndl("#WINMAIN.GFX")
PRINT #WINMAIN.GFX, "LOCATE ";0;" ";0;" ";Bx;" ";By
PRINT #WINMAIN, "REFRESH"
PRINT #WINMAIN.GFX, "DOWN"
PRINT #WINMAIN.GFX, "FILL BLACK"
PRINT #WINMAIN.GFX, "FLUSH"
PRINT #WINMAIN.GFX, "DISCARD"

END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.TOOLWIN(ParentHndl, IdNo)

DATA "ARROW.BMP"
DATA "GRASSLND.BMP"
DATA "PLAINS.BMP"
DATA "DESERT.BMP"
DATA "TUNDRA.BMP"
DATA "COAST.BMP"
DATA "ICE.BMP"
DATA "OCEAN.BMP"

WS.POPUP          = HEXDEC("&H80000000")
WS.VISIBLE        = HEXDEC("&H10000000")
WS.CLIPSIBLINGS   = HEXDEC("&H04000000")
WS.CLIPCHILDREN   = HEXDEC("&H02000000")
WS.CAPTION        = HEXDEC("&H00C00000")
WS.SYSMENU        = HEXDEC("&H00080000")
DS.ABSALIGN     = HEXDEC("&H01")
WS.TABSTOP      = HEXDEC("&H00010000")

BS.AUTOCHECKBOX    = HEXDEC("&H00000003")
BS.CHECKBOX        = HEXDEC("&H00000002")
BS.BITMAP          = HEXDEC("&H00000080")
BS.NOTIFY          = HEXDEC("&H00004000")
BS.PUSHLIKE        = HEXDEC("&H00001000")

WS.EX.TOOLWINDOW      = HEXDEC("&H00000080")
WS.EX.TOPMOST         = HEXDEC("&H00000008")
WS.EX.CONTROLPARENT   = HEXDEC("&H00010000")
WS.EX.CLIENTEDGE      = HEXDEC("&H00000200")
WS.EX.DLGMODALFRAME   = HEXDEC("&H00000001")

TOOL.STYLE = WS.POPUP OR WS.CAPTION OR WS.CLIPCHILDREN OR WS.CLIPSIBLINGS OR _
            DS.ABSALIGN '<--- USE PIXELS TO PLACE LOCATION OF TOOL WINDOW

'<--- CHANGE BUTTON FROM BUTTON TO CHECKBOX BUTTON ---->
BTN.STYLE = WS.VISIBLE OR WS.CHILD OR BS.PUSHLIKE OR _
          WS.TABSTOP OR BS.NOTIFY OR BS.CHECKBOX OR BS.AUTOCHECKBOX OR BS.BITMAP

LR.DEFAULTCOLOR     = 00000000
LR.LOADFROMFILE     = HEXDEC("&H00000010")
LR.LOAD = LR.LOADFROMFILE OR LR.DEFAULTCOLOR

IMAGE.BITMAP = 0
BM.SETIMAGE  = HEXDEC("&H00F7")

ToolHndl  = 0
ImageHndl = 0

WinHndl = 0
'ToolDc = 0

Ux    = 0
Uy    = 0
Xwide = 0
Yhigh = 0
RetVal = 0
I = 0

Tmp$ = ""
StrIn$ = ""
              '<--- THIS CTRL AS START CTRL --->
STYLEBITS #TOOLS.CKB1, BTN.STYLE, 0, WS.EX.DLGMODALFRAME OR WS.EX.CLIENTEDGE, 0

STYLEBITS #TOOLS.CKB2, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0
STYLEBITS #TOOLS.CKB3, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0
STYLEBITS #TOOLS.CKB4, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0
STYLEBITS #TOOLS.CKB5, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0
STYLEBITS #TOOLS.CKB6, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0
STYLEBITS #TOOLS.CKB7, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0
STYLEBITS #TOOLS.CKB8, BTN.STYLE, 0, WS.EX.DLGMODALFRAME, 0

BUTTON #TOOLS.CKB1, "1", BTN.BMP, UL, 5, 5, 38, 38
BUTTON #TOOLS.CKB2, "2", BTN.BMP, UL, 5, 46, 38, 38
BUTTON #TOOLS.CKB3, "3", BTN.BMP, UL, 5, 87, 38, 38
BUTTON #TOOLS.CKB4, "4", BTN.BMP, UL, 5, 128, 38, 38
BUTTON #TOOLS.CKB5, "5", BTN.BMP, UL, 5, 169, 38, 38
BUTTON #TOOLS.CKB6, "6", BTN.BMP, UL, 5, 210, 38, 38
BUTTON #TOOLS.CKB7, "7", BTN.BMP, UL, 5, 251, 38, 38
BUTTON #TOOLS.CKB8, "8", BTN.BMP, UL, 5, 292, 38, 38

RetVal = FN.ClientSize(ParentHndl, Xwide, Yhigh)
RetVal = FN.MapPoints(ParentHndl, 0, Ux, Uy, 0, 0)

RetVal = FN.LbWinPos(Ux, Uy)
RetVal = FN.LbWinSize(60, 38 * 8 + 30 + 9 * 3)

STYLEBITS #TOOLS, TOOL.STYLE, WS.SYSMENU, WS.EX.TOOLWINDOW OR _
                 WS.EX.CONTROLPARENT OR WS.EX.TOPMOST, 0

OPEN "TOOLS" FOR DIALOG AS #TOOLS
WinHndl = FN.GetHndl("#TOOLS")

RetVal = FN.MoveWindow(WinHndl, Ux, Uy, 60, 38 * 8 + 30 + 9 * 3)

FOR I = 1 TO 8
 Tmp$ = "#TOOLS.CKB" + STR$(I)
 ToolHndl = FN.GetHndl(Tmp$)
 READ StrIn$
 CALLDLL #USER, "LoadImageA", 0 AS LONG, StrIn$ AS PTR, IMAGE.BITMAP AS LONG, _
                30 AS LONG, 30 AS LONG, LR.LOAD AS ULONG, _
                ImageHndl AS ULONG

'<--- SET BITMAP IMAGE FOR THE BUTTON --->
 CALLDLL #USER, "SendMessageA", ToolHndl AS ULONG, BM.SETIMAGE AS ULONG, _
                IMAGE.BITMAP AS ULONG, ImageHndl AS ULONG, RetVal AS VOID
NEXT I

ToolHndl = FN.GetHndl("TOOLS.CKB1")
CALLDLL #USER, "GetDlgCtrlID", ToolHndl AS ULONG, IdNo AS LONG
PRINT #TOOLS.CKB1, "SETFOCUS"
PRINT #TOOLS.CKB1, "SET"
FN.TOOLWIN = IdNo
END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.LbWinPos(Ux, Uy)

UpperLeftX = Ux
UpperLeftY = Uy

END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.LbWinSize(Blx, Bly)

WindowWidth = Blx
WindowHeight = Bly

END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.CheckTag$(Tag$)

IF LEFT$(Tag$, 1) <> "#" THEN Tag$ = "#" + Tag$

FN.CheckTag$ = Tag$
END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.GetHndl(Hndl$)

ObjHndl = 0

Hndl$ = FN.CheckTag$(Hndl$)

ObjHndl = HWND(#Hndl$)

FN.GetHndl = ObjHndl
END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.ClientSize(Hndl, BYREF Bx, BYREF By)

STRUCT tRect, _
 Ux  AS LONG, _
 Uy  AS LONG, _
 Bx  AS LONG, _
 By  AS LONG

RetVal = 0
CALLDLL #USER, "GetClientRect", Hndl AS ULONG, tRect AS STRUCT, RetVal AS VOID
Bx = tRect.Bx.struct
By = tRect.By.struct

END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.WindowSize(Hndl, BYREF Ulx, BYREF Uly, BYREF Bx, BYREF By)

STRUCT tRect, _
 Ux  AS LONG, _
 Uy  AS LONG, _
 Bx  AS LONG, _
 By  AS LONG

RetVal = 0
CALLDLL #USER, "GetWindowRect", Hndl AS ULONG, tRect AS STRUCT, RetVal AS VOID

Ulx = tRect.Ux.struct
Uly = tRect.Uy.struct
Bx = tRect.Bx.struct
By = tRect.By.struct

END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.MapPoints(PntFrom, PntTo, BYREF X, BYREF Y, BYREF X1, BYREF Y1)

STRUCT tRect, _
 Ux  AS LONG, _
 Uy  AS LONG, _
 Bx  AS LONG, _
 By  AS LONG

tRect.Ux.struct = X
tRect.Uy.struct = Y
tRect.Bx.struct = X1
tRect.By.struct = Y1

RetVal = 0
CALLDLL #USER, "MapWindowPoints", PntFrom AS ULONG, PntTo AS ULONG, _
              tRect AS STRUCT, 2 AS LONG, RetVal AS VOID

X = tRect.Ux.struct
Y = tRect.Uy.struct
X1 = tRect.Bx.struct
Y1 = tRect.By.struct

END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.MoveWindow(Hndl, Ulx, Uly, Xwide, Yhigh)

RetVal = 0
CALLDLL #USER, "MoveWindow", Hndl AS ULONG, Ulx AS LONG, Uly AS LONG, _
               Xwide AS LONG, Yhigh AS LONG, 1 AS LONG, RetVal AS VOID

END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.BtnClicked(Clicked$, BtnStyle)

GWL.EXSTYLE = -20

BtnHndl = 0
PntHndl = 0
RetVal  = 0

Ux = 0
Uy = 0
Bx = 0
By = 0

BtnHndl = FN.GetHndl(Clicked$)
RetVal = FN.WindowSize(BtnHndl, Ux, Uy, Bx, By)
CALLDLL #USER, "GetParent", BtnHndl AS ULONG, PntHndl AS ULONG
RetVal = FN.MapPoints(0, PntHndl, Ux, Uy, Bx, By)
Bx = Bx - Ux
By = By - Uy
CALLDLL #USER, "SetWindowLongA", BtnHndl AS ULONG, GWL.EXSTYLE AS LONG, _
               BtnStyle AS ULONG, RetVal AS LONG

'<-------- REDRAW THE BUTTON WITH ITS NEW STYLE ------>
RetVal = FN.MoveWindow(BtnHndl, Ux, Uy, Bx - 1, By - 1)
RetVal = FN.MoveWindow(BtnHndl, Ux, Uy, Bx , By)

END FUNCTION

'-------------------------------------------
'-------------------------------------------

FUNCTION FN.DrawGfx(BtnPushed)

GfxHndl = 0
RetVal  = 0

Ux = 0
Uy = 0
Bx = 0
By = 0

GfxHndl = FN.GetHndl("#WINMAIN.GFX")
RetVal = FN.ClientSize(GfxHndl, Bx, By)
RetVal = FN.MapPoints(GfxHndl, 0, Ux, Uy, Bx, By)
Ux = INT(Ux + (Bx - Ux) / 2)
Uy = INT(Uy + (By - Uy) / 2)

CALLDLL #USER, "SetCursorPos", Ux AS LONG, Uy AS LONG, RetVal AS VOID

CURSOR CrossHair

PRINT #WINMAIN.GFX, "when leftButtonDown [DO.SOMETHING]"

WAIT

 [DO.SOMETHING]

 [END.DOSOMETHING]
PRINT #WINMAIN.GFX, "when leftButtonDown"
CURSOR Arrow

END FUNCTION
'

[Brandon Parker]

Mar 29, 2023 11:51:13 GMT -5 Walt Decker said:

The reason is that with any button two event handlers is silly.

Well, you can use a single event handler if you would like to. All you have to do is check the status of the CheckBox after entering the event handler and take the necessary steps from there.

NoMainWin

WindowWidth = 180
WindowHeight = 160

Button #1, "&Ok", quit, UL, 120, 90, 40, 25
CheckBox #1.cb, "I am a checkbox", checkBoxEvent, checkBoxEvent, 10, 10, 130, 20
TextBox #1.text, 10, 90, 100, 24
Open "Checkbox Test" For Dialog As #1
#1 "TrapClose quit"
Wait


Sub checkBoxEvent handle$
   #handle$ "Value? result$"
   #1.text, "I am ";result$
End Sub


Sub quit handle$
 Close #handle$
 End
End Sub



{:0)

Brandon Parker