TabControl 32/64

[Pierre Bellisle]

Hi Roland, Zlatko.
Here is a summary of the story:

GPF compiling ...\Oxygen\o2\demos\WinDynDialogs\TabControl.o2bas in 64 bit.
GPF may not be seen with different system configuration or OS version.

Observation of Oxygen\o2\inc\Dialogs.inc, function CreateModalDialog(),
For what I understand, the lpdt memory space was used more than once wich is good practice,
the issue is that freememory lpdt was also called more than once
with the same memory address so the GPF.
I added a flag variable to remember that the memory was already freed...

Here is the modification I made, please double check if you feel like it...
In Dialogs.inc,
After:      sys g_lpdtptr       'pointer to initial DLGTEMPLATE struc
I added:  sys ValidMemPointer '2022-12-31

In CreateModalDialog(),
I replaced: freememory lpdt
with:         if ValidMemPointer = lpdt then freememory lpdt : ValidMemPointer = false '2022-12-31

In CreateModelessDialog(),
I replaced: freememory lpdt
with:         if ValidMemPointer = lpdt then freememory lpdt : ValidMemPointer = false '2022-12-31

In the Dialog() sub,
After:     if g_lpdtptr then freememory g_lpdtptr 
I added: ValidMemPointer = false '2022-12-31 (Just for clarity)
After:     g_lpdtptr=getmemory 20480 '1024*20
I added: ValidMemPointer = g_lpdtptr '2022-12-31

Thank you Roland for the sharing of your work, it is really appreciated!

Regard

[Roland Stowasser]

Thanks Pierre for the solution. I believe this is necessary for Win 10 as well. Maybe Charles will exchange the modified Dialogs.inc:

Code Select Expand


'library functions for creating dialogs at runtime in memory
'coded according to Win32 Help file
'
'based on
'dialogs.bas in:
'https://www.freebasic.net/forum/viewtopic.php?t=5667

'dialogs.inc in:
'MASM32 SDK

'2022-12-31: Pierre Bellisle added variable ValidMemPointer to avoid GPF

uses corewin
uses generics
#ifdef review
  uses console
#endif

'some classes for using InitCommonControlsEx
% WC_HEADER="SysHeader32"
% TOOLBARCLASSNAME="ToolbarWindow32"
% STATUSCLASSNAME="msctls_statusbar32"
% TRACKBAR_CLASS="msctls_trackbar32"
% UPDOWN_CLASS="msctls_updown32"
% PROGRESS_CLASS="msctls_progress32"
% WC_LISTVIEW="SysListView32"
% WC_TREEVIEW="SysTreeView32"
% WC_TABCONTROL="SysTabControl32"
% ANIMATE_CLASS="SysAnimate32"
% RICHEDIT_CLASS10A="RICHEDIT"
% RICHEDIT_CLASS="RichEdit20A"
% MSFTEDIT_CLASS="RichEdit50W"
% MONTHCAL_CLASS="SysMonthCal32"
% DATETIMEPICK_CLASS="SysDateTimePick32"
% WC_IPADDRESS="SysIPAddress32"
% HOTKEY_CLASS="msctls_hotkey32"
% REBARCLASSNAME="ReBarWindow32"
% WC_PAGESCROLLER="SysPager"
% WC_NATIVEFONTCTL="NativeFontCtl"
% WC_COMMCTRL_DRAGLISTMSG="commctrl_DragListMsg"
% WC_COMBOBOXEX="ComboBoxEx32"
% TOOLTIPS_CLASS="tooltips_class32"
'==============================================================================

'Items needed to run dialogs.inc
% DS_SETFONT=0x40
% SS_LEFT=0
% SS_CENTER=1
% SS_RIGHT=2
% SS_ICON=3
% SS_BITMAP=0x0E
% SS_NOTIFY=0x0100
% CBS_SIMPLE=1
% CBS_DROPDOWN=2
% CBS_DROPDOWNLIST=3
% CBS_SORT=0x0100
% CBS_HASSTRINGS=0x0200
% ES_SAVESEL=0x8000

