Custom Dialog (Win)

BlitzMax Forums/MaxGUI Module/Custom Dialog (Win)

Henri

(Posted 2014) [#1]

Hello all,

I created a custom dialog type for my project, and thought I'd share if somebody finds this amusing.

Keypoints:

Dialog is true modal (could be also modeless) which means it halts program flow to get user information and continues when user closes the dialog. Useful when running eventhook-based system.

Everything is created dynamically. If one looks Create() -method inside TDialog type, there is a example of methods used for setting style and controls in dialog.

Everything is sized automatically depending on font specified in SetFont() -method. If font is not found then system default is used.

I have tested this on Win7/8

EXAMPLE

Strict

Import maxgui.drivers
Import maxgui.xpmanifest	'Not needed, but visually better

Extern "win32"
	Function GetDlgItemTextW:Int(hwnd:Int, nIDDlgItem:Int, lpString:Short Ptr, nMaxCount:Int)
	Function DialogBoxIndirectParamW:Int(hinstance:Int,hDialogTemplate:Byte Ptr,hWndParent:Int,lpDialogFunc:Byte Ptr,dwInitParam:Int)
	Function EndDialog:Int(hDlg:Int,nResult:Int)
EndExtern

'-------------------------------------
'EXAMPLE (Eventhook-based application)
'-------------------------------------
Global app:TApp
TApp.Create()

Repeat
	WaitEvent()
Forever

Type TApp
	Field window2:tgadget = CreateWindow("Main",200,100,300,200,Null)
	Field button:tgadget = CreateButton("Dialog",100,50,80,36,window2)

	Function Create()
		app	= New TApp
		AddHook(EmitEventHook,eventhook,app)
	EndFunction
	
	Function eventhook:Object(id:Int,data:Object,context:Object)
		If TApp(context) Then TApp(context).OnEvent(TEvent(data))
		Return data
	End Function
	
	Method OnEvent(event:TEvent)
		
		Select event.id
			Case EVENT_WINDOWCLOSE	End
			
			Case EVENT_GADGETACTION
				
				'Show Dialog
				Local txt:String = CreateDialog("My very first dialog","Name:",10,10,160,75,window2)
				Print "Your name is "+txt
		EndSelect
	EndMethod
EndType
'---------------------------
'END
'---------------------------

Dialog type to be included:

Function CreateDialog:String(title:String,item:String,x:Int,y:Int,width:Int,height:Int,parent:tgadget=Null)
	Local txt:String = TDialog.Create(title,item,x,y,width,height,parent)
	If TDialog._ref Then TDialog._ref.free()
	Return txt
EndFunction

Type TDialog
	Const DS_MODALFRAME:Int	= $80
	Const DS_CENTER:Int		= $800
	Const DS_SETFONT:Int	= $40
	Const BS_SOLID:Int		= 0
	
	Const IDLABEL:Int		= 120	'User defined control ID's
	Const IDEDIT:Int		= 121
	
	Global _ref:TDialog = Null
	
	Field dlgb:Int					'Brush handle
	Field mem:Byte Ptr				'Pointer to reserved memory
	Field mem_ptr:Byte Ptr			'Pointer to write operation
	Field hwnd:Int					'Dialog parent handle
	Field ctrl_list:TList=New TList	'Controls in dialog				
	Field focus:Int					'Control handle to receive focus; Not implemented yet!
	Field text:String				'EditControl text
	Global font:TGuiFont			'Font name
	
	Field red:Int, green:Int, blue:Int	'Background colors
	
	Function Create:String(title:String,item:String,x:Int,y:Int,width:Int,height:Int,parent:tgadget=Null)
		
		_ref = New TDialog
		If parent Then _ref.hwnd = QueryGadget(parent,QUERY_HWND)
		
		'Set style & color
		_ref.SetFont("Segoe UI",10)
		_ref.SetBGColor(255,255,255)
		
		'Add some controls
		_ref.AddButton("Cancel",85,50,65,15,IDCANCEL)
		_ref.AddButton("OK",10,50,65,15,IDOK)
		_ref.AddLabel(item,10,10,40,12,IDLABEL)
		_ref.AddTextField("",70,10,80,12,IDEDIT)
		
		'Init & display
		_ref.InitDialog(title,x,y,width,height)
		_ref.ShowDialog()
		
		'Return user input
		Return _ref.text
	EndFunction
	
	Method ShowDialog()	
		Local ret:Int = DialogBoxIndirectParamW(0,mem,hwnd,DialogProc,0)
		
		'For return value see DialogProc()-function
		Select ret
			Case IDOK, IDCANCEL
				
			Case -1
				Notify("Error: Could not create dialog",True)
		EndSelect
	EndMethod
	
	Method SetBGColor(r:Int,g:Int,b:Int)
		red		= r
		green	= g
		blue	= b
	EndMethod
	
	Method SetFont(fName:String, fSize:Int)
		If font Then
			If font.name.toupper()=fName And font.size=fSize Then Return
		EndIf
		
		font = LoadGuiFont(fName,fSize)
	EndMethod
	
	Method InitDialog(title:String,x:Int,y:Int,width:Int,height:Int)
		Local dlg:DLG_TEMPLATE = New DLG_TEMPLATE
		dlg.style	= WS_POPUP | WS_BORDER | WS_SYSMENU | DS_MODALFRAME | WS_CAPTION  | WS_VISIBLE | DS_SETFONT '| DS_CENTER
		dlg.cdit	= 0
		dlg.x		= x
		dlg.y		= y
		dlg.cx		= width
		dlg.cy		= height
		dlg.menu	= 0
		dlg.class	= 0
		
		Local str_size:Int
		
		'Calculate size needed
		str_size = SizeOf(DLG_TEMPLATE) + title.length * 2 + 4
		For Local dlgi:DLG_ITEMTEMPLATE = EachIn ctrl_list
			str_size:+ (SizeOf(DLG_ITEMTEMPLATE) + dlgi.title.length * 2 + 4)
			dlg.cdit:+1
		Next
		
		'Allocate memory
		mem = MemAlloc(str_size) ; MemClear(mem, str_size)
		mem_ptr = mem
		
		'------------------------------
		'Create structure in memory
		'------------------------------
		str_size = SizeOf(DLG_TEMPLATE)
		MemCopy(mem,dlg,str_size)
		mem_ptr:+ str_size
		
		'Add dialog title
		For Local i:Int = 0 Until title.length
			mem_ptr[0] = title[i]
			mem_ptr:+2
		Next
		mem_ptr:+2
		
		'Add dialog font
		mem_ptr[0]=font.size ; mem_ptr:+2
		For Local i:Int = 0 Until font.name.length
			mem_ptr[0] = font.name[i]
			mem_ptr:+2
		Next
		mem_ptr:-2
		mem_ptr = AlignDW(mem_ptr)
		
		
		'Add dialog controls (textfields, buttons etc.)
		str_size = (SizeOf(DLG_ITEMTEMPLATE) - 6)
		For Local dlgi:DLG_ITEMTEMPLATE = EachIn ctrl_list
			
			MemCopy(mem_ptr,dlgi,str_size)
			mem_ptr:+ str_size
			
			'Add control title
			For Local i:Int = 0 Until dlgi.title.length
				mem_ptr[0] = dlgi.title[i]
				mem_ptr:+2
			Next
			mem_ptr = AlignDW(mem_ptr)	
		Next
	EndMethod
	
	Method AddButton(title:String,x:Int,y:Int,width:Int,height:Int,id:Int)
		Local dlgi:DLG_ITEMTEMPLATE = New DLG_ITEMTEMPLATE
		dlgi.style	= WS_CHILD | WS_VISIBLE | BS_DEFPUSHBUTTON
		dlgi.x		= x
		dlgi.y		= y
		dlgi.cx		= width
		dlgi.cy		= height
		dlgi.id		= id
		dlgi.class	= $ffff
		dlgi.ordinal= $80
		dlgi.title	= New Short[title.length]
		For Local i:Int = 0 Until title.length
			dlgi.title[i] = title[i]
		Next
		ctrl_list.addlast(dlgi)
	EndMethod
	
	Method AddLabel(title:String,x:Int,y:Int,width:Int,height:Int,id:Int)
		Local dlgi:DLG_ITEMTEMPLATE = New DLG_ITEMTEMPLATE
		dlgi.style	= WS_CHILD | WS_VISIBLE | SS_LEFT
		dlgi.x		= x
		dlgi.y		= y
		dlgi.cx		= width
		dlgi.cy		= height
		dlgi.id		= id
		dlgi.class	= $ffff
		dlgi.ordinal= $82
		dlgi.title	= New Short[title.length]
		For Local i:Int = 0 Until title.length
			dlgi.title[i] = title[i]
		Next
		ctrl_list.addlast(dlgi)
	EndMethod
	
	Method AddTextField(title:String,x:Int,y:Int,width:Int,height:Int,id:Int)
		Local dlgi:DLG_ITEMTEMPLATE = New DLG_ITEMTEMPLATE
		dlgi.style	= WS_CHILD | WS_VISIBLE | WS_BORDER
		dlgi.x		= x
		dlgi.y		= y
		dlgi.cx		= width
		dlgi.cy		= height
		dlgi.id		= id
		dlgi.class	= $ffff
		dlgi.ordinal= $81
		dlgi.title	= New Short[title.length]
		For Local i:Int = 0 Until title.length
			dlgi.title[i] = title[i]
		Next
		ctrl_list.addlast(dlgi)
	EndMethod
	
	Method AddCombobox(title:String,x:Int,y:Int,width:Int,height:Int,id:Int)
		'Todo
	EndMethod
	
	Method AlignW:Byte Ptr(sp:Byte Ptr)
		sp:+2
		Local int_ptr:Int = Int(sp)
		Return Byte Ptr((int_ptr Shr 1) Shl 1)
	EndMethod
	
	Method AlignDW:Byte Ptr(sp:Byte Ptr)
		sp:+6
		Local int_ptr:Int = Int(sp)
		Return Byte Ptr((int_ptr Shr 2) Shl 2)
	EndMethod
	
	Method Free()
		MemFree mem
		If dlgb Then DeleteObject(dlgb)
		ctrl_list.Clear()
		ctrl_list = Null
		_ref = Null
	EndMethod
	
	Function DialogProc(hwnd:Int, message:Int, wparam:Int, lparam:Int) "Win32"
	    Select message
	    
	        Case WM_INITDIALOG

				'Create backgroud color
				Local color:Int = (_ref.red)|(_ref.green Shl 8)|(_ref.blue Shl 16)
	
				_ref.dlgb = CreateSolidBrush(color)
				If Not _ref.dlgb Then RuntimeError("Error: No color created")
				
	        	Return True
	
			Case WM_CTLCOLORDLG, WM_CTLCOLORSTATIC
				Return _ref.dlgb
				
	        Case WM_COMMAND
	            
				'Check which button was pressed. EndDialog() ends dialog with return value as second parameter
				Select LOWORD(wparam)
	                Case IDOK
						DebugLog "OK button pressed "
						
						Local buffer:Short[64]
						GetDlgItemTextW(hwnd, IDEDIT, buffer, buffer.length)
						_ref.text = String.FromWString(buffer)
	                    EndDialog(hwnd, IDOK)
						Return True
						
	                Case IDCANCEL
						DebugLog "Cancel button pressed"
	                    
						EndDialog(hwnd, IDCANCEL)
						Return True
	           	EndSelect
	        Default
	            Return False
		EndSelect
		
	    Return True
	EndFunction
	
	Function HIWORD:Int(IntIn:Int)
		Return (IntIn Shr 16)
	EndFunction
	
	Function LOWORD:Int(IntIn:Int)
		Return (IntIn & $FFFF)
	EndFunction
EndType

Type DLG_TEMPLATE
    Field style:Int
    Field dwExtendedStyle:Int
    Field cdit:Short
    Field x:Short
    Field y:Short
    Field cx:Short
    Field cy:Short
    Field menu:Short
    Field class:Short
EndType

Type DLG_ITEMTEMPLATE
    Field style:Int
    Field dwExtendedStyle:Int
    Field x:Short
    Field y:Short
    Field cx:Short
    Field cy:Short
    Field id:Short
	Field class:Short
	Field ordinal:Short
	Field title:Short[]
	'Field length:Short	'Additional length of the title
EndType

-Henri