PureBasic Forums - English

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