Custom Dialog (Win)


Tweet blitzmax maxgui code-archives
(Posted 1 year ago) RonTek

Custom dialog type for BlitzMax MaxGUI

Author: Henri

  • 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.
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

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

Example

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

Reply To Topic (minimum 10 characters)

Please log in to reply