Floating Tool box

[Walt Decker]

Thought I might try building a floating tool box.  Here's the result.  The dlls, .bmp files, and source code are contained in TOOLBOX.ZIP.

'
'======================================================================
'  This tool box uses graphic controls to act like buttons; however,
'  a tool box does not necessarily have to contain buttons only.
'  With a little thought it can contain whatever you want.
'=======================================================================

[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")

[GLOBALS]

GLOBAL LstBtn$  '<--- LAST BUTTON SELECTED

'<-------------------- BUTTONS SHADOWS ------------------->
GLOBAL Silver, _
        Gray

'<---------------------- CONSTANTS ------------------------>
GLOBAL  C.NOOP, _
       C.DRAW, _
      C.ERASE, _
      C.SPRAY, _
      C.FLOOD, _
       C.PICK, _
       C.TEXT, _
       C.SWAP

DIM Tools$(0, 0) '<--- TOOLS NAMES AND PROPERTIES

C.NOOP  = 0
C.DRAW  = 1
C.ERASE = 2
C.SPRAY = 3
C.FLOOD = 4
C.PICK  = 5
C.TEXT  = 6
C.SWAP  = 7

OPEN "User32" FOR DLL AS #USER
OPEN "Drwdll" FOR DLL AS #DRW
OPEN "NUMBERMANDLL" FOR DLL AS #NUM


A = FN.CreateToolButtons()

UpperLeftX = 120
UpperLeftY = 100
WindowWidth = 5 + 32 + 5 + 32 + 5
WindowHeight = (32 * 5) + (5 * 10) + 10

'====================================================================
'  To avoid the user from killing the toolbox you may want to
'  drop WS.SYSMENU and WS.EX.TOOLWINDOW
'====================================================================
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

Btn$ = ""
I    = 0
Prop = 0
Btn$ = BtnName$

I = INSTR(Btn$, ".")
Btn$ = LEFT$(Btn$, I - 1)

Prop = FN.ActivateBtn(Btn$, LstBtn$)

'================================================================
'  From here you can design routines to do whatever prop indicates
'================================================================
END SUB

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

FUNCTION FN.ActivateBtn(Btn$, BYREF BtnLst$)

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 Prop = C.SWAP THEN
 IF VAL(Tools$(BtnCur - 1, 3)) = C.SWAP THEN
   DrawClr$ = Tools$(BtnCur - 1, 4)
   FillClr$ = Tools$(BtnCur, 4)
   Tools$(BtnCur - 1, 4) = FillClr$
   Tools$(BtnCur, 4) = DrawClr$

   CtlName$ = Tools$(BtnCur - 1, 0) + ".BTN"
   LOADBMP "TOOLS", Tools$(BtnCur - 1, 4)
   PRINT #CtlName$, "place 0 0"
   PRINT #CtlName$, "down"
   PRINT #CtlName$, "drawbmp ";"TOOLS ";0;" ";0
   PRINT #CtlName$, "flush"
   PRINT #CtlName$, "getbmp ";"TOOL ";0;" ";0;" ";32;" ";32
   BMPSAVE "TOOL", Tools$(BtnCur - 1, 4)
   UNLOADBMP "TOOL"

   CtlName$ = Tools$(BtnCur, 0) + ".BTN"
   LOADBMP "TOOLS", Tools$(BtnCur, 4)
   PRINT #CtlName$, "place 0 0"
   PRINT #CtlName$, "down"
   PRINT #CtlName$, "drawbmp ";"TOOLS ";0;" ";0
   PRINT #CtlName$, "flush"
   PRINT #CtlName$, "getbmp ";"TOOL ";0;" ";0;" ";32;" ";32
   BMPSAVE "TOOL", Tools$(BtnCur, 4)
   UNLOADBMP "TOOL"

 ELSE
   DrawClr$ = Tools$(BtnCur, 4)
   FillClr$ = Tools$(BtnCur + 1, 4)
   Tools$(BtnCur, 4) = FillClr$
   Tools$(BtnCur + 1, 4) = DrawClr$

   CtlName$ = Tools$(BtnCur, 0) + ".BTN"
   LOADBMP "TOOLS", Tools$(BtnCur, 4)
   PRINT #CtlName$, "place 0 0"
   PRINT #CtlName$, "down"
   PRINT #CtlName$, "drawbmp ";"TOOLS ";0;" ";0
   PRINT #CtlName$, "flush"
   PRINT #CtlName$, "getbmp ";"TOOL ";0;" ";0;" ";32;" ";32
   BMPSAVE "TOOL", Tools$(BtnCur, 4)
   UNLOADBMP "TOOL"

   CtlName$ = Tools$(BtnCur + 1, 0) + ".BTN"
   LOADBMP "TOOLS", Tools$(BtnCur + 1, 4)
   PRINT #CtlName$, "place 0 0"
   PRINT #CtlName$, "down"
   PRINT #CtlName$, "drawbmp ";"TOOLS ";0;" ";0
   PRINT #CtlName$, "flush"
   PRINT #CtlName$, "getbmp ";"TOOL ";0;" ";0;" ";32;" ";32
   BMPSAVE "TOOL", Tools$(BtnCur + 1, 4)
   UNLOADBMP "TOOL"
 END IF
 FN.ActivateBtn = C.SWAP
 EXIT FUNCTION
END IF

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, 4 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, 4 AS LONG, Gray AS ULONG, _
             BmpName$ AS PTR, RetVal AS VOID

[UNCLICK.BTN]

LOADBMP "TOOL", BmpName$
PRINT #CtlName$, "place 0 0"
PRINT #CtlName$, "down"
PRINT #CtlName$, "drawbmp ";"TOOL ";0;" ";0
PRINT #CtlName$, "flush"

[CLICK.BTN]

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, 4 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, 4 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"

BtnLst$ = Tools$(BtnCur, 0)
FN.ActivateBtn = VAL(Tools$(BtnCur, 3))
END FUNCTION

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

SUB DONE WinHndl$

Tmp$ = ""
FOR I = 0 TO 9
 Tmp$ = Tools$(I, 0)
 CLOSE #Tmp$
NEXT I

CLOSE #NUM
CLOSE #TBOX
CLOSE #USER
CLOSE #DRW

END
END SUB

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

FUNCTION FN.CreateToolButtons()

DS.CONTROL          = HEXDEC("&H0400")
WS.CHILD          = HEXDEC("&H40000000")
WS.VISIBLE        = HEXDEC("&H10000000")
WS.CLIPSIBLINGS   = HEXDEC("&H04000000")

DIM BtnProps(9)
DIM Tools$(9, 4)
BtnProps$(0) = DefaultDir$ + "\arrow.bmp"
BtnProps$(1) = DefaultDir$ + "\pencil.bmp"
BtnProps$(2) = DefaultDir$ + "\brush.bmp"
BtnProps$(3) = DefaultDir$ + "\erase.bmp"
BtnProps$(4) = DefaultDir$ + "\air.bmp"
BtnProps$(5) = DefaultDir$ + "\fill.bmp"
BtnProps$(6) = DefaultDir$ + "\pickc.bmp"
BtnProps$(7) = DefaultDir$ + "\textbmp.bmp"
BtnProps$(8) = DefaultDir$ + "\foreclr.bmp"
BtnProps$(9) = 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

 Temp$ = BtnProps$(I)
 CALLDLL #DRW, "drwLoadImage", BtnHndl AS ULONG, Temp$ AS PTR, _
                0 AS LONG, 0 AS LONG, Temp$ AS PTR, RetVal AS VOID
 CALLDLL #DRW, "FN_drwGetBmpSize", Temp$ AS PTR, RetVal AS LONG
 CALLDLL #NUM, "FN_GetLowWord", RetVal AS LONG, BmpWide AS LONG
 CALLDLL #NUM, "FN_GetHiWord", RetVal AS LONG, BmpHigh AS LONG
 BmpWide = BmpWide - 1
 BmpHigh = BmpHigh - 1

 IF I = 0 THEN
   CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, 0 AS LONG, 0 AS LONG, _
                 0 AS LONG, BmpHigh AS LONG, 3 AS LONG, Gray AS ULONG, _
                 Temp$ AS PTR, RetVal AS VOID
   CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, 0 AS LONG, 0 AS LONG, _
                 BmpWide AS LONG, 0 AS LONG, 4 AS LONG, Gray AS ULONG, _
                 Temp$ AS PTR, RetVal AS VOID
   CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, BmpWide AS LONG, 0 AS LONG, _
                 BmpWide AS LONG, BmpHigh AS LONG, 3 AS LONG, Silver AS ULONG, _
                 Temp$ AS PTR, RetVal AS VOID
   CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, BmpWide AS LONG, BmpHigh AS LONG, _
                 0 AS LONG, BmpHigh AS LONG, 3 AS LONG, Silver AS ULONG, _
                 Temp$ AS PTR, RetVal AS VOID
 ELSE
   CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, 0 AS LONG, 0 AS LONG, _
                 0 AS LONG, BmpHigh AS LONG, 3 AS LONG, Silver AS ULONG, _
                 Temp$ AS PTR, RetVal AS VOID
   CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, 0 AS LONG, 0 AS LONG, _
                 BmpWide AS LONG, 0 AS LONG, 4 AS LONG, Silver AS ULONG, _
                 Temp$ AS PTR, RetVal AS VOID
   CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, BmpWide AS LONG, 0 AS LONG, _
                 BmpWide AS LONG, BmpHigh AS LONG, 3 AS LONG, Gray AS ULONG, _
                 Temp$ AS PTR, RetVal AS VOID
   CALLDLL #DRW, "drwRawLine", BtnHndl AS ULONG, BmpWide AS LONG, BmpHigh AS LONG, _
                 0 AS LONG, BmpHigh 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, "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)

 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)
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)
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)
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)
CALLDLL #USER, "ShowWindow", ToolHndl AS ULONG, 0 AS LONG, RetVal AS VOID

