QB64/InForm
QB64/InForm
1
1
Fork 0
mirror of https://github.com/FellippeHeitor/InForm.git synced 2025-01-15 11:59:34 +00:00
Code Issues Releases Wiki Activity
InForm/UiEditorPreview.bas
FellippeHeitor a91c32c8b1 Fixes and improvements to UiEditorPreview: 
- Segoe UI is now used as default font for new forms.
- Fix: preview window now properly reloads if inadvertenly closed.
- Internal contextual menus are not saved any longer.
2016-11-21 23:20:13 -02:00

1067 lines
50 KiB
QBasic
Raw Blame History

OPTION _EXPLICIT
$EXEICON:'.\InForm\InForm Preview.ico'
_ICON
CONST OffsetEditorPID = 1
CONST OffsetPreviewPID = 5
CONST OffsetWindowLeft = 9
CONST OffsetWindowTop = 11
CONST OffsetNewControl = 13
CONST OffsetNewDataFromEditor = 15
CONST OffsetNewDataFromPreview = 17
CONST OffsetTotalControlsSelected = 19
CONST OffsetFormID = 23
CONST OffsetFirstSelectedID = 27
CONST OffsetPropertyChanged = 31
CONST OffsetPropertyValue = 33
DIM SHARED UiPreviewPID AS LONG
DIM SHARED ExeIcon AS LONG
$IF WIN THEN
DECLARE DYNAMIC LIBRARY "kernel32"
FUNCTION OpenProcess& (BYVAL dwDesiredAccess AS LONG, BYVAL bInheritHandle AS LONG, BYVAL dwProcessId AS LONG)
FUNCTION CloseHandle& (BYVAL hObject AS LONG)
FUNCTION GetExitCodeProcess& (BYVAL hProcess AS LONG, lpExitCode AS LONG)
END DECLARE
$ELSE
DECLARE LIBRARY
FUNCTION PROCESS_CLOSED& ALIAS kill (BYVAL pid AS INTEGER, BYVAL signal AS INTEGER)
END DECLARE
$END IF
'$include:'InForm.ui'
'$include:'UiEditorPreview.frm'
'$include:'xp.uitheme'
'Event procedures: ---------------------------------------------------------------
SUB __UI_Click (id AS LONG)
DIM b$
b$ = MKI$(-1)
SendData b$, OffsetNewDataFromPreview
END SUB
SUB __UI_MouseEnter (id AS LONG)
DIM b$
b$ = MKI$(-1)
SendData b$, OffsetNewDataFromPreview
END SUB
SUB __UI_MouseLeave (id AS LONG)
END SUB
SUB __UI_FocusIn (id AS LONG)
END SUB
SUB __UI_FocusOut (id AS LONG)
END SUB
SUB __UI_MouseDown (id AS LONG)
DIM b$
b$ = MKI$(-1)
SendData b$, OffsetNewDataFromPreview
END SUB
SUB __UI_MouseUp (id AS LONG)
DIM b$
b$ = MKI$(-1)
SendData b$, OffsetNewDataFromPreview
END SUB
SUB __UI_BeforeUpdateDisplay
DIM NewWindowTop AS INTEGER, NewWindowLeft AS INTEGER
DIM b$, TempValue AS LONG, i AS LONG, UiEditorPID AS LONG
STATIC MidRead AS _BYTE, UiEditorFile AS INTEGER
SavePreview
b$ = MKL$(UiPreviewPID)
SendData b$, OffsetPreviewPID
UiEditorFile = FREEFILE
OPEN "UiEditor.dat" FOR BINARY AS #UiEditorFile
IF NOT MidRead THEN
MidRead = __UI_True
b$ = SPACE$(4): GET #UiEditorFile, OffsetEditorPID, b$
UiEditorPID = CVL(b$)
$IF WIN THEN
b$ = SPACE$(2): GET #UiEditorFile, OffsetWindowLeft, b$
NewWindowLeft = CVI(b$)
b$ = SPACE$(2): GET #UiEditorFile, OffsetWindowTop, b$
NewWindowTop = CVI(b$)
IF NewWindowLeft >= 0 AND NewWindowTop >= 0 AND (NewWindowLeft <> _SCREENX OR NewWindowTop <> _SCREENY) THEN
_SCREENMOVE NewWindowLeft + 610, NewWindowTop
END IF
$END IF
'Check if the editor is still alive
$IF WIN THEN
DIM hnd&, b&, ExitCode&
hnd& = OpenProcess(&H400, 0, UiEditorPID)
b& = GetExitCodeProcess(hnd&, ExitCode&)
IF b& = 1 AND ExitCode& = 259 THEN
'Editor is active.
ELSE
'Editor was closed.
SYSTEM
END IF
b& = CloseHandle(hnd&)
$ELSE
IF PROCESS_CLOSED(UiEditorPID, 0) THEN SYSTEM
$END IF
'New control:
DIM ThisContainer AS LONG, TempWidth AS INTEGER, TempHeight AS INTEGER
b$ = SPACE$(2): GET #UiEditorFile, OffsetNewControl, b$
TempValue = CVI(b$)
b$ = MKI$(0): PUT #UiEditorFile, OffsetNewControl, b$
IF TempValue > 0 THEN
IF __UI_Controls(__UI_Controls(__UI_FirstSelectedID).ParentID).Type = __UI_Type_Frame THEN
ThisContainer = __UI_Controls(__UI_FirstSelectedID).ParentID
TempWidth = __UI_Controls(__UI_Controls(__UI_FirstSelectedID).ParentID).Width
TempHeight = __UI_Controls(__UI_Controls(__UI_FirstSelectedID).ParentID).Height
ELSEIF __UI_Controls(__UI_FirstSelectedID).Type = __UI_Type_Frame THEN
ThisContainer = __UI_Controls(__UI_FirstSelectedID).ID
TempWidth = __UI_Controls(__UI_FirstSelectedID).Width
TempHeight = __UI_Controls(__UI_FirstSelectedID).Height
ELSE
TempWidth = __UI_Controls(__UI_FormID).Width
TempHeight = __UI_Controls(__UI_FormID).Height
END IF
SELECT CASE TempValue
CASE __UI_Type_Button
TempValue = __UI_NewControl(__UI_Type_Button, "", 80, 23, TempWidth \ 2 - 40, TempHeight \ 2 - 12, ThisContainer)
CASE __UI_Type_Label, __UI_Type_CheckBox, __UI_Type_RadioButton
TempValue = __UI_NewControl(TempValue, "", 150, 23, TempWidth \ 2 - 75, TempHeight \ 2 - 12, ThisContainer)
__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("", 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
TempValue = __UI_NewControl(__UI_Type_ListBox, "", 200, 200, TempWidth \ 2 - 100, TempHeight \ 2 - 100, ThisContainer)
__UI_Controls(TempValue).HasBorder = __UI_True
CASE __UI_Type_DropdownList
TempValue = __UI_NewControl(__UI_Type_DropdownList, "", 200, 23, TempWidth \ 2 - 100, TempHeight \ 2 - 12, ThisContainer)
CASE __UI_Type_TrackBar
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
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)
__UI_SetCaption __UI_Controls(TempValue).Name, RTRIM$(__UI_Controls(TempValue).Name)
END SELECT
FOR i = 1 TO UBOUND(__UI_Controls)
__UI_Controls(i).ControlIsSelected = __UI_False
NEXT
__UI_Controls(TempValue).ControlIsSelected = __UI_True
__UI_TotalSelectedControls = 1
__UI_FirstSelectedID = TempValue
__UI_ForceRedraw = __UI_True
END IF
b$ = SPACE$(2): GET #UiEditorFile, OffsetNewDataFromEditor, b$
TempValue = CVI(b$)
b$ = MKI$(0): PUT #UiEditorFile, OffsetNewDataFromEditor, b$
IF TempValue = -1 THEN
DIM FloatValue AS _FLOAT
'Editor sent property value
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyChanged, b$
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_TotalSelectedControls = 1 THEN
IF __UI_GetID(b$) > 0 AND __UI_GetID(b$) <> __UI_FirstSelectedID THEN
DO
b$ = b$ + "_"
IF __UI_GetID(b$) = 0 THEN EXIT DO
LOOP
END IF
__UI_Controls(__UI_FirstSelectedID).Name = b$
ELSE
IF __UI_GetID(b$) > 0 AND __UI_GetID(b$) <> __UI_FormID THEN
DO
b$ = b$ + "_"
IF __UI_GetID(b$) = 0 THEN EXIT DO
LOOP
END IF
__UI_Controls(__UI_FormID).Name = b$
END IF
CASE 2 'Caption
b$ = SPACE$(4): GET #UiEditorFile, OffsetPropertyValue, b$
b$ = SPACE$(CVL(b$)): GET #UiEditorFile, , b$
IF __UI_TotalSelectedControls > 0 THEN
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_SetCaption RTRIM$(__UI_Controls(i).Name), b$
END IF
NEXT
ELSE
__UI_Captions(__UI_FormID) = b$
END IF
CASE 3 'Text
DIM TotalReplacements AS LONG
b$ = SPACE$(4): GET #UiEditorFile, OffsetPropertyValue, b$
b$ = SPACE$(CVL(b$)): GET #UiEditorFile, , b$
IF __UI_TotalSelectedControls > 0 THEN
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$
ELSEIF __UI_Controls(i).Type = __UI_Type_ListBox OR __UI_Controls(i).Type = __UI_Type_DropdownList THEN
__UI_Texts(i) = __UI_ReplaceText(b$, "\n", CHR$(13), __UI_False, TotalReplacements)
IF __UI_Controls(i).Max < TotalReplacements + 1 THEN __UI_Controls(i).Max = TotalReplacements + 1
__UI_Controls(i).LastVisibleItem = 0 'Reset it so it's recalculated
END IF
END IF
NEXT
ELSE
IF ExeIcon <> 0 THEN _FREEIMAGE ExeIcon: ExeIcon = 0
ExeIcon = IconPreview&(b$)
IF ExeIcon < -1 THEN
_ICON ExeIcon
__UI_Texts(__UI_FormID) = b$
ELSE
_ICON
__UI_Texts(__UI_FormID) = ""
END IF
END IF
CASE 4 'Top
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
TempValue = CVI(b$)
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).Top = TempValue
END IF
NEXT
CASE 5 'Left
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
TempValue = CVI(b$)
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).Left = TempValue
END IF
NEXT
CASE 6 'Width
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
TempValue = CVI(b$)
IF TempValue < 1 THEN TempValue = 1
IF __UI_TotalSelectedControls > 0 THEN
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).Width = TempValue
END IF
NEXT
ELSE
IF TempValue < 20 THEN TempValue = 20
__UI_Controls(__UI_FormID).Width = TempValue
END IF
CASE 7 'Height
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
TempValue = CVI(b$)
IF TempValue < 1 THEN TempValue = 1
IF __UI_TotalSelectedControls > 0 THEN
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).Height = TempValue
END IF
NEXT
ELSE
IF TempValue < 20 THEN TempValue = 20
__UI_Controls(__UI_FormID).Height = TempValue
END IF
CASE 8 'Font
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)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).Value = _CV(_FLOAT, b$)
END IF
NEXT
CASE 11 'Min
b$ = SPACE$(LEN(FloatValue)): GET #UiEditorFile, OffsetPropertyValue, b$
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).Min = _CV(_FLOAT, b$)
END IF
NEXT
CASE 12 'Max
b$ = SPACE$(LEN(FloatValue)): GET #UiEditorFile, OffsetPropertyValue, b$
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).Max = _CV(_FLOAT, b$)
END IF
NEXT
CASE 13 'Interval
b$ = SPACE$(LEN(FloatValue)): GET #UiEditorFile, OffsetPropertyValue, b$
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).Interval = _CV(_FLOAT, b$)
END IF
NEXT
CASE 14 'Stretch
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).Stretch = CVI(b$)
END IF
NEXT
CASE 15 'Has border
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).HasBorder = CVI(b$)
END IF
NEXT
CASE 16 'Show percentage
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).ShowPercentage = CVI(b$)
END IF
NEXT
CASE 17 'Word wrap
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).WordWrap = CVI(b$)
END IF
NEXT
CASE 18 'Can have focus
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).CanHaveFocus = CVI(b$)
END IF
NEXT
CASE 19 'Disabled
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).Disabled = CVI(b$)
END IF
NEXT
CASE 20 'Hidden
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).Hidden = CVI(b$)
END IF
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
CASE 22 'Alignment
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).Align = CVI(b$)
END IF
NEXT
CASE 23 'ForeColor
b$ = SPACE$(4): GET #UiEditorFile, OffsetPropertyValue, b$
IF __UI_TotalSelectedControls > 0 THEN
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).ForeColor = _CV(_UNSIGNED LONG, b$)
END IF
NEXT
ELSE
__UI_Controls(__UI_FormID).ForeColor = _CV(_UNSIGNED LONG, b$)
END IF
CASE 24 'BackColor
b$ = SPACE$(4): GET #UiEditorFile, OffsetPropertyValue, b$
IF __UI_TotalSelectedControls > 0 THEN
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).BackColor = _CV(_UNSIGNED LONG, b$)
END IF
NEXT
ELSE
__UI_Controls(__UI_FormID).BackColor = _CV(_UNSIGNED LONG, b$)
END IF
CASE 25 'SelectedForeColor
b$ = SPACE$(4): GET #UiEditorFile, OffsetPropertyValue, b$
IF __UI_TotalSelectedControls > 0 THEN
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).SelectedForeColor = _CV(_UNSIGNED LONG, b$)
END IF
NEXT
ELSE
__UI_Controls(__UI_FormID).SelectedForeColor = _CV(_UNSIGNED LONG, b$)
END IF
CASE 26 'SelectedBackColor
b$ = SPACE$(4): GET #UiEditorFile, OffsetPropertyValue, b$
IF __UI_TotalSelectedControls > 0 THEN
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).SelectedBackColor = _CV(_UNSIGNED LONG, b$)
END IF
NEXT
ELSE
__UI_Controls(__UI_FormID).SelectedBackColor = _CV(_UNSIGNED LONG, b$)
END IF
CASE 27 'BorderColor
b$ = SPACE$(4): GET #UiEditorFile, OffsetPropertyValue, b$
IF __UI_TotalSelectedControls > 0 THEN
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).BorderColor = _CV(_UNSIGNED LONG, b$)
END IF
NEXT
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
CASE 31 'Padding
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
TempValue = CVI(b$)
IF __UI_TotalSelectedControls > 0 THEN
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ControlIsSelected THEN
__UI_Controls(i).Padding = TempValue
END IF
NEXT
END IF
END SELECT
__UI_ForceRedraw = __UI_True
END IF
b$ = MKL$(__UI_TotalSelectedControls)
PUT #UiEditorFile, OffsetTotalControlsSelected, b$
b$ = MKL$(__UI_FirstSelectedID)
PUT #UiEditorFile, OffsetFirstSelectedID, b$
b$ = MKL$(__UI_FormID)
PUT #UiEditorFile, OffsetFormID, b$
MidRead = __UI_False
CLOSE #UiEditorFile
END IF
END SUB
SUB __UI_BeforeUnload
'DIM Answer AS _BYTE
'Answer = __UI_MessageBox("Leaving UI", "Copy current form data to clipboard?", __UI_MsgBox_YesNoCancel + __UI_MsgBox_Question)
'IF Answer = __UI_MsgBox_Cancel THEN
' __UI_UnloadSignal = __UI_False
'ELSEIF Answer = __UI_MsgBox_Yes THEN
' Answer = __UI_MessageBox("Leaving UI", "Not yet implemented", __UI_MsgBox_OkOnly + __UI_MsgBox_Information)
'END IF
END SUB
SUB __UI_BeforeInit
__UI_DesignMode = __UI_True
UiPreviewPID = __UI_GetPID
LoadPreview
END SUB
SUB __UI_OnLoad
END SUB
SUB __UI_KeyPress (id AS LONG)
END SUB
SUB __UI_ValueChanged (id AS LONG)
END SUB
SUB LoadPreview
DIM a$, b$, i AS LONG, __UI_EOF AS _BYTE, Answer AS _BYTE
DIM NewType AS INTEGER, NewWidth AS INTEGER, NewHeight AS INTEGER
DIM NewLeft AS INTEGER, NewTop AS INTEGER, NewName AS STRING
DIM NewParentID AS STRING, FloatValue AS _FLOAT, TempValue AS LONG
DIM Dummy AS LONG
DIM BinaryFileNum AS INTEGER, LogFileNum AS INTEGER
CONST LogFileLoad = __UI_True
IF _FILEEXISTS("UiEditorPreview.frmbin") = 0 THEN
EXIT SUB
ELSE
BinaryFileNum = FREEFILE
OPEN "UiEditorPreview.frmbin" FOR BINARY AS #BinaryFileNum
LogFileNum = FREEFILE
IF LogFileLoad THEN OPEN "ui_log.txt" FOR OUTPUT AS #LogFileNum
b$ = SPACE$(7): GET #BinaryFileNum, 1, b$
IF b$ <> "InForm" + CHR$(1) THEN
GOTO LoadError
EXIT SUB
END IF
IF LogFileLoad THEN PRINT #LogFileNum, "FOUND INFORM+1"
__UI_AutoRefresh = __UI_False
FOR i = UBOUND(__UI_Controls) TO 1 STEP -1
IF LEFT$(__UI_Controls(i).Name, 9) <> "__UI_Text" AND LEFT$(__UI_Controls(i).Name, 16) <> "__UI_PreviewMenu" THEN
__UI_DestroyControl __UI_Controls(i)
END IF
NEXT
IF LogFileLoad THEN PRINT #LogFileNum, "DESTROYED CONTROLS"
b$ = SPACE$(4): GET #BinaryFileNum, , b$
IF LogFileLoad THEN PRINT #LogFileNum, "READ NEW ARRAYS:" + STR$(CVL(b$))
REDIM _PRESERVE __UI_Captions(1 TO CVL(b$)) AS STRING
REDIM __UI_TempCaptions(1 TO CVL(b$)) AS STRING
REDIM __UI_Texts(1 TO CVL(b$)) AS STRING
REDIM __UI_TempTexts(1 TO CVL(b$)) AS STRING
REDIM __UI_Tips(1 TO CVL(b$)) AS STRING
REDIM __UI_TempTips(1 TO CVL(b$)) AS STRING
REDIM _PRESERVE __UI_Controls(0 TO CVL(b$)) AS __UI_ControlTYPE
b$ = SPACE$(2): GET #BinaryFileNum, , b$
IF LogFileLoad THEN PRINT #LogFileNum, "READ NEW CONTROL:" + STR$(CVI(b$))
IF CVI(b$) <> -1 THEN GOTO LoadError
DO
b$ = SPACE$(4): GET #BinaryFileNum, , b$
Dummy = CVL(b$)
b$ = SPACE$(2): GET #BinaryFileNum, , b$
NewType = CVI(b$)
IF LogFileLoad THEN PRINT #LogFileNum, "TYPE:" + STR$(CVI(b$))
b$ = SPACE$(2): GET #BinaryFileNum, , b$
b$ = SPACE$(CVI(b$)): GET #BinaryFileNum, , b$
NewName = b$
IF LogFileLoad THEN PRINT #LogFileNum, "NAME:" + NewName
b$ = SPACE$(2): GET #BinaryFileNum, , b$
NewWidth = CVI(b$)
IF LogFileLoad THEN PRINT #LogFileNum, "WIDTH:" + STR$(CVI(b$))
b$ = SPACE$(2): GET #BinaryFileNum, , b$
NewHeight = CVI(b$)
IF LogFileLoad THEN PRINT #LogFileNum, "HEIGHT:" + STR$(CVI(b$))
b$ = SPACE$(2): GET #BinaryFileNum, , b$
NewLeft = CVI(b$)
IF LogFileLoad THEN PRINT #LogFileNum, "LEFT:" + STR$(CVI(b$))
b$ = SPACE$(2): GET #BinaryFileNum, , b$
NewTop = CVI(b$)
IF LogFileLoad THEN PRINT #LogFileNum, "TOP:" + STR$(CVI(b$))
b$ = SPACE$(2): GET #BinaryFileNum, , b$
IF CVI(b$) > 0 THEN
NewParentID = SPACE$(CVI(b$)): GET #BinaryFileNum, , NewParentID
IF LogFileLoad THEN PRINT #LogFileNum, "PARENT:" + NewParentID
ELSE
NewParentID = ""
IF LogFileLoad THEN PRINT #LogFileNum, "PARENT: ORPHAN/CONTAINER"
END IF
TempValue = __UI_NewControl(NewType, NewName, NewWidth, NewHeight, NewLeft, NewTop, __UI_GetID(NewParentID))
DO 'read properties
b$ = SPACE$(2): GET #BinaryFileNum, , b$
IF LogFileLoad THEN PRINT #LogFileNum, "PROPERTY:" + STR$(CVI(b$)) + " :";
SELECT CASE CVI(b$)
CASE -2 'Caption
b$ = SPACE$(4): GET #BinaryFileNum, , b$
b$ = SPACE$(CVL(b$))
GET #BinaryFileNum, , 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$
b$ = SPACE$(CVL(b$))
GET #BinaryFileNum, , b$
__UI_Texts(TempValue) = b$
IF __UI_Controls(TempValue).Type = __UI_Type_PictureBox OR __UI_Controls(TempValue).Type = __UI_Type_Button THEN
__UI_LoadImage __UI_Controls(TempValue), __UI_Texts(TempValue)
ELSEIF __UI_Controls(TempValue).Type = __UI_Type_Form THEN
IF ExeIcon <> 0 THEN _FREEIMAGE ExeIcon: ExeIcon = 0
ExeIcon = IconPreview&(b$)
IF ExeIcon < -1 THEN
_ICON ExeIcon
END IF
END IF
IF LogFileLoad THEN PRINT #LogFileNum, "TEXT:" + __UI_Texts(TempValue)
CASE -4 'Stretch
__UI_Controls(TempValue).Stretch = __UI_True
IF LogFileLoad THEN PRINT #LogFileNum, "STRETCH"
CASE -5 'Font
IF LogFileLoad THEN PRINT #LogFileNum, "FONT:";
DIM FontSetup$, FindSep AS INTEGER
DIM NewFontName AS STRING, NewFontFile AS STRING
DIM NewFontSize AS INTEGER, NewFontAttributes AS STRING
b$ = SPACE$(2): GET #BinaryFileNum, , b$
FontSetup$ = SPACE$(CVI(b$)): GET #BinaryFileNum, , FontSetup$
IF LogFileLoad THEN PRINT #LogFileNum, FontSetup$
FindSep = INSTR(FontSetup$, "*")
NewFontFile = LEFT$(FontSetup$, FindSep - 1): FontSetup$ = MID$(FontSetup$, FindSep + 1)
FindSep = INSTR(FontSetup$, "*")
NewFontAttributes = LEFT$(FontSetup$, FindSep - 1): FontSetup$ = MID$(FontSetup$, FindSep + 1)
NewFontSize = VAL(FontSetup$)
__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$)
IF LogFileLoad THEN PRINT #LogFileNum, "FORECOLOR"
CASE -7 'BackColor
b$ = SPACE$(4): GET #BinaryFileNum, , b$
__UI_Controls(TempValue).BackColor = _CV(_UNSIGNED LONG, b$)
IF LogFileLoad THEN PRINT #LogFileNum, "BACKCOLOR"
CASE -8 'SelectedForeColor
b$ = SPACE$(4): GET #BinaryFileNum, , b$
__UI_Controls(TempValue).SelectedForeColor = _CV(_UNSIGNED LONG, b$)
IF LogFileLoad THEN PRINT #LogFileNum, "SELECTEDFORECOLOR"
CASE -9 'SelectedBackColor
b$ = SPACE$(4): GET #BinaryFileNum, , b$
__UI_Controls(TempValue).SelectedBackColor = _CV(_UNSIGNED LONG, b$)
IF LogFileLoad THEN PRINT #LogFileNum, "SELECTEDBACKCOLOR"
CASE -10 'BorderColor
b$ = SPACE$(4): GET #BinaryFileNum, , b$
__UI_Controls(TempValue).BorderColor = _CV(_UNSIGNED LONG, b$)
IF LogFileLoad THEN PRINT #LogFileNum, "BORDERCOLOR"
CASE -11
__UI_Controls(TempValue).BackStyle = __UI_Transparent
IF LogFileLoad THEN PRINT #LogFileNum, "BACKSTYLE:TRANSPARENT"
CASE -12
__UI_Controls(TempValue).HasBorder = __UI_True
IF LogFileLoad THEN PRINT #LogFileNum, "HASBORDER"
CASE -13
b$ = SPACE$(1): GET #BinaryFileNum, , b$
__UI_Controls(TempValue).Align = _CV(_BYTE, b$)
IF LogFileLoad THEN PRINT #LogFileNum, "ALIGN="; __UI_Controls(TempValue).Align
CASE -14
b$ = SPACE$(LEN(FloatValue)): GET #BinaryFileNum, , b$
__UI_Controls(TempValue).Value = _CV(_FLOAT, b$)
IF LogFileLoad THEN PRINT #LogFileNum, "VALUE="; __UI_Controls(TempValue).Value
CASE -15
b$ = SPACE$(LEN(FloatValue)): GET #BinaryFileNum, , b$
__UI_Controls(TempValue).Min = _CV(_FLOAT, b$)
IF LogFileLoad THEN PRINT #LogFileNum, "MIN="; __UI_Controls(TempValue).Min
CASE -16
b$ = SPACE$(LEN(FloatValue)): GET #BinaryFileNum, , b$
__UI_Controls(TempValue).Max = _CV(_FLOAT, b$)
IF LogFileLoad THEN PRINT #LogFileNum, "MAX="; __UI_Controls(TempValue).Max
CASE -17
b$ = SPACE$(2): GET #BinaryFileNum, , b$
__UI_Controls(TempValue).HotKey = CVI(b$)
IF LogFileLoad THEN PRINT #LogFileNum, "HOTKEY="; __UI_Controls(TempValue).HotKey; "("; CHR$(__UI_Controls(TempValue).HotKey); ")"
CASE -18
b$ = SPACE$(2): GET #BinaryFileNum, , b$
__UI_Controls(TempValue).HotKeyOffset = CVI(b$)
IF LogFileLoad THEN PRINT #LogFileNum, "HOTKEYOFFSET="; __UI_Controls(TempValue).HotKeyOffset
CASE -19
__UI_Controls(TempValue).ShowPercentage = __UI_True
IF LogFileLoad THEN PRINT #LogFileNum, "SHOWPERCENTAGE"
CASE -20
__UI_Controls(TempValue).CanHaveFocus = __UI_True
IF LogFileLoad THEN PRINT #LogFileNum, "CANHAVEFOCUS"
CASE -21
__UI_Controls(TempValue).Disabled = __UI_True
IF LogFileLoad THEN PRINT #LogFileNum, "DISABLED"
CASE -22
__UI_Controls(TempValue).Hidden = __UI_True
IF LogFileLoad THEN PRINT #LogFileNum, "HIDDEN"
CASE -23
__UI_Controls(TempValue).CenteredWindow = __UI_True
IF LogFileLoad THEN PRINT #LogFileNum, "CENTEREDWINDOW"
CASE -24 'Tips
b$ = SPACE$(4): GET #BinaryFileNum, , b$
b$ = SPACE$(CVL(b$))
GET #BinaryFileNum, , b$
__UI_Tips(TempValue) = b$
IF LogFileLoad THEN PRINT #LogFileNum, "TIP: "; __UI_Tips(TempValue)
CASE -25
DIM ContextMenuName AS STRING
b$ = SPACE$(2): GET #BinaryFileNum, , b$
ContextMenuName = SPACE$(CVI(b$)): GET #BinaryFileNum, , ContextMenuName
__UI_Controls(TempValue).ContextMenuID = __UI_GetID(ContextMenuName)
IF LogFileLoad THEN PRINT #LogFileNum, "CONTEXTMENU:"; ContextMenuName
CASE -26
b$ = SPACE$(LEN(FloatValue)): GET #BinaryFileNum, , b$
__UI_Controls(TempValue).Interval = _CV(_FLOAT, b$)
IF LogFileLoad THEN PRINT #LogFileNum, "INTERVAL="; __UI_Controls(TempValue).Interval
CASE -27
__UI_Controls(TempValue).WordWrap = __UI_True
IF LogFileLoad THEN PRINT #LogFileNum, "WORDWRAP"
CASE -28
b$ = SPACE$(4): GET #BinaryFileNum, , b$
__UI_Controls(TempValue).TransparentColor = _CV(_UNSIGNED LONG, b$)
IF LogFileLoad THEN PRINT #LogFileNum, "TRANSPARENTCOLOR"
__UI_ClearColor __UI_Controls(TempValue).HelperCanvas, __UI_Controls(TempValue).TransparentColor, -1
CASE -29
__UI_Controls(TempValue).CanResize = __UI_True
IF LogFileLoad THEN PRINT #LogFileNum, "CANRESIZE"
CASE -31
b$ = SPACE$(2): GET #BinaryFileNum, , b$
__UI_Controls(TempValue).Padding = CVI(b$)
IF LogFileLoad THEN PRINT #LogFileNum, "PADDING" + STR$(CVI(b$))
CASE -1 'new control
IF LogFileLoad THEN PRINT #LogFileNum, "READ NEW CONTROL: -1"
EXIT DO
CASE -1024
IF LogFileLoad THEN PRINT #LogFileNum, "READ END OF FILE: -1024"
__UI_EOF = __UI_True
EXIT DO
CASE ELSE
IF LogFileLoad THEN PRINT #LogFileNum, "UNKNOWN PROPERTY ="; CVI(b$)
EXIT DO
END SELECT
LOOP
LOOP UNTIL __UI_EOF
CLOSE #BinaryFileNum
IF LogFileLoad THEN CLOSE #LogFileNum
__UI_AutoRefresh = __UI_True
EXIT SUB
LoadError:
__UI_AutoRefresh = __UI_True
CLOSE #BinaryFileNum
EXIT SUB
END IF
END SUB
SUB SavePreview
DIM b$, i AS LONG, a$, FontSetup$, TempValue AS LONG
DIM BinFileNum AS INTEGER, TxtFileNum AS INTEGER
CONST Debug = __UI_True
BinFileNum = FREEFILE
OPEN "UiEditorPreview.frmbin" FOR BINARY AS #BinFileNum
IF Debug THEN
TxtFileNum = FREEFILE
OPEN "UiEditorPreview.txt" FOR OUTPUT AS #TxtFileNum
END IF
b$ = "InForm" + CHR$(1)
PUT #BinFileNum, 1, b$
b$ = MKL$(UBOUND(__UI_Controls))
PUT #BinFileNum, , b$
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).ID > 0 AND __UI_Controls(i).Type <> __UI_Type_MenuPanel AND __UI_Controls(i).Type <> __UI_Type_Font AND LEN(RTRIM$(__UI_Controls(i).Name)) > 0 AND LEFT$(RTRIM$(__UI_Controls(i).Name), 9) <> "__UI_Text" AND LEFT$(RTRIM$(__UI_Controls(i).Name), 16) <> "__UI_PreviewMenu" THEN
IF Debug THEN
PRINT #TxtFileNum, __UI_Controls(i).ID,
PRINT #TxtFileNum, RTRIM$(__UI_Controls(i).Name)
END IF
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)
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
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, , a$
END IF
IF LEN(__UI_Tips(i)) > 0 THEN
b$ = MKI$(-24) + MKL$(LEN(__UI_Tips(i))) '-24 indicates a tip
PUT #BinFileNum, , b$
PUT #BinFileNum, , __UI_Tips(i)
END IF
IF LEN(__UI_Texts(i)) > 0 THEN
b$ = MKI$(-3) + MKL$(LEN(__UI_Texts(i))) '-3 indicates a text
PUT #BinFileNum, , b$
PUT #BinFileNum, , __UI_Texts(i)
END IF
IF __UI_Controls(i).TransparentColor > 0 THEN
b$ = MKI$(-28) + _MK$(_UNSIGNED LONG, __UI_Controls(i).TransparentColor)
PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).Stretch THEN
b$ = MKI$(-4)
PUT #BinFileNum, , b$
END IF
'Inheritable properties won't be saved if they are the same as the parent's
IF __UI_Controls(i).Type = __UI_Type_Form THEN
IF __UI_Controls(i).Font = 8 OR __UI_Controls(i).Font = 16 THEN
'Internal fonts
SaveInternalFont:
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$ = __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
ELSE
IF __UI_Controls(i).ParentID > 0 THEN
IF __UI_Controls(i).Font > 0 AND __UI_Controls(i).Font <> __UI_Controls(__UI_Controls(i).ParentID).Font THEN
IF __UI_Controls(i).Font = 8 OR __UI_Controls(i).Font = 16 THEN
GOTO SaveInternalFont
ELSE
GOTO SaveExternalFont
END IF
END IF
ELSE
IF __UI_Controls(i).Font > 0 AND __UI_Controls(i).Font <> __UI_Controls(__UI_FormID).Font THEN
IF __UI_Controls(i).Font = 8 OR __UI_Controls(i).Font = 16 THEN
GOTO SaveInternalFont
ELSE
GOTO SaveExternalFont
END IF
END IF
END IF
END IF
'Colors are saved only if they differ from the theme's defaults
IF __UI_Controls(i).ForeColor <> __UI_DefaultColor(__UI_Controls(i).Type, 1) THEN
b$ = MKI$(-6) + _MK$(_UNSIGNED LONG, __UI_Controls(i).ForeColor)
PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).BackColor <> __UI_DefaultColor(__UI_Controls(i).Type, 2) THEN
b$ = MKI$(-7) + _MK$(_UNSIGNED LONG, __UI_Controls(i).BackColor)
PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).SelectedForeColor <> __UI_DefaultColor(__UI_Controls(i).Type, 3) THEN
b$ = MKI$(-8) + _MK$(_UNSIGNED LONG, __UI_Controls(i).SelectedForeColor)
PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).SelectedBackColor <> __UI_DefaultColor(__UI_Controls(i).Type, 4) THEN
b$ = MKI$(-9) + _MK$(_UNSIGNED LONG, __UI_Controls(i).SelectedBackColor)
PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).BorderColor <> __UI_DefaultColor(__UI_Controls(i).Type, 5) THEN
b$ = MKI$(-10) + _MK$(_UNSIGNED LONG, __UI_Controls(i).BorderColor)
PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).BackStyle = __UI_Transparent THEN
b$ = MKI$(-11): PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).HasBorder THEN
b$ = MKI$(-12): PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).Align = __UI_Center THEN
b$ = MKI$(-13) + _MK$(_BYTE, __UI_Controls(i).Align): PUT #BinFileNum, , b$
ELSEIF __UI_Controls(i).Align = __UI_Right THEN
b$ = MKI$(-13) + _MK$(_BYTE, __UI_Controls(i).Align): PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).Value <> 0 THEN
b$ = MKI$(-14) + _MK$(_FLOAT, __UI_Controls(i).Value): PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).Min <> 0 THEN
b$ = MKI$(-15) + _MK$(_FLOAT, __UI_Controls(i).Min): PUT #BinFileNum, , b$
END IF
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).ShowPercentage THEN
b$ = MKI$(-19): PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).CanHaveFocus THEN
b$ = MKI$(-20): PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).Disabled THEN
b$ = MKI$(-21): PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).Hidden THEN
b$ = MKI$(-22): PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).CenteredWindow THEN
b$ = MKI$(-23): PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).ContextMenuID THEN
IF LEFT$(__UI_Controls(__UI_Controls(i).ContextMenuID).Name, 9) <> "__UI_Text" AND LEFT$(__UI_Controls(__UI_Controls(i).ContextMenuID).Name, 16) <> "__UI_PreviewMenu" THEN
b$ = MKI$(-25) + MKI$(LEN(RTRIM$(__UI_Controls(__UI_Controls(i).ContextMenuID).Name))) + RTRIM$(__UI_Controls(__UI_Controls(i).ContextMenuID).Name): PUT #BinFileNum, , b$
END IF
END IF
IF __UI_Controls(i).Interval THEN
b$ = MKI$(-26) + _MK$(_FLOAT, __UI_Controls(i).Interval): PUT #BinFileNum, , b$
END IF
IF __UI_Controls(i).WordWrap THEN
b$ = MKI$(-27): PUT #BinFileNum, , b$
END IF
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
IF __UI_Controls(i).Padding > 0 THEN
b$ = MKI$(-31) + MKI$(__UI_Controls(i).Padding): PUT #BinFileNum, , b$
END IF
END IF
NEXT
b$ = MKI$(-1024): PUT #BinFileNum, , b$ 'end of file
CLOSE #BinFileNum
IF Debug THEN CLOSE #TxtFileNum
END SUB
SUB SendData (b$, Offset AS LONG)
DIM FileNum AS INTEGER
FileNum = FREEFILE
OPEN "UiEditor.dat" FOR BINARY AS #FileNum
PUT #FileNum, Offset, b$
CLOSE #FileNum
END SUB
FUNCTION IconPreview& (IconFile$)
DIM IconFileNum AS INTEGER
DIM Preferred AS INTEGER, Largest AS INTEGER
DIM i AS LONG, a$
TYPE ICONTYPE
Reserved AS INTEGER: ID AS INTEGER: Count AS INTEGER
END TYPE
TYPE ICONENTRY
PWidth AS _UNSIGNED _BYTE: PDepth AS _UNSIGNED _BYTE
NumColors AS _BYTE: RES2 AS _BYTE
NumberPlanes AS INTEGER: BitsPerPixel AS INTEGER
DataSize AS LONG: DataOffset AS LONG
END TYPE
TYPE BMPENTRY
ID AS STRING * 2: Size AS LONG: Res1 AS INTEGER: Res2 AS INTEGER: Offset AS LONG
END TYPE
TYPE BMPHeader
Hsize AS LONG: PWidth AS LONG: PDepth AS LONG
Planes AS INTEGER: BPP AS INTEGER
Compression AS LONG: ImageBytes AS LONG
Xres AS LONG: Yres AS LONG: NumColors AS LONG: SigColors AS LONG
END TYPE
DIM ICO AS ICONTYPE
DIM BMP AS BMPENTRY
DIM BMPHeader AS BMPHeader
IF _FILEEXISTS(IconFile$) = 0 THEN EXIT FUNCTION
IconFileNum = FREEFILE
OPEN IconFile$ FOR BINARY AS #IconFileNum
GET #IconFileNum, 1, ICO
IF ICO.ID <> 1 THEN CLOSE #IconFileNum: EXIT FUNCTION
DIM Entry(ICO.Count) AS ICONENTRY
Preferred = 0
Largest = 0
FOR i = 1 TO ICO.Count
GET #IconFileNum, , Entry(i)
IF Entry(i).BitsPerPixel = 32 THEN
IF Entry(i).PWidth = 0 THEN Entry(i).PWidth = 256
IF Entry(i).PWidth > Largest THEN Largest = Entry(i).PWidth: Preferred = i
END IF
NEXT
IF Preferred = 0 THEN EXIT FUNCTION
a$ = SPACE$(Entry(Preferred).DataSize)
GET #IconFileNum, Entry(Preferred).DataOffset + 1, a$
CLOSE #IconFileNum
IF LEFT$(a$, 4) = CHR$(137) + "PNG" THEN
'PNG data can be dumped to the disk directly
OPEN IconFile$ + ".preview.png" FOR BINARY AS #IconFileNum
PUT #IconFileNum, 1, a$
CLOSE #IconFileNum
i = _LOADIMAGE(IconFile$ + ".preview.png", 32)
IF i = -1 THEN i = 0
IconPreview& = i
KILL IconFile$ + ".preview.png"
EXIT FUNCTION
ELSE
'BMP data requires a header to be added
BMP.ID = "BM"
BMP.Size = LEN(BMP) + LEN(BMPHeader) + LEN(a$)
BMP.Offset = LEN(BMP) + LEN(BMPHeader)
BMPHeader.Hsize = 40
BMPHeader.PWidth = Entry(Preferred).PWidth
BMPHeader.PDepth = Entry(Preferred).PDepth: IF BMPHeader.PDepth = 0 THEN BMPHeader.PDepth = 256
BMPHeader.Planes = 1
BMPHeader.BPP = 32
OPEN IconFile$ + ".preview.bmp" FOR BINARY AS #IconFileNum
PUT #IconFileNum, 1, BMP
PUT #IconFileNum, , BMPHeader
a$ = MID$(a$, 41)
PUT #IconFileNum, , a$
CLOSE #IconFileNum
i = _LOADIMAGE(IconFile$ + ".preview.bmp", 32)
IF i < -1 THEN 'Loaded properly
_SOURCE i
IF POINT(0, 0) = _RGB32(0, 0, 0) THEN _CLEARCOLOR _RGB32(0, 0, 0), i
_SOURCE 0
ELSE
i = 0
END IF
IconPreview& = i
KILL IconFile$ + ".preview.bmp"
EXIT FUNCTION
END IF
END FUNCTION
View git blame Copy permalink