In-Memory Dialogs

Windows specific questions.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

In-Memory Dialogs

Post by MichaelW »

New 7/9/15:
Made a small change to DIALOGS.BAS to make it compatible with 64-bit code as well as 32-bit code.

New:
Thanks to D.J.Peters (and KristopherWindsor), all of the source, bitmap, icons, and resource files, as of December 17, 2009, along with a batch file to build everything and the resulting EXEs, are now available in a single zip file:

http://freefile.kristopherw.us/uploads/ ... ialogs.zip


I’m hoping that this is not too big to post.

The original concept for this was from the MASM32 in-memory dialogs, implemented as a set of MASM macros.

The DIALOGS.BAS module provides a simple method of creating a dialog box template in allocated memory, and creating a modal or modeless dialog from the template. Because this method does not depend on resources stored in the application’s executable file it can be used for pre-built dialogs that must be stored in a library module. Because this method does not require a dialog editor, resource compiler, or resource definition, and because there is no need to define and resister a window class, or for a modal dialog provide a message loop, at least for simple dialogs coding is quick and easy.

The primary difference between a modal dialog and a modeless dialog is that a modal dialog retains the application’s input focus while it is open, where a modeless dialog does not. When either type of dialog is created the system makes it the active window. When a modal dialog with an owner window is created the owner window, along with any child window belonging to it, is disabled, and it cannot be made active again until the dialog is destroyed with the EndDialog function. When a modeless dialog with an owner window is created the owner window is not disabled, and it can be made active again, at any time, by the user or by the application.

There are several secondary differences between modal dialogs and modeless dialogs. The system dialog box manager provides a message loop for a modal dialog, where the application must provide a message loop for a modeless dialog. A modal dialog is destroyed with the EndDialog function, where a modeless dialog is destroyed with the DestroyWindow function. The owner window for a modal dialog cannot be hidden or destroyed until the dialog is destroyed, where a modeless dialog with an owner window is hidden or destroyed by the system when the owner window is hidden or destroyed.

Coordinates and width and height values in a dialog box are specified in dialog template units. Dialog template units are based on the average width and height of the font used, allowing the dialog box to have essentially the same on-screen proportions and appearance (but not the same apparent size) across different resolutions and/or aspect ratios. For reference, a horizontal dialog template unit is 1/4 the average width of the font, in pixels, and a vertical dialog template unit is 1/8 the height of the font, in pixels.

DIALOGS.BAS:

Code: Select all

