Tweet
I think I now have the absolute minimum required to place controls on a form, though until I've done the properties dialog (right-click menu) the form won't be much use. No code generation is included.
Still can't work out how to do the gripper overlay but it is not strictly necessary.
*afterthought* I have not made the controls snap to the grid after moving. ** done it - code changed **
Still can't work out how to do the gripper overlay but it is not strictly necessary.
*afterthought* I have not made the controls snap to the grid after moving. ** done it - code changed **
Code:
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Visual designer-in-waiting originally based upon Borje Hagsten's DrawRect sample
' of March 2003, hacked about by Chris Holbrook to provide a floating menu
' and moveable "controls", being dialogs each with a single control
' to represent the eventaul type style and placement of the control
' in the generated program.
' CJH 6-DEC-2007
'--------------------------------------------------------------------
#COMPILE EXE
#DIM ALL
#INCLUDE "commctrl.inc"
#INCLUDE "WIN32API.INC"
'--------------------------------------------------------------------
' timer related
%TIMEOUT = 50 ' timer delay for mouseover, etc
%TINSTANCE = 99 ' timer number
'--------------------------------------------------------------------
%IDC_CHK1 = 121
%IDC_CHK2 = 122
'--------------------------------------------------------------------
' popup CC menu ids
%IDM_POPUP1 = 150
%IDM_POPUP2 = 151
%IDM_POPUP3 = 152
'--------------------------------------------------------------------
%our_typecontrol_base = 500
%our_button_type = 1
%our_checkbox_type = 2
%our_label_type = 3
%our_textbox_type = 4
%our_listbox_type = 5
%our_listview_type = 6
'
%IDC_GRAPHIC = 700
' keep type identifier control declarations in a contiguous block
%IDC_CTL1 = %our_typecontrol_base + %our_button_type
%IDC_CTL2 = %our_typecontrol_base + %our_checkbox_type
%IDC_CTL3 = %our_typecontrol_base + %our_label_type
%IDC_CTL4 = %our_typecontrol_base + %our_textbox_type
%IDC_CTL5 = %our_typecontrol_base + %our_listbox_type
%IDC_CTL6 = %our_typecontrol_base + %our_listview_type
%idc_CCID = 550
%GRIDSIZEX = 10
%GRIDSIZEY = 10
'--------------------------------------------------------------------
DECLARE CALLBACK FUNCTION DlgProc() AS LONG
DECLARE FUNCTION MakeGridBrush (BYVAL hDlg AS DWORD) AS DWORD
DECLARE SUB selRectBegin (BYVAL hWnd AS DWORD)
DECLARE SUB selRectDraw (BYVAL hWnd AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, RC AS RECT)
DECLARE SUB selRectEnd (BYVAL hWnd AS DWORD, RC AS rect)
DECLARE FUNCTION FloatMenu_dialog(BYVAL hParent AS DWORD) AS LONG
'--------------------------------------------------------------------
TYPE CPH ' control place holder
hD AS DWORD ' dialog handle
cid AS LONG ' control identifier used in generated code
lType AS LONG ' numeric index to type being control id of type - %IDC_CTL1, q.v.
sText AS STRING * 40 ' text for this control
END TYPE
'--------------------------------------------------------------------
GLOBAL cGridX AS LONG, cGridY AS LONG, gShowGrid AS LONG, gSnapToGrid AS LONG
GLOBAL ghBit AS DWORD, ghBrush AS DWORD, gMemDC AS DWORD
GLOBAL gPt AS POINTAPI, gRc AS RECT
GLOBAL Hcontrols() AS CPH
GLOBAL CONTROLINDEX AS LONG
'GLOBAL ghMenuDialog AS DWORD ' handle for floating menu dialog
GLOBAL ghMenuDialog AS DWORD ' handle for floating menu dialog
GLOBAL ghCCDialog AS DWORD ' handle for current CCdialog
'global gHandCur as long ' handle for hand currsor
'-------------------------------------------------------------------
' common functions
'--------------------------------------------------------------------
SUB DummyListBox( hD AS DWORD, hC AS LONG, n AS LONG)
LOCAL i AS LONG
FOR i = 1 TO n
LISTBOX ADD hD, hC, USING$("Example Item #", i)
NEXT
END SUB
'---------------------------------------------------------------------
SUB SampleListView(BYVAL hDlg AS DWORD, BYVAL lID AS LONG, BYVAL lColCnt AS LONG, BYVAL lRowCnt AS LONG)
LOCAL lCol AS LONG
LOCAL lRow AS LONG
LOCAL hCtl AS DWORD
LOCAL tLVC AS LV_COLUMN
LOCAL tLVI AS LV_ITEM
LOCAL szBuf AS ASCIIZ * 32
LOCAL lStyle AS LONG
CONTROL HANDLE hDlg, lID TO hCtl
lStyle = ListView_GetExtendedListViewStyle(hCtl)
ListView_SetExtendedListViewStyle hCtl, lStyle OR %LVS_EX_FULLROWSELECT OR %LVS_EX_GRIDLINES
' Load column headers.
tLVC.mask = %LVCF_FMT OR %LVCF_TEXT OR %LVCF_SUBITEM
tLVC.fmt = %LVCFMT_LEFT
tLVC.pszText = VARPTR(szBuf)
FOR lCol = 0 TO lColCnt - 1
szBuf = USING$("Column #", lCol)
tLVC.iOrder = lCol
ListView_InsertColumn hCtl, lCol, tLVC
NEXT lCol
' Load sample data.
FOR lRow = 0 TO lRowCnt - 1
tLVI.stateMask = %LVIS_FOCUSED
tLVI.pszText = VARPTR(szBuf)
tLVI.iItem = lRow
FOR lCol = 0 TO lColCnt - 1
szBuf = USING$("Column # Row #", lCol, lRow)
tLVI.iSubItem = lCol
tLVI.lParam = lRow
IF lCol = 0 THEN
tLVI.mask = %LVIF_TEXT OR %LVIF_PARAM OR %LVIF_STATE
ListView_InsertItem hCtl, tLVI
ELSE
tLVI.mask = %LVIF_TEXT
ListView_SetItem hCtl, tLVI
END IF
NEXT lCol
NEXT lRow
' Auto size columns.
FOR lCol = 0 TO lColCnt - 2
ListView_SetColumnWidth hCtl, lCol, %LVSCW_AUTOSIZE
NEXT lCol
ListView_SetColumnWidth hCtl, lColCnt - 1, %LVSCW_AUTOSIZE_USEHEADER
END SUB
'----------------------------------------------------------------------
' return the index to the HCONTROLS table which has .hD = window handle supplied
FUNCTION CCIndexFromhW ( hW AS DWORD ) AS LONG
LOCAL l AS LONG
FOR l = 1 TO UBOUND(hControls)
IF hControls(l).hD = hW THEN
FUNCTION = l
EXIT FUNCTION
END IF
NEXT
END FUNCTION
'----------------------------------------------------------------------
SUB RemoveCCFRomTable ( hW AS DWORD )
LOCAL l AS LONG
l = CCIndexFromhW(hW)
hControls(l).hD = 0
END SUB
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main entrance
'--------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
LOCAL hDlg AS DWORD, lRes AS LONG
DIM Hcontrols(0) AS GLOBAL CPH
CONTROLINDEX = 2000
DIALOG NEW 0, "One day...",,, 400, 240, _
%WS_CAPTION OR %WS_CLIPCHILDREN OR %WS_SYSMENU OR %WS_THICKFRAME, 0 TO hDlg
SetTimer hDlg, %TINSTANCE, %TIMEOUT, %NULL
DIALOG SHOW MODAL hDlg CALL DlgProc
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main callback
'--------------------------------------------------------------------
CALLBACK FUNCTION DlgProc() AS LONG
LOCAL l, X, Y , W, H AS LONG
STATIC RC AS RECT
STATIC hPopup, menuchoice AS LONG
LOCAL p AS PointAPI
SELECT CASE CBMSG
CASE %WM_INITDIALOG
STATIC hCur AS DWORD ' for static grid brush handle
cGridX = %GRIDSIZEX ' horizontal grid size
cGridY = %GRIDSIZEY ' vertical grid size
gShowGrid = 1 ' show grid at start
gSnapToGrid = 1 ' snap drawing to grid at start
hCur = LoadCursor(0, BYVAL %IDC_CROSS) ' store handle of cursot to use at draw
ghBrush = MakeGridBrush(CBHNDL) ' and create grid brush
l = FloatMenu_Dialog(CBHNDL)
'ghandcur = LoadCursorFromFile("handgrab.cur")
CASE %WM_CTLCOLORDLG ' paint grid if gShowGrid is on..
IF gShowGrid AND ghBrush THEN FUNCTION = ghBrush
CASE %WM_DESTROY 'delete what we created on exit, to avoid mem leaks
IF ghBrush THEN DeleteObject ghBrush
IF ghBit THEN DeleteObject SelectObject(gMemDC, ghBit)
IF gMemDC THEN DeleteDC gMemDC 'should already be deleted, but to make sure..
killtimer CBHNDL, %TINSTANCE
CASE %WM_SETCURSOR
' If mouse button is pressed, over-ride default cursor and
' set "own", here cross cursor. Only shown during drawing the control.
' Note - in dialogs, we must return
' %TRUE to inform dialog engine we have taken charge. In SDK-style
' windows, we would have had to return zero and break out.
IF CBWPARAM = CBHNDL AND HIWRD(CBLPARAM) = %WM_LBUTTONDOWN THEN
IF GetCursor <> hCur THEN SetCursor hCur
FUNCTION = 1
END IF
CASE %WM_LBUTTONDOWN, %WM_LBUTTONDBLCLK 'start selrect draw
selRectBegin CBHNDL
CASE %WM_MOUSEMOVE
IF (CBWPARAM AND %MK_LBUTTON) THEN 'if mouse button is down while moved, draw rect
selRectDraw CBHNDL, LOWRD(CBLPARAM), HIWRD(CBLPARAM), RC
END IF
CASE %WM_MOUSEACTIVATE
LOCAL p_CrsInSCreen, p_ClientOffset AS POINTAPI
LOCAL hWndCtrl AS LONG
GetCursorPos( p_CrsInScreen )
ClientToScreen( CBHNDL, p_ClientOffset )
hWndCtrl = ChildWindowFromPoint( CBHNDL, p_CrsInScreen.X - p_ClientOffset.X, _
p_CrsInScreen.Y - p_ClientOffset.Y )
IF hWndCtrl = CBHNDL THEN ' ignore if cursor is not in a child window
FUNCTION = %MA_ACTIVATE ' deal with it elsewhere
EXIT FUNCTION
END IF
IF (hWndCtrl = ghMenuDialog) THEN
FUNCTION = %MA_NOACTIVATEANDEAT
EXIT FUNCTION
END IF
'
SELECT CASE HI(WORD, CBLPARAM) ' mouse message
CASE %WM_LBUTTONDOWN, %WM_LBUTTONDBLCLK
' If the cursor is in the client area of the CC dialog, then force drag.
' Otherwise, pass message through so dialog gets resived.
' NB control is resized to dialog dimensions on %WM_EXITSIZEMOVE
' in the callback for CCdialog.
IF LO(WORD,CBLPARAM) <> %HTCLIENT THEN
FUNCTION = %MA_ACTIVATE ' NO, let message through for resize
ELSE
'setcursor hCur
PostMessage hWndCtrl, %WM_NCLBUTTONDOWN, %HTCAPTION, 0 ' YES, FORCE DRAG
FUNCTION = %MA_NOACTIVATEANDEAT
EXIT FUNCTION
END IF
CASE %WM_RBUTTONDOWN, %WM_RBUTTONDBLCLK
hPopup& = CreatePopupMenu
FOR l = 1 TO PARSECOUNT(ENVIRON$(29))
CALL InsertMenu(hPopup&, 0, %MF_BYCOMMAND OR %MF_GRAYED, 1, "Properties")
CALL InsertMenu(hPopup&, 0, %MF_BYCOMMAND OR %MF_GRAYED, 2, "Cut")
CALL InsertMenu(hPopup&, 0, %MF_BYCOMMAND OR %MF_GRAYED, 3, "Copy")
CALL InsertMenu(hPopup&, 0, %MF_BYCOMMAND OR %MF_GRAYED, 4, "Paste")
CALL InsertMenu(hPopup&, 0, %MF_BYCOMMAND OR %MF_GRAYED, 5, "Select All")
CALL InsertMenu(hPopup&, 0, %MF_BYCOMMAND, 6, "Delete")
NEXT
CALL GetCursorPos(BYREF p)
MenuChoice = TrackPopupMenuEx(hPopup&, %MF_ENABLED OR %MF_BYCOMMAND OR %TPM_RETURNCMD, p.x, p.y, CBHNDL, BYVAL %NULL)
CALL DestroyMenu(hPopup)
SELECT CASE menuchoice
CASE 6
CONTROL KILL CBHNDL, %idc_CCID ' kill control
RemoveCCFromTable(hWndCtrl) ' remove from table
DIALOG END hwndCtrl, 0 ' kill dialog
END SELECT
FUNCTION = %MA_NOACTIVATEANDEAT ' that's all for right click
END SELECT
CASE %WM_LBUTTONUP 'mouse button released - end draw
selRectEnd CBHNDL, RC
' Now, when mouse button is released, global RECT (gRc)
' will hold coordinates of final drawn rect. If you
' for example want to select a group of controls or
' other objects, you can use IntersectRect API to see
' if parts of other RECT's are withing this global rect.
' Or use the coordinates to create a control/object of
' this size, whatever..
CASE %WM_TIMER
GetCursorPos( p_CrsInScreen )
ClientToScreen( CBHNDL, p_ClientOffset )
hWndCtrl = ChildWindowFromPoint( CBHNDL, p_CrsInScreen.X - p_ClientOffset.X, _
p_CrsInScreen.Y - p_ClientOffset.Y )
' is the mouse over a CCDialog? iF SO, DON'T CONFUSE THE PUNTER BY SNAPPING TO GRID!
IF CCIndexFromhW ( hWndCtrl ) = 0 THEN
' snap last ccontrol to grid - it will be the last one used or moved/resized!
IF gSnapToGrid THEN
IF iswindow(ghCCDialog) THEN
DIALOG GET LOC ghCCDialog TO X, Y
X = INT(((cGridX*0.5) + X) / cGridX) * cGridX ' if snap to grid, calculate "grid'd pos"
Y = INT(((cGridy*0.5) + Y) / cGridY) * cGridY ' via multiply of integer divide result
DIALOG SET LOC ghCCDialog, X, Y
DIALOG GET SIZE ghCCDialog TO W, H
W = INT(((cGridX*0.5) + W) / cGridX) * cGridX ' if snap to grid, calculate "grid'd pos"
H = INT(((cGridY*0.5) + H) / cGridY) * cGridY ' via multiply of integer divide result
DIALOG SET SIZE ghCCDialog, W, H
END IF
'BEEP
END IF
END IF
END SELECT
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' initialize sel rect drawing
' Copy dialog to global "screen buffer" for use as base for flicker
' free drawing and later restore.
'--------------------------------------------------------------------
SUB selRectBegin (BYVAL hWnd AS DWORD)
LOCAL hDC AS DWORD, hBit AS DWORD, pt AS POINTAPI, rc AS RECT
SetCapture hWnd ' set capture to desired window
GetClientRect hWnd, rc ' get client size
MapWindowPoints hWnd, 0, rc, 2 ' map client coordiantes to screen
ClipCursor rc ' clip cursor to client coordinates
GetCursorPos gPt ' get cursor pos on screen
ScreenToClient hWnd, gPt ' convert to client coordinates
IF gSnapToGrid THEN
gPt.x = (gPt.x \ cGridX) * cGridX ' if snap to grid, calculate "grid'd pos"
gPt.y = (gPt.y \ cGridY) * cGridY ' via multiply of integer divide result
END IF
GetClientRect hWnd, rc 'create a global memDC and copy window to it.
hDC = GetDc(hWnd)
gMemDC = CreateCompatibleDC (hDC)
ghBit = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
ghBit = SelectObject(gMemDC, ghBit)
BitBlt gMemDC, 0, 0, rc.nRight, rc.nBottom, hDC, 0, 0, %SRCCOPY
ReleaseDc hWnd, hDC
END SUB
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' perform sel rect drawing
'--------------------------------------------------------------------
SUB selRectDraw (BYVAL hWnd AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, RCT AS RECT)
LOCAL hDC AS DWORD, hBrush AS DWORD, hPen AS DWORD, rc AS RECT
LOCAL memDC AS DWORD, hBit AS DWORD
IF gSnapToGrid THEN
' MS cross cursor has mis-aligned hotspot - it should be at
' cross, but is upper-left corner. We should use own cross,
' but this is just a sample, so instead cheat and add 4 to pos..
x = x + 4 '<- depends on where hotspot in cursor is..
y = y + 4
x = (x \ cGridX) * cGridX 'first integer divide, then multiply for "grid effect".
y = (y \ cGridY) * cGridY
END IF
' must make sure rect coordinates are correct,
' so right side always is larger than left, etc.
IF (gPt.x <= x) AND (gPt.y >= y) THEN
SetRect gRc, gPt.x, y, x, gPt.y
ELSEIF (gPt.x > x) AND (gPt.y > y) THEN
SetRect gRc, x, y, gPt.x, gPt.y
ELSEIF (gPt.x >= x) AND (gPt.y <= y) THEN
SetRect gRc, x, gPt.y, gPt.x, y
ELSE
SetRect gRc, gPt.x, gPt.y, x, y
END IF
GetClientRect hWnd, rc
IF gRc.nLeft = gRc.nRight THEN INCR gRc.nRight '<- ensure we never get a "null rect"
IF gRc.nTop = gRc.nBottom THEN INCR gRc.nBottom
hDC = GetDc(hWnd)
memDC = CreateCompatibleDC (hDC) 'create temporary memDC to draw in
hBit = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
hBit = SelectObject(memDC, hBit)
hBrush = SelectObject(memDC, GetStockObject(%NULL_BRUSH)) 'for hollow rect
BitBlt memDC, 0, 0, rc.nRight, rc.nBottom, gMemDC, 0, 0, %SRCCOPY 'copy original buffer to temp DC
hPen = SelectObject(memDC, CreatePen(%PS_SOLID, 2, GetSysColor(%COLOR_3DSHADOW))) 'create pen
Rectangle memDC, gRc.nLeft, gRc.nTop, gRc.nRight + 1, gRc.nBottom + 1 'draw rect
SETRECT RCT, gRc.nLeft, gRc.nTop, gRc.nRight + 1, gRc.nBottom + 1
DeleteObject SelectObject(memDC, hPen)
BitBlt hDC, 0, 0, rc.nRight, rc.nBottom, memDC, 0, 0, %SRCCOPY 'copy temp DC to window
SelectObject memDC, hBrush
IF hBit THEN DeleteObject SelectObject(memDC, hBit) 'clean up to avoid mem leaks
IF memDC THEN DeleteDC memDC
ReleaseDc hWnd, hDC
END SUB
'------------------------------------------------------------------------------
CALLBACK FUNCTION CC_dialogProc()
STATIC hparent AS DWORD
LOCAL r AS rect
LOCAL w, h, l, x, y AS LONG
STATIC hcurs AS LONG
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
' Initialization handler
ghCCDialog = CBHNDL
hParent = GetParent (CBHNDL)
DIALOG GET SIZE CBHNDL TO W, H
CONTROL SET SIZE CBHNDL, %idc_ccID, w, h
hcurs = loadcursor(0, BYVAL %IDC_SIZEALL)
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CBWPARAM THEN
' Save control focus
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
' Restore control focus
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_EXITSIZEMOVE
DIALOG GET SIZE CBHNDL TO W, H
CONTROL SET SIZE CBHNDL, %idc_ccID, w, h
CASE %WM_NCLBUTTONDOWN
setcursor(hCurs)
CASE %WM_LBUTTONDOWN
SendMessage CBHNDL, %WM_NCLBUTTONDOWN, %HTCAPTION, BYVAL %NULL ' force drag
CASE %WM_LBUTTONUP
CASE %WM_DESTROY 'delete what we created on exit, to avoid mem leaks
END SELECT
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' end sel rect drawing
' Copy original window buffer back to screen to wipe out drawn
' rectangle, delete global memDC, release capture and clipped cursor.
'--------------------------------------------------------------------
SUB selRectEnd (BYVAL hWnd AS DWORD, RCT AS RECT)
LOCAL hDC AS DWORD, rc AS RECT
LOCAL hCCDD AS DWORD' dialog handle for control container
LOCAL lCtrlType, lRslt, CheckState AS LONG
LOCAL s, sTxt AS STRING
LOCAL X, Y, W, H AS LONG ' new dialog coords in UNITS
LOCAL lstyle AS LONG ' style attributes to add to window style acc to control type request
hDC = GetDc(hWnd)
GetClientRect hWnd, rc
BitBlt hDC, 0, 0, rc.nRight, rc.nBottom, gMemDC, 0, 0, %SRCCOPY
ReleaseDc hWnd, hDC
IF ghBit THEN DeleteObject SelectObject(gMemDC, ghBit) : ghBit = 0
IF gMemDC THEN DeleteDC gMemDC : gMemDC = 0
ReleaseCapture
FOR lCtrlType = %IDC_CTL1 TO %IDC_CTL6 ' Here can add more controls
CONTROL GET CHECK ghMenuDialog, lCtrlType TO CheCkState
IF CheckSTate THEN
' create a dialog to contain the selected type of control
DIALOG PIXELS hwnd, RCt.nleft, rct.ntop TO UNITS X, Y
DIALOG PIXELS hwnd, rct.nright-rct.nleft, rct.nbottom-rct.ntop TO UNITS W, H
DIALOG NEW hWnd, "", X, Y, W, H, _
%WS_POPUP OR %WS_THICKFRAME OR %WS_CHILD OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
%DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_TOOLWINDOW OR _
%WS_EX_TOPMOST OR %WS_EX_LEFT OR %WS_EX_LTRREADING TO hCCDD
REDIM PRESERVE HControls(UBOUND(Hcontrols)+1) AS GLOBAL CPH
INCR CONTROLINDEX
SELECT CASE lCtrlType - %our_typecontrol_base
CASE %our_button_type
s = "BN:" & FORMAT$(CONTROLINDEX)
lStyle = 0
CONTROL ADD BUTTON, hCCDD, %idc_CCID, "", 0,0,0,0
'GetTextOnCOntrol ( CBHNDL, %idc_ccID) ' will load %IDC-CCTXT with text, trransfer focus to text box
's = INPUTBOX$("Text for this button", "Control initialisation", s, X, Y)
CASE %our_checkbox_type
sTxt = "CB:" & FORMAT$(CONTROLINDEX)
lStyle = 0
CONTROL ADD CHECKBOX, hCCDD, %idc_CCID, "", 0,0,0,0
CASE %our_label_type
sTxt = "Ll:" & FORMAT$(CONTROLINDEX)
lStyle = 0
CONTROL ADD LABEL, hCCDD, %idc_CCID, "", 0,0,0,0
CASE %our_textbox_type
sTxt = "TB:" & FORMAT$(CONTROLINDEX)
lStyle = 0
CONTROL ADD TEXTBOX, hCCDD, %idc_CCID, "", 0,0,0,0
CASE %our_listbox_type
sTxt = "LB:" & FORMAT$(CONTROLINDEX)
lStyle = 0
CONTROL ADD LISTBOX, hCCDD, %idc_CCID, , 0,0,0,0
DummyListBox ( hCCDD, %IDC_CCID, 10)
CASE %our_listview_type
sTxt = "LV:" & FORMAT$(CONTROLINDEX)
lStyle = 0
CONTROL ADD "SysListView32", hCCDD, %idc_CCID, "", 0,0,0,0, _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %LVS_REPORT OR _
%LVS_SHOWSELALWAYS, %WS_EX_LEFT OR %WS_EX_CLIENTEDGE OR _
%WS_EX_RIGHTSCROLLBAR
SampleListView ( hCCDD, %IDC_CCID, 10, 10)
END SELECT
HControls(UBOUND(HControls)).hD = hCCDD
HControls(UBOUND(HControls)).lType = lCtrlType
HControls(UBOUND(HControls)).cid = CONTROLINDEX
HControls(UBOUND(HControls)).sText = s
DIALOG SHOW MODELESS hCCDD, CALL CC_dialogProc TO lRslt
CONTROL SET TEXT hCCDD, %IDC_CCID, s
END IF
NEXT lCtrlType
ClipCursor BYVAL %NULL
END SUB
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Create a patterned brush for grid. By using this, grid draw becomes
' very quick, even on full size dialogs. Must warn though - in Win95,
' brush can be max 8x8 pixels. In Win98 and later, brush can be bigger,
' so never a problem there.
'--------------------------------------------------------------------
FUNCTION MakeGridBrush(BYVAL hDlg AS DWORD) AS DWORD
LOCAL hDC AS DWORD, memDC AS DWORD, hBit AS DWORD, hBitOld AS DWORD, rc AS RECT
hDC = GetDC(hDlg)
memDC = CreateCompatibleDC(hDC)
hBit = CreateCompatibleBitmap(hDC, cGridX, cGridY)
hBitOld = SelectObject(memDC, hBit)
rc.nRight = cGridX
rc.nBottom = cGridY
FillRect memDC, rc, GetSysColorBrush(%COLOR_3DFACE)
SetPixelV memDC, 0, 0, 0 'paint "dots" in all four corners
SetPixelV memDC, 0, cGridY, 0
SetPixelV memDC, cGridX, 0, 0
SetPixelV memDC, cGridX, cGridY, 0
FUNCTION = CreatePatternBrush (hBit)
SelectObject memDC, hBitOld 'clean up to avoid mem leaks
DeleteObject hBit
DeleteDC memDC
ReleaseDC hDlg, hDC
END FUNCTION
'------------------------------------------------------------------------------
CALLBACK FUNCTION FloatMenu_dialogProc()
STATIC hmenu, hparent AS DWORD
LOCAL r AS rect
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
' Initialization handler
ghMenuDialog = CBHNDL
hParent = GetParent (CBHNDL)
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CBWPARAM THEN
' Save control focus
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
' Restore control focus
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_LBUTTONDOWN
SendMessage CBHNDL, %WM_NCLBUTTONDOWN, %HTCAPTION, BYVAL %NULL ' force drag
CASE %WM_DESTROY 'delete what we created on exit, to avoid mem leaks
CASE %WM_COMMAND
SELECT CASE CBCTL ' <- look at control's id
CASE %IDC_CHK1
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
CONTROL GET CHECK CBHNDL, CBCTL TO gSnapToGrid
END IF
CASE %IDC_CHK2
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
CONTROL GET CHECK CBHNDL, CBCTL TO gShowGrid
RedrawWindow hparent, BYVAL %NULL, 0, %RDW_ERASE OR %RDW_INVALIDATE OR %RDW_UPDATENOW
END IF
CASE %IDC_CHK1
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
CONTROL GET CHECK CBHNDL, CBCTL TO gSnapToGrid
END IF
CASE %IDC_CHK2
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
CONTROL GET CHECK CBHNDL, CBCTL TO gShowGrid
END IF
CASE %IDCANCEL
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN 'end prog
DIALOG END CBHNDL
END IF
END SELECT
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION FloatMenu_dialog(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
LOCAL hDlg AS DWORD
DIALOG NEW hParent, "", 176, 133, 65, 110, %WS_POPUP OR %WS_THICKFRAME OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
%DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_TOOLWINDOW OR _
%WS_EX_TOPMOST OR %WS_EX_LEFT OR %WS_EX_LTRREADING TO hdlg
'OR _
'%WS_EX_RIGHTSCROLLBAR, TO hDlg
DIALOG SET COLOR hDlg, -1, RGB(255, 255, 155)
CONTROL ADD CHECKBOX, hDlg, %IDC_CHK1, "&Snap to grid ", 2, 5, 60, 10
CONTROL ADD CHECKBOX, hDlg, %IDC_CHK2, "&Show grid ", 2, 15, 60, 10
CONTROL SET CHECK hDlg, %IDC_CHK1, 1
CONTROL SET CHECK hDlg, %IDC_CHK2, 2
CONTROL ADD OPTION, hDlg, %IDC_CTL1, "Button", 2, 45, 60, 10, %WS_GROUP
CONTROL ADD OPTION, hDlg, %IDC_CTL2, "CheckBox", 2, 55, 60, 10
CONTROL ADD OPTION, hDlg, %IDC_CTL3, "Label", 2, 65, 60, 10
CONTROL ADD OPTION, hDlg, %IDC_CTL4, "Text Box", 2, 75, 60, 10
CONTROL ADD OPTION, hDlg, %IDC_CTL5, "Listbox", 2, 85, 60, 10
CONTROL ADD OPTION, hDlg, %IDC_CTL6, "Listview", 2, 95, 60, 10
CONTROL SET OPTION hDlg, %IDC_CTL1, %IDC_CTL1, %IDC_CTL3 ' set initial state
DIALOG SHOW MODELESS hDlg, CALL FloatMenu_dialogProc TO lRslt
FUNCTION = lRslt
END FUNCTION
Comment