WIN32 and DDT code examples

[Jim Fritts]

Update for Chris's post #2
Modified by Jim Fritts
Great work Chris and thank you for sharing!

Create and modify image in memory and BitBlt the changes to the screen control
Fills the Memory DC with green and then draws a new black line
~60 frames/second draw rate

' ***************************************************************
'   This code can be used Royalty Free and Freely Distributed !
' ***************************************************************

#COMPILE EXE
#REGISTER NONE
#DIM ALL          '  This is helpful to prevent errors in coding

'Update for Chris's post #2
'Modified by Jim Fritts
'Great work Chris and thank you for sharing!
'https://forum.powerbasic.com/forum/third-party-forums/cw/cwdf/744463-win32-and-ddt-code-examples?p=744464#post744464

'Create and modify image in memory and BitBlt the changes to the screen control
'Fills the Memory DC with green and then draws a new black line
'~60 frames/second draw rate


'#INCLUDE "win32api.inc"   ' Must come first before other include files !
' *************************************************************
'                  Constants and Declares (#1)
' *************************************************************
DECLARE SUB LIB_InitColors()
DECLARE SUB LIB_DeleteBrushes()
'
%FORM1_LABEL2             = 100
%FORM1_THREADLABEL        = 105
%FORM1_BUTTON1            = 110


' // Size = 28 bytes
TYPE tagMSG DWORD
   hwnd    AS DWORD   ' HWND
   message AS DWORD   ' UINT
   wParam  AS DWORD   ' WPARAM
   lParam  AS LONG    ' LPARAM
   time    AS DWORD   ' DWORD
   pt      AS POINT   ' POINT
END TYPE

' // Size = 16 bytes
TYPE OLD_RECT_STRUCT DWORD   ' Old PB definition
   nLeft   AS LONG   ' LONG left
   nTop    AS LONG   ' LONG top
   nRight  AS LONG   ' LONG right
   nBottom AS LONG   ' LONG bottom
END TYPE

' // Size = 16 bytes
TYPE tagRECT DWORD
   left   AS LONG   ' LONG left
   top    AS LONG   ' LONG top
   right  AS LONG   ' LONG right
   bottom AS LONG   ' LONG bottom
END TYPE

' // GDI+ uses x, y, Width and Height as members instead of Left, Right, Top and Bottom
TYPE GDIP_RECT_STRUCT DWORD
   x      AS LONG   ' LONG x
   y      AS LONG   ' LONG y
   Width  AS LONG   ' LONG Width
   Height AS LONG   ' LONG Height
END TYPE

' // To allow the use of both nLeft, etc, and Left, etc.
' // Size = 16 bytes
UNION RECT
   OLD_RECT_STRUCT
   tagRECT
   GDIP_RECT_STRUCT
END UNION

' // Size = 48 bytes
TYPE WNDCLASSEXA BYTE
   cbSize        AS DWORD        ' UINT
   ' /* Win 3.x */
   style         AS DWORD        ' UINT
   lpfnWndProc   AS DWORD        ' WNDPROC
   cbClsExtra    AS LONG         ' int
   cbWndExtra    AS LONG         ' int
   hInstance     AS DWORD        ' HINSTANCE
   hIcon         AS DWORD        ' HICON
   hCursor       AS DWORD        ' HCURSOR
   hbrBackground AS DWORD        ' HBRUSH
   lpszMenuName  AS ASCIIZ PTR   ' LPCSTR
   lpszClassName AS ASCIIZ PTR   ' LPCSTR
   ' /* Win 4.0 */
   hIconSm       AS DWORD        ' HICON
END TYPE

%NULL = 0

%IDI_APPLICATION   = 32512&
%IDC_ARROW         = 32512&
%WHITE_BRUSH         = 0
%WM_SETTEXT              = &HC
%WM_ERASEBKGND           = &H14
%SRCCOPY     = &H00CC0020 ' (DWORD) dest = source
%SRCPAINT    = &H00EE0086 ' (DWORD) dest = source OR dest
%SRCAND      = &H008800C6 ' (DWORD) dest = source AND dest
%SRCINVERT   = &H00660046 ' (DWORD) dest = source XOR dest
%SRCERASE    = &H00440328 ' (DWORD) dest = source AND (NOT dest )
%NOTSRCCOPY  = &H00330008 ' (DWORD) dest = (NOT source)
%NOTSRCERASE = &H001100A6 ' (DWORD) dest = (NOT src) AND (NOT dest)
%MERGECOPY   = &H00C000CA ' (DWORD) dest = (source AND pattern)
%MERGEPAINT  = &H00BB0226 ' (DWORD) dest = (NOT source) OR dest
%PATCOPY     = &H00F00021 ' (DWORD) dest = pattern
%PATPAINT    = &H00FB0A09 ' (DWORD) dest = DPSnoo
%PATINVERT   = &H005A0049 ' (DWORD) dest = pattern XOR dest
%DSTINVERT   = &H00550009 ' (DWORD) dest = (NOT dest)
%BLACKNESS   = &H00000042 ' (DWORD) dest = BLACK
%WHITENESS   = &H00FF0062 ' (DWORD) dest = WHITE

%WM_COPYDATA                   = &H4A
%WM_CANCELJOURNAL              = &H4B
%WM_INPUTLANGUAGECHANGEREQUEST = &H50
%WM_INPUTLANGCHANGEREQUEST     = &H50
%WM_INPUTLANGUAGECHANGE        = &H51
%WM_INPUTLANGCHANGE            = &H51
%WM_TCARD                      = &H52
%WM_USERCHANGED                = &H54
%WM_NOTIFYFORMAT               = &H55

%WM_CONTEXTMENU      = &H7B
%WM_STYLECHANGING    = &H7C
%WM_STYLECHANGED     = &H7D
%WM_DISPLAYCHANGE    = &H7E

%WM_GETICON          = &H7F
%WM_SETICON          = &H80
%WM_GETDLGCODE       = &H87
%WM_SYNCPAINT        = &H88
%WM_INPUT_DEVICE_CHANGE = &H00FE
%WM_INPUT            = &HFF

%WM_KEYFIRST         = &H100
%WM_DEADCHAR         = &H103
%WM_SYSCHAR          = &H106
%WM_SYSDEADCHAR      = &H107
%WM_IME_STARTCOMPOSITION = &H010D
%WM_IME_ENDCOMPOSITION   = &H010E
%WM_IME_COMPOSITION      = &H010F
%WM_IME_KEYLAST          = &H010F
%WM_UNICHAR          = &H0109
%WM_KEYLAST          = &H0109
%UNICODE_NOCHAR      = &H0FFFF
%WM_SYSCOMMAND       = &H112
%WM_INITMENU         = &H116
%WM_INITMENUPOPUP    = &H117
%WM_MENUSELECT       = &H11F
%WM_MENUCHAR         = &H120
%WM_ENTERIDLE        = &H121
%WM_MENURBUTTONUP    = &H0122
%WM_MENUDRAG         = &H0123
%WM_MENUGETOBJECT    = &H0124
%WM_UNINITMENUPOPUP  = &H0125
%WM_MENUCOMMAND      = &H0126
%WM_CHANGEUISTATE    = &H0127
%WM_UPDATEUISTATE    = &H0128
%WM_QUERYUISTATE     = &H0129
%WM_CTLCOLORMSGBOX   = &H132
%WM_CTLCOLOREDIT     = &H133
%WM_CTLCOLORLISTBOX  = &H134
%WM_CTLCOLORBTN      = &H135
%WM_CTLCOLORDLG      = &H136
%WM_CTLCOLORSCROLLBAR = &H137
%WM_CTLCOLORSTATIC   = &H138
%WM_XBUTTONDOWN      = &H20B
%WM_XBUTTONUP        = &H20C
%WM_XBUTTONDBLCLK    = &H20D

%WM_PARENTNOTIFY     = &H210
%WM_ENTERMENULOOP    = &H211
%WM_EXITMENULOOP     = &H212

%WM_SIZING           = &H214
%WM_MOVING           = &H216

%WM_POWERBROADCAST   = &H218
%WM_DEVICECHANGE     = &H219
%WM_MDICREATE        = &H220
%WM_MDIDESTROY       = &H221
%WM_MDIACTIVATE      = &H222
%WM_MDIRESTORE       = &H223
%WM_MDINEXT          = &H224
%WM_MDIMAXIMIZE      = &H225
%WM_MDITILE          = &H226
%WM_MDICASCADE       = &H227
%WM_MDIICONARRANGE   = &H228
%WM_MDIGETACTIVE     = &H229
%WM_MDISETMENU       = &H230
%WM_DROPFILES        = &H233
%WM_MDIREFRESHMENU   = &H234

%WM_WTSSESSION_CHANGE = &H02B1
%WM_TABLET_FIRST      = &H02c0
%WM_TABLET_LAST       = &H02df

%WM_CUT               = &H300
%WM_COPY              = &H301
%WM_PASTE             = &H302
%WM_CLEAR             = &H303
%WM_UNDO              = &H304
%WM_RENDERFORMAT      = &H305
%WM_RENDERALLFORMATS  = &H306
%WM_DESTROYCLIPBOARD  = &H307
%WM_DRAWCLIPBOARD     = &H308
%WM_PAINTCLIPBOARD    = &H309
%WM_VSCROLLCLIPBOARD  = &H30A
%WM_SIZECLIPBOARD     = &H30B
%WM_ASKCBFORMATNAME   = &H30C
%WM_CHANGECBCHAIN     = &H30D
%WM_HSCROLLCLIPBOARD  = &H30E
%WM_QUERYNEWPALETTE   = &H30F
%WM_PALETTEISCHANGING = &H310
%WM_PALETTECHANGED    = &H311
%WM_HOTKEY            = &H312
%WM_PRINT             = &H317
%WM_PRINTCLIENT       = &H318
%WM_APPCOMMAND        = &H319
%WM_THEMECHANGED      = &H31A
%WM_HANDHELDFIRST     = &H0358
%WM_HANDHELDLAST      = &H035F
%WM_AFXFIRST          = &H0360
%WM_AFXLAST           = &H037F
%WM_PENWINFIRST       = &H380
%WM_PENWINLAST        = &H38F
%WM_APP               = &H08000

%PM_NOREMOVE    = &H0
%PM_REMOVE      = &H1

' --------------------------------------------------
DECLARE SUB ShowDialog_Form1(BYVAL hParent AS LONG)
DECLARE CALLBACK FUNCTION Form1_DLGPROC
DECLARE SUB Open_Form1_Thread1()
DECLARE SUB Close_Form1_Thread1()
DECLARE SUB RegisterControl ()
DECLARE FUNCTION CreateControl (BYVAL hParent AS LONG, BYVAL nID AS LONG, _
                                BYVAL AX AS LONG, BYVAL AY AS LONG, _
                                BYVAL AW AS LONG, BYVAL AH AS LONG) AS LONG

' --------------------------------------------------
' ------------------------------------------------

DECLARE CALLBACK FUNCTION CBF_FORM1_BUTTON1()




' *************************************************************
'               Application Globals Variables (#2)
' *************************************************************
'
GLOBAL App_Brush() AS LONG
GLOBAL App_Color() AS LONG
'
GLOBAL hForm1    AS LONG '???? Dialog handle
GLOBAL App_X, App_Y, App_W, App_H AS LONG
'
GLOBAL hForm1_Thread1 AS LONG
GLOBAL End_Form1_Thread1 AS LONG
GLOBAL App_hCtrl AS LONG
'
GLOBAL giRunningEraseBG AS LONG
GLOBAL ghBgBrush        AS DWORD

' *************************************************************
'                    Application Entrance
' *************************************************************

FUNCTION PBMAIN
    LOCAL iCount AS LONG
    LOCAL MVal AS LONG
    LOCAL Msg AS tagMsg

    ghBgBrush = CreateSolidBrush(RGB(0,255,0))

    End_Form1_Thread1 = 0   ' no thread
    RegisterControl
    LIB_InitColors
    ShowDialog_Form1 0

    DO
        MVal = GetMessageA(Msg, %NULL, 0, 0)
        IF MVal = -1 THEN EXIT DO    ' error was returned must exit
        IF MVal = 0 THEN EXIT DO
        TranslateMessage Msg
        DispatchMessageA Msg
    LOOP

    ' can not use DDT message loop since it processes all available messages
    '    DO
    '        DIALOG DOEVENTS TO iCount
    '    LOOP UNTIL iCount=0
    DeleteObject ghBgBrush
    LIB_DeleteBrushes
END FUNCTION


' *************************************************************
'                    Application Dialogs (#3)
' *************************************************************

SUB ShowDialog_Form1(BYVAL hParent AS LONG)
    LOCAL dwStyle, ExStyle, hCtrl AS LONG
    LOCAL N, CT AS LONG        '  Variables used for Reading Data in Arrays for Listbox and Combobox

    '   hParent = 0 if no parent Dialog
    dwStyle = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
    ExStyle = 0
    DIALOG NEW PIXELS, hParent, "Your Dialog", 0, 0,  267,  177, dwStyle, ExStyle TO hForm1
    ' ------------------------------------------------------------
    ' define location of custom control in pixels
    App_X = 88
    App_Y = 22
    App_W = 155
    App_H = 116
    ' ------------------------------------------------------------
    CONTROL ADD LABEL, hForm1,  %FORM1_LABEL2,  "", 21, 150, 221, 16, _
        %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER OR %WS_BORDER
    CONTROL ADD "Button", hForm1,  %FORM1_BUTTON1,  "Start", 21, 22, 53, 20, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTON1
    DIALOG SHOW MODELESS hForm1 , CALL Form1_DLGPROC
END SUB
'
' *************************************************************
'                             Dialog Callback Procedure
'                             for Form Form1
'                             uses Global Handle - hForm1
' *************************************************************
'
CALLBACK FUNCTION Form1_DLGPROC
    SELECT CASE CBMSG
        CASE %WM_CTLCOLORMSGBOX, %WM_CTLCOLORBTN, %WM_CTLCOLOREDIT,_
             %WM_CTLCOLORSTATIC, %WM_CTLCOLORSCROLLBAR, %WM_CTLCOLORLISTBOX

            ' Control colors
            SELECT CASE GetDlgCtrlID(CBLPARAM)
                CASE  %FORM1_LABEL2
                    SetTextColor CBWPARAM, App_Color( 0)
                    SetBkColor   CBWPARAM, App_Color( 26)
                    FUNCTION = App_Brush( 26)

                CASE  %FORM1_THREADLABEL
                    SetTextColor CBWPARAM, App_Color( 0)
                    SetBkColor   CBWPARAM, App_Color( 30)
                    FUNCTION = App_Brush( 30)

                CASE ELSE
                    FUNCTION = 0

            END SELECT

      CASE %WM_SYSCOMMAND
          IF (CBWPARAM AND &HFFF0) = %SC_CLOSE THEN
             IF End_Form1_Thread1 = -1 THEN
                Close_Form1_Thread1
             END IF
          END IF

      CASE %WM_DESTROY
          PostQuitMessage 0
      CASE ELSE
    END SELECT
END FUNCTION
'
' *******************************************************************
' *                         Library Code   *
' ********************************************************************
'
SUB LIB_InitColors()
    DATA         0,  8388608,    32768,  8421376,      196,  8388736,    16512, 12895428
    DATA   8421504, 16711680,    65280, 16776960,      255, 16711935,    65535, 16777215
    DATA  10790052, 16752768, 10551200, 16777120, 10526975, 16752895, 10551295, 13948116
    DATA  11842740, 16768188, 14483420, 16777180, 14474495, 16768255, 14483455, 15000804

    LOCAL T, RGBVal AS LONG
    REDIM App_Brush(0 TO 31)
    REDIM App_Color(0 TO 31)

    FOR T = 0 TO 31
        RGBVal = VAL(READ$(T +1))
        App_Brush(T) = CreateSolidBrush(RGBVal)
        App_Color(T) = RGBVal
    NEXT T
END SUB

' -------------------------------------------------------------

SUB LIB_DeleteBrushes()
    LOCAL T  AS LONG

    FOR T = 0 TO 31
        DeleteObject App_Brush(T)
    NEXT T
END SUB

' -------------------------------------------------------------

' *************************************************************
'   Application Callback Functions (or Subs) for Controls (#4)
' *************************************************************
'
'
' ------------------------------------------------
CALLBACK FUNCTION CBF_FORM1_BUTTON1
    STATIC Flag AS LONG
    IF CBCTLMSG = %BN_CLICKED THEN
        IF Flag = 0 THEN
            Flag = 1
            Open_Form1_Thread1
            CONTROL SET TEXT hForm1, %FORM1_BUTTON1, "Stop"
        ELSE
            Flag = 0
            Close_Form1_Thread1
            CONTROL SET TEXT hForm1, %FORM1_BUTTON1, "Start"
            UpdateWindow hForm1
        END IF
    END IF
