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
'====================================================================
Code: Select all
declare function DialogProc( byval hDlg as HWND, _
byval uMsg as UINT, _
byval wParam as WPARAM, _
byval lParam as LPARAM ) as integer
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
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 )
'====================================================================
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.
---