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

Overall: Replaces QB64's _PRINTSTRING with *uprint* aka falcon.h. Also:

Browse source 
- Adds padding (left/right) to labels.
- Adds multiline support for textboxes.
- Improves wordwrapping for labels - bypasses the function if the same text passed has already been processed for the same width and _font conditions.
- Restores internal textfield contextual menu.
- Textfield contextual menu limits options based on clipboard/selection status.
- Creates a new helpercanvas automatically upon creating a new picturebox control.
- New ReplaceText function which enables \n for adding items to a listbox at design time.

UiEditor.bas:
- Indicator on textbox shows if current input value has been accepted by the Preview renderer.
- Improves saving of nested controls.
- New "icon" property for the main form.

UiEditorPreview.bas:
- Loads the icon specified in the editor and shows it in real time (.ico files encoded as bmps and pngs accepted).
This commit is contained in:
FellippeHeitor 2016-11-02 01:03:46 -02:00
parent 4188be2a76
commit b9bebbee59
11 changed files with 1548 additions and 428 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

984
InForm.ui
View file

File diff suppressed because it is too large Load diff

27
InForm/Icons.txt Normal file
View file

@ -0,0 +1,27 @@
http://www.iconarchive.com/show/matrilineare-icons-by-sora-meliae/Apps-dconf-editor-icon.html
"Apps dconf editor Icon"
Artist: sora-meliae
Iconset: Matrilineare Icons (126 icons)
License: GNU General Public License
Commercial usage: Allowed
http://www.iconarchive.com/show/modern-xp-icons-by-dtafalonso/ModernXP-69-Window-icon.html
"ModernXP 69 Window Icon"
Artist: dtafalonso
Iconset: Modern XP Icons (76 icons)
License: CC Attribution-Noncommercial-No Derivate 4.0
Commercial usage: Not allowed
http://www.iconarchive.com/show/onebit-icons-by-icojam/ok-icon.html
"Ok Icon"
Artist: Icojam
Iconset: Onebit 1-3 Icons (105 icons)
License: Public Domain
Commercial usage: Allowed
http://www.iconarchive.com/show/sleek-xp-basic-icons-by-hopstarter/Delete-icon.html
"Delete Icon"
Artist: Hopstarter (Available for custom work)
Iconset: Sleek XP Basic Icons (50 icons)
License: CC Attribution-Noncommercial-No Derivate 4.0
Commercial usage: Allowed (Author Arrangement required -> Visit artist website for details).

7
InForm/InForm Preview.ico.txt
View file

@ -1,7 +0,0 @@
http://www.iconarchive.com/show/modern-xp-icons-by-dtafalonso/ModernXP-69-Window-icon.html
"ModernXP 69 Window Icon"
Artist: dtafalonso
Iconset: Modern XP Icons (76 icons)
License: CC Attribution-Noncommercial-No Derivate 4.0
Commercial usage: Not allowed

7
InForm/InForm.ico.txt
View file

@ -1,7 +0,0 @@
http://www.iconarchive.com/show/matrilineare-icons-by-sora-meliae/Apps-dconf-editor-icon.html
"Apps dconf editor Icon"
Artist: sora-meliae
Iconset: Matrilineare Icons (126 icons)
License: GNU General Public License
Commercial usage: Allowed

BIN
InForm/oknowait.bmp Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 2.3 KiB

143
UiEditor.bas
View file

