This version for unicode mode only.
Code: Select all
;For unicode only. Does not work in ascii mode.
;If you use a dialog font you must set the #DS_SETFONT style in the dialog style.
;You don't need to supply the WS_CHILD style whwn adding controls.
;Dialog and control measurements are in dialog units.
;You must define the handle returned by dlgCreate() as a pointer to a _MDIALOG_DATA_
;structure.
Structure _MDIALOG_DATA_
*tmpl.l
tmplSize.l
EndStructure
Procedure dlgSaveToFile(*dlg._MDIALOG_DATA_, file$)
Define.l hfile
DeleteFile(file$)
hfile = OpenFile(#PB_Any, file$)
If hfile
WriteData(hfile, *dlg\tmpl, *dlg\tmplSize)
CloseFile(hfile)
EndIf
EndProcedure
Procedure dlgFree(*dlg._MDIALOG_DATA_)
If *dlg
If *dlg\tmpl : FreeMemory(*dlg\tmpl) : EndIf
FreeMemory(*dlg)
EndIf
EndProcedure
Procedure dlgEnableItem(hdlg.l, ctlID.l, fEnable.l)
ProcedureReturn EnableWindow_(GetDlgItem_(hdlg, ctlID), fEnable)
EndProcedure
Procedure dlgCreate(Style.l, ExStyle.l, x.w, y.w, width.w, height.w, wtitle.s, wfont.s="", pointSize.w=0, wclass.s="")
Define.l titleBufLen, classBufLen, fontBufLen, *ptr.l
Define.b fIsFont
Define.DLGTEMPLATE *dtmp
Define._MDIALOG_DATA_ *dlg
*dlg = AllocateMemory(SizeOf(_MDIALOG_DATA_))
If Style & #DS_SETFONT = #DS_SETFONT And wfont
fIsFont = #TRUE
Else
fIsFont = #FALSE
EndIf
;Get template len
titleBufLen = (Len(wtitle) * 2) + 2
classBufLen = (Len(wclass) * 2) + 2
fontBufLen = (Len(wfont) * 2) + 2
*dlg\tmplSize = SizeOf(DLGTEMPLATE)
*dlg\tmplSize + SizeOf(WORD) ;menu array
*dlg\tmplSize + classBufLen
*dlg\tmplSize + titleBufLen
If fIsFont
*dlg\tmplSize + SizeOf(WORD) ;pointsize
*dlg\tmplSize + fontBufLen
EndIf
;Align
*dlg\tmplSize + (*dlg\tmplSize % 4)
*dlg\tmpl = AllocateMemory(*dlg\tmplSize)
*ptr = *dlg\tmpl ;temporary pointer
;DLGTEMPLATE
*dtmp = *ptr
*dtmp\style = Style
*dtmp\dwExtendedStyle = ExStyle
*dtmp\cdit = 0
*dtmp\x = x
*dtmp\y = y
*dtmp\cx = width
*dtmp\cy = height
*ptr + SizeOf(DLGTEMPLATE)
;Menu array
*ptr + SizeOf(WORD)
;Class array
If wclass
PokeS(*ptr, wclass) : *ptr + classBufLen
Else
*ptr + SizeOf(WORD)
EndIf
;Title array
If wtitle
PokeS(*ptr, wtitle) : *ptr + titleBufLen
Else
*ptr + SizeOf(WORD)
EndIf
;Font array
If fIsFont
;PointSize
PokeW(*ptr, pointSize) : *ptr + SizeOf(WORD)
;Font name
PokeS(*ptr, wfont) : *ptr + fontBufLen
EndIf
ProcedureReturn *dlg
EndProcedure
;dlgOpenModal(*dlg._MDIALOG_DATA_, dlgProc.l, hwndParent.l=0, hinst.l=0, param.l=0)
Macro dlgOpenModal(dlg, dlgProc, hwndParent=0, hinst=0, param=0)
DialogBoxIndirectParam_(hinst, dlg\tmpl, hwndParent, dlgProc, param)
EndMacro
;dlgOpenModeless(*dlg._MDIALOG_DATA_, dlgProc.l, hwndParent.l=0, hinst.l=0, param.l=0)
Macro dlgOpenModeless(dlg, dlgProc, hwndParent=0, hinst=0, param=0)
CreateDialogIndirectParam_(hinst, dlg\tmpl, hwnd, dlgProc, param)
EndMacro
Procedure dlgAddItem(*dlg._MDIALOG_DATA_, wclass.s, Style.l, ExStyle.l, x.w, y.w, w.w, h.w, wtitle.s, id.w)
Define.DLGITEMTEMPLATE *dit
Define.DLGTEMPLATE *dtmp
Define.l itemLen, classBufLen, titleBufLen, *ptr
;Get item len
classBufLen = (Len(wclass) * 2) + 2
titleBufLen = (Len(wtitle) * 2) + 2
itemlen = SizeOf(DLGITEMTEMPLATE)
itemlen + classBufLen
itemlen + titleBufLen
itemlen + SizeOf(WORD) ;creation data
;Align
itemlen + (itemlen % 4)
;Set new size
*dlg\tmpl = ReAllocateMemory(*dlg\tmpl, *dlg\tmplSize + itemlen)
*ptr = *dlg\tmpl + *dlg\tmplSize ;starting DLGITEMTEMPLATE
;Update size
*dlg\tmplSize + itemlen
;DLGITEMTEMPLATE
*dit = *ptr
*dit\style = #WS_CHILD | Style
*dit\dwExtendedStyle = ExStyle
*dit\x = x
*dit\y = y
*dit\cx = w
*dit\cy = h
*dit\id = id
;Advance pointer
*ptr + SizeOf(DLGITEMTEMPLATE)
;Class array
PokeS(*ptr, wclass) : *ptr + classBufLen
;Title array
If wtitle
PokeS(*ptr, wtitle) : *ptr + titleBufLen
Else
*ptr + SizeOf(WORD)
EndIf
;Creation data array
;Update item count
*dtmp = *dlg\tmpl
*dtmp\cdit + 1
ProcedureReturn *dtmp\cdit
EndProcedure
;dlgGetSystemClass(*wc.WNDCLASS)
;Makes a copy of the system dialog class
Macro dlgGetSystemClass(wc)
GetClassInfo_(0, "#32770", wc)
EndMacro
;- #TEST
;Shows how to create a dialog with a custom class, sets a hand cursor.
;The class is optional.
;-----
;This part for XP ONLY.
Import "uxtheme.lib"
EnableThemeDialogTexture_(hwnd.l, flags.l) As "_EnableThemeDialogTexture@8"
EndImport
#ETDT_ENABLE = $00000002
#ETDT_USETABTEXTURE = $00000004
#ETDT_ENABLETAB = #ETDT_ENABLE | #ETDT_USETABTEXTURE
;------
Enumeration
#IDC_BT
#IDC_ED
EndEnumeration
Define._MDIALOG_DATA_ *hdTmpl
Define.WNDCLASS wc
Define.s class
Procedure DlgProc(hdlg.l, msg.l, wParam.l, lParam.l)
Select msg
;-----
;XP ONLY
Case #WM_INITDIALOG
EnableThemeDialogTexture_(hdlg, #ETDT_ENABLETAB)
ProcedureReturn 1
;-----
Case #WM_COMMAND
Select wparam>>16
Case #BN_CLICKED
Select wparam & $ffff
Case #IDC_BT
Debug "click"
EndSelect
EndSelect
ProcedureReturn 1
Case #WM_CLOSE
EndDialog_(hdlg, 1)
ProcedureReturn 1
Default : ProcedureReturn 0
EndSelect
EndProcedure
;Optional, shows how to create a new custom dialog class
class.s = "myclass"
dlgGetSystemClass(@wc)
wc\lpszClassName = @class
wc\hCursor = LoadCursor_(#NULL, #IDC_HAND)
RegisterClass_(@wc)
;create dialog template
*hdTmpl = dlgCreate(#WS_SYSMENU|#DS_SETFONT, 0, 10, 10, 200, 200, "Modal dialog", "Tahoma", 10, class)
dlgAddItem(*hdTmpl, "Button", #WS_VISIBLE, 0, 2, 2, 80, 20, "Click Me", #IDC_BT)
dlgAddItem(*hdTmpl, "Edit", #WS_VISIBLE, #WS_EX_CLIENTEDGE, 0, 40, 40, 20, "text", #IDC_ED)
;open
dlgOpenModal(*hdTmpl, @DlgProc())
dlgFree(*hdTmpl)
;end
