Announcement

Collapse
No announcement yet.

is there a better way of drawing lines between moveable objects

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • #1

    is there a better way of drawing lines between moveable objects

    I'm still messing about with drawing Entity Relationship diagrams and it occurred to me that maybe my basic method of drawing lines between boxes, resulting from trial and error, could be improved upon. So here is an example of the approach which I am using, can it be done better?

    The code below will compile with version 9, and I would guess with version 8 too.

    Code:
    '
' demonstrating a way of redrawing lines between moveable/sizeable dialogs
' and hoping there is a better one!
' Chris Holbrook Sep 2008
' 
' (gripper code after an example by Jules Marchildon)
'
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
%IDD_DIALOG1 = 101

TYPE tCC
     hWnd               AS DWORD
     r(0 TO 7)          AS RECT
     hitval(0 TO 7)     AS DWORD  'NCHITTEST return value
     centreX            AS LONG
     centreY            AS LONG
END TYPE
'----------------------------------------------------------------------
GLOBAL ghd() AS tcc
GLOBAL gparentdlg AS DWORD

'----------------------------------------------------------------------
SUB FigureHandleSizes(BYVAL hWnd AS LONG)

    LOCAL rc         AS RECT
    LOCAL dx, dy, x, y, lcx   AS LONG
    LOCAL dWHitValue AS DWORD
    LOCAL iIndex     AS LONG
    GLOBAL ghd()     AS tcc

    IF ghd(0).hwnd = hwnd THEN
        lcx = 0
    ELSEIF ghd(1).hwnd = hwnd THEN
        lcx = 1
    ELSE
        lcx = 2
    END IF
    '**Get the width and height of the window frame
    '  we want to put handles on.
    dx = GetSystemMetrics(%SM_CXFRAME)
    dy = GetSystemMetrics(%SM_CYFRAME) + 1  'not sure why add 1 ???

    CALL GetWindowRect(hWnd,rc)

    x = rc.nleft
    y = (rc.ntop + rc.nbottom) \ 2 - y \ 2
    CALL MakeHandle(lcx, 0, rc.nleft, (rc.ntop + rc.nbottom) \ 2 - dy \ 2, dx, dy,%HTLEFT)
    CALL MakeHandle(lcx, 1, rc.nright-dx-1, (rc.ntop+rc.nbottom) \ 2-dy \ 2, dx, dy,%HTRIGHT)
    CALL MakeHandle(lcx, 2, (rc.nleft+rc.nright) \ 2-dx \ 2, rc.ntop, dx, dy,%HTTOP)
    CALL MakeHandle(lcx, 3, rc.nleft, rc.ntop, dx, dy,%HTTOPLEFT)
    CALL MakeHandle(lcx, 4, rc.nright-dx-1, rc.ntop, dx, dy,%HTTOPRIGHT)
    CALL MakeHandle(lcx, 5, (rc.nleft+rc.nright) \ 2-dx \ 2, rc.nbottom-dy-2, dx, dy,%HTBOTTOM)
    CALL MakeHandle(lcx, 6, rc.nleft, rc.nbottom-dy-2, dx, dy,%HTBOTTOMLEFT)
    CALL MakeHandle(lcx, 7, rc.nright-dy, rc.nbottom-dy-2, dx, dy,%HTBOTTOMRIGHT)
END SUB
'----------------------------------------------------------------------------------
SUB MakeHandle(lcx AS LONG, _
               BYVAL iIndex AS LONG, _
               BYVAL x  AS LONG, _
               BYVAL y  AS LONG, _
               BYVAL dx AS LONG, _
               BYVAL dy AS LONG, _
               BYVAL dwHitValue AS WORD)

    'DIM Grips(0:7) AS tGRIPPERS

    GHD(lcx).r(iIndex).nleft   = x
    GHD(lcx).r(iIndex).ntop    = y
    GHD(lcx).r(iIndex).nright  = x+dx+1    'adjust size
    GHD(lcx).r(iIndex).nbottom = y+dy+1    'adjust size
    GHD(lcx).hitval(iIndex)   = dwHitValue
END SUB
'------------------------------------------------------------------------------
SUB ScreenToClientRect(BYVAL hWnd AS LONG, prRect AS RECT)
    LOCAL pt AS POINTAPI

    pt.x = prRect.nleft
    pt.y = prRect.ntop
    ScreenToClient hWnd,pt
    prRect.nleft = pt.x
    prRect.ntop  = pt.y
    pt.x = prRect.nright
    pt.y = prRect.nbottom
    ScreenToClient hWnd,pt
    prRect.nright  = pt.x
    prRect.nbottom = pt.y
