Announcement

**Chris Boss** · 10 Mar 2008, 06:49 PM

I have it working:

Code:

#PBFORMS CREATED V1.51
#COMPILE EXE
#DIM ALL
#PBFORMS BEGIN INCLUDES
#IF NOT %DEF(%WINAPI)
    #INCLUDE "WIN32API.INC"
#ENDIF
#PBFORMS END INCLUDES
#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1  =  101
%IDC_LABEL1   = 1001
%IDC_TEXTBOX1 = 1002
%IDC_go_bn    = 1003
%IDC_LISTBOX1 = 1004
%IDC_LABEL2   = 1005
#PBFORMS END CONSTANTS
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowhelpProc()
    STATIC hparent AS DWORD
    STATIC htext AS STRING
    STATIC pSQL AS STRING PTR
    STATIC s AS STRING
    LOCAL l AS LONG
    LOCAL r, rEdit, rUS AS RECT
    STATIC szText AS ASCIIZ * 2048
    LOCAL hfont, hfont2, px, py, x, y AS LONG
    LOCAL hDC AS DWORD
    LOCAL ps AS paintstruct
    LOCAL pstr AS STRING PTR, RV&, hBrush AS LONG
    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
             ' Initialization handler
             DIALOG SET LOC CBHNDL, 50,50
             pstr = getprop(CBHNDL, "TEXT")
             sztext = @pstr         ' store in static variable
             getwindowrect CBHNDL, r
             x=r.nLeft
             y=r.nTop
             getClientrect CBHNDL, r
             hDC=GetDC(CBHNDL)
             SaveDC hDC
             hfont = SendMessage(CBHNDL, %WM_GETFONT, 0, 0)
             hfont2 = SelectObject(hDC, hfont)
             DrawText hDC, szText, LEN(szText), r, %DT_CALCRECT OR %DT_LEFT OR %DT_WORDBREAK
             SelectObject hDC, hfont2
             RestoreDC hDC, -1
             ReleaseDC CBHNDL, hDC
             SetWindowPos CBHNDL, 0, x, y, R.nRight, R.nBottom, %SWP_NOACTIVATE OR %SWP_NOCOPYBITS OR %SWP_NOMOVE OR %SWP_NOOWNERZORDER OR %SWP_NOREDRAW OR %SWP_NOZORDER
        CASE %WM_LBUTTONDOWN
            SendMessage CBHNDL, %WM_NCLBUTTONDOWN, %HTCAPTION, BYVAL %NULL  ' force drag
        CASE %WM_MOUSEMOVE ' the dialog has been dragged
             ' if the topleft of the dialog is within the edit box
             ' and within 100 px of it, transfer the text to the edit box
             GetWindowRect ( getdlgitem(getparent(CBHNDL), %IDC_TEXTBOX1), rEdit)
             GetWindowRect ( CBHNDL , rUs)
             IF (rUs.nleft >= rEdit.nleft) AND (rUs.nleft < rEdit.nleft + 100) THEN
                 IF (rUs.nTop >= rEdit.nTop) AND ( rUs.nTop < rEdit.nTop + 100) THEN
                     CONTROL SET TEXT getparent(CBHNDL), %IDC_TEXTBOX1, TRIM$(sztext)
                     DIALOG END CBHNDL, 0
                 END IF
             END IF
        CASE %WM_ERASEBKGND
             hDC = CBWPARAM
             SaveDC hDC
             hBrush = SendMessage(CBHNDL, %WM_CTLCOLORDLG, hDC, CBHNDL)
             SelectObject hDC, hBrush
             getclientrect CBHNDL, r
             PatBlt hDC, 0,0, R.nRight, R.nBottom, %PATCOPY
             hfont = SendMessage(CBHNDL, %WM_GETFONT, 0, 0)
             hfont2 = SelectObject(hDC, hfont)
             DrawText hDC, szText, LEN(szText), r, %DT_LEFT OR %DT_WORDBREAK
             SelectObject hDC, hfont2
             RestoreDC hDC, -1
             FUNCTION=1
             EXIT FUNCTION
    END SELECT
END FUNCTION
'------------------------------------------------------------------------------
' display expanded version of archived query
FUNCTION Showhelpdd(BYVAL hParent AS DWORD, s AS STRING) AS LONG
    LOCAL lRslt AS LONG
    STATIC sSQL AS STRING
    LOCAL hDlg  AS DWORD
    DIALOG NEW hParent, "", 176, 133, 190, 50, %WS_POPUP OR %WS_CLIPSIBLINGS OR %WS_VISIBLE  TO hDlg
    DIALOG  SET COLOR   hDlg, 0, RGB(155, 255,155)
    setprop hdlg, "TEXT", BYVAL VARPTR(s)
    DIALOG SHOW MODELESS hDlg, CALL ShowhelpProc TO lRslt
    FUNCTION = lRslt
