Visual Forms Designer again

[Chris Holbrook]

The trick is to use regions.

Sounds convincing! I thought that using a rectangle drawn on the control I wanted to "grab" would be a good start. This can be accessed as a bitmap, so starting off with Patrice Terrier's example here I have grafted code into a small DDT application, decalring the REGION class and using CONTROL ADD "REGION" etc, subclassing the region control. It all works pretty much like M Terrier's example, except that there appears to be an interaction between the dialog styles and the colour of the region. In the example bitmap which I use (a red circle), running the original code, the circle is indeed red. You could substitute another bitmap and observe a similar effect. In my DDT application, the circle either captures the underlying image on creation, or appears in the LTGRAY system colour, for example, if I remove the %WS_DLGFRAME, I get grey. Any ideas how this transformation could come about?

*** update 30-dec-2007. OK I see the problem, it's not about the graphic but all to do with the window handling. I don't think I can do this with DDT. ***

'------------------------------------------------------------------------------
' CJH broken code - image colour not correctly rendered in region.
'
'------------------------------------------------------------------------------
#COMPILE EXE
#DIM ALL

#INCLUDE "WIN32API.INC"
#INCLUDE "COMMCTRL.INC"
'------------------------------------------------------------------------------
'   ** Constants **
'------------------------------------------------------------------------------
%IDD_DIALOG1  =  101
%IDC_GRAPHIC1 = 1001
%IDC_LABEL1   = 1003
%idc_bn1      = 1004
%IDC_REGION1  = 1005
'------------------------------------------------------------------------------
GLOBAL hBmp AS LONG
'------------------------------------------------------------------------------
'   ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
'------------------------------------------------------------------------------
DECLARE SUB Circle (BYVAL hWnd AS LONG, BYVAL hDlg AS LONG)

GLOBAL gOldRgnProc AS DWORD

'------------------------------------------------------------------------------
SUB GetPixmapSize(BYVAL hBmp&, xWidth&, yHeight&) EXPORT
    LOCAL bm AS BITMAP
    IF hBmp& THEN
       CALL GetObject(hBmp&, SIZEOF(bm), bm)
       xWidth& = bm.bmWidth
       yHeight& = bm.bmHeight
    END IF
END SUB
'------------------------------------------------------------------------------
FUNCTION ConvertBitmapToRgn& (BYVAL hBmp&, BYVAL TransColor&) AS LONG 'EXPORT
'
    LOCAL bm AS BITMAP, rc AS RECT
    LOCAL bi AS BITMAPINFO, rdh AS RGNDATAHEADER PTR
    LOCAL os AS OSVERSIONINFO
    LOCAL lpRect AS RECT PTR
    LOCAL regiondata AS STRING

    LOCAL maxregions, hDC, hMem1DC, hMem2DC, hTmpBmp, pwidth, pheight, hToDIB AS LONG
    LOCAL T, TT, I, J, K, L, M, hRGN1, hRGN2 AS LONG
    LOCAL ar() AS LONG

    MaxRegions& = 4000
'
    CALL GetPixmapSize(hBmp&, pWidth&, pHeight&)
