
'====================================================================
'' Version 0.4
''
''  Removed option explicit.
''
''  In the Control procedure changed "class" to "_class".
''
''  Added a ByRef to "lpdt as LPDLGTEMPLATE" and to all string
''  parameters, and added the ByVal that was missing on some of
''  the parameters of other types.
''
''  Should now work for 0.15b, 0.16b, and 0.17b up through the
''  CVS build from February 21, 2007.
''
'' Version 0.3
''
''  First release.
''
'====================================================================

'====================================================================
'' This module contains procedures and definitions to support the
'' creation of a dialog box template in allocated memory, and the
'' creation of a modal or modeless dialog from the template.
''
'' The dialog box template consists of a DLGTEMPLATE structure
'' followed by three or four variable-length arrays, followed by
'' zero or more DLGITEMTEMPLATE structures each followed by three
'' variable-length arrays. The DLGTEMPLATE structure and the
'' associated arrays define the dialog window. The DLGITEMTEMPLATE
'' structures and the associated arrays define the controls in the
'' dialog.
''
'' The variable-length arrays consist of WORD (16-bit) elements.
'' The first three arrays following the DLGTEMPLATE structure
'' specify the menu, class, and title for the dialog. The three
'' arrays following each DLGITEMTEMPLATE structure specify the
'' class, title, and creation data for the control. Each of these
'' arrays will have at least one element, and the system will
'' interpret the contents of the array based on the value of the
'' first element. For the dialog menu, class, and title arrays,
'' and the control creation data array, if the first element is
'' zero, then the array is effectively empty and there are no
'' other elements. For the dialog menu and class arrays, and the
'' control class and title arrays, if the first element is FFFFh,
'' then the second element contains the ordinal value of a
'' resource or a predefined class, and the array contains no other
'' elements. For the dialog menu, class, and title arrays, and the
'' control class and title arrays, if the first element is any
'' value other than zero or FFFFh, then the array is assumed to be
'' a null-terminated Unicode string. Depending on the array, this
'' Unicode string can specify the name of a menu resource, a
'' registered class, the dialog title, or the initial text for a
'' control. For the control creation data array, if the first
'' element is non-zero, then it contains the length, in bytes, of
'' the creation data that follows. The fourth array following the
'' DLGTEMPLATE structure, which is present only when the dialog
'' style includes DS_SETFONT, specifies the font point size value
'' in the first element, followed by the name of the typeface as
'' a null-terminated Unicode string.
''
'' This implementation does not permit a menu or class specification
'' for the dialog, or creation data for the controls.
''
'' The DLGTEMPLATE and DLGITEMTEMPLATE structures must be aligned
'' on a DWORD boundary. The variable-length arrays that follow the
'' structures must start on a WORD boundary, but with WORD-size
'' elements and the structure sizes and alignment requirements,
'' this should be automatic.
''
'' Prior to creating a dialog template your source must declare,
'' for each dialog, a pointer to a DLGTEMPLATE structure:
''
'' dim as LPDLGTEMPLATE lpdt
''
'' This pointer is used to store the starting address of the
'' template memory.
'====================================================================

#include once "windows.bi"
#include once "win\richedit.bi"
#include once "win\commctrl.bi"

'' This shared integer is used to implement automatic horizontal
'' centering of a control in a dialog.
''
Dim Shared As Integer g_dialog_width

'' This shared pointer to a WORD is used by the Dialog and
'' control definition procedures to store the current address
'' in the template memory, and by the CreateModalDialog and
'' CreateModelessDialog procedures to resize the memory block
'' before the dialog is created. It is shared as a convenience,
'' because doing so eliminates one parameter from each of the
'' procedures.
''
Dim Shared As LPWORD g_lpw

'' Because of these shared variables dialog definitions cannot
'' be interleaved.

'====================================================================