'some often used constants
% DS_CENTER=0x0800
% LR_LOADFROMFILE=0x0010
% IMAGE_BITMAP=0
% IMAGE_ICON=1
% ICON_SMALL=0
% ICON_BIG=1
% WM_SETICON=0x80
% STM_SETIMAGE=0x172
% SWP_NOMOVE=2
% SWP_NOREDRAW=8
% COLOR_WINDOW=5
% SM_CXBORDER=5
% SM_CYBORDER=6
% SWP_NOZORDER=4
% HWND_TOPMOST= -1
% HORZRES=8
% VERTRES=10
% ODS_SELECTED=1
% WM_DRAWITEM=0x2B
% SRCCOPY=0xCC0020
% SB_SETTEXT=0x401
% SB_SETPARTS=0x404


'MultiByteToWideChar
% CP_ACP=0
% MB_PRECOMPOSED=1

'WinApi types
packed type DLGTEMPLATE 'template for dialog box
   dword style
   dword dwExtendedStyle
   word  cdit  'number of items
   short x     'in dialog box units
   short y
   short cx    'width
   short cy    'height
end type
'immediately followed by some data

packed type DLGITEMTEMPLATE 'template for a control in a dialog box
   dword style
   dword dwExtendedStyle
   short x     'in dialog box units
   short y
   short cx    'width
   short cy    'height
   word  id    'control identifier
end type
'immediately followed by some data

'needed for menus
% GRAYED=MF_GRAYED
% CHECKED=MF_CHECKED
% OWNERDRAW=MF_OWNERDRAW
string tab=chr(9)

'needed for accelerators
% FVIRTKEY=1 'TRUE
% FNOINVERT=0x02
% FSHIFT=0x04
% FCONTROL=0x08
% FALT=0x10

type ACCEL
   byte fVirt
   word key
   word cmd
end type

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

sys g_memptr        'points to an address in memory
int g_dialog_width  'for centering  a control in a dialog.
int g_Ccount        'controls actually created

sys g_lpdtptr       'pointer to initial DLGTEMPLATE struc
sys ValidMemPointer '2022-12-31

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

'macros
macro align_2(v) {v+=1 : v = v and -2}
macro align_4(v) {v+=3 : v = v and -4}

macro make_ustring(text,memptr, count) 
  int count = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED,
                               text,
                               -1,
                               memptr,
                               len(text)+1 )
  memptr += count*2
end macro

macro set_val(i,v) {i=v : g_memptr+=sizeof(i)}

'====================================================================
' Create a modal dialog from the dialog box template pointed to by lpdt.
' hParent should be null if the dialog is the main window of the application.
'
' DialogBoxIndirectParam function does not return until EndDialog.
' rval returns whatever was specified as result of EndDialog.
'
function CreateModalDialog( sys hParent, sys *lpDialogProc, dwInitParam, optional lpdt=g_lpdtptr) as sys
 
  sys rval
  rval = DialogBoxIndirectParam( GetModuleHandle(null),
                                 lpdt,
                                 hParent,
                                 @lpDialogProc,
                                 dwInitParam )
  if rval=-1 then
    mbox "Creating modal Dialog failed. Stop!"
#ifdef review
  printl "Error: rval = " rval
  printl "Enter to end ... ": waitkey
#endif   
    ExitProcess(0)
  end if
 
  if ValidMemPointer = lpdt then freememory lpdt : ValidMemPointer = false '2022-12-31

  return rval
end function

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

' Create a modeless dialog from the dialog box template pointed to by lpdt.
' hParent should be null if the dialog is the main window of the application.
'
' CreateDialogIndirectParam function will use DestroyWindow to return
' rval normally returns the handle to the dialog window.
'
' WS_VISIBLE style is required for a modeless dialog to be visible.
'
function CreateModelessDialog( sys hParent, sys *lpDialogProc, lParamInit, optional lpdt=g_lpdtptr) as sys
         
  sys rval

  rval = CreateDialogIndirectParam( GetModuleHandle(null),
                                    lpdt,
                                    hParent,
                                    @lpDialogProc,
                                    lParamInit )
  if rval=0 then
    mbox "Cannot create modeless Dialog. Stop!"
#ifdef review
  printl "Error: rval = " rval
  printl "Enter to end ... ": waitkey
#endif   
    ExitProcess(0)
  end if

  if ValidMemPointer = lpdt then freememory lpdt : ValidMemPointer = false '2022-12-31

  return rval
end function

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

' Initialize 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_memptr, and a
' pointer to the allocated memory in lpdt.
'
' 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( short x,y,cx,cy, string title, dword style,
           optional short pointSize=0, string typeFace="", dword extStyle=0)

  int e = int(title) : if e != 0 or title=0 then mbox "Warning: title in Dialog probably not a string"
