Forms designer - first hurdle

[Chris Holbrook]

Enough!

As a postscript to this thread.
The application has moved on a liitle and I can now design forms reasonably efficiently. There are several large deficiencies, in particular I don't have a control styles editor or group move/align functions, and I'm not generating any code yet. I shall post code -somewhere- for anyone who is interested when I get to a stable version. If you're interested, feel free to PM me.

[Chris Holbrook]

Wrap a rectangle around the selected item?

Rod,
that's the plan! There's a rectangle function which I have borrowed here in Pierre Bellisle's post.

[Rodney Hicks]

At present the lack of gripper handles seems a plus, but I realize that may change when there are several items to select from.
Would you necessarily need gripper handles to show that an item is selected, which will be necessary if multiple items are to be copied or moved? Wrap a rectangle around the selected item?

Rod

[Edwin Knoppert]

Very nice already.

PwrDev does make use of a real windowclasses for the draghandles.
On mouseover determines which cursor to show.
On mousemove redraw and reposition.

[Chris Holbrook]

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 **

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' 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

[Edwin Knoppert]

Why return : FUNCTION = %MA_ACTIVATE ??
Just return nothing and the default is used.

[Chris Holbrook]

Sorted! My method of discriminating between a mouse click in client and non-client areas was wrong. in the WM_MOUSEACTIVATE event (sorry, message) the low end of lparam (lo(word,CBLPARAM) gives the "hot spot", one of the possible values is HTCLIENT which means that you clicked in the client area:

    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 = 0
                 EXIT FUNCTION
             END IF
            ' 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
            END IF

[Edwin Knoppert]

'Suppress' mouse via WM_SETCURSOR, WM_SETCURSOR means: ask for cursor, if not go up one level and ask again.

There are several messages sent to a form which are an hierarchy.
Depending on the message it first sends it to the form, if not handle the control below etc etc..

WM_MOUSEACTIVATE and WM_CONTEXTMENU and WM_SETCURSOR are such messages.

Afaik still no need to hook a control at this time

See this:

    Case %WM_SETCURSOR
    
        If CbWParam <> CbHndl Then
            SetCursor( LoadCursor( 0, ByVal %IDC_ARROW ) )        
            Function = 1
        End If

[Chris Holbrook]

Thanks Edwin!

I added code to seperate move & drag, which works.
However, sometimes the system cursor changes when the mouse is not yet in the NC area, and sometimes the NC area seems hard to find. I'm sure that I would find this irritating in use, it really needs a grabs on the control to be moved rather than fishing around for the NC edge.

    CASE %WM_MOUSEACTIVATE
            LOCAL p_CrsInSCreen, p_ClientOffset, p_topL, p_bottomR AS POINTAPI
            LOCAL hWndCtrl AS LONG
            LOCAL r AS rect

            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 = 0
                 EXIT FUNCTION
             END IF
            ' 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.
            GetClientRect(hWndCtrl, r)
            p_topL.x = r.nleft  : p_topL.y = r.ntop
            ClientToScreen(hwndCtrl, p_TopL)
            p_bottomR.x = r.nright : p_bottomR.y = r.nbottom
            ClientToScreen(hwndCtrl, p_bottomR)
            IF (p_CrsInScreen.x < p_TopL.x)       _
               OR (p_CrsInScreen.y < p_TopL.y)    _
               OR (p_CRSInScreen.x > p_BottomR.x) _
               OR (p_CrsInScreen.y > p_BottomR.y) THEN
                FUNCTION = %MA_ACTIVATE                                ' NO, let message through for resize
            ELSE
                PostMessage hWndCtrl, %WM_NCLBUTTONDOWN, %HTCAPTION, 0 ' YES, FORCE DRAG
                FUNCTION = %MA_NOACTIVATEandeat
            END IF

[Edwin Knoppert]

if hWndCtrl <> hWnd then
'drag...

[Chris Holbrook]

Here is something which does drag all kinds of things...

That is impressive. One little problem, after I use it in the main dialog to drag the little dialogs which hold the user-selected controls, it wants to drag the main dialog even though the cursor is in the client area, pressing ESC gets back to normal, how to turn this off? Also resizing doesn't work, it drags irrespective of what part of the dialog is under the mouse.

[Edwin Knoppert]

Here is something which does drag all kinds of things, even an ATL based shell.explorer (internet).

    Case %WM_MOUSEACTIVATE
    
        Local PA1 As POINTAPI
        Local PA2 As POINTAPI
        Local hWndCtrl As Long
        GetCursorPos( PA1 )
        ClientToScreen( CbHndl, PA2 )
        hWndCtrl = ChildWindowFromPoint( CbHndl, PA1.X - PA2.X, PA1.Y - PA2.Y )
        PostMessage hWndCtrl, %WM_NCLBUTTONDOWN, %HTCAPTION, 0 
        Function = %MA_NOACTIVATEANDEAT

[Edwin Knoppert]

Using some kind of floating control is what MS did with the (at least) older VB's (as i heard)

A 'difficult' control is for example the richedit class.

I use something like:

    Case %WM_MOUSEACTIVATE
    
        Function = %MA_NOACTIVATEANDEAT

*in* the (ddt)form!
no need to hook the control at this time.

[Rodney Hicks]

I do use PBForms but not the SQLite so no need to post, at least not for my sake although the code generating aspect would be interesting. Other's may be watching and interested.

I was thinking that you might want to show location and size as the item is drawn.

There are some rather simple things that PBForms doesn't do that would be nice to see, like including programmer comments. Minor stuff really.

I can't put into words just what it is that's knocking around in my head about this idea. (maybe just another neuron biting the dust, misfires in the synapse gaps,whatever)

[Chris Holbrook]

...are you hoping to create a window with all items and transfer that code?

My first objective was to generate source code recogniseable to PBForms so that I could create lots of controls automatically just by identifying a database table and then use PBForms to sort out the resulting mess. That part is working, I can post it if you want but you will need a SQLite database to make sense of it and PBForms also to demonstrate it properly. I thought the effort would be best directed to dropping PBForms out of the loop, so the subset of PBForms which I use will have to be in scope. Rewriting all of PBForms would (for me anyway) be a career move.

I think the dragging problem is due to some of the controls capturing the mouse. If I overlay them with transparent controls and drag these, that problem will be solved.

Thanks for your encouragement, and what are the thoughts to which you refer?

[Rodney Hicks]

From your first posts on this subject I took it to mean that you wanted to have a tool for creating and item, and be able to transfer that item to your project. Is your goal still the same or are you hoping to create a window with all items and transfer that code? Don't let my questions alter your target.

If you are just creating an item to move to another project, being able to drag it in this program wouldn't be that important, would it?

I have thoughts on this, but since I'm not doing any of the coding, I'm trying to keep them to a minimum. The UI is the most important and I think you're heading in the right direction. Keep it up.

[Chris Holbrook]

Rodney, I just realised that the button, listbox and listview are no longer draggable once created.

Since posting I have replaced the table of window handles used in Borje's example with a UDT table to contain properties of each control. This array will be saved (until I get code regeneration working) and the (DDT) generated code will be generated by traversing this array once for declarations, once for the dialog and controls creation and once for the message handler. There will also be some standard functions, comments and metadata.

Quite a lot to do on the UI before code is generated, this is the slow part for me. I am at home with code generation, at sea with Windows.

[Rodney Hicks]

I've given it a quick go and there are several things that I like.
You're doing fine from where I sit. How are you going to generate code and transport generated code? Or am I jumping ahead on you?

Rod

[Chris Holbrook]

I've abandoned my first attempt and added some functionality to an example posted long ago by Borje Hagsten which looks promising. So far it just creates controls and lets you push them around the form. If anyone cares to give it a spin & send feedback it would be appreciated.

Just realised that I included the source code for the function to populate the example listview which is created by PBForms. I'm not sure if this is PowerBASIC's copyright.

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Visual designer-in-waiting based upon Borje Hagsten's DrawRect sample
' of March 2003, hacked about by Chris Holbrook to provide a floating menu
' and moveable "controls"
' the "controls" are all labels in fact, just placeholders for the
' controls on the generated code
'--------------------------------------------------------------------
#COMPILE EXE
#DIM ALL
#INCLUDE "commctrl.inc"
#INCLUDE "WIN32API.INC"
'--------------------------------------------------------------------
%IDC_CHK1 = 121
%IDC_CHK2 = 122

%IDC_CTL1 = 522
%IDC_CTL2 = 523
%IDC_CTL3 = 524
%IDC_CTL4 = 525
%IDC_CTL5 = 526
%IDC_CTL6 = 527

%idc_CCID = 550
'--------------------------------------------------------------------
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
'--------------------------------------------------------------------
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 LONG
GLOBAL CONTROLINDEX AS LONG
GLOBAL gdialogbob AS DWORD ' handle for floating menu dialog
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main entrance
'--------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
  LOCAL hDlg AS DWORD, lRes AS LONG
  DIM Hcontrols(0) AS GLOBAL LONG
  CONTROLINDEX = 2000

  DIALOG NEW 0, "One day...",,, 400, 240, _
                %WS_CAPTION OR %WS_CLIPCHILDREN OR %WS_SYSMENU OR %WS_THICKFRAME, 0 TO hDlg

  DIALOG SHOW MODAL hDlg CALL DlgProc

END FUNCTION

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main callback
'--------------------------------------------------------------------
CALLBACK FUNCTION DlgProc() AS LONG
  LOCAL l, lRes AS LONG
  STATIC RC AS RECT

  SELECT CASE CBMSG
     CASE %WM_INITDIALOG
        STATIC hCur AS DWORD ' for static grid brush handle
        cGridX      = 10     ' horizontal grid size
        cGridY      = 10     ' 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)

     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..

     CASE %WM_SETCURSOR
        ' If mouse button is pressed, over-ride default cursor and
        ' set "own", here cross cursor. 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_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..

  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 AS LONG

    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
            ' Initialization handler
            hParent = GetParent (CBHNDL)
            DIALOG GET CLIENT CBHNDL TO W, H
            CONTROL SET SIZE CBHNDL, %idc_ccID, w, h

        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 CLIENT CBHNDL TO W, H
            CONTROL SET SIZE CBHNDL, %idc_ccID, w, h

        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

    END SELECT
END FUNCTION
'--------------------------------------------------------------------
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



'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' 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 AS LONG, CheckState AS LONG
  LOCAL sTxt AS ASCIIZ * 80
  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 gdialogbob, 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 LONG
    INCR CONTROLINDEX
    SELECT CASE lCtrlType
        CASE %IDC_CTL1
              sTxt = "BN:" & FORMAT$(CONTROLINDEX)
              lStyle = 0
              CONTROL ADD BUTTON, hCCDD, %idc_CCID, "", 0,0,0,0

        CASE %IDC_CTL2
              sTxt = "CB:" & FORMAT$(CONTROLINDEX)
              lStyle = 0
              CONTROL ADD CHECKBOX, hCCDD, %idc_CCID, "", 0,0,0,0

        CASE %IDC_CTL3
              sTxt = "Ll:" & FORMAT$(CONTROLINDEX)
              lStyle = 0
              CONTROL ADD LABEL, hCCDD, %idc_CCID, "", 0,0,0,0

        CASE %IDC_CTL4
              sTxt = "TB:" & FORMAT$(CONTROLINDEX)
              lStyle = 0
              CONTROL ADD TEXTBOX, hCCDD, %idc_CCID, "", 0,0,0,0

        CASE %IDC_CTL5
              sTxt = "LB:" & FORMAT$(CONTROLINDEX)
              lStyle = 0
              CONTROL ADD LISTBOX, hCCDD, %idc_CCID, , 0,0,0,0
              DummyListBox ( hCCDD, %IDC_CCID, 10)

        CASE %IDC_CTL6
              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)) = hCCDD


    DIALOG SHOW MODELESS hCCDD, CALL CC_dialogProc 'TO lRslt

    CONTROL SET TEXT hCCDD, %IDC_CCID, sTxt

'    HControls(UBOUND(HControls)) = CreateWindow ("static",_
'                                                   BYVAL VARPTR(zTxt),_
'                                                   %WS_CHILD OR %WS_VISIBLE or lStyle, _
'                                                   RCt.nleft, rct.ntop,_
'                                                   rct.nright-rct.nleft, _
'                                                   rct.nbottom-rct.ntop, _
'                                                   hWnd, _
'                                                   CONTROLINDEX,_
'                                                   GetWindowLong(Hwnd, %GWL_HINSTANCE), _
'                                                   %NULL)

   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
            gDialogBOB = 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

[Chris Holbrook]

Go to the PB download web page here:

http://www.powerbasic.com/files/pub/pbwin/tools/

Chris, thanks for that guidance. Jules Marchilon's code doesn't compile with PB 8.04, but I'm looking at it. I had thought of trying to insert some metadata into the PBForms controls (like you suggest with EZGUI) but could not see how to get enough in there, also it means that there is a dependency on PBForms, similar considerations would apply to EZGUI freeware though cost would cease to be a factor!