END SUB
'------------------------------------------------------------------------------------
CALLBACK FUNCTION BoxCBProc()
    LOCAL ps            AS PAINTSTRUCT
    LOCAL rc            AS RECT
    LOCAL hdc, hbrush   AS DWORD
    LOCAL i, lcx, lresult   AS LONG
    LOCAL pt            AS POINTAPI
    STATIC hparent      AS DWORD
    
    SELECT CASE CBMSG
        CASE %WM_PAINT
            hdc = beginpaint(CBHNDL, PS)
            getwindowrect( CBHNDL, rc)
            ' draw outline of bos
            Rectangle hDC, 0, 0, rc.nright - rc.nleft , rc.nbottom - rc.ntop
            Rectangle hDC, 0, 0, rc.nright - rc.nleft , rc.nbottom - rc.ntop
            IF ghd(0).hwnd = CBHNDL THEN
                lcx = 0
            ELSEIF ghd(1).hwnd = CBHNDL THEN
                lcx = 1
            ELSE
                lcx = 2
            END IF
            ' locate grippers...
            FigureHandleSizes CBHNDL
            '... and draw grippers
            FOR  i = 0 TO 7
                rc = GHD(lcx).r(i)
                ScreenToClientRect CBHNDL, rc
                FillRect hDC,rc,GetStockObject(%LTGRAY_BRUSH)
            NEXT
            endpaint(CBHNDL, ps)

        CASE %WM_LBUTTONDOWN
            SendMessage CBHNDL, %WM_NCLBUTTONDOWN, %HTCAPTION, BYVAL %NULL  ' force drag
            
        CASE %WM_EXITSIZEMOVE
            DIALOG SEND gparentdlg, %WM_USER + 400, 0, 0

        CASE %WM_NCHITTEST
            FigureHandleSizes  CBHNDL
            IF ghd(0).hwnd = CBHNDL THEN
                lcx = 0
            ELSEIF ghd(1).hwnd = CBHNDL THEN
                lcx = 1
            ELSE
                lcx = 2
            END IF
            GetClientRect CBHNDL,rc
            pt.x = LOWRD(CBLPARAM)
            pt.y = HIWRD(CBLPARAM)
            '**First, test for the "handles"
            FOR i = 0 TO  7
                rc = ghd(lcx).r(i)
                lresult = PtInRect( rc, pt.x, pt.y )
                IF lresult <> 0 THEN
                    FUNCTION = ghd(lcx).hitval(i)
                    EXIT FUNCTION
                END IF
            NEXT
            '**Second, test for moving
            ScreenToClient CBHNDL,pt
            lresult = PtInRect(rc, pt.x, pt.y)
            IF lresult = 0 THEN FUNCTION = %HTCAPTION  'force drag

    END SELECT
END FUNCTION
'------------------------------------------------------------------------------------
FUNCTION createboxes ( hParent AS DWORD) AS LONG
    LOCAL i AS LONG
    DIM ghd(0 TO 2) AS GLOBAL tcc

    FOR i = 0 TO 2
        DIALOG NEW hParent, "", 80 * i + 20, 20 * i + 20, 50, 50, _
        %WS_POPUP  OR %WS_CHILD OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_NOFAILCREATE OR _  OR %DS_3DLOOK
        %DS_SETFONT , %WS_EX_TRANSPARENT OR %WS_EX_CONTROLPARENT  OR _   OR %WS_EX_TOOLWINDOW
        %WS_EX_TOPMOST OR %WS_EX_LEFT OR %WS_EX_LTRREADING TO ghD(i).hWnd

        DIALOG SHOW MODELESS ghD(i).hWnd, CALL BoxCBProc 'TO lRslt

    NEXT
END FUNCTION
'------------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
    LOCAL ps AS PAINTSTRUCT
    LOCAL r, rc AS RECT
    LOCAL hdc, hbrush, hpen AS DWORD
    LOCAL s AS STRING
    LOCAL i, lcx, lresult   AS LONG
    LOCAL pt, p1, p2        AS POINTAPI

    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
             createboxes(CBHNDL)

        CASE %WM_USER + 400
            BEEP
            getclientrect(CBHNDL,r)
            invalidaterect ( CBHNDL, BYREF r, %false)
            
'        CASE %WM_EXITSIZEMOVE
'            DIALOG SEND CBHNDL, %WM_USER + 400, 0, 0

        CASE %WM_PAINT
            hdc = beginpaint(CBHNDL, PS)
            ' draw some background stuff
            s = REPEAT$(200, "oooooooo ")
            setrect rc, 0, 0, 500,500
            drawtext hdc, BYVAL STRPTR(s), BYVAL LEN(s) + 1, BYVAL VARPTR(rc), %dt_wordbreak
            ' draw a line between the centres of the subdialogs
            hpen = selectobject(hdc, createpen(%PS_SOLID,2,%RED))
            FOR i = 0 TO 2 ' for each subdialog
                getclientrect ghd(i).hwnd, BYREF r
                p1.x = r.nleft: p1.y = r.ntop
                p2.x = r.nright: p2.y = r.nbottom
                clienttoscreen ghd(i).hwnd, p1
                clienttoscreen ghd(i).hwnd, p2
                screentoclient CBHNDL, p1
                screentoclient CBHNDL, p2
                ghd(i).centrex = (p1.x + p2.x) \2
                ghd(i).centrey = (p1.y + p2.y) \2
            NEXT
            moveto hdc, ghd(0).centrex, ghd(0).centrey
            lineto hdc, ghd(1).centrex, ghd(1).centrey
            lineto hdc, ghd(2).centrex, ghd(2).centrey
            hpen = selectobject(hdc,hpen)
            deleteobject(hpen)
            endpaint(CBHNDL, ps)
    END SELECT
END FUNCTION
'------------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG
    LOCAL hDlg  AS DWORD

    DIALOG NEW hParent, "lines & boxes question                          by Chris Holbrook", _
                        193, 132, 262, 161, _
                        %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR _
                        %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
                        %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR _
                        %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, _
                        TO gParentdlg
    
    DIALOG SHOW MODAL gparentdlg, CALL ShowDIALOG1Proc TO lRslt
    FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------------
FUNCTION PBMAIN()
    DIM ghd(0 TO 0) AS tcc
    ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
    Tags: None
Previous template Next
Working...
X

We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

I Agree