Load .vb Resouce (Visual Studio Express 2012 Designer) v0.3
Posted: Tue Oct 29, 2013 6:57 am
Notes:
NB: I still consider this sandbox code
v0.3
You'll need to provide your own #RESOURCE = "data\test\Form1.Designer.vb" ; <--- Change this.
No event processing yet, but it's probably clear where I'm heading with this, with call function(s)
naturally in some sort of sane way, menus into one procedure gadget to the own procedure.
Reason:
Just something I always wanted to do, there isn't anything wrong with the form designer that comes with
PureBasic wonderful tool I've used it lot, I just felt like something different.
On my To list with this code
Export to a .pb file - for means of quicker debugging the translator and an alternative to including the resource
in the file.
-- I am a busy guy at the moment with doing a degree in I.T at weltec so don't expect it too get update too quickly.
Oops: Bug() command and InitBug() you can remove/replace, with your own code they connect into my
own library of code bits, InitBug() sets up an output file and the number is for the amount of columns I want to output,
with each argument in Bug() being in its own column when output is sent to a file.
Yes I know about SaveDebugOutput() but it doesn't seem to operate on my PC, and I prefer my own way anyhow so
no great loss.
NB: I still consider this sandbox code
v0.3
Code: Select all
; * (0.3)
; Added: the following 'Controls' marked with a '*'
; Controls
;
; * ButtonGadget ButtonImageGadget * CalendarGadget
; * CheckBoxGadget * ComboBoxGadget
; DateGadget * EditorGadget
; ExplorerComboGadget ExplorerListGadget ExplorerTreeGadget
; HyperLinkGadget IPAddressGadget
; * ImageGadget ListIconGadget * ListViewGadget
; * OptionGadget
; * ProgressBarGadget ? (cmin,cmax) ScrollBarGadget
; ShortcutGadget SpinGadget
; * StringGadget TextGadget * TrackBarGadget ? (cmin,cmax)
; * TreeGadget * WebGadget ? (url)
; New Controls
;
; * CheckedListBox() = TreeGadget() with aproperate flag settings.
; Containers
;
; SplitterGadget ScrollAreaGadget MDIGadget
; * FrameGadget ContainerGadget CanvasGadget
; PanelGadget
; Added: events to 'Controls' / Can be found in the (Testing) block of code, the procedures within
; (Testing) are assumed to be defined after including this source code, in other words user created.
; in the below (Testing) area, each 'Control' event gets its own 'Procedure' call, you could just as
; well just use '1' procedure for all events if you so wished.
No event processing yet, but it's probably clear where I'm heading with this, with call function(s)
naturally in some sort of sane way, menus into one procedure gadget to the own procedure.
Reason:
Just something I always wanted to do, there isn't anything wrong with the form designer that comes with
PureBasic wonderful tool I've used it lot, I just felt like something different.
On my To list with this code
Export to a .pb file - for means of quicker debugging the translator and an alternative to including the resource
in the file.
-- I am a busy guy at the moment with doing a degree in I.T at weltec so don't expect it too get update too quickly.
Oops: Bug() command and InitBug() you can remove/replace, with your own code they connect into my
own library of code bits, InitBug() sets up an output file and the number is for the amount of columns I want to output,
with each argument in Bug() being in its own column when output is sent to a file.
Yes I know about SaveDebugOutput() but it doesn't seem to operate on my PC, and I prefer my own way anyhow so
no great loss.
Code: Select all
;=============================================================================
; Title: Resource Translation Libaray
; Author: T.J.Roughton
; Version: 0.2
; Notes: Used to convert 'at run time' a "Form.vb" into UI usable by PB
;=============================================================================
;- Top
; Currently Supports:
;
; * (0.1)
; CreatePopupMenu (Done)
; OpenWindow (Done)
; * (0.2)
; Re-wrote the entire code For 'Phasing' the resource file
; ContextMenus (Popup Menus) now support sub menus
; lots of bug fixes.
; * (0.3)
; Added: the following 'Controls' marked with a '*'
; Controls
;
; * ButtonGadget ButtonImageGadget * CalendarGadget
; * CheckBoxGadget * ComboBoxGadget
; DateGadget * EditorGadget
; ExplorerComboGadget ExplorerListGadget ExplorerTreeGadget
; HyperLinkGadget IPAddressGadget
; * ImageGadget ListIconGadget * ListViewGadget
; * OptionGadget
; * ProgressBarGadget ? (cmin,cmax) ScrollBarGadget
; ShortcutGadget SpinGadget
; * StringGadget TextGadget * TrackBarGadget ? (cmin,cmax)
; * TreeGadget * WebGadget ? (url)
; New Controls
;
; * CheckedListBox() = TreeGadget() with aproperate flag settings.
; Containers
;
; SplitterGadget ScrollAreaGadget MDIGadget
; * FrameGadget ContainerGadget CanvasGadget
; PanelGadget
; Added: events to 'Controls' / Can be found in the (Testing) block of code, the procedures within
; (Testing) are assumed to be defined after including this source code, in other words user created.
; in the below (Testing) area, each 'Control' event gets its own 'Procedure' call, you could just as
; well just use '1' procedure for all events if you so wished.
; Debugger
;
XIncludeFile "../debugger.pb"
;=============================================================================
; Enumerations
;=============================================================================
Enumeration GADGET_ENUM
#TLUI_CreatePopupMenu = 1000
#TLUI_MenuItem
EndEnumeration
;=============================================================================
; Structures
;=============================================================================
Structure GADGET_RESOURCE
gid.l
ghandle.l
name.s
text.s
x.l
y.l
width.l
height.l
flags.l
procaddr.l
EndStructure
Structure MENU_RESOURCE
gid.l
ghandle.l
name.s
text.s
x.l
y.l
showimagemargin.l
EndStructure
Structure WINDOW_RESOURCE
class.s ; Partial Class --> TheTestWindow
whandle.l ;
name.s ; <-- REFERENCE
text.s ;
flags.l ;
x.l ;
y.l ;
width.l ;
height.l ;
maxwidth.l ;
maxheight.l ;
minwidth.l ;
minheight.l ;
callback.l ;
; Handles conntected directly to this window
contextmhandle.l ;
; Private Internal Stuff
hpopup.l ; Current handle of popup menu being processed.
hpopupname.s ; String name of current popup window attached to this window.
Map ctrlmap.GADGET_RESOURCE() ; Private gadget list
EndStructure
Global NewList restags.s()
Global winrsc.WINDOW_RESOURCE
;-> Export to my String Library
Macro GetStringFromTo(string,fromchar,tochar,removelimitchr)
RemoveString(Mid(string,FindString(string,fromchar)+removelimitchr),Mid(string,FindString(string,tochar)+(1-removelimitchr)))
EndMacro
Macro GetStringFromRight(string,fromchar)
Trim(Mid(string,FindString(string,fromchar)+1,Len(string)))
EndMacro
Macro GetStringFromLeft(string,tochar)
Trim(Mid(string,1,FindString(string,tochar)-1))
EndMacro
;-> Internal Macros
Macro MapFlagAdd(flagname,flagvalue)
AddMapElement(mkflags(),flagname)
mkflags()=flagvalue
EndMacro
Macro MapFlagDel(flagname)
DeleteMapElement(mkflags(),flagname)
EndMacro
#RESOURCE = "data\test\Form1.Designer.vb" ; <--- Change this
;=============================================================================
; TESTING TESTING TESTING TESTING TESTING TESTING TESTING TESTING TESTING
;=============================================================================
Procedure GAD_Button1(gadgetid)
Debug gadgetid
Debug ("Hello World")
EndProcedure
;NAME
; Event_MenuHandler()
;FUNCTION
; Event_MenuHandler(?)
;SYNOPSIS
; ?
;DISCRIPTION
; This Procedure "DOES NOT" belong here its for testing only
;BUGS
; None
;
Procedure GetProcedureByName(cname.s)
Define procaddr = 0
Select cname
Case "Button1"
procaddr = @GAD_Button1()
EndSelect
ProcedureReturn procaddr
EndProcedure
;NAME
; Event_MenuHandler()
;FUNCTION
; Event_MenuHandler(?)
;SYNOPSIS
; ?
;DISCRIPTION
; This Procedure "DOES NOT" belong here its for testing only
;BUGS
; None
;
Procedure Event_MenuHandler(emenu)
Define result.b = #False
Select GetMenuItemText(winrsc\contextmhandle,emenu)
Case "Exit"
result = #PB_Event_CloseWindow
EndSelect
ProcedureReturn result
EndProcedure
;=============================================================================
; TESTING TESTING TESTING TESTING TESTING TESTING TESTING TESTING TESTING
;=============================================================================
;NAME
; TLUI_LoadResource()
;FUNCTION
; TLUI_LoadResource(filename.s)
;SYNOPSIS
; filename.s
;DISCRIPTION
; Phases the Included Binrary .vb file into a list.
;BUGS
; None
;
Procedure TLUI_WndProc(winid, msg, wparam, lparam)
Define result = #PB_ProcessPureBasicEvents
Define *pMinMax.MINMAXINFO
Select msg
Case #WM_GETMINMAXINFO
*pMinMax = lparam
*pMinMax\ptMinTrackSize\x = winrsc\minwidth
*pMinMax\ptMinTrackSize\y = winrsc\minheight
*pMinMax\ptMaxTrackSize\x = winrsc\maxwidth
*pMinMax\ptMaxTrackSize\y = winrsc\maxheight
; Force a minimum window size for our application.
result = 0
; And clear the messages
Case #WM_RBUTTONUP
DisplayPopupMenu(winrsc\contextmhandle,winid)
EndSelect
ProcedureReturn result
EndProcedure
;NAME
; TLUI_MakeGadgets()
;FUNCTION
; TLUI_MakeGadgets()
;SYNOPSIS
; filename.s
;DISCRIPTION
; Phases the Included Binrary .vb file into a list.
;BUGS
; None
;
Procedure TLUI_MakeControls(name.s,List cline.s(),Map mline.l())
Define ncontrols = CountString(name,",")
Define controlname.s = ""
Define controlnamemap.s = ""
Define cname.s = ""
Define ctxt.s = ""
Define cx = 0
Define cy = 0
Define cw = 0
Define ch = 0
Define controltaborder = 0
Define i = 0
Bug("-=")
Bug("","TLUI_MakeControls()")
Bug("-=")
Bug("","",name)
For i = 1 To ncontrols
SelectElement(cline(),mline(StringField(StringField(name,i,","),2,"."))-1)
While NextElement(cline())
If Left(cline(),1)="'"
Break
EndIf
; We only need to go into the Select / EndSelect if something is 'non-standard'
; about the control, basic info can be obtained from these default types.
;Me.Button1.Location = New System.Drawing.Point(12, 12)
;Me.Button1.Size = New System.Drawing.Size(177, 42)
;Me.Button1.TabIndex = 1
;Me.Button1.Text = "Button Test"
; Information Gathering
;
Select StringField(GetStringFromLeft(cline(),"="),3,".")
Case "Name"
cname = RemoveString(GetStringFromRight(cline(),"="),Chr(34))
Case "Location"
cx = Val(StringField(RemoveString(GetStringFromTo(cline(),"(",")",#True)," "),1,","))
cy = Val(StringField(RemoveString(GetStringFromTo(cline(),"(",")",#True)," "),2,","))
Case "Size"
cw = Val(StringField(RemoveString(GetStringFromTo(cline(),"(",")",#True)," "),1,","))
ch = Val(StringField(RemoveString(GetStringFromTo(cline(),"(",")",#True)," "),2,","))
Case "TabIndex"
controltaborder = Val(GetStringFromRight(cline(),"="))
Case "Text"
ctxt = RemoveString(GetStringFromRight(cline(),"="),Chr(34))
EndSelect
Wend
; Controls
;
; * ButtonGadget ButtonImageGadget * CalendarGadget
; * CheckBoxGadget * ComboBoxGadget
; DateGadget * EditorGadget
; ExplorerComboGadget ExplorerListGadget ExplorerTreeGadget
; HyperLinkGadget IPAddressGadget
; * ImageGadget ListIconGadget * ListViewGadget
; * OptionGadget
; * ProgressBarGadget ? (cmin,cmax) ScrollBarGadget
; ShortcutGadget SpinGadget
; * StringGadget TextGadget * TrackBarGadget ? (cmin,cmax)
; * TreeGadget * WebGadget ? (url)
; New Controls
;
; * CheckedListBox() = TreeGadget() with aproperate flag settings.
; Containers
;
; SplitterGadget ScrollAreaGadget MDIGadget
; * FrameGadget ContainerGadget CanvasGadget
; PanelGadget
Bug(StringField(StringField(name,i,","),1,"."),"",Str(cx)+","+Str(cy)+","+Str(cw)+","+Str(ch)+","+ctxt+","+cname)
; Make Control .vb -> .pb
;
Select StringField(StringField(name,i,","),1,".") ;<<< ------ BUG
Case "Button()"
ghandle = ButtonGadget(#PB_Any,cx,cy,cw,ch,ctxt)
Case "CheckBox()"
ghandle = CheckBoxGadget(#PB_Any,cx,cy,cw,ch,ctxt)
Case "CheckedListBox()"
; nb: closest translation
ghandle = TreeGadget(#PB_Any,cx,cy,cw,ch,#PB_Tree_NoButtons|#PB_Tree_NoLines|#PB_Tree_CheckBoxes)
Case "ComboBox()"
ghandle = ComboBoxGadget(#PB_Any,cx,cy,cw,ch)
Case "GroupBox()"
ghandle = FrameGadget(#PB_Any,cx,cy,cw,ch,ctxt)
Case "Label()"
ghandle = TextGadget(#PB_Any,cx,cy,cw,ch,ctxt)
Case "ListBox()"
ghandle = ListViewGadget(#PB_Any,cx,cy,cw,ch)
Case "ListView()"
ghandle = ListViewGadget(#PB_Any,cx,cy,cw,ch)
Case "LinkLabel()"
ghandle = HyperLinkGadget(#PB_Any,cx,cy,cw,ch,ctxt,0)
Case "RadioButton()"
ghandle = OptionGadget(#PB_Any,cx,cy,cw,ch,ctxt)
Case "RichTextBox()"
ghandle = EditorGadget(#PB_Any,cx,cy,cw,ch)
Case "TextBox()"
ghandle = StringGadget(#PB_Any,cx,cy,cw,ch,"")
;TextGadget(#PB_Any,cx,cy,cw,ch,"Test 1 2 3 4")
Case "TrackBar()"
ghandle = TrackBarGadget(#PB_Any,cx,cy,cw,ch,0,0)
Case "TreeView()"
ghandle = TreeGadget(#PB_Any,cx,cy,cw,ch)
Case "MonthCalendar()"
ghandle = CalendarGadget(#PB_Any,cx,cy,220,160,#PB_Calendar_Borderless)
Case "PictureBox()"
ghandle = ImageGadget(#PB_Any,cx,cy,cw,ch,0,#PB_Image_Border)
Case "ProgressBar()"
ghandle = ProgressBarGadget(#PB_Any,cx,cy,cw,ch,0,0)
Case "WebBrowser()"
ghandle = WebGadget(#PB_Any,cx,cy,cw,ch,"")
Default
Bug("ERROR","No idea what 'control' this is?!",StringField(StringField(name,i,","),1,"."))
EndSelect
; Add whatever 'control' to map
AddMapElement(winrsc\ctrlmap(),Str(ghandle))
winrsc\ctrlmap()\name = cname
winrsc\ctrlmap()\procaddr = GetProcedureByName(cname)
Next
EndProcedure
;NAME
; TLUI_MakeResources()
;FUNCTION
; TLUI_MakeResources(filename.s)
;SYNOPSIS
; filename.s
;DISCRIPTION
; Phases the Included Binrary .vb file
;BUGS
; None
;
Procedure TLUI_MakeMenu(name.s,List cline.s(),Map mline.l(),level.l = 0)
Define range.s
Define value.s = ""
Define i,rangelen = 0
Define osub = #False
Define tmp.s = ""
Bug("-=")
Bug("","TLUI_MakeMenu()")
Bug("-=")
Bug(name.s,cline(),Str(mline(name)-1))
SelectElement(cline(),mline(name)-1)
While NextElement(cline())
If Left(cline(),1)="'"
Break
EndIf
Select GetStringFromleft(cline(),"=")
Case "Me."+name+".Name"
;Debug GetStringFromRight(cline(),"=")
Case "Me."+name+".ShowImageMargin"
;Debug GetStringFromRight(cline(),"=")
Case "Me."+name+".Size"
;Debug GetStringFromRight(cline(),"=")
Case "Me."+name+".Text"
value.s = RemoveString(GetStringFromRight(cline(),"="),Chr(34))
If (level>0)
If (osub = #True)
OpenSubMenu(value)
Else
MenuItem(mline(name)-1,value)
EndIf
sub = #False
EndIf
Default
If (level = 0)
range = "Me."+name+".Items.AddRange"
If Left(cline(),Len(range))=range
range = RemoveString(GetStringFromTo(cline(),"{","}",#True)," ")
range = RemoveString(range,"Me.") + ","
EndIf
EndIf
If (level > 0)
range = "Me."+name+".DropDownItems.AddRange"
If Left(cline(),Len(range))=range
range = RemoveString(GetStringFromTo(cline(),"{","}",#True)," ")
range = RemoveString(range,"Me.") + ","
EndIf
osub = #True
EndIf
EndSelect
Wend
level = level + 1
If (level = 1)
; It's here but I don't like the style.
;winrsc\contextmhandle = CreatePopupImageMenu(#PB_Any, #PB_Menu_ModernLook)
winrsc\contextmhandle = CreatePopupMenu(#PB_Any)
EndIf
rangelen = CountString(range,",")
For i = 1 To rangelen
TLUI_MakeMenu(StringField(range,i,","),cline(),mline(),level)
If (i = rangelen)
CloseSubMenu()
EndIf
Next
EndProcedure
;NAME
; TLUI_PhaseResourceList()
;FUNCTION
; TLUI_PhaseResourceList(filename.s)
;SYNOPSIS
; filename.s
;DISCRIPTION
; Phases the Included Binrary .vb file
;BUGS
; None
;
Procedure TLUI_PhaseResourceList(winname.s,List cline.s(),Map mline.l(),List clayout.s())
Define tag.s = ""
Define value.s = ""
Define addflags.l = 0
Define contextmname.s = ""
Define controlnames.s = ""
Define controlbuf.s = ""
Define controlidx.l = 0
Define idx.l = 0
Define NewMap mkflags.l()
MapFlagAdd("#PB_Window_SystemMenu",#PB_Window_SystemMenu)
MapFlagAdd("#PB_Window_SizeGadget",#PB_Window_SizeGadget)
MapFlagAdd("#PB_Window_MinimizeGadget",#PB_Window_MinimizeGadget)
MapFlagAdd("#PB_Window_MaximizeGadget",#PB_Window_MaximizeGadget)
Bug("-=")
Bug("","TLUI_PhaseResourceList()")
Bug("-=")
Bug("Window Name",winname)
ResetList(cline())
SelectElement(cline(),mline(winname))
; Window
;
While (NextElement(cline()))
;Bug("cline("+Str(ListIndex(cline()))+")","List",cline())
ForEach restags()
tag = "Me" + restags()
If FindString(cline(),tag)
value.s = RemoveString(GetStringFromRight(cline(),"="),Chr(34))
Bug("cline("+Str(ListIndex(cline()))+")",tag,cline())
With winrsc
Select tag
Case "Me.Name"
\name = value
Case "Me.Size"
Case "Me.Text"
\text = value
Case "Me.AutoScaleDimensions"
Case "Me.AutoScaleMode"
Case "Me.ClientSize"
\width = Val(StringField(GetStringFromTo(value,"(",")",#True),1,","))
\height = Val(StringField(GetStringFromTo(value,"(",")",#True),2,","))
Case "Me.MaximumSize"
\maxwidth = Val(StringField(GetStringFromTo(value,"(",")",#True),1,","))
\maxheight = Val(StringField(GetStringFromTo(value,"(",")",#True),2,","))
Case "Me.MinimumSize"
\minwidth = Val(StringField(GetStringFromTo(value,"(",")",#True),1,","))
\minheight = Val(StringField(GetStringFromTo(value,"(",")",#True),2,","))
Case "Me.MaximizeBox"
MapFlagDel("#PB_Window_MaximizeGadget")
Case "Me.MinimizeBox"
MapFlagDel("#PB_Window_MinimizeGadget")
Case "Me.StartPosition"
Select StringField(value,CountString(value,".")+1,".")
Case "CenterScreen"
MapFlagAdd("#PB_Window_ScreenCentered",#PB_Window_ScreenCentered)
EndSelect
;
; UI Attached to this window :)
;
Case "Me.Controls"
controlnames + GetStringFromTo(value,"(",")",#True) + ","
Case "Me.ContextMenuStrip"
contextmname = RemoveString(value,"Me.")
EndSelect
EndWith
EndIf
Next
Wend
; Layout
; Contains meaningful information about controls in regards to there type.
ResetList(clayout())
For controlidx = 0 To CountString(controlnames,",")
ForEach clayout()
If FindString(clayout(),StringField(controlnames,1+controlidx,","))
For idx = Len(clayout()) To 0 Step -1
If (Mid(clayout(),idx,1)=".")
controlbuf + ReplaceString(StringField(controlnames,1+controlidx,","),"Me",RemoveString(clayout(),Left(clayout(),idx))) + ","
Break
EndIf
Next
EndIf
Next
Next
; Create Window
;
With winrsc
If (\name<>"")
; Build Window Flags
ForEach mkflags()
addflags = addflags | mkflags()
Next
\whandle = OpenWindow(#PB_Any,\x,\y,\width,\height,\text,addflags)
;Bug("OpenWindow","",Str(\x)+","+Str(\y)+","+Str(\width)+","+Str(\height)+","+\text+","+Str(addflags))
SetWindowCallback(\callback,\whandle)
If (contextmname<>"")
TLUI_MakeMenu(contextmname,cline(),mline())
EndIf
If (controlnames<>"")
TLUI_MakeControls(controlbuf,cline(),mline())
EndIf
EndIf
EndWith
; Create Contect Menu (*if we need one*)
;
ClearMap(mkflags())
EndProcedure
;NAME
; TLUI_ReadResource()
;FUNCTION
; TLUI_ReadResource(*memptr,size)
;SYNOPSIS
; *memptr
; size
;DISCRIPTION
; Reads the Resources, either internal or external from code, it all ends up
; in the same place memory.
;BUGS
; None
;
Procedure TLUI_ReadResource(winname.s,*memptr,resourcesize,Map lnbuffermap.l())
Define i = 3 ; seam to be some trash at the start of the .vb file
Define c = 0
Define ln.s = ""
Define restag.s = ""
Define resgad.s = ""
Define begin = 0
Define NewList lnbuffer.s()
Define NewList layoutbuffer.s()
Bug("-=")
Bug("","TLUI_ReadResource()")
Bug("-=")
ClearList(restags())
Bug("Read","ResourceTags")
Restore resourcetags
While (restag<>"--")
Read.s restag
If(restag<>"--")
AddElement(restags())
restags()=restag
EndIf
Wend
; Need a Window ID
;
Bug("Read","Resource")
While (i<=resourcesize)
ln = ln + Chr(PeekA(*memptr+i))
If (PeekB(*memptr+i)=$D)
If FindString(ln,"ResumeLayout(False)")
begin = #False
EndIf
If begin = #True
AddElement(lnbuffer())
lnbuffer() = Trim(Mid(ln,1,Len(ln)-1))
If (Mid(lnbuffer(),1,1)="'") And (Len(lnbuffer())>1)
AddMapElement(lnbuffermap(),LTrim(lnbuffer(),"'"))
lnbuffermap()=ListIndex(lnbuffer())+2
Bug("Mapped",MapKey(lnbuffermap()),Str(lnbuffermap()))
EndIf
EndIf
If FindString(ln,"Me.SuspendLayout()") ; Only start adding when there is something useful to add.
begin = #True
EndIf
If begin = #False
If (Left(Trim(ln),3) = "Me.")
AddElement(layoutbuffer())
layoutbuffer() = Trim(Mid(ln,1,Len(ln)-1))
EndIf
EndIf
i=i+1 : ln = ""
EndIf
i=i+1
Wend
TLUI_PhaseResourceList(winname,lnbuffer(),lnbuffermap(),layoutbuffer())
ClearList(lnbuffer())
ClearList(layoutbuffer())
EndProcedure
;NAME
; TLUI_InitInterface()
;FUNCTION
; TLUI_InitInterface(filename.s)
;SYNOPSIS
; filename.s
;DISCRIPTION
; Phases the Included Binrary .vb file into a list.
;BUGS
; .. TLUI_LoadResource()
; Q: If FindString(winrscname,name) ; <--- WHY? .. should be "If (winrscname = name) ... EndIf"
; A: String was terminated with $D but name was terminated as all strings in PB are with a NULL
; | #PB_Window_SystemMenu | #PB_Window_SizeGadget
Procedure TLUI_InitInterface(name.s,callback.i = 0)
Define resourcesize.i = ?iface_resource_end-?iface_resource
Define eventmap = 0
Define event = 0
Define controleventid = 0
Define _msecdebug = ElapsedMilliseconds()
Define NewMap lnbuffermap.l()
Bug("-=")
Bug("","TLUI_InitInterface()")
Bug("-=")
If callback>0
winrsc\callback = callback
Else
winrsc\callback = @TLUI_WndProc()
EndIf
TLUI_ReadResource(name,?iface_resource,resourcesize,lnbuffermap())
Bug("Init UI Delay","ms "+Str(ElapsedMilliseconds()-_msecdebug))
;Event_MenuHandler()
If (winrsc\name = name)
Repeat
event = WaitWindowEvent()
Select event
Case #PB_Event_Gadget
controleventid = EventGadget()
winrsc\ctrlmap(Str(controleventid))
If (winrsc\ctrlmap()\procaddr<>0)
CallFunctionFast(winrsc\ctrlmap()\procaddr,controleventid)
EndIf
;Debug winrsc\ctrlmap()\name
Case #PB_Event_Menu
event = Event_MenuHandler(EventMenu())
EndSelect
Until event = #PB_Event_CloseWindow
EndIf
ClearMap(lnbuffermap())
EndProcedure
OpenConsole()
InitBug("resource_debug.log",3)
Bug("--")
Bug("VNAME","=","Data")
Bug("--")
TLUI_InitInterface("TheTestWindow")
CloseConsole()
End
DataSection
iface_resource:
IncludeBinary #RESOURCE
iface_resource_end:
; Keys to configure things
;
;
resourcetags:
Data.s ".AddRange"
Data.s ".Name"
Data.s ".Size"
Data.s ".Text"
;
; Form (Window)
;
Data.s ".AutoScaleDimensions"
Data.s ".AutoScaleMode"
Data.s ".ClientSize"
Data.s ".MaximumSize"
Data.s ".MinimumSize"
Data.s ".MaximizeBox"
Data.s ".MinimizeBox"
Data.s ".StartPosition"
Data.s ".ContextMenuStrip"
Data.s ".Controls"
;
; Layout
;
Data.s "Me.SuspendLayout"
Data.s "Me.ResumeLayout"
; END
Data.s "--"
EndDataSection