'' This procedure generates a Unicode string starting at the
'' address specified by g_lpw, and then adds the length, in
'' wide characters, of the string and null terminator to g_lpw.
'' For compatibility with 95/98/Me, the MuliByteToWideChar
'' function is used to generate the strings.
''
Sub GenUstring( Byref asciiString As String )

  '' If asciiString is null, skip the first element of
  '' the array, leaving it set to zero (no string).
  ''
  If asciiString = "" Then
    g_lpw += 1
  Else
    '' CP_ACP specifies that the function should use
    '' the current system ANSI code page to perform
    '' the conversion to Unicode.
    ''
    g_lpw += MultiByteToWideChar( CP_ACP, _
                                  MB_PRECOMPOSED, _
                                  asciistring, _
                                  -1, _
                                  cast(LPWSTR,g_lpw), _
                                  Len(asciiString) + 2 )
  End If

End Sub

'====================================================================

'' This function creates a modal dialog from the dialog box
'' template pointed to by lpdt. Parameter hParent should be
'' zero if the dialog is the main window of the application.
'' Parameter dwInitParam specifies a value that is passed to
'' the dialog box procedure in the lParam parameter of the
'' WM_INITDIALOG message.
''
'' The DialogBoxIndirectParam function does not return until
'' the dialog box is destroyed with the EndDialog function.
'' After freeing the allocated memory, this function returns
'' whatever was specified in the nResult parameter of the
'' EndDialog function.
''
Function CreateModalDialog( Byval hParent As HWND, _
                            Byval lpDialogProc As DLGPROC, _
                            Byval dwInitParam As LPARAM, _
                            Byval lpdt As LPDLGTEMPLATE ) As Integer

  Dim As Integer rval

  '' Resize the memory block to fit the template.
  ''
  GlobalReAlloc( lpdt,cast(Integer,g_lpw) - cast(Integer,lpdt),0 )

  rval = DialogBoxIndirectParam( GetModuleHandle(null), _
                                 lpdt, _
                                 hParent, _
                                 lpDialogProc, _
                                 dwInitParam )
  GlobalFree( lpdt )

  Return rval

End Function


'====================================================================

'' This function creates a modeless dialog from the dialog box
'' template pointed to by lpdt. Parameter hParent should be
'' zero if the dialog is the main window of the application.
'' Parameter lParamInit specifies a value that is passed to
'' the dialog box procedure in the lParam parameter of the
'' WM_INITDIALOG message.
''
'' After freeing the allocated memory, this function returns
'' whatever the CreateDialogIndirectParam function returned,
'' which would normally be the handle to the dialog window.
''
'' Note that the WS_VISIBLE style is required for a modeless
'' dialog to be visible.
''
Function CreateModelessDialog( Byval hParent As HWND, _
                               Byval lpDialogProc As DLGPROC, _
                               Byval lParamInit As LPARAM, _
                               Byval lpdt As LPDLGTEMPLATE ) As HWND

  Dim As HWND rval

  '' Resize the memory block to fit the template.
  ''
  GlobalReAlloc( lpdt,cast(Integer,g_lpw) - cast(Integer,lpdt),0 )

  rval = CreateDialogIndirectParam( GetModuleHandle(null), _
                                    lpdt, _
                                    hParent, _
                                    lpDialogProc, _
                                    lParamInit )
  GlobalFree( lpdt )

  Return rval

End Function

'====================================================================

