Add StatusBar, ToolBar, Menus to Dialogs

Share your advanced PureBasic knowledge/code with the community.
User avatar
HeX0R
Addict
Addict
Posts: 979
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Add StatusBar, ToolBar, Menus to Dialogs

Post by HeX0R »

Here is a little trick to add stuff to the dialogs quite easy.
You will have anything in one XML, not only the gadgets, but also menus, statusbars, toolbars, even popup menus would be possible (but I was too lazy to add this).

I had to hack into PB a little bit, it would be more future proof if the PB team would just integrate it into the dialog lib.
Shouldn't be a big deal, as you can see in that tiny code, anything needed is there already.

Code: Select all

;Code: https://www.purebasic.fr/english/viewtopic.php?f=12&t=76247

;Version 1.05 [30.06.2023]  -> fixed entry point for PB >= 6.02
;Version 1.06 [03.07.2023]  -> fixed standard buttons for PB < 6.00
;Version 1.07 [10.07.2023]  -> fixed toolbar margin for linux
;Version 1.08 [20.02.2024]  -> fixed negative width for statusbar field and a missing Trim() in GetVal()
;Version 1.09 [18.03.2024]  -> added imagemenu to MyParseXML


CompilerIf Defined(USE_MYTOOLBARSTANDARD_PBI, #PB_Constant) = 0
	#USE_MYTOOLBARSTANDARD_PBI = #False
CompilerEndIf

CompilerIf #PB_Compiler_Version >= 600 And #USE_MYTOOLBARSTANDARD_PBI
	XIncludeFile "MyToolBarStandard.pbi"
	;get it from here:
	;https://www.purebasic.fr/english/viewtopic.php?f=12&t=67622
CompilerEndIf

DeclareModule DEX
	EnableExplicit
	Declare UsedWithDD(MenuMinID.i)    ;ignore this, only needed, when included in DialogDesign0R
	Declare DefaultImage(Image.i)      ;set a default picture (in case the runtime constant is not known), to prevent compiler warnings
	Declare ParseDialogXML(XML)
	Declare InitDialog(Dialog, XML, Name.s, OpenIt = #False)
	Declare RemoveStatusBar(Dialog.i)  ;added for DD
	Declare RemoveToolBar(Dialog.i)    ;added for DD
	Declare RemoveMenu(Dialog.i)       ;added for DD
	Declare DeInitDialog(Dialog)
	Declare DeInit()
	
EndDeclareModule

Module DEX
	
	CompilerIf Defined(MyToolBarStandard, #PB_Module)
		UseModule MyToolBarStandard

		CompilerIf #PB_Compiler_OS = #PB_OS_Linux
			Macro CreateToolBar(ToolBar, WindowID, Flags = 0)
				MyCreateToolBar(ToolBar, WindowID, Flags)
			EndMacro
		CompilerEndIf

	CompilerEndIf

	Structure DlgWindow
		*VTable
		*StaticData
		*Parent
		Gadget.i
		Folded.l
		HasTitle.l
		*ChildData
		tMargin.l
		bMargin.l
		lMargin.l
		rMargin.l
		vExpand.l
		hExpand.l
		vExpandMax.l
		hExpandMax.l
		vAlign.l
		hAlign.l
		RequestedWidth.l
		RequestedHeight.l
		Window.i
	EndStructure
	
	Structure _MYITEMS_
		MenuXML.i
		MenuID.i
		StatusBarXML.i
		StatusBarID.i
		MainXML.i
		ToolBarXML.i
		ToolBarID.i
		WindowName.s
		DialogNo.i
		tMargin.l
		bMargin.l
		*dialog.DlgWindow
	EndStructure
	
	
	Global NewList Items._MYITEMS_()
	Global NewMap Cons.l()
	Global MinID.i         ; only needed when used in DialogDesign0R, that one will hold the smallest ID we set
	Global CurrID.i        ; only needed when used in DialogDesign0R, because DD ignores users set ids and uses own incrementing values
	Global DefaultImage.i
	
	Procedure CreatePopup(*Node)
		
		
	EndProcedure
	
	Procedure DefaultImage(Image.i)    ; only needed, when used in DialogDesign0R, to show just "some" picture in the preview
		If IsImage(Image)
			DefaultImage = ImageID(Image)
		EndIf
	EndProcedure
	
	Procedure UsedWithDD(MenuMinID.i) ; only needed, when used in DialogDesign0R, DD will transmit the smallest free ID
		CurrID = MenuMinID
		MinID  = CurrID
	EndProcedure
	
	Procedure GetVal(ID.s, PB_Any = #True) ; get the value of a PB constant or, in case it wasn't found, the one of a runtime integer
		Protected Result, i, ID2.s, Found
		
		If ID
			ID2 = LCase(ID)
			For i = 0 To CountString(ID2, "|")
				If FindMapElement(Cons(), Trim(StringField(ID2, i + 1, "|")))
					Result = Result | Cons()
					Found  = #True
				EndIf
			Next i
			If Found = #False
				Result = GetRuntimeInteger(ID)
			EndIf
		ElseIf PB_Any
			Result = #PB_Any
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	
	Procedure DoMenus(MenuID, *Node)
		Protected i, id.s, iID, iID2, text.s, image.s, event.s, evproc
		
		If XMLNodeType(*Node) <> #PB_XML_Normal
			ProcedureReturn 
		EndIf
		
		Select LCase(GetXMLNodeName(*Node))
			Case "title"
				MenuTitle(GetXMLAttribute(*Node, "text"))
				For i = 1 To XMLChildCount(*Node)
					DoMenus(MenuID, ChildXMLNode(*Node, i))
				Next i
			Case "submenu"
				image = GetXMLAttribute(*Node, "image")
				iID   = -1
				If image
					iID = GetVal(image)
				EndIf
				If IsImage(iID)
					OpenSubMenu(GetXMLAttribute(*Node, "text"), ImageID(iID))
				Else
					OpenSubMenu(GetXMLAttribute(*Node, "text"))
				EndIf
				For i = 1 To XMLChildCount(*Node)
					DoMenus(MenuID, ChildXMLNode(*Node, i))
				Next i
				CloseSubMenu()
			Case "menubar"
				MenuBar()
			Case "menuitem"
				iID2  = -1
				id    = GetXMLAttribute(*Node, "id")
				text  = GetXMLAttribute(*Node, "text")
				event = GetXMLAttribute(*Node, "onevent")
				image = GetXMLAttribute(*Node, "image")
				If CurrID
					iID = CurrID
					CurrID + 1
				Else
					iID   = GetVal(id)
				EndIf
				iID2  = GetVal(image)
				If IsImage(iID2)
					MenuItem(iID, text, ImageID(iID2))
				Else
					MenuItem(iID, text)
				EndIf
				If CurrID = 0
					If event
						evproc = GetRuntimeInteger(event)
						If evproc
							BindMenuEvent(MenuID, iID, evproc)
						EndIf
					EndIf
				EndIf
		EndSelect
	EndProcedure
	
	Procedure RemoveMenu(Dialog.i)
		Protected Found
		
		If IsDialog(Dialog) = 0
			ProcedureReturn
		EndIf
		
		ForEach Items()
			If Items()\DialogNo = Dialog
				Found = #True
				Break
			EndIf
		Next
		If Found = #False Or Items()\MenuID = 0
			ProcedureReturn
		EndIf
		
		Items()\Dialog\bMargin - MenuHeight()
		FreeMenu(Items()\MenuID)
		FreeXML(Items()\MenuXML)
		Items()\MenuXML = 0
		Items()\MenuID = 0
		If Items()\StatusBarID = 0 And Items()\ToolBarID = 0
			;nothing else
			DeleteElement(Items())
		EndIf
		
		RefreshDialog(Dialog)
	EndProcedure		
	
	Procedure MenuAdd(Dialog.i)
		Protected Found, ID.s, i, *Node, Result, type.s, flags.s
		
		If IsDialog(Dialog) = 0
			ProcedureReturn
		EndIf
		
		ForEach Items()
			If Items()\DialogNo = Dialog
				Found = #True
				Break
			EndIf
		Next
		If Found = #False Or Items()\MenuXML = 0
			ProcedureReturn
		EndIf
		*Node          = MainXMLNode(Items()\MenuXML)
		ID             = GetXMLAttribute(*Node, "id")
		type           = GetXMLAttribute(*Node, "type")
		flags          = GetXMLAttribute(*Node, "flags")
		Items()\MenuID = GetVal(ID)
		If CurrID
			Items()\MenuID = CurrID
			CurrID + 1
		EndIf
		If Items()\MenuID = #PB_Any
			If LCase(type) = "imagemenu"
				Items()\MenuID = CreateImageMenu(#PB_Any, WindowID(DialogWindow(Dialog)), GetVal(flags, 0))
			Else
				Items()\MenuID = CreateMenu(#PB_Any, WindowID(DialogWindow(Dialog)))
			EndIf
		ElseIf LCase(type) = "imagemenu"
			CreateImageMenu(Items()\MenuID, WindowID(DialogWindow(Dialog)), GetVal(flags, 0))
		Else
			CreateMenu(Items()\MenuID, WindowID(DialogWindow(Dialog)))
		EndIf
		Result = Items()\MenuID
		
		For i = 1 To XMLChildCount(*Node)
			DoMenus(Result, ChildXMLNode(*Node, i))
		Next i

 		Items()\Dialog\bMargin + MenuHeight()
		RefreshDialog(Dialog)
		
		ProcedureReturn Result
	EndProcedure
	
	Procedure RemoveToolBar(Dialog.i)
		Protected Found
		
		If IsDialog(Dialog) = 0
			ProcedureReturn
		EndIf
		
		ForEach Items()
			If Items()\DialogNo = Dialog
				Found = #True
				Break
			EndIf
		Next
		If Found = #False Or Items()\ToolBarID = 0
			ProcedureReturn
		EndIf
		
		CompilerIf #PB_Compiler_OS = #PB_OS_Linux
			Items()\Dialog\bMargin - ToolBarHeight(Items()\ToolBarID)
		CompilerElse
			Items()\Dialog\tMargin - ToolBarHeight(Items()\ToolBarID)
		CompilerEndIf
		FreeToolBar(Items()\ToolBarID)
		FreeXML(Items()\ToolBarXML)
		Items()\ToolBarXML = 0
		Items()\ToolBarID = 0
		If Items()\StatusBarID = 0 And Items()\MenuID = 0
			;nothing else
			DeleteElement(Items())
		EndIf
		
		RefreshDialog(Dialog)
	EndProcedure
	
	Procedure ToolBarAdd(Dialog.i)
		Protected Found, ID.s, i, *Node, *CNode, Result, text.s, image.s, iID, bID, bbID, flags.s, iflags, type.s, tooltip.s
		
		If IsDialog(Dialog) = 0
			ProcedureReturn
		EndIf
		
		ForEach Items()
			If Items()\DialogNo = Dialog
				Found = #True
				Break
			EndIf
		Next

		If Found = #False Or Items()\ToolBarXML = 0
			ProcedureReturn
		EndIf
		*Node             = MainXMLNode(Items()\ToolBarXML)
		ID                = GetXMLAttribute(*Node, "id")
		flags             = GetXMLAttribute(*Node, "flags")
		Items()\ToolBarID = GetVal(ID)

		If flags
			iflags = GetVal(flags)
			If iflags = #PB_Any
				iflags = 0
			EndIf
		EndIf
		If Items()\ToolBarID = #PB_Any Or CurrID
			Items()\ToolBarID = CreateToolBar(#PB_Any, WindowID(DialogWindow(Dialog)), iflags)
		Else
			CreateToolBar(Items()\ToolBarID, WindowID(DialogWindow(Dialog)))
		EndIf
		Result = Items()\ToolBarID
		For i = 1 To XMLChildCount(*Node)
			*CNode = ChildXMLNode(*Node, i)
			If XMLNodeType(*CNode) = #PB_XML_Normal
				ID      = GetXMLAttribute(*CNode, "id")
				text    = GetXMLAttribute(*CNode, "text")
				image   = GetXMLAttribute(*CNode, "image")
				flags   = GetXMLAttribute(*CNode, "flags")
				type    = GetXMLAttribute(*CNode, "type")
				tooltip = GetXMLAttribute(*CNode, "tooltip")
				If CurrID
					bID = CurrID
					CurrID + 1
				Else
					bID = GetVal(ID)
				EndIf
				Select GetXMLNodeName(*CNode)
					Case "toolbutton"
						If type = "standard"
							CompilerIf Defined(MyToolBarStandard, #PB_Module)
								MyToolBarStandardButton(bID, GetVal(image), GetVal(flags, 0), text)
							CompilerElseIf #PB_Compiler_Version < 600
								ToolBarStandardButton(bID, GetVal(image), GetVal(flags, 0), text)
							CompilerElse
								bID = -1
								;well, we have no standard button, so ignore it
							CompilerEndIf
						Else
							iID = GetVal(image)
							If IsImage(iID)
								iID = ImageID(iID)
							ElseIf DefaultImage
								iID = DefaultImage
							Else
								iID = 0
							EndIf
							ToolBarImageButton(bID, iID, GetVal(flags, 0), text)
						EndIf
						
						If tooltip And bID <> -1
							ToolBarToolTip(Result, bID, tooltip)
						EndIf
						
					Case "toolseparator"
						ToolBarSeparator()
				EndSelect
			EndIf
		Next i
		
		CompilerIf #PB_Compiler_OS = #PB_OS_Linux
			Items()\dialog\bMargin + ToolBarHeight(Result)
		CompilerElse
			Items()\Dialog\tMargin + ToolBarHeight(Result)
		CompilerEndIf
 		RefreshDialog(Dialog)
		
		ProcedureReturn Result
	EndProcedure
	
	Procedure RemoveStatusBar(Dialog.i)
		Protected Found
		
		If IsDialog(Dialog) = 0
			ProcedureReturn
		EndIf
		
		ForEach Items()
			If Items()\DialogNo = Dialog
				Found = #True
				Break
			EndIf
		Next
		If Found = #False Or Items()\StatusBarID = 0
			ProcedureReturn
		EndIf
		
		Items()\Dialog\bMargin - StatusBarHeight(Items()\StatusBarID)
		FreeStatusBar(Items()\StatusBarID)
		FreeXML(Items()\StatusBarXML)
		Items()\StatusBarXML = 0
		Items()\StatusBarID = 0
		If Items()\ToolBarID = 0 And Items()\MenuID = 0
			;nothing else
			DeleteElement(Items())
		EndIf
		
		RefreshDialog(Dialog)
	EndProcedure		
		
	Procedure StatusBarAdd(Dialog.i)
		Protected Found, ID.s, i, *Node, *CNode, Result, Pos, iID
		Protected width.s, text.s, flags.s, min.s, max.s, type.s, Value.s, Image.s
		
		If IsDialog(Dialog) = 0
			ProcedureReturn
		EndIf
		
		ForEach Items()
			If Items()\DialogNo = Dialog
				Found = #True
				Break
			EndIf
		Next
		If Found = #False Or Items()\StatusBarXML = 0
			ProcedureReturn
		EndIf
		*Node = MainXMLNode(Items()\StatusBarXML)
		ID    = GetXMLAttribute(*Node, "id")
		If CurrID
			Items()\StatusBarID = CurrID
			CurrID + 1
		Else
			Items()\StatusBarID = GetVal(ID)
		EndIf
		If Items()\StatusBarID = #PB_Any
			Items()\StatusBarID = CreateStatusBar(#PB_Any, WindowID(DialogWindow(Dialog)))
		Else
			CreateStatusBar(Items()\StatusBarID, WindowID(DialogWindow(Dialog)))
		EndIf
		Result = Items()\StatusBarID
		
		For i = 1 To XMLChildCount(*Node)
			*CNode = ChildXMLNode(*Node, i)
			If XMLNodeType(*CNode) = #PB_XML_Normal And GetXMLNodeName(*CNode) = "field"
				width = GetXMLAttribute(*CNode, "width")
				text  = GetXMLAttribute(*CNode, "text")
				flags = GetXMLAttribute(*CNode, "flags")
				min   = GetXMLAttribute(*CNode, "min")
				max   = GetXMLAttribute(*CNode, "max")
				type  = GetXMLAttribute(*CNode, "type")
				Value = GetXMLAttribute(*CNode, "value")
				Image = GetXMLAttribute(*CNode, "image")
				If Val(width) >= 0
					AddStatusBarField(Val(width))
				Else
					AddStatusBarField(#PB_Ignore)
				EndIf
				Select LCase(type)
					Case "progress"
						If min = "" Or max = ""
							StatusBarProgress(Result, Pos, Val(Value), GetVal(flags, 0))
						Else
							StatusBarProgress(Result, Pos, Val(Value), GetVal(flags, 0), Val(min), Val(max))
						EndIf
					Case "image"
						iID = GetVal(image)
						If IsImage(iID) = 0 And DefaultImage = 0
							;Debugger doesn't like non existing Images
						Else
							If IsImage(iID) = 0
								iID = DefaultImage
							Else
								iID = ImageID(iID)
							EndIf
							StatusBarImage(Result, Pos, iID, GetVal(flags, 0)) 
						EndIf
						
					Default
						StatusBarText(Result, Pos, text, GetVal(flags, 0))
				EndSelect
				Pos + 1
			EndIf
		Next i
		Items()\Dialog\bMargin + StatusBarHeight(Items()\StatusBarID)
		RefreshDialog(Dialog)
		
		ProcedureReturn Result
	EndProcedure
	
	Procedure MyParseXML(XML, *Node, Name.s = "")
		Protected i, a$, Found
		
		If XMLNodeType(*Node) = #PB_XML_Normal
			Select LCase(GetXMLNodeName(*Node))
				Case "dialogs"
					For i = 1 To XMLChildCount(*Node)
						MyParseXML(XML, ChildXMLNode(*Node, i))
					Next i
				Case "window"
					a$    = GetXMLAttribute(*Node, "name")
					Found = #False
					ForEach Items()
						If Items()\MainXML = XML And Items()\WindowName = a$
							Found = #True
							Break
						EndIf
					Next
					If Found = #False
						AddElement(Items())
						Items()\MainXML    = XML
						Items()\WindowName = a$
						
					EndIf
					For i = 1 To XMLChildCount(*Node)
						MyParseXML(XML, ChildXMLNode(*Node, i), a$)
					Next i
				Case "menu", "imagemenu"
					If Name
						If Items()\MenuXML
							FreeXML(Items()\MenuXML)
						EndIf
						;store for later use
						Items()\MenuXML = CreateXML(#PB_Any)
						CopyXMLNode(*Node, RootXMLNode(Items()\MenuXML))
					EndIf
				Case "statusbar"
					If Name
						If Items()\StatusBarXML
							FreeXML(Items()\StatusBarXML)
						EndIf
						;store for later use
						Items()\StatusBarXML = CreateXML(#PB_Any)
						CopyXMLNode(*Node, RootXMLNode(Items()\StatusBarXML))
					EndIf
				Case "popup"
					CreatePopup(*Node)
				Case "toolbar"
					If Name
						If Items()\ToolBarXML
							FreeXML(Items()\ToolBarXML)
						EndIf
						;store for later use
						Items()\ToolBarXML = CreateXML(#PB_Any)
						CopyXMLNode(*Node, RootXMLNode(Items()\ToolBarXML))
					EndIf
			EndSelect
		EndIf
		
	EndProcedure
	
	Procedure ParseDialogXML(XML.i)
		Protected a$, b$, i, j
		
		;we need a Map to convert PB constants to the according values, e.g. #PB_Menu_ModernLook, #PB_StatusBar_Raised, ...
		If MapSize(Cons()) = 0  ;do this only if we didn't do it before
			Restore PBConstants
			Read.s a$
			b$ + LCase(a$)
			Repeat
				Read.s a$  ;first the contant names
				If a$
					b$ = b$ + "|" + LCase(a$)
				EndIf
			Until a$ = ""
			For i = 0 To CountString(b$, "|")
				Read.l j  ;now the constant values
				Cons(StringField(b$, i + 1, "|")) = j
			Next i
		EndIf
		
		If MinID
			CurrID = MinID
		EndIf
		
		If IsXML(XML) = 0
			ProcedureReturn
		EndIf
		
		MyParseXML(XML, MainXMLNode(XML))
		
		ProcedureReturn #True
	EndProcedure
	
	Procedure DeInitDialog(Dialog)
		
		If IsDialog(Dialog) = 0
			ProcedureReturn
		EndIf
		
		ForEach Items()
			If Items()\DialogNo = Dialog
				If Items()\MenuXML
					FreeXML(Items()\MenuXML)
				EndIf
				If Items()\StatusBarXML
					FreeXML(Items()\StatusBarXML)
				EndIf
				If Items()\ToolBarXML
					FreeXML(Items()\ToolBarXML)
				EndIf
				Items()\dialog\bMargin = Items()\bMargin
				Items()\dialog\tMargin = Items()\tMargin
				DeleteElement(Items())
				Break
			EndIf
		Next

	EndProcedure
	
	Procedure InitDialog(Dialog, XML.i, Name.s, OpenIt = #False)
		Protected *Pointer.INTEGER, Found, i, k, Add
		
		Structure _Filler_
			i.i[4]
			w1.w
			l.l
			w2.w
		EndStructure

		Structure _FillerC_ Align #PB_Structure_AlignC
			i.i[4]
			w1.w
			l.l
			w2.w
		EndStructure
	
		If IsDialog(Dialog) = 0 Or IsXML(XML) = 0
			ProcedureReturn
		EndIf
		
		Found = #False
		For k = 1 To 2
			ForEach Items()
				If Items()\MainXML = XML And Items()\WindowName = Name
					Found = #True
					Break
				EndIf
			Next
			If Found = #False
				ParseDialogXML(XML)
			EndIf
		Next k
		
		If Found = #False
			ProcedureReturn
		EndIf
		
		If OpenIt
			If OpenXMLDialog(Dialog, XML, Name) = 0
				Debug DialogError(Dialog)
				ProcedureReturn #False
			EndIf
		EndIf
		
		Items()\DialogNo = Dialog
		*Pointer         = DialogID(Dialog)
		CompilerIf #PB_Compiler_Version > 600
			Items()\Dialog = *Pointer\i + SizeOf(_FillerC_)
		CompilerElse
			Items()\Dialog = *Pointer\i + SizeOf(_Filler_)
		CompilerEndIf
; 		CompilerIf #PB_Compiler_Version > 600
; 			CompilerIf #PB_Compiler_Processor = #PB_Processor_x64 Or #PB_Compiler_OS = #PB_OS_MacOS
; 				Items()\Dialog = *Pointer\i + $30
; 			CompilerElse
; 				Items()\Dialog = *Pointer\i + $1C
; 			CompilerEndIf
; 		CompilerElse
; 			CompilerIf #PB_Compiler_Processor = #PB_Processor_x64 Or #PB_Compiler_OS = #PB_OS_MacOS
; 				Items()\Dialog = *Pointer\i + $28
; 			CompilerElse
; 				Items()\Dialog = *Pointer\i + $18
; 			CompilerEndIf
; 		CompilerEndIf
		Items()\bMargin = Items()\Dialog\bMargin
		Items()\tMargin = Items()\Dialog\tMargin
		StatusBarAdd(Dialog)
		MenuAdd(Dialog)
		ToolBarAdd(Dialog)
		
		ProcedureReturn #True
	EndProcedure
	
	Procedure DeInit()
		
		ForEach Items()
			If Items()\MenuXML
				FreeXML(Items()\MenuXML)
			EndIf
			If Items()\StatusBarXML
				FreeXML(Items()\StatusBarXML)
			EndIf
			If Items()\ToolBarXML
				FreeXML(Items()\ToolBarXML)
			EndIf
		Next
		ClearList(Items())
		
	EndProcedure

	DataSection
		PBConstants: ;pseudo runtime constants... just add more if needed
		Data.s "#PB_ToolBar_Normal", "#PB_ToolBar_Toggle", "#PB_ToolBar_Small", "#PB_ToolBar_Large", "#PB_ToolBar_Text", "#PB_ToolBar_InlineText"
		CompilerIf Defined(PB_ToolBarIcon_New, #PB_Constant)
			Data.s "#PB_ToolBarIcon_New", "#PB_ToolBarIcon_Open", "#PB_ToolBarIcon_Save", "#PB_ToolBarIcon_Print", "#PB_ToolBarIcon_PrintPreview"
			Data.s "#PB_ToolBarIcon_Find", "#PB_ToolBarIcon_Replace", "#PB_ToolBarIcon_Cut", "#PB_ToolBarIcon_Copy", "#PB_ToolBarIcon_Paste"
			Data.s "#PB_ToolBarIcon_Undo", "#PB_ToolBarIcon_Redo", "#PB_ToolBarIcon_Delete", "#PB_ToolBarIcon_Properties", "#PB_ToolBarIcon_Help"
		CompilerEndIf
		Data.s "#PB_Menu_ModernLook", "#PB_StatusBar_Raised", "#PB_StatusBar_BorderLess", "#PB_StatusBar_Center", "#PB_StatusBar_Right"
		Data.s ""
		Data.l #PB_ToolBar_Normal, #PB_ToolBar_Toggle, #PB_ToolBar_Small, #PB_ToolBar_Large, #PB_ToolBar_Text, #PB_ToolBar_InlineText
		CompilerIf Defined(PB_ToolBarIcon_New, #PB_Constant)
			Data.l #PB_ToolBarIcon_New, #PB_ToolBarIcon_Open, #PB_ToolBarIcon_Save, #PB_ToolBarIcon_Print, #PB_ToolBarIcon_PrintPreview
			Data.l #PB_ToolBarIcon_Find, #PB_ToolBarIcon_Replace, #PB_ToolBarIcon_Cut, #PB_ToolBarIcon_Copy, #PB_ToolBarIcon_Paste
			Data.l #PB_ToolBarIcon_Undo, #PB_ToolBarIcon_Redo, #PB_ToolBarIcon_Delete, #PB_ToolBarIcon_Properties, #PB_ToolBarIcon_Help
		CompilerEndIf
		Data.l #PB_Menu_ModernLook, #PB_StatusBar_Raised, #PB_StatusBar_BorderLess, #PB_StatusBar_Center, #PB_StatusBar_Right
		Data.l 0
	EndDataSection
	
EndModule


CompilerIf #PB_Compiler_IsMainFile
	UsePNGImageDecoder()
	Runtime Enumeration
		#MyBar
		#MainMenu
		#Menu_Load
		#Menu_Save
		#Menu_Sub1
		#Image_Load
		#MainToolBar
		#Button_Properties
	EndEnumeration
	
	Runtime Procedure OnLoad()
		Debug "load clicked"
	EndProcedure

	
	Procedure.s GetXMLString()
		Protected XML$
		
		XML$ + ~"<?xml version='1.0' encoding='UTF-16'?>\n"
		XML$ + ~"\n"
		XML$ + ~"<dialogs>\n"
		XML$ + ~"  <window flags='#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered' text='Bla' minheight='450' name='window_1'>\n"
		XML$ + ~"    <vbox expand='item:1'>\n"
		XML$ + ~"      <editor name='editor_1' width='500' height='300'/>\n"
		XML$ + ~"      <button name='button' height='24' text='Hi' />\n"
		XML$ + ~"    </vbox>\n"
		XML$ + ~"    <statusbar id='#MyBar'>\n"
		XML$ + ~"      <field width='100' text='text' />\n"
		XML$ + ~"      <field width='64' image='#Image_Load' type='image' flags='#PB_StatusBar_Center'/>\n"
		XML$ + ~"      <field width='120' min='0' max='80' value='60' type='progress'/>\n"
		XML$ + ~"      <field text='more text...' />\n"
		XML$ + ~"    </statusbar>\n"
		XML$ + ~"    <menu id='#MainMenu' type='imagemenu' flags='#PB_Menu_ModernLook'>\n"
		XML$ + ~"      <title text='File'>\n"
		XML$ + ~"        <menuitem id='#Menu_Load' text='Load' onevent='OnLoad()' image='#Image_Load' />\n"
		XML$ + ~"        <menubar />\n"
		XML$ + ~"        <menuitem id='#Menu_Save' text='Save' />\n"
		XML$ + ~"        <submenu text='submenu'>\n"
		XML$ + ~"          <menuitem id='#Menu_Sub1' text='whatever' />\n"
		XML$ + ~"        </submenu>\n"
		XML$ + ~"      </title>\n"
		XML$ + ~"    </menu>\n"
		XML$ + ~"    <toolbar id='#MainToolBar' flags='#PB_ToolBar_Large'>\n"
		XML$ + ~"      <toolbutton id='#Menu_Load' image='#Image_Load' tooltip='Load something'/>\n"
		XML$ + ~"      <toolseparator />\n"
		XML$ + ~"      <toolbutton id='#Button_Properties' image='#PB_ToolBarIcon_Properties' type='standard' tooltip='open preferences' />\n"
		XML$ + ~"    </toolbar>\n"
		XML$ + ~"  </window>\n"
		XML$ + ~"</dialogs>\n"
		
		ProcedureReturn XML$
	EndProcedure
	
	a$ = GetXMLString()
	CatchImage(#Image_Load, ?Pic, ?PicEnd - ?Pic)
	If CatchXML(0, @a$, StringByteLength(a$), 0, #PB_Unicode)
; 		DEX::ParseDialogXML(0)
		
		CreateDialog(0)
		DEX::InitDialog(0, 0, "window_1", #True)
		
		SetGadgetText(DialogGadget(0, "editor_1"), ~"this is our dialog xml:\n\n" + a$)
		
		Repeat
			Select WaitWindowEvent()
				Case #PB_Event_CloseWindow
					Break
			EndSelect
		ForEver
	EndIf
	
	End
	DataSection
		Pic:
		Data.l $474E5089, $0A1A0A0D, $0D000000, $52444849, $10000000, $10000000, $00000608, $FFF31F00, $00000061, $58457419, $666F5374, $72617774, $64410065, $2065626F, $67616D49, $61655265
		Data.l $C9717964, $00003C65, $54692203, $4D587458, $6F633A4C, $64612E6D, $2E65626F, $00706D78, $00000000, $70783F3C, $656B6361, $65622074, $3D6E6967, $BFBBEF22, $64692022, $3557223D
		Data.l $704D304D, $69686543, $65727A48, $544E7A53, $636B7A63, $3F226439, $783C203E, $706D783A, $6174656D, $6C6D7820, $783A736E, $6461223D, $3A65626F, $6D3A736E, $2F617465, $3A782022
		Data.l $74706D78, $41223D6B, $65626F64, $504D5820, $726F4320, $2E352065, $30632D30, $36203136, $34312E34, $39343930, $3032202C, $312F3031, $37302F32, $3A30312D, $303A3735, $20202031
		Data.l $20202020, $203E2220, $6664723C, $4644523A, $6C6D7820, $723A736E, $223D6664, $70747468, $772F2F3A, $772E7777, $726F2E33, $39312F67, $302F3939, $32322F32, $6664722D, $6E79732D
		Data.l $2D786174, $2223736E, $723C203E, $443A6664, $72637365, $69747069, $72206E6F, $613A6664, $74756F62, $2022223D, $6E6C6D78, $6D783A73, $68223D70, $3A707474, $736E2F2F, $6F64612E
		Data.l $632E6562, $782F6D6F, $312F7061, $222F302E, $6C6D7820, $783A736E, $4D4D706D, $7468223D, $2F3A7074, $2E736E2F, $626F6461, $6F632E65, $61782F6D, $2E312F70, $6D6D2F30, $7820222F
		Data.l $736E6C6D, $5274733A, $223D6665, $70747468, $6E2F2F3A, $64612E73, $2E65626F, $2F6D6F63, $2F706178, $2F302E31, $70795473, $65522F65, $72756F73, $65526563, $20222366, $3A706D78
		Data.l $61657243, $54726F74, $3D6C6F6F, $6F644122, $50206562, $6F746F68, $706F6873, $35534320, $5720312E, $6F646E69, $20227377, $4D706D78, $6E493A4D, $6E617473, $44496563, $6D78223D
		Data.l $69692E70, $36443A64, $38433331, $37414634, $31314233, $46423145, $44393042, $38304239, $31433644, $20224232, $4D706D78, $6F443A4D, $656D7563, $4449746E, $6D78223D, $69642E70
		Data.l $36443A64, $38433331, $37413035, $31314233, $46423145, $44393042, $38304239, $31433644, $3E224232, $6D783C20, $3A4D4D70, $69726544, $46646576, $206D6F72, $65527473, $6E693A66
		Data.l $6E617473, $44496563, $6D78223D, $69692E70, $36443A64, $38433331, $37414434, $31314233, $46423145, $44393042, $38304239, $31433644, $20224232, $65527473, $6F643A66, $656D7563
		Data.l $4449746E, $6D78223D, $69642E70, $36443A64, $38433331, $37414534, $31314233, $46423145, $44393042, $38304239, $31433644, $2F224232, $2F3C203E, $3A666472, $63736544, $74706972
		Data.l $3E6E6F69, $722F3C20, $523A6664, $203E4644, $3A782F3C, $6D706D78, $3E617465, $783F3C20, $6B636170, $65207465, $223D646E, $3E3F2272, $FC13A08C, $1D020000, $54414449, $937CDA78
		Data.l $51136BCF, $EFBFC710, $CD49366D, $26926E8F, $AD15A69A, $D2C5EB06, $1E22F45C, $82882A84, $45E4F278, $F41FC441, $37AAF09F, $783D1E2D, $27A2F4B2, $429178A5, $562A343C, $45628A90
		Data.l $87E6D14A, $F7DDD69A, $3776F39E, $1D4D764B, $3784DE18, $F7C999F3, $14A532CD, $307DBDB4, $B2A4A9B3, $94801294, $4A024A50, $718C089F, $378B1E0E, $9E7D5C8F, $7AC5D5EB, $4B084A97
		Data.l $8F48DB3A, $DF6E421E, $93A33234, $097B8B30, $1AE41706, $97731A01, $0059F42D, $4C1FCE90, $CFC79F5D, $7D688B0F, $FAB58379, $30B76002, $548F3BBC, $94AB0321, $837AAC45, $01031258
		Data.l $4CF70A4A, $8F481297, $F8E5405F, $0DAD3825, $D1D6AE6C, $ED0EFAFC, $A898CF8D, $03B61CEA, $75885F40, $3A9D7688, $24F1412F, $C50C6258, $6B1441EA, $EEEAF1A7, $A6C04C45, $F78030FA
		Data.l $AE804449, $C52664C7, $159D90DB, $294FEBD8, $1B1CFC76, $54030B51, $17753BD7, $F0CC5746, $BF78E9DC, $DD47AD95, $9327A001, $322323BF, $35C035CF, $34084A9A, $F6FC9DEE, $C2C0BF9F
		Data.l $A01F3142, $A8D85528, $27A5995D, $060CF677, $2A2209E8, $E8BA3D33, $57772278, $F68B6728, $00D20D4C, $A22C06AE, $C65431B2, $C8F317C7, $E2A5A7EF, $A13A2271, $4D7FBC16, $0DC0B6C1
		Data.l $6170C7EE, $B1FF948C, $66071DF6, $21F1004E, $9FF73F72, $F9BC603D, $65A5F169, $96C88B95, $18CC30F3, $3A74FFA4, $D8F87E5E, $A03D017D, $683B46E2, $A828FBDC, $ADDCD4DB, $4AC9D9DA
		Data.l $69264CEA, $232AB31C, $C6E71AEE, $C9FAF046, $AC2CEE12, $13642F9E, $6E7192BB, $7EF47EDE, $511AEA99, $E4F23E80, $FDECF205, $8753B59B, $ACE7D3C7, $82547994, $3DAFA7B5, $7C49692B
		Data.l $75057F95, $05BF4011, $8ABD7230, $7EDE908D, $06015FDD, $C7E29800, $F4DA266E, $0000001E, $4E454900, $6042AE44
		Data.b $82
		PicEnd:
	EndDataSection
	
CompilerEndIf
Last edited by HeX0R on Wed Mar 20, 2024 7:03 pm, edited 11 times in total.
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Add StatusBar, ToolBar, Menus to Dialogs

Post by Kwai chang caine »

Waouh !!! nice code like usually :shock:
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
Mesa
Enthusiast
Enthusiast
Posts: 345
Joined: Fri Feb 24, 2012 10:19 am

Re: Add StatusBar, ToolBar, Menus to Dialogs

Post by Mesa »

Great !

Do you think that it's possible to create a plugin for Dialogdesign0r easily ?

M.
User avatar
Saki
Addict
Addict
Posts: 830
Joined: Sun Apr 05, 2020 11:28 am
Location: Pandora

Re: Add StatusBar, ToolBar, Menus to Dialogs

Post by Saki »

Great and it even works without a magnifying glass on 4K. :o
地球上の平和
User avatar
HeX0R
Addict
Addict
Posts: 979
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Re: Add StatusBar, ToolBar, Menus to Dialogs

Post by HeX0R »

Mesa wrote:Great !

Do you think that it's possible to create a plugin for Dialogdesign0r easily ?

M.
I had the idea to integrate it into the base of DD, but I'm unsure if it is really a good idea.
Maybe the PB team will add something like this in future, but with different node names, or even worse, with a complete different approach.

I didn't think about doing it in a plugin, it will be most likely not possible without improving the addon system.
Mesa
Enthusiast
Enthusiast
Posts: 345
Joined: Fri Feb 24, 2012 10:19 am

Re: Add StatusBar, ToolBar, Menus to Dialogs

Post by Mesa »

You can ask Fred for that.
But I'm pretty sure fred would have done it from the start, so you can put it in the designer, it's very useful and I think it will be a long time before that happens.

M.
User avatar
HeX0R
Addict
Addict
Posts: 979
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Re: Add StatusBar, ToolBar, Menus to Dialogs

Post by HeX0R »

Some small changes
  • Changed barbutton into toolbutton and barseparator into toolseparator.
  • Changed a few things to be able to use it in the DialogDesign0r.
  • No more need to call ParseDialogXML(), it will be called in InitDialog() in case the XML is not yet known.
Integration into DD looks good so far, but there is still some more work to do.
User avatar
Andre
PureBasic Team
PureBasic Team
Posts: 2056
Joined: Fri Apr 25, 2003 6:14 pm
Location: Germany (Saxony, Deutscheinsiedel)
Contact:

Re: Add StatusBar, ToolBar, Menus to Dialogs

Post by Andre »

Looks very well, thank you :D
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)
Post Reply