END FUNCTION
' ------------------------------------------------
'
%WM_MYTIMER         =   %WM_USER + 400
'
THREAD FUNCTION Form1_Thread1(BYVAL hDlg AS LONG) AS LONG
    LOCAL MVal         AS LONG
    LOCAL Msg          AS tagMsg
    LOCAL hCtrl        AS LONG
    LOCAL TimesThrough AS LONG

    End_Form1_Thread1 = -1   ' thread active
    hCtrl = CreateControl(hDlg, %FORM1_THREADLABEL , App_X, App_Y, App_W, App_H)

    ' Message Loop
    App_hCtrl = hCtrl
    DO
        IF IsWindow(hCtrl) THEN
            MVal = PeekMessageA(Msg, %NULL, 0, 0, %PM_REMOVE)
            IF MVal <> 0 THEN
                TranslateMessage Msg
                DispatchMessageA Msg
            END IF

            'Control how fast the screen is refreshed
            INCR TimesThrough
            IF TimesThrough >= 300000 AND _   'TimesThrough at 10,000,000 = 2 frames/second
               giRunningEraseBG = 0 THEN      'TimesThrough at 300,000 = 63 frames/second
                TimesThrough = 0
                PostMessageA hCtrl, %WM_MYTIMER, 0, 0
            END IF

        END IF
        IF End_Form1_Thread1 = 1 THEN
            EXIT DO
        END IF
    LOOP
    FUNCTION=1
END FUNCTION
'
' -------------------------------

SUB Open_Form1_Thread1
  LOCAL idThreadForm1        AS LONG

  THREAD CREATE Form1_Thread1(hForm1) TO idThreadForm1
  THREAD CLOSE idThreadForm1 TO idThreadForm1
END SUB
'
'
SUB Close_Form1_Thread1()
    LOCAL EFlag, N  AS LONG
    ' ----------------------------------------------
    ' DestroyWindow does not work for some reason
    ' when used from either the primary thread or
    ' the actual thread that created the control.
    ' WM_CLOSE is the only thing that works !!!
    ' ----------------------------------------------

    SendMessageA App_hCtrl, %WM_CLOSE, 0, 0
    End_Form1_Thread1 = 1
    N = 0
    DO
        EFlag = 0
        THREAD STATUS hForm1_Thread1 TO EFlag
        N = N + 1
        IF N > 10000000 THEN EXIT DO
        IF EFlag <> &H103 THEN EXIT DO
    LOOP
    THREAD CLOSE hForm1_Thread1 TO N
    End_Form1_Thread1 = 0
END SUB
'
' --------------------------------------------------------------------------------------
SUB RegisterControl ()
    LOCAL winclass    AS wndclassExA
    LOCAL szClassName AS ASCIIZ * 32
    szClassName            = "MYCONTROL32"
    winclass.cbSize        = SIZEOF(winclass)
    winclass.style         = %CS_OWNDC OR %CS_HREDRAW OR %CS_VREDRAW
    winclass.lpfnWndProc   = CODEPTR(ControlWindowProc)
    winclass.cbClsExtra    = 0
    winclass.cbWndExtra    = 0
    winclass.hInstance     = GetModuleHandleA(BYVAL %NULL)
    winclass.hIcon         = LoadIconA(%NULL, BYVAL %IDI_APPLICATION)
    winclass.hCursor       = LoadCursorA( %NULL, BYVAL %IDC_ARROW )
    winclass.hbrBackground = GetStockObject(%WHITE_BRUSH)
    winclass.lpszMenuName  = %NULL
    winclass.lpszClassName = VARPTR( szClassName )
    winclass.hIconSm       = LoadIconA(%NULL, BYVAL %IDI_APPLICATION)
    RegisterClassExA winclass
END SUB
'
' --------------------------------------------------------------------------------------
'
FUNCTION CreateControl (BYVAL hParent AS LONG, BYVAL nID AS LONG, _
                        BYVAL AX AS LONG, BYVAL AY AS LONG, _
                        BYVAL AW AS LONG, BYVAL AH AS LONG) AS LONG
    LOCAL szTemp AS ASCIIZ * 80
    LOCAL hCtrl, dwStyle, ExStyle AS LONG

    szTemp = "Move Mouse over me !"
    dwStyle = %WS_CHILD OR %WS_VISIBLE OR %WS_BORDER
    ExStyle = 0
    szTemp = "Move Mouse over me !!!"
    hCtrl = CreateWindowEXA(ExStyle, _   ' Extended Window Style
                     "MYCONTROL32", _   ' window class name
                            szTemp, _   ' window caption
                           dwStyle, _   ' window style
                                AX, _   ' initial x position
                                AY, _   ' initial y position
                                AW, _   ' initial width
                                AH, _   ' initial height
                           hParent, _   ' parent window handle
                               nID, _   ' window ID
     GetModuleHandleA(BYVAL %NULL), _   ' program instance handle
                       BYVAL %NULL)     ' creation parameters
    FUNCTION = hCtrl