'' This procedure allocates memory for a dialog template and
'' initializes the essential members of the DLGTEMPLATE structure,
'' the menu, class, and title arrays, and optionally the font
'' point size and typeface array. Returns a pointer to the next
'' WORD following the title or typeface array in g_lpw, and a
'' pointer to the allocated memory in lpdt.
''
'' The initial allocation size, 10KB, should be sufficient even
'' for a large and complex dialog. In the unlikely event that
'' the allocation is not sufficient, the likely result will be a
'' memory access violation at run time. For troubleshooting this
'' problem, the number of bytes of template memory used, at any
'' point in the creation of the template, can be displayed with
'' a statement like this:
''
'' MessageBox( 0, str(cint(g_lpw) - cint(lpdt)), "Bytes Used", 0 )
''
'' The CreateModalDialog and CreateModelessDialog functions resize
'' the memory block to fit the template, freeing any excess.
''
'' Parameter cdit must match the number of controls defined.
'' If the value is too high then the function that creates the
'' dialog will fail. If the value is too low then one or more
'' of the controls will not be created.
''
Sub Dialog( Byval cdit As WORD, _
            Byval x As Short, _
            Byval y As Short, _
            Byval cx As Short, _
            Byval cy As Short, _
            Byref title As String, _
            Byref lpdt As LPDLGTEMPLATE, _
            Byval style As DWORD, _
            Byval pointSize As Short = 0, _
            Byref typeFace As String = "" )

  g_dialog_width = cx

  lpdt = GlobalAlloc( GMEM_FIXED Or GMEM_ZEROINIT, 1024 * 10 )

  '' Memory allocated by GlobalAlloc is guaranteed to be
  '' aligned on an 8-byte boundary. Initialize the essential
  '' members of the structure.
  ''
  lpdt->style = style
  lpdt->cdit = cdit
  lpdt->x  = x
  lpdt->y  = y
  lpdt->cx = cx
  lpdt->cy = cy

  '' Set g_lpw to the menu array that follows the structure.
  ''
  g_lpw = cast(LPWORD,lpdt + 1)

  '' Skip the first element of the menu array, leaving it
  '' set to zero (no menu).
  ''
  g_lpw += 1

  '' Skip the first element of the class array, leaving it
  '' set to zero (no class), so the system will use the
  '' predefined dialog box class.
  ''
  g_lpw += 1

  '' Initialize the title array and set g_lpw to next WORD
  '' following the title array.
  ''
  GenUstring( title )

  '' If the DS_SETFONT style was specified, set the font
  '' point size, initialize the typeface array, and set
  '' g_lpw to next WORD following the typeface array.
  ''
  If style And DS_SETFONT Then
    *g_lpw = pointSize
    g_lpw += 1
    GenUstring( typeFace )
  End If

End Sub

'====================================================================

'' Starting at the address specified by g_lpw, this general-purpose
'' control definition procedure initializes the essential members
'' of a DLGITEMTEMPLATE structure and the class, title and creation
'' data arrays.
''
'' For the class array, for the six predefined system (User32)
'' classes, use the strings "BUTTON", "EDIT", "STATIC", "LISTBOX",
'' "SCROLLBAR", and "COMBOBOX". For common controls use the class
'' strings defined in commctrl.bi.
''
'' The title array can specify the caption or initial text for the
'' control, or the ordinal value of a resource in the executable
'' file. Specify a caption or initial text in the title parameter,
'' or an ordinal value in the rid (ResourceID) parameter. If the
'' rid parameter is non-zero then the title parameter is ignored.
''
'' There is no support for creation data.
''
'' * FOR WINDOWS 95/98/ME, ONLY THE LOW-ORDER BYTE OF THE CONTROL
'' ID (parameter cid) IS USED, SO THE MAXIMUM VALUE IS 255 *
''
'' The tab order of the controls in a dialog is determined by the
'' order in which the controls are created, and by which controls
'' have the WS_TABSTOP style.
''
'' To center the control in the dialog horizontally specify -1
'' for the x parameter. This feature will not work correctly for
'' an auto-sized control where the width is not specified.
''
Sub Control( Byval cid As WORD, _
             Byval x As Short, _
             Byval y As Short, _
             Byval cx As Short, _
             Byval cy As Short, _
             Byref title As String, _
             Byval rid As Short, _
             Byref _class As String, _
             Byval style As DWORD = 0 )

  If x = -1 Then x = (g_dialog_width - cx) / 2

  Dim As LPDLGITEMTEMPLATE lpdit
  Dim As ULONG ul

  '' The DLGITEMTEMPLATE structure must be aligned on a
  '' DWORD boundary.
  ''
  ul = cast(ULONG,g_lpw) + 3
  ul Shr= 2
  ul Shl= 2
  g_lpw = cast(LPWORD,ul)

  '' Initialize the essential members of the structure.
  ''
  '' The establishes the base style as WS_CHILD or WS_VISIBLE.
  ''
  lpdit = cast(LPDLGITEMTEMPLATE,g_lpw)
  lpdit->style = WS_CHILD Or WS_VISIBLE Or style
  lpdit->x  = x
  lpdit->y  = y
  lpdit->cx = cx
  lpdit->cy = cy
  lpdit->id = cid

  '' Set g_lpw to the class array that follows the structure.
  ''
  g_lpw = cast(LPWORD,lpdit + 1)

  '' Initialize the class array and set g_lpw to the next WORD
  '' following the class array.
  ''
  GenUstring( _class )


  '' Initialize the title array and set g_lpw to the next WORD
  '' following the title array.
  ''
  If rid Then
    *g_lpw = &hffff
    g_lpw += 1
    *g_lpw = rid
    g_lpw += 1
  Else
    GenUstring( title )
  End If

  '' Skip the first element of the creation data array, leaving
  '' it set to zero (no creation data).
  ''
  g_lpw += 1

