QB64/InForm
QB64/InForm
1
1
Fork 0
mirror of https://github.com/FellippeHeitor/InForm.git synced 2025-01-15 03:49:56 +00:00
Code Issues Releases Wiki Activity

File loading/saving routines implemented. Also:

Browse source 
- New list box method: __UI_ReplaceListBoxItem.
- Menu items can have icons.
This commit is contained in:
FellippeHeitor 2016-10-22 10:09:59 -02:00
parent 7a3dc578dc
commit 4188be2a76
6 changed files with 1071 additions and 500 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

126
InForm.ui
View file

@ -57,6 +57,7 @@ TYPE __UI_ControlTYPE
Interval AS _FLOAT
HotKey AS INTEGER
HotKeyOffset AS INTEGER
HotKeyPosition AS INTEGER
ShowPercentage AS _BYTE
InputViewStart AS LONG
PreviousInputViewStart AS LONG
@ -137,13 +138,13 @@ DIM SHARED __UI_ActiveMenu AS LONG, __UI_ParentMenu AS LONG
DIM SHARED __UI_ActiveTipID AS LONG, __UI_TipTimer AS DOUBLE
DIM SHARED __UI_ActiveTipTop AS INTEGER, __UI_ActiveTipLeft AS INTEGER
DIM SHARED __UI_FormID AS LONG, __UI_HasMenuBar AS LONG
DIM SHARED __UI_ScrollbarWidth AS INTEGER
DIM SHARED __UI_ScrollbarButtonHeight AS INTEGER
DIM SHARED __UI_ScrollbarWidth AS INTEGER, __UI_ScrollbarButtonHeight AS INTEGER
DIM SHARED __UI_MenuBarOffset AS INTEGER, __UI_MenuItemOffset AS INTEGER
DIM SHARED __UI_ForceRedraw AS _BYTE, __UI_AutoRefresh AS _BYTE
DIM SHARED __UI_CurrentTitle AS STRING, __UI_WindowHandle AS LONG
DIM SHARED __UI_DesignMode AS _BYTE, __UI_FirstSelectedID AS LONG, __UI_ResizingForm AS _BYTE
DIM SHARED __UI_WaitMessage AS STRING, __UI_TotalSelectedControls AS LONG
DIM SHARED __UI_WaitMessageHandle AS LONG, __UI_ControlOperation AS _BYTE
DIM SHARED __UI_WaitMessageHandle AS LONG
'Control types:
DIM SHARED __UI_Type(0 TO 17) AS __UI_Types
@ -211,6 +212,8 @@ CONST __UI_MsgBox_Continue = 11
CONST __UI_True = -1
CONST __UI_False = 0
ON ERROR GOTO __UI_ErrorHandler
__UI_LoadForm
__UI_Init
@ -220,6 +223,10 @@ DO
_LIMIT 1
LOOP
SYSTEM
__UI_ErrorHandler:
RESUME NEXT
'---------------------------------------------------------------------------------
SUB __UI_Init
DIM i AS LONG
@ -231,7 +238,7 @@ SUB __UI_Init
IF __UI_Controls(__UI_FormID).CenteredWindow THEN _SCREENMOVE _MIDDLE
IF __UI_Controls(__UI_FormID).Font = 0 THEN __UI_Controls(__UI_FormID).Font = __UI_Font("VGA Emulated", "", 16, "")
IF __UI_Controls(__UI_FormID).Font = 0 THEN __UI_Controls(__UI_FormID).Font = __UI_Font("", 16, "")
IF __UI_Captions(__UI_FormID) = "" THEN __UI_Captions(__UI_FormID) = RTRIM$(__UI_Controls(__UI_FormID).Name)
@ -555,6 +562,8 @@ SUB __UI_UpdateDisplay
IF __UI_AutoRefresh = __UI_False THEN EXIT SUB
ON ERROR GOTO __UI_ErrorHandler
__UI_BeforeUpdateDisplay
'Clear frames canvases and count its children:
@ -1335,12 +1344,10 @@ SUB __UI_EventDispatcher
__UI_Controls(__UI_DraggingID).Top = __UI_PreviewTop
__UI_Controls(__UI_DraggingID).Left = __UI_PreviewLeft
__UI_DraggingID = 0
__UI_EndDrag
END IF
IF __UI_IsResizing THEN
__UI_IsResizing = __UI_False
__UI_ResizingID = 0
__UI_EndResize
END IF
IF __UI_DraggingThumb THEN
__UI_DraggingThumb = __UI_False
@ -2063,7 +2070,6 @@ SUB __UI_EventDispatcher
NEXT
END IF
END IF
__UI_ControlOperation = __UI_True
CASE ASC("C"), ASC("c")
IF __UI_CtrlIsDown AND __UI_TotalSelectedControls > 0 THEN
ControlClipboard$ = MKL$(__UI_TotalSelectedControls)
@ -2074,7 +2080,6 @@ SUB __UI_EventDispatcher
NEXT
_CLIPBOARD$ = "InForm" + CHR$(1)
END IF
__UI_ControlOperation = __UI_True
CASE ASC("V"), ASC("v")
IF __UI_CtrlIsDown THEN
Clip$ = _CLIPBOARD$
@ -2122,7 +2127,6 @@ SUB __UI_EventDispatcher
__UI_AutoRefresh = __UI_True
END IF
END IF
__UI_ControlOperation = __UI_True
CASE 21248 'Delete
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
@ -2140,7 +2144,6 @@ SUB __UI_EventDispatcher
__UI_TotalSelectedControls = __UI_TotalSelectedControls - 1
END IF
NEXT
__UI_ControlOperation = __UI_True
CASE 19200 'Left arrow key
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
@ -2204,8 +2207,8 @@ FUNCTION __UI_GetFontID (FontHandle&)
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION __UI_Font& (NewFontName AS STRING, NewFontFile AS STRING, NewFontSize AS INTEGER, NewFontAttributes AS STRING)
DIM NextSlot AS LONG, i AS LONG, Temp$
FUNCTION __UI_Font& (NewFontFile AS STRING, NewFontSize AS INTEGER, TempNewFontAttributes AS STRING)
DIM NextSlot AS LONG, i AS LONG, Temp$, NewFontAttributes AS STRING
'If the passed font is already loaded, we'll just return its handle
FOR NextSlot = 1 TO UBOUND(__UI_Controls)
@ -2242,13 +2245,41 @@ FUNCTION __UI_Font& (NewFontName AS STRING, NewFontFile AS STRING, NewFontSize A
__UI_DestroyControl __UI_Controls(NextSlot) 'This control is inactive but may still retain properties
__UI_Controls(NextSlot).ID = NextSlot
__UI_Controls(NextSlot).Type = __UI_Type_Font
__UI_Controls(NextSlot).Name = NewFontName
__UI_Controls(NextSlot).Name = "Font" + LTRIM$(STR$(__UI_Type(__UI_Type_Font).Count))
IF NewFontFile = "" THEN
'Internal emulated fonts
__UI_Controls(NextSlot).Value = NewFontSize
__UI_Controls(NextSlot).Max = NewFontSize
IF NewFontSize <> 8 AND NewFontSize <> 16 THEN
__UI_Controls(NextSlot).Value = 16
__UI_Controls(NextSlot).Max = 16
ELSE
__UI_Controls(NextSlot).Value = NewFontSize
__UI_Controls(NextSlot).Max = NewFontSize
END IF
ELSE
'Parse attributes
IF INSTR(UCASE$(TempNewFontAttributes), "MONOSPACE") THEN NewFontAttributes = "MONOSPACE"
IF INSTR(UCASE$(TempNewFontAttributes), "BOLD") THEN
IF LEN(NewFontAttributes) > 0 THEN NewFontAttributes = NewFontAttributes + ","
NewFontAttributes = NewFontAttributes + "BOLD"
END IF
IF INSTR(UCASE$(TempNewFontAttributes), "ITALIC") THEN
IF LEN(NewFontAttributes) > 0 THEN NewFontAttributes = NewFontAttributes + ","
NewFontAttributes = NewFontAttributes + "ITALIC"
END IF
IF INSTR(UCASE$(TempNewFontAttributes), "UNDERLINE") THEN
IF LEN(NewFontAttributes) > 0 THEN NewFontAttributes = NewFontAttributes + ","
NewFontAttributes = NewFontAttributes + "UNDERLINE"
END IF
IF INSTR(UCASE$(TempNewFontAttributes), "UNICODE") THEN
IF LEN(NewFontAttributes) > 0 THEN NewFontAttributes = NewFontAttributes + ","
NewFontAttributes = NewFontAttributes + "UNICODE"
END IF
IF INSTR(UCASE$(TempNewFontAttributes), "DONTBLEND") THEN
IF LEN(NewFontAttributes) > 0 THEN NewFontAttributes = NewFontAttributes + ","
NewFontAttributes = NewFontAttributes + "DONTBLEND"
END IF
__UI_Controls(NextSlot).Value = _LOADFONT(NewFontFile, NewFontSize, NewFontAttributes)
__UI_Controls(NextSlot).Max = NewFontSize
__UI_Texts(NextSlot) = NewFontFile
@ -2259,6 +2290,7 @@ FUNCTION __UI_Font& (NewFontName AS STRING, NewFontFile AS STRING, NewFontSize A
'If loading the requested font fails, we default to _FONT 16
IF __UI_Controls(NextSlot).Value <= 0 THEN
__UI_DestroyControl __UI_Controls(NextSlot)
__UI_Controls(NextSlot).Value = 16
__UI_Font& = 16
END IF
END IF
@ -2320,7 +2352,7 @@ FUNCTION __UI_NewControl (ControlType AS INTEGER, ControlName AS STRING, NewWidt
__UI_Controls(NextSlot).Font = __UI_Controls(ParentID).Font
END IF
IF __UI_Controls(NextSlot).Font = 0 THEN __UI_Controls(NextSlot).Font = __UI_Font("VGA Emulated", "", 16, "")
IF __UI_Controls(NextSlot).Font = 0 THEN __UI_Controls(NextSlot).Font = __UI_Font("", 16, "")
__UI_Controls(NextSlot).Width = NewWidth
__UI_Controls(NextSlot).Height = NewHeight
@ -2504,7 +2536,7 @@ END SUB
'---------------------------------------------------------------------------------
SUB __UI_SetCaption (Control$, TempCaption$)
DIM i AS LONG, FindSep%, ThisID AS LONG, NewCaption$, UsedList$, TempKey AS _UNSIGNED _BYTE
DIM PrevFont AS LONG, TempCanvas AS LONG, PrevDest AS LONG, ItemOffset AS INTEGER
DIM PrevFont AS LONG, TempCanvas AS LONG, PrevDest AS LONG
ThisID = __UI_GetID(Control$)
IF ThisID = 0 THEN EXIT SUB
@ -2524,6 +2556,7 @@ SUB __UI_SetCaption (Control$, TempCaption$)
TempKey = ASC(UCASE$(NewCaption$), FindSep%)
IF INSTR(UsedList$, CHR$(TempKey)) = 0 THEN
__UI_Controls(ThisID).HotKey = TempKey
__UI_Controls(ThisID).HotKeyPosition = FindSep%
PrevFont = _FONT
@ -2580,10 +2613,6 @@ SUB __UI_LoadImage (This AS __UI_ControlTYPE, File$)
IF This.HelperCanvas <> 0 THEN _FREEIMAGE This.HelperCanvas
IF This.Type = __UI_Type_PictureBox OR This.Type = __UI_Type_Button THEN
__UI_Texts(This.ID) = File$
END IF
IF _FILEEXISTS(File$) THEN
This.HelperCanvas = _LOADIMAGE(File$, 32)
IF This.HelperCanvas = -1 THEN ErrorMessage$ = "Unable to load file:"
@ -2607,6 +2636,10 @@ SUB __UI_LoadImage (This AS __UI_ControlTYPE, File$)
_PRINTSTRING (5, 5), ErrorMessage$
_PRINTSTRING (5, 5 + _FONTHEIGHT), File$
_DEST PrevDest
ELSE
IF This.Type = __UI_Type_PictureBox OR This.Type = __UI_Type_Button OR This.Type = __UI_Type_MenuItem THEN
__UI_Texts(This.ID) = File$
END IF
END IF
END SUB
@ -2783,7 +2816,7 @@ SUB __UI_RemoveListBoxItem (WhichListBox$, ItemToRemove AS INTEGER)
DIM This AS __UI_ControlTYPE, TempText$, ThisItem%, FindLF&, TempCaption$
This = __UI_Controls(__UI_GetID(WhichListBox$))
IF This.Type <> __UI_Type_ListBox THEN ERROR 5: EXIT SUB
IF This.Type <> __UI_Type_ListBox AND This.Type <> __UI_Type_DropdownList THEN ERROR 5: EXIT SUB
IF ItemToRemove > This.Max THEN ERROR 6: EXIT SUB
@ -2816,6 +2849,38 @@ SUB __UI_RemoveListBoxItem (WhichListBox$, ItemToRemove AS INTEGER)
__UI_Controls(This.ID) = This
END SUB
'---------------------------------------------------------------------------------
SUB __UI_ReplaceListBoxItem (WhichListBox$, ItemToReplace AS INTEGER, NewText$)
DIM This AS __UI_ControlTYPE, TempText$, ThisItem%, FindLF&, TempCaption$
This = __UI_Controls(__UI_GetID(WhichListBox$))
IF This.Type <> __UI_Type_ListBox AND This.Type <> __UI_Type_DropdownList THEN ERROR 5: EXIT SUB
IF ItemToReplace > This.Max THEN ERROR 6: EXIT SUB
TempText$ = __UI_Texts(This.ID)
__UI_Texts(This.ID) = ""
ThisItem% = 0
DO WHILE LEN(TempText$)
ThisItem% = ThisItem% + 1
FindLF& = INSTR(TempText$, CHR$(13))
IF FindLF& THEN
TempCaption$ = LEFT$(TempText$, FindLF& - 1)
TempText$ = MID$(TempText$, FindLF& + 1)
ELSE
TempCaption$ = TempText$
TempText$ = ""
END IF
IF ThisItem% <> ItemToReplace THEN
__UI_Texts(This.ID) = __UI_Texts(This.ID) + TempCaption$ + CHR$(13)
ELSE
__UI_Texts(This.ID) = __UI_Texts(This.ID) + NewText$ + CHR$(13)
END IF
LOOP
END SUB
'---------------------------------------------------------------------------------
SUB __UI_ListBoxSearchItem (This AS __UI_ControlTYPE)
STATIC SearchPattern$, LastListKeyHit AS DOUBLE
@ -2968,7 +3033,7 @@ END SUB
'---------------------------------------------------------------------------------
SUB __UI_ActivateMenu (This AS __UI_ControlTYPE, SelectFirstItem AS _BYTE)
DIM i AS LONG, ItemOffset AS INTEGER, TotalItems AS INTEGER, ItemHeight AS INTEGER
DIM i AS LONG, TotalItems AS INTEGER, ItemHeight AS INTEGER
IF NOT This.Disabled THEN
IF __UI_ActiveMenu > 0 THEN __UI_DestroyControl __UI_Controls(__UI_ActiveMenu)
@ -2987,17 +3052,13 @@ SUB __UI_ActivateMenu (This AS __UI_ControlTYPE, SelectFirstItem AS _BYTE)
__UI_Controls(__UI_ActiveMenu).Top = __UI_MouseTop
END IF
IF _PRINTWIDTH("W") <> _PRINTWIDTH("I") THEN ItemOffset = _PRINTWIDTH("____") ELSE ItemOffset = _PRINTWIDTH("__")
'Calculate panel's width and position the menu items
__UI_Controls(__UI_ActiveMenu).Width = 120
ItemHeight = _FONTHEIGHT * 1.5
__UI_Controls(__UI_ActiveMenu).Height = _FONTHEIGHT * .3
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ParentID = This.ID AND NOT __UI_Controls(i).Hidden THEN
TotalItems = TotalItems + 1
__UI_Controls(i).Width = ItemOffset * 2 + _PRINTWIDTH(__UI_Captions(i))
__UI_Controls(i).Width = __UI_MenuItemOffset * 2 + _PRINTWIDTH(__UI_Captions(i))
IF __UI_Controls(__UI_ActiveMenu).Width < __UI_Controls(i).Width THEN
__UI_Controls(__UI_ActiveMenu).Width = __UI_Controls(i).Width
END IF
@ -3138,26 +3199,25 @@ END FUNCTION
'---------------------------------------------------------------------------------
SUB __UI_RefreshMenuBar
'Calculate menu items' .Left and .Width
DIM LeftOffset AS INTEGER, ItemOffset AS INTEGER, i AS LONG
DIM LeftOffset AS INTEGER, i AS LONG
DIM TotalItems AS INTEGER, LastMenuItem AS LONG
_FONT (__UI_Controls(__UI_FormID).Font)
IF _PRINTWIDTH("W") <> _PRINTWIDTH("I") THEN ItemOffset = _PRINTWIDTH("__") ELSE ItemOffset = _PRINTWIDTH("__")
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ID > 0 THEN
IF __UI_Controls(i).Type = __UI_Type_MenuBar AND NOT __UI_Controls(i).Hidden THEN
TotalItems = TotalItems + 1
IF TotalItems = 1 THEN
LeftOffset = ItemOffset
LeftOffset = __UI_MenuBarOffset
ELSE
LeftOffset = LeftOffset + __UI_Controls(LastMenuItem).Width
END IF
__UI_Controls(i).Width = ItemOffset + _PRINTWIDTH(__UI_Captions(i)) + ItemOffset
__UI_Controls(i).Width = __UI_MenuBarOffset + _PRINTWIDTH(__UI_Captions(i)) + __UI_MenuBarOffset
IF __UI_Controls(i).Align = __UI_Left THEN
__UI_Controls(i).Left = LeftOffset
ELSE
__UI_Controls(i).Left = __UI_Controls(__UI_FormID).Width - 1 - ItemOffset - __UI_Controls(i).Width
__UI_Controls(i).Left = __UI_Controls(__UI_FormID).Width - 1 - __UI_MenuBarOffset - __UI_Controls(i).Width
END IF
LastMenuItem = i
END IF

BIN
InForm/disk.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 13 KiB

1128
UiEditor.bas
View file

File diff suppressed because it is too large Load diff

131
UiEditor.frm
View file

@ -1,42 +1,51 @@
'InForm - GUI system for QB64
'InForm - GUI system for QB64 - Beta version 1
'Fellippe Heitor, 2016 - fellippe@qb64.org - @fellippeheitor
'Beta version 1
'-----------------------------------------------------------
SUB __UI_LoadForm
DIM __UI_NewID AS LONG
__UI_NewID = __UI_NewControl(__UI_Type_Form, "Form1", 598, 430, 0, 0, 0)
__UI_SetCaption "Form1", "InForm Designer"
__UI_Controls(__UI_NewID).Font = __UI_Font("Noto Mono", "InForm\NotoMono-Regular.ttf", 12, "MONOSPACE")
__UI_NewID = __UI_NewControl(__UI_Type_Form, "UiEditorForm", 598, 430, 0, 0, 0)
__UI_SetCaption "UiEditorForm", "InForm Designer"
__UI_Controls(__UI_NewID).Font = __UI_Font("InForm\NotoMono-Regular.ttf", 12, "MONOSPACE")
__UI_NewID = __UI_NewControl(__UI_Type_MenuBar, "FileMenu", 56, 18, 14, 0, 0)
__UI_NewID = __UI_NewControl(__UI_Type_MenuBar, "FileMenu", 44, 18, 8, 0, 0)
__UI_SetCaption "FileMenu", "&File"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "FileMenuLoad", 140, 18, 0, 4, __UI_GetID("FileMenu"))
__UI_SetCaption "FileMenuLoad", "&Load form.frmbin"
__UI_Controls(__UI_NewID).Disabled = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_MenuBar, "ViewMenu", 44, 18, 52, 0, 0)
__UI_SetCaption "ViewMenu", "&View"
__UI_NewID = __UI_NewControl(__UI_Type_MenuBar, "HelpMenu", 44, 18, 545, 0, 0)
__UI_SetCaption "HelpMenu", "&Help"
__UI_Controls(__UI_NewID).Align = __UI_Right
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "ToolBox", 62, 376, 30, 40, 0)
__UI_Controls(__UI_NewID).HasBorder = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "PropertiesFrame", 457, 186, 110, 40, 0)
__UI_SetCaption "PropertiesFrame", "Control properties: Main form"
__UI_Controls(__UI_NewID).HasBorder = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "ColorMixer", 457, 175, 110, 240, 0)
__UI_SetCaption "ColorMixer", "Color mixer"
__UI_Controls(__UI_NewID).HasBorder = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "FileMenuSave", 91, 18, 0, 22, __UI_GetID("FileMenu"))
__UI_SetCaption "FileMenuSave", "&Save form-"
__UI_Controls(__UI_NewID).Disabled = __UI_True
__UI_LoadImage __UI_Controls(__UI_NewID), "InForm\disk.png"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "FileMenuExit", 56, 18, 0, 40, __UI_GetID("FileMenu"))
__UI_SetCaption "FileMenuExit", "E&xit"
__UI_NewID = __UI_NewControl(__UI_Type_MenuBar, "ViewMenu", 56, 18, 14, 0, 0)
__UI_SetCaption "ViewMenu", "&View"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "ViewMenuPreviewDetach", 56, 18, 0, 40, __UI_GetID("ViewMenu"))
__UI_SetCaption "ViewMenuPreviewDetach", "&Keep preview window attached"
__UI_Controls(__UI_NewID).Value = -1
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "ViewMenuPreview", 56, 18, 0, 40, __UI_GetID("ViewMenu"))
__UI_SetCaption "ViewMenuPreview", "Open &preview window"
__UI_SetCaption "ViewMenuPreview", "&Open preview window-"
$IF WIN THEN
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "ViewMenuPreviewDetach", 56, 18, 0, 40, __UI_GetID("ViewMenu"))
__UI_Controls(__UI_NewID).Value = __UI_True
__UI_SetCaption "ViewMenuPreviewDetach", "&Keep preview window attached"
$END IF
__UI_NewID = __UI_NewControl(__UI_Type_MenuBar, "HelpMenu", 56, 18, 527, 0, 0)
__UI_SetCaption "HelpMenu", "&Help"
__UI_Controls(__UI_NewID).Align = __UI_Right
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "ViewMenuLoadedFonts", 56, 18, 0, 40, __UI_GetID("ViewMenu"))
__UI_SetCaption "ViewMenuLoadedFonts", "&Loaded fonts"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "HelpMenuHelp", 0, 0, 0, 0, __UI_GetID("HelpMenu"))
__UI_SetCaption "HelpMenuHelp", "&What's all this?"
@ -44,46 +53,39 @@ SUB __UI_LoadForm
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "HelpMenuAbout", 0, 0, 0, 0, __UI_GetID("HelpMenu"))
__UI_SetCaption "HelpMenuAbout", "&About..."
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "ToolBox", 62, 376, 30, 40, 0)
__UI_Controls(__UI_NewID).HasBorder = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddButton", 22, 22, 20, 20, __UI_GetID("ToolBox"))
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddButton", 22, 22, 20, 26, __UI_GetID("ToolBox"))
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddLabel", 22, 22, 20, 50, __UI_GetID("ToolBox"))
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddLabel", 22, 22, 20, 56, __UI_GetID("ToolBox"))
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddTextBox", 22, 22, 20, 80, __UI_GetID("ToolBox"))
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddTextBox", 22, 22, 20, 86, __UI_GetID("ToolBox"))
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddCheckBox", 22, 22, 20, 110, __UI_GetID("ToolBox"))
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddCheckBox", 22, 22, 20, 116, __UI_GetID("ToolBox"))
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddRadioButton", 22, 22, 20, 140, __UI_GetID("ToolBox"))
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddRadioButton", 22, 22, 20, 146, __UI_GetID("ToolBox"))
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddListBox", 22, 22, 20, 170, __UI_GetID("ToolBox"))
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddListBox", 22, 22, 20, 176, __UI_GetID("ToolBox"))
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddDropdownList", 22, 22, 20, 200, __UI_GetID("ToolBox"))
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddDropdownList", 22, 22, 20, 206, __UI_GetID("ToolBox"))
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddTrackBar", 22, 22, 20, 230, __UI_GetID("ToolBox"))
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddTrackBar", 22, 22, 20, 236, __UI_GetID("ToolBox"))
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddProgressBar", 22, 22, 20, 260, __UI_GetID("ToolBox"))
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddProgressBar", 22, 22, 20, 266, __UI_GetID("ToolBox"))
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddPictureBox", 22, 22, 20, 290, __UI_GetID("ToolBox"))
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddPictureBox", 22, 22, 20, 296, __UI_GetID("ToolBox"))
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddFrame", 22, 22, 20, 320, __UI_GetID("ToolBox"))
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AddFrame", 22, 22, 20, 326, __UI_GetID("ToolBox"))
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "PropertiesFrame", 457, 186, 110, 40, 0)
__UI_SetCaption "PropertiesFrame", "Control properties: Form1"
__UI_Controls(__UI_NewID).HasBorder = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_DropdownList, "PropertiesList", 174, 23, 20, 20, __UI_GetID("PropertiesFrame"))
__UI_AddListBoxItem "PropertiesList", "Name"
__UI_AddListBoxItem "PropertiesList", "Caption"
@ -93,71 +95,80 @@ SUB __UI_LoadForm
__UI_AddListBoxItem "PropertiesList", "Width"
__UI_AddListBoxItem "PropertiesList", "Height"
__UI_AddListBoxItem "PropertiesList", "Font"
__UI_AddListBoxItem "PropertiesList", "BackStyle"
__UI_AddListBoxItem "PropertiesList", "Tool tip"
__UI_AddListBoxItem "PropertiesList", "Value"
__UI_AddListBoxItem "PropertiesList", "Min"
__UI_AddListBoxItem "PropertiesList", "Max"
__UI_AddListBoxItem "PropertiesList", "Interval"
__UI_Controls(__UI_NewID).HasBorder = __UI_True
__UI_Controls(__UI_NewID).Value = 1
__UI_Controls(__UI_NewID).Max = 13
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_TextBox, "PropertyValue", 250, 23, 200, 20, __UI_GetID("PropertiesFrame"))
__UI_Controls(__UI_NewID).HasBorder = __UI_True
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "Stretch", 150, 17, 70, 59, __UI_GetID("PropertiesFrame"))
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "Stretch", 150, 17, 22, 59, __UI_GetID("PropertiesFrame"))
__UI_SetCaption "Stretch", "Stretch"
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "HasBorder", 150, 17, 70, 79, __UI_GetID("PropertiesFrame"))
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "HasBorder", 150, 17, 22, 79, __UI_GetID("PropertiesFrame"))
__UI_SetCaption "HasBorder", "Has border"
__UI_Controls(__UI_NewID).Value = -1
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "ShowPercentage", 149, 17, 70, 99, __UI_GetID("PropertiesFrame"))
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "ShowPercentage", 149, 17, 22, 99, __UI_GetID("PropertiesFrame"))
__UI_SetCaption "ShowPercentage", "Show percentage"
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "WordWrap", 150, 17, 70, 119, __UI_GetID("PropertiesFrame"))
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "WordWrap", 150, 17, 22, 119, __UI_GetID("PropertiesFrame"))
__UI_SetCaption "WordWrap", "Word wrap"
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "CanHaveFocus", 150, 17, 230, 59, __UI_GetID("PropertiesFrame"))
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "CanHaveFocus", 150, 17, 182, 59, __UI_GetID("PropertiesFrame"))
__UI_SetCaption "CanHaveFocus", "Can have focus"
__UI_Controls(__UI_NewID).Value = -1
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "Disabled", 150, 17, 230, 79, __UI_GetID("PropertiesFrame"))
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "Disabled", 150, 17, 182, 79, __UI_GetID("PropertiesFrame"))
__UI_SetCaption "Disabled", "Disabled"
__UI_Controls(__UI_NewID).Value = -1
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "Hidden", 150, 17, 230, 99, __UI_GetID("PropertiesFrame"))
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "Hidden", 150, 17, 182, 99, __UI_GetID("PropertiesFrame"))
__UI_SetCaption "Hidden", "Hidden"
__UI_Controls(__UI_NewID).Value = -1
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "CenteredWindow", 150, 17, 230, 119, __UI_GetID("PropertiesFrame"))
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "CenteredWindow", 150, 17, 182, 119, __UI_GetID("PropertiesFrame"))
__UI_SetCaption "CenteredWindow", "Centered window"
__UI_Controls(__UI_NewID).Value = -1
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Label, "Label1", 83, 20, 70, 150, __UI_GetID("PropertiesFrame"))
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "Resizable", 102, 17, 339, 59, __UI_GetID("PropertiesFrame"))
__UI_SetCaption "Resizable", "Resizable"
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Label, "Label1", 83, 20, 24, 151, __UI_GetID("PropertiesFrame"))
__UI_SetCaption "Label1", "Text align:"
__UI_NewID = __UI_NewControl(__UI_Type_DropdownList, "AlignOptions", 155, 20, 160, 150, __UI_GetID("PropertiesFrame"))
__UI_NewID = __UI_NewControl(__UI_Type_DropdownList, "AlignOptions", 104, 20, 109, 151, __UI_GetID("PropertiesFrame"))
__UI_SetCaption "AlignOptions", "Left"
__UI_AddListBoxItem "AlignOptions", "Left"
__UI_AddListBoxItem "AlignOptions", "Center"
__UI_AddListBoxItem "AlignOptions", "Right"
__UI_Controls(__UI_NewID).HasBorder = __UI_True
__UI_Controls(__UI_NewID).Value = 1
__UI_Controls(__UI_NewID).Max = 3
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "ColorMixer", 457, 175, 110, 240, 0)
__UI_SetCaption "ColorMixer", "Color mixer"
__UI_NewID = __UI_NewControl(__UI_Type_Label, "Label2", 83, 20, 225, 151, __UI_GetID("PropertiesFrame"))
__UI_SetCaption "Label2", "Back style:"
__UI_NewID = __UI_NewControl(__UI_Type_DropdownList, "BackStyleOptions", 134, 20, 311, 151, __UI_GetID("PropertiesFrame"))
__UI_SetCaption "BackStyleOptions", "Left"
__UI_AddListBoxItem "BackStyleOptions", "Opaque"
__UI_AddListBoxItem "BackStyleOptions", "Transparent"
__UI_Controls(__UI_NewID).HasBorder = __UI_True
__UI_Controls(__UI_NewID).Value = 1
__UI_Controls(__UI_NewID).Max = 2
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_DropdownList, "ColorPropertiesList", 161, 21, 10, 20, __UI_GetID("ColorMixer"))
__UI_AddListBoxItem "ColorPropertiesList", "ForeColor"
@ -167,6 +178,7 @@ SUB __UI_LoadForm
__UI_AddListBoxItem "ColorPropertiesList", "BorderColor"
__UI_Controls(__UI_NewID).HasBorder = __UI_True
__UI_Controls(__UI_NewID).Value = 1
__UI_Controls(__UI_NewID).Max = 5
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "ColorPreview", 159, 115, 10, 51, __UI_GetID("ColorMixer"))
@ -201,4 +213,5 @@ SUB __UI_LoadForm
__UI_Controls(__UI_NewID).BorderColor = _RGB32(0, 0, 255)
__UI_Controls(__UI_NewID).HasBorder = __UI_True
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
END SUB

