FreeBasic

Отличный исходник визуального редактора, нацеленного на построение Gui интерфейса программ и преобразование в исходный код. Конечно много в нем недоделано, но смею вас уверить работы проделано много.
Платформа: Windows.
Автор: eodor 2010.

' #########################################################################
#INCLUDE Once "windows.bi"

#INCLUDE Once "win/commdlg.bi"

#INCLUDE Once "win/commctrl.bi"

#INCLUDE Once "crt.bi"




Declare Function MPFrameWndProc( hWnd  As HWND, uMsg As UINT,wParam   As WPARAM,        lParam        As LPARAM  _
                ) As LRESULT
Declare Function MPMDIChildWndProc(hWnd   As HWND,        uMsg As UINT,wParam As WPARAM,lParam As LPARAM        _
                ) As LRESULT
Declare Function InitializeApplication() As BOOL
Declare Function RegisterChild() As BOOL
Declare Function MakeTooltip(hwndOwner As HWND,lpszText  As LPSTR,hInst  As HINSTANCE ) As BOOL
Declare Function LoadCCLibrary(dwICC As DWORD) As BOOL
Declare Function MakeRebar(hwndOwner As HWND,hInst As HINSTANCE ) As HWND
Declare Function RebarAddBand(hwndOwner As HWND,hwndChild As HWND,lpTitle As LPSTR ) As BOOL
Declare Function MakeToolbar(hwndOwner As HWND,hInst As HINSTANCE) As HWND
Declare Sub ToolbarAddButton(hwndOwner As HWND,idCommand As Integer,lpTitle As LPSTR,dwStyle   As Byte  )
Declare Sub CenterWindow(hWnd As HWND)
Declare Function ApplyMenu(hwndOwner As HWND) As BOOL
Declare Function CreateChild(lpWindowName As String) As HWND
Declare Function EnumChildProc(hwnd As HWND,lParam As LPARAM  ) As BOOL
Declare Function CodegenProc(Byval hWnd   As HWND, _
                     Byval wMsg    As UINT, Byval wParam As  WPARAM, _
                     Byval lParam As LPARAM) As LRESULT
Declare Function ToolboxProc(Byval hWnd   As HWND, _
                     Byval wMsg    As UINT, Byval wParam As  WPARAM, _
                     Byval lParam As LPARAM) As LRESULT
Declare Sub CreateControlEx(hwndOwner As HWND )
Declare Function HitTest(hCtl As HWND,        lParam As LPARAM )As Integer

               
Declare Function EditProc(hCtl As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM ) As LRESULT
               
Declare Function ButtonProc(hCtl As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM ) As LRESULT 
Declare Function StaticProc(hCtl As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM ) As LRESULT
               
Declare Function ComboProc(hCtl As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM ) As LRESULT
               
Declare Function ListProc(hCtl As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM         ) As LRESULT 
               
Declare Function ScrollProc( hCtl As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM) As LRESULT 
               
Declare Function CreateCodeProc(hwnd As HWND,lParam As LPARAM ) As BOOL 



Sub INCR(Byref I As Integer)
        I=I+1

End Sub


 


   Dim Shared  hwndMDIClient As HWND
   Dim Shared  hwndFrame     As HWND
   Dim Shared  hStatus       As HWND
   Dim Shared  hToolbar      As HWND
   Dim Shared  hToolbox      As HWND
   Dim Shared  hTBtoolbar    As HWND
   Dim Shared  hCodegen      As HWND
   Dim Shared  hCGEdit       As HWND
   Dim Shared  hAccel        As HACCEL
   Dim Shared  hInst         As HINSTANCE
   Dim Shared  MainMenu      As HANDLE
   Dim Shared  FileMenu      As HANDLE
   Dim Shared  CWinMenu      As HANDLE
   Dim Shared  HelpMenu      As HANDLE

   Dim Shared  lpToolboxProc As WNDPROC
   Dim Shared  lpCodegenProc As WNDPROC

   Dim Shared  lpEditProc    As WNDPROC
   Dim Shared  lpButtonProc  As WNDPROC
   Dim Shared  lpStaticProc  As WNDPROC
   Dim Shared  lpScrollProc  As WNDPROC
   Dim Shared  lpComboProc   As WNDPROC
   Dim Shared  lpListProc    As WNDPROC

   Dim Shared  iButton As Integer

   Dim Shared  iCheckbox As Integer

   Dim Shared  iRadio As Integer

   Dim Shared  iStatic As Integer

   Dim Shared  iScrollBar As Integer

   Dim Shared  iEdit As Integer

   Dim Shared  iListBox As Integer

   Dim Shared  iComboBox As Integer

   Dim Shared  iControl As Integer


Dim Shared  gfTestForm     As Long     'test Form only. (Use Run for compiled code)
Dim Shared  gGridSize        As Long   'number, Grid Size,   User configurable
Dim Shared  gGridOnOff       As Long   'flag,   Grid On/Off, User configurable
Dim Shared  gSnapOnOff       As Long   'flag,   Snap On/Off, User configurable

    Const  szFrame As String     =  "bide_frame"
    Const  szChild As String     =  "bide_child"

    Const  IDM_NEW       =  1001

    Const  IDM_HTOOL     =  1002

    Const  IDM_HSTATUS   =  1003

    Const  IDM_HTOOLBOX  =  1004

    Const  IDM_EXIT      =  1005

    Const  IDM_CGEN      =  1006


    Const  IDM_CASCADE   =  2001

    Const  IDM_TILEH     =  2002

    Const  IDM_TILEV     =  2003

    Const  IDM_ARRANGE   =  2004

    Const  IDM_RESTORE   =  2005

    Const  IDM_MINWIN    =  2006

    Const  IDM_CLOSE     =  2007


    Const  IDM_ABOUT     =  3001


    Const  IDW_FIRST     =  4000


    Const  IDC_SEL       =  5001

    Const  IDC_EDT       =  5002

    Const  IDC_GRP       =  5003

    Const  IDC_BTN       =  5004

    Const  IDC_CHK       =  5005

    Const  IDC_RAD       =  5006

    Const  IDC_CMB       =  5007

    Const  IDC_LST       =  5008

    Const  IDC_HSL       =  5009

    Const  IDC_VSL       =  5010

    Const  IDC_FRM       =  5011

    Const  IDC_ICO       =  5012

    Const  IDC_STC       =  5013

    Const  IDC_RUN       =  5014


    Type CONTROLS
        hwnd As HANDLE         ' save handles and sizes of controls
        rect As RECT           ' for further processing ...
    End Type


   Dim Shared  hctl     As CONTROLS
   Dim Shared  fDrawing As Integer

   Dim Shared  cType    As Integer


Declare Function replace(Byval text As String,Byval del As String,Byval r As String)As String

Declare Sub DrawGrid (Byval hDC As HDC, rc As RECT, nSize As Long)

' #########################################################################
Declare Function WinMain(hInstance As HINSTANCE,hPrevInstance As HINSTANCE,lpCmdLine     As LPSTR,     _
                nCmdShow      As Integer ) As Integer

               
End WinMain(GetModuleHandle(0),NULL,Command,SW_SHOWMAXIMIZED)

Function WinMain(hInstance As HINSTANCE, hPrevInstance As HINSTANCE, lpCmdLine  As LPSTR,     _
    nCmdShow  As Integer ) As Integer


    Static msg  As MSG

    ' handle parent registration error
    If Not InitializeApplication() Then

    Function = FALSE
    End If

   
     ' Form Principale
    hwndFrame = CreateWindowEx(WS_EX_LEFT, szFrame,                      _
        "Bide - Form Designer", WS_OVERLAPPEDWINDOW, CW_USEDEFAULT,       _
        CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, FileMenu, NULL,      _
        hInst, NULL)

    CenterWindow(hwndFrame)
    ShowWindow(hwndFrame, SW_SHOWNORMAL)
    UpdateWindow(hwndFrame)

    While GetMessage(@msg, Cast(HWND,NULL), 0, 0)
        If (Not TranslateMDISysAccel(hwndMDIClient, @msg)) And            _
        (Not TranslateAccelerator(hwndFrame, hAccel, @msg)) Then

            TranslateMessage(@msg)
            DispatchMessage(@msg)
        End If

    Wend


    Function = msg.wParam