End Sub

'====================================================================
'' The following specialized control definition procedures are
'' simply wrappers for the general-purpose procedure.
'====================================================================

Sub PushButton( Byval cid As WORD, _
                Byval x As Short, _
                Byval y As Short, _
                Byval cx As Short, _
                Byval cy As Short, _
                Byref caption As String, _
                Byval style As DWORD = 0 )

  Control( cid, x, y, cx, cy, caption, 0, "BUTTON", _
           BS_PUSHBUTTON Or style )
End Sub

'====================================================================

Sub DefPushButton( Byval cid As WORD, _
                   Byval x As Short, _
                   Byval y As Short, _
                   Byval cx As Short, _
                   Byval cy As Short, _
                   Byref caption As String, _
                   Byval style As DWORD = 0 )

  Control( cid, x, y, cx, cy, caption, 0, "BUTTON", _
           BS_DEFPUSHBUTTON Or style )
End Sub

'====================================================================

Sub AutoCheckBox( Byval cid As WORD, _
                  Byval x As Short, _
                  Byval y As Short, _
                  Byval cx As Short, _
                  Byval cy As Short, _
                  Byref caption As String, _
                  Byval style As DWORD = 0 )

  Control( cid, x, y, cx, cy, caption, 0, "BUTTON", _
           BS_AUTOCHECKBOX Or style )
End Sub

'====================================================================

Sub AutoRadioButton( Byval cid As WORD, _
                     Byval x As Short, _
                     Byval y As Short, _
                     Byval cx As Short, _
                     Byval cy As Short, _
                     Byref caption As String, _
                     Byval style As DWORD = 0 )

  Control( cid, x, y, cx, cy, caption, 0, "BUTTON", _
           BS_AUTORADIOBUTTON Or style )
End Sub

'====================================================================

Sub GroupBox( Byval cid As WORD, _
              Byval x As Short, _
              Byval y As Short, _
              Byval cx As Short, _
              Byval cy As Short, _
              Byref caption As String, _
              Byval style As DWORD = 0 )

  Control( cid, x, y, cx, cy, caption, 0, "BUTTON", _
           BS_GROUPBOX Or style )
End Sub

'====================================================================

Sub EditText( Byval cid As WORD, _
              Byval x As Short, _
              Byval y As Short, _
              Byval cx As Short, _
              Byval cy As Short, _
              Byref text As String, _
              Byval style As DWORD = 0 )

  Control( cid, x, y, cx, cy, text, 0, "EDIT", _
           style )
End Sub

'====================================================================

Sub LText( Byval cid As WORD, _
           Byval x As Short, _
           Byval y As Short, _
           Byval cx As Short, _
           Byval cy As Short, _
           Byref text As String, _
           Byval style As DWORD = 0 )

  Control( cid, x, y, cx, cy, text, 0, "STATIC", _
           SS_LEFT Or style )
End Sub

'====================================================================

