Post by Walt Decker on Apr 25, 2021 15:59:35 GMT -5
The below zip file contains the listed source code, supporting bmp format files, and dlls required.
Normally I put all support stuff in a resource file and compile them right into the app. However, LB does not support resources so I would recommend putting the bmp files in a seperate directory and on startup copying them to the exe path directory. That way you are sure to have a fresh copy each time.
CUST_CURS.ZIP (52.29 KB)
'
[REFERENCE]
'<----------------------- WINDOW STYLES -------------------->
WS.OVERLAPPED = HEXDEC("&H00000000")
WS.CAPTION = HEXDEC("&H00C00000")
WS.CHILD = HEXDEC("&H40000000")
WS.VISIBLE = HEXDEC("&H10000000")
WS.CLIPSIBLINGS = HEXDEC("&H04000000")
WS.CLIPCHILDREN = HEXDEC("&H02000000")
WS.SYSMENU = HEXDEC("&H00080000")
WS.THICKFRAME = HEXDEC("&H00040000")
WS.GROUP = HEXDEC("&H00020000")
WS.TABSTOP = HEXDEC("&H00010000")
WS.BORDER = HEXDEC("&H00800000")
WS.MINIMIZEBOX = HEXDEC("&H00020000")
WS.MAXIMIZEBOX = HEXDEC("&H00010000")
WS.OVERLAPPEDWINDOW = (WS.OVERLAPPED _
OR WS.CAPTION _
OR WS.SYSMENU _
OR WS.THICKFRAME _
OR WS.MINIMIZEBOX _
OR WS.MAXIMIZEBOX)
WS.EX.TOPMOST = HEXDEC("&H00000008")
WS.EX.TOOLWINDOW = HEXDEC("&H00000080")
GCL.HCURSOR = -12
[GLOBALS]
GLOBAL LstBtn$ '<--- LAST BUTTON SELECTED
'<-------------------- CURSOR HANDLES ------------------->
GLOBAL CursHndl, _ '<--- New cursor
BaseHndl '<--- Creation handle
'<-------------------- BUTTONS SHADOWS ------------------->
GLOBAL Silver, _
Gray
'<---------------------- CONSTANTS ------------------------>
GLOBAL C.ARROW, _
C.PENCIL, _
C.BRUSH, _
C.ERASE, _
C.AIR, _
C.FILL, _
C.PICK, _
C.TEXT, _
C.SWAPD, _
C.SWAPF
DIM Tools$(0, 0) '<--- TOOL NAMES AND PROPERTIES
C.ARROW = 0
C.PENCIL = 1
C.BRUSH = 2
C.ERASE = 3
C.AIR = 4
C.FILL = 5
C.PICK = 6
C.TEXT = 7
C.SWAPD = 8
C.SWAPF = 9
CursHndl = 0
BaseHndl = 0
OPEN "User32" FOR DLL AS #USER
OPEN "DrwDll" FOR DLL AS #DRW
OPEN "NUMBERMANDLL" FOR DLL AS #NUM
UpperLeftX = 100
UpperLeftY = 100
WindowWidth = 400
WindowHeight = 400
OPEN "CUST CURS" FOR GRAPHICS AS #DMO
PRINT #DMO, "TRAPCLOSE DONE"
[GET.CLASS.CURSOR]
'/=======================================================================/'
' RETRIVE THE DEFAULT CURSOR FOR THE GRAPHIC WINDOW
'/=======================================================================/'
A = HWND(#DMO)
CALLDLL #USER, "GetClassLongA", A AS ULONG, GCL.HCURSOR AS LONG, _
BaseHndl AS ULONG
A = FN.CreateToolButtons()
UpperLeftX = 120
UpperLeftY = 100
WindowWidth = 32 * 2 + 5 * 3 + 6
WindowHeight = (32 * 5) + (5 * 10) + 10
STYLEBITS #TBOX, WS.CAPTION OR WS.VISIBLE OR WS.CLIPSIBLINGS OR WS.CLIPCHILDREN OR _
WS.SYSMENU, WS.OVERLAPPEDWINDOW, WS.EX.TOOLWINDOW OR WS.EX.TOPMOST, 0
OPEN "TOOLS" FOR WINDOW AS #TBOX
TbHndl = HWND(#TBOX)
PRINT #TBOX, "TRAPCLOSE DONE"
CALL SET.TOOL.BUTTONS
WAIT
END
'------------------------------------------------------------------
'------------------------------------------------------------------
SUB TOOL.BTN.CB BtnName$, Mx, My
'/=======================================================================/'
' THIS MODULE DETERMINES WHICH BUTTON WAS CLICKED
' FROM HERE YOU CAN JUMP TO A FUNCTION THAT PERFORMS THE INDICATED
' PROPERTY
'/=======================================================================/'
Btn$ = ""
GfxHndl = 0
Prop = 0
Index = 0
I = 0
Btn$ = BtnName$
I = INSTR(Btn$, ".")
Btn$ = LEFT$(Btn$, I - 1)
Prop = FN.ActivateBtn(Btn$, LstBtn$)
Index = VAL(Btn$)
I = FN.SelAction(Index, Prop, Btn$, CursHndl, BaseHndl)
END SUB
'------------------------------------------------------------------
'------------------------------------------------------------------
FUNCTION FN.ActivateBtn(Btn$, BYREF BtnLst$)
'/=======================================================================/'
' THIS FUNCTION UN-HILITES THE LAST BUTTON CLICKED AND HILITES THE
' CURRENT BUTTON CLICKED
'/=======================================================================/'
STRUCT tCli, _
X AS LONG, _
Y AS LONG, _
X1 AS LONG, _
Y1 AS LONG
X = 0
Y = 0
X1 = 0
Y1 = 0
RetVal = 0
BtnHndl = 0
BtnPrev = 0
BtnCur = 0
Prop = 0
DrawClr$ = ""
FillClr$ = ""
BmpName$ = ""
CtlName$ = ""
BtnPrev = VAL(BtnLst$)
BtnCur = VAL(Btn$)
Prop = VAL(Tools$(BtnCur, 3))
[SWAP.COLORS]
'/=======================================================================/'
' IF THE BUTTON IS A DRAW COLOR OR FILL COLOR BUTTON THEN SWAP 'EM
'/=======================================================================/'
SELECT CASE Prop
CASE C.SWAPF
DrawClr$ = Tools$(BtnCur - 1, 4)
FillClr$ = Tools$(BtnCur, 4)
LOADBMP "DRW", DrawClr$
LOADBMP "FILL", FillClr$
BMPSAVE "DRW", FillClr$
BMPSAVE "FILL", DrawClr$
UNLOADBMP "DRW"
UNLOADBMP "FILL"
CtlName$ = Tools$(BtnCur - 1, 0) + ".BTN"
LOADBMP "TOOL", Tools$(BtnCur - 1, 4)
PRINT #CtlName$, "place 0 0"
PRINT #CtlName$, "down"
PRINT #CtlName$, "drawbmp ";"TOOL ";0;" ";0
PRINT #CtlName$, "flush"
UNLOADBMP "TOOL"
CtlName$ = Tools$(BtnCur, 0) + ".BTN"
LOADBMP "TOOL", Tools$(BtnCur, 4)
PRINT #CtlName$, "place 0 0"
PRINT #CtlName$, "down"
PRINT #CtlName$, "drawbmp ";"TOOL ";0;" ";0
PRINT #CtlName$, "flush"
UNLOADBMP "TOOL"
FN.ActivateBtn = C.SWAPF
EXIT FUNCTION
CASE C.SWAPD
DrawClr$ = Tools$(BtnCur, 4)
FillClr$ = Tools$(BtnCur + 1, 4)
LOADBMP "DRW", DrawClr$
LOADBMP "FILL", FillClr$
BMPSAVE "DRW", FillClr$
BMPSAVE "FILL", DrawClr$
UNLOADBMP "DRW"
UNLOADBMP "FILL"
CtlName$ = Tools$(BtnCur, 0) + ".BTN"
LOADBMP "TOOL", Tools$(BtnCur, 4)
PRINT #CtlName$, "place 0 0"
PRINT #CtlName$, "down"
PRINT #CtlName$, "drawbmp ";"TOOL ";0;" ";0
PRINT #CtlName$, "flush"
UNLOADBMP "TOOL"
CtlName$ = Tools$(BtnCur + 1, 0) + ".BTN"
LOADBMP "TOOL", Tools$(BtnCur + 1, 4)
PRINT #CtlName$, "place 0 0"
PRINT #CtlName$, "down"
PRINT #CtlName$, "drawbmp ";"TOOL ";0;" ";0
PRINT #CtlName$, "flush"
UNLOADBMP "TOOL"
FN.ActivateBtn = C.SWAPD
EXIT FUNCTION
END SELECT
[UNCLICK.BTN]
'/=======================================================================/'
' UN-HILITE THE LAST BUTTON
'/=======================================================================/'
BtnHndl = VAL(Tools$(BtnPrev, 2))
CALLDLL #USER, "GetClientRect", BtnHndl AS ULONG, tCli AS STRUCT, RetVal AS VOID
X = tCli.X.struct
Y = tCli.Y.struct
X1 = tCli.X1.struct - 2
Y1 = tCli.Y1.struct - 2
CtlName$ = Tools$(BtnPrev, 0) + ".BTN"
BmpName$ = Tools$(BtnPrev, 4)
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X AS LONG, Y AS LONG, _
X1 AS LONG, Y AS LONG, 3 AS LONG, Silver AS ULONG, _
BmpName$ AS PTR, RetVal AS VOID
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X AS LONG, Y AS LONG, _
X AS LONG, Y1 AS LONG, 3 AS LONG, Silver AS ULONG, _
BmpName$ AS PTR, RetVal AS VOID
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X1 AS LONG, Y AS LONG, _
X1 AS LONG, Y1 AS LONG, 3 AS LONG, Gray AS ULONG, _
BmpName$ AS PTR, RetVal AS VOID
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X1 AS LONG, Y1 AS LONG, _
X AS LONG, Y1 AS LONG, 3 AS LONG, Gray AS ULONG, _
BmpName$ AS PTR, RetVal AS VOID
LOADBMP "TOOL", BmpName$
PRINT #CtlName$, "place 0 0"
PRINT #CtlName$, "down"
PRINT #CtlName$, "drawbmp ";"TOOL ";0;" ";0
PRINT #CtlName$, "flush"
[CLICK.BTN]
'/=======================================================================/'
' HILITE THE CURRENT BUTTON
'/=======================================================================/'
BtnHndl = VAL(Tools$(BtnCur, 2))
CtlName$ = Tools$(BtnCur, 0) + ".BTN"
BmpName$ = Tools$(BtnCur, 4)
CALLDLL #USER, "GetClientRect", BtnHndl AS ULONG, tCli AS STRUCT, RetVal AS VOID
X = tCli.X.struct
Y = tCli.Y.struct
X1 = tCli.X1.struct - 2
Y1 = tCli.Y1.struct - 2
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X AS LONG, Y AS LONG, _
X1 AS LONG, Y AS LONG, 3 AS LONG, Gray AS ULONG, _
BmpName$ AS PTR, RetVal AS VOID
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X AS LONG, Y AS LONG, _
X AS LONG, Y1 AS LONG, 3 AS LONG, Gray AS ULONG, _
BmpName$ AS PTR, RetVal AS VOID
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X1 AS LONG, Y AS LONG, _
X1 AS LONG, Y1 AS LONG, 3 AS LONG, Silver AS ULONG, _
BmpName$ AS PTR, RetVal AS VOID
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X1 AS LONG, Y1 AS LONG, _
X AS LONG, Y1 AS LONG, 3 AS LONG, Silver AS ULONG, _
BmpName$ AS PTR, RetVal AS VOID
LOADBMP "TOOL", BmpName$
PRINT #CtlName$, "place 0 0"
PRINT #CtlName$, "down"
PRINT #CtlName$, "drawbmp ";"TOOL ";0;" ";0
PRINT #CtlName$, "flush"
'/=======================================================================/'
'RETURN THE BUTTON PROPERTY VALUE
'/=======================================================================/'
BtnLst$ = Tools$(BtnCur, 0)
FN.ActivateBtn = VAL(Tools$(BtnCur, 3))
END FUNCTION
'------------------------------------------------------------------
'------------------------------------------------------------------
SUB DONE WinHndl$
IDC.ARROW = 32512
GCL.HCURSOR = -12
RetVal = 0
Hndl = 0
Tmp$ = ""
'/=======================================================================/'
' RELEASE THE CURSOR AND SET IT BACK TO THE DEFAULT CURSOR
'/=======================================================================/'
IF (CursHndl <> 0) OR (CursHndl <> BaseHndl) THEN
Hndl = HWND(#DMO)
CALLDLL #USER, "DestroyCursor", CursHndl AS ULONG, RetVal AS VOID
CALLDLL #USER, "LoadCursorA", 0 AS ULONG, IDC.ARROW AS ULONG, CursHndl AS ULONG
CALLDLL #USER, "SetClassLongA", Hndl AS ULONG, GCL.HCURSOR AS LONG, _
CursHndl AS ULONG, RetVal AS VOID
CursHndl = 0
BaseHndl = 0
END IF
'/=======================================================================/'
' UNLOAD THE BUTTONS
'/=======================================================================/'
FOR I = 0 TO 9
Tmp$ = Tools$(I, 0)
CLOSE #Tmp$
NEXT I
CLOSE #NUM
CLOSE #TBOX
CLOSE #USER
CLOSE #DRW
CLOSE #DMO
END
END SUB
'------------------------------------------------------------------
'------------------------------------------------------------------
FUNCTION FN.CreateToolButtons()
DS.CONTROL = HEXDEC("&H0400")
WS.CHILD = HEXDEC("&H40000000")
WS.VISIBLE = HEXDEC("&H10000000")
WS.CLIPSIBLINGS = HEXDEC("&H04000000")
STRUCT tCli, _
X AS LONG, _
Y AS LONG, _
X1 AS LONG, _
Y1 AS LONG
X = 0
Y = 0
X1 = 0
Y1 = 0
DIM BtnProps(9, 2)
DIM Tools$(9, 6)
'/=======================================================================/'
' SET THE BASE BITMAP, THE CURSOR BITMAP, AND THE
' HOT SPOT FOR EACH CURSOR
'/=======================================================================/'
BtnProps$(0, 0) = DefaultDir$ + "\arrow.bmp"
BtnProps$(1, 0) = DefaultDir$ + "\pencil.bmp"
BtnProps$(1, 1) = DefaultDir$ + "\pencur.bmp"
BtnProps$(1, 2) = "9 19"
BtnProps$(2, 0) = DefaultDir$ + "\brush.bmp"
BtnProps$(2, 1) = DefaultDir$ + "\brushcur.bmp"
BtnProps$(2, 2) = "16 23"
BtnProps$(3, 0) = DefaultDir$ + "\erase.bmp"
BtnProps$(3, 1) = DefaultDir$ + "\eracur.bmp"
BtnProps$(3, 2) = "9 17"
BtnProps$(4, 0) = DefaultDir$ + "\air.bmp"
BtnProps$(4, 1) = DefaultDir$ + "\aircur.bmp"
BtnProps$(4, 2) = "12 2"
BtnProps$(5, 0) = DefaultDir$ + "\fill.bmp"
BtnProps$(5, 1) = DefaultDir$ + "\fillcur.bmp"
BtnProps$(5, 2) = "3 21"
BtnProps$(6, 0) = DefaultDir$ + "\pickc.bmp"
BtnProps$(6, 1) = DefaultDir$ + "\pickcur.bmp"
BtnProps$(6, 2) = "8 23"
BtnProps$(7, 0) = DefaultDir$ + "\textbmp.bmp"
BtnProps$(7, 1) = DefaultDir$ + "\textcursor.bmp"
BtnProps$(7, 2) = "9 6"
BtnProps$(8, 0) = DefaultDir$ + "\foreclr.bmp"
BtnProps$(9, 0) = DefaultDir$ + "\backclr.bmp"
Gray = HEXDEC("&H808080")
Silver = HEXDEC("&HFFFFFF")
Style = WS.CHILD OR WS.VISIBLE OR DS.CONTROL OR WS.CLIPSIBLINGS
BtnTitle$ = "TOOL.BTN"
WinTitle$ = "TOOL"
Temp$ = ""
UpperLeftX = 5
UpperLeftY = 5
WindowWidth = 32
WindowHeight = 32
FOR I = 0 TO 07
GRAPHICBOX #TOOL.BTN, 0, 0, 32, 32
OPEN "" FOR WINDOW AS #TOOL
BtnHndl = HWND(#TOOL.BTN)
ToolHndl = HWND(#TOOL)
CALLDLL #USER, "SetWindowLongA", BtnHndl AS ULONG, _GWL_STYLE AS LONG, _
Style AS ULONG, RetVal AS VOID
CALLDLL #USER, "GetClientRect", BtnHndl AS ULONG, tCli AS STRUCT, RetVal AS VOID
X = tCli.X.struct
Y = tCli.Y.struct
X1 = tCli.X1.struct - 1
Y1 = tCli.Y1.struct - 1
'/=======================================================================/'
' THE FOLLOWIN FUNCTION INSURES THAT THE .BMP FILE IS IN THE PROPER
' LB FORMAT
'/=======================================================================/'
Temp$ = BtnProps$(I, 0)
CALLDLL #DRW, "drwLoadImage", BtnHndl AS ULONG, Temp$ AS PTR, _
0 AS LONG, 0 AS LONG, Temp$ AS PTR, RetVal AS VOID
'/=======================================================================/'
' FUNCTION drwRawLine() RENDERS A LINE ON A MEMORY BITMAP AND SAVE THE
' RESULT TO A TYPE BMP FILE.
' ARGUMENTS:
' BtnHndl = Handle of window
' X = Start position
' Y = Start position
' X1 = End position
' Y1 = End position
' Linesz = Width of line to render (here the width is 3)
' BmpName$ = Name of saved bmp type file (here the name is Temp$)
' RetVal = RETURN: None
'/=======================================================================/'
IF I = 0 THEN
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X AS LONG, Y AS LONG, _
X AS LONG, Y1 AS LONG, 3 AS LONG, Gray AS ULONG, _
Temp$ AS PTR, RetVal AS VOID
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X AS LONG, Y AS LONG, _
X1 AS LONG, Y AS LONG, 3 AS LONG, Gray AS ULONG, _
Temp$ AS PTR, RetVal AS VOID
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X1 AS LONG, Y AS LONG, _
X1 AS LONG, Y1 AS LONG, 3 AS LONG, Silver AS ULONG, _
Temp$ AS PTR, RetVal AS VOID
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X1 AS LONG, Y1 AS LONG, _
X AS LONG, Y1 AS LONG, 3 AS LONG, Silver AS ULONG, _
Temp$ AS PTR, RetVal AS VOID
ELSE
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X AS LONG, Y AS LONG, _
X AS LONG, Y1 AS LONG, 3 AS LONG, Silver AS ULONG, _
Temp$ AS PTR, RetVal AS VOID
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X AS LONG, Y AS LONG, _
X1 AS LONG, Y AS LONG, 3 AS LONG, Silver AS ULONG, _
Temp$ AS PTR, RetVal AS VOID
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X1 AS LONG, Y AS LONG, _
X1 AS LONG, Y1 AS LONG, 3 AS LONG, Gray AS ULONG, _
Temp$ AS PTR, RetVal AS VOID
CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, X1 AS LONG, Y1 AS LONG, _
X AS LONG, Y1 AS LONG, 3 AS LONG, Gray AS ULONG, _
Temp$ AS PTR, RetVal AS VOID
END IF
LOADBMP "TOOL", Temp$
PRINT #TOOL.BTN, "place 0, 0"
PRINT #TOOL.BTN, "down"
PRINT #TOOL.BTN, "drawbmp ";"TOOL ";0;" ";0
PRINT #TOOL.BTN, "flush"
UNLOADBMP "TOOL"
PRINT #TOOL.BTN, "when leftButtonDown TOOL.BTN.CB"
'/=======================================================================/'
' SAVE THE BITMAP AND CURSOR DATA
'/=======================================================================/'
Temp$ = TRIM$(STR$(I)) + WinTitle$
MAPHANDLE #TOOL, Temp$
Tools$(I, 0) = Temp$
Tools$(I, 1) = TRIM$(STR$(ToolHndl))
Tools$(I, 2) = TRIM$(STR$(BtnHndl))
Tools$(I, 4) = BtnProps$(I, 0)
Tools$(I, 5) = BtnProps$(I, 1)
Tools$(I, 6) = BtnProps$(I, 2)
CALLDLL #USER, "ShowWindow", ToolHndl AS ULONG, 0 AS LONG, RetVal AS VOID
NEXT I
GRAPHICBOX #TOOL.BTN, 0, 0, 30, 30
OPEN "" FOR WINDOW AS #TOOL
BtnHndl = HWND(#TOOL.BTN)
ToolHndl = HWND(#TOOL)
CALLDLL #USER, "SetWindowLongA", BtnHndl AS ULONG, _GWL_STYLE AS LONG, _
Style AS ULONG, RetVal AS VOID
Temp$ = BtnProps$(I, 0)
CALLDLL #DRW, "drwCreateFileBmp", 30 AS LONG, 30 AS LONG, _
Silver AS LONG, Temp$ AS PTR, RetVal AS VOID
LOADBMP "TOOL", Temp$
PRINT #TOOL.BTN, "place 0 0"
PRINT #TOOL.BTN, "drawbmp ";"TOOL ";0;" ";0
PRINT #TOOL.BTN, "flush"
UNLOADBMP "TOOL"
PRINT #TOOL.BTN, "when leftButtonDown TOOL.BTN.CB"
Temp$ = TRIM$(STR$(I)) + WinTitle$
MAPHANDLE #TOOL, Temp$
Tools$(I, 0) = Temp$
Tools$(I, 1) = TRIM$(STR$(ToolHndl))
Tools$(I, 2) = TRIM$(STR$(BtnHndl))
Tools$(I, 4) = BtnProps$(I, 0)
CALLDLL #USER, "ShowWindow", ToolHndl AS ULONG, 0 AS LONG, RetVal AS VOID
I = I + 1
GRAPHICBOX #TOOL.BTN, 0, 0, 30, 30
OPEN "" FOR WINDOW AS #TOOL
BtnHndl = HWND(#TOOL.BTN)
ToolHndl = HWND(#TOOL)
CALLDLL #USER, "SetWindowLongA", BtnHndl AS ULONG, _GWL_STYLE AS LONG, _
Style AS ULONG, RetVal AS VOID
Temp$ = BtnProps$(I, 0)
CALLDLL #DRW, "drwCreateFileBmp", 30 AS LONG, 30 AS LONG, _
Gray AS LONG, Temp$ AS PTR, RetVal AS VOID
LOADBMP "TOOL", Temp$
PRINT #TOOL.BTN, "place 0 0"
PRINT #TOOL.BTN, "drawbmp ";"TOOL ";0;" ";0
PRINT #TOOL.BTN, "flush"
UNLOADBMP "TOOL"
PRINT #TOOL.BTN, "when leftButtonDown TOOL.BTN.CB"
Temp$ = TRIM$(STR$(I)) + WinTitle$
MAPHANDLE #TOOL, Temp$
Tools$(I, 0) = Temp$
Tools$(I, 1) = TRIM$(STR$(ToolHndl))
Tools$(I, 2) = TRIM$(STR$(BtnHndl))
Tools$(I, 4) = BtnProps$(I, 0)
CALLDLL #USER, "ShowWindow", ToolHndl AS ULONG, 0 AS LONG, RetVal AS VOID
'/=======================================================================/'
' SET EACH TOOL BUTTON TO POINT TO ITS FUNCTION
'/=======================================================================/'
Tools$(0, 3) = STR$(C.ARROW)
Tools$(1, 3) = STR$(C.PENCIL)
Tools$(2, 3) = STR$(C.BRUSH)
Tools$(3, 3) = STR$(C.ERASE)
Tools$(4, 3) = STR$(C.AIR)
Tools$(5, 3) = STR$(C.FILL)
Tools$(6, 3) = STR$(C.PICK)
Tools$(7, 3) = STR$(C.TEXT)
Tools$(8, 3) = STR$(C.SWAPD)
Tools$(9, 3) = STR$(C.SWAPF)
REDIM BtnProps$(0, 0)
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB SET.TOOL.BUTTONS
'/=======================================================================/'
' THIS MODULE MAKES THE GRAPHIC CONTROLS A CHILD OF THE TOOL BOX
' WINDOW AND MOVES THEM TO THEIR PROPER POSITION
'/=======================================================================/'
WS.CHILD = HEXDEC("&H40000000")
WS.VISIBLE = HEXDEC("&H10000000")
WS.CLIPSIBLINGS = HEXDEC("&H04000000")
Parnt = HWND(#TBOX)
X = 5
Y = 5
Offs = 5
CtrlSz = 32
BtnHndl = 0
CtlName$ = ""
Style = WS.CHILD OR WS.VISIBLE OR WS.CLIPSIBLINGS
ToolCntr = -1
FOR I = 1 TO 5
FOR J = 1 TO 2
ToolCntr = ToolCntr + 1
Hndl = VAL(Tools$(ToolCntr, 1))
CALLDLL #USER, "SetParent", Hndl AS ULONG, Parnt AS ULONG, RetVal AS VOID
CALLDLL #USER, "SetWindowLongA", Hndl AS ULONG, _GWL_STYLE AS LONG, _
Style AS ULONG, RetVal AS VOID
CALLDLL #USER, "MoveWindow", Hndl AS ULONG, X AS LONG, Y AS LONG, _
CtrlSz AS LONG, CtrlSz AS LONG, 1 AS LONG, RetVal AS VOID
CALLDLL #USER, "ShowWindow", Hndl AS ULONG, 1 AS LONG, RetVal AS VOID
X = X + Offs + CtrlSz
NEXT J
X = Offs
Y = Y + CtrlSz + Offs
NEXT I
LstBtn$ = Tools$(0, 0)
END SUB
'-------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------
FUNCTION FN.SelAction(Index, Prop, Btn$, BYREF NewCursor, BaseCursor)
'/=======================================================================/'
' THIS FUNCTION DETEMINES WHAT THE BUTTON DOES AND ITS CORRESPONDING
' CURSOR SHAPE AND COLOR
' FROM HERE YOU CAN JUMP TO FUNCTION THAT PERFORM THE INDICATED PROPERTY
' OR DROP BACK TO TOOL.BTN.CB AND DETERMINE WHAT TO DO FROM THERE
'/=======================================================================/'
IDC.ARROW = 32512
GCL.HCURSOR = -12
Hndl = 0 '<--- handle of window to which the cursor belongs
RetVal = 0
HotX = 0 '<--- cursor hot spot
HotY = 0 '<--- cursor hot spot
Bmpsz = 32 '<--- size of cursor
BmpName$ = ""
Hndl = HWND(#DMO)
SELECT CASE Prop
CASE C.ARROW '<--- set the cursor to an arrow
IF (NewCursor = 0) OR (NewCursor = BaseCursor) THEN EXIT FUNCTION
CALLDLL #USER, "DestroyCursor", NewCursor AS ULONG, RetVal AS VOID
CALLDLL #USER, "LoadCursorA", 0 AS ULONG, IDC.ARROW AS ULONG, NewCursor AS ULONG
CALLDLL #USER, "SetClassLongA", Hndl AS ULONG, GCL.HCURSOR AS LONG, _
NewCursor AS ULONG, RetVal AS VOID
NewCursor = 0
CASE C.PENCIL '<--- set the cursor to a pencil
IF NewCursor THEN '<--- delete the current cursor
CALLDLL #USER, "DestroyCursor", NewCursor AS ULONG, RetVal AS VOID
END IF
BmpName$ = Tools$(Index, 5)
HotX = VAL(WORD$(Tools$(Index, 6), 1))
HotY = VAL(WORD$(Tools$(Index, 6), 2))
CALLDLL #DRW, "FN_CustomCursor", Bmpsz AS SHORT, HotX AS SHORT, HotY AS SHORT, _
BmpName$ AS PTR, NewCursor AS ULONG
'<---------------- SET THE DEFAULT CURSOR TO THE NEW CURSOR ----------->
CALLDLL #USER, "SetClassLongA", Hndl AS ULONG, GCL.HCURSOR AS LONG, _
NewCursor AS ULONG, RetVal AS VOID
CASE C.BRUSH '<--- set the cursor to a brush
IF NewCursor THEN
CALLDLL #USER, "DestroyCursor", NewCursor AS ULONG, RetVal AS VOID
END IF
BmpName$ = Tools$(Index, 5)
HotX = VAL(WORD$(Tools$(Index, 6), 1))
HotY = VAL(WORD$(Tools$(Index, 6), 2))
CALLDLL #DRW, "FN_CustomCursor", Bmpsz AS SHORT, HotX AS SHORT, HotY AS SHORT, _
BmpName$ AS PTR, NewCursor AS ULONG
CALLDLL #USER, "SetClassLongA", Hndl AS ULONG, GCL.HCURSOR AS LONG, _
NewCursor AS ULONG, RetVal AS VOID
CASE C.ERASE '<--- set the cursor to an erasor
IF NewCursor THEN
CALLDLL #USER, "DestroyCursor", NewCursor AS ULONG, RetVal AS VOID
END IF
BmpName$ = Tools$(Index, 5)
HotX = VAL(WORD$(Tools$(Index, 6), 1))
HotY = VAL(WORD$(Tools$(Index, 6), 2))
CALLDLL #DRW, "FN_CustomCursor", Bmpsz AS SHORT, HotX AS SHORT, HotY AS SHORT, _
BmpName$ AS PTR, NewCursor AS ULONG
CALLDLL #USER, "SetClassLongA", Hndl AS ULONG, GCL.HCURSOR AS LONG, _
NewCursor AS ULONG, RetVal AS VOID
CASE C.AIR '<--- set the cursor to a spray can
IF NewCursor THEN
CALLDLL #USER, "DestroyCursor", NewCursor AS ULONG, RetVal AS VOID
END IF
BmpName$ = Tools$(Index, 5)
HotX = VAL(WORD$(Tools$(Index, 6), 1))
HotY = VAL(WORD$(Tools$(Index, 6), 2))
CALLDLL #DRW, "FN_CustomCursor", Bmpsz AS SHORT, HotX AS SHORT, HotY AS SHORT, _
BmpName$ AS PTR, NewCursor AS ULONG
CALLDLL #USER, "SetClassLongA", Hndl AS ULONG, GCL.HCURSOR AS LONG, _
NewCursor AS ULONG, RetVal AS VOID
CASE C.FILL '<--- set the cursor to a bucket
IF NewCursor THEN
CALLDLL #USER, "DestroyCursor", NewCursor AS ULONG, RetVal AS VOID
END IF
BmpName$ = Tools$(Index, 5)
HotX = VAL(WORD$(Tools$(Index, 6), 1))
HotY = VAL(WORD$(Tools$(Index, 6), 2))
CALLDLL #DRW, "FN_CustomCursor", Bmpsz AS SHORT, HotX AS SHORT, HotY AS SHORT, _
BmpName$ AS PTR, NewCursor AS ULONG
CALLDLL #USER, "SetClassLongA", Hndl AS ULONG, GCL.HCURSOR AS LONG, _
NewCursor AS ULONG, RetVal AS VOID
CASE C.PICK '<--- set the cursor to an eye dropper
IF NewCursor THEN
CALLDLL #USER, "DestroyCursor", NewCursor AS ULONG, RetVal AS VOID
END IF
BmpName$ = Tools$(Index, 5)
HotX = VAL(WORD$(Tools$(Index, 6), 1))
HotY = VAL(WORD$(Tools$(Index, 6), 2))
CALLDLL #DRW, "FN_CustomCursor", Bmpsz AS SHORT, HotX AS SHORT, HotY AS SHORT, _
BmpName$ AS PTR, NewCursor AS ULONG
CALLDLL #USER, "SetClassLongA", Hndl AS ULONG, GCL.HCURSOR AS LONG, _
NewCursor AS ULONG, RetVal AS VOID
CASE C.TEXT '<--- set the cursor to a "T" symbol
IF NewCursor THEN
CALLDLL #USER, "DestroyCursor", NewCursor AS ULONG, RetVal AS VOID
END IF
BmpName$ = Tools$(Index, 5)
HotX = VAL(WORD$(Tools$(Index, 6), 1))
HotY = VAL(WORD$(Tools$(Index, 6), 2))
CALLDLL #DRW, "FN_CustomCursor", Bmpsz AS SHORT, HotX AS SHORT, HotY AS SHORT, _
BmpName$ AS PTR, NewCursor AS ULONG
CALLDLL #USER, "SetClassLongA", Hndl AS ULONG, GCL.HCURSOR AS LONG, _
NewCursor AS ULONG, RetVal AS VOID
CASE C.SWAPD OR C.DWAPF '<--- do nothing
END SELECT
END FUNCTION
'