137
UiEditorPreview.bas
View file

@ -41,12 +41,6 @@ SUB __UI_Click (id AS LONG)
SendData b$, OffsetNewDataFromPreview
END SUB
SUB __UI_EndDrag
END SUB
SUB __UI_EndResize
END SUB
SUB __UI_MouseEnter (id AS LONG)
DIM b$
b$ = MKI$(-1)
@ -84,11 +78,6 @@ SUB __UI_BeforeUpdateDisplay
b$ = MKL$(UiPreviewPID)
SendData b$, OffsetPreviewPID
IF __UI_ControlOperation THEN
__UI_ControlOperation = __UI_False
b$ = MKI$(-1): SendData b$, OffsetNewDataFromPreview
END IF
UiEditorFile = FREEFILE
OPEN "UiEditor.dat" FOR BINARY AS #UiEditorFile
@ -150,7 +139,7 @@ SUB __UI_BeforeUpdateDisplay
__UI_SetCaption __UI_Controls(TempValue).Name, RTRIM$(__UI_Controls(TempValue).Name)
CASE __UI_Type_TextBox
TempValue = __UI_NewControl(__UI_Type_TextBox, "", 120, 23, TempWidth \ 2 - 60, TempHeight \ 2 - 12, ThisContainer)
IF _FONTWIDTH(__UI_Controls(TempValue).Font) = 0 THEN __UI_Controls(TempValue).Font = __UI_Font("VGA Emulated", "", 16, "")
IF _FONTWIDTH(__UI_Controls(TempValue).Font) = 0 THEN __UI_Controls(TempValue).Font = __UI_Font("", 16, "")
__UI_Controls(TempValue).FieldArea = __UI_Controls(TempValue).Width \ _FONTWIDTH(__UI_Controls(TempValue).Font) - 1
__UI_SetCaption __UI_Controls(TempValue).Name, RTRIM$(__UI_Controls(TempValue).Name)
CASE __UI_Type_ListBox
@ -162,7 +151,7 @@ SUB __UI_BeforeUpdateDisplay
TempValue = __UI_NewControl(__UI_Type_TrackBar, "", 300, 45, TempWidth \ 2 - 150, TempHeight \ 2 - 23, ThisContainer)
CASE __UI_Type_ProgressBar
TempValue = __UI_NewControl(__UI_Type_ProgressBar, "", 300, 23, TempWidth \ 2 - 150, TempHeight \ 2 - 12, ThisContainer)
CASE __UI_Type_PictureBox, __UI_Type_Frame
CASE __UI_Type_PictureBox
TempValue = __UI_NewControl(TempValue, "", 230, 150, TempWidth \ 2 - 115, TempHeight \ 2 - 75, ThisContainer)
CASE __UI_Type_Frame
TempValue = __UI_NewControl(TempValue, "", 230, 150, TempWidth \ 2 - 115, TempHeight \ 2 - 75, 0)
@ -187,10 +176,18 @@ SUB __UI_BeforeUpdateDisplay
TempValue = CVI(b$)
SELECT CASE TempValue
CASE 1 'Name
b$ = SPACE$(4): GET #UiEditorFile, OffsetPropertyValue, b$
b$ = SPACE$(CVL(b$)): GET #UiEditorFile, , b$
IF __UI_GetID(b$) > 0 THEN
DO
b$ = b$ + "_"
IF __UI_GetID(b$) = 0 THEN EXIT DO
LOOP
END IF
IF __UI_TotalSelectedControls = 1 THEN
b$ = SPACE$(4): GET #UiEditorFile, OffsetPropertyValue, b$
b$ = SPACE$(CVL(b$)): GET #UiEditorFile, , b$
__UI_Controls(__UI_FirstSelectedID).Name = b$
ELSE
__UI_Controls(__UI_FormID).Name = b$
END IF
CASE 2 'Caption
b$ = SPACE$(4): GET #UiEditorFile, OffsetPropertyValue, b$
@ -198,7 +195,7 @@ SUB __UI_BeforeUpdateDisplay
IF __UI_TotalSelectedControls > 0 THEN
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Captions(i) = b$
__UI_SetCaption RTRIM$(__UI_Controls(i).Name), b$
END IF
NEXT
ELSE
@ -210,6 +207,9 @@ SUB __UI_BeforeUpdateDisplay
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Texts(i) = b$
IF __UI_Controls(i).Type = __UI_Type_Button OR __UI_Controls(i).Type = __UI_Type_PictureBox THEN
__UI_LoadImage __UI_Controls(i), b$
END IF
END IF
NEXT
CASE 4 'Top
@ -257,7 +257,44 @@ SUB __UI_BeforeUpdateDisplay
__UI_Controls(__UI_FormID).Height = TempValue
END IF
CASE 8 'Font
CASE 9 'BackStyle
b$ = SPACE$(4): GET #UiEditorFile, OffsetPropertyValue, b$
b$ = SPACE$(CVL(b$)): GET #UiEditorFile, , b$
DIM NewFontFile AS STRING
DIM NewFontSize AS INTEGER, NewFontParameters AS STRING
DIM FindSep AS INTEGER, TotalSep AS INTEGER
'Parse b$ into Font data
FindSep = INSTR(b$, "*")
IF FindSep THEN TotalSep = TotalSep + 1
NewFontFile = LEFT$(b$, FindSep - 1)
b$ = MID$(b$, FindSep + 1)
FindSep = INSTR(b$, "*")
IF FindSep THEN TotalSep = TotalSep + 1
NewFontParameters = LEFT$(b$, FindSep - 1)
b$ = MID$(b$, FindSep + 1)
NewFontSize = VAL(b$)
IF TotalSep = 2 AND NewFontSize > 0 THEN
IF __UI_TotalSelectedControls > 0 THEN
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).Font = __UI_Font(NewFontFile, NewFontSize, NewFontParameters)
END IF
NEXT
ELSE
__UI_Controls(__UI_FormID).Font = __UI_Font(NewFontFile, NewFontSize, NewFontParameters)
END IF
END IF
CASE 9 'Tooltip
b$ = SPACE$(4): GET #UiEditorFile, OffsetPropertyValue, b$
b$ = SPACE$(CVL(b$)): GET #UiEditorFile, , b$
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Tips(i) = b$
END IF
NEXT
CASE 10 'Value
b$ = SPACE$(LEN(FloatValue)): GET #UiEditorFile, OffsetPropertyValue, b$
FOR i = 1 TO UBOUND(__UI_Controls)
@ -337,6 +374,7 @@ SUB __UI_BeforeUpdateDisplay
NEXT
CASE 21 'CenteredWindow
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
TempValue = CVI(b$)
IF __UI_TotalSelectedControls = 0 THEN
__UI_Controls(__UI_FormID).CenteredWindow = TempValue
END IF
@ -402,6 +440,19 @@ SUB __UI_BeforeUpdateDisplay
ELSE
__UI_Controls(__UI_FormID).BorderColor = _CV(_UNSIGNED LONG, b$)
END IF
CASE 28 'BackStyle
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).BackStyle = CVI(b$)
END IF
NEXT
CASE 29 'CanResize
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
TempValue = CVI(b$)
IF __UI_TotalSelectedControls = 0 THEN
__UI_Controls(__UI_FormID).CanResize = TempValue
END IF
END SELECT
__UI_ForceRedraw = __UI_True
END IF
@ -473,7 +524,7 @@ SUB LoadPreview
IF LogFileLoad THEN PRINT #LogFileNum, "DESTROYED CONTROLS"
b$ = SPACE$(4): GET #BinaryFileNum, , b$
IF LogFileLoad THEN PRINT #LogFileNum, "READ NEW ARRAYS:" + STR$(CVI(b$))
IF LogFileLoad THEN PRINT #LogFileNum, "READ NEW ARRAYS:" + STR$(CVL(b$))
REDIM _PRESERVE __UI_Captions(1 TO CVL(b$)) AS STRING
REDIM _PRESERVE __UI_TempCaptions(1 TO CVL(b$)) AS STRING
@ -528,7 +579,7 @@ SUB LoadPreview
b$ = SPACE$(4): GET #BinaryFileNum, , b$
b$ = SPACE$(CVL(b$))
GET #BinaryFileNum, , b$
__UI_Captions(TempValue) = b$
__UI_SetCaption RTRIM$(__UI_Controls(TempValue).Name), b$
IF LogFileLoad THEN PRINT #LogFileNum, "CAPTION:" + __UI_Captions(TempValue)
CASE -3 'Text
b$ = SPACE$(4): GET #BinaryFileNum, , b$
@ -551,18 +602,15 @@ SUB LoadPreview
FontSetup$ = SPACE$(CVI(b$)): GET #BinaryFileNum, , FontSetup$
IF LogFileLoad THEN PRINT #LogFileNum, FontSetup$
FindSep = INSTR(FontSetup$, "\")
NewFontName = LEFT$(FontSetup$, FindSep - 1): FontSetup$ = MID$(FontSetup$, FindSep + 1)
FindSep = INSTR(FontSetup$, "\")
FindSep = INSTR(FontSetup$, "*")
NewFontFile = LEFT$(FontSetup$, FindSep - 1): FontSetup$ = MID$(FontSetup$, FindSep + 1)
FindSep = INSTR(FontSetup$, "\")
NewFontSize = VAL(LEFT$(FontSetup$, FindSep - 1)): FontSetup$ = MID$(FontSetup$, FindSep + 1)
FindSep = INSTR(FontSetup$, "*")
NewFontAttributes = LEFT$(FontSetup$, FindSep - 1): FontSetup$ = MID$(FontSetup$, FindSep + 1)
NewFontAttributes = FontSetup$
NewFontSize = VAL(FontSetup$)
__UI_Controls(TempValue).Font = __UI_Font(NewFontName, NewFontFile, NewFontSize, NewFontAttributes)
__UI_Controls(TempValue).Font = __UI_Font(NewFontFile, NewFontSize, NewFontAttributes)
CASE -6 'ForeColor
b$ = SPACE$(4): GET #BinaryFileNum, , b$
__UI_Controls(TempValue).ForeColor = _CV(_UNSIGNED LONG, b$)
@ -707,13 +755,23 @@ SUB SavePreview
b$ = MKI$(-1) + MKL$(i) + MKI$(__UI_Controls(i).Type) '-1 indicates a new control
b$ = b$ + MKI$(LEN(RTRIM$(__UI_Controls(i).Name)))
b$ = b$ + RTRIM$(__UI_Controls(i).Name)
b$ = b$ + MKI$(__UI_Controls(i).Width) + MKI$(__UI_Controls(i).Height) + MKI$(__UI_Controls(i).Left) + MKI$(__UI_Controls(i).Top) + MKI$(LEN(RTRIM$(__UI_Controls(__UI_Controls(i).ParentID).Name))) + RTRIM$(__UI_Controls(__UI_Controls(i).ParentID).Name)
b$ = b$ + MKI$(__UI_Controls(i).Width) + MKI$(__UI_Controls(i).Height) + MKI$(__UI_Controls(i).Left) + MKI$(__UI_Controls(i).Top)
IF __UI_Controls(i).ParentID > 0 THEN
b$ = b$ + MKI$(LEN(RTRIM$(__UI_Controls(__UI_Controls(i).ParentID).Name))) + RTRIM$(__UI_Controls(__UI_Controls(i).ParentID).Name)
ELSE
b$ = b$ + MKI$(0)
END IF
PUT #BinFileNum, , b$
IF LEN(__UI_Captions(i)) > 0 THEN
b$ = MKI$(-2) + MKL$(LEN(__UI_Captions(i))) '-2 indicates a caption
IF __UI_Controls(i).HotKeyPosition > 0 THEN
a$ = LEFT$(__UI_Captions(i), __UI_Controls(i).HotKeyPosition - 1) + "&" + MID$(__UI_Captions(i), __UI_Controls(i).HotKeyPosition)
ELSE
a$ = __UI_Captions(i)
END IF
b$ = MKI$(-2) + MKL$(LEN(a$)) '-2 indicates a caption
PUT #BinFileNum, , b$
PUT #BinFileNum, , __UI_Captions(i)
PUT #BinFileNum, , a$
END IF
IF LEN(__UI_Tips(i)) > 0 THEN
@ -740,12 +798,12 @@ SUB SavePreview
IF __UI_Controls(i).Font = 8 OR __UI_Controls(i).Font = 16 THEN
'Internal fonts
SaveInternalFont:
FontSetup$ = "VGA Emulated\\" + LTRIM$(STR$(__UI_Controls(__UI_GetFontID(__UI_Controls(i).Font)).Max)) + "\"
FontSetup$ = "**" + LTRIM$(STR$(__UI_Controls(__UI_GetFontID(__UI_Controls(i).Font)).Max))
b$ = MKI$(-5) + MKI$(LEN(FontSetup$)) + FontSetup$
PUT #BinFileNum, , b$
ELSE
SaveExternalFont:
FontSetup$ = RTRIM$(__UI_Controls(__UI_GetFontID(__UI_Controls(i).Font)).Name) + "\" + __UI_Texts(__UI_GetFontID(__UI_Controls(i).Font)) + "\" + LTRIM$(STR$(__UI_Controls(__UI_GetFontID(__UI_Controls(i).Font)).Max)) + "\" + __UI_Captions(__UI_GetFontID(__UI_Controls(i).Font))
FontSetup$ = __UI_Texts(__UI_GetFontID(__UI_Controls(i).Font)) + "*" + __UI_Captions(__UI_GetFontID(__UI_Controls(i).Font)) + "*" + LTRIM$(STR$(__UI_Controls(__UI_GetFontID(__UI_Controls(i).Font)).Max))
b$ = MKI$(-5) + MKI$(LEN(FontSetup$)) + FontSetup$
PUT #BinFileNum, , b$
END IF
@ -809,12 +867,12 @@ SUB SavePreview
IF __UI_Controls(i).Max <> 0 THEN
b$ = MKI$(-16) + _MK$(_FLOAT, __UI_Controls(i).Max): PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).HotKey <> 0 THEN
b$ = MKI$(-17) + MKI$(__UI_Controls(i).HotKey): PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).HotKeyOffset <> 0 THEN
b$ = MKI$(-18) + MKI$(__UI_Controls(i).HotKeyOffset): PUT #BinFileNum, , b$
END IF
'IF __UI_Controls(i).HotKey <> 0 THEN
' b$ = MKI$(-17) + MKI$(__UI_Controls(i).HotKey): PUT #BinFileNum, , b$
'END IF
'IF __UI_Controls(i).HotKeyOffset <> 0 THEN
' b$ = MKI$(-18) + MKI$(__UI_Controls(i).HotKeyOffset): PUT #BinFileNum, , b$
'END IF
IF __UI_Controls(i).ShowPercentage THEN
b$ = MKI$(-19): PUT #BinFileNum, , b$
END IF
@ -842,6 +900,9 @@ SUB SavePreview
IF __UI_Controls(i).CanResize AND __UI_Controls(i).Type = __UI_Type_Form THEN
b$ = MKI$(-29): PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).HotKey > 0 THEN
b$ = MKI$(-30) + MKI$(__UI_Controls(i).HotKeyPosition): PUT #BinFileNum, , b$
END IF
END IF
NEXT
b$ = MKI$(-1024): PUT #BinFileNum, , b$ 'end of file