End Function


' #########################################################################
'
'   this is *very* important!
'   must have LRESULT CALLBACK or
'   will crash under Windows 98 SE
'
' #########################################################################

Function MPFrameWndProc( hWnd As HWND,uMsg As UINT, wParam As WPARAM,lParam As LPARAM  _
    ) As LRESULT

    Static cc      As CLIENTCREATESTRUCT
    Static rc      As RECT
    Static tHeight As Integer

    Static sHeight As Integer


    Select Case uMsg
    Case WM_COMMAND
        Select Case wParam
        Case IDM_NEW
            CreateChild("Untitled")

        Case IDM_HTOOL
            If IsWindowVisible(hToolbar) Then

                ShowWindow(hToolbar, SW_HIDE)
                CheckMenuItem(FileMenu, IDM_HTOOL, MF_BYCOMMAND  Or          _
                    MF_CHECKED)
                SendMessage(hwndFrame, WM_SIZE, 0, 0)
            Else

                ShowWindow(hToolbar, SW_SHOW)
                CheckMenuItem(FileMenu, IDM_HTOOL, MF_BYCOMMAND  Or          _
                    MF_UNCHECKED)
                SendMessage(hwndFrame, WM_SIZE, 0, 0)
            End If


        Case IDM_HSTATUS
            If IsWindowVisible(hStatus) Then

                ShowWindow(hStatus, SW_HIDE)
                CheckMenuItem(FileMenu, IDM_HSTATUS, MF_BYCOMMAND  Or        _
                    MF_CHECKED)
                SendMessage(hwndFrame, WM_SIZE, 0, 0)
            Else

                ShowWindow(hStatus, SW_SHOW)
                CheckMenuItem(FileMenu, IDM_HSTATUS, MF_BYCOMMAND  Or        _
                    MF_UNCHECKED)
                SendMessage(hwndFrame, WM_SIZE, 0, 0)
            End If


        Case IDM_HTOOLBOX
            If IsWindowVisible(hToolbox) Then

                ShowWindow(hToolbox, SW_HIDE)
                CheckMenuItem(FileMenu, IDM_HTOOLBOX, MF_BYCOMMAND  Or       _
                    MF_CHECKED)
            Else

                ShowWindow(hToolbox, SW_SHOW)
                CheckMenuItem(FileMenu, IDM_HTOOLBOX, MF_BYCOMMAND  Or       _
                    MF_UNCHECKED)
            End If


        Case IDM_EXIT
            SendMessage(hwndFrame, WM_SYSCOMMAND, SC_CLOSE, NULL)

        Case IDM_CGEN
            If Not hCodegen Then

                ' create code generator window
                CreateChild("Code Generator")
                hCodegen = FindWindowEx(hwndMDIClient, NULL, NULL,        _
                    "Code Generator")
                SetWindowLong(hCodegen, GWL_EXSTYLE, WS_EX_PALETTEWINDOW)
                GetClientRect(hCodegen, @rc)
                MoveWindow(hCodegen, rc.left, rc.top, rc.right - rc.left, _
                    rc.bottom - rc.top, TRUE)
                lpCodegenProc = Cast(WNDPROC,SetWindowLong(hCodegen, GWL_WNDPROC,      _
                    Cast(Long,@CodegenProc)))

                hCGEdit = CreateWindowEx(WS_EX_STATICEDGE, "edit", " ",    _
                    WS_CHILD  Or  WS_VISIBLE  Or  WS_TABSTOP  Or  WS_VSCROLL  Or      _
                    WS_HSCROLL  Or  ES_AUTOHSCROLL  Or  ES_AUTOVSCROLL  Or         _
                    ES_MULTILINE  Or  ES_WANTRETURN  Or  ES_READONLY, 0, 0, 0,  _
                    0, hCodegen, NULL, hInst, NULL)

                SendMessage(hCGEdit, WM_SETFONT,                          _
                    Cast(WPARAM,GetStockObject(DEFAULT_GUI_FONT)), MAKELPARAM(FALSE,0))

                SendMessage(hCodegen, WM_SIZE, 0, 0)
            Else

                ShowWindow(hCodegen, SW_SHOWNORMAL)
            End If


            SendMessage(hCGEdit, WM_SETTEXT, 0, Cast(LPARAM, ""))

            ' get parent's info first
            CreateCodeProc(hwndMDIClient, Cast(LPARAM, -12345))
           
            ' get all child controls next
            EnumChildWindows(hwndMDIClient, Cast(WNDENUMPROC,@CreateCodeProc), 0)
           
        Case IDM_CASCADE
            SendMessage(hwndMDIClient, WM_MDICASCADE, 0, 0)

        Case IDM_TILEH
            SendMessage(hwndMDIClient, WM_MDITILE,MDITILE_HORIZONTAL, 0)

        Case IDM_TILEV
            SendMessage(hwndMDIClient, WM_MDITILE, MDITILE_VERTICAL, 0)

        Case IDM_ARRANGE
            SendMessage(hwndMDIClient, WM_MDIICONARRANGE, 0, 0)

        Case IDM_RESTORE
            EnumChildWindows(hwndMDIClient,Cast(WNDENUMPROC,@EnumChildProc) , 0)

        Case IDM_MINWIN
            EnumChildWindows(hwndMDIClient, Cast(WNDENUMPROC,@EnumChildProc), 1)

        Case IDM_CLOSE
            EnumChildWindows(hwndMDIClient, Cast(WNDENUMPROC,@EnumChildProc), 2)

        Case IDM_ABOUT
            CreateChild("Created by dl")
        End Select

        ''''must be shure to post all command msgs to frame procedure
        Return DefFrameProc(hwnd, hwndMDIClient, uMsg, wParam, lParam)
    Case WM_CREATE
        hToolbar = MakeToolbar(hWnd, hInst)
        hStatus = CreateStatusWindow(WS_VISIBLE  Or  WS_CHILD  Or               _
            SBS_SIZEGRIP, Cast(LPCTSTR, NULL), hWnd, 0)

        ' handle child registration error
        If Not RegisterChild() Then

            Function = FALSE
        End If


        ' handle menu registration error
        If Not ApplyMenu(hWnd) Then

            Function = FALSE
        End If


        cc.hWindowMenu  = GetSubMenu(MainMenu, 0)
        cc.idFirstChild = IDW_FIRST
        hwndMDIClient = CreateWindowEx(WS_EX_CLIENTEDGE, "MDICLIENT",     _
            NULL, WS_CHILD  Or  WS_CLIPCHILDREN  Or  WS_VISIBLE  Or                _
            WS_VSCROLL  Or  WS_HSCROLL, 0, 0, 0, 0, hWnd, NULL, hInst,       _
            @cc)

        ToolbarAddButton(hToolbar, IDM_NEW,  "New Dialog",                _
            TBSTYLE_BUTTON  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hToolbar, IDM_CGEN, "Code Generator",            _
            TBSTYLE_BUTTON  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hToolbar, 0, "", TBSTYLE_SEP)
        ToolbarAddButton(hToolbar, IDM_EXIT, "Exit", TBSTYLE_BUTTON  Or      _
            TBSTYLE_AUTOSIZE)
           
        ShowWindow(hToolbar,SW_SHOW)
       
        ' create toolbox child window
        CreateChild("Toolbox")

        hToolbox = FindWindowEx(hwndMDIClient, NULL, NULL, "Toolbox")
        SetWindowLong(hToolbox, GWL_EXSTYLE, WS_EX_PALETTEWINDOW)
        MoveWindow(hToolbox, 0, 20, 130, 140, TRUE)

        hTBtoolbar = MakeToolbar(hToolbox, hInst)
        ToolbarAddButton(hTBtoolbar, IDC_RUN, "Runtime",                  _
            TBSTYLE_CHECKGROUP  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hTBtoolbar, IDC_SEL, "Select",                   _
            TBSTYLE_CHECKGROUP  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hTBtoolbar, IDC_EDT, "Edit",                     _
            TBSTYLE_CHECKGROUP  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hTBtoolbar, IDC_GRP, "Group",                    _
            TBSTYLE_CHECKGROUP  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hTBtoolbar, IDC_BTN, "Button",                   _
            TBSTYLE_CHECKGROUP  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hTBtoolbar, IDC_CHK, "Check",                    _
            TBSTYLE_CHECKGROUP  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hTBtoolbar, IDC_RAD, "Radio",                    _
            TBSTYLE_CHECKGROUP  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hTBtoolbar, IDC_CMB, "Combo",                    _
            TBSTYLE_CHECKGROUP  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hTBtoolbar, IDC_LST, "List",                     _
            TBSTYLE_CHECKGROUP  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hTBtoolbar, IDC_HSL, "HScroll",                  _
            TBSTYLE_CHECKGROUP  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hTBtoolbar, IDC_VSL, "VScroll",                  _
            TBSTYLE_CHECKGROUP  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hTBtoolbar, IDC_FRM, "Frame",                    _
            TBSTYLE_CHECKGROUP  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hTBtoolbar, IDC_ICO, "Icon",                     _
            TBSTYLE_CHECKGROUP  Or  TBSTYLE_AUTOSIZE)
        ToolbarAddButton(hTBtoolbar, IDC_STC, "Static",                   _
            TBSTYLE_CHECKGROUP  Or  TBSTYLE_AUTOSIZE)

        lpToolboxProc = Cast(WNDPROC,SetWindowLong(hToolbox, GWL_WNDPROC, Cast(DWORD,@ToolboxProc)))
        SendMessage(hToolbox, WM_SIZE, 0, 0)

    Case WM_SIZE
        SendMessage(hToolbar, TB_AUTOSIZE, 0, 0)
        MoveWindow(hStatus, 0, 0, 0, 0, TRUE)

        If IsWindowVisible(hToolbar) Then

            GetWindowRect(hToolbar, @rc)
            rc.bottom = rc.bottom - rc.top
            tHeight = rc.bottom
        Else

            tHeight = 0

        End If


        If IsWindowVisible(hStatus) Then

            GetWindowRect(hStatus, @rc)
            rc.bottom = rc.bottom - rc.top
            sHeight = rc.bottom
        Else

            sHeight = 0

        End If


        GetClientRect(hWnd, @rc)
        sHeight = (rc.bottom - tHeight) - sHeight

        MoveWindow(hwndMDIClient, 0, tHeight, rc.right, sHeight, TRUE)
       

            Case WM_CLOSE
         DestroyWindow(hwnd)
       
            Case WM_DESTROY
         PostQuitMessage(0)
     
      Case Else

         Return DefFrameProc(hwnd, hwndMDIClient, uMsg, wParam, lParam)
   End Select

   Return 0

End Function


' #########################################################################
'
'   this is *very* important!
'   must have LRESULT CALLBACK or
'   will crash under Windows 98 SE
'
' #########################################################################

Function MPMDIChildWndProc(hWnd As HWND,uMsg As UINT,wParam As WPARAM, lParam As LPARAM ) As LRESULT

    Static x As Integer

    Static y As Integer

    Static fDrag As Integer

    Static xStart As Integer

    Static yStart As Integer

    Static pt     As Point

    Static hdc    As HDC
     Dim   rc        As RECT
     Dim   ps        As PAINTSTRUCT

    Select Case uMsg
           
            Case WM_PAINT
       Dim  hDC As HDC
          If gfTestForm = 0 Then

   
                                hDC  = BeginPaint(hWnd,@ps)

                                'Draw the Grid on the Client area of the Main Form
                                'Optimization, Use PAINTSTRUCT.rcPaint
                                        If gGridOnOff = 1 Then

                                            rc = ps.rcPaint
                                    DrawGrid(hDC,rc,gGridSize)
                                        End If


                         EndPaint(hWnd,@ps)

                                        Function =0

                                        Exit Function

          Else

                                        hDC = BeginPaint(hWnd,@ps)
                                 EndPaint(hWnd,@ps)
                                Function =0

                                Exit Function

                            End If

    Case WM_LBUTTONDOWN
        ' protect our custom windows
        If hWnd = hToolbox Or hWnd = hCodegen Or cType = -1 Then

            Function = 0

        End If


        'Set starting points
            If gSnapOnOff = 1 Then

                pt.x = Loword ( lParam ) - Loword ( lParam ) Mod gGridSize
                pt.y = Hiword ( lParam ) - Hiword ( lParam ) Mod gGridSize
            Else

                pt.x = Loword ( lParam )
                pt.y = Hiword ( lParam )
            End If


        SetCapture(hWnd)
        xStart   = Loword(lparam)
        yStart   = Hiword(lparam)
        fDrawing = TRUE
        Return 0


    Case WM_MOUSEMOVE
        x = Loword(lparam)              ' current X position
        y = Hiword(lparam)              ' current Y position

        If fDrawing Then

            If gSnapOnOff = 1 Then

                x = Loword (lParam ) - Loword ( lParam ) Mod gGridSize
                y = Hiword (lParam ) - Hiword ( lParam ) Mod gGridSize
            Else

                x = Loword (lParam )
                y = Hiword (lParam )
            End If

            hdc = GetDC(hWnd)
            SetROP2(hdc, R2_NOTXORPEN)
            DrawFocusRect(hdc, @hctl.rect)

            If xStart > x Then

                hctl.rect.left  = x
                hctl.rect.right = xStart
            Else                       ' going right
                hctl.rect.left  = xStart
                hctl.rect.right = x
            End If


            If yStart < y Then

                hctl.rect.bottom = y
                hctl.rect.top    = yStart
            Else                                  ' going right
                hctl.rect.bottom = yStart
                hctl.rect.top    = y
            End If


            DrawFocusRect(hdc, @hctl.rect)
            ReleaseDC(hWnd, hdc)
        End If

        Return 0


    Case WM_LBUTTONUP
        x = Loword(lparam)              ' current X position
        y = Hiword(lparam)              ' current Y position

        If fDrag Then

            fDrag = FALSE
            ReleaseCapture
            Exit Select

        End If


        If fDrawing Then

            ReleaseCapture()

            If xStart > x Then

                hctl.rect.left  = x
                hctl.rect.right = xStart
            Else    ' going right
                hctl.rect.left  = xStart
                hctl.rect.right = x
            End If


            If yStart < y Then

                hctl.rect.bottom = y
                hctl.rect.top    = yStart
            Else    ' going right
                hctl.rect.bottom = yStart
                hctl.rect.top    = y
            End If


            CreateControlEx(hWnd)

            hctl.rect.left = 0

            hctl.rect.top = 0

            hctl.rect.right = 0

            hctl.rect.bottom = 0

            DrawFocusRect(hdc, @hctl.rect)

            InvalidateRect(hWnd,0,TRUE)
            UpdateWindow(hWnd)
            ReleaseCapture()

            fDrawing = FALSE
        End If

        Return 0

    End Select


    Return DefMDIChildProc(hWnd, uMsg, wParam, lParam)
End Function


' #########################################################################
'   abstract:   registers parent  window class
'   usage   :   InitializeApplication()
' #########################################################################

Function InitializeApplication() As BOOL
    Static wc As WNDCLASSEX

    ' register the frame window class
    wc.cbSize        = Sizeof(WNDCLASSEX)
    wc.style         = CS_HREDRAW  Or  CS_VREDRAW  Or  CS_BYTEALIGNWINDOW
    wc.lpfnWndProc   = @MPFrameWndProc
    wc.cbClsExtra    =  NULL
    wc.cbWndExtra    = NULL
    wc.hInstance     = hInst
    wc.hbrBackground = Cast(HBRUSH, NULL )   ' fixes flicker
    wc.lpszMenuName  = NULL
    wc.lpszClassName = Strptr(szFrame)
    wc.hIcon         = LoadIcon(NULL, IDI_APPLICATION)
    wc.hCursor       = LoadCursor(NULL, IDC_ARROW)
    wc.hIconSm       = LoadIcon(NULL, IDI_APPLICATION)
    If Not RegisterClassEx(@wc) Then

    Function = FALSE
    End If



 'Initialize the Grid size, 
    'set some limits here!!!!   '<4,6,8,10,12,16,18> ??? Never Zero!
    gGridSize  = 8              'Min 2 works well with Grid=0

    'Initialize Grid            'User can set grid on/off
    gGridOnOff = 1            'Turn Grid Off if less than 4x4

    'Initialize Snap            'User can set snap on/off
    gSnapOnOff = 1            '

    Function = TRUE
End Function


' #########################################################################
'   abstract:   registers child window class
'   usage   :   RegisterChild()
' #########################################################################

Function RegisterChild() As BOOL
    Static wc As WNDCLASSEX

    ' register the MDI child window class
    wc.cbSize        = Sizeof(WNDCLASSEX)
    wc.style         = CS_HREDRAW  Or  CS_VREDRAW  Or  CS_BYTEALIGNWINDOW
    wc.lpfnWndProc   = @MPMDIChildWndProc
    wc.cbClsExtra    =  NULL
    wc.cbWndExtra    =  NULL
    wc.hInstance     = hInst
    wc.hbrBackground = Cast(HBRUSH, (COLOR_BTNFACE + 1))
    wc.lpszMenuName  = NULL
    wc.lpszClassName = Strptr(szChild)
    wc.hIcon         = LoadIcon(NULL, IDI_WINLOGO)
    wc.hCursor       = LoadCursor(NULL, IDC_ARROW)
    wc.hIconSm       = LoadIcon(NULL, IDI_WINLOGO)
    If Not RegisterClassEx(@wc) Then

        Function = FALSE
    End If


    Function = TRUE
End Function


' #########################################################################
'   abstract:   creates tooltip for any control
'   usage   :   MakeTooltip(hControl, "Tip Information", hInstance)
' #########################################################################

Function MakeTooltip(      _
    hwndOwner As HWND,     _
    lpszText  As LPSTR,    _
    hInst     As HINSTANCE _
    ) As BOOL

    Static hwndTT As HWND
    Static ti     As TOOLINFO
    Static uid    As WPARAM
    Static rect   As RECT

    ' initialize common controls
    If Not LoadCCLibrary(ICC_BAR_CLASSES) Then

        Function = FALSE
    End If


    ' create a tooltip window
    hwndTT = CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, NULL,          _
        WS_POPUP  Or  TTS_NOPREFIX  Or  TTS_ALWAYSTIP, CW_USEDEFAULT,           _
        CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, hwndOwner, NULL,     _
        hInst, NULL)
    If Not hwndTT Then

        Function = FALSE
    End If


    SetWindowPos(hwndTT, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE  Or            _
    SWP_NOSIZE  Or  SWP_NOACTIVATE)

    ' get coordinates of the main client area
    GetClientRect (hwndOwner, @rect)

    ' initialize members of the toolinfo structure
    ti.cbSize      = Sizeof(TOOLINFO)
    ti.uFlags      = TTF_SUBCLASS
    ti.hwnd        = hwndOwner
    ti.hinst       = hInst
    ti.uId         = uid
    ti.lpszText    = lpszText

    ' tooltip control will cover the whole window
    ti.rect.left   = rect.left
    ti.rect.top    = rect.top
    ti.rect.right  = rect.right
    ti.rect.bottom = rect.bottom

    ' send an addtool message to the tooltip control window
    Function = SendMessage(hwndTT, TTM_ADDTOOL, 0, Cast(LPARAM, Cast(LPTOOLINFO, @ti)))
End Function


' #########################################################################
'   abstract:   initializes windows common control library
'   usage   :   LoadCCLibrary(common_control_classes)
' #########################################################################

Function LoadCCLibrary(dwICC As DWORD) As BOOL
    Static iccex As INITCOMMONCONTROLSEX

    iccex.dwICC  = dwICC
    iccex.dwSize = Sizeof(INITCOMMONCONTROLSEX)

    If Not InitCommonControlsEx(@iccex) Then

        Function = FALSE
    End If


    Function = TRUE
End Function


' #########################################################################
'   abstract:   creates rebar frame
'   usage   :   MakeRebar(hParent, hInstance)
' #########################################################################

Function MakeRebar(hwndOwner As HWND, hInst As HINSTANCE ) As HWND

    Static hwndRB As HWND
    Static rbi    As REBARINFO

    ' initialize common controls
    If Not LoadCCLibrary(ICC_BAR_CLASSES) Then

        Function = FALSE
    End If


    hwndRB = CreateWindowEx(WS_EX_TOOLWINDOW, REBARCLASSNAME, NULL,       _
        WS_BORDER  Or  WS_CHILD  Or  WS_VISIBLE  Or  WS_CLIPCHILDREN  Or              _
        WS_CLIPSIBLINGS  Or  RBS_VARHEIGHT  Or  RBS_AUTOSIZE  Or                   _
        RBS_BANDBORDERS  Or  CCS_ADJUSTABLE  Or  CCS_TOP  Or  CCS_NODIVIDER, 0, 0, _
        0, 0, hwndOwner, NULL, hInst, NULL)

    If Not hwndRB Then

        Function = NULL
    End If


    ' initialize and send the rebarinfo structure
    rbi.cbSize = Sizeof(REBARINFO)
    rbi.fMask  = 0

    rbi.himl   = Cast(HIMAGELIST,NULL)
    SendMessage(hwndRB, RB_SETBARINFO, 0, Cast(LPARAM, @rbi))

    Function = hwndRB
End Function


' #########################################################################
'   abstract:   adds a band to a rebar
'   usage   :   RebarAddBand(hParent, hControl, "Title of Band")
' #########################################################################

Function RebarAddBand(hwndOwner As HWND,hwndChild As HWND,lpTitle As LPSTR) As BOOL

    Static rbBand As REBARBANDINFO

    ' initialize structure members that both bands will share
    rbBand.cbSize  = Sizeof(REBARBANDINFO)
    rbBand.fMask   = RBBIM_TEXT  Or  RBBIM_STYLE  Or  RBBIM_CHILD  Or              _
                     RBBIM_CHILDSIZE  Or  RBBIM_SIZE
    rbBand.fStyle  = RBBS_CHILDEDGE  Or  RBBS_GRIPPERALWAYS

    ' set values unique to the band
    rbBand.lpText     = lpTitle
    rbBand.cch        = 2

    rbBand.hwndChild  = hwndChild
    rbBand.cxMinChild = 0

    rbBand.cyMinChild = 0

    rbBand.cx         = 200


    ' add the band to rebar
    Function = SendMessage(hwndOwner, RB_INSERTBAND, Cast(WPARAM, -1),         _
        Cast(LPARAM, @rbBand))
End Function


' #########################################################################
'   abstract:   creates toolbar
'   usage   :   MakeToolbar(hParent, hInstance)
' #########################################################################

Function MakeToolbar(hwndOwner As HWND,hInst As HINSTANCE ) As HWND

    Static hwndTB  As HWND

    hwndTB = CreateWindow(TOOLBARCLASSNAME, NULL, WS_VISIBLE Or WS_CHILD  Or  CCS_TOP  Or     _
        TBSTYLE_LIST  Or  CCS_ADJUSTABLE  Or  TBSTYLE_WRAPABLE  Or  TBSTYLE_FLAT    _
       , 0, 0, 0, 0, hwndOwner, Cast(HMENU,NULL), hInst, NULL)

    If 0=hwndTB Then

        Return NULL
    End If


    Return hwndTB
End Function


' #########################################################################
'   abstract:   adds buttons to toolbar
'   usage   :   ToolbarAddButton(hParent, idCommand, hInstance)
' #########################################################################

Sub ToolbarAddButton( hwndOwner As HWND, idCommand As Integer, lpTitle  As LPSTR, dwStyle As Byte  )

    Static tbb      As TBBUTTON

    ' send the TB_BUTTONSTRUCTSIZE message, which is required for
    ' backward compatibility
    SendMessage(hwndOwner, TB_BUTTONSTRUCTSIZE, Sizeof(TBBUTTON), 0)

    ' fill the TBBUTTON array with button information, and add the
    ' buttons to the toolbar
    tbb.idCommand = idCommand
    tbb.fsState   = TBSTATE_ENABLED
    tbb.fsStyle   = dwStyle
    tbb.dwData    = 0

    tbb.iString   = SendMessage(hwndOwner, TB_ADDSTRING, 0, Cast(LPARAM,lpTitle))
    tbb.iBitmap   = -2


    SendMessage(hwndOwner, TB_SETBUTTONSIZE, 0, MAKELONG(16, 16))
    SendMessage(hwndOwner, TB_ADDBUTTONS, 1, Cast(DWORD, @tbb))
End Sub


' #########################################################################
'   abstract:   repositions any window to the center of the screen
'   usage   :   CenterWindow(hParent)
' #########################################################################

Sub CenterWindow(hWnd As HWND)
    Static wRect As RECT
    Static x     As DWORD
    Static y     As DWORD

    GetWindowRect(hWnd, @wRect)
    x = (GetSystemMetrics(SM_CXSCREEN) - (wRect.right - wRect.left)) / 2

    y = (GetSystemMetrics(SM_CYSCREEN) - (wRect.bottom - wRect.top +      _
        GetSystemMetrics(SM_CYCAPTION))) / 2

    SetWindowPos(hWnd, NULL, x, y, 0, 0, SWP_NOSIZE  Or  SWP_NOZORDER)
End Sub


' #########################################################################
'   abstract:   creates default menu for mdi parent
'   usage   :   ApplyMenu(hParent)
' #########################################################################

Function ApplyMenu(hwndOwner As HWND) As BOOL
    ' create menu handles
    MainMenu = CreateMenu()
    FileMenu = CreateMenu()
    CWinMenu = CreateMenu()
    HelpMenu = CreateMenu()

    ' create file menu
    AppendMenu(FileMenu, MF_STRING,    IDM_NEW,     Strptr("&New Dialog"))
    AppendMenu(FileMenu, MF_SEPARATOR, 0, "")
    AppendMenu(FileMenu, MF_STRING,    IDM_HTOOL,   Strptr("&Hide Toolbar"))
    AppendMenu(FileMenu, MF_STRING,    IDM_HSTATUS, Strptr("&Hide Statusbar"))
    AppendMenu(FileMenu, MF_STRING,    IDM_HTOOLBOX,Strptr("&Hide Toolbox"))
    AppendMenu(FileMenu, MF_SEPARATOR, 0, "")
    AppendMenu(FileMenu, MF_STRING,    IDM_EXIT,    Strptr("E&xit"))

    ' create window menu
    AppendMenu(CWinMenu, MF_STRING,    IDM_CASCADE, "&Cascade")
    AppendMenu(CWinMenu, MF_STRING,    IDM_TILEH,   "Tile &Horizontally")
    AppendMenu(CWinMenu, MF_STRING,    IDM_TILEV,   "&Tile Vertically")
    AppendMenu(CWinMenu, MF_STRING,    IDM_ARRANGE, "&Arrange Icons")
    AppendMenu(CWinMenu, MF_SEPARATOR, 0, "")
    AppendMenu(CWinMenu, MF_STRING,    IDM_RESTORE, "&Restore All")
    AppendMenu(CWinMenu, MF_STRING,    IDM_MINWIN,  "&Minimize All")
    AppendMenu(CWinMenu, MF_STRING,    IDM_CLOSE,   "C&lose All")

    ' create help window
    AppendMenu(HelpMenu, MF_STRING,    IDM_ABOUT,   "&About")

    ' attach menus to menubar
    InsertMenu(MainMenu, 0, MF_POPUP, Cast(UINT,FileMenu), "&File")
    InsertMenu(MainMenu, 1, MF_POPUP, Cast(UINT,CWinMenu), "&Window")
    InsertMenu(MainMenu, 2, MF_POPUP, Cast(UINT,HelpMenu), "&Help")

    ' activate menu
    If Not SetMenu(hwndOwner, MainMenu) Then

        Function = FALSE
    End If


    Function = TRUE
End Function


' #########################################################################
'   abstract:   creates child window
'   usage   :   CreateChild("Title of Window")
' #########################################################################

Function CreateChild(lpWindowName As String) As HWND
    Function = CreateWindowEx(WS_EX_MDICHILD, szChild, lpWindowName,    _
        WS_VISIBLE  Or  MDIS_ALLCHILDSTYLES, CW_USEDEFAULT, CW_USEDEFAULT,   _
        CW_USEDEFAULT, CW_USEDEFAULT, hwndMDIClient, NULL, hInst, NULL)
End Function


' #########################################################################
'   abstract:   controls what can be done with child mdi windows
'   usage   :   EnumChildProc(hWindow, lParam)
' #########################################################################

Function EnumChildProc(hwnd As HWND, lParam As LPARAM ) As BOOL 

    ' protect our custom parent and children windows
    If hwnd = hToolbox Or GetParent(hwnd) = hToolbox Or                   _
    hwnd = hCodegen Or GetParent(hwnd) = hCodegen Then

        Function = TRUE
    End If


    Select Case lParam
    Case 0

        ShowWindow(hwnd, SW_RESTORE)
    Case 1

        ShowWindow(hwnd, SW_MINIMIZE)
    Case 2

        SendMessage(hwndMDIClient, WM_MDIDESTROY, Cast(WPARAM,hwnd), 0)
    End Select


    Function = TRUE
End Function


' #########################################################################
'   abstract:   handles code generator messages
'   usage   :   CodegenProc(hWindow, wMsg, wParam, lParam)
' #########################################################################

 Function CodegenProc(Byval hWnd   As HWND, _
                     Byval Msg    As UINT, Byval wParam As  WPARAM, _
                     Byval lParam As LPARAM) As LRESULT
    Static rc As RECT

    Select Case Msg
    Case WM_SIZE
        GetClientRect(hWnd, @rc)
        MoveWindow(hCGEdit, 0, 0, rc.right - rc.left, rc.bottom - rc.top, TRUE)
        Function = 0

    Case WM_CLOSE
        ShowWindow(hCodegen, SW_HIDE)
        Function = 0

       
    End Select


    Function = CallWindowProc(lpCodegenProc, hWnd, Msg, wParam, lParam)
End Function


' #########################################################################
'   abstract:   handles toolbox messages
'   usage   :   ToolboxProc(hWindow, wMsg, wParam, lParam)
' #########################################################################

 Function ToolboxProc(Byval hWnd   As HWND, _
                     Byval Msg    As UINT, Byval wParam As  WPARAM, _
                     Byval lParam As LPARAM) As LRESULT
    Select Case Msg
    Case WM_COMMAND
        Select Case wParam
        Case IDC_RUN : cType = -1

        Case IDC_SEL : cType = 0

        Case IDC_EDT : cType = 1

        Case IDC_GRP : cType = 2

        Case IDC_BTN : cType = 3

        Case IDC_CHK : cType = 4

        Case IDC_RAD : cType = 5

        Case IDC_CMB : cType = 6

        Case IDC_LST : cType = 7

        Case IDC_HSL : cType = 8

        Case IDC_VSL : cType = 9

        Case IDC_FRM : cType = 10

        Case IDC_ICO : cType = 11

        Case IDC_STC : cType = 12

        End Select

        Function = 0


    Case WM_CLOSE
        ShowWindow(hToolbox, SW_HIDE)
        CheckMenuItem(FileMenu, IDM_HTOOLBOX, MF_BYCOMMAND  Or  MF_CHECKED)
        Function = 0


    Case WM_SIZE
        SendMessage(hTBtoolbar, TB_AUTOSIZE, 0, 0)
        Function = 0

    End Select


    Function = CallWindowProc(lpToolboxProc, hWnd, Msg, wParam, lParam)
End Function


' #########################################################################
'   abstract:   creates a control at run-time
'   usage   :   CreateControlEx(hParent)
' #########################################################################

Sub CreateControlEx( hwndOwner As HWND )

    Static hCtle   As HWND
    Static xStyle As DWORD
    Static cStyle As DWORD
    Static cClass As LPSTR
    Static cText  As LPSTR
    Static As Integer id = 10000


    Select Case cType
        Case -1

            ' do nothing
        Case 0

            ' do nothing
        Case 1

            xStyle = WS_EX_STATICEDGE
            cStyle = WS_VSCROLL  Or  WS_HSCROLL  Or  ES_AUTOHSCROLL  Or            _
                     ES_AUTOVSCROLL  Or  ES_MULTILINE  Or  ES_WANTRETURN
            cClass = Strptr("edit")
            cText  = Strptr("Edit")
        Case 2

            xStyle = 0

            cStyle = BS_GROUPBOX
            cClass = Strptr("button")
            cText  = Strptr("Group")
        Case 3

            xStyle = 0

            cStyle = BS_PUSHBUTTON
            cClass = Strptr("button")
            cText  = Strptr("Button")
        Case 4

            xStyle = WS_EX_STATICEDGE
            cStyle = BS_AUTOCHECKBOX
            cClass = Strptr("button")
            cText  = Strptr("Check")
        Case 5

            xStyle = WS_EX_STATICEDGE
            cStyle = BS_AUTORADIOBUTTON
            cClass = Strptr("button")
            cText  = Strptr("Radio")
        Case 6

            xStyle = 0

            cStyle = WS_VSCROLL  Or  CBS_DROPDOWN  Or  CBS_SORT
            cClass = Strptr("combobox")
            cText  = Strptr("Combo")
        Case 7

            xStyle = WS_EX_STATICEDGE
            cStyle = WS_VSCROLL  Or  LBS_SORT  Or  LBS_STANDARD
            cClass = Strptr("listbox")
            cText  = Strptr("List")
        Case 8

            xStyle = 0

            cStyle = SBS_HORZ
            cClass = Strptr("scrollbar")
            cText  = Strptr("HScroll")
        Case 9

            xStyle = 0

            cStyle = SBS_VERT
            cClass = Strptr("scrollbar")
            cText  = Strptr("VScroll")
        Case 10

            xStyle = WS_EX_STATICEDGE
            cStyle = SS_BLACKFRAME  Or  SS_NOTIFY
            cClass = Strptr("static")
            cText  = Strptr("Frame")
        Case 11

            xStyle = WS_EX_STATICEDGE
            cStyle = SS_BITMAP  Or  SS_NOTIFY
            cClass = Strptr("static")
            cText  = Strptr("Picture")
        Case 12

            xStyle = WS_EX_STATICEDGE
            cStyle = SS_NOTIFY
            cClass = Strptr("static")
            cText  = Strptr("Label")
    End Select


    If cType > 0 Then

              INCR id
        hCtle = CreateWindowEx(xStyle, cClass, cText, WS_CHILD  Or            _
            WS_VISIBLE  Or  WS_TABSTOP  Or  cStyle, hctl.rect.left,             _
            hctl.rect.top, hctl.rect.right - hctl.rect.left,              _
            hctl.rect.bottom - hctl.rect.top, hwndOwner, Cast(HMENU,id), hInst, NULL)

        SendMessage(hCtle, WM_SETFONT, Cast(WPARAM,GetStockObject(DEFAULT_GUI_FONT)), Cast(LPARAM,MAKELPARAM(FALSE,0)))

        Select Case cClass
        Case Strptr("edit")
            lpEditProc   = Cast(WNDPROC,SetWindowLong(hCtle, GWL_WNDPROC, Cast(DWORD,@EditProc)))
        Case Strptr("button")
            lpButtonProc = Cast(WNDPROC,SetWindowLong(hCtle, GWL_WNDPROC, Cast(DWORD,@ButtonProc)))
        Case Strptr("static")
            lpStaticProc = Cast(WNDPROC,SetWindowLong(hCtle, GWL_WNDPROC, Cast(DWORD,@StaticProc)))
        Case Strptr("scrollbar")
            lpScrollProc = Cast(WNDPROC,SetWindowLong(hCtle, GWL_WNDPROC, Cast(DWORD,@ScrollProc)))
        Case Strptr("combobox")
            SendMessage(hCtle, CB_ADDSTRING, 0, Cast(LPARAM, Strptr("for")))
            SendMessage(hCtle, CB_ADDSTRING, 0, Cast(LPARAM, Strptr("your")))
            SendMessage(hCtle, CB_ADDSTRING, 0, Cast(LPARAM, Strptr("enjoyment")))
            SendMessage(hCtle, CB_ADDSTRING, 0, Cast(LPARAM, Strptr("I")))
            SendMessage(hCtle, CB_ADDSTRING, 0, Cast(LPARAM, Strptr("added")))
            SendMessage(hCtle, CB_ADDSTRING, 0, Cast(LPARAM, Strptr("some")))
            SendMessage(hCtle, CB_ADDSTRING, 0, Cast(LPARAM, Strptr("combobox")))
            SendMessage(hCtle, CB_ADDSTRING, 0, Cast(LPARAM, Strptr("strings")))
            lpComboProc  = Cast(WNDPROC,SetWindowLong(hCtle, GWL_WNDPROC, Cast(DWORD,@ComboProc)))
        Case Strptr("listbox")
            SendMessage(hCtle, LB_ADDSTRING, 0, Cast(LPARAM, Strptr("for")))
            SendMessage(hCtle, LB_ADDSTRING, 0, Cast(LPARAM, Strptr("your")))
            SendMessage(hCtle, LB_ADDSTRING, 0, Cast(LPARAM, Strptr("enjoyment")))
            SendMessage(hCtle, LB_ADDSTRING, 0, Cast(LPARAM, Strptr("I")))
            SendMessage(hCtle, LB_ADDSTRING, 0, Cast(LPARAM, Strptr("added")))
            SendMessage(hCtle, LB_ADDSTRING, 0, Cast(LPARAM, Strptr("some")))
            SendMessage(hCtle, LB_ADDSTRING, 0, Cast(LPARAM, Strptr("listbox")))
            SendMessage(hCtle, LB_ADDSTRING, 0, Cast(LPARAM, Strptr("strings")))
            lpListProc   = Cast(WNDPROC,SetWindowLong(hCtle, GWL_WNDPROC, Cast(DWORD,@ListProc)))
        End Select

    End If

End Sub


' #########################################################################
'   abstract:   detects location of mouse in object
'   usage   :   HitTest(hControl, lParam)
' #########################################################################

Function HitTest( hCtl As HWND, lParam As LPARAM ) As Integer


    Static pt As Point

    Static rc As RECT

    pt.x = Loword(lparam)
    pt.y = Hiword(lparam)

    ScreenToClient (hCtl, @pt)
    GetWindowRect  (hCtl, @rc)

    MapWindowPoints(HWND_DESKTOP, GetParent(hCtl), Cast(LPPOINT,@rc), 2)

    If pt.y < 4 And pt.x < 4 Then

        Return HTTOPLEFT
    Elseif pt.y < 4 And pt.x >= (rc.right - rc.left - 4) Then

        Return HTTOPRIGHT
    Elseif pt.y >= (rc.bottom - rc.top - 4) And pt.x >=                   _
        (rc.right - rc.left - 4) Then

        Return HTBOTTOMRIGHT
    Elseif pt.x < 4 And pt.y >= (rc.bottom - rc.top - 4) Then

        Return HTBOTTOMLEFT
    Elseif pt.y < 4 Then

        Return HTTOP
    Elseif pt.x < 4 Then

        Return HTLEFT
    Elseif pt.x >= (rc.right - rc.left - 4) Then

        Return HTRIGHT
    Elseif pt.y >= (rc.bottom - rc.top - 4) Then

        Return HTBOTTOM
    Else

        Return HTCLIENT
    End If

End Function


' #########################################################################
'   abstract:   handles run-time controls
'   usage   :   EditProc(hControl, wMsg, wParam, lParam)
' #########################################################################

Function EditProc(hCtl As HWND,uMsg As UINT,wParam As WPARAM, lParam As LPARAM ) As LRESULT

    Select Case uMsg
    Case WM_LBUTTONDOWN
        If cType <> -1 Then

            ReleaseCapture()
            SendMessage(hCtl, WM_NCLBUTTONDOWN, HTCAPTION, 0)
            Return 0

        End If

    Case WM_LBUTTONUP
        If cType <> -1 Then

            ReleaseCapture()
            Return 0

        End If

    Case WM_LBUTTONDBLCLK
        MessageBox(hCtl, "WM_LBUTTONDBLCLK", "edit", MB_OK)
        'NB: ICI ON PEUT CREER DANS LE CODE private sub NOMFORM_DBLCLCK()
        Return 0

    Case WM_RBUTTONDOWN
        If cType <> -1 Then

            DestroyWindow(hCtl)
            BringWindowToTop(hCtl)
            Return 0

        End If

    Case WM_NCHITTEST
        If cType <> -1 Then

            Return HitTest(hCtl,lParam)
        End If

    Case WM_SIZING   '* Gridize while sizing
        If cType <> -1 Then

            Return 0

        End If

    Case WM_MOVING   '* Gridize while moving
        If cType <> -1 Then

            Return 0

        End If

    End Select


    Return CallWindowProc(lpEditProc, hCtl, uMsg, wParam, lParam)
End Function


' #########################################################################
'   abstract:   handles run-time controls
'   usage   :   ButtonProc(hControl, wMsg, wParam, lParam)
' #########################################################################

Function ButtonProc(hCtl As HWND,uMsg As UINT, wParam As WPARAM, lParam As LPARAM  ) As LRESULT 

    Select Case uMsg
    Case WM_LBUTTONDOWN
        If cType <> -1 Then

            ReleaseCapture()
            SendMessage(hCtl, WM_NCLBUTTONDOWN, HTCAPTION, 0)
            Return 0

        End If

    Case WM_LBUTTONUP
        If cType <> -1 Then

            ReleaseCapture()
            Return 0

        End If

    Case WM_LBUTTONDBLCLK
        MessageBox(hCtl, "WM_LBUTTONDBLCLK", "button", MB_OK)
        Return 0

    Case WM_RBUTTONDOWN
        If cType <> -1 Then

            DestroyWindow(hCtl)
            BringWindowToTop(hCtl)
            Return 0

        End If

    Case WM_NCHITTEST
        If cType <> -1 Then

            Return HitTest(hCtl,lParam)
        End If

    Case WM_SIZING   '* Gridize while sizing
        If cType <> -1 Then

            Return 0

        End If

    Case WM_MOVING   '* Gridize while moving
        If cType <> -1 Then

            Return 0

        End If

    End Select


    Return CallWindowProc(lpButtonProc, hCtl, uMsg, wParam, lParam)
End Function


' #########################################################################
'   abstract:   handles run-time controls
'   usage   :   StaticProc(hControl, wMsg, wParam, lParam)
' #########################################################################

Function StaticProc(hCtl As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM ) As LRESULT 

    Select Case uMsg
    Case WM_LBUTTONDOWN
        If cType <> -1 Then

            ReleaseCapture()
            SendMessage(hCtl, WM_NCLBUTTONDOWN, HTCAPTION, 0)
            Return 0

        End If

    Case WM_LBUTTONUP
        If cType <> -1 Then

            ReleaseCapture()
            Return 0

        End If

    Case WM_LBUTTONDBLCLK
        MessageBox(hCtl, "WM_LBUTTONDBLCLK", "static", MB_OK)
        Return 0

    Case WM_RBUTTONDOWN
        If cType <> -1 Then

            DestroyWindow(hCtl)
            BringWindowToTop(hCtl)
            Return 0

        End If

    Case WM_NCHITTEST
        If cType <> -1 Then

            Return HitTest(hCtl,lParam)
        End If

    Case WM_SIZING   '* Gridize while sizing
        If cType <> -1 Then

            Return 0

        End If

    Case WM_MOVING   '* Gridize while moving
        If cType <> -1 Then

            Return 0

        End If

    End Select


    Return CallWindowProc(lpStaticProc, hCtl, uMsg, wParam, lParam)
End Function


' #########################################################################
'   abstract:   handles run-time controls
'   usage   :   ComboProc(hControl, wMsg, wParam, lParam)
' #########################################################################

Function ComboProc(hCtl As HWND,uMsg As UINT, wParam As WPARAM,lParam As LPARAM ) As LRESULT 

    Select Case uMsg
    Case WM_LBUTTONDOWN
        If cType <> -1 Then

            ReleaseCapture()
            SendMessage(hCtl, WM_NCLBUTTONDOWN, HTCAPTION, 0)
            Return 0

        End If

    Case WM_LBUTTONUP
        If cType <> -1 Then

            ReleaseCapture()
            Return 0

        End If

    Case WM_LBUTTONDBLCLK
        MessageBox(hCtl, "WM_LBUTTONDBLCLK", "combobox", MB_OK)
        Return 0

    Case WM_RBUTTONDOWN
        If cType <> -1 Then

            DestroyWindow(hCtl)
            BringWindowToTop(hCtl)
            Return 0

        End If

    Case WM_NCHITTEST
        If cType <> -1 Then

            Return HitTest(hCtl,lParam)
        End If

    Case WM_SIZING   '* Gridize while sizing
        If cType <> -1 Then

            Return 0

        End If

    Case WM_MOVING   '* Gridize while moving
        If cType <> -1 Then

            Return 0

        End If

    End Select


    Return CallWindowProc(lpComboProc, hCtl, uMsg, wParam, lParam)
End Function


' #########################################################################
'   abstract:   handles run-time controls
'   usage   :   ListProc(hControl, wMsg, wParam, lParam)
' #########################################################################

Function ListProc(hCtl As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM ) As LRESULT 

    Select Case uMsg
    Case WM_LBUTTONDOWN
        If cType <> -1 Then

            ReleaseCapture()
            SendMessage(hCtl, WM_NCLBUTTONDOWN, HTCAPTION, 0)
            Return 0

        End If

    Case WM_LBUTTONUP
        If cType <> -1 Then

            ReleaseCapture()
            Return 0

        End If

    Case WM_LBUTTONDBLCLK
        MessageBox(hCtl, "WM_LBUTTONDBLCLK", "listbox", MB_OK)
        Return 0

    Case WM_RBUTTONDOWN
        If cType <> -1 Then

            DestroyWindow(hCtl)
            BringWindowToTop(hCtl)
            Return 0

        End If

    Case WM_NCHITTEST
        If cType <> -1 Then

            Return HitTest(hCtl,lParam)
        End If

    Case WM_SIZING   '* Gridize while sizing
        If cType <> -1 Then

            Return 0

        End If

    Case WM_MOVING   '* Gridize while moving
        If cType <> -1 Then

            Return 0

        End If

    End Select


    Return CallWindowProc(lpListProc, hCtl, uMsg, wParam, lParam)
End Function


' #########################################################################
'   abstract:   handles run-time controls
'   usage   :   ScrollProc(hControl, wMsg, wParam, lParam)
' #########################################################################

Function ScrollProc(hCtl As HWND, uMsg As UINT,wParam As WPARAM,lParam As LPARAM ) As LRESULT 

    Select Case uMsg
    Case WM_LBUTTONDOWN
        If cType <> -1 Then

            ReleaseCapture()
            SendMessage(hCtl, WM_NCLBUTTONDOWN, HTCAPTION, 0)
            Return 0

        End If

    Case WM_LBUTTONUP
        If cType <> -1 Then

            ReleaseCapture()
            Return 0

        End If

    Case WM_LBUTTONDBLCLK
        MessageBox(hCtl, "WM_LBUTTONDBLCLK", "listbox", MB_OK)
        Return 0

    Case WM_RBUTTONDOWN
        If cType <> -1 Then

            DestroyWindow(hCtl)
            BringWindowToTop(hCtl)
            Return 0

        End If

    Case WM_NCHITTEST
        If cType <> -1 Then

            Return HitTest(hCtl,lParam)
        End If

    Case WM_SIZING   '* Gridize while sizing
        If cType <> -1 Then

            Return 0

        End If

    Case WM_MOVING   '* Gridize while moving
        If cType <> -1 Then

            Return 0

        End If

    End Select


    Return CallWindowProc(lpScrollProc, hCtl, uMsg, wParam, lParam)
End Function


' #########################################################################

Function CreateCodeProc( hwnd As HWND, lParam As LPARAM ) As BOOL

    Static dwExStyle As String*255

    Static lpClassName As String*MAX_PATH
    Static lpWindowName As String*MAX_PATH
    Static dwStyle As String*255

    Static x As String*255

    Static y As String*25

    Static nWidth As String*25

    Static nHeight As String*25

    Static hMenu As String*255

    Static lpKeyName As String*255

    Static lpTemp As String*255

    Static lpBuffer As String* 35840

    Static rc As RECT
    Static a  As Long


    ' protect our custom parent and children windows
    If hwnd = hToolbox Or GetParent(hwnd) = hToolbox Or                   _
    hwnd = hCodegen Or GetParent(hwnd) = hCodegen Then

        Return TRUE
    End If


    ' extended window style
    a = GetWindowLong(hwnd, GWL_EXSTYLE)
    dwExStyle = TRIM$(Str$(a))

    ' registered class name
    GetClassName(hwnd, lpClassName, 2048)

    ' window name
    GetWindowText(hwnd, lpWindowName, 2048)

    ' window style
    a = GetWindowLong(hwnd, GWL_STYLE)
    dwStyle = TRIM$(Str$(a))

    ' horizontal position of window
    GetWindowRect(hwnd, @rc)        ' get control
    a = rc.left
    GetWindowRect(GetParent(hwnd), @rc)    ' get parent
    x = TRIM$(Str$((a-rc.left)-2))

    ' vertical position of window
    GetWindowRect(hwnd, @rc)        ' get control
    a = rc.top
    GetWindowRect(GetParent(hwnd), @rc)    ' get parent
    y = TRIM$(Str$((a-rc.top)-20))

    ' window width
    GetWindowRect(hwnd, @rc)
    a = (rc.right-rc.left)
    nWidth = TRIM$(Str$(a))

    ' window height
    GetWindowRect(hwnd, @rc)
    a = (rc.bottom-rc.top)
    nHeight = TRIM$(Str$(a))

    a = GetWindowLong(hwnd, GWL_ID)
    hMenu = TRIM$(Str$(a))
         Print lpKeyName
 
    Select Case(Lcase$(lpClassName))
    Case "button"
        INCR iButton
        lpKeyName = "Button" & TRIM$(Str$(iButton))

    Case "checkbox"
        INCR iCheckbox
        lpKeyName = "Checkbox" & TRIM$(Str$(iCheckbox))
    Case "radio"
        INCR iRadio
        lpKeyName = "Radio" & TRIM$(Str$(iRadio))
    Case "static"
        INCR iStatic
        lpKeyName = "Static" & TRIM$(Str$(iStatic))
    Case "scrollbar"
        INCR iScrollBar
        lpKeyName = "ScrollBar" & TRIM$(Str$(iScrollBar))
    Case "edit"
        INCR iEdit
        lpKeyName = "Edit" & TRIM$(Str$(iEdit))
    Case "listbox"
        INCR iListBox
        lpKeyName = "ListBox" & TRIM$(Str$(iListBox))
    Case "combobox"
        INCR iComboBox
        lpKeyName = "ComboBox" & TRIM$(Str$(iComboBox))
    Case Else

        ' don't get mdi parent
        If lParam = -12345 Then

            Return TRUE
        Else

            INCR iControl
            lpKeyName = "Form" & Trim$(Str$(iControl))
        End If

    End Select


    lpTemp = "DIM SHARED  \Name AS HWND/CONST   ID_\Name =  \ID//\Name = CreateWindowEx(\ExStyles, \Class, \Caption, _/\Styles, \x, \y, \w, \h, _/Form1, ID_\Name, hInst, NULL)//SendMessage(\Name, WM_SETFONT, _/GetStockObject(DEFAULT_GUI_FONT), MAKELPARAM(FALSE, 0))/"
    lpTemp = replace( lpTemp, "\Name", lpKeyName)
    lpTemp = replace( lpTemp, "\ID", hMenu)
    lpTemp = replace( lpTemp, "\ExStyles", dwExStyle)
    lpTemp = replace( lpTemp, "\Class", lpClassName)
    lpTemp = replace( lpTemp, "\Caption", lpWindowName)
    lpTemp = replace( lpTemp, "\Styles", dwStyle)
    lpTemp = replace( lpTemp, "\x", x)
    lpTemp = replace( lpTemp, "\y", y)
    lpTemp = replace( lpTemp, "\w", nWidth)
    lpTemp = replace( lpTemp, "\h", nHeight)

    lpTemp = replace(lpTemp, "/", Chr$(13,10))

    ' replace with " doesn't work for some reason
     lpTemp = replace( lpTemp, "`", Chr$(34))

    lpBuffer = ""
    SendMessage(hCGEdit, WM_GETTEXT, 35840, Cast(LPARAM, Strptr(lpBuffer)))
    'lstrcat(lpBuffer, lpTemp)
    lpBuffer=lpBuffer + lpTemp
   
    SendMessage(hCGEdit, WM_SETTEXT, 0, Cast(LPARAM, Strptr(lpBuffer)))

    Return TRUE
End Function


' #########################################################################


Function replace(Byval text As String,Byval del As String,Byval r As String)As String

        Dim As Long i,s,c,lr
        Dim As String cmd
        cmd=text
        lr=Len(del)
        If Instr(cmd,del)=1 Then

                cmd=r+Mid$(cmd,lr+1,-1)
        End If

        s=1

        Do

                i=Instr(s,cmd,del)
                If i>0 Then

                        cmd=Mid$(cmd,1,i-1)+r+Mid$(cmd,i+lr,-1)
                        s=i+lr
                End If

        Loop Until i=0

        Function=cmd
End Function


Sub DrawGrid (Byval hDC As HDC, rc As RECT, nSize As Long)

    Dim  i As Long

    Dim  j As Long



    'NOTE: We want to optimize this to reduce flicker during a Move
    '      operation. We should just repaint the previous position
    '      of the control, assume the caller is giving us the rcPaint
    '      member from the PAINTSTRUCT inside a WM_PAINT block

    For  i = 0 To rc.Right Step nSize
        For j= 0 To rc.Bottom Step nSize
             SetPixel(hDC, i,j,Rgb(0,0,0))
        Next

    Next


End Sub