@ -8,8 +8,9 @@ DIM SHARED RedTextBoxID AS LONG, GreenTextBoxID AS LONG, BlueTextBoxID AS LONG
DIM SHARED ColorPropertiesListID AS LONG, PropertyValueID AS LONG
DIM SHARED UiPreviewPID AS LONG, TotalSelected AS LONG, FirstSelected AS LONG
DIM SHARED PreviewFormID AS LONG, ColorPreviewID AS LONG
DIM SHARED BackStyleListID AS LONG
DIM SHARED BackStyleListID AS LONG, PropertyUpdateStatusID AS LONG
DIM SHARED CheckPreviewTimer AS INTEGER, PreviewAttached AS _BYTE
DIM SHARED PropertyUpdateStatusImage AS LONG, LastKeyPress AS DOUBLE
CONST OffsetEditorPID = 1
CONST OffsetPreviewPID = 5
@ -446,7 +447,11 @@ SUB __UI_BeforeUpdateDisplay
CASE 2 'Caption
__UI_Texts(PropertyValueID) = PreviewCaptions(FirstSelected)
CASE 3 'Text
__UI_Texts(PropertyValueID) = PreviewTexts(FirstSelected)
IF PreviewControls(FirstSelected).Type = __UI_Type_ListBox OR PreviewControls(FirstSelected).Type = __UI_Type_DropdownList THEN
__UI_Texts(PropertyValueID) = __UI_ReplaceText(PreviewTexts(FirstSelected), CHR$(13), "\n", __UI_False, 0)
ELSE
__UI_Texts(PropertyValueID) = PreviewTexts(FirstSelected)
END IF
CASE 4 'Top
__UI_Texts(PropertyValueID) = LTRIM$(STR$(PreviewControls(FirstSelected).Top))
CASE 5 'Left
@ -467,9 +472,64 @@ SUB __UI_BeforeUpdateDisplay
__UI_Texts(PropertyValueID) = LTRIM$(STR$(PreviewControls(FirstSelected).Max))
CASE 13 'Interval
__UI_Texts(PropertyValueID) = LTRIM$(STR$(PreviewControls(FirstSelected).Interval))
CASE 14 'Padding
__UI_Texts(PropertyValueID) = LTRIM$(STR$(PreviewControls(FirstSelected).Padding))
END SELECT
__UI_Controls(PropertyUpdateStatusID).Hidden = __UI_True
ELSE
__UI_CursorAdjustments
DIM PropertyAccept AS _BYTE
SELECT CASE SelectedProperty
CASE 1 'Name
IF LCASE$(__UI_Texts(PropertyValueID)) = LCASE$(RTRIM$(PreviewControls(FirstSelected).Name)) THEN PropertyAccept = __UI_True
CASE 2 'Caption
IF __UI_Texts(PropertyValueID) = PreviewCaptions(FirstSelected) THEN PropertyAccept = __UI_True
CASE 3 'Text
IF PreviewControls(FirstSelected).Type = __UI_Type_ListBox OR PreviewControls(FirstSelected).Type = __UI_Type_DropdownList THEN
IF __UI_ReplaceText(__UI_Texts(PropertyValueID), "\n", CHR$(13), __UI_False, 0) = PreviewTexts(FirstSelected) THEN PropertyAccept = __UI_True
ELSE
IF __UI_Texts(PropertyValueID) = PreviewTexts(FirstSelected) THEN PropertyAccept = __UI_True
END IF
CASE 4 'Top
IF __UI_Texts(PropertyValueID) = LTRIM$(STR$(PreviewControls(FirstSelected).Top)) THEN PropertyAccept = __UI_True
CASE 5 'Left
IF __UI_Texts(PropertyValueID) = LTRIM$(STR$(PreviewControls(FirstSelected).Left)) THEN PropertyAccept = __UI_True
CASE 6 'Width
IF __UI_Texts(PropertyValueID) = LTRIM$(STR$(PreviewControls(FirstSelected).Width)) THEN PropertyAccept = __UI_True
CASE 7 'Height
IF __UI_Texts(PropertyValueID) = LTRIM$(STR$(PreviewControls(FirstSelected).Height)) THEN PropertyAccept = __UI_True
CASE 8 'Font
IF LCASE$(__UI_Texts(PropertyValueID)) = LCASE$(PreviewFonts(FirstSelected)) THEN PropertyAccept = __UI_True
CASE 9 'Tooltip
IF __UI_Texts(PropertyValueID) = PreviewTips(FirstSelected) THEN PropertyAccept = __UI_True
CASE 10 'Value
IF __UI_Texts(PropertyValueID) = LTRIM$(STR$(PreviewControls(FirstSelected).Value)) THEN PropertyAccept = __UI_True
CASE 11 'Min
IF __UI_Texts(PropertyValueID) = LTRIM$(STR$(PreviewControls(FirstSelected).Min)) THEN PropertyAccept = __UI_True
CASE 12 'Max
IF __UI_Texts(PropertyValueID) = LTRIM$(STR$(PreviewControls(FirstSelected).Max)) THEN PropertyAccept = __UI_True
CASE 13 'Interval
IF __UI_Texts(PropertyValueID) = LTRIM$(STR$(PreviewControls(FirstSelected).Interval)) THEN PropertyAccept = __UI_True
CASE 14 'Padding
IF __UI_Texts(PropertyValueID) = LTRIM$(STR$(PreviewControls(FirstSelected).Padding)) THEN PropertyAccept = __UI_True
END SELECT
__UI_Controls(PropertyUpdateStatusID).Hidden = __UI_False
_DEST __UI_Controls(PropertyUpdateStatusID).HelperCanvas
CLS , _RGBA32(0, 0, 0, 0)
IF PropertyAccept AND LEN(RTRIM$(__UI_Texts(PropertyValueID))) > 0 THEN
_PUTIMAGE (0, 0), PropertyUpdateStatusImage, , (0, 0)-STEP(15, 15)
__UI_SetTip "PropertyUpdateStatus", "The property value entered is valid"
ELSEIF LEN(RTRIM$(__UI_Texts(PropertyValueID))) > 0 THEN
IF TIMER - LastKeyPress > .5 THEN
_PUTIMAGE (0, 0), PropertyUpdateStatusImage, , (0, 16)-STEP(15, 15)
__UI_SetTip "PropertyUpdateStatus", "Invalid property value"
ELSE
_PUTIMAGE (0, 0), PropertyUpdateStatusImage, , (0, 32)-STEP(15, 15)
__UI_SetTip "PropertyUpdateStatus", ""
END IF
END IF
_DEST 0
__UI_Controls(PropertyUpdateStatusID).PreviousValue = 0 'Force update
END IF
'Update checkboxes:
@ -502,6 +562,7 @@ SUB __UI_BeforeUpdateDisplay
__UI_Controls(BackStyleListID).Disabled = __UI_True
__UI_ReplaceListBoxItem "PropertiesList", 3, "Text"
__UI_Controls(__UI_GetID("Resizable")).Disabled = __UI_True
__UI_Captions(PropertyValueID) = ""
IF TotalSelected > 0 THEN
SELECT EVERYCASE PreviewControls(FirstSelected).Type
CASE __UI_Type_PictureBox
@ -517,7 +578,7 @@ SUB __UI_BeforeUpdateDisplay
CASE __UI_Type_Frame, __UI_Type_Label
__UI_Controls(BackStyleListID).Disabled = __UI_False
SELECT CASE SelectedProperty
CASE 1, 2, 4, 5, 6, 7, 8, 9
CASE 1, 2, 4, 5, 6, 7, 8, 9, 14
__UI_Controls(PropertyValueID).Disabled = __UI_False
CASE ELSE
__UI_Controls(PropertyValueID).Disabled = __UI_True
@ -582,15 +643,21 @@ SUB __UI_BeforeUpdateDisplay
'Properties relative to the form
__UI_Controls(__UI_GetID("CenteredWindow")).Disabled = __UI_False
__UI_Controls(__UI_GetID("Resizable")).Disabled = __UI_False
__UI_ReplaceListBoxItem "PropertiesList", 3, "Icon"
SELECT CASE SelectedProperty
CASE 1, 2, 6, 7, 8 'Name, Caption, Width, Height, Font
CASE 1, 2, 3, 6, 7, 8 'Name, Caption, Width, Height, Font
__UI_Controls(PropertyValueID).Disabled = __UI_False
CASE ELSE
__UI_Controls(PropertyValueID).Disabled = __UI_True
END SELECT
END IF
IF __UI_Controls(PropertyValueID).Disabled THEN
__UI_Texts(PropertyValueID) = ""
__UI_Captions(PropertyValueID) = "Property not available"
END IF
'Update the color mixer
DIM ThisColor AS _UNSIGNED LONG, ThisBackColor AS _UNSIGNED LONG
@ -701,6 +768,8 @@ SUB __UI_OnLoad
__UI_Controls(__UI_GetID("AddFrame")).HelperCanvas = _NEWIMAGE(16, 16, 32)
i = i + 1: _PUTIMAGE (0, 0), CommControls, __UI_Controls(__UI_GetID("AddFrame")).HelperCanvas, (0, i * 16 - 16)-STEP(15, 15)
PropertyUpdateStatusImage = _LOADIMAGE("InForm\oknowait.bmp", 32)
__UI_ClearColor PropertyUpdateStatusImage, 0, 0
'Properly loaded helper images assign a file name to the control's text property.
'Any text will do for internallly stored images:
@ -728,6 +797,9 @@ SUB __UI_OnLoad
BackStyleListID = __UI_GetID("BackStyleOptions")
ColorPreviewID = __UI_GetID("ColorPreview")
PropertyValueID = __UI_GetID("PropertyValue")
PropertyUpdateStatusID = __UI_GetID("PropertyUpdateStatus")
__UI_Controls(PropertyValueID).FieldArea = __UI_Controls(PropertyValueID).Width / _FONTWIDTH((__UI_Controls(PropertyValueID).Font)) - 4
PreviewAttached = __UI_True
@ -814,29 +886,45 @@ SUB __UI_OnLoad
END SUB
SUB __UI_KeyPress (id AS LONG)
LastKeyPress = TIMER
SELECT CASE UCASE$(RTRIM$(__UI_Controls(id).Name))
CASE "PROPERTYVALUE"
'Send the preview the new property value
DIM FloatValue AS _FLOAT, b$, TempValue AS LONG, i AS LONG
STATIC PreviousValue$
TempValue = __UI_Controls(__UI_GetID("PropertiesList")).Value
SELECT CASE TempValue
CASE 1, 2, 3, 9 'Name, caption, text, tooltips
b$ = MKL$(LEN(__UI_Texts(PropertyValueID))) + __UI_Texts(PropertyValueID)
CASE 4, 5, 6, 7 'Top, left, width, height
b$ = MKI$(VAL(__UI_Texts(PropertyValueID)))
CASE 8 'Font
b$ = MKL$(LEN(__UI_Texts(PropertyValueID))) + __UI_Texts(PropertyValueID)
CASE 10, 11, 12, 13 'Value, min, max, interval
b$ = _MK$(_FLOAT, VAL(__UI_Texts(PropertyValueID)))
END SELECT
SendData b$, TempValue
IF PreviousValue$ <> __UI_Texts(PropertyValueID) THEN
PreviousValue$ = __UI_Texts(PropertyValueID)
TempValue = __UI_Controls(__UI_GetID("PropertiesList")).Value
SELECT CASE TempValue
CASE 1, 2, 3, 9 'Name, caption, text, tooltips
b$ = MKL$(LEN(__UI_Texts(PropertyValueID))) + __UI_Texts(PropertyValueID)
CASE 4, 5, 6, 7, 14 'Top, left, width, height, padding
b$ = MKI$(VAL(__UI_Texts(PropertyValueID)))
IF TempValue = 14 THEN TempValue = 31
CASE 8 'Font
b$ = MKL$(LEN(__UI_Texts(PropertyValueID))) + __UI_Texts(PropertyValueID)
CASE 10, 11, 12, 13 'Value, min, max, interval
b$ = _MK$(_FLOAT, VAL(__UI_Texts(PropertyValueID)))
END SELECT
SendData b$, TempValue
END IF
END SELECT
END SUB
SUB __UI_ValueChanged (id AS LONG)
DIM b$
SELECT EVERYCASE UCASE$(RTRIM$(__UI_Controls(id).Name))
CASE "PROPERTIESLIST"
_DELAY .1 'Give the screen update routine time to finish
IF __UI_Controls(PropertyValueID).Disabled = __UI_False THEN
__UI_Focus = PropertyValueID
IF LEN(__UI_Texts(__UI_Focus)) > 0 THEN
__UI_Controls(__UI_Focus).Cursor = LEN(__UI_Texts(__UI_Focus))
__UI_Controls(__UI_Focus).SelectionStart = 0
__UI_Controls(__UI_Focus).TextIsSelected = __UI_True
END IF
END IF
CASE "ALIGNOPTIONS"
b$ = MKI$(__UI_Controls(__UI_GetID("AlignOptions")).Value - 1)
SendData b$, 22
@ -1207,6 +1295,9 @@ SUB LoadPreview
CASE -30
b$ = SPACE$(2): GET #BinaryFileNum, , b$
PreviewControls(Dummy).HotKeyPosition = CVI(b$)
CASE -31
b$ = SPACE$(2): GET #BinaryFileNum, , b$
PreviewControls(Dummy).Padding = CVI(b$)
CASE -1 'new control
EXIT DO
CASE -1024
@ -1355,6 +1446,10 @@ SUB SaveForm
PRINT #TextFileNum, "'-----------------------------------------------------------"
PRINT #TextFileNum, "SUB __UI_LoadForm"
PRINT #TextFileNum,
IF LEN(PreviewTexts(PreviewFormID)) > 0 THEN
PRINT #TextFileNum, " $EXEICON:'" + PreviewTexts(PreviewFormID) + "'"
PRINT #TextFileNum, " _ICON"
END IF
PRINT #TextFileNum, " DIM __UI_NewID AS LONG"
PRINT #TextFileNum,
b$ = "InForm" + CHR$(1)
@ -1362,12 +1457,14 @@ SUB SaveForm
b$ = MKL$(UBOUND(PreviewControls))
PUT #BinaryFileNum, , b$
'First pass is for the main form and containers (frames and menubars)
'Second pass is for the rest of controls
'First pass is for the main form and containers (frames and menubars).
'Second pass is for the rest of controls.
'Controls named __UI_+anything are ignored, as they are automatically created.
DIM ThisPass AS _BYTE
FOR ThisPass = 1 TO 2
FOR i = 1 TO UBOUND(PreviewControls)
IF PreviewControls(i).ID > 0 AND PreviewControls(i).Type <> __UI_Type_MenuPanel AND PreviewControls(i).Type <> __UI_Type_Font AND LEN(RTRIM$(PreviewControls(i).Name)) > 0 THEN
IF UCASE$(LEFT$(PreviewControls(i).Name, 5)) = "__UI_" THEN GOTO EndOfThisPass 'Internal controls
a$ = " __UI_NewID = __UI_NewControl("
SELECT CASE PreviewControls(i).Type
CASE __UI_Type_Form: a$ = a$ + "__UI_Type_Form, ": IF ThisPass = 2 THEN GOTO EndOfThisPass
@ -1404,11 +1501,11 @@ SUB SaveForm
PUT #BinaryFileNum, , b$
IF LEN(PreviewCaptions(i)) > 0 THEN
IF PreviewControls(i).HotKeyPosition > 0 THEN
a$ = LEFT$(PreviewCaptions(i), PreviewControls(i).HotKeyPosition - 1) + "&" + MID$(PreviewCaptions(i), PreviewControls(i).HotKeyPosition)
ELSE
a$ = PreviewCaptions(i)
END IF
'IF PreviewControls(i).HotKeyPosition > 0 THEN
' a$ = LEFT$(PreviewCaptions(i), PreviewControls(i).HotKeyPosition - 1) + "&" + MID$(PreviewCaptions(i), PreviewControls(i).HotKeyPosition)
'ELSE
' a$ = PreviewCaptions(i)
'END IF
a$ = " __UI_SetCaption " + CHR$(34) + RTRIM$(PreviewControls(i).Name) + CHR$(34) + ", " + __UI_SpecialCharsToCHR$(a$)
b$ = MKI$(-2) + MKL$(LEN(PreviewCaptions(i))) '-2 indicates a caption
PUT #BinaryFileNum, , b$