49
xp.uitheme
View file

@ -9,6 +9,8 @@ SUB __UI_ThemeSetup
'Metrics
__UI_ScrollbarWidth = 17
__UI_ScrollbarButtonHeight = 17
__UI_MenuBarOffset = 8
__UI_MenuItemOffset = 22
END SUB
'---------------------------------------------------------------------------------
@ -91,7 +93,7 @@ SUB __UI_DrawButton (This AS __UI_ControlTYPE, ControlState AS _BYTE)
'Does this button have a helper canvas (icon)?
DIM IconRatio AS INTEGER, IconWidth AS INTEGER, IconHeight AS INTEGER
IF This.HelperCanvas < -1 THEN
IF This.HelperCanvas < -1 AND LEN(__UI_Texts(This.ID)) > 0 THEN
IF LEN(TempCaption$) THEN
'Icon will be to the left of caption
IconHeight = This.Height - 6
@ -131,7 +133,7 @@ SUB __UI_DrawButton (This AS __UI_ControlTYPE, ControlState AS _BYTE)
_PRINTSTRING ((IconWidth / 2) + (This.Width \ 2 - _PRINTWIDTH(TempCaption$) \ 2), ((This.Height \ 2) - _FONTHEIGHT \ 2) + 2), TempCaption$
'Hot key:
IF This.HotKey > 0 AND __UI_ShowHotKeys AND NOT This.Disabled THEN
IF This.HotKey > 0 AND ((__UI_ShowHotKeys AND NOT This.Disabled) OR __UI_DesignMode) THEN
LINE ((This.Width \ 2 - _PRINTWIDTH(TempCaption$) \ 2) + This.HotKeyOffset, ((This.Height \ 2) + _FONTHEIGHT \ 2) + 1)-STEP(_PRINTWIDTH(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
@ -222,7 +224,7 @@ SUB __UI_DrawLabel (This AS __UI_ControlTYPE, ControlState AS _BYTE)
LOOP
'Hot key:
IF This.HotKey > 0 AND __UI_ShowHotKeys AND NOT This.Disabled THEN
IF This.HotKey > 0 AND ((__UI_ShowHotKeys AND NOT This.Disabled) OR __UI_DesignMode) THEN
LINE (CaptionLeftFirstLine + This.HotKeyOffset, CaptionIndent + _FONTHEIGHT + 2)-STEP(_PRINTWIDTH(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
ELSE
@ -240,7 +242,7 @@ SUB __UI_DrawLabel (This AS __UI_ControlTYPE, ControlState AS _BYTE)
_PRINTSTRING (CaptionLeft, ((This.Height \ 2) - _FONTHEIGHT \ 2)), TempCaption$
'Hot key:
IF This.HotKey > 0 AND __UI_ShowHotKeys AND NOT This.Disabled THEN
IF This.HotKey > 0 AND ((__UI_ShowHotKeys AND NOT This.Disabled) OR __UI_DesignMode) THEN
LINE (CaptionLeftFirstLine + This.HotKeyOffset, ((This.Height \ 2) + (_FONTHEIGHT \ 2)))-STEP(_PRINTWIDTH(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
END IF
@ -319,7 +321,7 @@ SUB __UI_DrawRadioButton (This AS __UI_ControlTYPE, ControlState AS _BYTE)
_PRINTSTRING (CaptionIndent, ((This.Height \ 2) - _FONTHEIGHT \ 2) + 1), TempCaption$
'Hot key:
IF This.HotKey > 0 AND __UI_ShowHotKeys AND NOT This.Disabled THEN
IF This.HotKey > 0 AND ((__UI_ShowHotKeys AND NOT This.Disabled) OR __UI_DesignMode) THEN
LINE (CaptionIndent + This.HotKeyOffset, ((This.Height \ 2) + _FONTHEIGHT \ 2))-STEP(_PRINTWIDTH(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
@ -397,7 +399,7 @@ SUB __UI_DrawCheckBox (This AS __UI_ControlTYPE, ControlState AS _BYTE)
_PRINTSTRING (CaptionIndent, ((This.Height \ 2) - _FONTHEIGHT \ 2) + 1), TempCaption$
'Hot key:
IF This.HotKey > 0 AND __UI_ShowHotKeys AND NOT This.Disabled THEN
IF This.HotKey > 0 AND ((__UI_ShowHotKeys AND NOT This.Disabled) OR __UI_DesignMode) THEN
LINE (CaptionIndent + This.HotKeyOffset, ((This.Height \ 2) + _FONTHEIGHT \ 2))-STEP(_PRINTWIDTH(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
@ -591,9 +593,11 @@ SUB __UI_DrawTextBox (This AS __UI_ControlTYPE, ControlState, ss1 AS LONG, ss2 A
IF This.Type = __UI_Type_TextBox THEN
'Make sure textboxes have fixed width fonts and a proper FieldArea property
IF _FONTWIDTH((This.Font)) = 0 THEN
This.Font = __UI_Font(RTRIM$(__UI_Controls(__UI_GetFontID(This.Font)).Name), __UI_Texts(__UI_GetFontID(This.Font)), __UI_Controls(__UI_GetFontID(This.Font)).Max, "monospace")
This.Font = __UI_Font(__UI_Texts(__UI_GetFontID(This.Font)), __UI_Controls(__UI_GetFontID(This.Font)).Max, "monospace")
END IF
This.FieldArea = This.Width \ _FONTWIDTH((This.Font)) - 1
This.FieldArea = This.Width / _FONTWIDTH((This.Font)) - 1
ELSE
EXIT SUB
END IF
IF This.ControlState <> ControlState OR _
@ -1109,7 +1113,7 @@ SUB __UI_DrawFrame (This AS __UI_ControlTYPE)
_PRINTSTRING (CaptionLeft, 0), TempCaption$
'Hot key:
IF This.HotKey > 0 AND __UI_ShowHotKeys AND NOT This.Disabled THEN
IF This.HotKey > 0 AND ((__UI_ShowHotKeys AND NOT This.Disabled) OR __UI_DesignMode) THEN
LINE (CaptionLeft + _PRINTWIDTH(" ") + This.HotKeyOffset, 0 + _FONTHEIGHT)-STEP(_PRINTWIDTH(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
END IF
@ -1152,9 +1156,6 @@ SUB __UI_DrawMenuBar (This AS __UI_ControlTYPE, ControlState AS _BYTE)
_FONT (This.Font)
'---
DIM ItemOffset%
IF _PRINTWIDTH("W") <> _PRINTWIDTH("I") THEN ItemOffset% = _PRINTWIDTH("__") ELSE ItemOffset% = _PRINTWIDTH("__")
CLS , This.BackColor
_PRINTMODE _KEEPBACKGROUND
@ -1176,10 +1177,10 @@ SUB __UI_DrawMenuBar (This AS __UI_ControlTYPE, ControlState AS _BYTE)
COLOR c
_PRINTSTRING (ItemOffset%, ((This.Height \ 2) - _FONTHEIGHT \ 2)), TempCaption$
IF This.HotKey > 0 AND (__UI_AltIsDown OR __UI_Controls(__UI_Focus).Type = __UI_Type_MenuBar) THEN
_PRINTSTRING (__UI_MenuBarOffset, ((This.Height \ 2) - _FONTHEIGHT \ 2)), TempCaption$
IF This.HotKey > 0 AND ((__UI_AltIsDown OR __UI_Controls(__UI_Focus).Type = __UI_Type_MenuBar) OR __UI_DesignMode) THEN
'Has "hot-key"
LINE (ItemOffset% + This.HotKeyOffset, ((This.Height \ 2) + _FONTHEIGHT \ 2) - 1)-STEP(_PRINTWIDTH(CHR$(This.HotKey)) - 1, 0), c
LINE (__UI_MenuBarOffset + This.HotKeyOffset, ((This.Height \ 2) + _FONTHEIGHT \ 2) - 1)-STEP(_PRINTWIDTH(CHR$(This.HotKey)) - 1, 0), c
END IF
'---
@ -1220,9 +1221,6 @@ SUB __UI_DrawMenuPanel (This AS __UI_ControlTYPE, ControlState AS _BYTE)
_FONT (This.Font)
'---
DIM ItemOffset AS INTEGER
IF _PRINTWIDTH("W") <> _PRINTWIDTH("I") THEN ItemOffset = _PRINTWIDTH("____") ELSE ItemOffset = _PRINTWIDTH("__")
COLOR , _RGBA32(0, 0, 0, 0)
CLS
_PRINTMODE _KEEPBACKGROUND
@ -1259,16 +1257,25 @@ SUB __UI_DrawMenuPanel (This AS __UI_ControlTYPE, ControlState AS _BYTE)
COLOR c
_PRINTSTRING (__UI_Controls(i).Left + ItemOffset, __UI_Controls(i).Top + __UI_Controls(i).Height \ 2 - _FONTHEIGHT \ 2), TempCaption$
_PRINTSTRING (__UI_Controls(i).Left + __UI_MenuItemOffset, __UI_Controls(i).Top + __UI_Controls(i).Height \ 2 - _FONTHEIGHT \ 2), TempCaption$
IF __UI_Controls(i).HotKey > 0 THEN
'Has "hot-key"
LINE (__UI_Controls(i).Left + ItemOffset + __UI_Controls(i).HotKeyOffset, __UI_Controls(i).Top + __UI_Controls(i).Height \ 2 + _FONTHEIGHT \ 2 - 1)-STEP(_PRINTWIDTH(CHR$(__UI_Controls(i).HotKey)) - 1, 0), c
LINE (__UI_Controls(i).Left + __UI_MenuItemOffset + __UI_Controls(i).HotKeyOffset, __UI_Controls(i).Top + __UI_Controls(i).Height \ 2 + _FONTHEIGHT \ 2 - 1)-STEP(_PRINTWIDTH(CHR$(__UI_Controls(i).HotKey)) - 1, 0), c
END IF
IF __UI_Controls(i).Value = __UI_True THEN
'Checked menu item
_PUTIMAGE (ItemOffset \ 2 - CheckMarkWidth \ 2, __UI_Controls(i).Top + __UI_Controls(i).Height \ 2 - CheckMarkHeight \ 2), ControlImage, , (0, CheckMarkIndex * CheckMarkHeight - CheckMarkHeight)-STEP(6, 6)
_PUTIMAGE (__UI_MenuItemOffset \ 2 - CheckMarkWidth \ 2, __UI_Controls(i).Top + __UI_Controls(i).Height \ 2 - CheckMarkHeight \ 2), ControlImage, , (0, CheckMarkIndex * CheckMarkHeight - CheckMarkHeight)-STEP(6, 6)
ELSE
'Does this menu item have a helper canvas (icon)?
DIM IconRatio AS INTEGER, IconWidth AS INTEGER, IconHeight AS INTEGER
IF __UI_Controls(i).HelperCanvas < -1 AND LEN(__UI_Texts(__UI_Controls(i).ID)) > 0 THEN
'Icon will be to the left of caption
IconHeight = 16
IconWidth = _WIDTH(__UI_Controls(i).HelperCanvas) * IconHeight / _HEIGHT(__UI_Controls(i).HelperCanvas)
_PUTIMAGE (3, __UI_Controls(i).Top + __UI_Controls(i).Height / 2 - IconHeight / 2)-STEP(IconWidth - 1, IconHeight - 1), __UI_Controls(i).HelperCanvas
END IF
END IF
IF HasSeparator THEN