'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

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

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

'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
  
  freememory lpdt
  
  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

  freememory lpdt

  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)
#ifdef review
  printl "sub Dialog: try to create Dialog template structure"
#endif

  if g_lpdtptr then freememory g_lpdtptr
  g_lpdtptr=getmemory 20480 '1024*20

  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

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