8
UiEditor.frm
View file

@ -100,15 +100,20 @@ SUB __UI_LoadForm
__UI_AddListBoxItem "PropertiesList", "Min"
__UI_AddListBoxItem "PropertiesList", "Max"
__UI_AddListBoxItem "PropertiesList", "Interval"
__UI_AddListBoxItem "PropertiesList", "Padding (Left/Right)"
__UI_Controls(__UI_NewID).HasBorder = __UI_True
__UI_Controls(__UI_NewID).Value = 1
__UI_Controls(__UI_NewID).Max = 13
__UI_Controls(__UI_NewID).Max = 14
__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_PictureBox, "PropertyUpdateStatus", 16, 16, 430, 23, __UI_GetID("PropertiesFrame"))
__UI_Controls(__UI_NewID).HasBorder = __UI_False
__UI_Controls(__UI_NewID).BackStyle = __UI_Transparent
__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
@ -182,7 +187,6 @@ SUB __UI_LoadForm
__UI_Controls(__UI_NewID).CanHaveFocus = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "ColorPreview", 159, 115, 10, 51, __UI_GetID("ColorMixer"))
__UI_Controls(__UI_NewID).HasBorder = __UI_True
__UI_NewID = __UI_NewControl(__UI_Type_TrackBar, "Red", 198, 40, 191, 17, __UI_GetID("ColorMixer"))
__UI_Controls(__UI_NewID).Max = 255

168
UiEditorPreview.bas
View file

@ -17,6 +17,7 @@ CONST OffsetPropertyChanged = 31
CONST OffsetPropertyValue = 33
DIM SHARED UiPreviewPID AS LONG
DIM SHARED ExeIcon AS LONG
$IF WIN THEN
DECLARE DYNAMIC LIBRARY "kernel32"
@ -29,7 +30,6 @@ $ELSE
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'
@ -178,15 +178,21 @@ SUB __UI_BeforeUpdateDisplay
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
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
@ -202,16 +208,33 @@ SUB __UI_BeforeUpdateDisplay
__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$
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$
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
NEXT
END IF
CASE 4 'Top
b$ = SPACE$(2): GET #UiEditorFile, OffsetPropertyValue, b$
TempValue = CVI(b$)
@ -453,6 +476,16 @@ SUB __UI_BeforeUpdateDisplay
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
@ -588,6 +621,12 @@ SUB LoadPreview
__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
@ -703,6 +742,10 @@ SUB LoadPreview
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
@ -903,6 +946,10 @@ SUB SavePreview
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
@ -919,3 +966,98 @@ SUB SendData (b$, Offset AS LONG)
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

5
UiEditorPreview.frm
View file

@ -1,9 +1,8 @@
'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", 640, 400, 0, 0,0)
__UI_Controls(__UI_NewID).CanResize = __UI_True
END SUB

224
falcon.h Normal file
View file