'====================================================================
'' Version 0.5
''
''  Small modification for compatibility with 32 and 64-bit code.
''  See comment starting on line 343.
''
'' 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
  
  ''--------------------------------------------------------------
  '' Changed following two statements from the Windows data type
  '' ULONG to the FreeBASIC type UINTEGER so the size would match
  '' the size of a pointer, 32 bits for 32-bit code and 64 bits
  '' for 64-bit code.
  ''--------------------------------------------------------------
  
  dim as UINTEGER ul
  
  '' The DLGITEMTEMPLATE structure must be aligned on a
  '' DWORD boundary.
  ''
  ul = cast(UINTEGER,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

'====================================================================
Dialogs defined with the Dialog procedure in DIALOGS.BAS use the system-defined dialog box class. This is a reference declaration for the dialog box procedure (the callback function that processes the messages sent to the dialog) for dialogs that use the system-defined dialog box class:

Code: Select all

declare function DialogProc( byval hDlg as  HWND, _
                             byval uMsg as UINT, _
                             byval wParam as WPARAM, _
                             byval lParam as LPARAM ) as integer
The following is a quick description of the most common messages that a dialog box procedure handles.

WM_INITDIALOG

This message is sent before the dialog is displayed. The handler typically performs any necessary initialization of the dialog and/or the controls in the dialog.

wParam contains the handle to the control that will receive the keyboard input focus.

lParam contains data from the function that created the dialog (see the CreateModalDialog and CreateModelessDialog functions in DIALOGS.BAS).

Return true directly if the system should set the keyboard focus, false otherwise.

WM_COMMAND

This message is sent when a control sends a notification, when an accelerator is translated, or when the user selects a menu command.

The high-order word of wParam contains the notification code if the message is from a control, 1 if the message is from an accelerator, or 0 if the message is from a menu. The low-order word of wParam contains the control, accelerator, or menu item identifier.

lParam contains the handle to the control that sent the message, or null if the message is not from a control.

Return zero directly if this message is processed.

WM_NOTIFY

This message is sent by a common control to notify the parent window that some event has occurred, or to obtain information that the control requires.

wParam is supposed to contain the common control identifier, but it cannot not be depended on to identify the control.

lParam contains a pointer to a NMHDR structure, and the hwndFrom and idFrom members of the structure can be depended on to identify the control.

Except for notification messages were the documentation specifies otherwise, the return value is ignored.

WM_SIZE

This message is sent when the dialog window size has changed.

wParam specifies the type of sizing request.

The low-order word of lParam contains the new width of the client area, and the high-order word the new height of the client area, both in pixels.

Return zero directly if this message is processed.

WM_CLOSE

This message is typically sent when the user attempts to close the dialog.

wParam is not used.
lParam is not used.

Return zero directly if this message is processed.

The handler can choose to close (destroy) the dialog, or not. For a modal dialog use the EndDialog function to destroy the dialog. For a modeless dialog use the DestroyWindow function to destroy the dialog.

WM_DESTROY

This message is sent when the dialog is being destroyed.

wParam is not used
lParam is not used

For a modal dialog there is typically no need to handle this message. For a modeless dialog the handler should call PostQuitMessage (which will post a WM_QUIT message to the thread’s message queue) and return zero directly.


This is a typical message loop for a modeless dialog:

Code: Select all

dim as MSG wMsg
do while GetMessage( @wMsg, null, 0, 0 ) <> 0
  if IsDialogMessage( hDlg,  @wMsg ) = 0 then
      TranslateMessage( @wMsg )
      DispatchMessage( @wMsg )
  end if
loop
GetMessage retrieves messages from the calling thread’s message queue, returning zero when it retrieves a WM_QUIT message. If no message is available, then GetMessage waits for a message to be posted before it returns. The IsDialogMessage function translates and dispatches all messages for the dialog. TranslateMessage and DispatchMessage are included for applications where they are required, to process tool tips, for example, and will be called only if IsDialogMessage does not process the message. See the examples for variations of this message loop.

IDCANCEL is a special identifier that is documented with the MessageBox function. If the user presses the Escape key the dialog box procedure is sent a WM_COMMAND message with the low-order word of wParam set to IDCANCEL, regardless of whether or not the dialog contains a control with this identifier.

A few simple examples:

Code: Select all

'====================================================================
'' MONTHCAL_CLASS common control demo, modal dialog as main.
'====================================================================

#include "dialogs.bas"

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

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer

  select case uMsg

    case WM_COMMAND

      if loword(wParam) = IDCANCEL then
        EndDialog( hDlg, null )
      end if

    case WM_CLOSE

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt

InitializeCommonControls

Dialog( 1, 0, 0, 120, 110, "Today", lpdt, _
        WS_OVERLAPPED or WS_SYSMENU or DS_CENTER )

Control( 100, -1, 0, 120, 100, "", 0, MONTHCAL_CLASS )

CreateModalDialog( 0, @DialogProc, 0, lpdt )

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

Code: Select all

'====================================================================
'' Button grid demo, modal dialog as main.
'====================================================================

#include "dialogs.bas"

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

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer

  static state(100 to 200) as integer

  select case uMsg

    case WM_COMMAND

      if hiword(wParam) = BN_CLICKED then

        if state(loword(wParam)) then
          SetDlgItemText( hDlg, loword(wParam), "" )
          state(loword(wParam)) = 0
        else
          SetDlgItemText( hDlg, loword(wParam), "X" )
          state(loword(wParam)) = 1
        end if

      end if

    case WM_CLOSE

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt

dim as short id, r, c

Dialog( 100, 0, 0, 122, 130, "Button Grid Demo", lpdt, _
        WS_OVERLAPPED or WS_SYSMENU or DS_CENTER )

id = 100
for c = 10 to 100 step 10
  for r = 10 to 100 step 10
    PushButton( id, r, c, 9, 9, "", WS_TABSTOP )
    id += 1
  next
next

CreateModalDialog( 0, @DialogProc, 0, lpdt )

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

Code: Select all

'====================================================================
'' Control grouping demo, modal dialog as main.
'====================================================================

#include "dialogs.bas"

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

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer

  select case uMsg

    case WM_COMMAND

      dim as integer ctrl, res
      dim as string state

      if hiword(wParam) = BN_CLICKED then

        if loword(wParam) = 105 then

          state = ""
          for ctrl = 101 to 104
            res = IsDlgButtonChecked( hDlg, ctrl )
            if res = BST_CHECKED then
              state = state & "1"
            else
              state = state & "0"
            end if
          next
          MessageBox( hDlg, state, "State", 0 )

        elseif loword(wParam) = IDCANCEL then

          EndDialog( hDlg, null )

        end if

      end if

    case WM_CLOSE

        EndDialog( hDlg, null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt

Dialog( 8, 0, 0, 150, 100, "Group Demo", lpdt, _
        WS_OVERLAPPED or WS_SYSMENU or DS_CENTER )

GroupBox( 100, 10, 5, 80, 35, "GroupBox1" )

'' By default all of the controls in a dialog form a single group.
'' The WS_GROUP style specifies the first control in a group, with
'' the group extending up to, but not including, the next control
'' in the tab order that has the WS_GROUP style. Unlike the VB
'' Frame control, a GroupBox control provides visual grouping
'' only.
''
AutoRadioButton( 101, 15, 15, 70, 10, "AutoRadioButton&1", _
                 WS_TABSTOP or WS_GROUP )

AutoRadioButton( 102, 15, 25, 70, 10, "AutoRadioButton&2" )

GroupBox( 110, 10, 45, 80, 35, "GroupBox2" )

AutoRadioButton( 103, 15, 55, 70, 10, "AutoRadioButton&3", _
                 WS_TABSTOP or WS_GROUP )

AutoRadioButton( 104, 15, 65, 70, 10, "AutoRadioButton&4" )

DefPushButton( 105, 100, 10, 38, 12, "&Get State", _
               WS_TABSTOP or WS_GROUP )

PushButton( IDCANCEL, 100, 28, 38, 12, "Cancel", WS_TABSTOP )

CreateModalDialog( 0, @DialogProc, 0, lpdt )

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

Code: Select all

'====================================================================
'' Menu demo, fully programmed (no menu resource) with keyboard
'' accelerators, modeless dialog as main.
''
'' Keyboard accelerators are easier to implement in a modeless
'' dialog because you have direct access to the message loop.
'====================================================================

#include "dialogs.bas"

'' For 0.15b through 0.17b July 30, 2006, uncomment the following
'' option escape and remove the "!" prefix on the AppendMenu string
'' arguments.

'option escape

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

dim shared as HACCEL g_hAccel

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

'' The ACCEL structure, as defined in the 0.16b winuser.bi, is
'' padded to a length of 8 bytes, instead of the 6 bytes that
'' the API expects. This definition corrects the problem, so
'' in an array elements beyond the first will work correctly.
''
type _ACCEL field = 2
    fVirt as BYTE
    key as WORD
    cmd as WORD
end type

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

function InitMenu() as HMENU

  dim as HMENU hMenu, hFileMenu
  dim as _ACCEL accl( 0 to 2)

  hMenu = CreateMenu
  hFileMenu = CreateMenu

  AppendMenu( hMenu, MF_POPUP, cast(UINT_PTR,hFileMenu), "&File" )
  AppendMenu( hFileMenu, MF_STRING, 1000, !"&New\tCtrl+N" )
  AppendMenu( hFileMenu, MF_SEPARATOR, 0, 0 )
  AppendMenu( hFileMenu, MF_STRING, 1001, !"&Open\tCtrl+O" )
  AppendMenu( hFileMenu, MF_SEPARATOR, 0, 0 )
  AppendMenu( hFileMenu, MF_STRING, 1002, !"&Save\tCtrl+S" )
  AppendMenu( hFileMenu, MF_STRING, 1003, !"Save &As" )
  AppendMenu( hFileMenu, MF_SEPARATOR, 0, 0 )
  AppendMenu( hFileMenu, MF_STRING, 1004, !"E&xit\tAlt+F4" )

  accl(0).fVirt = FCONTROL or FVIRTKEY
  accl(0).key = asc("N")
  accl(0).cmd = 1000
  accl(1).fVirt = FCONTROL or FVIRTKEY
  accl(1).key = asc("O")
  accl(1).cmd = 1001
  accl(2).fVirt = FCONTROL or FVIRTKEY
  accl(2).key = asc("S")
  accl(2).cmd = 1002

  g_hAccel = CreateAcceleratorTable( cast(LPACCEL,@accl(0)), 3 )

  return hMenu

end function

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

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer

  select case uMsg

    case WM_INITDIALOG

      SetMenu( hDlg, InitMenu() )

      return true

    case WM_COMMAND

      select case loword(wParam)
        case 1000
          MessageBox( hDlg, "New", "", 0 )
        case 1001
          MessageBox( hDlg, "Open", "", 0 )
        case 1002
          MessageBox( hDlg, "Save", "", 0 )
        case 1003
          MessageBox( hDlg, "Save As", "", 0 )
        case 1004
          DestroyWindow( hDlg )
      end select

    case WM_CLOSE

      DestroyWindow( hDlg )

    case WM_DESTROY

      DestroyAcceleratorTable( g_hAccel )
      PostQuitMessage( null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt
dim as HWND hDlg
dim as MSG wMsg

Dialog( 1, 0, 0, 150, 100, "Menu Demo", lpdt, _
        WS_OVERLAPPEDWINDOW or DS_CENTER or WS_VISIBLE )

'' The dialog must have at least one control or the menu
'' will not activate correctly with Alt + access key.
''
LText( 100, 0, 0, 0, 0, "" )

hDlg = CreateModelessDialog( 0, @DialogProc, 0, lpdt )

do while GetMessage( @wMsg, null, 0, 0 ) <> 0
  if TranslateAccelerator( hDlg, g_hAccel, @wMsg ) = 0 then
    if IsDialogMessage( hDlg,  @wMsg ) = 0 then
      TranslateMessage( @wMsg )
      DispatchMessage( @wMsg )
    end if
  end if
loop

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

Code: Select all

'====================================================================
'' Status bar demo, modal dialog as main.
'====================================================================

#include "dialogs.bas"

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

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer

  static as HWND hWndSB
  static as RECT rcDlg, rcSB

  select case uMsg

    case WM_INITDIALOG

      dim as integer widths(0 to 3)

      hWndSB = GetDlgItem( hDlg, 100 )

      GetClientRect( hDlg, @rcDlg )
      widths(0) = rcDlg.right \ 4
      widths(1) = rcDlg.right * 2 \ 4
      widths(2) = rcDlg.right * 3 \ 4
      widths(3) = -1              '' part extends to window border

      SendMessage( hWndSB, SB_SETPARTS, 4, cast(LPARAM,@widths(0)) )

      return true

    case WM_SIZE

      dim as integer sbHeight
      dim as string status

      GetClientRect( hDlg, @rcDlg )
      GetWindowRect( hWndSB, @rcSB )
      sbHeight = rcSB.bottom - rcSB.top + 1

      MoveWindow( hWndSB, 0, rcDlg.bottom - sbHeight , _
                  loword(lParam), rcDlg.bottom - sbHeight, false )

      '' For a simple status bar with just one part,
      '' the text can be set with WM_SETTEXT.
      ''
      status = " " & str(rcDlg.right) & "x" & str(rcDlg.bottom)
      SendMessage( hWndSB,SB_SETTEXT,0,cast(LPARAM,strptr(status)) )
      SendMessage( hWndSB,SB_SETTEXT,1,cast(LPARAM,@" part 1") )
      SendMessage( hWndSB,SB_SETTEXT,2,cast(LPARAM,@" part 2") )
      SendMessage( hWndSB,SB_SETTEXT,3,cast(LPARAM,@" part 3 ") )

      rcDlg.bottom -= sbHeight
      InvalidateRect( hDlg, @rcDlg, true )

    case WM_CLOSE

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt

InitializeCommonControls

Dialog( 1, 0, 0, 120, 90, "Status Bar Demo", lpdt, _
        WS_OVERLAPPEDWINDOW or DS_CENTER )

'' Instead of trying to anticipate the position and/or size of
'' the controls, just use zeros and set the correct values in
'' the WM_SIZE handler.
''
Control( 100, 0, 0, 0, 0, "", 0, STATUSCLASSNAME )

CreateModalDialog( 0, @DialogProc, 0, lpdt )

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

Code: Select all

'====================================================================
'' Toolbar demo, with tooltips, modeless dialog as main.
'====================================================================

#include "dialogs.bas"

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

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer

  static as HANDLE hTT
  static as HWND hWndTB

  select case uMsg

    case WM_INITDIALOG

      dim as TBADDBITMAP tbab
      dim as TBBUTTON tbb(0 to 6)

      hWndTB = GetDlgItem( hDlg, 100 )

      '' Specify the structure size so the system can determine
      '' which version of the common control DLL is being used.
      ''
      SendMessage( hWndTB,TB_BUTTONSTRUCTSIZE,sizeof(TBBUTTON),0 )

      '' Add the system-defined bitmap button images to the
      '' list of available images.
      ''
      tbab.hInst = HINST_COMMCTRL
      tbab.nID = IDB_STD_SMALL_COLOR
      SendMessage( hWndTB, TB_ADDBITMAP, 0, cast(LPARAM,@tbab) )

      '' For each button, specify the button image index,
      '' the associated command identifier, and the button
      '' state and style.
      ''
      tbb(0).iBitmap = STD_FILENEW
      tbb(0).idCommand = 1000
      tbb(0).fsState = TBSTATE_ENABLED
      tbb(0).fsStyle = TBSTYLE_BUTTON
      tbb(1).iBitmap = STD_FILEOPEN
      tbb(1).idCommand = 1001
      tbb(1).fsState = TBSTATE_ENABLED
      tbb(1).fsStyle = TBSTYLE_BUTTON
      tbb(2).iBitmap = STD_FILESAVE
      tbb(2).idCommand = 1002
      tbb(2).fsState = TBSTATE_ENABLED
      tbb(2).fsStyle = TBSTYLE_BUTTON
      tbb(3).iBitmap = 0
      tbb(3).fsState = TBSTATE_ENABLED
      tbb(3).fsStyle = TBSTYLE_SEP
      tbb(4).iBitmap = STD_CUT
      tbb(4).idCommand = 1003
      tbb(4).fsState = TBSTATE_ENABLED
      tbb(4).fsStyle = TBSTYLE_BUTTON
      tbb(5).iBitmap = STD_COPY
      tbb(5).idCommand = 1004
      tbb(5).fsState = TBSTATE_ENABLED
      tbb(5).fsStyle = TBSTYLE_BUTTON
      tbb(6).iBitmap = STD_PASTE
      tbb(6).idCommand = 1005
      tbb(6).fsState = TBSTATE_ENABLED
      tbb(6).fsStyle = TBSTYLE_BUTTON

      '' Add the buttons to the toolbar.
      ''
      SendMessage( hWndTB,TB_ADDBUTTONS,7,cast(LPARAM,@tbb(0)) )

      '' Get the handle to the ToolTip control associated
      '' with the toolbar (by the TBSTYLE_TOOLTIPS style).
      ''
      hTT = cast(HANDLE,SendMessage( hWndTB,TB_GETTOOLTIPS,0,0 ))

      return true

    case WM_COMMAND

      select case loword(wParam)
        case 1000
          MessageBox( hDlg, "New", "", 0 )
        case 1001
          MessageBox( hDlg, "Open", "", 0 )
        case 1002
          MessageBox( hDlg, "Save", "", 0 )
        case 1003
          MessageBox( hDlg, "Cut", "", 0 )
        case 1004
          MessageBox( hDlg, "Copy", "", 0 )
        case 1005
          MessageBox( hDlg, "Paste", "", 0 )
      end select

    case WM_NOTIFY

      dim as LPNMHDR pnm

      '' This necessary because TTN_GETDISPINFO is not
      '' fully defined in commctrl.bi (0.16b stable).
      ''
      #define _TTN_GETDISPINFO -520

      pnm = cast(LPNMHDR,lParam)
      if pnm->hwndFrom = hTT then
        if pnm->code = _TTN_GETDISPINFO then

          dim as LPNMTTDISPINFO pdi

          '' Now know that pnm is actually pdi, and the ToolTip
          '' control is requesting information that it needs to
          '' display a tooltip. Note that the hdr member of the
          '' NMTTDISPINFO structure is a NMHDR structure.
          ''
          pdi = cast(LPNMTTDISPINFO, pnm)
          select case pdi->hdr.idFrom
            case 1000
              pdi->szText = "New"
            case 1001
              pdi->szText = "Open"
            case 1002
              pdi->szText = "Save"
            case 1003
              pdi->szText = "Cut"
            case 1004
              pdi->szText = "Copy"
            case 1005
              pdi->szText = "Paste"
          end select

          '' This causes the ToolTip control to retain
          '' the information after the first request.
          ''
          pdi->uFlags = pdi->uFlags or TTF_DI_SETITEM

        end if
      end if

    case WM_SIZE

      dim as RECT rcTB

      GetWindowRect( hWndTB, @rcTB )

      MoveWindow( hWndTB, 0, 0, loword(lParam), _
                  rcTB.bottom - rcTB.top + 1, false )

    case WM_CLOSE

      DestroyWindow( hDlg )

    case WM_DESTROY

      PostQuitMessage( null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt
dim as HWND hDlg
dim as MSG wMsg

InitializeCommonControls

Dialog( 1, 0, 0, 120, 90, "Toolbar Demo", lpdt, _
        WS_OVERLAPPEDWINDOW or DS_CENTER or WS_VISIBLE )

'' Instead of trying to anticipate the position and/or size of
'' the controls, just use zeros and set the correct values in
'' the WM_SIZE handler.
''
Control( 100, 0, 0, 0, 0, "", 0, TOOLBARCLASSNAME, _
         TBSTYLE_TOOLTIPS or TBSTYLE_FLAT )

hDlg = CreateModelessDialog( 0, @DialogProc, 0, lpdt )

do while GetMessage( @wMsg, null, 0, 0 ) <> 0
  if IsDialogMessage( hDlg,  @wMsg ) = 0 then
    TranslateMessage( @wMsg )
    DispatchMessage( @wMsg )
  end if
loop

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

Code: Select all

'====================================================================
'' Nested modal dialog demo, modal dialog as main.
'====================================================================

#include "dialogs.bas"

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

function NestedDialogProc( byval hDlg as  HWND, _
                           byval uMsg as UINT, _
                           byval wParam as WPARAM, _
                           byval lParam as LPARAM ) as integer
  select case uMsg

    case WM_COMMAND

      if loword(wParam) = IDCANCEL then
        EndDialog( hDlg, null )
      end if

    case WM_CLOSE

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

function MainDialogProc( byval hDlg as  HWND, _
                         byval uMsg as UINT, _
                         byval wParam as WPARAM, _
                         byval lParam as LPARAM ) as integer

  select case uMsg

    case WM_COMMAND

      select case loword(wParam)

        case 100

          dim as LPDLGTEMPLATE lpdt
          Dialog( 1, 0, 0, 120, 90, "Nested Dialog", lpdt, _
                  WS_OVERLAPPED or WS_SYSMENU or DS_CENTER )
          DefPushButton( IDCANCEL, -1, 60, 40, 12, "Close" )
          CreateModalDialog( hDlg, @NestedDialogProc, 0, lpdt )

        case IDCANCEL

          EndDialog( hDlg, null )

      end select

    case WM_CLOSE

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt

Dialog( 2, 0, 0, 150, 100, "Main Dialog", lpdt, _
        WS_OVERLAPPED or WS_SYSMENU or DS_CENTER )

DefPushButton( 100, 30, 70, 40, 12, "Go" )
PushButton( IDCANCEL, 80, 70, 40, 12, "Close" )

CreateModalDialog( 0, @MainDialogProc, 0, lpdt )

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

Code: Select all

'====================================================================
'' Nested modeless dialog demo, modeless dialog as main.
'====================================================================

#include "dialogs.bas"

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

dim shared as HWND g_hNestedDlg

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

function NestedDialogProc( byval hDlg as  HWND, _
                           byval uMsg as UINT, _
                           byval wParam as WPARAM, _
                           byval lParam as LPARAM ) as integer
  select case uMsg

    case WM_COMMAND

      if loword(wParam) = IDCANCEL then
        DestroyWindow( hDlg )
      end if

    case WM_CLOSE

      DestroyWindow( hDlg )

      '' Reset so main can determine if nested dialog is open.
      ''
      g_hNestedDlg = 0


  end select

  return 0

end function

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

function MainDialogProc( byval hDlg as  HWND, _
                         byval uMsg as UINT, _
                         byval wParam as WPARAM, _
                         byval lParam as LPARAM ) as integer

  select case uMsg

    case WM_COMMAND

      select case loword(wParam)

        case 100

          '' Open nested dialog only if not already open.
          ''
          if IsWindow( g_hNestedDlg ) = 0 then
            dim as LPDLGTEMPLATE lpdt
            Dialog( 1, 0, 0, 120, 90, "Nested Dialog", lpdt, _
                    WS_OVERLAPPED or WS_SYSMENU or DS_CENTER _
                    or WS_VISIBLE )
            DefPushButton( IDCANCEL, -1, 60, 40, 12, "Close" )
            g_hNestedDlg = CreateModelessDialog( hDlg, _
                                                 @NestedDialogProc,_
                                                 0, lpdt )
          end if

        case IDCANCEL

          DestroyWindow( hDlg )

      end select

    case WM_CLOSE

      DestroyWindow( hDlg )

    case WM_DESTROY

      PostQuitMessage( null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt

dim as HWND hDlg
dim as MSG wMsg

Dialog( 2, 0, 0, 150, 100, "Main Dialog", lpdt, _
        WS_OVERLAPPED or WS_SYSMENU or DS_CENTER or WS_VISIBLE )

DefPushButton( 100, 30, 70, 40, 12, "Go" )
PushButton( IDCANCEL, 80, 70, 40, 12, "Close" )

hDlg = CreateModelessDialog( 0, @MainDialogProc, 0, lpdt )

do while GetMessage( @wMsg, null, 0, 0 ) <> 0
  if IsDialogMessage( hDlg,  @wMsg ) = 0 then
    if IsDialogMessage( g_hNestedDlg,  @wMsg ) = 0 then
      TranslateMessage( @wMsg )
      DispatchMessage( @wMsg )
    end if
  end if
loop

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

Code: Select all

'====================================================================
'' Icon from resource demo, modal dialog as main.
''
'' This assumes that the executable file contains an ICON resource
'' with the identifier 1000. This would typically be done by
'' placing a resource definition something like this:
''
'' 1000 ICON "fblogo.ico"
''
'' in a .RC file and including the file on the FBC command line.
'====================================================================

#include "dialogs.bas"

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

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer

  select case uMsg

    case WM_CLOSE

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt

Dialog( 1, 0, 0, 120, 90,"Icon From Resource Demo", lpdt, _
        WS_OVERLAPPEDWINDOW or DS_CENTER )

Control( 100, 0, 0, 0, 0, "", 1000, "STATIC", SS_ICON )

CreateModalDialog( 0, @DialogProc, 0, lpdt )

'====================================================================
For more information:

MSDN: Dialog Boxes

MSDN: CreateWindowEx

EDIT: Tested with 0.16b, and 0.17b from July 21, and under Windows 2000 SP4 and Windows 98 SE.

EDIT: Corrected the IDCANCEL paragraph, and updated the MONTHCAL_CLASS common control demo.

EDIT: Updated DIALOGS.BAS to version 0.4 and modified the menu example to work with the recent CVS versions.

EDIT: Made a small change to make the code compatible with 64-bit code as well as 32-bit code and updated version to 0.5.

---
Last edited by MichaelW on Jul 09, 2015 17:57, edited 11 times in total.
VirusScanner
Posts: 775
Joined: Jul 01, 2005 18:45

Post by VirusScanner »

Cool, this is definitely going to be helpful.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

Another quick example:

Code: Select all

'====================================================================
'' Translucent dialog demo, with fade in, modeless dialog as main.
''
'' Requires Windows 2000 or later.
''
'' Adapted from http://www.codeproject.com/dialog/smoothalpha.asp
'====================================================================

#include "dialogs.bas"

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

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer
  select case uMsg

    case WM_INITDIALOG

      const ANIMATION_MS = 250
      const ALPHA = 200
      const ALPHA_STEP = 10
      const ANIMATION_TIMEOUT = ALPHA_STEP * ANIMATION_MS / ALPHA

      dim as ubyte bAlpha

      '' Make the dialog a layered window.
      ''
      SetWindowLong(hDlg, GWL_EXSTYLE, GetWindowLong( hDlg, _
                    GWL_EXSTYLE ) or WS_EX_LAYERED )

      '' Start at an alpha value of zero (completely transparent).
      ''
      SetLayeredWindowAttributes( hDlg, 0, 0, LWA_ALPHA )

      '' Display the dialog.
      ''
      ShowWindow( hDlg, SW_SHOW )

      '' Force an update of the client area so the controls
      '' will be included in the fade in.
      ''
      RedrawWindow( hDlg, null, null, RDW_UPDATENOW )

      '' Gradually fade the dialog in, stopping when the
      '' alpha value reaches ALPHA.
      ''
      do while bAlpha < ALPHA
        SetLayeredWindowAttributes( hDlg, 0, bAlpha, LWA_ALPHA )
        sleep( ANIMATION_TIMEOUT )
        bAlpha += ALPHA_STEP
      loop
      SetLayeredWindowAttributes( hDlg, 0, bAlpha, LWA_ALPHA )

      return true

    case WM_COMMAND

      if loword(wParam) = IDCANCEL then
        DestroyWindow( hDlg )
      end if

    case WM_CLOSE

      DestroyWindow( hDlg )

    case WM_DESTROY

      PostQuitMessage( null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt
dim as HWND hDlg
dim as MSG wMsg

'' The dialog must start out invisible, so no WS_VISIBLE style.
''
Dialog( 1, 0, 0, 120, 90, "Translucent Dialog Demo", lpdt, _
        WS_OVERLAPPEDWINDOW or DS_CENTER )

DefPushButton( IDCANCEL, -1, 65, 40, 12, "Close" )

hDlg = CreateModelessDialog( 0, @DialogProc, 0, lpdt )

do while GetMessage( @wMsg, null, 0, 0 ) <> 0
  if IsDialogMessage( hDlg,  @wMsg ) = 0 then
      TranslateMessage( @wMsg )
      DispatchMessage( @wMsg )
  end if
loop

'====================================================================
For more information see Layered Windows here and SetLayeredWindowAttributes
jevans4949
Posts: 1186
Joined: May 08, 2006 21:58
Location: Crewe, England

Post by jevans4949 »

This looks useful.

I was looking for how to build a dialog box dynamically, and the MS documentation does not make this clear.

Thanks very much.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

This is a quick and dirty app I made to investigate the FlashWindow and FlashWindowEx functions.

Code: Select all

'====================================================================
'' FlashWindow/FlashWindowEx demo, modal dialog as main.
'====================================================================

#include "dialogs.bas"

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

#define FLASHW_CAPTION    1
#define FLASHW_TRAY       2
#define FLASHW_ALL        3
#define FLASHW_TIMER      4
#define FLASHW_STOP       0
#define FLASHW_TIMERNOFG  12

enum
  FW_EX
  FW_TRUE
  FW_FALSE
end enum

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer

  static as FLASHWINFO fw
  static as integer state

  select case uMsg

    case WM_INITDIALOG

      fw.cbSize = sizeof(FLASHWINFO)
      fw.hwnd = hDlg
      fw.dwTimeout = 100

      return true

    case WM_COMMAND

      '' The two second delay provides an opportunity to
      '' minimize the window or make some other window
      '' the foreground window.

      select case wParam
        case 100
          SetTimer( hDlg, 1, 2000, null )
          state = FW_TRUE
        case 101
          SetTimer( hDlg, 1, 2000, null )
          state = FW_FALSE
        case 102
          fw.dwFlags = FLASHW_CAPTION
          fw.uCount = 40
          state = FW_EX
          SetTimer( hDlg, 1, 2000, null )
        case 103
          fw.dwFlags = FLASHW_TRAY
          fw.uCount = 40
          state = FW_EX
          SetTimer( hDlg, 1, 2000, null )
        case 104
          fw.dwFlags = FLASHW_ALL
          fw.uCount = 40
          state = FW_EX
          SetTimer( hDlg, 1, 2000, null )
        case 105
          fw.dwFlags = FLASHW_TIMER or FLASHW_ALL
          fw.uCount = 1000
          state = FW_EX
          SetTimer( hDlg, 1, 2000, null )
        case 106
          fw.dwFlags = FLASHW_STOP
          KillTimer( hDlg, 1 )
          state = FW_EX
          FlashWindowEx( @fw )
        case 107
          fw.dwFlags = FLASHW_TIMERNOFG or FLASHW_ALL
          state = FW_EX
          SetTimer( hDlg, 1, 2000, null )
      end select

    case WM_TIMER

      select case state
        case FW_TRUE
          KillTimer( hDlg, 1 )
          FlashWindow( hDlg, true )
          state = FW_EX
        case FW_FALSE
          KillTimer( hDlg, 1 )
          FlashWindow( hDlg, false )
          state = FW_EX
        case FW_EX
          KillTimer( hDlg, 1 )
          FlashWindowEx( @fw )
      end select

    case WM_CLOSE

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt

Dialog( 8, 0, 0, 125, 140, "FlashWindow Demo", lpdt, _
        WS_SYSMENU or WS_MINIMIZEBOX or DS_CENTER )

PushButton( 100, -1, 5, 100, 12, " FlashWindow true ", WS_TABSTOP )
PushButton( 101, -1, 20, 100, 12, " FlashWindow false", WS_TABSTOP )
PushButton( 102, -1, 35, 100, 12, "FLASHW_CAPTION", WS_TABSTOP )
PushButton( 103, -1, 50, 100, 12, "FLASHW_TRAY", WS_TABSTOP )
PushButton( 104, -1, 65, 100, 12, "FLASHW_ALL", WS_TABSTOP )
PushButton( 105, -1, 80, 100, 12, "FLASHW_TIMER", WS_TABSTOP )
PushButton( 106, -1, 95, 100, 12, "FLASHW_STOP", WS_TABSTOP )
PushButton( 107, -1, 110, 100, 12, "FLASHW_TIMERNOFG", WS_TABSTOP )

CreateModalDialog( 0, @DialogProc, 0, lpdt )

'====================================================================
MSDN: FlashWindow
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

Code: Select all

'====================================================================
'' Bitmap from resource demo, modal dialog as main.
''
'' This assumes that the executable file contains an BITMAP
'' resource with the identifier 1000. This would typically be
'' done by placing a resource definition something like this:
''
'' 1000 BITMAP "fblogo.bmp"
''
'' in a .RC file and including the file on the FBC command line.
'====================================================================

#include "dialogs.bas"

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

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer

  select case uMsg

    case WM_COMMAND

      if loword(wParam) = IDCANCEL then
        EndDialog( hDlg, null )
      end if

    case WM_CLOSE

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

dim lpdt as LPDLGTEMPLATE

Dialog( 1, 0, 0, 120, 90,"Bitmap From Resource Demo", lpdt, _
        WS_OVERLAPPEDWINDOW or DS_CENTER )

Control( 100, 0, 0, 0, 0, "", 1000, "STATIC", SS_BITMAP )

CreateModalDialog( 0, @DialogProc, 0, lpdt )

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

Resource definition:

Code: Select all

;
; fblogo.bmp can be found in the examples\gfx directory.
;
1000 BITMAP "fblogo.bmp"
tinram
Posts: 89
Joined: Nov 30, 2006 13:35
Location: UK

Post by tinram »

Looks good and comprehensive. Will definitely try out to get around some resource file problems.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

This is a quick dialog in DLL demo.

DLGINDLL_DLL.BAS:

Code: Select all

'====================================================================
'' Dialog in DLL demo, modal dialog as main.
''
'' Building with -DLL will create the DLL and import library.
'====================================================================

#include "dialogs.bas"

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

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer
  select case uMsg


    case WM_COMMAND

      if loword(wParam) = 100 then
        EndDialog( hDlg, null )
      end if

    case WM_CLOSE

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

'' Pass in the parent HWND so the dialog will behave as
'' a normal modal dialog.
''
sub ShowDialog( byval parent_hwnd as HWND ) export

  dim as LPDLGTEMPLATE lpdt

  Dialog( 1, 0, 0, 90, 62, "Dialog from DLL", lpdt, _
          WS_OVERLAPPEDWINDOW or DS_CENTER )

  DefPushButton( 100, -1, 40, 40, 12, "Close" )

  CreateModalDialog( parent_hwnd, @DialogProc, 0, lpdt )

end sub

'====================================================================
DLGINDLL_TEST.BAS:

Code: Select all

'====================================================================
'' Test app for dialog in DLL demo, modal dialog as main.
'====================================================================

#include "dialogs.bas"
#inclib "dlgindll_dll"

declare sub ShowDialog( byval as HWND )

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

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer
  select case uMsg

    case WM_COMMAND

      if loword(wParam) = 100 then
        ShowDialog( hDlg )
      end if

    case WM_CLOSE

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt

Dialog( 1, 0, 0, 120, 90, "Dialog from DLL Demo", lpdt, _
        WS_OVERLAPPEDWINDOW or DS_CENTER )

DefPushButton( 100, -1, 65, 50, 12, "Show Dialog" )

CreateModalDialog( 0, @DialogProc, 0, lpdt )

'====================================================================
oldmike
Posts: 24
Joined: Nov 23, 2006 18:17
Location: Germany, SH

Post by oldmike »

good for a Wiki Tutorial page - please place it there...

Best wishes
oldmike
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

I updated DIALOGS.BAS to version 0.4 and modified the menu example to work with the recent CVS versions.
good for a Wiki Tutorial page - please place it there...
I'm slowly moving in that direction.
gedumer
Posts: 129
Joined: Sep 15, 2005 16:52

Post by gedumer »

How far can this go? What are it's limits? Since dialogs typically only support a main application, your concept confuses me as to it's intent. Are you suggesting that one could create an app in total with this tool or only the dialog portion?

In any case, this is quite impressive. I'd like to see more.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

Yes, you could create an app in total with this tool, using a dialog as the main application window. There are some limitations, however, that might make it more difficult, or perhaps impossible, to create certain apps with unusual requirements. Off the top of my head I can’t think of any examples, but they must exist. Because I chose not to support the extended dialog box template there is no way to specify the window class for the dialog, so you are stuck with the system-defined class. If the system-defined class did not meet your requirements you could probably “adjust” it, or work around it in some other way, but depending on what was involved it might be easier to use a conventional window.
gedumer
Posts: 129
Joined: Sep 15, 2005 16:52

Post by gedumer »

Are there any controls that could not be used? How would you do a TabControl with multiple pages or how would you populate a TreeView control? Do you have examples of those controls and others like them?

Please forgive my naivety, but what restrictions does the system-defined class impose that would create problems. Also, what do you mean by the extended dialog box template?

I have a serious interest in this subject since I'm trying to put together a useful GUI tool to minimize the complexity of Windows programming. Unless I'm completely missing the boat, it seems that this approach could more useful than mine. I'd like to pursue this as far as you're willing to go. If this is just a study project for you and you have no interest in extending it further, let me know right now and I'll end my pursuit.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

I have not encountered any control that could not be used. I have a mostly unfinished Tab Control demo that displays the tabs, but I have not added the code to create and manage the child dialogs that I intend to display on the tabs. I have two mostly unfinished editor demos, one that uses a Rich Edit 1.0 control and one that uses the Scintilla control. I have not attempted a Tree-View control. I intend to post these demos at some point, but before I could continue with them I had to fix the problems with dialogs.bas and the recent CVS builds. My problem here is that my work leaves me with only a limited amount of free time.

So far, I have not encountered any problems with the system-defined dialog box class. I am just guessing, really, that there could be problems with the system-defined class that could not be corrected, using for example SetClassLongPtr, or otherwise worked around.

Information on the extended dialog box template is here.

I intended this from the start to be a useful tool to minimize the complexity of Windows GUI programming. I had seen and/or tried too many Windows GUI “frameworks” (AKA GUI libraries) that IMO missed the mark, requiring that the user learn a new, sometimes extensive, and generally poorly documented, API that made the programming easier only for a narrow range of tasks, and make other tasks more difficult. IMO a tool of this sort should automate the most common tasks, using an efficient, intuitive, and easy to understand interface, and allow the user to freely mix in normal API code without having to jump through unnecessary hoops.
gedumer
Posts: 129
Joined: Sep 15, 2005 16:52

Post by gedumer »

MichaelW wrote:IMO a tool of this sort should automate the most common tasks, using an efficient, intuitive, and easy to understand interface, and allow the user to freely mix in normal API code without having to jump through unnecessary hoops.
I agree and I'm looking forward to future releases of this project.
Post Reply