#ifdef review
  printl "sub Dialog: try to create Dialog template structure"
#endif

  if g_lpdtptr then freememory g_lpdtptr
  ValidMemPointer = false '2022-12-31 (Just for clarity)
 
  g_lpdtptr=getmemory 20480 '1024*20
  ValidMemPointer = g_lpdtptr '2022-12-31
 
  word cdit at g_lpdtptr+sizeof(dword)*2 'lpdt.cdit
  cdit = 0
       
  g_dialog_width = cx

  DLGTEMPLATE lpdt at g_lpdtptr
  lpdt.style = style
  lpdt.dwExtendedStyle = extStyle
  lpdt.cdit = cdit
  lpdt.x  = x
  lpdt.y  = y
  lpdt.cx = cx
  lpdt.cy = cy
   
  ' Set g_memptr to the menu array that follows the structure.
  g_memptr = g_lpdtptr + sizeof(lpdt)

  word menu_ at g_memptr : set_val(menu_, 0)
  word class_ at g_memptr : set_val(class_, 0)

  'title array and set g_memptr to next WORD following the title array.
  make_ustring( title, g_memptr )

  'if DS_SETFONT then point size and typeface
  if style and DS_SETFONT then
    word pointsize_ at g_memptr : set_val(pointsize_, pointSize)
    make_ustring( typeFace, g_memptr )
  end if
 
  g_Ccount=0
   
end sub

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

' General-purpose control definition starting at g_memptr, initializes
' the essential members of a DLGITEMTEMPLATE structure and
' the class, caption and creation data arrays.
'
' For the class array - six predefined system (User32) classes -
' use "BUTTON", "EDIT", "STATIC", "LISTBOX", "SCROLLBAR", and "COMBOBOX".
' For common controls use the class strings defined for comctl32.dll.
'
' Caption 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 caption parameter,
' or an ordinal value in the rid (ResourceID) parameter. If the
' rid parameter is non-zero then the caption parameter is ignored.
'
' There is no support for creation data.
'
' The tab order of the controls in a dialog is determined by the order in which
' the controls are created and 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.
'

sub control( string caption, word cid, string _class, dword style=0, short x,y,cx,cy,
             optional extStyle = 0, short rid=0 )

  if x = -1 then x = (g_dialog_width - cx) / 2

  '--------------------------------------------------------------
  'must be dword boundary
  '--------------------------------------------------------------   
  align_4(g_memptr)

  'initialize the essential members of the structure.
  'establish the base style as WS_CHILD or WS_VISIBLE.

  DLGITEMTEMPLATE lpdit at g_memptr
  lpdit.style = WS_CHILD or WS_VISIBLE or style
  lpdit.dwExtendedStyle = extStyle
  lpdit.x  = x
  lpdit.y  = y
  lpdit.cx = cx
  lpdit.cy = cy
  lpdit.id = cid

  'set g_memptr to the class array that follows the structure.
  g_memptr += sizeof(lpdit)

  'initialize the class array and set g_memptr to the next WORD
  make_ustring( _class, g_memptr )

  'initialize the caption array and set g_memptr to the next WORD
  if rid then
    word class_ at g_memptr : set_val(class_, 0xffff)
    word rid_ at g_memptr : set_val(rid_, rid)
  else
    make_ustring( caption, g_memptr )
  end if

  'skip the first element of the creation data, set it to zero (no creation data).
  align_2(g_memptr)
  word create_data at g_memptr : set_val(create_data, 0)

  g_Ccount+=1

#ifdef review
  printl "Controls created: " g_Ccount
#endif

  word cdit at g_lpdtptr+sizeof(dword)*2  'lpdt.cdit
  cdit=g_Ccount   
end sub

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

'PUSHBUTTON, PUSHBOX, DEFPUSHBUTTON, CHECKBOX, AUTOCHECKBOX, AUTO3STATE, STATE3, RADIOBUTTON, AUTORADIOBUTTON, GROUPBOX

sub PushButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_PUSHBUTTON or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub

sub PushBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_PUSHBOX or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub

sub DefPushButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_DEFPUSHBUTTON or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub

sub CheckBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_CHECKBOX or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub AutoCheckBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_AUTOCHECKBOX or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Auto3State( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_AUTO3STATE or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
                                                                                                       
sub State3( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_3STATE or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub RadioButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_AUTORADIOBUTTON or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub AutoRadioButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_AUTORADIOBUTTON or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub GroupBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_GROUPBOX or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub
'====================================================================

'EDITTEXT, MultiLineText

sub EditText( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "EDIT", ES_LEFT or WS_BORDER or WS_TABSTOP or ES_AUTOHSCROLL or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub

sub MultiLineText( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "EDIT", ES_LEFT|WS_BORDER|WS_TABSTOP|WS_GROUP|WS_VSCROLL|WS_HSCROLL|ES_MULTILINE|ES_AUTOVSCROLL|ES_AUTOHSCROLL|ES_WANTRETURN|style,x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub
'====================================================================

'LTEXT, RTEXT, CTEXT, ICON, Bitmap

sub Ltext( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "STATIC", SS_LEFT or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Rtext( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "STATIC", SS_RIGHT or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Ctext( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "STATIC", SS_CENTER or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Icon( string caption, word cid, optional short x=0,y=0,cx=0,cy=0, dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "STATIC", SS_ICON or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Bitmap( string caption, word cid, optional short x=0,y=0,cx=0,cy=0, dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "STATIC", SS_BITMAP or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
'====================================================================

'LISTBOX
sub ListBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( "", cid, "LISTBOX", WS_VSCROLL or WS_BORDER or WS_TABSTOP or LBS_NOTIFY or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub
'====================================================================

'SimpleCombo, SortedCombo,  COMBOBOX, DropDownList

sub SimpleCombo( string caption,word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( "", cid, "COMBOBOX", WS_VSCROLL or CBS_DROPDOWN or CBS_HASSTRINGS or WS_TABSTOP or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub

sub SortedCombo( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( "", cid, "COMBOBOX", WS_VSCROLL or CBS_DROPDOWN or CBS_HASSTRINGS or CBS_SORT or WS_TABSTOP or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub

sub ComboBox(string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( "", cid, "COMBOBOX", CBS_SIMPLE or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub

sub DropDownList( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( "", cid, "COMBOBOX", WS_VSCROLL or CBS_DROPDOWNLIST or CBS_HASSTRINGS or WS_TABSTOP or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub
'====================================================================

'SCROLLBAR, VScrollBar

sub ScrollBar( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( "", cid, "SCROLLBAR", SBS_HORZ or WS_TABSTOP or style, x,y,cx,cy, extStyle, 0 )
end sub

sub VScrollBar( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( "", cid, "SCROLLBAR", SBS_VERT or WS_TABSTOP or style, x,y,cx,cy, extStyle, 0 )
end sub
'====================================================================

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

' This procedure is coded for version 1.
sub RichEdit1( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, RICHEDIT_CLASS10A, WS_TABSTOP or WS_VSCROLL or ES_AUTOVSCROLL or ES_SAVESEL or ES_MULTILINE or WS_BORDER or ES_WANTRETURN or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub

' This procedure is coded for version 2 or 3.
sub RichEdit( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, RICHEDIT_CLASS, WS_TABSTOP or WS_VSCROLL or ES_AUTOVSCROLL or ES_SAVESEL or ES_MULTILINE or WS_BORDER or ES_WANTRETURN or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub

' This procedure is coded for version 4.1.
sub MsftEdit( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, MSFTEDIT_CLASS, WS_TABSTOP or WS_VSCROLL or ES_AUTOVSCROLL or ES_SAVESEL or ES_MULTILINE or WS_BORDER or ES_WANTRETURN or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub
'====================================================================

sub init_common_controls(optional dword classes=0)

   ' create a structure of INITCOMMONCONTROLSEX
   INITCOMMONCONTROLSEXt iccex
   
   iccex.dwSize=sizeof(iccex)
   'Register Common Controls
   if classes !=0 then
     'set own value
     iccex.dwICC=classes   
   else
     'use default
     iccex.dwICC= 0xffff
/*     
     0x0001 or ' ICC_LISTVIEW_CLASSES   - list view and header control classes. 
     0x0002 or ' ICC_TREEVIEW_CLASSES   - tree view and tooltip control classes.     
     0x0004 or ' ICC_BAR_CLASSES        - toolbar, status bar, trackbar, and tooltip control classes. 
     0x0008 or ' ICC_TAB_CLASSES        - tab and tooltip control classes.     
     0x0010 or ' ICC_UPDOWN_CLASS       - up-down control class.     
     0x0020 or ' ICC_PROGRESS_CLASS     - progress bar control class.     
     0x0040 or ' ICC_HOTKEY_CLASS       - hot key control class.     
     0x0080 or ' ICC_ANIMATE_CLASS      - animate control class.       
     0x00ff or ' ICC_WIN95_CLASSES      - animate control, header, hot key,
                                        ' list view, progress bar, status bar, tab,
                                        ' tooltip, toolbar, trackbar, tree view,
                                        ' and up-down control classes.   
     0x0100 or ' ICC_DATE_CLASSES       - date and time picker control class.     
     0x0200 or ' ICC_USEREX_CLASSES     - ComboBoxEx class. 
     0x0400 or ' ICC_COOL_CLASSES       - rebar control class.     
     0x0800 or ' ICC_INTERNET_CLASSES   - IP address class.   
     0x1000 or ' ICC_PAGESCROLLER_CLASS - pager control class.   
     0x2000 or ' ICC_NATIVEFNTCTL_CLASS - native font control class
     0x4000 or ' ICC_STANDARD_CLASSES   - one of the intrinsic User32 control classes.
                                        ' The user controls include button, edit, static,
                                        ' listbox, combobox, and scroll bar. 
     0x8000    ' ICC_LINK_CLASS         - hyperlink control class. 
*/
   end if

   InitCommonControlsEx(@iccex)
end sub

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

'Menus, PopupMenus
int g_MnuLv[10]   'Main Menu or PopupMenu and 9 levels of SubMenus
int g_Midx        'Menu index


macro MENU(hMenu)
   hMenu=CreateMenu
   g_Midx=1
   g_MnuLv[1]=hMenu
end macro

'Vertical Main Popup Menu
macro PopupMENU(hMenu)
   hMenu=CreatePopupMenu
   g_Midx=1
   g_MnuLv[1]=hMenu
end macro

sub BEGIN(optional int none=0)
end sub

sub POPUP(string item)
  sys hSubM=CreateMenu
  g_Midx+=1 : g_MnuLv[g_Midx]=hSubM
  AppendMenu( g_MnuLv[g_Midx-1], MF_POPUP, g_MnuLv[g_Midx], item ) 
end sub

sub MENUITEM(string item, optional sys id=0, uint uflags=MF_STRING)
   if lcase(item) = "separator" then
     AppendMenu(g_MnuLv[g_Midx], MF_SEPARATOR, 0, 0)
   else
     AppendMenu(g_MnuLv[g_Midx], uflags, id, item )
   end if
end sub

sub ENDMenu(optional int=0)
  g_Midx-=1
end sub

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




Unfortunately some apps in WynDynDialogs folder do not run correctly any more, but work with older versions of OxygenBasic. I do not believe that this is caused by Dialogs.inc and I will check them.

[Zlatko Vid]

Thanks Piere

But that just another level of complexity
i suspect that something is wrong in RTL64

or

simply this Dialogs.inc is to complex without real reason
I will look into some C examples not FreeBasic

[Zlatko Vid]

OK
so here is Dialog window or form in C
well as you may see nothing too complex...
i really have no clue why is o2 example so overhelmed with weird things??

Code Select Expand

#include <windows.h>

LRESULT CALLBACK WndProc(HWND, UINT, WPARAM, LPARAM);
LRESULT CALLBACK DialogProc(HWND, UINT, WPARAM, LPARAM);

void CreateDialogBox(HWND);
void RegisterDialogClass(HWND);

HINSTANCE ghInstance;

int WINAPI wWinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance,
    PWSTR pCmdLine, int nCmdShow) {

  MSG  msg;   
  HWND hwnd;

  WNDCLASSW wc = {0};

  wc.lpszClassName = L"Window";
  wc.hInstance     = hInstance;
  wc.hbrBackground = GetSysColorBrush(COLOR_3DFACE);
  wc.lpfnWndProc   = WndProc;
 
  RegisterClassW(&wc);
  hwnd = CreateWindowW(wc.lpszClassName, L"Window",
                WS_OVERLAPPEDWINDOW | WS_VISIBLE,
                100, 100, 250, 150, NULL, NULL, hInstance, NULL); 

  ghInstance = hInstance;

  while( GetMessage(&msg, NULL, 0, 0)) {
    DispatchMessage(&msg);
  }
 
  return (int) msg.wParam;
}

LRESULT CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) {

  switch(msg) {
 
      case WM_CREATE:
          RegisterDialogClass(hwnd);
          CreateWindowW(L"button", L"Show dialog",   
              WS_VISIBLE | WS_CHILD ,
              20, 50, 95, 25, hwnd, (HMENU) 1, NULL, NULL); 
          break;

      case WM_COMMAND:
          CreateDialogBox(hwnd);
          break;

      case WM_DESTROY:
      {
          PostQuitMessage(0);
          return 0;
      }
  }
  return DefWindowProcW(hwnd, msg, wParam, lParam);
}

LRESULT CALLBACK DialogProc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
{
  switch(msg) {
 
    case WM_CREATE:
        CreateWindowW(L"button", L"Ok",   
          WS_VISIBLE | WS_CHILD ,
          50, 50, 80, 25, hwnd, (HMENU) 1, NULL, NULL); 
    break;

    case WM_COMMAND:
        DestroyWindow(hwnd);
    break;

    case WM_CLOSE:
        DestroyWindow(hwnd);
        break;

  }
 
  return (DefWindowProcW(hwnd, msg, wParam, lParam));
}

void RegisterDialogClass(HWND hwnd) {

  WNDCLASSEXW wc = {0};
  wc.cbSize           = sizeof(WNDCLASSEXW);
  wc.lpfnWndProc      = (WNDPROC) DialogProc;
  wc.hInstance        = ghInstance;
  wc.hbrBackground    = GetSysColorBrush(COLOR_3DFACE);
  wc.lpszClassName    = L"DialogClass";
  RegisterClassExW(&wc);

}

void CreateDialogBox(HWND hwnd) {

  CreateWindowExW(WS_EX_DLGMODALFRAME | WS_EX_TOPMOST,  L"DialogClass", L"Dialog Box",
        WS_VISIBLE | WS_SYSMENU | WS_CAPTION , 100, 100, 200, 150,
        NULL, NULL, ghInstance,  NULL);
}

[Roland Stowasser]

Hi Zlatko,

What is the problem? You do not like In Memory Dialogs - they are possible in different programming languages - but you are not forced to use them. In folder WinGui for example Charles provided many demos applying only the WinApi functions which use CreateWindowEx and WndProc. There should be no competitive spirit about this subject.

Your example above creates a window with a button, which opens a dialog box with an OK button. But where is the tabcontrol with the tabs and the different controls? How do you switch the tabs, make for instance changes in the edit fields? I think this is more complex than your simple example.

Roland

[Zlatko Vid]

And what is your problem?

Is it really that hard to add tab control in this way ?
Here is not problem in Tabcontrol then in a way how is this Dialog created

and who talking about competition?

[Charles Pegge]

As a pointer, ValidMemPointer should be declared as sys, not long

I've updated with the amended Dialog.inc.

Also:

10:15 02/01/2023 Fix folder refs from 'ProjectsA to 'demos\!ProjA'
09:41 30/12/2022 Prevent neg column numbers in error report (tran.inc sttw-sttl+1)


https://github.com/Charles-Pegge/OxygenBasic/blob/master/OxygenBasic050P15.zip

[Pierre Bellisle]

Yep!
Mea culpa, I updated my post above...

[Zlatko Vid]

OMG

I become sick from this Dialogs ...
back to usual programming with Windows ...

[Pierre Bellisle]

Thank for this new version Charles...
The more I look at it, the more I like...

[Pierre Bellisle]

Hi Charles,
Talking of GPF, I had another one,

In Oxygen\o2\demos\Unicode\REdit_Unicode\RicheditUnicode.o2bas
wstring lblTxt[4]={"   Ansi","UTF-16","UTF-8","Text","Open file as: "}

I guess lblTxt[4] should be lblTxt[5]

Take care...

[Charles Pegge]

Thanks Pierre

It compiles to 64 bit and runs fine with arrays of 5 elements.

array correction:

Code Select Expand


   sys lbl[5]
   wstring lblTxt[5]={"   Ansi","UTF-16","UTF-8","Text","Open file as: "}
   sys radio[5]
   sys id_radio[5]={101,102,103,104}