END FUNCTION
CALLBACK FUNCTION ShowDIALOG1Proc()
    LOCAL s AS STRING
    LOCAL sarray() AS STRING
    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
            DIM sarray(0 TO 8)
            sarray(0) = "This document* shews at once the dangers and difficulties which" + _
                        "attended travelling in Aubrey's time, and also that he seriously" + _
                        "contemplated the publication of his favourite work.
            sarray(1) = "I will not say, that none else hath observed the same; but I protest," + _
                        "(""Ita, me Deus amet, ut verum loquor"") I do not know of any that have;" + _
                        "and therefore must justly claim to be acquitted from the least" + _
                        "suspicion of plagiarism, or plowing with others heifers."
            sarray(2) = "A few passages may be quoted from the latter to shew that he was" + _
                        "greatly in advance of his contemporaries in general knowledge and" + _
                        "liberality of sentiment:-"
            sarray(3) = "I have oftentimes wished for a mappe of England coloured according" + _
                        "to the colours of the earth; with markes of the fossiles and" + _
                        "minerals."" (p. 10.)"
            sarray(4) = "As the motion caused by a stone lett fall into the water is by" + _
                        "circles, so sounds move by spheres in the same manner; which, though" + _
                        "obvious enough, I doe not remember to have seen in any booke."" (p." + _
                        "18.)"
            sarray(5) = "Phantomes. Though I myselfe never saw any such things, yet I will" + _
                        "not conclude that there is no truth at all in these reports. I believe" + _
                        "that extraordinarily there have been such apparitions; but where one" + _
                        "is true a hundred are figments. There is a lecherie in lyeing and" + _
                        "imposing on the credulous, and the imagination of fearfull people is" + _
                        "to admiration."" [In other words, timid people are disposed to believe" + _
                        "marvellous stories.] (p. 122.)"
            sarray(6) = "Draughts of the Seates and Prospects. If these views were well donn," + _
                        "they would make a glorious volume by itselfe, and like enough it might" + _
                        "take well in the world. It were an inconsiderable expence to these"
            sarray(7) = "persons of qualitie, and it would remaine to posterity when their" + _
                        "families are gonn and their buildings ruined by time or fire, as we" + _
                        "have seen that stupendous fabric of Paul's Church, not a stone left on" + _
                        "a stone, and lives now only in Mr. Hollar's Etchings in Sir William"
            sarray(8) = "Dugdale's History of Paul's. I am not displeased with this thought as" + _
                        "a desideratum, but I doe never expect to see it donn; so few men have" + _
                        "the hearts to doe public good to give 4 or 5 pounds for a copper-plate." + _
                        "p. 126.)"
        CONTROL ADD LISTBOX, CBHNDL, %IDC_LISTBOX1,sarray() , 5, 5, 155, 70
        CASE %WM_COMMAND
            SELECT CASE AS LONG CBCTL
                CASE %IDC_Listbox1
                    IF CBCTLMSG = %LBN_DBLCLK THEN
                        LISTBOX GET TEXT CBHNDL, %IDC_LISTBOX1 TO s
                        showhelpdd(CBHNDL, s)
                    END IF
'                CASE %IDC_go_bn
                    'CONTROL SET TEXT CBHNDL, %IDC_TEXTBOX1, ""
                    'CONTROL DISABLE CBHNDL, %IDC_LABEL1
                    'showhelpdd(CBHNDL)
            END SELECT
    END SELECT
END FUNCTION
'-------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG
#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
    LOCAL hDlg  AS DWORD
    DIALOG NEW hParent, "Expand and drag text", 115, 93, 387, 81, %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 hDlg
    CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX1, "TextBox1", 165, 5, 215, 50, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_LEFT OR _
        %ES_MULTILINE, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
'    CONTROL ADD BUTTON,  hDlg, %IDC_go_bn, "go", 365, 60, 15, 15
    CONTROL ADD LABEL,   hDlg, %IDC_LABEL2, "Dblclk on the listbox, drag text to edit box top LHS", 165, 60, 195, 20
#PBFORMS END DIALOG
    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
#PBFORMS END CLEANUP
    FUNCTION = lRslt
END FUNCTION
'===============================================
FUNCTION PBMAIN()
    ShowDIALOG1 %HWND_DESKTOP
END FUNCTION

I changed a good bit of code in the dialog procedure. I calculate the dialogs size in WM_INITDIALOG and resize it. You have to use the correct code to do the calculation.

Then I draw the text in the dialogs WM_ERASEBKGND message.

Also to make it look more tooltip like, the dialog has no border. It makes it easier to calculate the size too.

**Chris Holbrook** · 10 Mar 2008, 07:26 PM

Originally posted by Chris Boss View Post

Then I draw the text in the dialogs WM_ERASEBKGND message.

Perfect. Exactly what I was aiming at. Many thanks!

Announcement

dragging text & drawing on a dialog

dragging text & drawing on a dialog

Comment

Comment