Sub RText( Byval cid As WORD, _
           Byval x As Short, _
           Byval y As Short, _
           Byval cx As Short, _
           Byval cy As Short, _
           Byref text As String, _
           Byval style As DWORD = 0 )

  Control( cid, x, y, cx, cy, text, 0, "STATIC", _
           SS_RIGHT Or style )
End Sub

'====================================================================

Sub CText( Byval cid As WORD, _
           Byval x As Short, _
           Byval y As Short, _
           Byval cx As Short, _
           Byval cy As Short, _
           Byref text As String, _
           Byval style As DWORD = 0 )

  Control( cid, x, y, cx, cy, text, 0, "STATIC", _
           SS_CENTER Or style )
End Sub

'====================================================================

Sub ListBox( Byval cid As WORD, _
             Byval x As Short, _
             Byval y As Short, _
             Byval cx As Short, _
             Byval cy As Short, _
             Byval style As DWORD = 0 )

  Control( cid, x, y, cx, cy, "", 0, "LISTBOX", _
           style )
End Sub

'====================================================================

Sub ComboBox( Byval cid As WORD, _
              Byval x As Short, _
              Byval y As Short, _
              Byval cx As Short, _
              Byval cy As Short, _
              Byval style As DWORD = 0 )

    Control( cid, x, y, cx, cy, "", 0, "COMBOBOX", _
             style )
End Sub

'====================================================================

Sub ScrollBar( Byval cid As WORD, _
               Byval x As Short, _
               Byval y As Short, _
               Byval cx As Short, _
               Byval cy As Short, _
               Byval style As DWORD = 0 )

  Control( cid, x, y, cx, cy, "", 0, "SCROLLBAR", _
           style )
End Sub

'====================================================================
'' To use a Rich Edit control your app must first call LoadLibrary
'' to load the appropriate DLL - RICHED20.DLL for version 2 or 3,
'' or RICHED32.DLL for version 1.
'====================================================================

'' This procedure is coded for version 2 or 3.
''
Sub RichEdit( Byval cid As WORD, _
              Byval x As Short, _
              Byval y As Short, _
              Byval cx As Short, _
              Byval cy As Short, _
              Byval style As DWORD = 0 )

  Control( cid, x, y, cx, cy, "", 0, RICHEDIT_CLASS, _
           style )
End Sub

'' This procedure is coded for version 1.
''
Sub RichEdit1( Byval cid As WORD, _
               Byval x As Short, _
               Byval y As Short, _
               Byval cx As Short, _
               Byval cy As Short, _
               Byval style As DWORD = 0 )

  Control( cid, x, y, cx, cy, "", 0, RICHEDIT_CLASS10A, _
           style )
End Sub

'====================================================================

'' To use controls from the common control DLL, specific common
'' control classes must first be initialized. This procedure
'' initializes 14 of the commonly used common control classes
'' in a single call.
''
'' This procedure uses the InitCommonControlsEx function, which
'' should work for all recent versions of Windows, but it may
'' be necessary to substitute the older InitCommonControls
'' function for Windows 95 or NT.
''
Sub InitializeCommonControls

  Dim As INITCOMMONCONTROLSEX icce

  icce.dwSize = sizeof( INITCOMMONCONTROLSEX )
  icce.dwICC = ICC_ANIMATE_CLASS _
            Or ICC_BAR_CLASSES _
            Or ICC_COOL_CLASSES _
            Or ICC_DATE_CLASSES _
            Or ICC_HOTKEY_CLASS _
            Or ICC_INTERNET_CLASSES _
            Or ICC_LISTVIEW_CLASSES _
            Or ICC_PAGESCROLLER_CLASS _
            Or ICC_PROGRESS_CLASS _
            Or ICC_TAB_CLASSES _
            Or ICC_TREEVIEW_CLASSES _
            Or ICC_UPDOWN_CLASS _
            Or ICC_USEREX_CLASSES _
            Or ICC_WIN95_CLASSES

  InitCommonControlsEx( @icce )

End Sub

'====================================================================
 