END FUNCTION
'
' --------------------------------------------------------------------------------------
'
FUNCTION ControlWindowProc(BYVAL hWnd AS LONG, BYVAL Msg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
    STATIC X1, Y1, X2, Y2, X3, Y3, Flip AS LONG
    STATIC StartFrame!, EndFrame!, Frames!
    STATIC MemDC, hBmp, OldBmp AS LONG

    SELECT CASE Msg

        CASE %WM_CREATE
            DIM R AS RECT
            X1 = 0
            Y1 = 0
            GetClientRect hWnd, R
            X2 = R.nRight - 1
            Y2 = R.nBottom - 1

        CASE %WM_MYTIMER

            IF X1 = 0 AND X3 = 0 THEN
                StartFrame! = TIMER
                Frames! = 0
            END IF

            InvalidateRect hWnd, BYVAL %NULL, 1
            UpdateWindow hWnd
            INCR Frames!

            INCR X3
            IF X3 > X2 THEN
                X3 = X2
                INCR X1
                IF X1 > X2 THEN
                    X1 = 0
                    X3 = 0
                    EndFrame! = TIMER - StartFrame!
                    DIM zText2 AS ASCIIZ *80
                    zText2 = STR$(Frames!/EndFrame!) + " frames/sec."
                    CONTROL SEND hForm1, %FORM1_LABEL2, %WM_SETTEXT, 0, VARPTR(zText2)
                END IF
            END IF
            EXIT FUNCTION

        CASE %WM_ERASEBKGND
            DIM hDC AS LONG
            DIM RR  AS RECT
            LOCAL MyX AS LONG
            LOCAL MyY AS LONG
            LOCAL PointColor AS DWORD

            IF giRunningEraseBG = 0 THEN
                giRunningEraseBG = 1

                hDC = wParam
                GetClientRect hWnd, RR
                IF MemDC = 0 THEN
                    MemDC = CreateCompatibleDC(hDC)
                    hBmp = CreateCompatibleBitmap(hDC, RR.nRight, RR.nBottom)
                    OldBmp = SelectObject(MemDC, hBmp)
                    PatBlt MemDC, 0, 0, RR.nRight, RR.nBottom, %WHITENESS
                END IF

                'IF X3 = 0 THEN
                '    PatBlt MemDC, 0, 0, RR.nRight, RR.nBottom, %WHITENESS
                'END IF

                FillRect MemDC, RR, ghBgBrush

            '    FOR MyY = 0 TO RR.nBottom
            '        FOR MyX = 0 TO RR.nRight
            '            'PointColor = GetPixel(MemDC, MyX, MyY)
            '            'if PointColor <> RGB(0,255,0) then
            '            '    SetPixel MemDC, MyX, MyY, RGB(0,255,0)
            '            'end if
            '        NEXT MyX
            '    NEXT MyY

                MoveToEx MemDC, X1, Y1, BYVAL %NULL
                LineTo MemDC, X3 , Y2 + 1


                BitBlt hDC, 0, 0, RR.nRight, RR.nBottom, MemDC, 0, 0, %SRCCOPY

                giRunningEraseBG = 0
            END IF
            EXIT FUNCTION

        CASE %WM_MOUSEMOVE
            DIM zText AS ASCIIZ *80
            zText = STR$(LO(WORD,lParam)) + "," + STR$(HI(WORD, lParam))
            CONTROL SEND hForm1, %FORM1_LABEL2, %WM_SETTEXT,0, VARPTR(zText)

        CASE %WM_DESTROY
            IF MemDC <> 0 THEN
                SelectObject MemDC, OldBmp
                DeleteObject hBmp
                DeleteDC MemDC
                MemDC = 0
                'Reset the drawing location
                X3 = 0
                X1 = 0
                X2 = 0
            END IF
            ' Indicate whether control is successfully destroyed
            BEEP

        CASE ELSE

    END SELECT
    FUNCTION = DefWindowProcA(hWnd, Msg, wParam, lParam)
END FUNCTION



'////////////////////////////////////////////
DECLARE FUNCTION GetMessageA IMPORT "USER32.DLL" ALIAS "GetMessageA" ( _
   BYREF lpMsg AS tagMSG _                              ' __out LPMSG lpMsg
 , BYVAL hWnd AS DWORD _                                ' __in_opt HWND hWnd
 , BYVAL wMsgFilterMin AS DWORD _                       ' __in UINT wMsgFilterMin
 , BYVAL wMsgFilterMax AS DWORD _                       ' __in UINT wMsgFilterMax
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION TranslateMessage IMPORT "USER32.DLL" ALIAS "TranslateMessage" ( _
   BYREF lpMsg AS tagMSG _                              ' __in CONST MSG *lpMsg
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION DispatchMessageA IMPORT "USER32.DLL" ALIAS "DispatchMessageA" ( _
   BYREF lpMsg AS tagMSG _                              ' __in CONST MSG *lpMsg
 ) AS LONG                                              ' LRESULT

DECLARE FUNCTION GetDlgCtrlID IMPORT "USER32.DLL" ALIAS "GetDlgCtrlID" ( _
   BYVAL hWnd AS DWORD _                                ' __in HWND hWnd
 ) AS LONG                                              ' int

DECLARE FUNCTION SetTextColor IMPORT "GDI32.DLL" ALIAS "SetTextColor" ( _
   BYVAL hdc AS DWORD _                                 ' __in HDC hdc
 , BYVAL color AS DWORD _                               ' __in COLORREF color
 ) AS DWORD                                             ' COLORREF

DECLARE FUNCTION SetBkColor IMPORT "GDI32.DLL" ALIAS "SetBkColor" ( _
   BYVAL hdc AS DWORD _                                 ' __in HDC hdc
 , BYVAL color AS DWORD _                               ' __in COLORREF color
 ) AS DWORD                                             ' COLORREF

DECLARE SUB PostQuitMessage IMPORT "USER32.DLL" ALIAS "PostQuitMessage" ( _
   BYVAL nExitCode AS LONG _                            ' __in int nExitCode
 )                                                      ' VOID

DECLARE FUNCTION CreateSolidBrush IMPORT "GDI32.DLL" ALIAS "CreateSolidBrush" ( _
   BYVAL color AS DWORD _                               ' __in COLORREF color
 ) AS DWORD                                             ' HBRUSH

DECLARE FUNCTION DeleteObject IMPORT "GDI32.DLL" ALIAS "DeleteObject" ( _
   BYVAL ho AS DWORD _                                  ' __in HGDIOBJ ho
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION UpdateWindow IMPORT "USER32.DLL" ALIAS "UpdateWindow" ( _
   BYVAL hWnd AS DWORD _                                ' __in HWND hWnd
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION IsWindow IMPORT "USER32.DLL" ALIAS "IsWindow" ( _
   BYVAL hWnd AS DWORD _                                ' __in_opt HWND hWnd
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION PeekMessageA IMPORT "USER32.DLL" ALIAS "PeekMessageA" ( _
   BYREF lpMsg AS tagMSG _                              ' __out LPMSG lpMsg
 , BYVAL hWnd AS DWORD _                                ' __in_opt HWND hWnd
 , BYVAL wMsgFilterMin AS DWORD _                       ' __in UINT wMsgFilterMin
 , BYVAL wMsgFilterMax AS DWORD _                       ' __in UINT wMsgFilterMax
 , BYVAL wRemoveMsg AS DWORD _                          ' __in UINT wRemoveMsg
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION PostMessageA IMPORT "USER32.DLL" ALIAS "PostMessageA" ( _
   BYVAL hWnd AS DWORD _                                ' __in_opt HWND hWnd
 , BYVAL Msg AS DWORD _                                 ' __in UINT Msg
 , BYVAL wParam AS DWORD  _                             ' __in WPARAM wParam
 , BYVAL lParam AS LONG _                               ' __in LPARAM lParam
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION SendMessageA IMPORT "USER32.DLL" ALIAS "SendMessageA" ( _
   BYVAL hWnd AS DWORD _                                ' __in HWND hWnd
 , BYVAL Msg AS DWORD _                                 ' __in UINT Msg
 , BYVAL wParam AS DWORD _                              ' __in WPARAM wParam
 , BYVAL lParam AS LONG _                               ' __in LPARAM lParam
 ) AS LONG                                              ' LRESULT

DECLARE FUNCTION GetModuleHandleA IMPORT "KERNEL32.DLL" ALIAS "GetModuleHandleA" ( _
   BYREF lpModuleName AS ASCIIZ _                       ' __in LPCSTR lpModuleName
 ) AS DWORD                                             ' HMODULE

DECLARE FUNCTION LoadIconA IMPORT "USER32.DLL" ALIAS "LoadIconA" ( _
   BYVAL hInstance AS DWORD _                           ' __in_opt HINSTANCE hInstance
 , BYREF lpIconName AS ASCIIZ _                         ' __in LPCSTR lpIconName
 ) AS DWORD                                             ' HICON

DECLARE FUNCTION LoadCursorA IMPORT "USER32.DLL" ALIAS "LoadCursorA" ( _
   BYVAL hInstance AS DWORD _                           ' __in_opt HINSTANCE hInstance
 , BYREF lpCursorName AS ASCIIZ _                       ' __in LPCSTR lpCursorName
 ) AS DWORD                                             ' HCURSOR

DECLARE FUNCTION GetStockObject IMPORT "GDI32.DLL" ALIAS "GetStockObject" ( _
   BYVAL i AS LONG _                                    ' __in int i
 ) AS DWORD                                             ' HGDIOBJ

DECLARE FUNCTION RegisterClassExA IMPORT "USER32.DLL" ALIAS "RegisterClassExA" ( _
   BYREF lpwcx AS WNDCLASSEXA _                         ' __in CONST WNDCLASSEXA *lpwcx
 ) AS WORD                                              ' ATOM

DECLARE FUNCTION CreateWindowExA IMPORT "USER32.DLL" ALIAS "CreateWindowExA" ( _
   BYVAL dwExStyle AS DWORD _                           ' __in DWORD dwExStyle
 , BYREF lpClassName AS ASCIIZ _                        ' __in_opt LPCSTR lpClassName
 , BYREF lpWindowName AS ASCIIZ _                       ' __in_opt LPCSTR lpWindowName
 , BYVAL dwStyle AS DWORD _                             ' __in DWORD dwStyle
 , BYVAL X AS LONG _                                    ' __in int X
 , BYVAL Y AS LONG _                                    ' __in int Y
 , BYVAL nWidth AS LONG _                               ' __in int nWidth
 , BYVAL nHeight AS LONG _                              ' __in int nHeight
 , OPTIONAL BYVAL hwndParent AS DWORD _                 ' __in_opt HWND hwndParent
 , OPTIONAL BYVAL hMenu AS DWORD _                      ' __in_opt HMENU hMenu
 , OPTIONAL BYVAL hInstance AS DWORD _                  ' __in_opt HINSTANCE hInstance
 , OPTIONAL BYREF lpParam AS ANY _                      ' __in_opt LPVOID lpParam
 ) AS DWORD                                             ' HWND

DECLARE FUNCTION ShowWindow IMPORT "USER32.DLL" ALIAS "ShowWindow" ( _
   BYVAL hWnd AS DWORD _                                ' __in HWND hWnd
 , BYVAL nCmdShow AS LONG _                             ' __in int nCmdShow
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION UpdateWindow IMPORT "USER32.DLL" ALIAS "UpdateWindow" ( _
   BYVAL hWnd AS DWORD _                                ' __in HWND hWnd
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION GetClientRect IMPORT "USER32.DLL" ALIAS "GetClientRect" ( _
   BYVAL hWnd AS DWORD _                                ' __in HWND hWnd
 , BYREF lpRect AS RECT _                               ' __out LPRECT lpRect
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION InvalidateRect IMPORT "USER32.DLL" ALIAS "InvalidateRect" ( _
   BYVAL hWnd AS DWORD _                                ' __in_opt HWND hWnd
 , BYREF lpRect AS RECT _                               ' __in_opt CONST RECT *lpRect
 , BYVAL bErase AS LONG _                               ' __in BOOL bErase
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION CreateCompatibleDC IMPORT "GDI32.DLL" ALIAS "CreateCompatibleDC" ( _
   OPTIONAL BYVAL hdc AS DWORD _                        ' __in_opt HDC hdc
 ) AS DWORD                                             ' HDC

DECLARE FUNCTION CreateCompatibleBitmap IMPORT "GDI32.DLL" ALIAS "CreateCompatibleBitmap" ( _
   BYVAL hdc AS DWORD _                                 ' __in HDC hdc
 , BYVAL cx AS LONG _                                   ' __in int cx
 , BYVAL cy AS LONG _                                   ' __in int cy
 ) AS DWORD                                             ' HBITMAP

DECLARE FUNCTION SelectObject IMPORT "GDI32.DLL" ALIAS "SelectObject" ( _
   BYVAL hdc AS DWORD _                                 ' __in HDC hdc
 , BYVAL h AS DWORD _                                   ' __in HGDIOBJ h
 ) AS DWORD                                             ' HGDIOBJ

DECLARE FUNCTION PatBlt IMPORT "GDI32.DLL" ALIAS "PatBlt" ( _
   BYVAL hdc AS DWORD _                                 ' __in HDC hdc
 , BYVAL x AS LONG _                                    ' __in int x
 , BYVAL y AS LONG _                                    ' __in int y
 , BYVAL w AS LONG _                                    ' __in int w
 , BYVAL h AS LONG _                                    ' __in int h
 , BYVAL rop AS DWORD _                                 ' __in DWORD rop
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION MoveToEx IMPORT "GDI32.DLL" ALIAS "MoveToEx" ( _
   BYVAL hdc AS DWORD _                                 ' __in HDC hdc
 , BYVAL x AS LONG _                                    ' __in int x
 , BYVAL y AS LONG _                                    ' __in int y
 , OPTIONAL BYREF lppt AS POINT _                       ' __out_opt LPPOINT lppt
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION LineTo IMPORT "GDI32.DLL" ALIAS "LineTo" ( _
   BYVAL hdc AS DWORD _                                 ' __in HDC hdc
 , BYVAL x AS LONG _                                    ' __in int x
 , BYVAL y AS LONG _                                    ' __in int y
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION BitBlt IMPORT "GDI32.DLL" ALIAS "BitBlt" ( _
   BYVAL hdc AS DWORD _                                 ' __in HDC hdc
 , BYVAL x AS LONG _                                    ' __in int x
 , BYVAL y AS LONG _                                    ' __in int y
 , BYVAL cx AS LONG _                                   ' __in int cx
 , BYVAL cy AS LONG _                                   ' __in int cy
 , BYVAL hdcSrc AS DWORD _                              ' __in_opt HDC hdcSrc
 , BYVAL x1 AS LONG _                                   ' __in int x1
 , BYVAL y1 AS LONG _                                   ' __in int y1
 , BYVAL rop AS DWORD _                                 ' __in DWORD rop
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION CreateSolidBrush IMPORT "GDI32.DLL" ALIAS "CreateSolidBrush" ( _
   BYVAL color AS DWORD _                               ' __in COLORREF color
 ) AS DWORD                                             ' HBRUSH

DECLARE FUNCTION DeleteDC IMPORT "GDI32.DLL" ALIAS "DeleteDC" ( _
   BYVAL hdc AS DWORD _                                 ' __in HDC hdc
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION DefWindowProcA IMPORT "USER32.DLL" ALIAS "DefWindowProcA" ( _
   BYVAL hWnd AS DWORD _                                ' __in HWND hWnd
 , BYVAL Msg AS DWORD _                                 ' __in UINT Msg
 , BYVAL wParam AS DWORD _                              ' __in WPARAM wParam
 , BYVAL lParam AS LONG _                               ' __in LPARAM lParam
 ) AS LONG                                              ' LRESULT

DECLARE FUNCTION FillRect IMPORT "USER32.DLL" ALIAS "FillRect" ( _
   BYVAL hDC AS DWORD _                                 ' __in HDC hDC
 , BYREF lprc AS RECT _                                 ' __in CONST RECT *lprc
 , BYVAL hbr AS DWORD _                                 ' __in HBRUSH hbr
 ) AS LONG                                              ' int

[Chris Boss]

Here is an include file which has a routine which allows you to load JPeg,GIF and PNG images using GDIplus.
The beauty of this routine is that you don't need any GDI+ API include files to use it. It is a self contained include file of its own.

The routine can load images for either DDT or SDK coding.

I finally got it working for DDT, but there is still one small problem with it. There is a white line at the top of the image and I have no idea why.

I don't know what DDT does with its own Bitmaps, but I had to go through loops to convert the image to a DDT Bitmap. I had to load the image as a DIB and using pointers run the image through a conversion routine before BitBlt'ing it to a DDt Bitmap.

If anyone can figure out what the problem is (the white line) please email me or post the solution so I can fix the problem.

Here are the routines in the include file

GDIP_GetImageSize F$, W&, H&

Reads an image file and returns the size (width and height) in pixels, without loading.

F$ is the filename (full path) of any Image file windows supports (ie. JPeg, PNG, GIF)
W& is a long variable to return the width in pixels
H& is a long variable to return the height in pixels

hBmp& = GDIP_LoadImage(DMode&, F$, W&, H&, QFlag&)

Loads an image file (JPeg,GIF or PNG)

DMode& if non-zero (1) makes function return a DDT Bitmap, rather than an API Bitmap
F$ is the filename (full path) of any Image file windows supports (ie. JPeg, PNG, GIF)
W& is the requested width of the image (in pixels)
H& is the requested height of the image (in pixels)
QFlag& if set to non-zero (1) requests best quality possible image

If W& and H& are set to -1 (or even zero) then the routine will use the actual size of the image on file.

The return value is a Bitmap handle.
If DMode& is non-zero (1) then the handle is a DDT Bitmap handle which can only be used with DDT Graphic commands.
If DMode& is zero, then the handle is an API Bitmap handle, which can only be used with the API and not DDT Graphic commands.

The code is based on code written by Dan Ginzel.
His code can be found here: http://chrisboss.hypermart.net/ubb/F...ML/000002.html

Here is the actual code in the EZ include file:

' Public domain
' conversion of code originally by Dan Ginzel
' see: http://chrisboss.hypermart.net/ubb/Forum36/HTML/000002.html
' requires no include files for GDIplus
DECLARE FUNCTION GdiplusStartupX LIB "GDIPLUS.DLL" ALIAS "GdiplusStartup" (BYREF token AS DWORD, BYVAL lpGDI_I AS DWORD, BYVAL lpGDI_O AS DWORD) AS LONG
DECLARE FUNCTION GdipLoadImageFromFileX LIB "GDIPLUS.DLL" ALIAS "GdipLoadImageFromFile" (BYVAL pFilename AS STRING, BYREF pImage AS DWORD) AS LONG
DECLARE FUNCTION GdipGetImageDimensionX LIB "GDIPLUS.DLL" ALIAS "GdipGetImageDimension" (BYVAL pImage AS DWORD, BYREF nWidth AS SINGLE, BYREF nHeight AS SINGLE) AS LONG
DECLARE FUNCTION GdipCreateFromHDCX LIB "GDIPLUS.DLL" ALIAS "GdipCreateFromHDC" ( BYVAL hDC AS LONG, BYREF graphics AS DWORD) AS LONG
DECLARE FUNCTION GdipSetInterpolationModeX LIB "GDIPLUS.DLL" ALIAS "GdipSetInterpolationMode" (BYVAL graphics AS DWORD, BYVAL interpolationMode AS LONG) AS LONG
DECLARE FUNCTION GdipDrawImageRectIX LIB "GDIPLUS.DLL" ALIAS "GdipDrawImageRectI" (BYVAL graphics AS DWORD, BYVAL pImage AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG) AS LONG
DECLARE FUNCTION GdipDisposeImageX LIB "GDIPLUS.DLL" ALIAS "GdipDisposeImage" ( BYVAL pImage AS DWORD) AS LONG
DECLARE SUB GdiplusShutdownX LIB "GDIPLUS.DLL" ALIAS "GdiplusShutdown" ( BYVAL token AS DWORD)

SUB GDIP_GetImageSize(BYVAL F$, W&,H&)
     LOCAL GDIToken AS LONG, Picture AS STRING, Result AS LONG, pImage AS DWORD
     LOCAL hDC AS LONG, pGraphics AS LONG, QMode AS LONG, RV$, PWidth AS SINGLE, PHeight AS SINGLE
     LOCAL GDI_S() AS DWORD
     RV$=""
     DIM GDI_S(1 TO 4)   ' use instead of GdiplusStartupInput structure
     GDI_S(1)=1          ' version
     F$=UCODE$(TRIM$(F$))
     W&=0
     H&=0
     IF GDIplusStartupX(GDItoken, BYVAL VARPTR(GDI_S(1)), BYVAL 0)=0 THEN
          Result = GDIPLoadImageFromFileX(F$, pImage)
          GDIPGetImageDimensionX pImage, PWidth, PHeight
          W&=PWidth
          H&=PHeight
          IF pImage<>0 THEN GDIPDisposeImageX(pImage)
          GDIplusShutdownX GDItoken
     END IF
END SUB

FUNCTION GDIP_LoadImage(BYVAL DMode&, BYVAL F$, BYVAL W&, BYVAL H&, BYVAL QFlag&) AS DWORD
     LOCAL GDIToken AS LONG, Picture AS DWORD, Result AS LONG, pImage AS DWORD
     LOCAL hDC AS DWORD, pGraphics AS LONG, QMode AS LONG, RV AS DWORD, PWidth AS SINGLE, PHeight AS SINGLE, hOldBmp AS DWORD
     LOCAL GDI_S() AS DWORD, hDCD AS DWORD
     LOCAL BM AS BITMAPINFO, PA AS DWORD, BP AS BYTE PTR, LX&,LY&, Pad&, BRow&
     REGISTER BX&, BY&
     RV=0
     DIM GDI_S(1 TO 4)   ' use instead of GdiplusStartupInput structure
     GDI_S(1)=1          ' version
     F$=UCODE$(TRIM$(F$))
     Picture=0
     IF GDIplusStartupX(GDItoken, BYVAL VARPTR(GDI_S(1)), BYVAL 0)=0 THEN
          Result = GDIPLoadImageFromFileX(F$, pImage)
          GDIPGetImageDimensionX pImage, PWidth, PHeight
          IF W&>0 THEN PWidth=W&
          IF H&>0 THEN PHeight=H&
          hDCD = GetDC(%HWND_DESKTOP)
          hDC=CreateCompatibleDC(hDCD)
          GOSUB MakeDIB
          ReleaseDC %HWND_DESKTOP, hDCD
          IF hDC<>0 THEN
               hOldBmp=SelectObject(hDC,Picture)
               IF QFlag& THEN
                    QMode=2
               ELSE
                    QMode=1
               END IF
               Result = GDIPCreateFromHDCX(hDC, pGraphics)
               Result = GDIPSetInterpolationModeX(pGraphics, QMode)
               Result = GDIPDrawImageRectIX(pGraphics, pImage, 0, 0, PWidth, PHeight)
          END IF
          IF pImage<>0 THEN GDIPDisposeImageX(pImage)
          GDIplusShutdownX GDItoken
          IF hDC<>0 THEN
               IF DMode&<>0 THEN
                    GOSUB SwapRedBlue
                    GOSUB ConvertToDDTGraphic
                    DeleteDC hDC
               ELSE
                    SelectObject hDC, hOldBmp
                    DeleteDC hDC
               END IF
          END IF
          RV=Picture

     END IF
     FUNCTION=RV
     EXIT FUNCTION

MakeDDB:
     Picture=CreateCompatibleBitmap(hDCD,INT(PWidth),INT(PHeight))
RETURN

MakeDIB:
     BM.bmiHeader.biSize=SIZEOF(BM.bmiHeader)
     BM.bmiHeader.biWidth=INT(PWidth)
     BM.bmiHeader.biHeight=-INT(PHeight)    ' pass a negative value for a topdown Bitmap
     BM.bmiHeader.biPlanes=1
     BM.bmiHeader.biBitCount=24
     BM.bmiHeader.biCompression=%BI_RGB
     Picture=CreateDIBSection (hDCD, BM, %DIB_RGB_COLORS, VARPTR(PA), %NULL, %NULL)
RETURN

SwapRedBlue:
     GDIFlush
     LX&=INT(PWidth)
     BRow&=LX&*3
     Pad&=BRow& MOD 4
     IF Pad&<>0 THEN Pad&=4-Pad&
     LX&=LX&-1
     LY&=INT(PHeight)-1
     BP=PA
     FOR BY&=0 TO LY&
          FOR BX&=0 TO LX&
               @BP[0][email protected][0]
               @BP[1][email protected][1]
               @BP[2][email protected][2]
               SWAP @BP[0],@BP[2]
               BP=BP+3
          NEXT BX&
          BP=BP+Pad&
     NEXT BY&
RETURN

ConvertToDDTGraphic:
     LOCAL hBmp AS DWORD, hGDC AS DWORD, MapMode&
     GRAPHIC BITMAP NEW INT(PWidth),INT(PHeight) TO hBmp
     GRAPHIC ATTACH hBmp,0
     GRAPHIC SET OVERLAP 1
     GRAPHIC SCALE PIXELS
     GRAPHIC GET DC TO hGDC
     bitBlt hGDC,0,0,INT(PWidth),INT(PHeight), hDC, 0,0,%SRCCOPY
     GRAPHIC DETACH
     SelectObject hDC, hOldBmp
     DeleteObject Picture
     Picture=hBmp
RETURN
END FUNCTION

[Chris Boss]

This example demonstrates how to make Windows drag a child dialog around simply by sending it fake messages when the mouse button goes down.

Basically I am converting the WM_LBUTTONDOWN message to a WM_NCLBUTTONDOWN message (which does the dragging) by sending a fake message to the dialog. Its a neat trick!

#COMPILE EXE
#REGISTER NONE
#DIM ALL
#INCLUDE "win32api.inc"
DECLARE SUB LIB_InitColors()
DECLARE SUB LIB_DeleteBrushes()
' --------------------------------------------------
%FORM1_LABEL1             = 100
' --------------------------------------------------
DECLARE SUB ShowDialog_Form1()
DECLARE CALLBACK FUNCTION Form1_DLGPROC
DECLARE CALLBACK FUNCTION Form1_DLGPROC2
' --------------------------------------------------
GLOBAL App_Brush&()
GLOBAL App_Color&()
GLOBAL hForm1&    ' Dialog handle
GLOBAL hForm2&
'
FUNCTION PBMAIN
    LOCAL Count&
    LIB_InitColors
    ShowDialog_Form1
    DO
        DIALOG DOEVENTS TO Count&
    LOOP UNTIL Count&=0
    LIB_DeleteBrushes
END FUNCTION
'
SUB ShowDialog_Form1()
    LOCAL Style&, ExStyle&
    '   hParent& = 0 if no parent Dialog
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
    ExStyle& = 0
    DIALOG NEW 0, "Your Dialog", 0, 0,  267,  177, Style&, ExStyle& TO hForm1&
    DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
END SUB
'
SUB AddChildDlg()
    LOCAL Style&, ExStyle&
    Style& = %WS_CHILD OR %WS_BORDER
    ExStyle& = 0
    DIALOG NEW hForm1&, "Drag Me !", 45, 32, 96, 71, Style&, ExStyle& TO hForm2&
    DIALOG SHOW MODELESS hForm2& , CALL Form1_DLGPROC2
END SUB

CALLBACK FUNCTION Form1_DLGPROC
    SELECT CASE CBMSG
        CASE %WM_INITDIALOG
            AddChildDlg
        CASE ELSE
    END SELECT
END FUNCTION
'
CALLBACK FUNCTION Form1_DLGPROC2
    SELECT CASE CBMSG
        CASE %WM_CTLCOLORDLG
            SetTextColor CBWPARAM, App_Color&( 0)
            SetBkColor   CBWPARAM, App_Color&( 10)
            FUNCTION=App_Brush&( 10)
            EXIT FUNCTION
        CASE %WM_LBUTTONDOWN
            SetWindowText hForm1&, "Drag Started"
            SendMessage CBHNDL, %WM_NCLBUTTONDOWN, %HTCAPTION,0
        CASE %WM_EXITSIZEMOVE
            SetWindowText hForm1&, "Drag Stopped"
        CASE ELSE
    END SELECT
END FUNCTION
'
SUB LIB_InitColors()
    DATA         0,  8388608,    32768,  8421376,      196,  8388736,    16512, 12895428
    DATA   8421504, 16711680,    65280, 16776960,      255, 16711935,    65535, 16777215
    DATA  10790052, 16752768, 10551200, 16777120, 10526975, 16752895, 10551295, 13948116
    DATA  11842740, 16768188, 14483420, 16777180, 14474495, 16768255, 14483455, 15000804
    LOCAL T&, RGBVal&
    REDIM App_Brush&(0 TO 31)
    REDIM App_Color&(0 TO 31)
    FOR T&=0 TO 31
        RGBVal&=VAL(READ$(T&+1))
        App_Brush&(T&)=CreateSolidBrush(RGBVal&)
        App_Color&(T&)=RGBVal&
    NEXT T&
END SUB
'
SUB LIB_DeleteBrushes()
    LOCAL T&
    FOR T&=0 TO 31
        DeleteObject App_Brush&(T&)
    NEXT T&
END SUB

[Chris Boss]

This is an example of creating a Bitmap (memory) buffer to draw a background image for a DDT Dialog.

Notice how when you size the dialog, it resizes the bitmap and redraws it.

' ***************************************************************
'   This code can be used Royalty Free and Freely Distributed !
' ***************************************************************

#COMPILE EXE
#REGISTER NONE
#DIM ALL          '  This is helpful to prevent errors in coding


#INCLUDE "win32api.inc"   ' Must come first before other include files !
' *************************************************************
'                  Constants and Declares (#1)
' *************************************************************
DECLARE SUB LIB_InitColors()
DECLARE SUB LIB_DeleteBrushes()
' --------------------------------------------------
DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
DECLARE CALLBACK FUNCTION Form1_DLGPROC
' --------------------------------------------------
' ------------------------------------------------
' *************************************************************
'               Application Globals Variables (#2)
' *************************************************************
GLOBAL App_Brush&()
GLOBAL App_Color&()
'
GLOBAL hForm1&    ' Dialog handle
'
FUNCTION PBMAIN
    LOCAL Count&
    LIB_InitColors
    ShowDialog_Form1 0
    DO
        DIALOG DOEVENTS TO Count&
    LOOP UNTIL Count&=0
    LIB_DeleteBrushes
END FUNCTION
'
SUB ShowDialog_Form1(BYVAL hParent&)
    LOCAL Style&, ExStyle&
    LOCAL N&, CT&        '  Variables used for Reading Data in Arrays for Listbox and Combobox
    '   hParent& = 0 if no parent Dialog
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER OR %WS_THICKFRAME
    ExStyle& = 0
    DIALOG NEW hParent&, "Your Dialog", 0, 0,  267,  177, Style&, ExStyle& TO hForm1&
    DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
END SUB
'
TYPE MemImage
    Form_hBmp AS LONG
    Form_hDC AS LONG
    Form_W AS LONG
    Form_H AS LONG
END TYPE

SUB DrawBackground(BYVAL hWnd AS LONG, M AS MemImage)
LOCAL hDC AS LONG, W&, H&, L&, ATL&, tbuffer$, CFlag&
LOCAL hParent AS LONG, hBrush AS LONG, OldhBrush AS LONG, C&
LOCAL X&, Y&, Y2&, OldPen&
IF IsWindow(hWnd) THEN
    hDC=M.Form_hDC
    W&=M.Form_W
    H&=M.Form_H
    C&=RGB(255,255,0)
    '  ------------------------------------
    '  Draw here into the memory DC (not the window DC).
    '  The memory DC has a Bitmap associated with it already.
    '  The code below is just sample code.
    '  ------------------------------------
    hBrush=CreateSolidBrush(C&)
    OldhBrush=SelectObject(hDC, hBrush)
    PatBlt hDC, 0,0, W&, H&, %PATCOPY
    OldPen&=SelectObject(hDC, CreatePen(%PS_SOLID, 5, RGB(255,128,0)))
    FOR Y&=0 TO (H&-1) STEP 30
         MoveTo hDC,0,Y&
         Y2&=Y&+30
         IF Y2&<=(H&-1) THEN
              LineTo hDC, W&-1, Y2&
         END IF
    NEXT Y&
    SelectObject hDC, OldhBrush
    SelectObject hDC, OldPen&
    DeleteObject OldPen&
    DeleteObject hBrush
END IF
END SUB
'
SUB BuildBitmap(BYVAL hWnd AS LONG, M AS MemImage, BYVAL CFlag&)
LOCAL R AS RECT, hDC2 AS LONG, hDC AS LONG
LOCAL hOldBmp AS LONG, W&, H&, hBmp AS LONG
' CFlag&=1 for Creation, =0 for Resize, -1 for destroy
IF CFlag&<=0 THEN
    ' Delete Previous DC and Bitmap
    IF M.Form_hBmp<>0 THEN DeleteObject M.Form_hBmp
    IF M.Form_hDC<>0 THEN DeleteDC M.Form_hDC
    M.Form_hBmp=0
    M.Form_hDC=0
END IF
IF CFlag&>=0 THEN
    hDC2=GetDC(hWnd)
    hDC=CreateCompatibleDC(hDC2)
    GetClientRect hWnd, R
    W&=R.nRight-R.nLeft
    H&=R.nBottom-R.nTop
    hBmp=CreateCompatibleBitmap(hDC2, W&, H&)
    SelectObject hDC, hBmp
    DeleteDC hDC2
    M.Form_hBmp=hBmp
    M.Form_hDC=hDC
    M.Form_W=W&
    M.Form_H=H&
    DrawBackground hWnd, M
END IF
END SUB
'
SUB PaintBackground(BYVAL hWnd AS LONG, M AS MemImage)
LOCAL PS AS PAINTSTRUCT
LOCAL hDC AS LONG, R AS RECT, tbuffer$, L&, ATL&
LOCAL memDC AS LONG
    IF IsWindow(hWnd) THEN
        hDC=BeginPaint(hWnd, PS)
        memDC=M.Form_hDC
        BitBlt hDC, PS.rcPaint.nLeft, PS.rcPaint.nTop, _
                    PS.rcPaint.nRight-PS.rcPaint.nLeft, PS.rcPaint.nBottom-PS.rcPaint.nTop, _
                    memDC, PS.rcPaint.nLeft, PS.rcPaint.nTop, %SRCCOPY
        EndPaint hWnd, PS
    END IF
END SUB
'
CALLBACK FUNCTION Form1_DLGPROC
    STATIC M AS MemImage
    SELECT CASE CBMSG
        CASE %WM_ERASEBKGND
            FUNCTION=1
            EXIT FUNCTION
        CASE %WM_PAINT
            PaintBackground CBHNDL, M
            FUNCTION=1
            EXIT FUNCTION
        CASE %WM_INITDIALOG
            BuildBitmap CBHNDL, M, 1
        CASE %WM_DESTROY
            BuildBitmap CBHNDL, M, -1
        CASE %WM_SIZE
            BuildBitmap CBHNDL, M, 0
            InvalidateRect CBHNDL, BYVAL %NULL, %TRUE
        CASE ELSE
    END SELECT
END FUNCTION


' *******************************************************************
' *                         Library Code   *
' ********************************************************************

SUB LIB_InitColors()
    DATA         0,  8388608,    32768,  8421376,      196,  8388736,    16512, 12895428
    DATA   8421504, 16711680,    65280, 16776960,      255, 16711935,    65535, 16777215
    DATA  10790052, 16752768, 10551200, 16777120, 10526975, 16752895, 10551295, 13948116
    DATA  11842740, 16768188, 14483420, 16777180, 14474495, 16768255, 14483455, 15000804
    LOCAL T&, RGBVal&
    REDIM App_Brush&(0 TO 31)
    REDIM App_Color&(0 TO 31)
    FOR T&=0 TO 31
        RGBVal&=VAL(READ$(T&+1))
        App_Brush&(T&)=CreateSolidBrush(RGBVal&)
        App_Color&(T&)=RGBVal&
    NEXT T&
END SUB

' -------------------------------------------------------------

SUB LIB_DeleteBrushes()
    LOCAL T&
    FOR T&=0 TO 31
        DeleteObject App_Brush&(T&)
    NEXT T&
END SUB

[Chris Boss]

Here is an include file which has a library of routines that makes working with tooltips easy.

ezttip.inc

' Note:   You define the following function in your main apps code:
DECLARE FUNCTION DefineToolTipText(BYVAL hDlg&, BYVAL IDNum&) AS STRING

' *************************************************************
'           EZGUI Freeware ToolTip Library !!!
' -------------------------------------------------------------
'   Copyright 2005, Christopher R. Boss, All Rights Reserved !
'   This source code is offered as freeware. You may use it
'   Royalty free, but you must maintain this copyright notice
'   with the code. No warranty made !
'   Provided by Computer Workshop.
'   http://ezgui.com   , also  http://cwsof.com
' *************************************************************
GLOBAL g_ToolTipText AS ASCIIZ*1024
'
FUNCTION CreateDlgToolTip(BYVAL hDlg&, BYVAL MaxWidth&, BYVAL TextColor&, BYVAL BGColor&) AS LONG
    LOCAL WS&, EWS&, CName AS ASCIIZ*32, hCtrl&
    WS&=%WS_POPUP OR %TTS_ALWAYSTIP OR %TTS_BALLOON
    EWS&=%WS_EX_TOOLWINDOW
    CName=$TOOLTIPS_CLASS
    hCtrl&=CreateWindowEx(EWS&, CName,"", WS&,0,0,32,32,hDlg&,0,GetModuleHandle(BYVAL %NULL), BYVAL %NULL)
    SendMessage hCtrl&, %TTM_SETMAXTIPWIDTH, 0, MaxWidth&
    SendMessage hCtrl&, %TTM_SETTIPTEXTCOLOR,TextColor&,0
    SendMessage hCtrl&, %TTM_SETTIPBKCOLOR, BGColor&,0
    FUNCTION=hCtrl&
END FUNCTION
'
SUB AddTool(BYVAL hToolTip&, BYVAL hDlg&, BYVAL IDNum&)
    LOCAL TT AS TOOLINFO, hCtrl&, RV&
    CONTROL HANDLE hDlg&, IDNum& TO hCtrl&
    IF hCtrl&<>0 THEN
        TT.cbSize=SIZEOF(TT)
        TT.uFlags=%TTF_IDISHWND OR %TTF_SUBCLASS
        TT.hwnd=hDlg&
        TT.uId=hCtrl&
        ' TT.rec=
        TT.hinst=GetModuleHandle(BYVAL %NULL)
        TT.lpszText=%LPSTR_TEXTCALLBACK
        TT.lParam=0
        RV&=SendMessage(hToolTip&, %TTM_ADDTOOL,0, VARPTR(TT))
    END IF
END SUB
'
FUNCTION GetClassType(BYVAL hCtrl&) AS STRING
    LOCAL zC AS ASCIIZ*33, X&
    X&=GetClassName(hCtrl&, zC,32)
    FUNCTION=zC
END FUNCTION
'
FUNCTION MKCRLF(BYVAL T$) AS STRING
    REPLACE "|" WITH CHR$(13)+CHR$(10) IN T$
    FUNCTION=T$
END FUNCTION
'
FUNCTION TestForToolTip(BYVAL hDlg&, BYVAL Msg&, BYVAL wParam&, BYVAL lParam&) AS LONG
    LOCAL RV&, pNM AS NMHDR PTR, pTT AS NMTTDISPINFO PTR
    LOCAL hCtrl&, hTipTool&, IDNum&
    RV&=0
    IF Msg&=%WM_NOTIFY THEN
        pNM=lParam&
        hCtrl&[email protected]
        hTipTool&[email protected]
        IF GetClassType(hCtrl&)=$TOOLTIPS_CLASS THEN
            IF @pNM.code=%TTN_NEEDTEXT THEN
                pTT=lParam&
                IDNum&=GetDlgCtrlID(hTipTool&)
                ' this method is limited to 80 characters
                ' @pTT.szText=left$(DefineToolTipText(hDlg&, IDNum&),79)
                ' this method is limited to size of my global variable !
                g_ToolTipText=MKCRLF(DefineToolTipText(hDlg&, IDNum&))
                @pTT.lpszText=VARPTR(g_ToolTipText)
                RV&=1
            END IF
        END IF
    END IF
END FUNCTION

' *************************************************************
'   End ToolTip Library
' *************************************************************
'

[Chris Boss]

Here is an example which demonstrates the importance of only doing periodic updates of a dialogs controls versus doing an update for every iteration of some loop code.

When you run a loop (ie. a counter) which updates the GUI in every iteration it can significantly slow the display speed down.

The solution it to only update at steps (once every multiple intervals) which speeds things up significantly.

Heres the code:

' ***************************************************************
'   This code can be used Royalty Free and Freely Distributed !
' ***************************************************************

#COMPILE EXE
#REGISTER NONE
#DIM ALL          '  This is helpful to prevent errors in coding


#INCLUDE "win32api.inc"   ' Must come first before other include files !
' *************************************************************
'                  Constants and Declares (#1)
' *************************************************************

DECLARE SUB LIB_InitColors()
DECLARE SUB LIB_DeleteBrushes()

%FORM1_LABEL1             = 100
%FORM1_BUTTON1            = 105
%FORM1_BUTTON2            = 110
' --------------------------------------------------
DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
DECLARE CALLBACK FUNCTION Form1_DLGPROC
' --------------------------------------------------
' ------------------------------------------------

DECLARE CALLBACK FUNCTION CBF_FORM1_BUTTON1()
DECLARE CALLBACK FUNCTION CBF_FORM1_BUTTON2()

 


' *************************************************************
'               Application Globals Variables (#2)
' *************************************************************

GLOBAL App_Brush&()
GLOBAL App_Color&()
GLOBAL App_Font&()


GLOBAL hForm1&    ' Dialog handle

 

 

' *************************************************************
'                    Application Entrance
' *************************************************************

FUNCTION PBMAIN
    LOCAL Count&
    LIB_InitColors
    ShowDialog_Form1 0
    DO
        DIALOG DOEVENTS TO Count&
    LOOP UNTIL Count&=0


    LIB_DeleteBrushes
END FUNCTION


' *************************************************************
'                    Application Dialogs (#3)
' *************************************************************

SUB ShowDialog_Form1(BYVAL hParent&)
    LOCAL Style&, ExStyle&
    LOCAL N&, CT&        '  Variables used for Reading Data in Arrays for Listbox and Combobox
    '   hParent& = 0 if no parent Dialog
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
    ExStyle& = 0
    DIALOG NEW hParent&, "Your Dialog", 0, 0,  267,  177, Style&, ExStyle& TO hForm1&
    CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL1,  "Label  1", 43, 15, 163, 12, _
        %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER OR %WS_BORDER
    CONTROL ADD "Button", hForm1&,  %FORM1_BUTTON1,  "Start Loop", 80, 69, 85, 15, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTON1
    CONTROL ADD "Button", hForm1&,  %FORM1_BUTTON2,  "Start Loop (1 per 100 redraws)", 45, 98, 155, 15, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTON2
    DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
END SUB

' *************************************************************
'                             Dialog Callback Procedure
'                             for Form Form1
'                             uses Global Handle - hForm1&
' *************************************************************

CALLBACK FUNCTION Form1_DLGPROC
    SELECT CASE CBMSG
        CASE %WM_CTLCOLORDLG
            IF CBLPARAM=CBHNDL THEN
                ' Dialogs colors
                SetTextColor CBWPARAM, App_Color&(0)
                SetBkColor   CBWPARAM, App_Color&( 26)
                FUNCTION=App_Brush&( 26)
            END IF
        CASE %WM_CTLCOLORMSGBOX , %WM_CTLCOLORBTN, %WM_CTLCOLOREDIT,_
             %WM_CTLCOLORSTATIC, %WM_CTLCOLORSCROLLBAR, %WM_CTLCOLORLISTBOX
            ' Control colors
            SELECT CASE GetDlgCtrlID(CBLPARAM)
                CASE  %FORM1_LABEL1
                    SetTextColor CBWPARAM, App_Color&( 0)
                    SetBkColor   CBWPARAM, App_Color&( 15)
                    FUNCTION=App_Brush&( 15)
                CASE ELSE
                    FUNCTION=0
            END SELECT
        CASE ELSE
    END SELECT
END FUNCTION


' *******************************************************************
' *                         Library Code   *
' ********************************************************************

SUB LIB_InitColors()
    DATA         0,  8388608,    32768,  8421376,      196,  8388736,    16512, 12895428
    DATA   8421504, 16711680,    65280, 16776960,      255, 16711935,    65535, 16777215
    DATA  10790052, 16752768, 10551200, 16777120, 10526975, 16752895, 10551295, 13948116
    DATA  11842740, 16768188, 14483420, 16777180, 14474495, 16768255, 14483455, 15000804
    LOCAL T&, RGBVal&
    REDIM App_Brush&(0 TO 31)
    REDIM App_Color&(0 TO 31)
    FOR T&=0 TO 31
        RGBVal&=VAL(READ$(T&+1))
        App_Brush&(T&)=CreateSolidBrush(RGBVal&)
        App_Color&(T&)=RGBVal&
    NEXT T&
END SUB

' -------------------------------------------------------------

SUB LIB_DeleteBrushes()
    LOCAL T&
    FOR T&=0 TO 31
        DeleteObject App_Brush&(T&)
    NEXT T&
END SUB

' -------------------------------------------------------------

' *************************************************************
'   Application Callback Functions (or Subs) for Controls (#4)
' *************************************************************
SUB DoEventAPI()
    LOCAL Msg AS tagMSG, T AS ASCIIZ*48, N&
    FOR N&=1 TO 500000
        IF PeekMessage(Msg,%NULL,0,0,%PM_REMOVE) THEN
           IF IsDialogMessage(Msg.hwnd, Msg)=0 THEN
               TranslateMessage Msg
               DispatchMessage Msg
           END IF
        END IF
    NEXT N&
END SUB

SUB DoLoopUpdate(BYVAL Mode&)
    LOCAL N&, TM#, LN&
    LN&=1000
    TM#=TIMER
    IF Mode&=0 THEN
        FOR N&=1 TO LN&
            CONTROL SET TEXT hForm1&,  %FORM1_LABEL1, STR$(N&)
            DoEventAPI
        NEXT N&
    ELSE
        FOR N&=1 TO LN&
            IF (N& MOD 100)=0 THEN
                CONTROL SET TEXT hForm1&,  %FORM1_LABEL1, STR$(N&)
                DoEventAPI
            END IF
        NEXT N&
    END IF
    MSGBOX STR$(TIMER-TM#)+" seconds to run loop"
END SUB

' ------------------------------------------------
CALLBACK FUNCTION CBF_FORM1_BUTTON1
    IF CBCTLMSG=%BN_CLICKED THEN
        DoLoopUpdate 0
    END IF
END FUNCTION
' ------------------------------------------------

' ------------------------------------------------
CALLBACK FUNCTION CBF_FORM1_BUTTON2
    IF CBCTLMSG=%BN_CLICKED THEN
        DoLoopUpdate 1
    END IF
END FUNCTION
' ------------------------------------------------

[Chris Boss]

Here is an example of using the interesting GDI (API) function called:

LineDDA

The function calculates the position of each point on a line, but then calls a user defined function to draw at each point.

You don't have to draw lines with it. You can draw a line of icons or bitmaps or anything else you like.

Its an interesting graphic function.

Try it out!

' ***************************************************************
'   This code can be used Royalty Free and Freely Distributed !
' ***************************************************************

#COMPILE EXE
#REGISTER NONE
#DIM ALL          '  This is helpful to prevent errors in coding


#INCLUDE "win32api.inc"   ' Must come first before other include files !
' *************************************************************
'                  Constants and Declares (#1)
' *************************************************************

%FORM1_BUTTON1            = 100
' --------------------------------------------------
DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
DECLARE CALLBACK FUNCTION Form1_DLGPROC
' --------------------------------------------------
' ------------------------------------------------

DECLARE CALLBACK FUNCTION CBF_FORM1_BUTTON1()

 


' *************************************************************
'               Application Globals Variables (#2)
' *************************************************************

GLOBAL hForm1&    ' Dialog handle


' *************************************************************
'                    Application Entrance
' *************************************************************

FUNCTION PBMAIN
    LOCAL Count&
    ShowDialog_Form1 0
    DO
        DIALOG DOEVENTS TO Count&
    LOOP UNTIL Count&=0
END FUNCTION


' *************************************************************
'                    Application Dialogs (#3)
' *************************************************************
GLOBAL App_hForm1&

SUB ShowDialog_Form1(BYVAL hParent&)
    LOCAL Style&, ExStyle&
    LOCAL N&, CT&        '  Variables used for Reading Data in Arrays for Listbox and Combobox
    '   hParent& = 0 if no parent Dialog
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
    ExStyle& = 0
    DIALOG NEW hParent&, "Your Dialog", 0, 0,  267,  177, Style&, ExStyle& TO hForm1&
    App_hForm1&=hForm1&
    CONTROL ADD "Button", hForm1&,  %FORM1_BUTTON1,  "Draw Now !", 163, 158, 96, 15, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTON1
    DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
END SUB

' *************************************************************
'                             Dialog Callback Procedure
'                             for Form Form1
'                             uses Global Handle - hForm1&
' *************************************************************

CALLBACK FUNCTION Form1_DLGPROC
    SELECT CASE CBMSG
        CASE ELSE
    END SELECT
END FUNCTION
'
'
TYPE LDInfo     ' this is a user defined type which you can create
    hDC AS LONG
    hIcon AS LONG
    COUNT AS LONG
    Skip AS LONG

END TYPE

SUB DrawUsingLineDDA()
    LOCAL X1&, Y1&, X2&, Y2&
    LOCAL LD AS LDInfo, hDC&, ID&
    X1&=RND(0,20)
    Y1&=RND(0,20)
    X2&=RND(100,200)
    Y2&=RND(100,200)
    hDC&=GetDC(App_hForm1&)
    LD.hDC=hDC&
    ID&=RND(%IDI_APPLICATION,%IDI_WINLOGO)
    LD.hIcon=LoadIcon(%NULL,BYVAL ID&)
    LD.Count=0
    LD.Skip=24
    LineDDA X1&, Y1&, X2&, Y2&, CODEPTR(MyLineProc),VARPTR(LD)
    ReleaseDC App_hForm1&, hDC&
END SUB

FUNCTION MyLineProc(BYVAL X&, BYVAL Y&, BYVAL lpData AS DWORD) AS LONG
    LOCAL LD AS LDInfo PTR
    LD=lpData
    @[email protected]+1
    IF @LD.Count>[email protected] THEN
        DrawIcon @LD.hDC, X&, Y&, @LD.hIcon
        @LD.Count=0
    END IF
    FUNCTION=0
END FUNCTION


' *************************************************************
'   Application Callback Functions (or Subs) for Controls (#4)
' *************************************************************
' ------------------------------------------------
CALLBACK FUNCTION CBF_FORM1_BUTTON1
    IF CBCTLMSG=%BN_CLICKED THEN
        DrawUsingLineDDA
    END IF
END FUNCTION
' ------------------------------------------------

[Chris Boss]

Here is a nice example of a custom window class (your own control) which can do rubberbanding (drawing a line on a window via the mouse).

This is a valuable technique to learn.

' ***************************************************************
'   written by Chris Boss (developer of EZGUI)
'   put into the public domain - 2004
'   This code can be used Royalty Free and Freely Distributed !
' ***************************************************************

#COMPILE EXE
#REGISTER NONE
#DIM ALL          '  This is helpful to prevent errors in coding


#INCLUDE "win32api.inc"   ' Must come first before other include files !
' *************************************************************
'                  Constants and Declares (#1)
' *************************************************************
DECLARE SUB RegisterLineControl()
DECLARE SUB REAL_LINEPaint(BYVAL hWnd AS LONG)
%FORM1_LINE1             = 100
' --------------------------------------------------
DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
DECLARE CALLBACK FUNCTION Form1_DLGPROC
' --------------------------------------------------

 

 

' *************************************************************
'               Application Globals Variables (#2)
' *************************************************************

GLOBAL hForm1&    ' Dialog handle

' #############################################################################
' store data for custom control to draw based on
' #############################################################################
TYPE LINEINFO
    X1 AS LONG
    Y1 AS LONG
    X2 AS LONG
    Y2 AS LONG
    LColor AS LONG
    MaxX AS LONG
    MaxY AS LONG
END TYPE

GLOBAL App_LineData AS LINEINFO
' #############################################################################

' *************************************************************
'                    Application Entrance
' *************************************************************
'
' #############################################################################
'
SUB DefineLine(BYVAL AX1&, BYVAL AY1&, BYVAL AX2&, BYVAL AY2&, BYVAL ALColor&)
    LOCAL hCtrl&
    App_LineData.X1=AX1&
    App_LineData.Y1=AY1&
    App_LineData.X2=AX2&
    App_LineData.Y2=AY2&
    App_LineData.LColor=ALColor&
    CONTROL HANDLE hForm1&,%FORM1_LINE1 TO hCtrl&
    IF hCtrl&<>0 THEN
        InvalidateRect hCtrl&, BYVAL %NULL, 0
    END IF
END SUB
'
SUB GetClientSize()
    LOCAL hCtrl&, R AS RECT
    CONTROL HANDLE hForm1&,%FORM1_LINE1 TO hCtrl&
    GetClientRect hCtrl&, R
    App_LineData.MaxX=R.nRight-1
    App_LineData.MaxY=R.nBottom-1
END SUB
'
' #############################################################################
'
FUNCTION PBMAIN
    LOCAL Count&
    RegisterLineControl
    ShowDialog_Form1 0
    DO
        DIALOG DOEVENTS TO Count&
    LOOP UNTIL Count&=0
END FUNCTION


' *************************************************************
'                    Application Dialogs (#3)
' *************************************************************

SUB ShowDialog_Form1(BYVAL hParent&)
    LOCAL Style&, ExStyle&
    LOCAL N&, CT&        '  Variables used for Reading Data in Arrays for Listbox and Combobox
    '   hParent& = 0 if no parent Dialog
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
    ExStyle& = 0
    DIALOG NEW hParent&, "Click Mouse and drag mouse to draw line.", 0, 0,  267,  177, Style&, ExStyle& TO hForm1&
    ' -----------------------------------------------------------------------
    ' #############################################################################
    CONTROL ADD "REAL_LINE32", hForm1&,  %FORM1_LINE1,  "", 10, 10, 247, 157,%WS_CHILD OR %WS_VISIBLE,%WS_EX_CLIENTEDGE
    GetClientSize
    ' #############################################################################
    ' -----------------------------------------------------------------------
    DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
    '
END SUB

' *************************************************************
'                             Dialog Callback Procedure
'                             for Form Form1
'                             uses Global Handle - hForm1&
' *************************************************************

CALLBACK FUNCTION Form1_DLGPROC
    SELECT CASE CBMSG
        ' -----------------------------------------------
        CASE ELSE
    END SELECT
END FUNCTION

' #############################################################################
' -------------------------------------------------------------------------------------------
$REAL_LINEName            = "REAL_LINE32"
' -------------------------------------------------------------------------------------------
'
' -------------------------------------------------------------------------------------------
'                          Custom Control ControlClass Functions / Subs
' -------------------------------------------------------------------------------------------
SUB RegisterLineControl()
LOCAL wc    AS WndClassEx
LOCAL szClassName AS ASCIIZ * 80
    szClassName      = $REAL_LINEName+CHR$(0)
    wc.cbSize        = SIZEOF(wc)
    wc.style         = %CS_HREDRAW OR %CS_VREDRAW OR %CS_PARENTDC
    wc.lpfnWndProc   = CODEPTR(REAL_LINEWndProc)
    wc.cbClsExtra    = 0
    wc.cbWndExtra    = 8
    wc.hInstance     = GetModuleHandle(BYVAL %NULL)
    wc.hIcon         = %NULL
    wc.hCursor       = LoadCursor( %NULL, BYVAL %IDC_ARROW )
    wc.hbrBackground = GetStockObject( %WHITE_BRUSH )
    wc.lpszMenuName  = %NULL
    wc.lpszClassName = VARPTR( szClassName )
    wc.hIconSm       = %NULL
    RegisterClassEx wc
END SUB

' -------------------------------------------------------------------------------------------
TYPE MousePos
    X AS INTEGER
    Y AS INTEGER
END TYPE
'
UNION MouseLong
    L AS LONG
    M AS MousePos
END UNION
'
'
SUB DrawDragLine(BYVAL hWnd AS LONG, MP1 AS MouseLong, MP2 AS MouseLong)
    LOCAL hDC AS LONG, OldROP&, hPen&, OldPen&, Color1&, R AS RECT, hRegion&
    Color1&=RGB(0,0,0)
    hDC=GetDC(hWnd)
    OldROP&=GetROP2(hDC)
    SetROP2 hDC, %R2_NOTXORPEN
    hPen&=CreatePen(%PS_SOLID, 1,Color1&)
    OldPen&=SelectObject(hDC, hPen&)
    GetClientRect hWnd, R
    hRegion&=CreateRectRgnIndirect(R)
    SelectClipRgn hDC, hRegion&
    MoveToEx hDC, MP1.M.X, MP1.M.Y, BYVAL %NULL
    LineTo hDC, MP2.M.X, MP2.M.Y
    SetPixelV hDC, MP2.M.X, MP2.M.Y, Color1&
    SetRop2 hDC, OldROP&
    SelectObject hDC, OldPen&
    DeleteObject hPen&
    ReleaseDC hWnd, hDC
END SUB
'

FUNCTION REAL_LINEWndProc(BYVAL hWnd   AS LONG, _
                 BYVAL Msg    AS LONG, _
                 BYVAL wParam AS LONG, _
                 BYVAL lParam AS LONG) EXPORT AS LONG
STATIC MP1 AS MouseLong
STATIC MP2 AS MouseLong
STATIC DFlag&
'
SELECT CASE Msg
    CASE %WM_LBUTTONDOWN
        MP1.L=lParam
        SetCapture hWnd
        DFlag&=1
    CASE %WM_MOUSEMOVE
        IF DFlag& THEN
            IF DFlag&=2 THEN
                DrawDragLine hWnd, MP1, MP2    ' remove old line
            ELSE        ' first move
                DFlag&=2
            END IF
            MP2.L=lParam
            DrawDragLine hWnd, MP1, MP2    ' draw new line
        END IF
    CASE %WM_LBUTTONUP
        IF DFlag& THEN
            ReleaseCapture
            DFlag&=0
            DefineLine MP1.M.X, MP1.M.Y, MP2.M.X, MP2.M.Y, RGB(255,0,0)

        END IF
    CASE %WM_PAINT
        REAL_LINEPaint hWnd
        FUNCTION=0
        EXIT FUNCTION
    CASE %WM_ERASEBKGND
        FUNCTION=0
        EXIT FUNCTION
    CASE %WM_CREATE
    CASE %WM_DESTROY
    CASE %WM_SIZE
        InvalidateRect hWnd, BYVAL %NULL, %TRUE
    CASE ELSE
END SELECT

FUNCTION = DefWindowProc(hWnd,Msg,wParam,lParam)

END FUNCTION

' -------------------------------------------------------------------------------------------

SUB REAL_LINEPaint(BYVAL hWnd AS LONG)
LOCAL PS AS PAINTSTRUCT
LOCAL hDC AS LONG, R AS RECT, FGC&, hParent&, OldBrush&, hPen&, OldPen&
LOCAL X1&, Y1&, X2&, Y2&, hBrush&, hRegion&
    IF IsWindow(hWnd) THEN
        hDC=BeginPaint(hWnd, PS)
        FGC&=App_LineData.LColor
        hBrush&=CreateSolidBrush(RGB(255,255,255))
        OldBrush&=SelectObject(hDC,hBrush&)
        GetClientRect hWnd, R
        ' -------------------------------------------
        ' this is necessary because control shares DC with
        ' parent dialog and you cna draw outside the control
        hRegion&=CreateRectRgnIndirect(R)
        SelectClipRgn hDC, hRegion&
        ' -------------------------------------------
        PatBlt hDC,0,0,R.nRight-R.nLeft,R.nBottom-R.nTop,%PATCOPY
        hPen&=CreatePen(%PS_SOLID,5,FGC&)
        OldPen&=SelectObject(hDC&,hPen&)
        X1&=App_LineData.X1
        Y1&=App_LineData.Y1
        X2&=App_LineData.X2
        Y2&=App_LineData.Y2
        IF X1&=0 AND Y1&=0 AND X2&=0 AND Y2&=0 THEN
            ' do nothing
        ELSE
            MoveToEx hDC, X1&, Y1&, BYVAL %NULL
            LineTo hDC, X2&, Y2&
            SetPixel hDC, X2&, Y2&, FGC&
        END IF
        SelectObject hDC&, OldBrush&
        SelectObject hDC&, OldPen&
        DeleteObject hPen&
        DeleteObject hBrush&
        EndPaint hWnd, PS
    END IF
END SUB

[Chris Boss]

This was my best effort at trying to coax MDI out of DDT Dialogs.
It does work, but is a little buggy yet (almost there though).

Its a good starting point for those who want to try to fine tune it so it is 100% reliable.

' ***************************************************************
' This code was written by Chris Boss. Special thanks go to
' Daniel Modler for his coding insights found at: (link not longer available)
 This code is put into the Public Domain !
' ***************************************************************
#COMPILE EXE
#REGISTER NONE
#DIM ALL
#INCLUDE "win32api.inc"
' ***************************************************************
%MDIFrame_MDI                                      = 500
%MDIFrame_MAKECHILD                                = 505
%MDIFrame_SEPARATOR_510                            = 510
%MDIFrame_EXIT                                     = 515
DECLARE SUB ShowDialog_MDIFrame(BYVAL hParent&)
DECLARE CALLBACK FUNCTION MDIFrame_DLGPROC
DECLARE SUB MDIFrame_MAKECHILD_Select()
DECLARE SUB MDIFrame_EXIT_Select()
GLOBAL hMDIFrame&    ' Dialog handle
GLOBAL hMDIFrame_Menu0&
GLOBAL hMDIFrame_Menu1&
' --------------------------------------------------
%MDICHILD_BUTTON1            = 100
%MDICHILD_BUTTON2            = 105
%MDICHILD_TEXT1              = 110
DECLARE SUB ShowDialog_MDIChild(BYVAL hParent&)
DECLARE CALLBACK FUNCTION MDIChild_DLGPROC
GLOBAL hMDIChild&
' --------------------------------------------------
%MDICHILD2_BUTTON1            = 100
%MDICHILD2_BUTTON2            = 105
%MDICHILD2_TEXT1              = 110
DECLARE SUB ShowDialog_MDIChild2(BYVAL hParent&)
DECLARE CALLBACK FUNCTION MDIChild2_DLGPROC
GLOBAL hMDIChild2&
' --------------------------------------------------
'
'
'
' ----------------------------------------------------------------
'                   DDT MDI Conversion Library - begin
' ----------------------------------------------------------------
GLOBAL MDI_DlgProc AS DWORD
GLOBAL MDI_OriginalDlgProc AS DWORD
GLOBAL MDI_hMDIClient&
GLOBAL MDI_hMDIFrame&
'
FUNCTION MDI_MessageLoop() AS LONG
    LOCAL Msg AS tagMsg, OKFlag&, hDlg&, RV&
    DO
        RV&=GetMessage(Msg, BYVAL %NULL, 0, 0)
        IF RV&=0 OR RV&=-1 THEN EXIT DO
        OKFlag&=1
        hDlg&=MDI_hMDIFrame&
        IF MDI_hMDIClient&<>0 THEN
            IF TranslateMDISysAccel(MDI_hMDIClient&, Msg) THEN OKFlag&=0
            hDlg&=SendMessage(MDI_hMDIClient&, %WM_MDIGETACTIVE,0,0)
            IF hDlg&=0 THEN hDlg&=MDI_hMDIFrame&
        END IF
        IF OKFlag& THEN
            IF IsDialogMessage(hDlg&, Msg)=0 THEN
               TranslateMessage Msg
               DispatchMessage Msg
            END IF
        END IF
    LOOP
END FUNCTION
'
' ----------------------------------------------------------------
'
SUB MDI_SetFrameHandle(BYVAL hDlg&)
    MDI_hMDIFrame&=hDlg&
END SUB
'
' ----------------------------------------------------------------
'
FUNCTION MDI_SendMessage(BYVAL Msg&, BYVAL wParam&, BYVAL lParam&) AS LONG
    FUNCTION=SendMessage(MDI_hMDIClient&, Msg&, wParam&, lParam&)
END FUNCTION
'
' ----------------------------------------------------------------
'
FUNCTION MDI_ClientHandle() AS LONG
    FUNCTION=MDI_hMDIClient&
END FUNCTION
'
' ----------------------------------------------------------------
'
SUB MDI_InitDDTCallback()
    MDI_DlgProc=CODEPTR(MDI_CallDialogPROC)
END SUB
'
' ----------------------------------------------------------------
'
SUB MDI_SizeClient(BYVAL hDlg&)
LOCAL R AS RECT
IF MDI_hMDIClient&<>0 THEN
    GetClientRect hDlg&, R
    MoveWindow MDI_hMDIClient&, R.nLeft, R.nTop, R.nRight, R.nBottom, %TRUE
END IF
END SUB
'
' ----------------------------------------------------------------
'
SUB MDI_CreateClient(BYVAL hDlg&)
LOCAL cc AS CLIENTCREATESTRUCT
cc.idFirstChild = 0
MDI_hMDIClient& = CreateWindowEx(%WS_EX_CLIENTEDGE, "MDICLIENT", BYVAL %NULL, _
                             %WS_CHILD OR %WS_CLIPCHILDREN OR %WS_VISIBLE OR %WS_VSCROLL OR %WS_HSCROLL, _
                             0, 0, 0, 0, hDlg&, 100, GetModuleHandle(BYVAL %NULL), cc)
MDI_SizeClient hDlg&
END SUB
'
' ----------------------------------------------------------------
'
CALLBACK FUNCTION MDI_CallDialogPROC
LOCAL DlgAdd AS DWORD
DlgAdd=GetWindowLong(CBHNDL,%DWL_DLGPROC)
IF DlgAdd<>0 THEN
    FUNCTION=CallWindowProc(DlgAdd, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
ELSE
    FUNCTION=0
END IF
END FUNCTION
'
' ----------------------------------------------------------------
'
CALLBACK FUNCTION MDI_WindowPROC
LOCAL RV&
SELECT CASE CBMSG
    CASE %WM_ERASEBKGND, _
        %WM_CTLCOLORDLG, %WM_CTLCOLORBTN,_
        %WM_CTLCOLOREDIT, %WM_CTLCOLORLISTBOX, %WM_CTLCOLORSTATIC,_
        %WM_CTLCOLORSCROLLBAR ' or any message you need DDT to process
        FUNCTION=CallWindowProc(MDI_OriginalDlgProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
    CASE ELSE
        RV&=CallWindowProc(MDI_DlgProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
        IF RV&=0 THEN

'            if cbmsg = %DM_GETDEFID then beep:beep:beep
'            if cbmsg = %DM_SETDEFID THEN BEEP:BEEP:BEEP
'            if cbmsg = %DC_HASDEFID THEN BEEP:BEEP:BEEP

            IF (GetWindowLong(CBHNDL, %GWL_EXSTYLE) AND %WS_EX_MDICHILD)=%WS_EX_MDICHILD THEN
                FUNCTION = DefMDIChildProc(CBHNDL,CBMSG,CBWPARAM,CBLPARAM)
            ELSE
                FUNCTION = DefFrameProc(CBHNDL, MDI_hMDIClient&, CBMSG, CBWPARAM, CBLPARAM)
            END IF
        ELSE
            FUNCTION=RV&
        END IF
END SELECT
END FUNCTION
'
' ----------------------------------------------------------------
'
SUB MDI_SubClassDialog(BYVAL hDlg&)
LOCAL OldProc AS DWORD
OldProc=SetWindowLong(hDlg&,%GWL_WNDPROC, CODEPTR(MDI_WindowPROC))
IF MDI_OriginalDlgProc=0 THEN MDI_OriginalDlgProc=OldProc
END SUB
'
' ----------------------------------------------------------------
'
SUB MDI_SetExtendedStyles(BYVAL hDlg&)
LOCAL EWS&
EWS&=GetWindowLong(hDlg&, %GWL_EXSTYLE)
EWS&=EWS& OR %WS_EX_MDICHILD OR %WS_EX_CONTROLPARENT
SetWindowLong hDlg&, %GWL_EXSTYLE, EWS&
END SUB
'
' ----------------------------------------------------------------
'                   DDT MDI Conversion Library - end
' ----------------------------------------------------------------
'
'
FUNCTION PBMAIN
    LOCAL Count&
    ' ----------------------
      MDI_InitDDTCallback
    ' ----------------------
    ShowDialog_MDIFrame 0
    ' ----------------------
      FUNCTION=MDI_MessageLoop
    ' ----------------------
END FUNCTION
'
' ----------------------------------------------------------------
'
SUB ShowDialog_MDIFrame(BYVAL hParent&)
    LOCAL Style&, ExStyle&
    Style& = %WS_POPUP OR %WS_THICKFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER OR %WS_CLIPCHILDREN
    ExStyle& = 0
    DIALOG NEW hParent&, "MDI using DDT", 0, 0,  450,  320, Style&, ExStyle& TO hMDIFrame&
    ' ----------------------
      MDI_SetFrameHandle hMDIFrame&
    ' ----------------------
    MENU NEW BAR TO hMDIFrame_Menu0&
    MENU NEW POPUP TO hMDIFrame_Menu1&
    MENU ADD POPUP, hMDIFrame_Menu0& ,"&MDI", hMDIFrame_Menu1&, %MF_ENABLED
    MENU ADD STRING, hMDIFrame_Menu1&, "&Create MDI Children",  %MDIFrame_MAKECHILD, %MF_ENABLED
    MENU ADD STRING, hMDIFrame_Menu1&, "-",  %MDIFrame_SEPARATOR_510, %MF_ENABLED
    MENU ADD STRING, hMDIFrame_Menu1&, "E&xit",  %MDIFrame_EXIT, %MF_ENABLED
    MENU ATTACH hMDIFrame_Menu0&, hMDIFrame&
    DIALOG SHOW MODELESS hMDIFrame& , CALL MDIFrame_DLGPROC
END SUB
'
CALLBACK FUNCTION MDIFrame_DLGPROC
    SELECT CASE CBMSG
        CASE %WM_INITDIALOG
            ' ----------------------
              MDI_CreateClient CBHNDL
              MDI_SubClassDialog CBHNDL
            ' ----------------------
        CASE %WM_SIZE
            ' ----------------------
              MDI_SizeClient CBHNDL
            ' ----------------------
        CASE %WM_COMMAND
            SELECT CASE CBCTL
                CASE  %MDIFrame_MAKECHILD
                    MDIFrame_MAKECHILD_Select
                CASE  %MDIFrame_EXIT
                    MDIFrame_EXIT_Select
                CASE ELSE
            END SELECT
        CASE %WM_DESTROY
            PostQuitMessage 0
        CASE ELSE
    END SELECT
END FUNCTION
'
SUB MDIFrame_MAKECHILD_Select()
STATIC CFlag&
IF CFlag&=0 THEN
    ' ------------------------------------------------------
    ShowDialog_MDIChild   MDI_ClientHandle ' client is parent
    ShowDialog_MDIChild2   MDI_ClientHandle ' client is parent
      MDI_SendMessage %WM_MDIACTIVATE, hMDIChild&,0
    ' -------------------------------------------------------
    CFlag&=1
END IF
END SUB
'
SUB MDIFrame_EXIT_Select()
DIALOG END hMDIFrame&
END SUB
'
' ----------------------------------------------------------------
'
SUB ShowDialog_MDIChild(BYVAL hParent&)
    LOCAL Style&, ExStyle&
    Style& = %WS_CHILD OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_SYSMENU OR %WS_CLIPSIBLINGS
    ExStyle& = 0
    DIALOG NEW hParent&, "MDI Child #1 using DDT", 0, 0,  267,  138, Style&, ExStyle& TO hMDIChild&
'    CONTROL ADD "Button", hMDIChild&,  %MDICHILD_BUTTON1,  "Button  1", 21, 20, 53, 15, _
'        %WS_CHILD OR %WS_VISIBLE OR %BS_AUTOCHECKBOX OR %WS_TABSTOP
    CONTROL ADD "Button", hMDIChild&,  %MDICHILD_BUTTON2,  "Button  2", 21, 39, 53, 15, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP
    CONTROL ADD TEXTBOX, hMDIChild&,  %MDICHILD_TEXT1,  "", 93, 20, 147, 103, _
        %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %ES_WANTRETURN OR %ES_LEFT OR %WS_TABSTOP, _
        %WS_EX_CLIENTEDGE
    DIALOG SHOW MODELESS hMDIChild& , CALL MDIChild_DLGPROC
END SUB
'
CALLBACK FUNCTION MDIChild_DLGPROC
    SELECT CASE CBMSG
        CASE %WM_INITDIALOG
            ' ----------------------
              MDI_SetExtendedStyles CBHNDL
              MDI_SubClassDialog CBHNDL
            ' ----------------------
        CASE ELSE
    END SELECT
END FUNCTION
'
' ----------------------------------------------------------------
'
SUB ShowDialog_MDIChild2(BYVAL hParent&)
    LOCAL Style&, ExStyle&
    Style& = %WS_CHILD OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_SYSMENU OR %WS_CLIPSIBLINGS
    ExStyle& = 0
    DIALOG NEW hParent&, "MDI Child #2 using DDT", 40, 20,  267,  138, Style&, ExStyle& TO hMDIChild2&
    CONTROL ADD "Button", hMDIChild2&,  %MDIChild2_BUTTON1,  "Button  1", 21, 20, 53, 15, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP
    CONTROL ADD "Button", hMDIChild2&,  %MDIChild2_BUTTON2,  "Button  2", 21, 39, 53, 15, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP
    CONTROL ADD TEXTBOX, hMDIChild2&,  %MDIChild2_TEXT1,  "", 93, 20, 147, 103, _
        %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %ES_WANTRETURN OR %ES_LEFT OR %WS_TABSTOP, _
        %WS_EX_CLIENTEDGE
    DIALOG SHOW MODELESS hMDIChild2& , CALL MDIChild2_DLGPROC
END SUB
'
CALLBACK FUNCTION MDIChild2_DLGPROC
    SELECT CASE CBMSG
        CASE %WM_INITDIALOG
            ' ----------------------
              MDI_SetExtendedStyles CBHNDL
              MDI_SubClassDialog CBHNDL
            ' ----------------------
        CASE ELSE
    END SELECT
END FUNCTION
'
' ----------------------------------------------------------------

[Chris Boss]

This is an interesting test program which allows you to see what messages get passed through the message loop versus what messages get sent to the dialogs dialog procedure.

#COMPILE EXE
#REGISTER NONE
#DIM ALL          '  This is helpful to prevent errors in coding
#INCLUDE "win32api.inc"   ' Must come first before other include files !
'
GLOBAL App_ActiveDlg&
'
' --------------------------------------------------
' This code was written by Chris Boss and may be used
' royalty free in any application.
' --------------------------------------------------
' --------------------------------------------------
DECLARE CALLBACK FUNCTION Debug2_DLGPROC
' --------------------------------------------------
SUB DPrint2(BYVAL T$)
    STATIC hDebug2&
    LOCAL TmpT$
    IF hDebug2&=0 THEN
        DIALOG NEW 0, "Dialog Procedure", 180, 0,  150,  150,_
                   %WS_OVERLAPPEDWINDOW,_
                   %WS_EX_TOPMOST TO hDebug2&
        CONTROL ADD TEXTBOX, hDebug2&,  100,  "", 0, 0, 150, 50, _
                   %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %ES_WANTRETURN OR _
                   %ES_LEFT OR %ES_AUTOVSCROLL OR %WS_VSCROLL OR %ES_AUTOHSCROLL OR _
                   %WS_HSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
        CONTROL SEND hDebug2&, 100, %WM_SETFONT, GetStockObject(%ANSI_FIXED_FONT),0
        DIALOG SHOW MODELESS hDebug2& , CALL Debug2_DLGPROC
    END IF
    IF hDebug2&<>0 THEN
        IF IsWindow(hDebug2&)=0 THEN
            hDebug2&=0
            EXIT SUB
        END IF
        CONTROL GET TEXT hDebug2&,100 TO TmpT$
        IF LEN(TmpT$)>32000 THEN TmpT$=""
        SELECT CASE UCASE$(T$)
            CASE "<<CLEAR>>"
                TmpT$=""
                GOSUB DoDebugText
            CASE "<<CLOSE>>"
                DIALOG END hDebug2&
                hDebug2&=0
            CASE ELSE
                REPLACE "|" WITH CHR$(13)+CHR$(10) IN T$
                T$=T$+CHR$(13)+CHR$(10)
                TmpT$=TmpT$+T$
                GOSUB DoDebugText
        END SELECT
    END IF
    EXIT SUB

    DoDebugText:
    CONTROL SET TEXT hDebug2&, 100, TmpT$
    CONTROL SEND hDebug2&,100, %EM_SETSEL, LEN(TmpT$),-1
    CONTROL SEND hDebug2&,100, %EM_SCROLLCARET,0,0
    RETURN
END SUB
'
SUB ResizeEdit2(BYVAL hDlg&)
    LOCAL R AS RECT, hEdit&
    GetClientRect hDlg&, R
    CONTROL HANDLE hDlg&, 100 TO hEdit&
    SetWindowPos hEdit&,0, 0,0, R.nRight, R.nBottom, %SWP_NOZORDER OR %SWP_NOACTIVATE
END SUB
'
CALLBACK FUNCTION Debug2_DLGPROC
    SELECT CASE CBMSG
        CASE %WM_NCACTIVATE
            IF CBWPARAM<>0 THEN
                App_ActiveDlg&=CBHNDL
            END IF
        CASE %WM_SIZE
            ResizeEdit2 CBHNDL
        CASE ELSE
    END SELECT
END FUNCTION
'
' --------------------------------------------------

 


DECLARE CALLBACK FUNCTION Debug1_DLGPROC
' --------------------------------------------------
SUB DPrint(BYVAL T$)
    STATIC hDebug1&
    LOCAL TmpT$
    IF hDebug1&=0 THEN
        DIALOG NEW 0, "Message Loop", 0, 0,  150,  150,_
                   %WS_OVERLAPPEDWINDOW,_
                   %WS_EX_TOPMOST TO hDebug1&
        CONTROL ADD TEXTBOX, hDebug1&,  100,  "", 0, 0, 150, 50, _
                   %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %ES_WANTRETURN OR _
                   %ES_LEFT OR %ES_AUTOVSCROLL OR %WS_VSCROLL OR %ES_AUTOHSCROLL OR _
                   %WS_HSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
        CONTROL SEND hDebug1&, 100, %WM_SETFONT, GetStockObject(%ANSI_FIXED_FONT),0
        DIALOG SHOW MODELESS hDebug1& , CALL Debug1_DLGPROC
    END IF
    IF hDebug1&<>0 THEN
        IF IsWindow(hDebug1&)=0 THEN
            hDebug1&=0
            EXIT SUB
        END IF
        CONTROL GET TEXT hDebug1&,100 TO TmpT$
        IF LEN(TmpT$)>32000 THEN TmpT$=""
        SELECT CASE UCASE$(T$)
            CASE "<<CLEAR>>"
                TmpT$=""
                GOSUB DoDebugText
            CASE "<<CLOSE>>"
                DIALOG END hDebug1&
                hDebug1&=0
            CASE ELSE
                REPLACE "|" WITH CHR$(13)+CHR$(10) IN T$
                T$=T$+CHR$(13)+CHR$(10)
                TmpT$=TmpT$+T$
                GOSUB DoDebugText
        END SELECT
    END IF
    EXIT SUB

    DoDebugText:
    CONTROL SET TEXT hDebug1&, 100, TmpT$
    CONTROL SEND hDebug1&,100, %EM_SETSEL, LEN(TmpT$),-1
    CONTROL SEND hDebug1&,100, %EM_SCROLLCARET,0,0
    RETURN
END SUB
'
SUB ResizeEdit(BYVAL hDlg&)
    LOCAL R AS RECT, hEdit&
    GetClientRect hDlg&, R
    CONTROL HANDLE hDlg&, 100 TO hEdit&
    SetWindowPos hEdit&,0, 0,0, R.nRight, R.nBottom, %SWP_NOZORDER OR %SWP_NOACTIVATE
END SUB
'
CALLBACK FUNCTION Debug1_DLGPROC
    SELECT CASE CBMSG
        CASE %WM_NCACTIVATE
            IF CBWPARAM<>0 THEN
                App_ActiveDlg&=CBHNDL
            END IF
        CASE %WM_SIZE
            ResizeEdit CBHNDL
        CASE ELSE
    END SELECT
END FUNCTION
'
' --------------------------------------------------
'
' --------------------------------------------------
%FORM1_BUTTON1            = 100
%FORM1_TEXT1              = 105
' --------------------------------------------------
DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
DECLARE CALLBACK FUNCTION Form1_DLGPROC
' ------------------------------------------------
DECLARE CALLBACK FUNCTION CBF_FORM1_BUTTON1()
'
GLOBAL hForm1&    ' Dialog handle
'
FUNCTION GetClass(BYVAL hWnd&) AS STRING
    LOCAL zCN AS ASCIIZ*33, C$
    GetClassname hWnd&, zCN, 32
    C$=zCN
    IF C$="#32770" THEN C$="DIALOG"
    FUNCTION=LEFT$(C$+STRING$(7," "),7)+"- "
END FUNCTION
'
SUB ShowMessage(BYVAL hWnd&, BYVAL M&, BYVAL W&)
    LOCAL T$
    SELECT CASE M&
        CASE %WM_PAINT
            T$="WM_PAINT"
        CASE %WM_NCLBUTTONDOWN
            T$="WM_NCLBUTTONDOWN"
        CASE %WM_NCLBUTTONUP
            T$="WM_NCLBUTTONUP"
        CASE %WM_NCMOUSEMOVE
            T$="WM_NCMOUSEMOVE"
        CASE %WM_MOUSEMOVE
            T$="WM_MOUSEMOVE"
        CASE %WM_LBUTTONDOWN
            T$="WM_LBUTTONDOWN"
        CASE %WM_LBUTTONUP
            T$="WM_LBUTTONUP"
        CASE %WM_KEYUP
            T$="WM_KEYUP"
        CASE %WM_KEYDOWN
            T$="WM_KEYDOWN"
        CASE %WM_CHAR
            T$="WM_CHAR"
        CASE %WM_SETCURSOR
            T$="WM_SETCURSOR"
        CASE %WM_MOUSEACTIVATE
            T$="WM_MOUSEACTIVATE"
        CASE %WM_NCHITTEST
            T$="WM_NCHITTEST"
        CASE %WM_COMMAND
            T$="WM_COMMAND"
        CASE %WM_CTLCOLORBTN
            T$="WM_CTLCOLORBTN"
        CASE %WM_CTLCOLOREDIT
            T$="WM_CTLCOLOREDIT"
        CASE %WM_PARENTNOTIFY
            T$="WM_PARENTNOTIFY"
        CASE ELSE
            T$="&H"+HEX$(M&)
    END SELECT
    IF W&=1 THEN
        DPrint GetClass(hWnd&)+ T$
    END IF
    IF W&=2 THEN
        DPrint2 GetClass(hWnd&)+ T$
    END IF
END SUB
'
FUNCTION PBMAIN
    LOCAL X&
    LOCAL Msg AS tagMsg
    DPrint "Start:"
    DPrint2 "Start:"
    ShowDialog_Form1 0
    DO
        X&=GetMessage(Msg,%NULL,0,0)
        IF X&=0 OR X&=-1 THEN EXIT DO
        IF App_ActiveDlg&=hForm1& THEN
            ShowMessage Msg.hwnd, Msg.message, 1
        END IF
        IF App_ActiveDlg&<>0 THEN
            IF IsDialogMessage(App_ActiveDlg&, Msg)=0 THEN
                TranslateMessage Msg
                DispatchMessage Msg
            END IF
        ELSE
            TranslateMessage Msg
            DispatchMessage Msg
        END IF
    LOOP
END FUNCTION
'
SUB ShowDialog_Form1(BYVAL hParent&)
    LOCAL Style&, ExStyle&
    LOCAL N&, CT&        '  Variables used for Reading Data in Arrays for Listbox and Combobox
    '   hParent& = 0 if no parent Dialog
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER OR %WS_THICKFRAME
    ExStyle& = 0
    DIALOG NEW hParent&, "Your Dialog", 0, 0,  181,  89, Style&, ExStyle& TO hForm1&
    CONTROL ADD "Button", hForm1&,  %FORM1_BUTTON1,  "Button  1", 21, 20, 125, 24, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTON1
    CONTROL ADD TEXTBOX , hForm1&, %FORM1_TEXT1, "", 21,60,125,20, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
    DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
END SUB
'
CALLBACK FUNCTION Form1_DLGPROC
    ShowMessage CBHNDL, CBMSG, 2
    SELECT CASE CBMSG
        CASE %WM_NCACTIVATE
            IF CBWPARAM<>0 THEN
                App_ActiveDlg&=CBHNDL
            END IF
        CASE %WM_DESTROY
            DPrint "<<CLOSE>>"
            DPrint2 "<<CLOSE>>"
            PostQuitMessage 0
        CASE ELSE
    END SELECT
END FUNCTION
'
CALLBACK FUNCTION CBF_FORM1_BUTTON1
    IF CBCTLMSG=%BN_CLICKED THEN

    END IF
END FUNCTION

[Chris Boss]

This was an interesting piece of code I did a while back I just came across.

The program appears to run notepad and then embed it into the calling dialog as if it was a control.

Well not exactly !

Actually Notepad is just floating above the Dialog and it moved when the dialog is moved.

For all practical purposes, it appears embeded in the dialog.

It is an interesting technque.

Try it out!

#INCLUDE "win32api.inc"   ' Must come first before other include files !
' *************************************************************
'                  Constants and Declares (#1)
' *************************************************************
DECLARE SUB LIB_InitColors()
DECLARE SUB LIB_DeleteBrushes()
%FORM1_RUNBUTTON          = 100
' --------------------------------------------------
DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
DECLARE CALLBACK FUNCTION Form1_DLGPROC
' --------------------------------------------------
DECLARE CALLBACK FUNCTION CBF_FORM1_RUNBUTTON()
'
' *************************************************************
'               Application Globals Variables (#2)
' *************************************************************
GLOBAL App_Brush&()
GLOBAL App_Color&()
GLOBAL hForm1&    ' Dialog handle
GLOBAL App_hActualWnd&
'
' *************************************************************
'                    Application Entrance
' *************************************************************
'
FUNCTION PBMAIN
    LOCAL Count&
    LIB_InitColors
    ShowDialog_Form1 0
    DO
        DIALOG DOEVENTS TO Count&
    LOOP UNTIL Count&=0
    LIB_DeleteBrushes
END FUNCTION
'
SUB ShowDialog_Form1(BYVAL hParent&)
    LOCAL Style&, ExStyle&
    LOCAL N&, CT&        '  Variables used for Reading Data in Arrays for Listbox and Combobox
    '   hParent& = 0 if no parent Dialog
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER OR %WS_CLIPCHILDREN
    ExStyle& = 0
    DIALOG NEW hParent&, "Your Dialog", 0, 0,  475,  305, Style&, ExStyle& TO hForm1&
    CONTROL ADD "Button", hForm1&,  %FORM1_RUNBUTTON,  "Run NotePad", 5, 10, 91, 30, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_RUNBUTTON
    DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
END SUB
'
DECLARE SUB UpdateExternalAppPos(BYVAL hParent&, BYVAL hWndApp&, BYVAL X&, BYVAL Y&, BYVAL W&, BYVAL H&)
'
CALLBACK FUNCTION Form1_DLGPROC
    SELECT CASE CBMSG
        CASE %WM_MOVE
             UpdateExternalAppPos CBHNDL, App_hActualWnd&, 200,50, 400,400
        CASE %WM_CTLCOLORDLG
            IF CBLPARAM=CBHNDL THEN
                ' Dialogs colors
                SetTextColor CBWPARAM, App_Color&(0)
                SetBkColor   CBWPARAM, App_Color&( 25)
                FUNCTION=App_Brush&( 25)
            END IF
        CASE %WM_DESTROY
             IF App_hActualWnd&<>0 THEN
                  IF IsWindow(App_hActualWnd&) THEN
                       SendMessage App_hActualWnd&, %WM_SYSCOMMAND, %SC_CLOSE,0
                  END IF
             END IF
        CASE ELSE
    END SELECT
END FUNCTION
'
SUB LIB_InitColors()
    DATA         0,  8388608,    32768,  8421376,      196,  8388736,    16512, 12895428
    DATA   8421504, 16711680,    65280, 16776960,      255, 16711935,    65535, 16777215
    DATA  10790052, 16752768, 10551200, 16777120, 10526975, 16752895, 10551295, 13948116
    DATA  11842740, 16768188, 14483420, 16777180, 14474495, 16768255, 14483455, 15000804
    LOCAL T&, RGBVal&
    REDIM App_Brush&(0 TO 31)
    REDIM App_Color&(0 TO 31)
    FOR T&=0 TO 31
        RGBVal&=VAL(READ$(T&+1))
        App_Brush&(T&)=CreateSolidBrush(RGBVal&)
        App_Color&(T&)=RGBVal&
    NEXT T&
END SUB
'
SUB LIB_DeleteBrushes()
    LOCAL T&
    FOR T&=0 TO 31
        DeleteObject App_Brush&(T&)
    NEXT T&
END SUB
'

FUNCTION RunExternalAppComponent(BYVAL hParent&, BYVAL AppName$, BYVAL AppClass$, BYVAL AppTitle$, BYVAL X&, BYVAL Y&, BYVAL W&, BYVAL H&, hActualWnd&) AS LONG
     LOCAL hWndApp&, V&, RV&, CT&
     LOCAL WS&, EXS&, MenuID&
     V&=SHELL(AppName$, 0)
     hActualWnd&=0
     DO
          SLEEP 100 ' wait for app to run
          hWndApp&=FindWindow(BYVAL STRPTR(AppClass$), BYVAL STRPTR(AppTitle$))
          IF hWndApp&=0 THEN hWndApp&=FindWindow(BYVAL STRPTR(AppClass$), BYVAL %NULL)
          IF hWndApp&<>0 THEN
               RV&=1
               EXIT DO
          ELSE
               CT&=CT&+1
               IF CT&=20 THEN EXIT DO
          END IF
     LOOP
     IF hWndApp&<>0 THEN
          hActualWnd&=hWndApp&
          WS&=GetWindowLong(hWndApp&, %GWL_STYLE)
          WS&=WS& AND (NOT(%WS_DLGFRAME OR %WS_OVERLAPPEDWINDOW OR %WS_BORDER OR %WS_POPUP OR %WS_CHILD))
          EXS&=GetWindowLong(hWndApp&, %GWL_EXSTYLE)
          EXS&=EXS& AND (%WS_EX_ACCEPTFILES OR %WS_EX_NOPARENTNOTIFY)
          MenuID&=GetWindowLong(hWndApp&, %GWL_ID)
          WS&=WS& OR %WS_POPUP OR %WS_BORDER
          SetWindowLong hWndApp&, %GWL_STYLE, WS&
          SetWindowLong hWndApp&, %GWL_EXSTYLE, EXS&
          SetParent hWndApp&, hParent&
          SetWindowPos hWndApp&,%NULL, X&, Y&, W&, H&, %SWP_DRAWFRAME OR %SWP_NOZORDER OR %SWP_SHOWWINDOW
     END IF
     FUNCTION=RV&
END FUNCTION
'
CALLBACK FUNCTION CBF_FORM1_RUNBUTTON
    IF CBCTLMSG=%BN_CLICKED THEN
          IF RunExternalAppComponent(hForm1&, "notepad.exe", "Notepad", "Untitled - Notepad", 200,50, 400,400, App_hActualWnd&) THEN
               ' it worked
          END IF
    END IF
END FUNCTION

SUB UpdateExternalAppPos(BYVAL hParent&, BYVAL hWndApp&, BYVAL X&, BYVAL Y&, BYVAL W&, BYVAL H&)
     SetWindowPos hWndApp&,%NULL, X&, Y&, W&, H&, %SWP_DRAWFRAME OR %SWP_NOZORDER OR %SWP_SHOWWINDOW
END SUB

[Chris Boss]

When you want to resize a Dialog to its largest size (without doing a maximize) you really should resize it to what is called the "Desktop Work Area", rather than full screen.

The work area is the entire desktop minus the area where the Windows Task bar is is.

Here is a simple example:

#COMPILE EXE
#REGISTER NONE
#DIM ALL          '  This is helpful to prevent errors in coding


#INCLUDE "win32api.inc"   ' Must come first before other include files !
' *************************************************************
'                  Constants and Declares (#1)
' *************************************************************
%FORM1_BUTTON1            = 100
' --------------------------------------------------
DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
DECLARE CALLBACK FUNCTION Form1_DLGPROC
' --------------------------------------------------
' ------------------------------------------------

DECLARE CALLBACK FUNCTION CBF_FORM1_BUTTON1()

' *************************************************************
'               Application Globals Variables (#2)
' *************************************************************
GLOBAL hForm1&    ' Dialog handle

' *************************************************************
'                    Application Entrance
' *************************************************************

FUNCTION PBMAIN
    LOCAL Count&
    ShowDialog_Form1 0
    DO
        DIALOG DOEVENTS TO Count&
    LOOP UNTIL Count&=0
END FUNCTION


' *************************************************************
'                    Application Dialogs (#3)
' *************************************************************

SUB ShowDialog_Form1(BYVAL hParent&)
    LOCAL Style&, ExStyle&
    LOCAL N&, CT&        '  Variables used for Reading Data in Arrays for Listbox and Combobox
    '   hParent& = 0 if no parent Dialog
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
    ExStyle& = 0
    DIALOG NEW hParent&, "Your Dialog", 0, 0,  267,  177, Style&, ExStyle& TO hForm1&
    CONTROL ADD "Button", hForm1&,  %FORM1_BUTTON1,  "Click to Resize", 96, 79, 80, 15, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTON1
    DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
END SUB

' *************************************************************
'                             Dialog Callback Procedure
'                             for Form Form1
'                             uses Global Handle - hForm1&
' *************************************************************

CALLBACK FUNCTION Form1_DLGPROC
    SELECT CASE CBMSG
        CASE ELSE
    END SELECT
END FUNCTION

' ------------------------------------------------
'
SUB ResizeToWorkArea()
    LOCAL R AS RECT
    SystemParametersInfo %SPI_GETWORKAREA, 0, R,0
    SetWindowPos  hForm1&, 0, R.nLeft, R.nTop, R.nRight-R.nLeft, R.nBottom-R.nTop, %SWP_NOZORDER OR %SWP_SHOWWINDOW
END SUB
'
CALLBACK FUNCTION CBF_FORM1_BUTTON1
    IF CBCTLMSG=%BN_CLICKED THEN
        ResizeToWorkArea
    END IF
END FUNCTION
' ------------------------------------------------

[Chris Boss]

This is interesting code.

It creates a custom window class (a control), but it does it in its own thread, so the control is actually in a different thread than the dialog is (it has its own message loop).

' ***************************************************************
'   This code can be used Royalty Free and Freely Distributed !
' ***************************************************************

#COMPILE EXE
#REGISTER NONE
#DIM ALL          '  This is helpful to prevent errors in coding


#INCLUDE "win32api.inc"   ' Must come first before other include files !
' *************************************************************
'                  Constants and Declares (#1)
' *************************************************************
DECLARE SUB LIB_InitColors()
DECLARE SUB LIB_DeleteBrushes()
'
%FORM1_LABEL2             = 100
%FORM1_THREADLABEL        = 105
%FORM1_BUTTON1            = 110
' --------------------------------------------------
DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
DECLARE CALLBACK FUNCTION Form1_DLGPROC
DECLARE SUB Close_Form1_Thread1()
DECLARE SUB RegisterControl ()
DECLARE FUNCTION CreateControl (BYVAL hParent&, BYVAL ID&, _
                                BYVAL AX&, BYVAL AY&, _
                                BYVAL AW&, BYVAL AH&) AS LONG

' --------------------------------------------------
' ------------------------------------------------

DECLARE CALLBACK FUNCTION CBF_FORM1_BUTTON1()

 


' *************************************************************
'               Application Globals Variables (#2)
' *************************************************************
'
GLOBAL App_Brush&()
GLOBAL App_Color&()
'
GLOBAL hForm1&    ' Dialog handle
GLOBAL App_X&, App_Y&, App_W&, App_H&
'
GLOBAL hForm1_Thread1&
GLOBAL End_Form1_Thread1&
GLOBAL App_hCtrl&
'

 

' *************************************************************
'                    Application Entrance
' *************************************************************

FUNCTION PBMAIN
    LOCAL Count&
    LOCAL MVal&, Msg AS tagMsg
    End_Form1_Thread1&=0   ' no thread
    RegisterControl
    LIB_InitColors
    ShowDialog_Form1 0

    DO
        MVal&=GetMessage(Msg,%NULL,0,0)
        IF MVal&=-1 THEN EXIT DO    ' error was returned must exit
        IF MVal&=0 THEN EXIT DO
        TranslateMessage Msg
        DispatchMessage Msg
    LOOP

    ' can not use DDT message loop since it processes all available messages
    '    DO
    '        DIALOG DOEVENTS TO Count&
    '    LOOP UNTIL Count&=0
    LIB_DeleteBrushes
END FUNCTION


' *************************************************************
'                    Application Dialogs (#3)
' *************************************************************

SUB ShowDialog_Form1(BYVAL hParent&)
    LOCAL Style&, ExStyle&, hCtrl&
    LOCAL N&, CT&        '  Variables used for Reading Data in Arrays for Listbox and Combobox
    '   hParent& = 0 if no parent Dialog
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
    ExStyle& = 0
    DIALOG NEW hParent&, "Your Dialog", 0, 0,  267,  177, Style&, ExStyle& TO hForm1&
    ' ------------------------------------------------------------
    ' define location of custom control in dialog units
    App_X&=88
    App_Y&=22
    App_W&=155
    App_H&=116
    ' convert to pixels
    DIALOG UNITS hForm1&, App_X&, App_Y& TO PIXELS App_X&, App_Y&
    DIALOG UNITS hForm1&, App_W&, App_H& TO PIXELS App_W&, App_H&
    ' ------------------------------------------------------------
    CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL2,  "", 21, 150, 221, 12, _
        %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER OR %WS_BORDER
    CONTROL ADD "Button", hForm1&,  %FORM1_BUTTON1,  "Start Thread", 21, 22, 53, 15, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTON1
    DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
END SUB
'
' *************************************************************
'                             Dialog Callback Procedure
'                             for Form Form1
'                             uses Global Handle - hForm1&
' *************************************************************
'
CALLBACK FUNCTION Form1_DLGPROC
    SELECT CASE CBMSG
        CASE %WM_CTLCOLORMSGBOX , %WM_CTLCOLORBTN, %WM_CTLCOLOREDIT,_
             %WM_CTLCOLORSTATIC, %WM_CTLCOLORSCROLLBAR, %WM_CTLCOLORLISTBOX
            ' Control colors
            SELECT CASE GetDlgCtrlID(CBLPARAM)
                CASE  %FORM1_LABEL2
                    SetTextColor CBWPARAM, App_Color&( 0)
                    SetBkColor   CBWPARAM, App_Color&( 26)
                    FUNCTION=App_Brush&( 26)
                CASE  %FORM1_THREADLABEL
                    SetTextColor CBWPARAM, App_Color&( 0)
                    SetBkColor   CBWPARAM, App_Color&( 30)
                    FUNCTION=App_Brush&( 30)
                CASE ELSE
                    FUNCTION=0
            END SELECT
      CASE %WM_SYSCOMMAND
          IF (CBWPARAM AND &HFFF0)= %SC_CLOSE THEN
             IF End_Form1_Thread1&=-1 THEN
                Close_Form1_Thread1
             END IF
          END IF
      CASE %WM_DESTROY
          PostQuitMessage 0
      CASE ELSE
    END SELECT
END FUNCTION
'
' *******************************************************************
' *                         Library Code   *
' ********************************************************************
'
SUB LIB_InitColors()
    DATA         0,  8388608,    32768,  8421376,      196,  8388736,    16512, 12895428
    DATA   8421504, 16711680,    65280, 16776960,      255, 16711935,    65535, 16777215
    DATA  10790052, 16752768, 10551200, 16777120, 10526975, 16752895, 10551295, 13948116
    DATA  11842740, 16768188, 14483420, 16777180, 14474495, 16768255, 14483455, 15000804
    LOCAL T&, RGBVal&
    REDIM App_Brush&(0 TO 31)
    REDIM App_Color&(0 TO 31)
    FOR T&=0 TO 31
        RGBVal&=VAL(READ$(T&+1))
        App_Brush&(T&)=CreateSolidBrush(RGBVal&)
        App_Color&(T&)=RGBVal&
    NEXT T&
END SUB

' -------------------------------------------------------------

SUB LIB_DeleteBrushes()
    LOCAL T&
    FOR T&=0 TO 31
        DeleteObject App_Brush&(T&)
    NEXT T&
END SUB

' -------------------------------------------------------------

' *************************************************************
'   Application Callback Functions (or Subs) for Controls (#4)
' *************************************************************
'
'
' ------------------------------------------------
CALLBACK FUNCTION CBF_FORM1_BUTTON1
    STATIC Flag&
    IF CBCTLMSG=%BN_CLICKED THEN
        IF Flag&=0 THEN
            Flag&=1
            THREAD CREATE Form1_Thread1(hForm1&) TO hForm1_Thread1&
            CONTROL SET TEXT hForm1&,%FORM1_BUTTON1, "Stop Thread"
        ELSE
            Flag&=0
            Close_Form1_Thread1
            CONTROL SET TEXT hForm1&,%FORM1_BUTTON1, "Start Thread"
            UpdateWindow hForm1&
        END IF
    END IF
END FUNCTION
' ------------------------------------------------
'
%WM_MYTIMER         =   %WM_USER+400
'
FUNCTION Form1_Thread1(BYVAL hDlg&) AS LONG
    LOCAL MVal&, Msg AS tagMsg, hCtrl&
    End_Form1_Thread1&=-1   ' thread active
    hCtrl&=CreateControl(hDlg&,%FORM1_THREADLABEL , App_X&, App_Y&, App_W&, App_H&)
    ' Message Loop
    App_hCtrl&=hCtrl&
    DO
        IF IsWindow(hCtrl&) THEN
            MVal&=PeekMessage(Msg,%NULL,0,0, %PM_REMOVE)
            IF MVal&<>0 THEN
                TranslateMessage Msg
                DispatchMessage Msg
            END IF
            SendMessage hCtrl&, %WM_MYTIMER,0,0
        END IF
        IF End_Form1_Thread1&=1 THEN
            EXIT DO
        END IF
    LOOP
    FUNCTION=1
END FUNCTION
'
' -------------------------------
'
'
SUB Close_Form1_Thread1()
    LOCAL EFlag&, N&
    ' ----------------------------------------------
    '  DestroyWindow does not work for some reason
    ' when used from either the primary thread or
    ' the actual thread that created the control.
    ' WM_CLOSE is the only thing that works !!!
    ' ----------------------------------------------
    SendMessage App_hCtrl&, %WM_CLOSE,0,0
    End_Form1_Thread1& = 1
    N&=0
    DO
        EFlag&=0
        THREAD STATUS hForm1_Thread1& TO EFlag&
        N&=N&+1
        IF N&>10000000 THEN EXIT DO
        IF EFlag&<>&H103 THEN EXIT DO
    LOOP
    THREAD CLOSE hForm1_Thread1& TO N&
    End_Form1_Thread1& = 0
END SUB
'
' --------------------------------------------------------------------------------------
SUB RegisterControl ()
    LOCAL winclass    AS wndclassEx
    LOCAL szClassName AS ASCIIZ * 32
    szClassName            = "MYCONTROL32"
    winclass.cbSize        = SIZEOF(winclass)
    winclass.style         = %CS_OWNDC OR %CS_HREDRAW OR %CS_VREDRAW
    winclass.lpfnWndProc   = CODEPTR(ControlWindowProc)
    winclass.cbClsExtra    = 0
    winclass.cbWndExtra    = 0
    winclass.hInstance     = GetModuleHandle(BYVAL %NULL)
    winclass.hIcon         = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
    winclass.hCursor       = LoadCursor( %NULL, BYVAL %IDC_ARROW )
    winclass.hbrBackground = GetStockObject(%WHITE_BRUSH)
    winclass.lpszMenuName  = %NULL
    winclass.lpszClassName = VARPTR( szClassName )
    winclass.hIconSm       = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
    RegisterClassEx winclass
END SUB
'
' --------------------------------------------------------------------------------------
'
FUNCTION CreateControl (BYVAL hParent&, BYVAL ID&, _
                        BYVAL AX&, BYVAL AY&, _
                        BYVAL AW&, BYVAL AH&) AS LONG
    LOCAL szTemp AS ASCIIZ * 80
    LOCAL hCtrl&, Style&, ExStyle&
    szTemp="Move Mouse over me !"
    Style&=%WS_CHILD OR %WS_VISIBLE OR %WS_BORDER
    ExStyle&=0
    szTemp="Move Mouse over me !!!"
    hCtrl&=CreateWindowEX(ExStyle&, _   ' Extended Window Style
                     "MYCONTROL32", _   ' window class name
                            szTemp, _   ' window caption
                            Style&, _   ' window style
                               AX&, _   ' initial x position
                               AY&, _   ' initial y position
                               AW&, _   ' initial width
                               AH&, _   ' initial height
                          hParent&, _   ' parent window handle
                               ID&, _   ' window ID&
      GetModuleHandle(BYVAL %NULL), _   ' program instance handle
                          BYVAL %NULL)  ' creation parameters
    FUNCTION=hCtrl&
END FUNCTION
'
' --------------------------------------------------------------------------------------
'
FUNCTION ControlWindowProc(BYVAL hWnd&, BYVAL Msg&, BYVAL wParam&, BYVAL lParam&) AS LONG
    STATIC X1&,Y1&, X2&, Y2&,X3& ,Y3&, Flip&
    STATIC MemDC&, hBmp&, OldBmp&, StartFrame!, EndFrame!, Frames!
    SELECT CASE Msg&
        CASE %WM_CREATE
            DIM R AS RECT
            X1&=0
            Y1&=0
            GetClientRect hWnd&, R
            X2&=R.nRight-1
            Y2&=R.nBottom-1
        CASE %WM_MYTIMER
            IF X1&=0 AND X3&=0 THEN
                StartFrame!=TIMER
                Frames!=0
            END IF
            InvalidateRect hWnd&, BYVAL %NULL,1
            UpdateWindow hWnd&
            Frames!=Frames!+1
            X3&=X3&+1
            IF X3&>X2& THEN
                X3&=X2&
                X1&=X1&+1
                IF X1&>X2& THEN
                    X1&=0
                    X3&=0
                    EndFrame!=TIMER-StartFrame!
                    DIM zText2 AS ASCIIZ *80
                    zText2=STR$(Frames!/EndFrame!)+" frames/sec."
                    CONTROL SEND hForm1&,%FORM1_LABEL2, %WM_SETTEXT,0, VARPTR(zText2)
                END IF
            END IF
            EXIT FUNCTION
        CASE %WM_ERASEBKGND
            DIM hDC&, RR AS RECT
            hDC&=wParam&
            GetClientRect hWnd&, RR
            IF MemDC&=0 THEN
                MemDC&=CreateCompatibleDC(hDC&)
                hBmp&=CreateCompatibleBitmap(hDC&,RR.nRight,RR.nBottom)
                OldBmp&=SelectObject(MemDC&,hBmp&)
                PatBlt MemDC&,0,0,RR.nRight,RR.nBottom, %WHITENESS
            END IF
            IF X3&=0 THEN
                PatBlt MemDC&,0,0,RR.nRight,RR.nBottom, %WHITENESS
            END IF
            MoveToEx MemDC&, X1&,Y1&, BYVAL %NULL
            LineTo MemDC&, X3&,Y2&+1
            BitBlt hDC&,0,0,RR.nRight,RR.nBottom,MemDC&,0,0,%SRCCOPY
            EXIT FUNCTION
        CASE %WM_MOUSEMOVE
            DIM zText AS ASCIIZ *80
            zText=STR$(LOWRD(lParam&))+","+STR$(HIWRD(lParam&))
            CONTROL SEND hForm1&,%FORM1_LABEL2, %WM_SETTEXT,0, VARPTR(zText)
        CASE %WM_DESTROY
            IF MemDC&<>0 THEN
                SelectObject MemDC&, OldBmp&
                DeleteObject hBmp&
                DeleteDC MemDC&
                MemDC&=0
            END IF
            ' Indicate whether control is successfully destroyed
            BEEP
        CASE ELSE
    END SELECT
    FUNCTION=DefWindowProc(hWnd&, Msg&, wParam&, lParam&)
END FUNCTION

[Chris Boss]

I am taking some of the code samples from my forums and posting them here.