'
    hDC& = CreateIC ("DISPLAY", BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
'
    hMem1DC& = CreateCompatibleDC(hDC&)
    hMem2DC& = CreateCompatibleDC(hDC&)
    hTmpBmp& = CreateCompatibleBitmap(hDC&, pWidth&, pHeight&)
    CALL SelectObject(hMem1DC&, hBmp&)
    CALL SelectObject(hMem2DC&, hTmpBmp&)
    CALL BitBlt(hMem2DC&, 0, 0, pWidth&, pHeight&, hMem1DC&, 0, 0, %SRCCOPY)
'
    bi.bmiHeader.biSize = SIZEOF(bi.bmiHeader)
    bi.bmiHeader.biWidth = pWidth&
    bi.bmiHeader.biHeight = pHeight&
    bi.bmiHeader.biPlanes = 1
    bi.bmiHeader.biBitCount = 32
    bi.bmiHeader.biCompression = %BI_RGB
'
    hToDIB& = CreateDIBSection(hMem1DC&, bi, %DIB_RGB_COLORS, 0, 0, 0)
'
    CALL SelectObject(hMem1DC&, hToDIB&)
    CALL GetObject(hToDIB&, SIZEOF(bm), bm)
    CALL BitBlt(hMem1DC&, 0, 0, pWidth&, pHeight&, hMem2DC&, 0, 0, %SRCCOPY)
'
    REDIM Ar&(0) AT bm.bmBits: TT& = 0
'
  ' Set up the transparent color
    IF TransColor& = -1 THEN
       T& = (Ar&((pHeight& - 1) * pWidth&) AND &HFFFFFF)'<--- (0, 0)
    ELSE
       T& = TransColor& ' Common Trancolor is magenta &HFF00FF
    END IF
'
    RegionData$ = STRING$(LEN(RGNDATAHEADER) + LEN(RECT) * MaxRegions&, 0)
    rdh = STRPTR(RegionData$)
    @rdh.nCount = MaxRegions& + 1
    @rdh.dwSize = LEN(RGNDATAHEADER)
    @rdh.iType = %RDH_RECTANGLES
    @rdh.rcBound.nLeft = 0
    @rdh.rcBound.nTop = 0
    @rdh.rcBound.nRight = pWidth&
    @rdh.rcBound.nBottom = pHeight&
    FOR J& = 0 TO pHeight& - 1
        TT& = pWidth& * (pHeight& - 1 - J&): M& = -1
        FOR I& = 0 TO pWidth&
            IF I& = pWidth& THEN K& = T& ELSE K& = (Ar&(TT&) AND &HFFFFFF): INCR TT&
            IF K& <> T& THEN
               IF M& = -1 THEN M& = I&
            ELSEIF M& >= 0 THEN
               IF @rdh.nCount >= MaxRegions& THEN
                  hRgn2& = ExtCreateRegion(BYVAL 0, LEN(RGNDATAHEADER) + (LEN(RECT) * @rdh.nCount), BYVAL rdh)
                  IF hRgn1& = 0 THEN
                     hRgn1& = hRgn2&
                  ELSE
                     CALL CombineRgn(hRgn1&, hRgn1&, hRgn2&, %RGN_OR)
                     CALL DeleteObject(hRgn2&)
                  END IF
                  lpRect = LEN(RGNDATAHEADER) + rdh
                  @rdh.nCount = 0
               END IF
               INCR @rdh.nCount
               @lpRect.nLeft = M&
               @lpRect.nRight = I&
               @lpRect.nTop = J&
               @lpRect.nBottom = J& + 1
               lpRect = lpRect + LEN(RECT)
               M& = -1
            END IF
        NEXT
    NEXT
    hRgn2& = ExtCreateRegion(BYVAL 0, LEN(RGNDATAHEADER) + (LEN(RECT) * @rdh.nCount), BYVAL rdh)
    IF hRgn1& = 0 THEN
       hRgn1& = hRgn2&
    ELSE
       CALL CombineRgn(hRgn1&, hRgn1&, hRgn2&, %RGN_OR)
       CALL DeleteObject(hRgn2&)
    END IF
'
    CALL DeleteDC(hMem1DC&)
    CALL DeleteDC(hMem2DC&)
    CALL DeleteDC(hDC&)
    CALL DeleteObject(hTmpBmp&)
    CALL DeleteObject(hToDIB&)
'
    FUNCTION = hRgn1&
'
END FUNCTION
'
' Message function
'---------------------------------------------------------------------
FUNCTION RgnProc(BYVAL hWnd AS LONG, BYVAL Msg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
'
    LOCAL hDC, xSize, ySize, usebitmap AS LONG
    SELECT CASE Msg&
    '
        CASE %WM_ERASEBKGND
             hDC& = CreateCompatibleDC(wParam&)
             CALL GetPixmapSize(UseBitmap&, xSize&, ySize&)
             SelectObject hDC&, UseBitmap&
             BitBlt wParam&, 0, 0, xSize&, ySize&, hDC&, 0, 0, %SRCCOPY
             DeleteDC hDC&
    '
             FUNCTION = 1
             EXIT FUNCTION
    '
        CASE %WM_RBUTTONDOWN
             CALL PostQuitMessage(0)
             FUNCTION = 0: EXIT FUNCTION
    '
        CASE %WM_LBUTTONDOWN
             BEEP
             CALL ReleaseCapture
             CALL SendMessage(hWnd&, %WM_NCLBUTTONDOWN, %HTCAPTION, BYVAL %NULL)   ' HTCAPTION
             FUNCTION = 1: EXIT FUNCTION
    END SELECT
    FUNCTION = CallWindowProc(gOldRgnProc, hWnd, Msg, wParam, lParam)
    EXIT FUNCTION
END FUNCTION
'------------------------------------------------------------------------------
'   ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN()

    InitCommonControls

    ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------
'   ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
    LOCAL W, H, pw, ph, hbmp, hbmpold, hW AS LONG
    LOCAL hDC, hMEMDC AS LONG
    STATIC hrgnclip, hRgn AS LONG ' handle for region

    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
            ' Initialization handler
            hbmp = LoadImage(BYVAL 0&, ("redcircle.bmp"), %IMAGE_BITMAP, 0, 0, %LR_LOADFROMFILE)
            CALL GetPixmapSize(hbmp, W, H)
            CONTROL ADD "REGION", CBHNDL, %IDC_REGION1, "", 0, 0, W, H, %WS_POPUP OR %WS_SYSMENU' OR %WS_CHILD

            IF hBmp THEN
                 hRgnClip& = ConvertBitmapToRgn(hBMP, -1)
                 IF hRgnClip& THEN
                     CALL SetWindowRgn(CBHNDL, hRgnClip&, %True)
                 END IF
            END IF
            CONTROL HANDLE CBHNDL, %IDC_REGION1 TO hRgn
            gOldRgnProc = SetWindowLong(hRgnClip, %GWL_WNDPROC, CODEPTR(RgnProc))

        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_COMMAND
            ' Process control notifications
            SELECT CASE AS LONG CBCTL
                CASE %idc_bn1

            END SELECT

        CASE %WM_CLOSE
            GRAPHIC ATTACH hBmp, 0
            GRAPHIC BITMAP END

        CASE %WM_DESTROY
             SetWindowLong hRgnClip, %GWL_WNDPROC, gOldRgnProc
        END SELECT

END FUNCTION
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG

    LOCAL hDlg   AS DWORD
    LOCAL hFont1 AS DWORD
    LOCAL Msg     AS tagMsg
    LOCAL WC      AS WndClassEx
    LOCAL zClass  AS ASCIIZ * 7
    LOCAL l AS LONG
'
    zClass = "REGION"
'
    wc.cbSize        = SIZEOF(wc)
    wc.style         = %CS_HREDRAW OR %CS_VREDRAW
    wc.lpfnWndProc   = CODEPTR(RgnProc)
    wc.cbClsExtra    = 0
    wc.cbWndExtra    = 0
    wc.hInstance     = GetModulehandle(BYVAL %NULL)
    wc.hIcon         = %NULL ' LoadIcon(l, "PROGRAM")
    wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
    wc.hbrBackground = GetStockObject( %LTGRAY_BRUSH )
    wc.lpszMenuName  = %NULL
    wc.lpszClassName = VARPTR(zClass)
    wc.hIconSm       = 0
    CALL RegisterClassEx(wc)

    DIALOG NEW hParent, "Transparent", 165, 103, 201, 121, %WS_POPUP OR %WS_BORDER OR %WS_SYSMENU OR %WS_DLGFRAME OR _
        %WS_MINIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_CENTER 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

    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

    FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------------------------

[Chris Holbrook]

reposted over here with several bugs fixed. To my surprise, the generated code is PB-forms friendly, too.

[Michael Mattias]

Some might argue a few days without Internet access *Is* civilization....

[Rodney Hicks]

I am going to play with this over the next few days. I'll be away from home and without Internet access, but I will get back to you when I'm back in civilization.

Rod

[Chris Holbrook]

The version in the source code forum has been refreshed. Current version generates DDT code - please try it, feedback would be nice. You need to have the styles.txt file in the working directory.

[Chris Holbrook]

Thanks for comments above. I'm a bit embarrassed that I left the styles.txt file out, now posted to source code forum here.

[Rodney Hicks]

I am quite impressed with your progress with this project, and the way you have set up some of the features.

Looking good!

[Chris Boss]

While I can't give away any trade secrets, here are some more comments about visual designers.

A far as I can see, there are two ways to impliment drag handles for a designer.

One is to draw them on the parent form directly. I don't do this, but I assume you could process the forms WM_PAINT and then draw them afterwards, as long as you don't use any clipping, so you can draw on top of the controls to. It may be possible to create a transparent window on top of the form to draw them, but I am not sure how that would work.

The other way is to create a real window class to handle the handles.
This is what I do. I have my own custom window class (drag handle control) which can attach itself to any control and display the drag handles (both inside or outside the control).


The trick is to use regions.

Regions allow a window to be non-rectangular, which is what I use to make the drag handle control able to display on in certain places.

Now it may be possible to create a drag handle control, one for each handle, but I have a drag handle class which creates all 8 drag handles in one control. The region code requires a bit of calculations, but it can be done and quite easily.

I wish I could post more, but then I would be giving away all my secrets.

[Chris Boss]

Chris,

Some suggestions:

Rather than use dialogs (children of parent dialog) for the control parents and using the WS_THICKFRAME style to make windows handle the sizing of the dialogs edges, you can accomplish the same thing by using a different method, which is better IMO.

Create the controls directly on the parent form, without the dialog middleman.

Subclass the controls (plenty of code on the forums demonstrate this).

in the subclass code process the WM_NCHITTEST message, rather than pass it to DefWindowProc or the original window procedure. You can fake the return values for this message and it will allow you to make Windows impliment sizing of the borders and even dragging of the control.

Windows sends this message to a classes window procedure every time the mouse moves to see what the mouse is over (is over the edge, a sizable edge, the client area, etc.). The return value tells Windows what to do.

If you return %HTCAPTION for example, Windows will think the mouse is over the caption bar of a window. If the user drags the mouse at this time, Windows will automatically impliment dragging of the window.

If you returned %HTTOP then Windows will impliment the drag cursor for dragging the top of the window and so on.

Read the API docs about WM_NCHITTEST and find out more.

[Paul Squires]

.... and if I remember correctly, I stole a lot of code from Jule's work that he did on building a visual designer. Thanks Jules!

[Jules Marchildon]

Chris,

Don't forget to check out QTABS in the download area. Lot's of resources to help you on your way that was created with the help from many here on the forum.

(I just glued it together )

Regards,
Jules

[Paul Squires]

There is certainly a lot of work to making a visual designer, isn't it?

I remember when I started writing FireFly. I thought that I could whip through the process in a matter of weeks but every step of the way turned out to be a huge learning process for me. Looking back on it, I am very happy that I continued - I have learned soooooooooo much over that time.

Keep at it. You'll be surprised how much you learn - stuff that you'll keep in your programming bag of tricks for a long time.

[Chris Holbrook]

Please see the source code forum, here. Still very much incomplete.

The snags at the moment concern the Styles part of the properties dialog (right click on a control, etc). One, I can't get a multiline tooltip working to make sense of the help text in the styles listview, Two, I have not applied syles to the controls in the Visual Designer because I don't know well enough what effect they will have - need to research this more!