Announcement

Collapse
No announcement yet.

Forms designer - first hurdle

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • #21
    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 **
    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
    Last edited by Chris Holbrook; 6 Dec 2007, 11:40 AM. Reason: added snap to grid to code under WM_TIMER

    Comment


    • #22
      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.
      hellobasic

      Comment


      • #23
        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
        Rod
        In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

        Comment


        • #24
          Originally posted by Rodney Hicks View Post
          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.

          Comment


          • #25
            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.

            Comment

            Working...
            X