'===========================================================
'  Could use then User32 API "SetProp"() to set the graphic box properties
'  but this is just as easy
'===========================================================
Tools$(0, 3) = STR$(C.NOOP)  '<--- Button property used to govern action
Tools$(1, 3) = STR$(C.DRAW)
Tools$(2, 3) = STR$(C.DRAW)
Tools$(3, 3) = STR$(C.ERASE)
Tools$(4, 3) = STR$(C.SPRAY)
Tools$(5, 3) = STR$(C.FLOOD)
Tools$(6, 3) = STR$(C.PICK)
Tools$(7, 3) = STR$(C.TEXT)
Tools$(8, 3) = STR$(C.SWAP)
Tools$(9, 3) = STR$(C.SWAP)

REDIM BtnProps(0)

END FUNCTION

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

SUB SET.TOOL.BUTTONS

WS.CHILD          = HEXDEC("&H40000000")
WS.VISIBLE        = HEXDEC("&H10000000")
WS.CLIPSIBLINGS   = HEXDEC("&H04000000")

Parnt = HWND(#TBOX)
X = 5
Y = 5
Offs = 5
CtrlSz = 32

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
   X = X + OOffs + CtrlSz
   CALLDLL #USER, "ShowWindow", Hndl AS ULONG, 1 AS LONG, RetVal AS VOID
 NEXT J
 X = Offs
 Y = Y + CtrlSz + Offs
NEXT I

LstBtn$ = Tools$(0, 0)

END SUB
'
TOOLBOX.ZIP (48.38 KB)