@ -0,0 +1,224 @@
#include "internal/c/parts/video/font/ttf/src/freetypeamalgam.h"
//The following license applies to utf8decode() and associated data only
// Copyright (c) 2008-2010 Bjoern Hoehrmann <bjoern@hoehrmann.de>
// See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.
/* Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. */
#define UTF8_ACCEPT 0
#define UTF8_REJECT 1
static const uint8_t utf8d[] = {
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 00..1f
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 20..3f
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 40..5f
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 60..7f
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, // 80..9f
7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, // a0..bf
8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, // c0..df
0xa,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x4,0x3,0x3, // e0..ef
0xb,0x6,0x6,0x6,0x5,0x8,0x8,0x8,0x8,0x8,0x8,0x8,0x8,0x8,0x8,0x8, // f0..ff
0x0,0x1,0x2,0x3,0x5,0x8,0x7,0x1,0x1,0x1,0x4,0x6,0x1,0x1,0x1,0x1, // s0..s0
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,0,1,0,1,1,1,1,1,1, // s1..s2
1,2,1,1,1,1,1,2,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1, // s3..s4
1,2,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,3,1,3,1,1,1,1,1,1, // s5..s6
1,3,1,1,1,1,1,3,1,3,1,1,1,1,1,1,1,3,1,1,1,1,1,1,1,1,1,1,1,1,1,1, // s7..s8
};
uint32_t inline
utf8decode(uint32_t* state, uint32_t* codep, uint32_t byte) {
uint32_t type = utf8d[byte];
*codep = (*state != UTF8_ACCEPT) ?
(byte & 0x3fu) | (*codep << 6) :
(0xff >> type) & (byte);
*state = utf8d[256 + *state*16 + type];
return *state;
}
/**************************************************************/
struct fonts_struct { //copied from parts/video/font/ttf/src.c
uint8 in_use;
uint8 *ttf_data;
int32 default_pixel_height;
uint8 bold;
uint8 italic;
uint8 underline;
uint8 monospace;
int32 monospace_width;
uint8 unicode;
//---------------------------------
FT_Face handle;
int32 baseline;
float default_pixel_height_scale;
};
extern img_struct *write_page;
extern int32 *font;
extern fonts_struct *fonts;
FT_Face get_fhandle() {
return fonts[font[write_page->font]].handle;
}
int get_defheight() {
return fonts[font[write_page->font]].default_pixel_height;
}
int gp2px(int gp) {
return (float)gp / get_fhandle()->units_per_EM * get_defheight();
}
int uheight() {
switch (write_page->font) {
case 8: return 9;
case 14: return 15;
case 16: return 17;
}
return gp2px(get_fhandle()->ascender - get_fhandle()->descender);
}
int uascension() {
switch (write_page->font) {
case 8: return 9;
case 14: return 13;
case 16: return 14;
}
return gp2px(get_fhandle()->ascender);
}
int uspacing() {
if (write_page->font < 32) return write_page->font;
return gp2px(get_fhandle()->height) + 2;
}
extern uint8 charset8x8[256][8][8];
extern uint8 charset8x16[256][16][8];
#ifdef QB64_64
void uprint_extra(int32 startx, int32 starty, int64 str_in, int64 bytelen, int32 kern_wanted, int32 do_render, int32 *txtwidth, int64 charpos, int32 *chars, uint32 colour, int32 max_width) {
#else
void uprint_extra(int32 startx, int32 starty, int32 str_in, int64 bytelen, int32 kern_wanted, int32 do_render, int32 *txtwidth, int64 charpos, int32 *chars, uint32 colour, int32 max_width) {
#endif
int builtin = 0;
if (write_page->font < 32) {
builtin = 1;
}
uint8 *str = (uint8 *)str_in;
uint32 cpindex, prev_state = 0, cur_state = 0, cp;
uint8 *builtin_start;
int cur_cpindex = 0;
FT_Face fhandle;
int prev_glyph = 0, glyph_index, error, kern;
FT_Vector kern_delta;
int pen_x, pen_y, draw_x, draw_y, pixmap_x, pixmap_y;
float alpha;
unsigned int rgb;
pen_x = startx;
pen_y = starty;
if (builtin) {
pen_y += 2;
}
else {
fhandle = get_fhandle();
pen_y += uascension();
if (FT_HAS_KERNING(fhandle) && kern_wanted) kern = 1; else kern = 0;
}
alpha = (colour >> 24) / 255.0;
rgb = colour & 0xffffff;
for (cpindex = 0; cpindex < bytelen; prev_state = cur_state, cpindex++) {
//if (pen_x > im->width || pen_y > im->height) break;
if (max_width && (pen_x > startx + max_width)) break;
if (charpos) ((int32*)charpos)[cur_cpindex] = pen_x - startx;
switch (utf8decode(&cur_state, &cp, str[cpindex])) {
case UTF8_ACCEPT:
//good codepoint
cur_cpindex++;
break;
case UTF8_REJECT:
//codepoint would be U+FFFD (replacement character)
cp = 0xfffd;
cur_state = UTF8_ACCEPT;
if (prev_state != UTF8_ACCEPT) cpindex--;
cur_cpindex++;
break;
default:
//need to read continuation bytes
continue;
break;
}
if (builtin) {
if (max_width && (pen_x + 8 > startx + max_width)) break;
if (cp > 255) continue;
switch (write_page->font) {
case 8: builtin_start = &charset8x8[cp][0][0]; break;
case 14: builtin_start = &charset8x16[cp][1][0]; break;
case 16: builtin_start = &charset8x16[cp][0][0]; break;
}
if (do_render) {
for (draw_y = pen_y, pixmap_y = 0; pixmap_y < write_page->font; draw_y++, pixmap_y++) {
for (draw_x = pen_x, pixmap_x = 0; pixmap_x < 8; draw_x++, pixmap_x++) {
if (*builtin_start++) pset_and_clip(draw_x, draw_y, colour);
}
}
}
pen_x += 8;
}
else {
glyph_index = FT_Get_Char_Index(fhandle, cp);
if (kern && prev_glyph && glyph_index) {
FT_Get_Kerning(fhandle, prev_glyph, glyph_index, FT_KERNING_DEFAULT, &kern_delta);
pen_x += gp2px(kern_delta.x);
}
error = FT_Load_Glyph(fhandle, glyph_index, FT_LOAD_DEFAULT);
if (error) continue;
error = FT_Render_Glyph(fhandle->glyph, FT_RENDER_MODE_NORMAL);
if (error) continue;
if (max_width && (pen_x + fhandle->glyph->bitmap.width > startx + max_width)) break;
if (do_render) {
for (draw_y = pen_y - fhandle->glyph->bitmap_top, pixmap_y = 0; pixmap_y < fhandle->glyph->bitmap.rows; draw_y++, pixmap_y++) {
for (draw_x = pen_x + fhandle->glyph->bitmap_left, pixmap_x = 0; pixmap_x < fhandle->glyph->bitmap.width; draw_x++, pixmap_x++) {
pset_and_clip(draw_x, draw_y, ((int)(fhandle->glyph->bitmap.buffer[pixmap_y * fhandle->glyph->bitmap.width + pixmap_x] * alpha) << 24) | rgb);
}
}
}
pen_x += fhandle->glyph->advance.x / 64;
prev_glyph = glyph_index;
}
if (txtwidth) *txtwidth = pen_x - startx;
if (chars) *chars = cur_cpindex;
}
if (charpos) ((int32*)charpos)[cur_cpindex] = pen_x - startx;
}
int32 uprint(int32 startx, int32 starty, char *str_in, int64 bytelen, uint32 colour, int32 max_width) {
int32 txtwidth;
#ifdef QB64_64
uprint_extra(startx, starty, (int64)str_in, bytelen, -1, 1, &txtwidth, 0, 0, colour, max_width);
#else
uprint_extra(startx, starty, (int32)str_in, bytelen, -1, 1, &txtwidth, 0, 0, colour, max_width);
#endif
return txtwidth;
}
int32 uprintwidth(char *str_in, int64 bytelen, int32 max_width) {
int32 txtwidth;
#ifdef QB64_64
uprint_extra(0, 0, (int64)str_in, bytelen, -1, 0, &txtwidth, 0, 0, 0, max_width);
#else
uprint_extra(0, 0, (int32)str_in, bytelen, -1, 0, &txtwidth, 0, 0, 0, max_width);
#endif
return txtwidth;
}

403
xp.uitheme
View file

@ -52,7 +52,7 @@ END FUNCTION
'---------------------------------------------------------------------------------
SUB __UI_DrawButton (This AS __UI_ControlTYPE, ControlState AS _BYTE)
'ControlState: 1 = Normal; 2 = Hover/focus; 3 = Mouse down; 4 = Disabled
DIM TempColor~&, TempCaption$, HasShadow AS _BYTE
DIM TempCaption$, HasShadow AS _BYTE, TempColor~&, Temp&
DIM PrevDest AS LONG, TempControlState AS _BYTE
STATIC ControlImage AS LONG
@ -98,7 +98,7 @@ SUB __UI_DrawButton (This AS __UI_ControlTYPE, ControlState AS _BYTE)
'Icon will be to the left of caption
IconHeight = This.Height - 6
IconWidth = _WIDTH(This.HelperCanvas) * IconHeight / _HEIGHT(This.HelperCanvas)
_PUTIMAGE ((This.Width \ 2 - _PRINTWIDTH(TempCaption$) \ 2) - ((IconWidth / 2) + 5), This.Height / 2 - ((This.Height - 4) / 2) + 1)-STEP(IconWidth - 1, IconHeight - 1), This.HelperCanvas
_PUTIMAGE ((This.Width \ 2 - __UI_PrintWidth&(TempCaption$) \ 2) - ((IconWidth / 2) + 5), This.Height / 2 - ((This.Height - 4) / 2) + 1)-STEP(IconWidth - 1, IconHeight - 1), This.HelperCanvas
ELSE
'Icon will be centered
IconHeight = This.Height - 6
@ -124,17 +124,16 @@ SUB __UI_DrawButton (This AS __UI_ControlTYPE, ControlState AS _BYTE)
_PUTIMAGE (This.Width - 3, This.Height - 3), ControlImage, , (ButtonWidth - 3, TempControlState * ButtonHeight - 3)-STEP(2, 2)
'Caption:
_PRINTMODE _KEEPBACKGROUND
IF NOT This.Disabled THEN
COLOR This.ForeColor, TempColor~&
TempColor~& = This.ForeColor
ELSE
COLOR __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80), TempColor~&
TempColor~& = __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80)
END IF
_PRINTSTRING ((IconWidth / 2) + (This.Width \ 2 - _PRINTWIDTH(TempCaption$) \ 2), ((This.Height \ 2) - _FONTHEIGHT \ 2) + 2), TempCaption$
Temp& = uprint((IconWidth / 2) + (This.Width \ 2 - __UI_PrintWidth&(TempCaption$) \ 2), ((This.Height \ 2) - uspacing& \ 2), TempCaption$, LEN(TempCaption$), TempColor~&, 0)
'Hot key:
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
LINE ((This.Width \ 2 - __UI_PrintWidth&(TempCaption$) \ 2) + This.HotKeyOffset, ((This.Height \ 2) + uspacing& \ 2) + 1)-STEP(__UI_PrintWidth&(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
'Focus outline:
@ -151,7 +150,7 @@ END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawLabel (This AS __UI_ControlTYPE, ControlState AS _BYTE)
DIM PrevDest AS LONG
DIM PrevDest AS LONG, TempColor~&, Temp&
DIM CaptionIndent AS INTEGER, TempCaption$, TempLine$
IF This.ControlState <> ControlState OR __UI_Captions(This.ID) <> __UI_TempCaptions(This.ID) OR This.PreviousParentID <> This.ParentID OR __UI_ForceRedraw THEN
@ -169,81 +168,93 @@ SUB __UI_DrawLabel (This AS __UI_ControlTYPE, ControlState AS _BYTE)
PrevDest = _DEST
_DEST This.Canvas
_FONT (This.Font)
_FONT This.Font
IF This.HasBorder THEN CaptionIndent = 5 ELSE CaptionIndent = 0
IF This.BackStyle = __UI_Opaque THEN
_PRINTMODE _FILLBACKGROUND
CLS , This.BackColor
ELSE
CLS , _RGBA32(0, 0, 0, 0)
_PRINTMODE _KEEPBACKGROUND
END IF
IF NOT This.Disabled THEN
COLOR This.ForeColor, This.BackColor
TempColor~& = This.ForeColor
ELSE
COLOR __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80), This.BackColor
TempColor~& = __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80)
END IF
'Caption:
DIM CaptionLeft AS INTEGER, FindLF&, ThisLine%
DIM CaptionLeft AS INTEGER, FindLF&, FindSep&, ThisLine%
DIM CaptionLeftFirstLine AS INTEGER, TextTop%
DIM TotalLInes AS INTEGER
TempCaption$ = __UI_WordWrap(__UI_Captions(This.ID), This.Width - CaptionIndent * 5, TotalLInes)
IF This.WordWrap AND TotalLInes > 1 THEN
DIM TotalLines AS INTEGER
IF This.WordWrap THEN
TempCaption$ = __UI_WordWrap(__UI_Captions(This.ID), This.Width - ((CaptionIndent + This.Padding) * 2), TotalLines)
DO WHILE LEN(TempCaption$)
ThisLine% = ThisLine% + 1
TextTop% = CaptionIndent + ThisLine% * _FONTHEIGHT - _FONTHEIGHT + 2
FindLF& = INSTR(TempCaption$, CHR$(10))
IF FindLF& > 0 THEN
TempLine$ = LEFT$(TempCaption$, FindLF& - 1)
TempCaption$ = MID$(TempCaption$, FindLF& + 1)
IF TotalLines < This.Height \ uspacing& THEN
'Center vertically if less lines than fits the box
TextTop% = (This.Height \ 2) - ((TotalLines * uspacing& - uspacing&) \ 2) - uspacing& \ 2 + (((ThisLine%) * uspacing& - uspacing&) + 2)
ELSE
TempLine$ = TempCaption$
TempCaption$ = ""
IF ThisLine% = 1 THEN TextTop% = ((This.Height \ 2) - _FONTHEIGHT \ 2)
'Snap to top of the label's boundaries
'if there are more lines than meet the eye
TextTop% = CaptionIndent + ThisLine% * uspacing& - uspacing& + 2
END IF
FindSep& = INSTR(TempCaption$, CHR$(1)) 'Search for soft breaks
FindLF& = INSTR(TempCaption$, CHR$(10)) 'Search for hard breaks
IF (FindSep& > 0 AND FindLF& > 0 AND FindSep& < FindLF&) OR (FindSep& > 0 AND FindLF& = 0) THEN
TempLine$ = LEFT$(TempCaption$, FindSep& - 1)
TempCaption$ = MID$(TempCaption$, FindSep& + 1)
ELSEIF FindSep& = 0 THEN
IF FindLF& > 0 THEN
TempLine$ = LEFT$(TempCaption$, FindLF& - 1)
TempCaption$ = MID$(TempCaption$, FindLF& + 1)
ELSE
TempLine$ = TempCaption$
TempCaption$ = ""
IF ThisLine% = 1 THEN
'Wordwrap was requested, but the caption didn't require it
TextTop% = ((This.Height \ 2) - uspacing& \ 2)
END IF
END IF
END IF
SELECT CASE This.Align
CASE __UI_Left
CaptionLeft = CaptionIndent
CaptionLeft = CaptionIndent + This.Padding
CASE __UI_Center
CaptionLeft = (This.Width \ 2 - _PRINTWIDTH(TempLine$) \ 2)
CaptionLeft = (This.Width \ 2 - __UI_PrintWidth&(TempLine$) \ 2)
CASE __UI_Right
CaptionLeft = (This.Width - _PRINTWIDTH(TempLine$)) - CaptionIndent
CaptionLeft = (This.Width - __UI_PrintWidth&(TempLine$)) - (CaptionIndent + This.Padding)
END SELECT
_PRINTSTRING (CaptionLeft, TextTop%), TempLine$
Temp& = uprint(CaptionLeft, TextTop%, TempLine$, LEN(TempLine$), TempColor~&, 0)
IF ThisLine% = 1 THEN CaptionLeftFirstLine = CaptionLeft
LOOP
'Hot key:
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
LINE (CaptionLeftFirstLine + This.HotKeyOffset, CaptionIndent + uspacing& + 2)-STEP(__UI_PrintWidth&(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
ELSE
TempCaption$ = __UI_Captions(This.ID)
SELECT CASE This.Align
CASE __UI_Left
CaptionLeft = CaptionIndent
CaptionLeft = CaptionIndent + This.Padding
CASE __UI_Center
CaptionLeft = (This.Width \ 2 - _PRINTWIDTH(TempCaption$) \ 2)
CaptionLeft = (This.Width \ 2 - __UI_PrintWidth&(TempCaption$) \ 2)
CASE __UI_Right
CaptionLeft = (This.Width - _PRINTWIDTH(TempCaption$)) - CaptionIndent
CaptionLeft = This.Width - __UI_PrintWidth&(TempCaption$) - (CaptionIndent + This.Padding)
END SELECT
CaptionLeftFirstLine = CaptionLeft
_PRINTSTRING (CaptionLeft, ((This.Height \ 2) - _FONTHEIGHT \ 2)), TempCaption$
Temp& = uprint(CaptionLeft, (This.Height \ 2) - uspacing& \ 2, TempCaption$, LEN(TempCaption$), TempColor~&, 0)
'Hot key:
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
LINE (CaptionLeftFirstLine + This.HotKeyOffset, ((This.Height \ 2) + (uspacing& \ 2)))-STEP(__UI_PrintWidth&(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
END IF
@ -260,7 +271,7 @@ END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawRadioButton (This AS __UI_ControlTYPE, ControlState AS _BYTE)
DIM PrevDest AS LONG
DIM PrevDest AS LONG, Temp&, TempColor~&
DIM CaptionIndent AS INTEGER, TempCaption$
STATIC ControlImage AS LONG
@ -287,18 +298,15 @@ SUB __UI_DrawRadioButton (This AS __UI_ControlTYPE, ControlState AS _BYTE)
PrevDest = _DEST
_DEST This.Canvas
_FONT (This.Font)
_FONT This.Font
'------
IF This.BackStyle = __UI_Opaque THEN
_PRINTMODE _FILLBACKGROUND
CLS , This.BackColor
ELSE
CLS , _RGBA32(0, 0, 0, 0)
_PRINTMODE _KEEPBACKGROUND
END IF
DIM i AS SINGLE, BoxSize%
BoxSize% = 10
DIM i AS SINGLE
CaptionIndent = 0
IF This.HasBorder = __UI_True THEN
@ -313,16 +321,16 @@ SUB __UI_DrawRadioButton (This AS __UI_ControlTYPE, ControlState AS _BYTE)
TempCaption$ = __UI_Captions(This.ID)
IF NOT This.Disabled THEN
COLOR This.ForeColor, This.BackColor
TempColor~& = This.ForeColor
ELSE
COLOR __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80), This.BackColor
TempColor~& = __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80)
END IF
_PRINTSTRING (CaptionIndent, ((This.Height \ 2) - _FONTHEIGHT \ 2) + 1), TempCaption$
Temp& = uprint(CaptionIndent, ((This.Height \ 2) - uspacing& \ 2) + 1, TempCaption$, LEN(TempCaption$), TempColor~&, 0)
'Hot key:
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
LINE (CaptionIndent + This.HotKeyOffset, ((This.Height \ 2) + uspacing& \ 2))-STEP(__UI_PrintWidth(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
'Focus outline
@ -341,7 +349,7 @@ END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawCheckBox (This AS __UI_ControlTYPE, ControlState AS _BYTE)
DIM PrevDest AS LONG
DIM PrevDest AS LONG, TempColor~&, Temp&
DIM CaptionIndent AS INTEGER, TempCaption$
STATIC ControlImage AS LONG
@ -368,19 +376,16 @@ SUB __UI_DrawCheckBox (This AS __UI_ControlTYPE, ControlState AS _BYTE)
PrevDest = _DEST
_DEST This.Canvas
_FONT (This.Font)
_FONT This.Font
'------
IF This.BackStyle = __UI_Opaque THEN
_PRINTMODE _FILLBACKGROUND
CLS , This.BackColor
ELSE
CLS , _RGBA32(0, 0, 0, 0)
_PRINTMODE _KEEPBACKGROUND
END IF
DIM i AS SINGLE, BoxSize%
BoxSize% = 10
DIM i AS SINGLE
CaptionIndent = 0
@ -391,16 +396,16 @@ SUB __UI_DrawCheckBox (This AS __UI_ControlTYPE, ControlState AS _BYTE)
TempCaption$ = __UI_Captions(This.ID)
IF NOT This.Disabled THEN
COLOR This.ForeColor, This.BackColor
TempColor~& = This.ForeColor
ELSE
COLOR __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80), This.BackColor
TempColor~& = __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80)
END IF
_PRINTSTRING (CaptionIndent, ((This.Height \ 2) - _FONTHEIGHT \ 2) + 1), TempCaption$
Temp& = uprint(CaptionIndent, ((This.Height \ 2) - uspacing& \ 2) + 1, TempCaption$, LEN(TempCaption$), TempColor~&, 0)
'Hot key:
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
LINE (CaptionIndent + This.HotKeyOffset, ((This.Height \ 2) + uspacing& \ 2))-STEP(__UI_PrintWidth(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
'Focus outline
@ -418,7 +423,7 @@ END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawProgressBar (This AS __UI_ControlTYPE, ControlState)
DIM PrevDest AS LONG
DIM PrevDest AS LONG, Temp&, TempColor~&
DIM CaptionIndent AS INTEGER, TempCaption$
STATIC ControlImage_Track AS LONG, ControlImage_Chunk AS LONG
@ -490,16 +495,15 @@ SUB __UI_DrawProgressBar (This AS __UI_ControlTYPE, ControlState)
TempCaption$ = ProgressString$
END IF
_PRINTMODE _KEEPBACKGROUND
IF NOT This.Disabled THEN
COLOR This.ForeColor
TempColor~& = This.ForeColor
ELSE
COLOR __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 70)
TempColor~& = __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 70)
END IF
IF _PRINTWIDTH(TempCaption$) < This.Width THEN
_PRINTSTRING (This.Width \ 2 - _PRINTWIDTH(TempCaption$) \ 2, This.Height \ 2 - _FONTHEIGHT \ 2 + 1), TempCaption$
Temp& = __UI_PrintWidth(TempCaption$)
IF Temp& < This.Width THEN
Temp& = uprint(This.Width \ 2 - Temp& \ 2, This.Height \ 2 - uspacing& \ 2 + 1, TempCaption$, LEN(TempCaption$), TempColor~&, 0)
END IF
END IF
'------
@ -593,9 +597,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(__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
IF This.FieldArea = 0 THEN This.FieldArea = This.Width / _FONTWIDTH((This.Font)) - 1
IF This.FirstVisibleLine = 0 THEN This.FirstVisibleLine = 1
IF This.CurrentLine = 0 THEN This.CurrentLine = 1
ELSE
EXIT SUB
END IF
@ -604,9 +610,12 @@ SUB __UI_DrawTextBox (This AS __UI_ControlTYPE, ControlState, ss1 AS LONG, ss2 A
This.FocusState <> (__UI_Focus = This.ID) OR _
__UI_Captions(This.ID) <> __UI_TempCaptions(This.ID) OR _
__UI_Texts(This.ID) <> __UI_TempTexts(This.ID) OR _
(TIMER - SetCursor# > .4 AND __UI_Focus = This.ID) OR _
(TIMER - SetCursor# > .3 AND __UI_Focus = This.ID) OR _
(__UI_SelectionLength <> This.SelectionLength AND __UI_Focus = This.ID) OR _
This.Cursor <> This.PrevCursor OR This.PreviousParentID <> This.ParentID OR _
This.VisibleCursor <> This.PrevVisibleCursor OR _
This.FirstVisibleLine <> This.PrevFirstVisibleLine OR _
This.CurrentLine <> This.PrevCurrentLine OR _
__UI_ForceRedraw THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.ControlState = ControlState
@ -615,8 +624,11 @@ SUB __UI_DrawTextBox (This AS __UI_ControlTYPE, ControlState, ss1 AS LONG, ss2 A
__UI_TempTexts(This.ID) = __UI_Texts(This.ID)
This.SelectionLength = __UI_SelectionLength
This.PrevCursor = This.Cursor
This.PrevVisibleCursor = This.VisibleCursor
IF This.ParentID THEN __UI_Controls(This.ParentID).ChildrenRedrawn = __UI_True
This.PreviousParentID = This.ParentID
This.PrevFirstVisibleLine = This.FirstVisibleLine
This.PrevCurrentLine = This.CurrentLine
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
@ -635,10 +647,7 @@ SUB __UI_DrawTextBox (This AS __UI_ControlTYPE, ControlState, ss1 AS LONG, ss2 A
TempCaption$ = __UI_Captions(This.ID)
CaptionIndent = 0
IF This.HasBorder THEN
CaptionIndent = 5
LINE (0, 0)-STEP(This.Width - 1, This.Height - 1), This.BorderColor, B
END IF
IF This.HasBorder THEN CaptionIndent = 5
IF NOT This.Disabled AND LEN(__UI_Texts(This.ID)) THEN
COLOR This.ForeColor, This.BackColor
@ -646,37 +655,116 @@ SUB __UI_DrawTextBox (This AS __UI_ControlTYPE, ControlState, ss1 AS LONG, ss2 A
COLOR __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80), This.BackColor
END IF
IF ((__UI_Focus = This.ID) OR (This.ID = __UI_PreviousFocus AND __UI_ParentMenu = This.ContextMenuID)) AND NOT This.Disabled THEN
IF LEN(__UI_Texts(This.ID)) THEN
_PRINTSTRING (CaptionIndent, ((This.Height \ 2) - _FONTHEIGHT \ 2)), MID$(__UI_Texts(This.ID), This.InputViewStart, This.FieldArea)
STATIC c AS _UNSIGNED LONG
IF c = 0 THEN
c = _RGBA32(_RED32(This.SelectedBackColor), _GREEN32(This.SelectedBackColor), _BLUE32(This.SelectedBackColor), 70)
END IF
IF NOT This.Multiline THEN
'Single line textbox
IF ((__UI_Focus = This.ID) OR (This.ID = __UI_PreviousFocus AND __UI_ParentMenu = This.ContextMenuID)) AND NOT This.Disabled THEN
IF LEN(__UI_Texts(This.ID)) THEN
__UI_PrintString CaptionIndent, ((This.Height \ 2) - uspacing& \ 2), MID$(__UI_Texts(This.ID), This.InputViewStart, This.FieldArea)
ELSE
__UI_PrintString CaptionIndent, ((This.Height \ 2) - uspacing& \ 2), TempCaption$
END IF
IF This.TextIsSelected THEN
LINE (CaptionIndent + ss1 * _FONTWIDTH, ((This.Height \ 2) - uspacing& \ 2))-STEP(ss2 * _FONTWIDTH, uspacing&), c, BF
END IF
IF TIMER - SetCursor# > .3 THEN
SetCursor# = TIMER
cursorBlink%% = NOT cursorBlink%%
ELSEIF TIMER - __UI_LastInputReceived < .1 THEN
SetCursor# = TIMER
cursorBlink%% = __UI_True
END IF
IF cursorBlink%% THEN
LINE (CaptionIndent + (This.Cursor - (This.InputViewStart - 1)) * _FONTWIDTH, ((This.Height \ 2) - uspacing& \ 2))-STEP(0, uspacing&), _RGB32(0, 0, 0)
END IF
ELSE
_PRINTSTRING (CaptionIndent, ((This.Height \ 2) - _FONTHEIGHT \ 2)), TempCaption$
IF LEN(__UI_Texts(This.ID)) THEN
__UI_PrintString CaptionIndent, ((This.Height \ 2) - uspacing& \ 2), MID$(__UI_Texts(This.ID), 1, This.FieldArea)
ELSE
__UI_PrintString CaptionIndent, ((This.Height \ 2) - uspacing& \ 2), TempCaption$
END IF
END IF
ELSE
'Multi line textbox
DIM ThisLine AS LONG, ThisTop AS INTEGER, TempLine AS STRING
DIM TotalLines AS LONG, i AS LONG, ThisLineStart AS LONG
DIM s1 AS LONG, s2 AS LONG
IF This.TextIsSelected THEN
STATIC c AS _UNSIGNED LONG
IF c = 0 THEN
c = _RGBA32(_RED32(This.SelectedBackColor), _GREEN32(This.SelectedBackColor), _BLUE32(This.SelectedBackColor), 70)
END IF
LINE (CaptionIndent + ss1 * _FONTWIDTH, ((This.Height \ 2) - _FONTHEIGHT \ 2))-STEP(ss2 * _FONTWIDTH, _FONTHEIGHT), c, BF
s1 = This.SelectionStart + 1
s2 = This.Cursor + 1
IF s1 > s2 THEN SWAP s1, s2
END IF
IF TIMER - SetCursor# > .4 THEN
ThisTop = CaptionIndent - uspacing&
TotalLines = __UI_CountLines(This.ID)
IF TIMER - SetCursor# > .3 THEN
SetCursor# = TIMER
cursorBlink%% = NOT cursorBlink%%
ELSEIF TIMER - __UI_LastInputReceived < .1 THEN
SetCursor# = TIMER
cursorBlink%% = __UI_True
END IF
IF cursorBlink%% THEN
LINE (CaptionIndent + (This.Cursor - (This.InputViewStart - 1)) * _FONTWIDTH, ((This.Height \ 2) - _FONTHEIGHT \ 2))-STEP(0, _FONTHEIGHT), _RGB32(0, 0, 0)
END IF
ELSE
IF LEN(__UI_Texts(This.ID)) THEN
_PRINTSTRING (CaptionIndent, ((This.Height \ 2) - _FONTHEIGHT \ 2)), MID$(__UI_Texts(This.ID), 1, This.FieldArea)
dim a$
FOR ThisLine = This.FirstVisibleLine TO TotalLines
IF ThisTop > This.Height THEN EXIT FOR 'Print until out of the box
ThisTop = ThisTop + uspacing&
TempLine = __UI_GetTextBoxLine$(This.ID, ThisLine, ThisLineStart)
IF LEN(TempLine) THEN
__UI_PrintString CaptionIndent, ThisTop, MID$(TempLine, This.InputViewStart)
END IF
IF This.TextIsSelected THEN
IF s1 >= ThisLineStart AND s2 < ThisLineStart + LEN(TempLine) THEN
'Only a portion of this line is selected
LINE (CaptionIndent + __UI_ThisLineChars(s1 - ThisLineStart), ThisTop)-(__UI_ThisLineChars(s2 - ThisLineStart + 1), ThisTop + uspacing& - 1), c, BF
ELSEIF s1 >= ThisLineStart AND s1 <= ThisLineStart + LEN(TempLine) THEN
'The beginning of the selection is in this line waiting to be highlighted.
LINE (CaptionIndent + __UI_ThisLineChars(s1 - ThisLineStart), ThisTop)-STEP(This.Width, uspacing& - 1), c, BF
ELSEIF s1 < ThisLineStart AND s2 > ThisLineStart + LEN(TempLine) THEN
'This whole line is selected
LINE (CaptionIndent, ThisTop)-STEP(This.Width, uspacing& - 1), c, BF
ELSEIF s1< ThisLineStart AND s2 <= ThisLineStart + LEN(TempLine) THEN
'Selection ends in this line
LINE (CaptionIndent, ThisTop)-STEP(__UI_ThisLineChars(s2 - ThisLineStart), uspacing& - 1), c, BF
END IF
END IF
IF ThisLine = This.CurrentLine THEN
IF cursorBlink%% AND __UI_Focus = This.ID AND This.CurrentLine >= This.FirstVisibleLine AND This.CurrentLine <= This.FirstVisibleLine + This.Height \ uspacing& THEN
LINE (CaptionIndent + __UI_ThisLineChars(This.VisibleCursor - (This.InputViewStart - 1)), ThisTop)-STEP(0, uspacing&), _RGB32(0, 0, 0)
END IF
END IF
NEXT
FOR i = __UI_Controls(__UI_Focus).Cursor TO 0 STEP -1
IF MID$(__UI_Texts(__UI_Focus), i, 1) = CHR$(10) OR i = 0 THEN
__UI_Controls(__UI_Focus).VisibleCursor = __UI_Controls(__UI_Focus).Cursor - i
EXIT FOR
END IF
NEXT
IF TotalLines > This.Height \ uspacing& THEN
This.FieldArea = This.Width / _FONTWIDTH((This.Font)) - 3
This.HasVScrollbar = __UI_True
__UI_DrawVScrollBar This, ControlState
ELSE
_PRINTSTRING (CaptionIndent, ((This.Height \ 2) - _FONTHEIGHT \ 2)), TempCaption$
This.HasVScrollbar = __UI_False
END IF
END IF
IF This.HasBorder THEN
LINE (0, 0)-STEP(This.Width - 1, This.Height - 1), This.BorderColor, B
END IF
'------
@ -689,7 +777,7 @@ END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawListBox (This AS __UI_ControlTYPE, ControlState)
DIM PrevDest AS LONG
DIM PrevDest AS LONG, Temp&, TempColor~&
DIM CaptionIndent AS INTEGER, TempCaption$
IF This.ControlState <> ControlState OR This.FocusState <> (__UI_Focus = This.ID) OR This.PreviousValue <> This.Value OR __UI_Texts(This.ID) <> __UI_TempTexts(This.ID) OR This.PreviousInputViewStart <> This.InputViewStart OR This.PreviousParentID <> This.ParentID OR __UI_ForceRedraw THEN
@ -713,8 +801,6 @@ SUB __UI_DrawListBox (This AS __UI_ControlTYPE, ControlState)
_FONT (This.Font)
'------
_PRINTMODE _KEEPBACKGROUND
IF This.BackStyle = __UI_Opaque THEN
CLS , This.BackColor
ELSE
@ -741,38 +827,39 @@ SUB __UI_DrawListBox (This AS __UI_ControlTYPE, ControlState)
TempText$ = ""
END IF
IF ThisItem% >= This.InputViewStart THEN
ThisItemTop% = ((ThisItem% - This.InputViewStart + 1) * _FONTHEIGHT - _FONTHEIGHT) + CaptionIndent
IF ThisItemTop% + _FONTHEIGHT > This.Height THEN EXIT DO
ThisItemTop% = ((ThisItem% - This.InputViewStart + 1) * uspacing& - uspacing&) + CaptionIndent
IF ThisItemTop% + uspacing& > This.Height THEN EXIT DO
LastVisibleItem = LastVisibleItem + 1
IF ThisItem% = This.Value AND __UI_Focus = This.ID THEN __UI_Captions(This.ID) = TempCaption$
IF NOT This.Disabled THEN
COLOR This.ForeColor, This.BackColor
TempColor~& = This.ForeColor
ELSE
COLOR __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80), This.BackColor
TempColor~& = __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80)
END IF
IF ThisItem% = This.Value THEN
IF __UI_Focus = This.ID THEN
COLOR This.SelectedForeColor, This.SelectedBackColor
LINE (CaptionIndent, ThisItemTop% - 1)-STEP(This.Width - CaptionIndent * 2, _FONTHEIGHT), This.SelectedBackColor, BF
LINE (CaptionIndent, ThisItemTop% - 1)-STEP(This.Width - CaptionIndent * 2, uspacing&), This.SelectedBackColor, BF
ELSE
LINE (CaptionIndent, ThisItemTop% - 1)-STEP(This.Width - CaptionIndent * 2, _FONTHEIGHT), _RGBA32(0, 0, 0, 50), BF
LINE (CaptionIndent, ThisItemTop% - 1)-STEP(This.Width - CaptionIndent * 2, uspacing&), _RGBA32(0, 0, 0, 50), BF
END IF
END IF
SELECT CASE This.Align
CASE __UI_Left
_PRINTSTRING (CaptionIndent * 2, ThisItemTop%), TempCaption$
Temp& = uprint(CaptionIndent * 2, ThisItemTop%, TempCaption$, LEN(TempCaption$), TempColor~&, 0)
CASE __UI_Center
_PRINTSTRING ((This.Width \ 2 - _PRINTWIDTH(TempCaption$) \ 2), ThisItemTop%), TempCaption$
Temp& = uprint((This.Width \ 2 - __UI_PrintWidth(TempCaption$) \ 2), ThisItemTop%, TempCaption$, LEN(TempCaption$), TempColor~&, 0)
CASE __UI_Right
_PRINTSTRING ((This.Width - _PRINTWIDTH(TempCaption$)) - CaptionIndent, ThisItemTop%), TempCaption$
Temp& = uprint((This.Width - __UI_PrintWidth(TempCaption$)) - CaptionIndent, ThisItemTop%, TempCaption$, LEN(TempCaption$), TempColor~&, 0)
END SELECT
END IF
LOOP
IF This.LastVisibleItem = 0 THEN This.LastVisibleItem = LastVisibleItem
IF This.Max > This.LastVisibleItem THEN
This.HasVScrollbar = __UI_True
__UI_DrawVScrollBar This, ControlState
@ -812,6 +899,8 @@ SUB __UI_DrawVScrollBar (TempThis AS __UI_ControlTYPE, ControlState AS _BYTE)
This = TempThis
_FONT This.Font
IF This.Type = __UI_Type_ListBox THEN
This.Min = 0
This.Max = This.Max - This.LastVisibleItem
@ -823,6 +912,17 @@ SUB __UI_DrawVScrollBar (TempThis AS __UI_ControlTYPE, ControlState AS _BYTE)
This.ForeColor = _RGB32(61, 116, 255)
This.HasBorder = __UI_True
This.BorderColor = _RGB32(0, 0, 0)
ELSEIF This.Type = __UI_Type_TextBox THEN
This.Min = 0
This.Max = __UI_CountLines(This.ID) - This.Height \ uspacing&
This.Value = This.FirstVisibleLine - 1
This.Left = This.Width - __UI_ScrollbarWidth - 1
This.Top = 1
This.Height = This.Height - 1
This.Width = __UI_ScrollbarWidth
This.ForeColor = _RGB32(61, 116, 255)
This.HasBorder = __UI_True
This.BorderColor = _RGB32(0, 0, 0)
END IF
'Scrollbar measurements:
@ -834,8 +934,6 @@ SUB __UI_DrawVScrollBar (TempThis AS __UI_ControlTYPE, ControlState AS _BYTE)
ThumbTop = This.Top + (TrackHeight - ThumbHeight) * (This.Value / This.Max)
TempThis.ThumbTop = TempThis.Top + ThumbTop + __UI_ScrollbarButtonHeight
_PRINTMODE _KEEPBACKGROUND
'Draw the bar
IF NOT This.Disabled THEN
_PUTIMAGE (This.Left, This.Top)-STEP(ImageWidth_Button - 1, This.Height - 1), ControlImage_Track, , (0, 1 * ImageHeight_Button - ImageHeight_Button)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1)
@ -892,7 +990,7 @@ END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawDropdownList (This AS __UI_ControlTYPE, ControlState)
DIM PrevDest AS LONG
DIM PrevDest AS LONG, Temp&, TempColor~&
DIM CaptionIndent AS INTEGER, TempCaption$
STATIC ControlImage AS LONG
@ -932,15 +1030,13 @@ SUB __UI_DrawDropdownList (This AS __UI_ControlTYPE, ControlState)
PrevDest = _DEST
_DEST This.Canvas
_FONT (This.Font)
_FONT This.Font
'------
IF This.BackStyle = __UI_Opaque THEN
_PRINTMODE _FILLBACKGROUND
CLS , This.BackColor
ELSE
CLS , _RGBA32(0, 0, 0, 0)
_PRINTMODE _KEEPBACKGROUND
END IF
CaptionIndent = 0
@ -965,28 +1061,28 @@ SUB __UI_DrawDropdownList (This AS __UI_ControlTYPE, ControlState)
TempText$ = ""
END IF
IF ThisItem% = This.Value THEN
ThisItemTop% = This.Height \ 2 - _FONTHEIGHT \ 2 + 1
ThisItemTop% = This.Height \ 2 - uspacing& \ 2 + 1
IF ThisItem% = This.Value AND __UI_Focus = This.ID THEN __UI_Captions(This.ID) = TempCaption$
IF NOT This.Disabled THEN
COLOR This.ForeColor, This.BackColor
TempColor~& = This.ForeColor
ELSE
COLOR __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80), This.BackColor
TempColor~& = __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80)
END IF
IF __UI_Focus = This.ID THEN
COLOR This.SelectedForeColor, This.SelectedBackColor
TempColor~& = This.SelectedForeColor
LINE (CaptionIndent, 3)-STEP(This.Width - CaptionIndent * 2, This.Height - 7), This.SelectedBackColor, BF
END IF
SELECT CASE This.Align
CASE __UI_Left
_PRINTSTRING (CaptionIndent * 2, ThisItemTop%), TempCaption$
Temp& = uprint(CaptionIndent * 2, ThisItemTop%, TempCaption$, LEN(TempCaption$), TempColor~&, 0)
CASE __UI_Center
_PRINTSTRING ((This.Width \ 2 - _PRINTWIDTH(TempCaption$) \ 2), ThisItemTop%), TempCaption$
Temp& = uprint((This.Width \ 2 - __UI_PrintWidth(TempCaption$) \ 2), ThisItemTop%, TempCaption$, LEN(TempCaption$), TempColor~&, 0)
CASE __UI_Right
_PRINTSTRING ((This.Width - _PRINTWIDTH(TempCaption$)) - CaptionIndent, ThisItemTop%), TempCaption$
Temp& = uprint((This.Width - __UI_PrintWidth(TempCaption$)) - CaptionIndent, ThisItemTop%, TempCaption$, LEN(TempCaption$), TempColor~&, 0)
END SELECT
EXIT DO
END IF
@ -1035,7 +1131,7 @@ END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawFrame (This AS __UI_ControlTYPE)
DIM TempCaption$, CaptionIndent AS INTEGER
DIM TempCaption$, CaptionIndent AS INTEGER, Temp&, TempColor~&
DIM TempCanvas AS LONG, HWTempCanvas AS LONG
STATIC ControlImage AS LONG
@ -1051,51 +1147,50 @@ SUB __UI_DrawFrame (This AS __UI_ControlTYPE)
This.PreviousValue = This.Value
__UI_TempCaptions(This.ID) = __UI_Captions(This.ID)
TempCanvas = _NEWIMAGE(This.Width, This.Height + _FONTHEIGHT((This.Font)) \ 2, 32)
_FONT This.Font
TempCanvas = _NEWIMAGE(This.Width, This.Height + uspacing& \ 2, 32)
_DEST TempCanvas
_FONT (This.Font)
_FONT This.Font
'------
IF LEN(__UI_Captions(This.ID)) > 0 THEN TempCaption$ = " " + __UI_Captions(This.ID) + " "
_FONT (This.Font)
_FONT This.Font
IF This.Hidden = __UI_False THEN
IF This.BackStyle = __UI_Opaque THEN
_PRINTMODE _FILLBACKGROUND
CLS , This.BackColor
ELSE
CLS , _RGBA32(0, 0, 0, 0)
_PRINTMODE _KEEPBACKGROUND
END IF
CaptionIndent = 0
IF This.HasBorder THEN CaptionIndent = 5
IF NOT This.Disabled THEN
COLOR This.ForeColor, This.BackColor
TempColor~& = This.ForeColor
ELSE
COLOR __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80), This.BackColor
TempColor~& = __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80)
END IF
'This.Canvas holds the children controls' images
_PUTIMAGE (CaptionIndent, CaptionIndent + _FONTHEIGHT((This.Font)) \ 2), This.Canvas, TempCanvas, (CaptionIndent, CaptionIndent)-(This.Width, This.Height)
_PUTIMAGE (CaptionIndent, CaptionIndent + uspacing& \ 2), This.Canvas, TempCanvas, (CaptionIndent, CaptionIndent)-(This.Width, This.Height)
IF This.HasBorder THEN
'Four corners;
_PUTIMAGE (0, _FONTHEIGHT((This.Font)) \ 2), ControlImage, , (0, 0)-STEP(2, 2)
_PUTIMAGE (This.Width - 3, _FONTHEIGHT((This.Font)) \ 2), ControlImage, , (19, 0)-STEP(2, 2)
_PUTIMAGE (0, This.Height + _FONTHEIGHT((This.Font)) \ 2 - 3), ControlImage, , (0, 17)-STEP(2, 2)
_PUTIMAGE (This.Width - 3, This.Height + _FONTHEIGHT((This.Font)) \ 2 - 3), ControlImage, , (19, 17)-STEP(2, 2)
_PUTIMAGE (0, uspacing& \ 2), ControlImage, , (0, 0)-STEP(2, 2)
_PUTIMAGE (This.Width - 3, uspacing& \ 2), ControlImage, , (19, 0)-STEP(2, 2)
_PUTIMAGE (0, This.Height + uspacing& \ 2 - 3), ControlImage, , (0, 17)-STEP(2, 2)
_PUTIMAGE (This.Width - 3, This.Height + uspacing& \ 2 - 3), ControlImage, , (19, 17)-STEP(2, 2)
'Two vertical lines
_PUTIMAGE (0, _FONTHEIGHT((This.Font)) \ 2 + 2)-(0, This.Height + _FONTHEIGHT((This.Font)) \ 2 - 4), ControlImage, , (0, 3)-(0, 16)
_PUTIMAGE (This.Width - 1, _FONTHEIGHT((This.Font)) \ 2 + 2)-(This.Width - 1, This.Height + _FONTHEIGHT((This.Font)) \ 2 - 4), ControlImage, , (0, 3)-(0, 16)
_PUTIMAGE (0, uspacing& \ 2 + 2)-(0, This.Height + uspacing& \ 2 - 4), ControlImage, , (0, 3)-(0, 16)
_PUTIMAGE (This.Width - 1, uspacing& \ 2 + 2)-(This.Width - 1, This.Height + uspacing& \ 2 - 4), ControlImage, , (0, 3)-(0, 16)
'Two horizontal lines
_PUTIMAGE (3, _FONTHEIGHT((This.Font)) \ 2)-STEP(This.Width - 6, 0), ControlImage, , (3, 0)-STEP(15, 0)
_PUTIMAGE (3, This.Height + _FONTHEIGHT((This.Font)) \ 2 - 1)-STEP(This.Width - 6, 0), ControlImage, , (3, 0)-STEP(15, 0)
_PUTIMAGE (3, uspacing& \ 2)-STEP(This.Width - 6, 0), ControlImage, , (3, 0)-STEP(15, 0)
_PUTIMAGE (3, This.Height + uspacing& \ 2 - 1)-STEP(This.Width - 6, 0), ControlImage, , (3, 0)-STEP(15, 0)
END IF
DIM CaptionLeft AS INTEGER
@ -1105,16 +1200,17 @@ SUB __UI_DrawFrame (This AS __UI_ControlTYPE)
CASE __UI_Left
CaptionLeft = CaptionIndent
CASE __UI_Center
CaptionLeft = (This.Width \ 2 - _PRINTWIDTH(TempCaption$) \ 2)
CaptionLeft = (This.Width \ 2 - __UI_PrintWidth(TempCaption$) \ 2)
CASE __UI_Right
CaptionLeft = (This.Width - _PRINTWIDTH(TempCaption$)) - CaptionIndent
CaptionLeft = (This.Width - __UI_PrintWidth(TempCaption$)) - CaptionIndent
END SELECT
_PRINTSTRING (CaptionLeft, 0), TempCaption$
Temp& = uprint(CaptionLeft, 0, TempCaption$, LEN(TempCaption$), TempColor~&, 0)
'Hot key:
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
Temp& = __UI_PrintWidth(CHR$(This.HotKey))
LINE (CaptionLeft + Temp& + This.HotKeyOffset, 0 + uspacing&)-STEP(Temp& - 1, 0), This.ForeColor
END IF
END IF
END IF
@ -1126,12 +1222,14 @@ SUB __UI_DrawFrame (This AS __UI_ControlTYPE)
_DEST 0
END IF
_PUTIMAGE (This.Left, This.Top - _FONTHEIGHT((This.Font)) \ 2), This.HelperCanvas
_FONT This.Font
_PUTIMAGE (This.Left, This.Top - uspacing& \ 2), This.HelperCanvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawMenuBar (This AS __UI_ControlTYPE, ControlState AS _BYTE)
DIM PrevDest AS LONG, CaptionIndent AS INTEGER, TempCaption$
DIM Temp&, TempColor~&
IF This.FocusState <> (__UI_Focus = This.ID) OR This.Value <> This.PreviousValue OR This.ControlState <> ControlState OR __UI_Captions(This.ID) <> __UI_TempCaptions(This.ID) OR __UI_ForceRedraw THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
@ -1157,30 +1255,28 @@ SUB __UI_DrawMenuBar (This AS __UI_ControlTYPE, ControlState AS _BYTE)
'---
CLS , This.BackColor
_PRINTMODE _KEEPBACKGROUND
DIM i AS INTEGER, c AS _UNSIGNED LONG
DIM i AS INTEGER
TempCaption$ = __UI_Captions(This.ID)
IF __UI_Focus = This.ID OR _
(__UI_ParentMenu = This.ID AND (__UI_Controls(__UI_Focus).Type = __UI_Type_MenuPanel OR __UI_Controls(__UI_Focus).Type = __UI_Type_MenuItem)) OR _
(__UI_HoveringID = This.ID AND (__UI_Controls(__UI_Focus).Type <> __UI_Type_MenuPanel AND __UI_Controls(__UI_Focus).Type <> __UI_Type_MenuBar AND __UI_Controls(__UI_Focus).Type <> __UI_Type_MenuItem)) THEN
LINE (0, 0)-STEP(This.Width - 1, This.Height - 1), This.SelectedBackColor, BF
c = This.SelectedForeColor
TempColor~& = This.SelectedForeColor
ELSE
c = This.ForeColor
TempColor~& = This.ForeColor
END IF
IF This.Disabled THEN
c = __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80)
TempColor~& = __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80)
END IF
COLOR c
_PRINTSTRING (__UI_MenuBarOffset, ((This.Height \ 2) - _FONTHEIGHT \ 2)), TempCaption$
Temp& = uprint(__UI_MenuBarOffset, ((This.Height \ 2) - uspacing& \ 2), TempCaption$, LEN(TempCaption$), TempColor~&, 0)
IF This.HotKey > 0 AND ((__UI_AltIsDown OR __UI_Controls(__UI_Focus).Type = __UI_Type_MenuBar) OR __UI_DesignMode) THEN
'Has "hot-key"
LINE (__UI_MenuBarOffset + This.HotKeyOffset, ((This.Height \ 2) + _FONTHEIGHT \ 2) - 1)-STEP(_PRINTWIDTH(CHR$(This.HotKey)) - 1, 0), c
Temp& = __UI_PrintWidth(CHR$(This.HotKey))
LINE (__UI_MenuBarOffset + This.HotKeyOffset, ((This.Height \ 2) + uspacing& \ 2) - 1)-STEP(Temp& - 1, 0), TempColor~&
END IF
'---
@ -1194,6 +1290,7 @@ END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawMenuPanel (This AS __UI_ControlTYPE, ControlState AS _BYTE)
DIM PrevDest AS LONG, CaptionIndent AS INTEGER, TempCaption$
DIM TempColor~&, Temp&
DIM CheckMarkIndex AS _BYTE
STATIC ControlImage AS LONG
@ -1223,13 +1320,12 @@ SUB __UI_DrawMenuPanel (This AS __UI_ControlTYPE, ControlState AS _BYTE)
'---
COLOR , _RGBA32(0, 0, 0, 0)
CLS
_PRINTMODE _KEEPBACKGROUND
'White panel:
__UI_ShadowBox 0, 0, This.Width - 1, This.Height - 1, _RGB32(255, 255, 255), 40, 5
LINE (0, 0)-STEP(This.Width - 1, This.Height - 1), This.BorderColor, B
DIM i AS LONG, c AS _UNSIGNED LONG, HasSeparator as _BYTE
DIM i AS LONG, HasSeparator as _BYTE
FOR i = 1 TO UBOUND(__UI_Controls)
IF __UI_Controls(i).Type = __UI_Type_MenuItem AND NOT __UI_Controls(i).Hidden AND __UI_Controls(i).ParentID = __UI_ParentMenu THEN
TempCaption$ = __UI_Captions(i)
@ -1243,25 +1339,24 @@ SUB __UI_DrawMenuPanel (This AS __UI_ControlTYPE, ControlState AS _BYTE)
IF __UI_Focus = i OR (__UI_HoveringID = i AND __UI_Focus = i) THEN
LINE (3, __UI_Controls(i).Top)-STEP(This.Width - 7, __UI_Controls(i).Height - 1), This.SelectedBackColor, BF
c = This.SelectedForeColor
TempColor~& = This.SelectedForeColor
CheckMarkIndex = 2
ELSE
c = This.ForeColor
TempColor~& = This.ForeColor
CheckMarkIndex = 1
END IF
IF __UI_Controls(i).Disabled THEN
c = __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80)
TempColor~& = __UI_Darken(__UI_Controls(__UI_FormID).BackColor, 80)
CheckMarkIndex = 3
END IF
COLOR c
_PRINTSTRING (__UI_Controls(i).Left + __UI_MenuItemOffset, __UI_Controls(i).Top + __UI_Controls(i).Height \ 2 - _FONTHEIGHT \ 2), TempCaption$
Temp& = uprint(__UI_Controls(i).Left + __UI_MenuItemOffset, __UI_Controls(i).Top + __UI_Controls(i).Height \ 2 - uspacing& \ 2, TempCaption$, LEN(TempCaption$), TempColor~&, 0)
IF __UI_Controls(i).HotKey > 0 THEN
'Has "hot-key"
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
Temp& = __UI_PrintWidth(CHR$(__UI_Controls(i).HotKey))
LINE (__UI_Controls(i).Left + __UI_MenuItemOffset + __UI_Controls(i).HotKeyOffset, __UI_Controls(i).Top + __UI_Controls(i).Height \ 2 + uspacing& \ 2 - 1)-STEP(Temp& - 1, 0), TempColor~&
END IF
IF __UI_Controls(i).Value = __UI_True THEN