1
1
Fork 0
mirror of https://github.com/FellippeHeitor/InForm.git synced 2024-05-12 06:50:12 +00:00
InForm/InForm/InForm.ui
2023-05-09 02:23:53 +05:30

8698 lines
451 KiB
XML

'InForm - GUI library for QB64
'Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
'------------------------------------------------------------------------------
'Control types:
FUNCTION __UI_Type_Form%%:__UI_Type_Form%% = 1: END FUNCTION
FUNCTION __UI_Type_Frame%%: __UI_Type_Frame%% = 2: END FUNCTION
FUNCTION __UI_Type_Button%%: __UI_Type_Button%% = 3: END FUNCTION
FUNCTION __UI_Type_Label%%: __UI_Type_Label%% = 4: END FUNCTION
FUNCTION __UI_Type_CheckBox%%: __UI_Type_CheckBox%% = 5: END FUNCTION
FUNCTION __UI_Type_RadioButton%%: __UI_Type_RadioButton%% = 6: END FUNCTION
FUNCTION __UI_Type_TextBox%%: __UI_Type_TextBox%% = 7: END FUNCTION
FUNCTION __UI_Type_ProgressBar%%: __UI_Type_ProgressBar%% = 8: END FUNCTION
FUNCTION __UI_Type_ListBox%%: __UI_Type_ListBox%% = 9: END FUNCTION
FUNCTION __UI_Type_DropdownList%%: __UI_Type_DropdownList%% = 10: END FUNCTION
FUNCTION __UI_Type_MenuBar%%: __UI_Type_MenuBar%% = 11: END FUNCTION
FUNCTION __UI_Type_MenuItem%%: __UI_Type_MenuItem%% = 12: END FUNCTION
FUNCTION __UI_Type_MenuPanel%%: __UI_Type_MenuPanel%% = 13: END FUNCTION
FUNCTION __UI_Type_PictureBox%%: __UI_Type_PictureBox%% = 14: END FUNCTION
FUNCTION __UI_Type_TrackBar%%: __UI_Type_TrackBar%% = 15: END FUNCTION
FUNCTION __UI_Type_ContextMenu%%: __UI_Type_ContextMenu%% = 16: END FUNCTION
FUNCTION __UI_Type_Font%%: __UI_Type_Font%% = 17: END FUNCTION
FUNCTION __UI_Type_ToggleSwitch%%: __UI_Type_ToggleSwitch%% = 18: END FUNCTION
'Back styles:
FUNCTION __UI_Opaque%%: __UI_Opaque%% = 0: END FUNCTION
FUNCTION __UI_Transparent%%: __UI_Transparent%% = -1: END FUNCTION
'Text alignment
FUNCTION __UI_Left%%: __UI_Left%% = 0: END FUNCTION
FUNCTION __UI_Center%%: __UI_Center%% = 1: END FUNCTION
FUNCTION __UI_Right%%: __UI_Right%% = 2: END FUNCTION
FUNCTION __UI_Top%%: __UI_Top%% = 0: END FUNCTION
FUNCTION __UI_Middle%%: __UI_Middle%% = 1: END FUNCTION
FUNCTION __UI_Bottom%%: __UI_Bottom%% = 2: END FUNCTION
'Textbox controls
FUNCTION __UI_NumericWithoutBounds%%: __UI_NumericWithoutBounds%% = True: END FUNCTION
FUNCTION __UI_NumericWithBounds%%: __UI_NumericWithBounds%% = 2: END FUNCTION
'BulletStyle
FUNCTION __UI_CheckMark%%: __UI_CheckMark%% = 0: END FUNCTION
FUNCTION __UI_Bullet%%: __UI_Bullet%% = 1: END FUNCTION
'General constants
FUNCTION __UI_ToolTipTimeOut!: __UI_ToolTipTimeOut! = .8: END FUNCTION
FUNCTION __UI_CantResizeV%%: __UI_CantResizeV%% = 1: END FUNCTION
FUNCTION __UI_CantResizeH%%: __UI_CantResizeH%% = 2: END FUNCTION
FUNCTION __UI_CantResize%%: __UI_CantResize%% = 3: END FUNCTION
'---------------------------------------------------------------------------------
' a740g: Check if this has the expected behavior 'cause _UFONTHEIGHT actually returns the true font height for built-in fonts
FUNCTION uspacing&
uspacing& = _UFONTHEIGHT + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset)
END FUNCTION
'---------------------------------------------------------------------------------
SUB __UI_InternalMenus
'Internal "design mode" context menu. -------------------------------------------
DIM __UI_NewID AS LONG
__UI_NewID = __UI_NewControl(__UI_Type_ContextMenu, "__UI_PreviewMenu", 0, 0, 0, 0, 0)
Control(__UI_NewID).Font = SetFont("segoeui.ttf?arial.ttf?/Library/Fonts/Arial.ttf?InForm/resources/NotoMono-Regular.ttf?cour.ttf", 12)
'Hotkeys available:
'F, J, K, Q
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuNewMenuBar", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuNewMenuBar"), "New &MenuBar control"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuNewContextMenu", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuNewContextMenu"), "New ContextMen&u control-"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuShowInvisibleControls", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuShowInvisibleControls"), "Sho&w invisible controls-"
ToolTip(__UI_NewID) = "Toogles the display of invisible items (e.g. ContextMenu controls)"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuSetDefaultButton", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuSetDefaultButton"), "&Set as default button-"
ToolTip(__UI_NewID) = "The default button can be triggered with Enter even if it doesn't have focus at run time."
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuBindControls", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuBindControls"), "Bind selected controls...-"
ToolTip(__UI_NewID) = "Binds a control's property to another control's property."
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuConvertType", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuConvertType"), "Co&nvert to type-"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuImageOriginalSize", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuImageOriginalSize"), "Restore &image dimensions-"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuNumericOnly", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuNumericOnly"), "Validate .Min/.Ma&x bounds-"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuAlignLeft", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuAlignLeft"), "Align &Left"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuAlignRight", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuAlignRight"), "Align &Right"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuAlignTops", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuAlignTops"), "Align T&op"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuAlignBottoms", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuAlignBottoms"), "Align &Bottom-"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuAlignCentersV", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuAlignCentersV"), "Align cent&ers Vertically"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuAlignCentersH", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuAlignCentersH"), "Ali&gn centers Horizontally"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuAlignCenterV", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuAlignCenterV"), "Center &Vertically (group)"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuAlignCenterH", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuAlignCenterH"), "Center &Horizontally (group)-"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuDistributeV", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuDistributeV"), "Distribute Verticall&y"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuDistributeH", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuDistributeH"), "Distribute Hori&zontally-"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuCut", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuCut"), "Cu&t"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuCopy", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuCopy"), "&Copy"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuPaste", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuPaste"), "&Paste"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuDelete", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuDelete"), "&Delete-"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_PreviewMenuSelect", 0, 0, 0, 0, __UI_GetID("__UI_PreviewMenu"))
SetCaption __UI_GetID("__UI_PreviewMenuSelect"), "Select &All"
DIM prevDest AS LONG
prevDest = _DEST
'Draw Align menu icons
Control(__UI_GetID("__UI_PreviewMenuAlignLeft")).HelperCanvas = _NEWIMAGE(48, 16, 32)
_DEST Control(__UI_GetID("__UI_PreviewMenuAlignLeft")).HelperCanvas
'Normal state
LINE (0, 0)-(1, 16), _RGB32(105, 105, 105), BF
LINE (3, 2)-(14, 7), _RGB32(255, 255, 255), BF
LINE (3, 2)-(14, 7), _RGB32(105, 105, 105), B
LINE (3, 10)-(10, 14), _RGB32(105, 105, 105), BF
'Hovered
LINE (16, 0)-STEP(1, 16), _RGB32(255, 255, 255), BF
LINE (19, 2)-STEP(11, 5), _RGB32(105, 105, 105), BF
LINE (19, 2)-STEP(11, 5), _RGB32(255, 255, 255), B
LINE (19, 10)-STEP(7, 4), _RGB32(255, 255, 255), BF
'Disabled
LINE (32, 0)-STEP(1, 16), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
LINE (35, 2)-STEP(11, 5), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
LINE (35, 2)-STEP(11, 5), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), B
LINE (35, 10)-STEP(7, 4), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
Control(__UI_GetID("__UI_PreviewMenuAlignRight")).HelperCanvas = _NEWIMAGE(48, 16, 32)
_DEST Control(__UI_GetID("__UI_PreviewMenuAlignRight")).HelperCanvas
'Normal state
LINE (14, 0)-STEP(1, 16), _RGB32(105, 105, 105), BF
LINE (1, 2)-STEP(11, 5), _RGB32(255, 255, 255), BF
LINE (1, 2)-STEP(11, 5), _RGB32(105, 105, 105), B
LINE (5, 10)-STEP(7, 4), _RGB32(105, 105, 105), BF
'Hovered
LINE (14 + 16, 0)-STEP(1, 16), _RGB32(255, 255, 255), BF
LINE (1 + 16, 2)-STEP(11, 5), _RGB32(105, 105, 105), BF
LINE (1 + 16, 2)-STEP(11, 5), _RGB32(255, 255, 255), B
LINE (5 + 16, 10)-STEP(7, 4), _RGB32(255, 255, 255), BF
'Disabled
LINE (14 + 32, 0)-STEP(1, 16), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
LINE (1 + 32, 2)-STEP(11, 5), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
LINE (1 + 32, 2)-STEP(11, 5), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), B
LINE (5 + 32, 10)-STEP(7, 4), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
Control(__UI_GetID("__UI_PreviewMenuAlignTops")).HelperCanvas = _NEWIMAGE(48, 16, 32)
_DEST Control(__UI_GetID("__UI_PreviewMenuAlignTops")).HelperCanvas
'Normal
LINE (0, 0)-STEP(16, 1), _RGB32(105, 105, 105), BF
LINE (2, 3)-STEP(5, 11), _RGB32(255, 255, 255), BF
LINE (2, 3)-STEP(4, 11), _RGB32(105, 105, 105), B
LINE (9, 3)-STEP(4, 7), _RGB32(105, 105, 105), BF
'Hovered
LINE (0 + 16, 0)-STEP(16, 1), _RGB32(255, 255, 255), BF
LINE (2 + 16, 3)-STEP(5, 11), _RGB32(105, 105, 105), BF
LINE (2 + 16, 3)-STEP(4, 11), _RGB32(255, 255, 255), B
LINE (9 + 16, 3)-STEP(4, 7), _RGB32(255, 255, 255), BF
'Disabled
LINE (0 + 32, 0)-STEP(16, 1), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
LINE (2 + 32, 3)-STEP(5, 11), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
LINE (2 + 32, 3)-STEP(4, 11), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), B
LINE (9 + 32, 3)-STEP(4, 7), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
Control(__UI_GetID("__UI_PreviewMenuAlignBottoms")).HelperCanvas = _NEWIMAGE(48, 16, 32)
_DEST Control(__UI_GetID("__UI_PreviewMenuAlignBottoms")).HelperCanvas
'Normal
LINE (0, 14)-STEP(16, 1), _RGB32(105, 105, 105), BF
LINE (2, 1)-STEP(5, 11), _RGB32(255, 255, 255), BF
LINE (2, 1)-STEP(5, 11), _RGB32(105, 105, 105), B
LINE (9, 5)-STEP(4, 7), _RGB32(105, 105, 105), BF
'Hovered
LINE (0 + 16, 14)-STEP(16, 1), _RGB32(255, 255, 255), BF
LINE (2 + 16, 1)-STEP(5, 11), _RGB32(105, 105, 105), BF
LINE (2 + 16, 1)-STEP(5, 11), _RGB32(255, 255, 255), B
LINE (9 + 16, 5)-STEP(4, 7), _RGB32(255, 255, 255), BF
'Disabled
LINE (0 + 32, 14)-STEP(16, 1), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
LINE (2 + 32, 1)-STEP(5, 11), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
LINE (2 + 32, 1)-STEP(5, 11), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), B
LINE (9 + 32, 5)-STEP(4, 7), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
Control(__UI_GetID("__UI_PreviewMenuAlignCentersV")).HelperCanvas = _NEWIMAGE(48, 16, 32)
_DEST Control(__UI_GetID("__UI_PreviewMenuAlignCentersV")).HelperCanvas
'Normal
LINE (0, 7)-STEP(16, 1), _RGB32(105, 105, 105), BF
LINE (2, 2)-STEP(5, 11), _RGB32(255, 255, 255), BF
LINE (2, 2)-STEP(5, 11), _RGB32(105, 105, 105), B
LINE (9, 4)-STEP(4, 7), _RGB32(105, 105, 105), BF
'Hovered
LINE (0 + 16, 7)-STEP(16, 1), _RGB32(255, 255, 255), BF
LINE (2 + 16, 2)-STEP(5, 11), _RGB32(105, 105, 105), BF
LINE (2 + 16, 2)-STEP(5, 11), _RGB32(255, 255, 255), B
LINE (9 + 16, 4)-STEP(4, 7), _RGB32(255, 255, 255), BF
'Disabled
LINE (0 + 32, 7)-STEP(16, 1), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
LINE (2 + 32, 2)-STEP(5, 11), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
LINE (2 + 32, 2)-STEP(5, 11), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), B
LINE (9 + 32, 4)-STEP(4, 7), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
Control(__UI_GetID("__UI_PreviewMenuAlignCentersH")).HelperCanvas = _NEWIMAGE(48, 16, 32)
_DEST Control(__UI_GetID("__UI_PreviewMenuAlignCentersH")).HelperCanvas
'Normal
LINE (7, 0)-STEP(1, 16), _RGB32(105, 105, 105), BF
LINE (2, 2)-STEP(11, 5), _RGB32(255, 255, 255), BF
LINE (2, 2)-STEP(11, 5), _RGB32(105, 105, 105), B
LINE (4, 9)-STEP(7, 4), _RGB32(105, 105, 105), BF
'Hovered
LINE (7 + 16, 0)-STEP(1, 16), _RGB32(255, 255, 255), BF
LINE (2 + 16, 2)-STEP(11, 5), _RGB32(105, 105, 105), BF
LINE (2 + 16, 2)-STEP(11, 5), _RGB32(255, 255, 255), B
LINE (4 + 16, 9)-STEP(7, 4), _RGB32(255, 255, 255), BF
'Disabled
LINE (7 + 32, 0)-STEP(1, 16), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
LINE (2 + 32, 2)-STEP(11, 5), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
LINE (2 + 32, 2)-STEP(11, 5), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), B
LINE (4 + 32, 9)-STEP(7, 4), Darken(__UI_DefaultColor(__UI_Type_Form, 2), 80), BF
_DEST prevDest
END SUB
'---------------------------------------------------------------------------------
SUB SetFrameRate(FPS AS _UNSIGNED INTEGER)
IF FPS >= 30 THEN
__UI_FrameRate = 1 / FPS
ELSE
__UI_FrameRate = 1 / 30
END IF
IF __UI_RefreshTimer = 0 THEN
__UI_RefreshTimer = _FREETIMER
ON TIMER(__UI_RefreshTimer, __UI_FrameRate) __UI_UpdateDisplay
ELSE
TIMER(__UI_RefreshTimer) OFF
TIMER(__UI_RefreshTimer) FREE
__UI_RefreshTimer = _FREETIMER
ON TIMER(__UI_RefreshTimer, __UI_FrameRate) __UI_UpdateDisplay
TIMER(__UI_RefreshTimer) ON
END IF
END SUB
'---------------------------------------------------------------------------------
SUB SetFocus(id AS LONG)
IF __UI_Focus = id THEN EXIT SUB
IF Control(id).CanHaveFocus = False OR Control(id).Hidden = True OR Control(id).Disabled = True THEN EXIT SUB
__UI_Focus = id
IF Control(id).Type = __UI_Type_TextBox THEN
IF Control(id).BypassSelectOnFocus = False THEN
Control(id).TextIsSelected = True
Control(id).SelectionStart = 0
Control(id).Cursor = LEN(Text(id))
END IF
END IF
END SUB
'---------------------------------------------------------------------------------
SUB __UI_Init
DIM i AS LONG, b$
SetFrameRate 60
__UI_BeforeInit
IF __UI_KeepScreenHidden = False THEN _SCREENSHOW
IF __UI_FormID = 0 THEN SYSTEM
SCREEN _NEWIMAGE(Control(__UI_FormID).Width, Control(__UI_FormID).Height, 32)
COLOR Control(__UI_FormID).ForeColor, Control(__UI_FormID).BackColor
IF Control(__UI_FormID).Font > 0 THEN _FONT Control(__UI_FormID).Font
b$ = "Initializing..."
GOSUB ShowMessage
_ICON
_TITLE "InForm"
IF Control(__UI_FormID).CenteredWindow THEN _SCREENMOVE _MIDDLE
IF Control(__UI_FormID).Font = 0 THEN Control(__UI_FormID).Font = SetFont("", 8)
IF Caption(__UI_FormID) = "" THEN Caption(__UI_FormID) = RTRIM$(Control(__UI_FormID).Name)
IF NOT __UI_DesignMode THEN
'Internal "text field" context menus. -------------------------------------------
DIM __UI_NewID AS LONG
__UI_NewID = __UI_NewControl(__UI_Type_ContextMenu, "__UI_TextFieldMenu", 0, 0, 0, 0, 0)
FOR i = 1 TO UBOUND(Control)
IF Control(i).Type = __UI_Type_TextBox AND Control(i).ContextMenuID = 0 THEN
Control(i).ContextMenuID = __UI_NewID
END IF
NEXT
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_TextMenuCut", 0, 0, 0, 0, __UI_GetID("__UI_TextFieldMenu"))
SetCaption __UI_GetID("__UI_TextMenuCut"), "Cu&t"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_TextMenuCopy", 0, 0, 0, 0, __UI_GetID("__UI_TextFieldMenu"))
SetCaption __UI_GetID("__UI_TextMenuCopy"), "&Copy"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_TextMenuPaste", 0, 0, 0, 0, __UI_GetID("__UI_TextFieldMenu"))
SetCaption __UI_GetID("__UI_TextMenuPaste"), "&Paste"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_TextMenuDelete", 0, 0, 0, 0, __UI_GetID("__UI_TextFieldMenu"))
SetCaption __UI_GetID("__UI_TextMenuDelete"), "&Delete-"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "__UI_TextMenuSelect", 0, 0, 0, 0, __UI_GetID("__UI_TextFieldMenu"))
SetCaption __UI_GetID("__UI_TextMenuSelect"), "Select &all"
END IF
_DISPLAYORDER _SOFTWARE, _HARDWARE
_DISPLAY
__UI_AssignIDs
__UI_OnLoad
__UI_EventsTimer = _FREETIMER
ON TIMER(__UI_EventsTimer, .016) __UI_DoEvents
TIMER(__UI_EventsTimer) ON
TIMER(__UI_RefreshTimer) ON
__UI_AutoRefresh = True
__UI_Loaded = True
EXIT SUB
ShowMessage:
CLS
__UI_PrintString _WIDTH / 2 - _PRINTWIDTH(b$) / 2, _HEIGHT / 2 - _FONTHEIGHT / 2, b$
_DISPLAY
RETURN
END SUB
'---------------------------------------------------------------------------------
'Internal procedures: ------------------------------------------------------------
'---------------------------------------------------------------------------------
FUNCTION __UI_GetProperMouseButton%%(Which%%)
$IF WIN THEN
IF GetSystemMetrics(__UI_SM_SWAPBUTTON) = 0 THEN
__UI_GetProperMouseButton%% = _MOUSEBUTTON(Which%%)
ELSE
IF Which%% = 1 THEN
__UI_GetProperMouseButton%% = _MOUSEBUTTON(2)
ELSEIF Which%% = 2 THEN
__UI_GetProperMouseButton%% = _MOUSEBUTTON(1)
END IF
END IF
__UI_MouseButtonsSwap = False
$ELSE
IF __UI_MouseButtonsSwap THEN
IF Which%% = 1 THEN
__UI_GetProperMouseButton%% = _MOUSEBUTTON(2)
ELSEIF Which%% = 2 THEN
__UI_GetProperMouseButton%% = _MOUSEBUTTON(1)
END IF
ELSE
__UI_GetProperMouseButton%% = _MOUSEBUTTON(Which%%)
END IF
$END IF
END FUNCTION
SUB __UI_ProcessInput
DIM OldScreen&, i AS LONG, j AS LONG
DIM ContainerOffsetTop AS INTEGER, ContainerOffsetLeft AS INTEGER
STATIC __UI_CurrentResizeStatus AS _BYTE, __UI_CurrentBackColor AS _UNSIGNED LONG
__UI_HasInput = False
__UI_ExitTriggered = _EXIT
IF __UI_ExitTriggered AND 1 THEN __UI_ExitTriggered = True: __UI_HasInput = True
IF _SCREENX = -32000 AND _SCREENY = -32000 THEN
'Window was minimized
EXIT SUB
END IF
'Mouse input (optimization kindly provided by Luke Ceddia):
__UI_MouseWheel = 0
IF __UI_MouseIsDown THEN __UI_HasInput = True
IF _MOUSEINPUT THEN
__UI_HasInput = True
__UI_MouseWheel = __UI_MouseWheel + _MOUSEWHEEL
IF __UI_GetProperMouseButton%%(1) = __UI_MouseButton1 AND __UI_GetProperMouseButton%%(2) = __UI_MouseButton2 THEN
DO WHILE _MOUSEINPUT
__UI_MouseWheel = __UI_MouseWheel + _MOUSEWHEEL
IF NOT (__UI_GetProperMouseButton%%(1) = __UI_MouseButton1 AND __UI_GetProperMouseButton%%(2) = __UI_MouseButton2) THEN EXIT DO
LOOP
END IF
__UI_MouseButton1 = __UI_GetProperMouseButton%%(1)
__UI_MouseButton2 = __UI_GetProperMouseButton%%(2)
__UI_MouseLeft = _MOUSEX
__UI_MouseTop = _MOUSEY
END IF
'Hover detection
IF __UI_PrevMouseLeft <> __UI_MouseLeft OR __UI_PrevMouseTop <> __UI_MouseTop OR __UI_DidClick OR __UI_HoveringSubMenu THEN
__UI_PrevMouseLeft = __UI_MouseLeft
__UI_PrevMouseTop = __UI_MouseTop
__UI_DidClick = False
DIM TempHover AS LONG
__UI_BelowHoveringID = 0
FOR i = 1 TO UBOUND(Control)
IF Control(i).ID > 0 AND Control(i).Type <> __UI_Type_MenuItem AND ((Control(i).Hidden = False AND __UI_DesignMode = False) OR (__UI_DesignMode = True)) THEN
IF Control(i).Type = __UI_Type_ContextMenu AND __UI_DesignMode AND __UI_ShowInvisibleControls = False THEN _CONTINUE
IF Control(i).Hidden = True AND __UI_ShowInvisibleControls = False THEN _CONTINUE
Control(i).HoveringVScrollbarButton = 0
IF Control(i).ParentID > 0 THEN
IF Control(Control(i).ParentID).Hidden = True THEN _CONTINUE
ContainerOffsetTop = Control(Control(i).ParentID).Top
ContainerOffsetLeft = Control(Control(i).ParentID).Left
'First make sure the mouse is inside the container:
IF __UI_MouseLeft >= ContainerOffsetLeft AND __UI_MouseLeft <= ContainerOffsetLeft + Control(Control(i).ParentID).Width - 1 AND __UI_MouseTop >= ContainerOffsetTop AND __UI_MouseTop <= ContainerOffsetTop + Control(Control(i).ParentID).Height - 1 THEN
'We're in. Now check for individual control:
IF __UI_MouseLeft >= ContainerOffsetLeft + Control(i).Left AND __UI_MouseLeft <= ContainerOffsetLeft + Control(i).Left + Control(i).Width - 1 AND __UI_MouseTop >= ContainerOffsetTop + Control(i).Top AND __UI_MouseTop <= ContainerOffsetTop + Control(i).Top + Control(i).Height - 1 THEN
__UI_BelowHoveringID = TempHover
TempHover = Control(i).ID
IF Control(i).HasVScrollbar AND __UI_IsDragging = False THEN
IF __UI_MouseLeft >= ContainerOffsetLeft + Control(i).Left + Control(i).Width - __UI_ScrollbarWidth THEN
IF __UI_MouseTop <= Control(i).Top + ContainerOffsetTop + __UI_ScrollbarButtonHeight AND __UI_DraggingThumb = False THEN
'Hovering "up" button
Control(i).HoveringVScrollbarButton = 1
Control(i).PreviousInputViewStart = 0
ELSEIF __UI_MouseTop >= Control(i).Top + ContainerOffsetTop + Control(i).Height - __UI_ScrollbarButtonHeight AND __UI_DraggingThumb = False THEN
'Hovering "down" button
Control(i).HoveringVScrollbarButton = 2
Control(i).PreviousInputViewStart = 0
ELSEIF __UI_MouseTop >= ContainerOffsetTop + Control(i).ThumbTop AND __UI_MouseTop <= ContainerOffsetTop + Control(i).ThumbTop + Control(i).ThumbHeight THEN
'Hovering the thumb
Control(i).HoveringVScrollbarButton = 3
Control(i).PreviousInputViewStart = 0
ELSE
'Hovering the track
IF __UI_MouseTop < ContainerOffsetTop + Control(i).ThumbTop THEN
'Above the thumb
Control(i).HoveringVScrollbarButton = 4
ELSE
'Below the thumb
Control(i).HoveringVScrollbarButton = 5
END IF
Control(i).PreviousInputViewStart = 0
END IF
END IF
END IF
END IF
END IF
ELSE
ContainerOffsetTop = 0
ContainerOffsetLeft = 0
IF __UI_MouseLeft >= Control(i).Left AND __UI_MouseLeft <= Control(i).Left + Control(i).Width - 1 AND __UI_MouseTop >= Control(i).Top AND __UI_MouseTop <= Control(i).Top + Control(i).Height - 1 THEN
__UI_BelowHoveringID = TempHover
TempHover = Control(i).ID
IF Control(i).Type = __UI_Type_ContextMenu AND __UI_DesignMode THEN
'In design mode, ContextMenu handles take precedence over
'any other controls
EXIT FOR
END IF
IF Control(i).HasVScrollbar AND __UI_IsDragging = False THEN
IF __UI_MouseLeft >= ContainerOffsetLeft + Control(i).Left + Control(i).Width - __UI_ScrollbarWidth THEN
IF __UI_MouseTop <= Control(i).Top + ContainerOffsetTop + __UI_ScrollbarButtonHeight AND __UI_DraggingThumb = False THEN
'Hovering "up" button
Control(i).HoveringVScrollbarButton = 1
Control(i).PreviousInputViewStart = 0
ELSEIF __UI_MouseTop >= Control(i).Top + ContainerOffsetTop + Control(i).Height - __UI_ScrollbarButtonHeight AND __UI_DraggingThumb = False THEN
'Hovering "down" button
Control(i).HoveringVScrollbarButton = 2
Control(i).PreviousInputViewStart = 0
ELSEIF __UI_MouseTop >= ContainerOffsetTop + Control(i).ThumbTop AND __UI_MouseTop <= ContainerOffsetTop + Control(i).ThumbTop + Control(i).ThumbHeight THEN
'Hovering the thumb
Control(i).HoveringVScrollbarButton = 3
Control(i).PreviousInputViewStart = 0
ELSE
'Hovering the track
IF __UI_MouseTop < ContainerOffsetTop + Control(i).ThumbTop THEN
'Above the thumb
Control(i).HoveringVScrollbarButton = 4
Control(i).PreviousInputViewStart = 0
ELSE
'Below the thumb
Control(i).HoveringVScrollbarButton = 5
Control(i).PreviousInputViewStart = 0
END IF
END IF
END IF
END IF
END IF
END IF
END IF
NEXT
IF Control(TempHover).Type = __UI_Type_MenuPanel THEN
DIM ParentMenu AS LONG
FOR i = __UI_TotalActiveMenus TO 1 STEP -1
IF __UI_ActiveMenu(i) = TempHover THEN
ParentMenu = __UI_ParentMenu(i)
EXIT FOR
END IF
NEXT
'For an active menu, we'll detect individual menu items being hovered
_FONT Control(TempHover).Font
FOR i = 1 TO UBOUND(Control)
IF Control(i).ParentID = ParentMenu AND Control(i).Hidden = False THEN
IF __UI_MouseTop >= Control(TempHover).Top + Control(i).Top AND __UI_MouseTop <= Control(TempHover).Top + Control(i).Top + Control(i).Height - 1 THEN
Control(TempHover).Value = __UI_Focus
TempHover = Control(i).ID
__UI_Focus = Control(i).ID
'Close any unrelated sub-menus:
FOR j = __UI_TotalActiveMenus TO 1 STEP -1
IF __UI_ParentMenu(j) = Control(i).ID OR __UI_ParentMenu(j) = ParentMenu THEN
EXIT FOR
ELSE
__UI_DestroyControl Control(__UI_ActiveMenu(j))
END IF
NEXT
EXIT FOR 'as no menu items will overlap in a panel
END IF
END IF
NEXT
END IF
__UI_HoveringID = TempHover
IF Control(__UI_HoveringID).Type = __UI_Type_Frame AND Control(__UI_BelowHoveringID).ParentID = Control(__UI_HoveringID).ID THEN
'If a control was created before its container, the following line
'will allow it to be properly hovered/focused/selected.
SWAP __UI_HoveringID, __UI_BelowHoveringID
END IF
'Design mode specific hover:
IF __UI_DesignMode AND __UI_IsResizing = False AND __UI_IsDragging = False THEN
__UI_ResizeHandleHover = 0
IF Control(__UI_HoveringID).ControlIsSelected AND Control(__UI_HoveringID).Type <> __UI_Type_MenuBar AND Control(__UI_HoveringID).Type <> __UI_Type_MenuItem THEN
IF __UI_MouseLeft >= Control(__UI_HoveringID).Left + Control(Control(__UI_HoveringID).ParentID).Left + Control(__UI_HoveringID).Width - 8 AND __UI_MouseTop >= Control(__UI_HoveringID).Top + Control(Control(__UI_HoveringID).ParentID).Top + Control(__UI_HoveringID).Height / 2 - 4 AND __UI_MouseTop <= Control(__UI_HoveringID).Top + Control(Control(__UI_HoveringID).ParentID).Top + Control(__UI_HoveringID).Height / 2 + 4 THEN
IF __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResizeH AND __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResize THEN
__UI_ResizeHandleHover = 1 'Right
END IF
ELSEIF __UI_MouseLeft >= Control(__UI_HoveringID).Left + Control(Control(__UI_HoveringID).ParentID).Left + Control(__UI_HoveringID).Width / 2 - 4 AND __UI_MouseLeft <= Control(__UI_HoveringID).Left + Control(Control(__UI_HoveringID).ParentID).Left + Control(__UI_HoveringID).Width / 2 + 4 AND __UI_MouseTop >= Control(__UI_HoveringID).Top + Control(Control(__UI_HoveringID).ParentID).Top + Control(__UI_HoveringID).Height / 2 - 4 AND __UI_MouseTop >= Control(__UI_HoveringID).Top + Control(Control(__UI_HoveringID).ParentID).Top + Control(__UI_HoveringID).Height - 8 THEN
IF __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResizeV AND __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResize THEN
__UI_ResizeHandleHover = 2 'Bottom
END IF
ELSEIF __UI_MouseLeft <= Control(__UI_HoveringID).Left + Control(Control(__UI_HoveringID).ParentID).Left + 8 AND __UI_MouseTop >= Control(__UI_HoveringID).Top + Control(Control(__UI_HoveringID).ParentID).Top + Control(__UI_HoveringID).Height / 2 - 4 AND __UI_MouseTop <= Control(__UI_HoveringID).Top + Control(Control(__UI_HoveringID).ParentID).Top + Control(__UI_HoveringID).Height / 2 + 4 THEN
IF __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResizeH AND __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResize THEN
__UI_ResizeHandleHover = 3 'Left
END IF
ELSEIF __UI_MouseLeft >= Control(__UI_HoveringID).Left + Control(Control(__UI_HoveringID).ParentID).Left + Control(__UI_HoveringID).Width / 2 - 4 AND __UI_MouseLeft <= Control(__UI_HoveringID).Left + Control(Control(__UI_HoveringID).ParentID).Left + Control(__UI_HoveringID).Width / 2 + 4 AND __UI_MouseTop <= Control(__UI_HoveringID).Top + Control(Control(__UI_HoveringID).ParentID).Top + 8 THEN
IF __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResizeV AND __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResize THEN
__UI_ResizeHandleHover = 4 'Top
END IF
ELSEIF __UI_MouseLeft >= Control(__UI_HoveringID).Left + Control(Control(__UI_HoveringID).ParentID).Left + Control(__UI_HoveringID).Width - 8 AND __UI_MouseTop <= Control(__UI_HoveringID).Top + Control(Control(__UI_HoveringID).ParentID).Top + 8 THEN
IF __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = False THEN
__UI_ResizeHandleHover = 5 'Top-right
END IF
ELSEIF __UI_MouseLeft <= Control(__UI_HoveringID).Left + Control(Control(__UI_HoveringID).ParentID).Left + 8 AND __UI_MouseTop <= Control(__UI_HoveringID).Top + Control(Control(__UI_HoveringID).ParentID).Top + 8 THEN
IF __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = False THEN
__UI_ResizeHandleHover = 6 'Top-left
END IF
ELSEIF __UI_MouseLeft >= Control(__UI_HoveringID).Left + Control(Control(__UI_HoveringID).ParentID).Left + Control(__UI_HoveringID).Width - 8 AND __UI_MouseTop >= Control(__UI_HoveringID).Top + Control(Control(__UI_HoveringID).ParentID).Top + Control(__UI_HoveringID).Height - 8 THEN
IF __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = False THEN
__UI_ResizeHandleHover = 7 'Bottom-right
END IF
ELSEIF __UI_MouseLeft <= Control(__UI_HoveringID).Left + Control(Control(__UI_HoveringID).ParentID).Left + 8 AND __UI_MouseTop >= Control(__UI_HoveringID).Top + Control(Control(__UI_HoveringID).ParentID).Top + Control(__UI_HoveringID).Height - 8 THEN
IF __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = False THEN
__UI_ResizeHandleHover = 8 'Bottom-left
END IF
END IF
END IF
END IF
IF Control(__UI_Focus).Type = __UI_Type_MenuBar AND Control(__UI_HoveringID).Type = __UI_Type_MenuBar THEN
IF __UI_TotalActiveMenus = 0 THEN
__UI_Focus = __UI_HoveringID
END IF
ELSEIF __UI_TotalActiveMenus > 0 AND Control(__UI_HoveringID).Type = __UI_Type_MenuBar AND __UI_ActiveMenuIsContextMenu = False AND __UI_DesignMode = False THEN
IF __UI_ParentMenu(__UI_TotalActiveMenus) <> __UI_HoveringID AND NOT Control(__UI_HoveringID).Disabled THEN
__UI_CloseAllMenus
__UI_ActivateMenu Control(__UI_HoveringID), False
__UI_ForceRedraw = True
ELSEIF Control(__UI_HoveringID).Disabled THEN
__UI_CloseAllMenus
__UI_Focus = __UI_HoveringID
END IF
ELSE
IF __UI_HoveringID <> __UI_LastHoveringID AND Control(__UI_HoveringID).Type = __UI_Type_MenuItem AND Control(__UI_HoveringID).SubMenu AND __UI_DesignMode = False THEN
Control(__UI_HoveringID).LastChange = TIMER
__UI_HoveringSubMenu = True
ELSEIF __UI_HoveringID = __UI_LastHoveringID AND Control(__UI_HoveringID).Type = __UI_Type_MenuItem AND Control(__UI_HoveringID).SubMenu THEN
IF TIMER - Control(__UI_HoveringID).LastChange >= __UI_SubMenuDelay THEN
__UI_ActivateMenu Control(__UI_HoveringID), False
__UI_HoveringSubMenu = False
END IF
END IF
END IF
END IF
'Check if a tooltip must be enabled
IF __UI_HoveringID <> __UI_LastHoveringID OR __UI_MouseButton1 OR __UI_MouseButton2 THEN
__UI_TipTimer = TIMER
__UI_ActiveTipID = 0
ELSE
IF __UI_HoveringID <> __UI_ActiveTipID AND __UI_HoveringID > 0 AND NOT __UI_IsDragging THEN
IF TIMER - __UI_TipTimer >= __UI_ToolTipTimeOut THEN
IF LEN(ToolTip(__UI_HoveringID)) > 0 THEN
__UI_ActiveTipID = __UI_HoveringID
__UI_ActiveTipTop = __UI_MouseTop + 16
__UI_ActiveTipLeft = __UI_MouseLeft
END IF
END IF
END IF
END IF
'Keyboard input:
__UI_KeyHit = _KEYHIT
IF __UI_KeyHit THEN __UI_HasInput = True
'Adjust the Resize Status of this form based on its CanResize property:
IF __UI_DesignMode = False THEN
IF Control(__UI_FormID).CanResize <> __UI_CurrentResizeStatus THEN
__UI_CurrentResizeStatus = Control(__UI_FormID).CanResize
IF __UI_CurrentResizeStatus THEN
_RESIZE ON
ELSE
_RESIZE OFF
END IF
END IF
END IF
'Resize event:
'(Triggered either programatically or by directly resizing the form):
DIM CheckResize AS _BYTE
CheckResize = _RESIZE
IF (CheckResize AND Control(__UI_FormID).CanResize) OR (CheckResize AND __UI_DesignMode) OR __UI_CurrentBackColor <> Control(__UI_FormID).BackColor OR Control(__UI_FormID).Width <> _WIDTH(0) OR Control(__UI_FormID).Height <> _HEIGHT(0) THEN
_DELAY .1
IF CheckResize THEN
Control(__UI_FormID).Width = _RESIZEWIDTH
Control(__UI_FormID).Height = _RESIZEHEIGHT
END IF
IF Control(__UI_FormID).Width > 0 AND Control(__UI_FormID).Height > 0 THEN
__UI_CurrentBackColor = Control(__UI_FormID).BackColor
__UI_HasResized = 2 'Indicate this process is in the middle
OldScreen& = _DISPLAY
SCREEN _NEWIMAGE(Control(__UI_FormID).Width, Control(__UI_FormID).Height, 32)
_FREEIMAGE OldScreen&
'Recreate the main form's canvas
IF Control(__UI_FormID).Canvas <> 0 THEN _FREEIMAGE Control(__UI_FormID).Canvas
Control(__UI_FormID).Canvas = _NEWIMAGE(Control(__UI_FormID).Width, Control(__UI_FormID).Height, 32)
_DEST Control(__UI_FormID).Canvas
COLOR Control(__UI_FormID).ForeColor, Control(__UI_FormID).BackColor
CLS
IF __UI_HasMenuBar = True THEN
'Add menubar div to main form's canvas
_FONT Control(__UI_FormID).Font
__UI_MenuBarOffsetV = _ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset) + 5 + 2
LINE (0, __UI_MenuBarOffsetV - 1)-STEP(Control(__UI_FormID).Width - 1, 0), Darken(Control(__UI_FormID).BackColor, 80)
LINE (0, __UI_MenuBarOffsetV)-STEP(Control(__UI_FormID).Width - 1, 0), Darken(Control(__UI_FormID).BackColor, 120)
__UI_RefreshMenuBar
ELSE
__UI_MenuBarOffsetV = 0
END IF
_DEST 0
IF LEN(__UI_CurrentTitle) THEN _TITLE __UI_CurrentTitle
__UI_HasResized = True
__UI_HasInput = True
END IF
END IF
'Update main window title if needed
IF __UI_CurrentTitle <> Caption(__UI_FormID) THEN
__UI_CurrentTitle = Caption(__UI_FormID)
_TITLE __UI_CurrentTitle
__UI_HasInput = True
END IF
__UI_ProcessInputTimer = TIMER
END SUB
'---------------------------------------------------------------------------------
SUB __UI_UpdateDisplay
STATIC ActiveTipPanel AS LONG
DIM i AS LONG, TempCaption$, PrevDest AS LONG, TempParentID AS LONG
DIM OverlayisVisible AS _BYTE, OverlayReset AS _BYTE
DIM ContainerOffsetLeft AS INTEGER, ContainerOffsetTop AS INTEGER
DIM ControlState AS _BYTE '1 = Normal; 2 = Hover/focus; 3 = Mouse down; 4 = Disabled;
IF __UI_AutoRefresh = False THEN EXIT SUB
__UI_BeforeUpdateDisplay
IF _SCREENX = -32000 AND _SCREENY = -32000 THEN
'Window was minimized
EXIT SUB
END IF
ON ERROR GOTO __UI_ErrorHandler
'Clear frames canvases and count its children;
FOR i = 1 TO UBOUND(Control)
IF Control(i).Type = __UI_Type_Frame THEN
Control(i).ParentID = 0 'Enforce no frames inside frames
Control(i).Value = 0 'Reset children counter
IF _WIDTH(Control(i).Canvas) <> Control(i).Width OR _HEIGHT(Control(i).Canvas) <> Control(i).Height THEN
_FREEIMAGE Control(i).Canvas
Control(i).Canvas = _NEWIMAGE(Control(i).Width, Control(i).Height, 32)
END IF
_DEST Control(i).Canvas
COLOR , Control(i).BackColor
CLS
ELSE
IF Control(i).ParentID > 0 AND Control(i).Type <> __UI_Type_MenuItem THEN
'Increase container's children controls counter
Control(Control(i).ParentID).Value = Control(Control(i).ParentID).Value + 1
END IF
END IF
NEXT
_DEST 0
IF __UI_ForceRedraw THEN 'Restore main window hardware bg
'Free the hardware bg image:
_FREEIMAGE Control(__UI_FormID).Canvas
'Create a new software one:
Control(__UI_FormID).Canvas = _NEWIMAGE(Control(__UI_FormID).Width, Control(__UI_FormID).Height, 32)
'Draw on it:
_DEST Control(__UI_FormID).Canvas
COLOR Control(__UI_FormID).ForeColor, Control(__UI_FormID).BackColor
CLS
IF __UI_HasMenuBar THEN
_FONT Control(__UI_FormID).Font
__UI_MenuBarOffsetV = _ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset) + 5 + 2
LINE (0, _ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset) + 5 + 1)-STEP(Control(__UI_FormID).Width - 1, 0), Darken(Control(__UI_FormID).BackColor, 80)
LINE (0, _ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset) + 5 + 2)-STEP(Control(__UI_FormID).Width - 1, 0), Darken(Control(__UI_FormID).BackColor, 120)
ELSE
__UI_MenuBarOffsetV = 0
END IF
_DEST 0
END IF
'Control drawing
DIM iCount AS LONG
FOR iCount = 1 TO UBOUND(ControlDrawOrder)
i = ControlDrawOrder(iCount)
IF Control(i).ID > 0 THEN
'Direct the drawing to the appropriate canvas (main or container)
IF Control(i).ParentID > 0 AND Control(i).Type <> __UI_Type_MenuItem THEN
_DEST Control(Control(i).ParentID).Canvas
ELSE
_DEST 0
END IF
IF i = __UI_FirstSelectedID AND Control(i).BoundTo > 0 AND __UI_DesignMode = True AND __UI_ShowInvisibleControls = True THEN
LINE (Control(i).Left - 5 + Control(Control(i).ParentID).Left, _
Control(i).Top - 5 + Control(Control(i).ParentID).Top)- _
STEP(Control(i).Width + 10, Control(i).Height + 10), _
_RGB32(127, 105, 183, 50), BF
LINE (Control(Control(i).BoundTo).Left - 5 + Control(Control(Control(i).BoundTo).ParentID).Left, _
Control(Control(i).BoundTo).Top - 5 + Control(Control(Control(i).BoundTo).ParentID).Top)- _
STEP(Control(Control(i).BoundTo).Width + 10, Control(Control(i).BoundTo).Height + 10), _
_RGB32(127, 105, 183, 50), BF
END IF
IF Control(i).Hidden = True AND __UI_DesignMode = True AND __UI_ShowInvisibleControls = True THEN
LINE (Control(i).Left, Control(i).Top)-STEP(Control(i).Width - 1, Control(i).Height - 1), _RGBA32(127, 127, 127, 80), BF
_FONT 8
_PRINTMODE _KEEPBACKGROUND
COLOR _RGBA32(0, 0, 0, 150)
_PRINTSTRING (Control(i).Left + 1, Control(i).Top + 1), RTRIM$(Control(i).Name)
_PRINTSTRING (Control(i).Left + 1, Control(i).Top + 1 + _ulinespacing), "(hidden)"
GOTO BypassDisplay
ELSEIF Control(i).Hidden = True THEN
GOTO BypassDisplay
END IF
IF ((__UI_MouseIsDown AND i = __UI_MouseDownOnID) OR (__UI_KeyIsDown AND i = __UI_KeyDownOnID AND __UI_KeyDownOnID = __UI_Focus)) AND NOT Control(i).Disabled THEN
ControlState = 3
ELSEIF (i = __UI_HoveringID AND Control(i).Type = __UI_Type_MenuBar) THEN
ControlState = 2
ELSEIF (i = __UI_HoveringID AND Control(i).Type <> __UI_Type_MenuBar AND NOT Control(i).Disabled) THEN
ControlState = 2
ELSEIF Control(i).Disabled THEN
ControlState = 4
ELSE
ControlState = 1
END IF
SELECT CASE Control(i).Type
CASE __UI_Type_Form
'Main window:
IF __UI_HasResized <> 2 THEN
IF Control(i).Canvas < -1 THEN _PUTIMAGE (0, 0), Control(i).Canvas, 0
ELSE
PAINT (0, 0), Control(i).BackColor
END IF
CASE __UI_Type_Button
'Buttons
__UI_DrawButton Control(i), ControlState
CASE __UI_Type_Label
'Labels
AutoSizeLabel Control(i)
__UI_DrawLabel Control(i), ControlState
CASE __UI_Type_RadioButton
'Radio buttons
__UI_DrawRadioButton Control(i), ControlState
CASE __UI_Type_CheckBox
'Check boxes
__UI_StateHasChanged = False
__UI_DrawCheckBox Control(i), ControlState
IF __UI_StateHasChanged THEN __UI_ValueChanged i
CASE __UI_Type_ProgressBar
'Progress bars
__UI_DrawProgressBar Control(i), ControlState
CASE __UI_Type_TrackBar
'Track bars
Control(i).Value = _ROUND(Control(i).Value)
Control(i).Interval = _ROUND(Control(i).Interval)
Control(i).MinInterval = _ROUND(Control(i).MinInterval)
__UI_StateHasChanged = False
__UI_DrawTrackBar Control(i), ControlState
IF __UI_StateHasChanged THEN
__UI_ValueChanged i
END IF
CASE __UI_Type_TextBox
'Text boxes
'IF Control(i).InputViewStart = 0 THEN Control(i).InputViewStart = 1
IF __UI_EditorMode = False AND Control(i).NumericOnly = __UI_NumericWithBounds AND __UI_Focus <> i THEN
__UI_ValidateBounds i
IF Text(i) <> LTRIM$(STR$(Control(i).Value)) THEN
Text(i) = LTRIM$(STR$(Control(i).Value))
END IF
END IF
DIM ss1 AS LONG, ss2 AS LONG
__UI_FillSelectedText ss1, ss2
__UI_StateHasChanged = False
__UI_DrawTextBox Control(i), ControlState
IF __UI_StateHasChanged THEN
__UI_TextChanged i
IF Control(i).NumericOnly THEN
Control(i).Value = VAL(Text(i))
__UI_ValidateBounds i
END IF
END IF
CASE __UI_Type_ListBox
'List boxes
IF Control(i).InputViewStart <= 0 THEN Control(i).InputViewStart = 1
__UI_StateHasChanged = False
__UI_DrawListBox Control(i), ControlState
IF __UI_StateHasChanged THEN __UI_ValueChanged i
CASE __UI_Type_DropdownList
'Dropdown lists
__UI_StateHasChanged = False
__UI_DrawDropdownList Control(i), ControlState
IF __UI_StateHasChanged THEN __UI_ValueChanged i
CASE __UI_Type_MenuBar
__UI_DrawMenuBar Control(i), ControlState
CASE __UI_Type_PictureBox
__UI_DrawPictureBox Control(i), ControlState
CASE __UI_Type_ToggleSwitch
__UI_StateHasChanged = False
__UI_DrawToggleSwitch Control(i), ControlState
IF __UI_StateHasChanged THEN __UI_ValueChanged i
END SELECT
END IF
BypassDisplay:
DIM __UI_RelevantID AS LONG
__UI_RelevantID = __UI_DraggingID
IF __UI_IsResizing THEN __UI_RelevantID = __UI_ResizingID
IF __UI_Snapped THEN
IF OverlayReset = False THEN
'Reset the helper canvas of the main form
OverlayReset = True
IF Control(__UI_FormID).HelperCanvas <> 0 THEN _FREEIMAGE Control(__UI_FormID).HelperCanvas
Control(__UI_FormID).HelperCanvas = _NEWIMAGE(Control(__UI_FormID).Width, Control(__UI_FormID).Height, 32)
_DEST Control(__UI_FormID).HelperCanvas
CLS , _RGBA32(0, 0, 0, 0)
ELSE
_DEST Control(__UI_FormID).HelperCanvas
END IF
OverlayisVisible = True
DIM X1 AS INTEGER, X2 AS INTEGER
DIM Y1 AS INTEGER, Y2 AS INTEGER
ContainerOffsetLeft = Control(Control(__UI_RelevantID).ParentID).Left
ContainerOffsetTop = Control(Control(__UI_RelevantID).ParentID).Top
IF __UI_SnappedY >= 0 AND __UI_SnappedByProximityY = 0 THEN
X1 = 0
X2 = _WIDTH
LINE (X1, __UI_SnappedY)-STEP(X2, 0), Control(__UI_FormID).SelectedBackColor
ELSEIF __UI_SnappedY >= 0 AND __UI_SnappedByProximityY > 0 THEN
SELECT CASE __UI_SnappedByProximityY
CASE 1 'bottom of dragged control to top of snapped control
X1 = Control(__UI_RelevantID).Left + Control(__UI_RelevantID).Width / 2
IF X1 < Control(__UI_SnappedXID).Left + 1 THEN X1 = Control(__UI_SnappedXID).Left + 1
IF X1 > Control(__UI_SnappedXID).Left + Control(__UI_SnappedXID).Width - 1 THEN X1 = Control(__UI_SnappedXID).Left + Control(__UI_SnappedXID).Width - 1
Y1 = Control(__UI_RelevantID).Top + Control(__UI_RelevantID).Height
FOR X1 = X1 - 1 TO X1 + 1
LINE (X1 + ContainerOffsetLeft, Y1 + ContainerOffsetTop)-STEP(0, __UI_SnapDistance), Control(__UI_FormID).SelectedBackColor
NEXT
CASE 2 'top of dragged control to bottom of snapped control
X1 = Control(__UI_RelevantID).Left + Control(__UI_RelevantID).Width / 2
IF X1 < Control(__UI_SnappedXID).Left + 1 THEN X1 = Control(__UI_SnappedXID).Left + 1
IF X1 > Control(__UI_SnappedXID).Left + Control(__UI_SnappedXID).Width - 1 THEN X1 = Control(__UI_SnappedXID).Left + Control(__UI_SnappedXID).Width - 1
Y1 = Control(__UI_RelevantID).Top
FOR X1 = X1 - 1 TO X1 + 1
LINE (X1 + ContainerOffsetLeft, Y1 + ContainerOffsetTop)-STEP(0, -__UI_SnapDistance), Control(__UI_FormID).SelectedBackColor
NEXT
CASE 3 'snapped to top of form
X1 = Control(__UI_RelevantID).Left + Control(__UI_RelevantID).Width / 2
IF X1 < 1 THEN X1 = 1
IF X1 > Control(__UI_FormID).Width - 2 THEN X1 = Control(__UI_FormID).Width - 2
Y1 = Control(__UI_RelevantID).Top
FOR X1 = X1 - 1 TO X1 + 1
LINE (X1 + ContainerOffsetLeft, Y1 + ContainerOffsetTop)-STEP(0, -__UI_SnapDistanceFromForm), Control(__UI_FormID).SelectedBackColor
NEXT
CASE 4 'snapped to bottom of form
X1 = Control(__UI_RelevantID).Left + Control(__UI_RelevantID).Width / 2
IF X1 < 1 THEN X1 = 1
IF X1 > Control(__UI_FormID).Width - 2 THEN X1 = Control(__UI_FormID).Width - 2
Y1 = Control(__UI_RelevantID).Top + Control(__UI_RelevantID).Height
FOR X1 = X1 - 1 TO X1 + 1
LINE (X1 + ContainerOffsetLeft, Y1 + ContainerOffsetTop)-STEP(0, __UI_SnapDistanceFromForm), Control(__UI_FormID).SelectedBackColor
NEXT
END SELECT
END IF
IF __UI_SnappedX >= 0 AND __UI_SnappedByProximityX = 0 THEN
Y1 = 0
Y2 = _HEIGHT
LINE (__UI_SnappedX, Y1)-STEP(0, Y2), Control(__UI_FormID).SelectedBackColor
ELSEIF __UI_SnappedX >= 0 AND __UI_SnappedByProximityX > 0 THEN
SELECT CASE __UI_SnappedByProximityX
CASE 1 'left of dragged control to right of snapped control
X1 = Control(__UI_SnappedXID).Left + Control(__UI_SnappedXID).Width
Y1 = Control(__UI_RelevantID).Top + Control(__UI_RelevantID).Height / 2
IF Y1 < Control(__UI_SnappedXID).Top + 1 THEN Y1 = Control(__UI_SnappedXID).Top + 1
IF Y1 > Control(__UI_SnappedXID).Top + Control(__UI_SnappedXID).Height - 1 THEN Y1 = Control(__UI_SnappedXID).Top + Control(__UI_SnappedXID).Height - 1
FOR Y1 = Y1 - 1 TO Y1 + 1
LINE (X1 + ContainerOffsetLeft, Y1 + ContainerOffsetTop)-STEP(__UI_SnapDistance, 0), Control(__UI_FormID).SelectedBackColor
NEXT
CASE 2 'right of dragged control to left of snapped control
X1 = Control(__UI_SnappedXID).Left
Y1 = Control(__UI_RelevantID).Top + Control(__UI_RelevantID).Height / 2
IF Y1 < Control(__UI_SnappedXID).Top + 1 THEN Y1 = Control(__UI_SnappedXID).Top + 1
IF Y1 > Control(__UI_SnappedXID).Top + Control(__UI_SnappedXID).Height - 1 THEN Y1 = Control(__UI_SnappedXID).Top + Control(__UI_SnappedXID).Height - 1
FOR Y1 = Y1 - 1 TO Y1 + 1
LINE (X1 + ContainerOffsetLeft, Y1 + ContainerOffsetTop)-STEP(-__UI_SnapDistance, 0), Control(__UI_FormID).SelectedBackColor
NEXT
CASE 3 'snapped to left side of form
X1 = Control(__UI_RelevantID).Left
Y1 = Control(__UI_RelevantID).Top + Control(__UI_RelevantID).Height / 2
IF Y1 < 1 THEN Y1 = 1
IF Y1 > Control(__UI_FormID).Height - 2 THEN Y1 = Control(__UI_FormID).Height - 2
FOR Y1 = Y1 - 1 TO Y1 + 1
LINE (X1 + ContainerOffsetLeft, Y1 + ContainerOffsetTop)-STEP(-__UI_SnapDistanceFromForm, 0), Control(__UI_FormID).SelectedBackColor
NEXT
CASE 4 'snapped to right side of form
X1 = Control(__UI_RelevantID).Left + Control(__UI_RelevantID).Width
Y1 = Control(__UI_RelevantID).Top + Control(__UI_RelevantID).Height / 2
IF Y1 < 1 THEN Y1 = 1
IF Y1 > Control(__UI_FormID).Height - 2 THEN Y1 = Control(__UI_FormID).Height - 2
FOR Y1 = Y1 - 1 TO Y1 + 1
LINE (X1 + ContainerOffsetLeft, Y1 + ContainerOffsetTop)-STEP(__UI_SnapDistanceFromForm, 0), Control(__UI_FormID).SelectedBackColor
NEXT
END SELECT
END IF
_DEST 0
END IF
IF Control(i).ControlIsSelected THEN
IF OverlayReset = False THEN
'Reset the helper canvas of the main form
OverlayReset = True
IF Control(__UI_FormID).HelperCanvas <> 0 THEN _FREEIMAGE Control(__UI_FormID).HelperCanvas
Control(__UI_FormID).HelperCanvas = _NEWIMAGE(Control(__UI_FormID).Width, Control(__UI_FormID).Height, 32)
_DEST Control(__UI_FormID).HelperCanvas
CLS , _RGBA32(0, 0, 0, 0)
ELSE
_DEST Control(__UI_FormID).HelperCanvas
END IF
OverlayisVisible = True
IF Control(i).Type = __UI_Type_MenuItem THEN
TempParentID = Control(i).ParentID
Control(i).ParentID = Control(i).MenuPanelID
'Dotted outline:
LINE (Control(i).Left + Control(Control(i).ParentID).Left - 2, Control(i).Top + Control(Control(i).ParentID).Top - 2)-STEP(Control(Control(i).ParentID).Width + 3, Control(i).Height + 3), _RGB32(0, 0, 0), B , 21845
ELSE
TempParentID = 0
'Dotted outline:
LINE (Control(i).Left + Control(Control(i).ParentID).Left - 2, Control(i).Top + Control(Control(i).ParentID).Top - 2)-STEP(Control(i).Width + 3, Control(i).Height + 3), _RGB32(0, 0, 0), B , 21845
END IF
IF NOT __UI_IsDragging THEN
IF __UI_Type(Control(i).Type).RestrictResize <> __UI_CantResizeH AND __UI_Type(Control(i).Type).RestrictResize <> __UI_CantResize THEN
'Right resize handle:
IF Control(i).Type = __UI_Type_MenuItem THEN
LINE (Control(i).Left + Control(Control(i).ParentID).Left + Control(Control(i).ParentID).Width - 8, Control(i).Top + Control(Control(i).ParentID).Top + Control(i).Height / 2 - 4)-STEP(7, 7), _RGB32(255, 255, 255), BF
LINE (Control(i).Left + Control(Control(i).ParentID).Left + Control(Control(i).ParentID).Width - 8, Control(i).Top + Control(Control(i).ParentID).Top + Control(i).Height / 2 - 4)-STEP(7, 7), _RGB32(0, 0, 0), B
ELSE
LINE (Control(i).Left + Control(Control(i).ParentID).Left + Control(i).Width - 8, Control(i).Top + Control(Control(i).ParentID).Top + Control(i).Height / 2 - 4)-STEP(7, 7), _RGB32(255, 255, 255), BF
LINE (Control(i).Left + Control(Control(i).ParentID).Left + Control(i).Width - 8, Control(i).Top + Control(Control(i).ParentID).Top + Control(i).Height / 2 - 4)-STEP(7, 7), _RGB32(0, 0, 0), B
END IF
'Left resize handle:
LINE (Control(i).Left + Control(Control(i).ParentID).Left, Control(i).Top + Control(Control(i).ParentID).Top + Control(i).Height / 2 - 4)-STEP(7, 7), _RGB32(255, 255, 255), BF
LINE (Control(i).Left + Control(Control(i).ParentID).Left, Control(i).Top + Control(Control(i).ParentID).Top + Control(i).Height / 2 - 4)-STEP(7, 7), _RGB32(0, 0, 0), B
END IF
IF __UI_Type(Control(i).Type).RestrictResize <> __UI_CantResizeV AND __UI_Type(Control(i).Type).RestrictResize <> __UI_CantResize THEN
'Bottom resize handle:
LINE (Control(i).Left + Control(Control(i).ParentID).Left + Control(i).Width / 2 - 4, Control(i).Top + Control(Control(i).ParentID).Top + Control(i).Height - 8)-STEP(7, 7), _RGB32(255, 255, 255), BF
LINE (Control(i).Left + Control(Control(i).ParentID).Left + Control(i).Width / 2 - 4, Control(i).Top + Control(Control(i).ParentID).Top + Control(i).Height - 8)-STEP(7, 7), _RGB32(0, 0, 0), B
'Top resize handle:
LINE (Control(i).Left + Control(Control(i).ParentID).Left + Control(i).Width / 2 - 4, Control(i).Top + Control(Control(i).ParentID).Top)-STEP(7, 7), _RGB32(255, 255, 255), BF
LINE (Control(i).Left + Control(Control(i).ParentID).Left + Control(i).Width / 2 - 4, Control(i).Top + Control(Control(i).ParentID).Top)-STEP(7, 7), _RGB32(0, 0, 0), B
END IF
IF __UI_Type(Control(i).Type).RestrictResize = False THEN
'Bottom-right resize handle:
LINE (Control(i).Left + Control(Control(i).ParentID).Left + Control(i).Width - 8, Control(i).Top + Control(Control(i).ParentID).Top + Control(i).Height - 8)-STEP(7, 7), _RGB32(255, 255, 255), BF
LINE (Control(i).Left + Control(Control(i).ParentID).Left + Control(i).Width - 8, Control(i).Top + Control(Control(i).ParentID).Top + Control(i).Height - 8)-STEP(7, 7), _RGB32(0, 0, 0), B
'Bottom-left resize handle:
LINE (Control(i).Left + Control(Control(i).ParentID).Left, Control(i).Top + Control(Control(i).ParentID).Top + Control(i).Height - 8)-STEP(7, 7), _RGB32(255, 255, 255), BF
LINE (Control(i).Left + Control(Control(i).ParentID).Left, Control(i).Top + Control(Control(i).ParentID).Top + Control(i).Height - 8)-STEP(7, 7), _RGB32(0, 0, 0), B
'Top-right resize handle:
LINE (Control(i).Left + Control(Control(i).ParentID).Left + Control(i).Width - 8, Control(i).Top + Control(Control(i).ParentID).Top)-STEP(7, 7), _RGB32(255, 255, 255), BF
LINE (Control(i).Left + Control(Control(i).ParentID).Left + Control(i).Width - 8, Control(i).Top + Control(Control(i).ParentID).Top)-STEP(7, 7), _RGB32(0, 0, 0), B
'Top-left resize handle:
LINE (Control(i).Left + Control(Control(i).ParentID).Left, Control(i).Top + Control(Control(i).ParentID).Top)-STEP(7, 7), _RGB32(255, 255, 255), BF
LINE (Control(i).Left + Control(Control(i).ParentID).Left, Control(i).Top + Control(Control(i).ParentID).Top)-STEP(7, 7), _RGB32(0, 0, 0), B
END IF
END IF
IF TempParentID > 0 THEN Control(i).ParentID = TempParentID
_DEST 0
END IF
IF Control(i).ParentID > 0 AND Control(i).Type <> __UI_Type_MenuItem THEN
'Check if no more controls will be drawn in this frame so it can be drawn too
DIM CheckChildControls AS LONG, NoMoreChildren AS _BYTE, ThisParent AS LONG
ThisParent = Control(i).ParentID
NoMoreChildren = True
FOR CheckChildControls = i + 1 TO UBOUND(Control)
IF Control(CheckChildControls).ParentID = ThisParent THEN
NoMoreChildren = False
EXIT FOR
END IF
NEXT
IF NoMoreChildren THEN
'Draw frame
__UI_DrawFrame Control(ThisParent)
END IF
END IF
IF i = __UI_Focus THEN __UI_CheckBinding i
NEXT
FOR i = 1 TO UBOUND(Control)
IF Control(i).Type = __UI_Type_Frame AND Control(i).Value = 0 THEN
'Draw frame without any children controls
__UI_DrawFrame Control(i)
END IF
NEXT
'Selection rectangle:
IF __UI_DesignMode AND __UI_SelectionRectangle THEN
IF OverlayReset = False THEN
'Reset the helper canvas of the main form
OverlayReset = True
IF Control(__UI_FormID).HelperCanvas <> 0 THEN _FREEIMAGE Control(__UI_FormID).HelperCanvas
Control(__UI_FormID).HelperCanvas = _NEWIMAGE(Control(__UI_FormID).Width, Control(__UI_FormID).Height, 32)
_DEST Control(__UI_FormID).HelperCanvas
CLS , _RGBA32(0, 0, 0, 0)
ELSE
_DEST Control(__UI_FormID).HelperCanvas
END IF
OverlayisVisible = True
LINE(__UI_SelectionRectangleLeft, __UI_SelectionRectangleTop)-(__UI_MouseLeft,__UI_MouseTop), _RGBA32(0, 177, 255, 150), BF
LINE(__UI_SelectionRectangleLeft, __UI_SelectionRectangleTop)-(__UI_MouseLeft,__UI_MouseTop), _RGB32(39, 188, 244), B
'LINE(__UI_SelectionRectangleLeft, __UI_SelectionRectangleTop)-(__UI_MouseLeft,__UI_MouseTop), Control(__UI_FormID).SelectedBackColor, B, 255 'Dotted line
_DEST 0
END IF
'Size and position indicator:
IF __UI_TotalSelectedControls > 0 AND __UI_Snapped = False AND __UI_ShowPositionAndSize THEN
IF Control(__UI_FormID).Width > 0 AND Control(__UI_FormID).Height > 0 THEN
IF OverlayReset = False THEN
'Reset the helper canvas of the main form
OverlayReset = True
IF Control(__UI_FormID).HelperCanvas <> 0 THEN _FREEIMAGE Control(__UI_FormID).HelperCanvas
Control(__UI_FormID).HelperCanvas = _NEWIMAGE(Control(__UI_FormID).Width, Control(__UI_FormID).Height, 32)
_DEST Control(__UI_FormID).HelperCanvas
CLS , _RGBA32(0, 0, 0, 0)
ELSE
_DEST Control(__UI_FormID).HelperCanvas
END IF
i = __UI_FirstSelectedID
IF Control(__UI_HoveringID).ControlIsSelected THEN i = __UI_HoveringID
IF Control(i).Type <> __UI_Type_ContextMenu AND Control(i).Type <> __UI_Type_MenuBar AND Control(i).Type <> __UI_Type_MenuItem THEN
OverlayisVisible = True
DIM SizeAndPosition1$, SizeAndPosition2$, pw&
DIM InfoLeft AS INTEGER, InfoTop AS INTEGER
_FONT Control(__UI_FormID).Font
'Calculate the info panel width
SizeAndPosition1$ = LTRIM$(STR$(Control(i).Left)) + "," + LTRIM$(STR$(Control(i).Top))
pw& = __UI_PrintWidth(SizeAndPosition1$)
SizeAndPosition2$ = LTRIM$(STR$(Control(i).Width)) + "x" + LTRIM$(STR$(Control(i).Height))
IF __UI_PrintWidth(SizeAndPosition2$) > pw& THEN pw& = __UI_PrintWidth(SizeAndPosition2$)
'Calculate the info panel position
InfoLeft = Control(Control(i).ParentID).Left + Control(i).Left
IF InfoLeft < 0 THEN InfoLeft = 0
IF InfoLeft + pw& + 4 > Control(__UI_FormID).Width THEN InfoLeft = Control(__UI_FormID).Width - (pw& + 4)
InfoTop = Control(Control(i).ParentID).Top + Control(i).Top + Control(i).Height + 2
IF InfoTop < 0 THEN InfoTop = 0
IF InfoTop + uspacing& * 2 + 4 > Control(__UI_FormID).Height THEN InfoTop = Control(__UI_FormID).Height - (uspacing& * 2 + 4)
'Reposition the panel if it intersects with the controls
IF InfoLeft < Control(Control(i).ParentID).Left + Control(i).Left + Control(i).Width AND _
Control(Control(i).ParentID).Left + Control(i).Left < InfoLeft + pw& + 4 AND _
InfoTop < Control(Control(i).ParentID).Top + Control(i).Top + Control(i).Height + 2 AND _
Control(Control(i).ParentID).Top + Control(i).Top < InfoTop + uspacing& * 2 + 4 THEN
InfoTop = Control(Control(i).ParentID).Top + Control(i).Top - (uspacing& * 2 + 4)
END IF
'Reposition the panel if the mouse is where it'd be drawn
IF __UI_MouseLeft >= InfoLeft AND __UI_MouseLeft <= InfoLeft + pw& + 4 AND _
__UI_MouseTop >= InfoTop AND __UI_MouseTop <= InfoTop + uspacing& * 2 + 4 THEN
InfoLeft = InfoLeft + Control(i).Width
END IF
'Draw the info panel
__UI_ShadowBox InfoLeft, InfoTop, pw& + 4, uspacing& * 2 + 4, __UI_DefaultColor(__UI_Type_Form, 6), 40, 5
'Print the info
COLOR _RGB32(0, 0, 0)
__UI_PrintString InfoLeft + 3, InfoTop + 3, SizeAndPosition1$
__UI_PrintString InfoLeft + 3, InfoTop + 3 + uspacing&, SizeAndPosition2$
END IF
_DEST 0
END IF
END IF
FOR i = 1 TO __UI_TotalActiveMenus
IF LEFT$(Control(__UI_ActiveMenu(i)).Name, 5) <> "__UI_" THEN
__UI_DrawMenuPanel Control(__UI_ActiveMenu(i)), __UI_ParentMenu(i)
END IF
NEXT
IF OverlayisVisible THEN
IF Control(__UI_FormID).HelperCanvas < -1 THEN
__UI_MakeHardwareImage Control(__UI_FormID).HelperCanvas
_PUTIMAGE , Control(__UI_FormID).HelperCanvas
END IF
END IF
IF __UI_DesignMode = True AND __UI_ShowInvisibleControls = True THEN
FOR i = 1 TO UBOUND(Control)
IF Control(i).Type = __UI_Type_ContextMenu AND LEFT$(Control(i).Name, 5) <> "__UI_" THEN
__UI_DrawContextMenuHandle Control(i), Control(i).ControlState
END IF
NEXT
END IF
'Keep DesignMode context menus on top by drawing them last:
FOR i = 1 TO __UI_TotalActiveMenus
IF LEFT$(Control(__UI_ActiveMenu(i)).Name, 5) = "__UI_" THEN
__UI_DrawMenuPanel Control(__UI_ActiveMenu(i)), __UI_ParentMenu(i)
END IF
NEXT
STATIC PanelWidth AS INTEGER, PanelHeight AS INTEGER
IF __UI_ActiveTipID > 0 THEN
IF __UI_ActiveTipID <> __UI_PreviousTipID OR ToolTip(__UI_ActiveTipID) <> __UI_TempTips(__UI_ActiveTipID) THEN
__UI_PreviousTipID = __UI_ActiveTipID
ToolTip(__UI_ActiveTipID) = RestoreCHR$(ToolTip(__UI_ActiveTipID))
__UI_TempTips(__UI_ActiveTipID) = ToolTip(__UI_ActiveTipID)
DIM ThisLine%, TextTop%
DIM FindLF AS LONG, TotalLines AS INTEGER, LongestLine AS INTEGER, TempLine$
_FONT Control(__UI_FormID).Font
TempCaption$ = __UI_WordWrap(Replace(ToolTip(__UI_ActiveTipID), "\n", CHR$(10), False, 0), Control(__UI_FormID).Width / 2, LongestLine, TotalLines)
PanelWidth = LongestLine + 16
IF TotalLines = 1 THEN
PanelHeight = uspacing& + 8
ELSE
PanelHeight = (TotalLines * uspacing&) + 8
END IF
IF ActiveTipPanel <> 0 THEN _FREEIMAGE ActiveTipPanel
ActiveTipPanel = _NEWIMAGE(PanelWidth, PanelHeight, 32)
_DEST ActiveTipPanel
_FONT Control(__UI_FormID).Font
__UI_ShadowBox 0, 0, PanelWidth - 6, PanelHeight - 6, __UI_DefaultColor(__UI_Type_Form, 6), 40, 5
COLOR __UI_DefaultColor(__UI_Type_Form, 1)
IF TotalLines = 1 THEN
__UI_PrintString _WIDTH \ 2 - __UI_PrintWidth(TempCaption$) \ 2 - 1.75, _HEIGHT \ 2 - _ufontheight \ 2 - 1.75, TempCaption$
ELSE
DO WHILE LEN(TempCaption$)
ThisLine% = ThisLine% + 1
TextTop% = 3 + ThisLine% * uspacing& - uspacing&
FindLF& = INSTR(TempCaption$, CHR$(1))
IF FindLF& > 0 THEN
TempLine$ = LEFT$(TempCaption$, FindLF& - 1)
TempCaption$ = MID$(TempCaption$, FindLF& + 1)
ELSE
TempLine$ = TempCaption$
TempCaption$ = ""
IF ThisLine% = 1 THEN TextTop% = ((_HEIGHT \ 2) - uspacing& \ 2)
END IF
__UI_PrintString 5, TextTop%, TempLine$
LOOP
END IF
LINE (0, 0)-(_WIDTH - 6, _HEIGHT - 6), __UI_DefaultColor(__UI_Type_Form, 5), B
__UI_MakeHardwareImage ActiveTipPanel
END IF
_DEST 0
IF __UI_ActiveTipTop + PanelHeight > Control(__UI_FormID).Height THEN
__UI_ActiveTipTop = Control(__UI_FormID).Height - PanelHeight
IF __UI_ActiveTipTop < 0 THEN __UI_ActiveTipTop = 0
END IF
IF __UI_ActiveTipLeft + PanelWidth > Control(__UI_FormID).Width THEN
__UI_ActiveTipLeft = Control(__UI_FormID).Width - PanelWidth
IF __UI_ActiveTipLeft < 0 THEN __UI_ActiveTipLeft = 0
END IF
_PUTIMAGE (__UI_ActiveTipLeft, __UI_ActiveTipTop), ActiveTipPanel
END IF
IF ((__UI_IsResizing AND Control(__UI_ResizingID).AutoSize = False) OR (__UI_IsDragging AND __UI_DraggingID > 0 AND __UI_DraggingID <> __UI_FormID)) AND (_KEYDOWN(100305) = 0 AND _KEYDOWN(100306) = 0) AND __UI_SnapLines THEN
STATIC DragTip AS LONG, TipPanelWidth AS INTEGER
IF DragTip = 0 THEN
_FONT Control(__UI_FormID).Font
TempCaption$ = "Hold Ctrl to bypass snapping"
TipPanelWidth = __UI_PrintWidth(TempCaption$) + 10
PanelHeight = uspacing& + 5 + 5
DragTip = _NEWIMAGE(TipPanelWidth, PanelHeight, 32)
_DEST DragTip
_FONT Control(__UI_FormID).Font
__UI_ShadowBox 0, 0, TipPanelWidth - 6, PanelHeight - 6, __UI_DefaultColor(__UI_Type_Form, 6), 40, 5
COLOR __UI_DefaultColor(__UI_Type_Form, 1)
__UI_PrintString _WIDTH \ 2 - __UI_PrintWidth(TempCaption$) \ 2 - 1.75, _HEIGHT \ 2 - uspacing& \ 2 - 1.75, TempCaption$
LINE (0, 0)-(_WIDTH - 6, _HEIGHT - 6), __UI_DefaultColor(__UI_Type_Form, 5), B
__UI_MakeHardwareImage DragTip
END IF
_DEST 0
__UI_RelevantID = __UI_DraggingID
IF __UI_IsResizing THEN __UI_RelevantID = __UI_ResizingID
IF __UI_Snapped THEN
X1 = _WIDTH \ 2 - TipPanelWidth \ 2
Y1 = 0
IF Control(__UI_RelevantID).Top <= _HEIGHT(DragTip) THEN
_PUTIMAGE (X1, Control(__UI_FormID).Height - _HEIGHT(DragTip)), DragTip
ELSE
_PUTIMAGE (X1, 0), DragTip
END IF
END IF
ELSEIF __UI_IsResizing AND Control(__UI_ResizingID).Type = __UI_Type_Label AND Control(__UI_ResizingID).AutoSize = True THEN
STATIC ResizeTip AS LONG, ResizeTipPanelWidth AS INTEGER
IF ResizeTip = 0 THEN
_FONT Control(__UI_FormID).Font
TempCaption$ = "Can't resize a label when .AutoSize = True"
ResizeTipPanelWidth = __UI_PrintWidth(TempCaption$) + 10
PanelHeight = uspacing& + 5 + 5
ResizeTip = _NEWIMAGE(ResizeTipPanelWidth, PanelHeight, 32)
_DEST ResizeTip
_FONT Control(__UI_FormID).Font
__UI_ShadowBox 0, 0, ResizeTipPanelWidth - 6, PanelHeight - 6, __UI_DefaultColor(__UI_Type_Form, 6), 40, 5
COLOR __UI_DefaultColor(__UI_Type_Form, 1)
__UI_PrintString _WIDTH \ 2 - __UI_PrintWidth(TempCaption$) \ 2 - 1.75, _HEIGHT \ 2 - uspacing& \ 2 - 1.75, TempCaption$
LINE (0, 0)-(_WIDTH - 6, _HEIGHT - 6), __UI_DefaultColor(__UI_Type_Form, 5), B
__UI_MakeHardwareImage ResizeTip
END IF
_DEST 0
X1 = _WIDTH \ 2 - ResizeTipPanelWidth \ 2
Y1 = 0
IF Control(__UI_ResizingID).Top <= _HEIGHT(ResizeTip) THEN
_PUTIMAGE (X1, Control(__UI_FormID).Height - _HEIGHT(ResizeTip)), ResizeTip
ELSE
_PUTIMAGE (X1, 0), ResizeTip
END IF
END IF
__UI_ForceRedraw = False
STATIC WaitMessageSetup AS _BYTE, PrevWaitMessage AS STRING
DIM NoInputMessage$
IF TIMER - __UI_ProcessInputTimer > 2 THEN
'Visually indicate that something is hogging the input routine
IF __UI_WaitMessageHandle = 0 THEN
__UI_WaitMessageHandle = _NEWIMAGE(_WIDTH(0), _HEIGHT(0), 32)
ELSEIF _WIDTH(__UI_WaitMessageHandle) <> _WIDTH(0) OR _HEIGHT(__UI_WaitMessageHandle) <> _HEIGHT(0) THEN
_FREEIMAGE __UI_WaitMessageHandle
__UI_WaitMessageHandle = _NEWIMAGE(_WIDTH(0), _HEIGHT(0), 32)
END IF
IF WaitMessageSetup = False OR PrevWaitMessage <> __UI_WaitMessage THEN
PrevWaitMessage = __UI_WaitMessage
WaitMessageSetup = True
PrevDest = _DEST
_DEST __UI_WaitMessageHandle
LINE (0, 0)-STEP(_WIDTH, _HEIGHT), _RGBA32(0, 0, 0, 170), BF
_FONT Control(__UI_FormID).Font
_PRINTMODE _KEEPBACKGROUND
NoInputMessage$ = "Please wait..."
COLOR _RGB32(0, 0, 0)
__UI_PrintString _WIDTH / 2 - __UI_PrintWidth(NoInputMessage$) / 2 + 1, _HEIGHT \ 2 - uspacing + 1, NoInputMessage$
COLOR _RGB32(255, 255, 255)
__UI_PrintString _WIDTH / 2 - __UI_PrintWidth(NoInputMessage$) / 2, _HEIGHT \ 2 - uspacing, NoInputMessage$
IF LEN(__UI_WaitMessage) > 0 THEN
IF LEFT$(__UI_WaitMessage, 1) <> "(" THEN __UI_WaitMessage = "(" + __UI_WaitMessage + ")"
COLOR _RGB32(0, 0, 0)
__UI_PrintString _WIDTH / 2 - __UI_PrintWidth(__UI_WaitMessage) / 2 + 1, _HEIGHT \ 2 + uspacing + 1, __UI_WaitMessage
COLOR _RGB32(255, 255, 255)
__UI_PrintString _WIDTH / 2 - __UI_PrintWidth(__UI_WaitMessage) / 2, _HEIGHT \ 2 + uspacing, __UI_WaitMessage
END IF
_DEST PrevDest
__UI_MakeHardwareImage __UI_WaitMessageHandle
END IF
IF _EXIT THEN SYSTEM 'Can't force user to wait...
_PUTIMAGE , __UI_WaitMessageHandle
END IF
FOR i = 1 TO 2
IF ControlDrawOrder(UBOUND(ControlDrawOrder)) = 0 THEN __UI_ExpandControlDrawOrder -1
NEXT i 'run that a couple times for good measure
_DISPLAY
END SUB
'---------------------------------------------------------------------------------
SUB __UI_EventDispatcher
STATIC __UI_LastMouseIconSet AS _BYTE
STATIC __UI_LastMouseDownEvent AS SINGLE
STATIC __UI_MouseDownTop AS INTEGER, __UI_MouseDownLeft AS INTEGER
STATIC __UI_JustOpenedMenu AS _BYTE
STATIC OriginalDragX AS INTEGER, OriginalDragY AS INTEGER
STATIC OriginalResizeRightSide AS INTEGER, OriginalResizeBottom AS INTEGER
DIM i AS LONG, j AS LONG, ThisItem%, TempParent AS LONG
DIM ContainerOffsetLeft AS INTEGER, ContainerOffsetTop AS INTEGER
IF __UI_HoveringID = 0 AND __UI_Focus = 0 THEN EXIT SUB
IF Control(__UI_HoveringID).ParentID > 0 AND Control(__UI_HoveringID).Type <> __UI_Type_MenuItem THEN
ContainerOffsetLeft = Control(Control(__UI_HoveringID).ParentID).Left
ContainerOffsetTop = Control(Control(__UI_HoveringID).ParentID).Top
END IF
IF __UI_ExitTriggered THEN
__UI_UnloadSignal = True
__UI_BeforeUnload
IF __UI_UnloadSignal THEN SYSTEM
END IF
'Have we had a resize?
IF __UI_HasResized THEN __UI_FormResized: __UI_HasResized = False
'Hover actions
IF __UI_LastHoveringID <> __UI_HoveringID OR __UI_HoveringID = __UI_ActiveDropdownList THEN
'MouseEnter, MouseLeave
IF __UI_LastHoveringID THEN __UI_MouseLeave __UI_LastHoveringID
__UI_MouseEnter __UI_HoveringID
STATIC LastMouseLeft AS INTEGER, LastMouseTop AS INTEGER
IF NOT __UI_DraggingThumb AND __UI_HoveringID = __UI_ActiveDropdownList AND Control(__UI_HoveringID).HoveringVScrollbarButton = 0 AND LastMouseTop <> __UI_MouseTop THEN
'Dropdown list items are preselected when hovered
LastMouseTop = __UI_MouseTop
IF Control(__UI_HoveringID).Max > 0 THEN
IF Control(__UI_HoveringID).Font > 0 THEN _FONT Control(__UI_HoveringID).Font
ThisItem% = ((__UI_MouseTop - (ContainerOffsetTop + Control(__UI_HoveringID).Top) - (ABS(Control(__UI_HoveringID).HasBorder) * __UI_DefaultCaptionIndent)) \ Control(__UI_HoveringID).ItemHeight) + Control(__UI_HoveringID).InputViewStart
IF ThisItem% >= Control(__UI_HoveringID).Min AND ThisItem% <= Control(__UI_HoveringID).Max THEN
Control(__UI_HoveringID).Value = ThisItem%
IF Control(__UI_HoveringID).PreviousValue <> Control(__UI_HoveringID).Value THEN
__UI_ValueChanged __UI_HoveringID
Control(__UI_HoveringID).PreviousValue = Control(__UI_HoveringID).Value
Control(__UI_HoveringID).Redraw = True
END IF
END IF
END IF
ELSEIF Control(__UI_HoveringID).Type = __UI_Type_MenuBar AND LastMouseLeft <> __UI_MouseLeft THEN
LastMouseLeft = __UI_MouseLeft
IF __UI_TotalActiveMenus > 0 AND __UI_ParentMenu(__UI_TotalActiveMenus) <> __UI_HoveringID THEN
IF __UI_ActiveMenuIsContextMenu = False AND __UI_DesignMode = False THEN
__UI_ActivateMenu Control(__UI_HoveringID), False
__UI_ForceRedraw = True
END IF
END IF
END IF
IF Control(__UI_Focus).Type = __UI_Type_MenuItem AND Control(__UI_HoveringID).Type <> __UI_Type_MenuItem THEN
__UI_Focus = __UI_ActiveMenu(__UI_TotalActiveMenus)
END IF
END IF
$IF WIN OR MAC THEN
IF __UI_ResizeHandleHover = 1 OR __UI_ResizeHandleHover = 3 THEN
IF __UI_LastMouseIconSet <> 3 THEN
__UI_LastMouseIconSet = 3
_MOUSESHOW "horizontal"
END IF
ELSEIF __UI_ResizeHandleHover = 2 OR __UI_ResizeHandleHover = 4 THEN
IF __UI_LastMouseIconSet <> 4 THEN
__UI_LastMouseIconSet = 4
_MOUSESHOW "vertical"
END IF
ELSEIF __UI_ResizeHandleHover = 5 OR __UI_ResizeHandleHover = 8 THEN
IF __UI_LastMouseIconSet <> 5 THEN
__UI_LastMouseIconSet = 5
_MOUSESHOW "topright_bottomleft"
END IF
ELSEIF __UI_ResizeHandleHover = 6 OR __UI_ResizeHandleHover = 7 THEN
IF __UI_LastMouseIconSet <> 6 THEN
__UI_LastMouseIconSet = 6
_MOUSESHOW "topleft_bottomright"
END IF
ELSEIF Control(__UI_HoveringID).Type = __UI_Type_TextBox AND NOT __UI_DesignMode THEN
IF Control(__UI_HoveringID).HasVScrollbar AND __UI_MouseLeft >= Control(__UI_HoveringID).Left + Control(Control(__UI_HoveringID).ParentID).Left + Control(__UI_HoveringID).Width - __UI_ScrollbarWidth - 1 THEN
IF __UI_LastMouseIconSet <> 0 THEN
__UI_LastMouseIconSet = 0
_MOUSESHOW "default"
END IF
ELSE
IF __UI_LastMouseIconSet <> 2 THEN
__UI_LastMouseIconSet = 2
_MOUSESHOW "text"
END IF
END IF
ELSE
IF __UI_LastMouseIconSet <> 0 THEN
__UI_LastMouseIconSet = 0
_MOUSESHOW "default"
END IF
END IF
$END IF
'FocusIn, FocusOut
DIM __UI_FocusSearch AS LONG
IF __UI_KeyHit = 9 AND __UI_IsDragging = False THEN 'TAB
IF __UI_DesignMode THEN
__UI_FocusSearch = __UI_FirstSelectedID
FOR i = 1 TO UBOUND(Control)
Control(i).ControlIsSelected = False
NEXT
DO
IF _KEYDOWN(100304) OR _KEYDOWN(100303) THEN
__UI_FocusSearch = __UI_FocusSearch - 1
IF __UI_FocusSearch < 1 THEN __UI_FocusSearch = UBOUND(Control)
ELSE
__UI_FocusSearch = __UI_FocusSearch + 1
IF __UI_FocusSearch > UBOUND(Control) THEN __UI_FocusSearch = 0
END IF
IF __UI_FocusSearch = __UI_FirstSelectedID THEN
'Full circle. No controls can be selected at the moment
Control(__UI_FocusSearch).ControlIsSelected = True
EXIT DO
END IF
IF Control(__UI_FocusSearch).ID > 0 AND Control(__UI_FocusSearch).Type <> __UI_Type_Form AND Control(__UI_FocusSearch).Type <> __UI_Type_MenuPanel AND Control(__UI_FocusSearch).Type <> __UI_Type_Font AND UCASE$(LEFT$(Control(__UI_FocusSearch).Name, 5)) <> "__UI_" THEN
IF Control(__UI_FocusSearch).Type <> __UI_Type_MenuItem THEN
__UI_CloseAllMenus
__UI_TotalSelectedControls = 1
__UI_FirstSelectedID = __UI_FocusSearch
Control(__UI_FocusSearch).ControlIsSelected = True
IF Control(__UI_FocusSearch).Type = __UI_Type_MenuBar OR Control(__UI_FocusSearch).Type = __UI_Type_ContextMenu THEN
__UI_ActivateMenu Control(__UI_FocusSearch), False
END IF
EXIT DO
ELSE
IF __UI_ParentMenu(__UI_TotalActiveMenus) = Control(__UI_FocusSearch).ParentID THEN
__UI_TotalSelectedControls = 1
__UI_FirstSelectedID = __UI_FocusSearch
Control(__UI_FocusSearch).ControlIsSelected = True
EXIT DO
END IF
END IF
END IF
LOOP
ELSE
__UI_KeyboardFocus = True
__UI_FocusSearch = __UI_Focus
DO
IF _KEYDOWN(100304) OR _KEYDOWN(100303) THEN
__UI_FocusSearch = __UI_FocusSearch - 1
IF __UI_FocusSearch < 1 THEN __UI_FocusSearch = UBOUND(Control)
ELSE
__UI_FocusSearch = __UI_FocusSearch + 1
IF __UI_FocusSearch > UBOUND(Control) THEN __UI_FocusSearch = 0
END IF
IF __UI_FocusSearch = __UI_Focus THEN
'Full circle. No controls can have focus
EXIT DO
END IF
IF Control(__UI_FocusSearch).CanHaveFocus AND Control(__UI_FocusSearch).Disabled = False AND Control(__UI_FocusSearch).Hidden = False AND Control(Control(__UI_FocusSearch).ParentID).Disabled = False AND Control(Control(__UI_FocusSearch).ParentID).Hidden = False THEN
IF __UI_Focus <> __UI_FocusSearch THEN __UI_KeepFocus = False: __UI_FocusOut __UI_Focus
IF __UI_KeepFocus = False THEN
__UI_Focus = __UI_FocusSearch
IF Control(__UI_Focus).Type = __UI_Type_TextBox AND Control(__UI_Focus).Multiline = False THEN
'Single-line textbox contents are selected when first focused.
IF Control(__UI_Focus).BypassSelectOnFocus = False THEN
Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus))
Control(__UI_Focus).SelectionStart = 0
Control(__UI_Focus).TextIsSelected = True
END IF
END IF
__UI_FocusIn __UI_Focus
END IF
EXIT DO
END IF
LOOP
END IF
END IF
'Any visible dropdown lists/menus will be destroyed when focus is lost
IF __UI_DesignMode = False THEN
IF __UI_ActiveDropdownList > 0 AND ((__UI_Focus <> __UI_ActiveDropdownList AND __UI_Focus <> __UI_ParentDropdownList) OR __UI_KeyHit = 27) THEN
__UI_Focus = __UI_ParentDropdownList
__UI_DestroyControl Control(__UI_ActiveDropdownList)
__UI_KeyHit = 0
ELSEIF __UI_TotalActiveMenus > 0 AND (__UI_Focus <> __UI_ActiveMenu(__UI_TotalActiveMenus) AND __UI_Focus <> __UI_ParentMenu(__UI_TotalActiveMenus)) THEN
IF Control(__UI_Focus).Type <> __UI_Type_MenuItem THEN
__UI_CloseAllMenus
__UI_ForceRedraw = True
END IF
END IF
END IF
'MouseWheel
IF __UI_MouseWheel AND NOT __UI_DesignMode THEN
IF (Control(__UI_HoveringID).Type = __UI_Type_ListBox AND NOT Control(__UI_HoveringID).Disabled) THEN
Control(__UI_HoveringID).InputViewStart = Control(__UI_HoveringID).InputViewStart + __UI_MouseWheel
IF Control(__UI_HoveringID).InputViewStart + Control(__UI_HoveringID).LastVisibleItem > Control(__UI_HoveringID).Max THEN
Control(__UI_HoveringID).InputViewStart = Control(__UI_HoveringID).Max - Control(__UI_HoveringID).LastVisibleItem + 1
END IF
ELSEIF (__UI_ActiveDropdownList > 0 AND __UI_Focus = __UI_ActiveDropdownList AND __UI_ParentDropdownList = __UI_HoveringID) THEN
Control(__UI_ActiveDropdownList).InputViewStart = Control(__UI_ActiveDropdownList).InputViewStart + __UI_MouseWheel
IF Control(__UI_ActiveDropdownList).InputViewStart + Control(__UI_ActiveDropdownList).LastVisibleItem > Control(__UI_ActiveDropdownList).Max THEN
Control(__UI_ActiveDropdownList).InputViewStart = Control(__UI_ActiveDropdownList).Max - Control(__UI_ActiveDropdownList).LastVisibleItem + 1
END IF
ELSEIF (Control(__UI_Focus).Type = __UI_Type_DropdownList AND NOT Control(__UI_Focus).Disabled) THEN
Control(__UI_Focus).Value = Control(__UI_Focus).Value + __UI_MouseWheel
IF Control(__UI_Focus).Value < 1 THEN Control(__UI_Focus).Value = 1
IF Control(__UI_Focus).Value > Control(__UI_Focus).Max THEN Control(__UI_Focus).Value = Control(__UI_Focus).Max
IF Control(__UI_Focus).PreviousValue <> Control(__UI_Focus).Value THEN
__UI_ValueChanged __UI_Focus
Control(__UI_Focus).PreviousValue = Control(__UI_Focus).Value
Control(__UI_Focus).Redraw = True
END IF
ELSEIF Control(__UI_Focus).Type = __UI_Type_TextBox AND Control(__UI_Focus).MultiLine THEN
DIM TotalLines AS LONG
TotalLines = __UI_CountLines(__UI_Focus)
_FONT Control(__UI_Focus).Font
IF TotalLines > Control(__UI_Focus).Height \ uspacing& THEN
Control(__UI_Focus).FirstVisibleLine = Control(__UI_Focus).FirstVisibleLine + __UI_MouseWheel
IF Control(__UI_Focus).FirstVisibleLine < 1 THEN Control(__UI_Focus).FirstVisibleLine = 1
IF Control(__UI_Focus).FirstVisibleLine > TotalLines - Control(__UI_Focus).Height \ uspacing& + 1 THEN
Control(__UI_Focus).FirstVisibleLine = TotalLines - Control(__UI_Focus).Height \ uspacing& + 1
END IF
END IF
END IF
END IF
'MouseDown, MouseUp, BeginDrag
IF __UI_MouseButton2 THEN
'Second mouse button is first pressed
IF __UI_Mouse2IsDown = False THEN
__UI_Mouse2IsDown = True
__UI_DidClick = True
__UI_Mouse2DownOnID = __UI_HoveringID
ELSE
'Second mouse button is still pressed
END IF
ELSE
'Second mousebutton is released
IF __UI_Mouse2IsDown THEN
__UI_Mouse2IsDown = False
__UI_Mouse2DownOnID = 0
'Click (second mouse button)
IF __UI_DesignMode THEN
DIM RightClickSelect AS _BYTE
RightClickSelect = True
GOSUB DesignModeClickToSelect
RightClickSelect = False
Control(__UI_GetID("__UI_PreviewMenuShowInvisibleControls")).Value = __UI_ShowInvisibleControls
IF __UI_TotalSelectedControls = 0 THEN
Control(__UI_GetID("__UI_PreviewMenuAlignLeft")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuAlignRight")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuAlignTops")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuAlignBottoms")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuAlignCenterV")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuAlignCenterH")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuAlignCentersV")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuAlignCentersH")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuDistributeV")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuDistributeH")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuCut")).Disabled = True
Control(__UI_GetID("__UI_PreviewMenuCopy")).Disabled = True
Control(__UI_GetID("__UI_PreviewMenuDelete")).Disabled = True
Control(__UI_GetID("__UI_PreviewMenuImageOriginalSize")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuNumericOnly")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuSetDefaultButton")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuBindControls")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuShowInvisibleControls")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuConvertType")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuNewMenuBar")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuNewContextMenu")).Hidden = False
ELSEIF __UI_TotalSelectedControls = 1 THEN
Control(__UI_GetID("__UI_PreviewMenuAlignLeft")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuAlignRight")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuAlignTops")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuAlignBottoms")).Hidden = True
IF Control(__UI_FirstSelectedID).Type <> __UI_Type_ContextMenu AND Control(__UI_FirstSelectedID).Type <> __UI_Type_MenuBar AND Control(__UI_FirstSelectedID).Type <> __UI_Type_MenuItem THEN
Control(__UI_GetID("__UI_PreviewMenuAlignCenterV")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuAlignCenterH")).Hidden = False
SetCaption __UI_GetID("__UI_PreviewMenuAlignCenterV"), "Center &Vertically"
SetCaption __UI_GetID("__UI_PreviewMenuAlignCenterH"), "Center &Horizontally-"
Control(__UI_GetID("__UI_PreviewMenuNewMenuBar")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuNewContextMenu")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuShowInvisibleControls")).Hidden = True
ELSE
Control(__UI_GetID("__UI_PreviewMenuNewMenuBar")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuNewContextMenu")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuShowInvisibleControls")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuAlignCenterV")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuAlignCenterH")).Hidden = True
END IF
IF Control(__UI_FirstSelectedID).Type = __UI_Type_PictureBox AND LEN(Text(__UI_FirstSelectedID)) > 0 THEN
IF Control(__UI_FirstSelectedID).Height - (Control(__UI_FirstSelectedID).BorderSize * ABS(Control(__UI_FirstSelectedID).HasBorder)) <> _HEIGHT(Control(__UI_FirstSelectedID).HelperCanvas) OR _
Control(__UI_FirstSelectedID).Width - (Control(__UI_FirstSelectedID).BorderSize * ABS(Control(__UI_FirstSelectedID).HasBorder)) <> _WIDTH(Control(__UI_FirstSelectedID).HelperCanvas) THEN
Control(__UI_GetID("__UI_PreviewMenuImageOriginalSize")).Hidden = False
SetCaption __UI_GetID("__UI_PreviewMenuImageOriginalSize"), "Restore &image dimensions (" + LTRIM$(STR$(_WIDTH(Control(__UI_FirstSelectedID).HelperCanvas))) + "x" + LTRIM$(STR$(_HEIGHT(Control(__UI_FirstSelectedID).HelperCanvas))) + ")-"
ELSE
Control(__UI_GetID("__UI_PreviewMenuImageOriginalSize")).Hidden = True
END IF
ELSE
Control(__UI_GetID("__UI_PreviewMenuImageOriginalSize")).Hidden = True
END IF
IF Control(__UI_FirstSelectedID).Type = __UI_Type_TextBox THEN
IF Control(__UI_FirstSelectedID).NumericOnly = True THEN
Control(__UI_GetID("__UI_PreviewMenuNumericOnly")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuNumericOnly")).Value = False
ELSEIF Control(__UI_FirstSelectedID).NumericOnly = __UI_NumericWithBounds THEN
Control(__UI_GetID("__UI_PreviewMenuNumericOnly")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuNumericOnly")).Value = True
ELSE
Control(__UI_GetID("__UI_PreviewMenuNumericOnly")).Hidden = True
END IF
ELSE
Control(__UI_GetID("__UI_PreviewMenuNumericOnly")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuNumericOnly")).Value = False
END IF
IF Control(__UI_FirstSelectedID).Type = __UI_Type_Button THEN
IF __UI_FirstSelectedID <> __UI_DefaultButtonID THEN
Control(__UI_GetID("__UI_PreviewMenuSetDefaultButton")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuSetDefaultButton")).Value = False
ELSE
Control(__UI_GetID("__UI_PreviewMenuSetDefaultButton")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuSetDefaultButton")).Value = True
END IF
ELSE
Control(__UI_GetID("__UI_PreviewMenuSetDefaultButton")).Hidden = True
END IF
Control(__UI_GetID("__UI_PreviewMenuAlignCentersV")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuAlignCentersH")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuDistributeV")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuDistributeH")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuCut")).Disabled = False
Control(__UI_GetID("__UI_PreviewMenuCopy")).Disabled = False
Control(__UI_GetID("__UI_PreviewMenuDelete")).Disabled = False
IF __UI_Type(Control(__UI_FirstSelectedID).Type).TurnsInto THEN
Control(__UI_GetID("__UI_PreviewMenuConvertType")).Hidden = False
SetCaption __UI_GetID("__UI_PreviewMenuConvertType"), "Co&nvert to " + RTRIM$(__UI_Type(__UI_Type(Control(__UI_FirstSelectedID).Type).TurnsInto).Name) + "-"
ELSEIF Control(__UI_FirstSelectedID).Type = __UI_Type_TextBox THEN
'Offer to turn text to numeric-only TextBox
Control(__UI_GetID("__UI_PreviewMenuConvertType")).Hidden = False
IF Control(__UI_FirstSelectedID).NumericOnly = False THEN
SetCaption __UI_GetID("__UI_PreviewMenuConvertType"), "Co&nvert to NumericTextBox-"
ELSE
SetCaption __UI_GetID("__UI_PreviewMenuConvertType"), "Co&nvert to TextBox-"
END IF
ELSE
Control(__UI_GetID("__UI_PreviewMenuConvertType")).Hidden = True
END IF
IF Control(__UI_FirstSelectedID).BoundTo > 0 THEN
Control(__UI_GetID("__UI_PreviewMenuBindControls")).Hidden = False
SetCaption __UI_GetID("__UI_PreviewMenuBindControls"), "Edit binding...-"
END IF
ELSEIF __UI_TotalSelectedControls = 2 THEN
Control(__UI_GetID("__UI_PreviewMenuBindControls")).Hidden = False
IF Control(__UI_FirstSelectedID).BoundTo > 0 THEN
SetCaption __UI_GetID("__UI_PreviewMenuBindControls"), "Edit binding...-"
ELSE
SetCaption __UI_GetID("__UI_PreviewMenuBindControls"), "Bind selected controls...-"
END IF
Control(__UI_GetID("__UI_PreviewMenuNewMenuBar")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuNewContextMenu")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuShowInvisibleControls")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuAlignLeft")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuAlignRight")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuAlignTops")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuAlignBottoms")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuAlignCenterV")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuAlignCenterH")).Hidden = False
SetCaption __UI_GetID("__UI_PreviewMenuAlignCenterV"), "Center &Vertically (group)"
SetCaption __UI_GetID("__UI_PreviewMenuAlignCenterH"), "Center &Horizontally (group)-"
Control(__UI_GetID("__UI_PreviewMenuAlignCentersV")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuAlignCentersH")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuDistributeV")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuDistributeH")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuCut")).Disabled = False
Control(__UI_GetID("__UI_PreviewMenuCopy")).Disabled = False
Control(__UI_GetID("__UI_PreviewMenuDelete")).Disabled = False
Control(__UI_GetID("__UI_PreviewMenuImageOriginalSize")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuSetDefaultButton")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuNumericOnly")).Hidden = True
GOTO AddConvertMenu
ELSE
Control(__UI_GetID("__UI_PreviewMenuNewMenuBar")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuNewContextMenu")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuShowInvisibleControls")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuAlignLeft")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuAlignRight")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuAlignTops")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuAlignBottoms")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuAlignCenterV")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuAlignCenterH")).Hidden = False
SetCaption __UI_GetID("__UI_PreviewMenuAlignCenterV"), "Center &Vertically (group)"
SetCaption __UI_GetID("__UI_PreviewMenuAlignCenterH"), "Center &Horizontally (group)-"
Control(__UI_GetID("__UI_PreviewMenuAlignCentersV")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuAlignCentersH")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuDistributeV")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuDistributeH")).Hidden = False
Control(__UI_GetID("__UI_PreviewMenuCut")).Disabled = False
Control(__UI_GetID("__UI_PreviewMenuCopy")).Disabled = False
Control(__UI_GetID("__UI_PreviewMenuDelete")).Disabled = False
Control(__UI_GetID("__UI_PreviewMenuImageOriginalSize")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuSetDefaultButton")).Hidden = True
Control(__UI_GetID("__UI_PreviewMenuNumericOnly")).Hidden = True
AddConvertMenu:
IF __UI_Type(Control(__UI_FirstSelectedID).Type).TurnsInto OR Control(__UI_FirstSelectedID).Type = __UI_Type_TextBox THEN
DIM SearchType AS INTEGER, AddConvertMenuCheck AS _BYTE
SearchType = Control(__UI_FirstSelectedID).Type
AddConvertMenuCheck = True
FOR i = 1 TO UBOUND(Control)
IF Control(i).ControlIsSelected THEN
IF Control(i).Type <> SearchType THEN
AddConvertMenuCheck = False
EXIT FOR
END IF
END IF
NEXT
IF AddConvertMenuCheck THEN
Control(__UI_GetID("__UI_PreviewMenuConvertType")).Hidden = False
IF SearchType = __UI_Type_TextBox THEN
IF Control(__UI_FirstSelectedID).NumericOnly = False THEN
SetCaption __UI_GetID("__UI_PreviewMenuConvertType"), "Co&nvert to NumericTextBox-"
ELSE
SetCaption __UI_GetID("__UI_PreviewMenuConvertType"), "Co&nvert to TextBox-"
END IF
ELSE
SetCaption __UI_GetID("__UI_PreviewMenuConvertType"), "Co&nvert to " + RTRIM$(__UI_Type(__UI_Type(Control(__UI_FirstSelectedID).Type).TurnsInto).Name) + "-"
END IF
ELSE
Control(__UI_GetID("__UI_PreviewMenuConvertType")).Hidden = True
END IF
ELSE
Control(__UI_GetID("__UI_PreviewMenuConvertType")).Hidden = True
END IF
END IF
IF LEFT$(_CLIPBOARD$, LEN(__UI_ClipboardCheck$)) = __UI_ClipboardCheck$ THEN
Control(__UI_GetID("__UI_PreviewMenuPaste")).Disabled = False
ELSE
Control(__UI_GetID("__UI_PreviewMenuPaste")).Disabled = True
END IF
IF Control(__UI_HoveringID).Type = __UI_Type_MenuBar THEN
Control(__UI_GetID("__UI_PreviewMenuCut")).Disabled = True
Control(__UI_GetID("__UI_PreviewMenuCopy")).Disabled = True
END IF
IF __UI_HoveringID > 0 AND Control(__UI_HoveringID).Type <> __UI_Type_MenuItem AND Control(__UI_HoveringID).Type <> __UI_Type_MenuPanel THEN __UI_ActivateMenu Control(__UI_GetID("__UI_PreviewMenu")), False
__UI_CantShowContextMenu = False
IF Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Height > Control(__UI_FormID).Height OR Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Width > Control(__UI_FormID).Width THEN
__UI_CantShowContextMenu = True
END IF
ELSEIF Control(__UI_HoveringID).ContextMenuID > 0 AND Control(__UI_HoveringID).Disabled = False THEN
__UI_Focus = __UI_HoveringID
__UI_PreviousFocus = __UI_Focus
'Internal text field menu:
IF Control(__UI_HoveringID).ContextMenuID = __UI_GetID("__UI_TextFieldMenu") THEN
IF Control(__UI_HoveringID).TextIsSelected THEN
Control(__UI_GetID("__UI_TextMenuCut")).Disabled = False
Control(__UI_GetID("__UI_TextMenuCopy")).Disabled = False
Control(__UI_GetID("__UI_TextMenuDelete")).Disabled = False
ELSE
Control(__UI_GetID("__UI_TextMenuCut")).Disabled = True
Control(__UI_GetID("__UI_TextMenuCopy")).Disabled = True
Control(__UI_GetID("__UI_TextMenuDelete")).Disabled = True
END IF
IF LEN(_CLIPBOARD$) > 0 THEN
Control(__UI_GetID("__UI_TextMenuPaste")).Disabled = False
ELSE
Control(__UI_GetID("__UI_TextMenuPaste")).Disabled = True
END IF
END IF
__UI_ContextMenuSourceID = __UI_HoveringID
__UI_ActivateMenu Control(Control(__UI_HoveringID).ContextMenuID), False
END IF
END IF
END IF
IF __UI_MouseButton1 THEN
'Mouse button is first pressed
IF __UI_MouseIsDown = False THEN
__UI_DidClick = True
__UI_MouseDownTop = __UI_MouseTop
__UI_MouseDownLeft = __UI_MouseLeft
IF __UI_DesignMode THEN
IF LEFT$(Control(__UI_HoveringID).Name, 5) = "__UI_" THEN GOTO ProcessClick
DesignModeClickToSelect:
IF RightClickSelect AND (Control(__UI_HoveringID).Type = __UI_Type_MenuPanel OR LEFT$(Control(__UI_HoveringID).Name, 5) = "__UI_") THEN RETURN
IF __UI_TotalActiveMenus > 0 AND Control(__UI_HoveringID).Type <> __UI_Type_MenuPanel THEN
IF Control(__UI_Focus).Type <> __UI_Type_MenuItem THEN
__UI_CloseAllMenus
__UI_ForceRedraw = True
END IF
END IF
IF _KEYDOWN(100305) OR _KEYDOWN(100306) THEN
IF Control(__UI_HoveringID).Type <> __UI_Type_Frame AND Control(__UI_HoveringID).Type <> __UI_Type_Form AND Control(__UI_HoveringID).Type <> __UI_Type_Font AND Control(__UI_HoveringID).Type <> __UI_Type_MenuItem AND Control(__UI_HoveringID).Type <> __UI_Type_MenuPanel AND Control(__UI_HoveringID).Type <> __UI_Type_ContextMenu AND Control(__UI_HoveringID).Type <> __UI_Type_MenuBar THEN
IF Control(__UI_HoveringID).ControlIsSelected = False AND Control(__UI_HoveringID).ParentID = Control(__UI_FirstSelectedID).ParentID AND Control(__UI_FirstSelectedID).Type <> __UI_Type_Frame THEN
Control(__UI_HoveringID).ControlIsSelected = True
__UI_TotalSelectedControls = __UI_TotalSelectedControls + 1
ELSEIF Control(__UI_HoveringID).ControlIsSelected = True THEN
Control(__UI_HoveringID).ControlIsSelected = False
__UI_TotalSelectedControls = __UI_TotalSelectedControls - 1
IF __UI_TotalSelectedControls = 1 THEN
FOR i = 1 TO UBOUND(Control)
IF Control(i).ControlIsSelected THEN __UI_FirstSelectedID = i: EXIT FOR
NEXT
ELSEIF __UI_TotalSelectedControls > 0 AND __UI_FirstSelectedID = __UI_HoveringID THEN
FOR i = 1 TO UBOUND(Control)
IF Control(i).ControlIsSelected THEN __UI_FirstSelectedID = i: EXIT FOR
NEXT
END IF
END IF
END IF
ELSEIF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN
IF __UI_FirstSelectedID <> __UI_HoveringID AND Control(__UI_HoveringID).Type <> __UI_Type_Frame AND Control(__UI_HoveringID).Type <> __UI_Type_Form AND Control(__UI_HoveringID).Type <> __UI_Type_Font AND Control(__UI_HoveringID).Type <> __UI_Type_MenuItem AND Control(__UI_HoveringID).Type <> __UI_Type_MenuPanel AND Control(__UI_HoveringID).Type <> __UI_Type_ContextMenu AND Control(__UI_HoveringID).Type <> __UI_Type_MenuBar THEN
'Select all controls in the range between the first
'selected and the one being clicked, emulating the
'selection rectangle.
IF Control(__UI_FirstSelectedID).ParentID = Control(__UI_HoveringID).ParentID THEN
__UI_SelectionRectangleLeft = Control(__UI_FirstSelectedID).Left + Control(__UI_FirstSelectedID).Width / 2
__UI_SelectionRectangleTop = Control(__UI_FirstSelectedID).Top + Control(__UI_FirstSelectedID).Height / 2
GOTO DoSelectionRectangle
END IF
END IF
ELSE
IF Control(__UI_HoveringID).Type = __UI_Type_MenuPanel AND LEFT$(Control(__UI_GetParentMenu(__UI_HoveringID)).Name, 5) <> "__UI_" THEN
DIM TempValue AS LONG
TempParent = __UI_GetParentMenu(__UI_HoveringID)
TempValue = __UI_NewControl(__UI_Type_MenuItem, "", 0, 0, 0, 0, TempParent)
SetCaption TempValue, RTRIM$(Control(TempValue).Name)
FOR i = __UI_TotalActiveMenus TO __UI_GetActiveMenuIndex(__UI_HoveringID) STEP -1
__UI_DestroyControl Control(__UI_ActiveMenu(i))
NEXT
__UI_ActivateMenu Control(TempParent), False
FOR i = 1 TO UBOUND(Control)
Control(i).ControlIsSelected = False
NEXT
Control(TempValue).ControlIsSelected = True
__UI_ActivateMenu Control(TempValue), False
__UI_ForceRedraw = True
__UI_TotalSelectedControls = 1
__UI_FirstSelectedID = TempValue
ELSEIF Control(__UI_HoveringID).Type = __UI_Type_Form AND __UI_MouseTop <= (uspacing& + 5) THEN
IF __UI_HasMenuBar THEN
__UI_KeyPress 224
END IF
ELSE
IF Control(__UI_HoveringID).ControlIsSelected = False THEN
FOR i = 1 TO UBOUND(Control)
Control(i).ControlIsSelected = False
NEXT
__UI_TotalSelectedControls = 0
__UI_FirstSelectedID = 0
IF Control(__UI_HoveringID).Type <> __UI_Type_Form AND Control(__UI_HoveringID).Type <> __UI_Type_Font AND Control(__UI_HoveringID).Type <> __UI_Type_MenuPanel THEN
IF Control(__UI_HoveringID).Type = __UI_Type_ContextMenu AND __UI_ShowInvisibleControls = False THEN GOTO SkipInvisibleControl
Control(__UI_HoveringID).ControlIsSelected = True
__UI_TotalSelectedControls = 1
__UI_FirstSelectedID = __UI_HoveringID
IF Control(__UI_HoveringID).Type = __UI_Type_MenuItem OR Control(__UI_HoveringID).Type = __UI_Type_MenuBar OR (Control(__UI_HoveringID).Type = __UI_Type_ContextMenu AND __UI_ShowInvisibleControls) THEN
__UI_ActivateMenu Control(__UI_HoveringID), False
__UI_JustOpenedMenu = True
END IF
SkipInvisibleControl:
END IF
ELSE
IF Control(__UI_FirstSelectedID).Type = __UI_Type_Frame AND (TIMER - __UI_LastMouseDownEvent < .5 AND (__UI_MouseTop = __UI_MouseDownTop AND __UI_MouseLeft = __UI_MouseDownLeft)) THEN
'Select all controls inside a frame
__UI_KeyPress 221
END IF
END IF
END IF
END IF
IF RightClickSelect THEN RETURN
ELSEIF Control(__UI_HoveringID).CanHaveFocus AND NOT Control(__UI_HoveringID).Disabled THEN
STATIC JustEnteredTextBox AS SINGLE
IF __UI_Focus <> __UI_HoveringID THEN
__UI_KeepFocus = False: __UI_FocusOut __UI_Focus
IF __UI_KeepFocus = False THEN
__UI_Focus = __UI_HoveringID
IF Control(__UI_Focus).Type = __UI_Type_TextBox THEN JustEnteredTextBox = TIMER
__UI_FocusIn __UI_Focus
END IF
END IF
ELSE
IF Control(__UI_HoveringID).Type = __UI_Type_MenuBar AND __UI_TotalActiveMenus > 0 AND __UI_HoveringID = __UI_ParentMenu(__UI_TotalActiveMenus) THEN
__UI_Focus = __UI_PreviousFocus
ELSEIF Control(__UI_HoveringID).Type = __UI_Type_MenuBar AND (__UI_TotalActiveMenus = 0 OR __UI_ActiveMenuIsContextMenu) THEN
__UI_CloseAllMenus
__UI_ActivateMenu Control(__UI_HoveringID), False
__UI_JustOpenedMenu = True
ELSEIF Control(__UI_HoveringID).Type = __UI_Type_MenuItem THEN
'Do nothing until mouseup (click)
ELSE
IF __UI_Focus > 0 THEN __UI_KeepFocus = False: __UI_FocusOut __UI_Focus
IF __UI_KeepFocus = False THEN __UI_Focus = 0
END IF
END IF
__UI_MouseIsDown = True
__UI_MouseDownOnID = __UI_HoveringID
IF __UI_DesignMode AND __UI_MouseDownOnID = __UI_FormID THEN
__UI_SelectionRectangle = True
__UI_SelectionRectangleTop = __UI_MouseTop
__UI_SelectionRectangleLeft = __UI_MouseLeft
ELSE
__UI_SelectionRectangle = False
END IF
IF NOT __UI_DesignMode THEN
IF Control(__UI_Focus).Type = __UI_Type_TextBox AND NOT Control(__UI_Focus).Disabled THEN
_FONT Control(__UI_Focus).Font
IF Control(__UI_HoveringID).HoveringVScrollbarButton = 1 OR Control(__UI_HoveringID).HoveringVScrollbarButton = 2 OR Control(__UI_HoveringID).HoveringVScrollbarButton = 4 OR Control(__UI_HoveringID).HoveringVScrollbarButton = 5 THEN
__UI_MouseDownOnScrollbar = TIMER
ELSEIF Control(__UI_HoveringID).HoveringVScrollbarButton = 3 THEN
IF NOT __UI_DraggingThumb THEN
__UI_DraggingThumb = True
__UI_ThumbDragTop = __UI_MouseTop
__UI_DraggingThumbOnID = __UI_HoveringID
END IF
ELSE
IF TIMER - JustEnteredTextBox =< .3 THEN
IF Control(__UI_Focus).Multiline THEN
GOTO PositionCursorMultilineTB
ELSE
'Single-line textbox contents are selected when first focused.
IF Control(__UI_Focus).BypassSelectOnFocus = False THEN
Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus))
Control(__UI_Focus).SelectionStart = 0
Control(__UI_Focus).TextIsSelected = True
END IF
END IF
ELSE
STATIC WholeWordSelection AS _BYTE, WholeWordCursor AS LONG, WholeWordSelStart AS LONG
Control(__UI_Focus).TextIsSelected = False
__UI_FillSelectedText 0, 0
WholeWordSelection = False
WholeWordCursor = 0
WholeWordSelStart = 0
IF Control(__UI_Focus).Multiline AND Control(__UI_Focus).HoveringVScrollbarButton = 0 THEN
PositionCursorMultilineTB:
'Multi-line textbox click (position cursor)
'Calculate which line was clicked
DIM ThisLine$, ThisLineLen AS LONG, ThisLineStart AS LONG
TotalLines = __UI_CountLines(__UI_Focus)
Control(__UI_Focus).CurrentLine = Control(__UI_Focus).FirstVisibleLine - 1 + (__UI_MouseTop - Control(__UI_Focus).Top - Control(Control(__UI_Focus).ParentID).Top) / uspacing&
IF Control(__UI_Focus).CurrentLine > TotalLines THEN Control(__UI_Focus).CurrentLine = TotalLines
IF Control(__UI_Focus).CurrentLine = 0 THEN Control(__UI_Focus).CurrentLine = 1
ThisLine$ = __UI_GetTextBoxLine(__UI_Focus, Control(__UI_Focus).CurrentLine, ThisLineStart)
ThisLineLen = LEN(ThisLine$)
'Print the text offscreen just to fill the right variables
__UI_CharPos ThisLine$
'New cursor position:
FOR i = 1 TO __UI_LastRenderedCharCount
IF (__UI_MouseLeft - Control(__UI_Focus).Left - Control(Control(__UI_Focus).ParentID).Left) >= __UI_ThisLineChars(i - 1) AND (__UI_MouseLeft - Control(__UI_Focus).Left - Control(Control(__UI_Focus).ParentID).Left) <= __UI_ThisLineChars(i) THEN
Control(__UI_Focus).Cursor = ThisLineStart + i - 2
EXIT FOR
END IF
NEXT
IF i > __UI_LastRenderedCharCount THEN Control(__UI_Focus).Cursor = ThisLineStart + ThisLineLen - 1
Control(__UI_Focus).SelectionStart = Control(__UI_Focus).Cursor
ELSE
'Position cursor in single-line textbox:
STATIC LastCursorReposition#, LastCursorID AS LONG, LastCursor AS LONG
STATIC JustSelectedAWord#, ContinuedSelection AS _BYTE
IF TIMER - LastCursorReposition# < .3 AND LastCursorID = __UI_Focus AND i <= __UI_LastRenderedCharCount AND LastCursor = Control(__UI_Focus).Cursor THEN
'Double click on this textbox, same position.
'Attempt to select this "word", with "word" being
'any block of characters separated by a space, comma, or similar.
CONST SEP$ = " ,.?!;:()=+-*/"
IF INSTR(SEP$, MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor + 1, 1)) = 0 THEN
RepositionCursorWholeWord:
DO
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor - 1
IF Control(__UI_Focus).Cursor = 0 THEN EXIT DO
LOOP WHILE INSTR(SEP$, MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor + 1, 1)) = 0
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor + 1
IF ContinuedSelection THEN RETURN
RepositionSelStartWholeWord:
DO
Control(__UI_Focus).SelectionStart = Control(__UI_Focus).SelectionStart + 1
IF Control(__UI_Focus).SelectionStart = LEN(Text(__UI_Focus)) THEN EXIT DO
LOOP WHILE INSTR(SEP$, MID$(Text(__UI_Focus), Control(__UI_Focus).SelectionStart + 1, 1)) = 0
DO
'Select extra spaces to the right until another character is found,
'for easy "whole word" replacement/deletion
IF Control(__UI_Focus).SelectionStart = LEN(Text(__UI_Focus)) THEN EXIT DO
IF MID$(Text(__UI_Focus), Control(__UI_Focus).SelectionStart + 1, 1) = " " THEN
Control(__UI_Focus).SelectionStart = Control(__UI_Focus).SelectionStart + 1
ELSE
EXIT DO
END IF
LOOP
IF ContinuedSelection THEN RETURN
Control(__UI_Focus).TextIsSelected = True
JustSelectedAWord# = TIMER
WholeWordSelection = True
WholeWordCursor = Control(__UI_Focus).Cursor
WholeWordSelStart = Control(__UI_Focus).SelectionStart
END IF
ELSE
IF TIMER - JustSelectedAWord# > .3 THEN
Control(__UI_Focus).TextIsSelected = False
__UI_FillSelectedText 0, 0
'Print the text offscreen just to fill the right variables
__UI_CharPos Text(__UI_Focus)
'Single-line textbox click
FOR i = 1 TO __UI_LastRenderedCharCount
IF (__UI_MouseLeft - Control(__UI_Focus).Left - Control(Control(__UI_Focus).ParentID).Left + Control(__UI_Focus).InputViewStart) >= __UI_ThisLineChars(i - 1) AND (__UI_MouseLeft - Control(__UI_Focus).Left - Control(Control(__UI_Focus).ParentID).Left) + Control(__UI_Focus).InputViewStart <= __UI_ThisLineChars(i) THEN
Control(__UI_Focus).Cursor = i - 1
EXIT FOR
END IF
NEXT
IF i > __UI_LastRenderedCharCount THEN Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus))
Control(__UI_Focus).SelectionStart = Control(__UI_Focus).Cursor
END IF
END IF
LastCursorReposition# = TIMER
LastCursorID = __UI_Focus
LastCursor = Control(__UI_Focus).Cursor
END IF
__UI_IsSelectingText = True
__UI_IsSelectingTextOnID = __UI_Focus
END IF
END IF
ELSEIF Control(__UI_HoveringID).Type = __UI_Type_ListBox AND NOT Control(__UI_HoveringID).Disabled THEN
IF Control(__UI_HoveringID).HoveringVScrollbarButton = 1 OR Control(__UI_HoveringID).HoveringVScrollbarButton = 2 OR Control(__UI_HoveringID).HoveringVScrollbarButton = 4 OR Control(__UI_HoveringID).HoveringVScrollbarButton = 5 THEN
__UI_MouseDownOnScrollbar = TIMER
ELSEIF Control(__UI_HoveringID).HoveringVScrollbarButton = 3 THEN
IF NOT __UI_DraggingThumb THEN
__UI_DraggingThumb = True
__UI_ThumbDragTop = __UI_MouseTop
__UI_DraggingThumbOnID = __UI_HoveringID
END IF
END IF
END IF
END IF
__UI_MouseDown __UI_HoveringID
__UI_LastMouseDownEvent = TIMER
ELSE
'Mouse button is still pressed
IF __UI_DesignMode THEN
IF __UI_ResizeHandleHover = 0 AND (__UI_MouseTop <> __UI_MouseDownTop OR __UI_MouseLeft <> __UI_MouseDownLeft) THEN
IF __UI_IsDragging = False AND __UI_SelectionRectangle = False THEN
__UI_IsDragging = True
__UI_DraggingID = __UI_HoveringID
FOR i = 1 TO UBOUND(Control)
IF Control(i).ControlIsSelected AND Control(i).Type = __UI_Type_Frame THEN
'Frames can't be dragged with other controls
__UI_DraggingID = i
FOR i = 1 TO UBOUND(Control)
IF i <> __UI_DraggingID THEN
IF Control(i).ControlIsSelected THEN
Control(i).ControlIsSelected = False
__UI_TotalSelectedControls = __UI_TotalSelectedControls - 1
END IF
END IF
NEXT
EXIT FOR
END IF
NEXT
IF Control(__UI_FirstSelectedID).Type = __UI_Type_ContextMenu OR Control(__UI_FirstSelectedID).Type = __UI_Type_MenuBar OR Control(__UI_FirstSelectedID).Type = __UI_Type_MenuItem THEN
__UI_DraggingID = 0
__UI_IsDragging = False
__UI_MouseDownOnID = 0
ELSE
__UI_MouseDownOnID = 0
__UI_DragY = __UI_MouseTop
__UI_DragX = __UI_MouseLeft
OriginalDragX = __UI_DragX - Control(__UI_DraggingID).Left - Control(Control(__UI_DraggingID).ParentID).Left
OriginalDragY = __UI_DragY - Control(__UI_DraggingID).Top - Control(Control(__UI_DraggingID).ParentID).Top
IF __UI_TotalSelectedControls > 1 THEN
FOR i = 1 TO UBOUND(Control)
IF i <> __UI_DraggingID THEN
Control(i).LeftOffsetFromFirstSelected = Control(__UI_DraggingID).Left - Control(i).Left
Control(i).TopOffsetFromFirstSelected = Control(__UI_DraggingID).Top - Control(i).Top
END IF
NEXT
END IF
END IF
END IF
ELSE
IF __UI_IsResizing = False AND __UI_SelectionRectangle = False AND Control(__UI_FirstSelectedID).Type <> __UI_Type_MenuBar AND Control(__UI_FirstSelectedID).Type <> __UI_Type_MenuItem THEN
__UI_IsResizing = True
__UI_ResizingID = __UI_HoveringID
OriginalResizeRightSide = Control(__UI_ResizingID).Left + Control(__UI_ResizingID).Width
OriginalResizeBottom = Control(__UI_ResizingID).Top + Control(__UI_ResizingID).Height
__UI_MouseDownOnID = 0
__UI_DragY = __UI_MouseTop
__UI_DragX = __UI_MouseLeft
OriginalDragX = __UI_DragX
OriginalDragY = __UI_DragY
END IF
END IF
END IF
IF TIMER - JustEnteredTextBox < .3 THEN JustEnteredTextBox = TIMER
IF __UI_IsSelectingText THEN
_FONT (Control(__UI_IsSelectingTextOnID).Font)
IF NOT Control(__UI_IsSelectingTextOnID).Multiline THEN
'Print the text offscreen just to fill the right variables
__UI_CharPos Text(__UI_Focus)
IF NOT WholeWordSelection THEN
'Single line selection, char by char
IF __UI_MouseLeft > Control(__UI_Focus).Left + Control(Control(__UI_Focus).ParentID).Left AND __UI_MouseLeft < Control(__UI_Focus).Left + Control(Control(__UI_Focus).ParentID).Left + Control(__UI_Focus).Width THEN
FOR i = 1 TO __UI_LastRenderedCharCount
IF (__UI_MouseLeft - Control(__UI_Focus).Left - Control(Control(__UI_Focus).ParentID).Left + Control(__UI_Focus).InputViewStart) >= __UI_ThisLineChars(i - 1) AND (__UI_MouseLeft - Control(__UI_Focus).Left - Control(Control(__UI_Focus).ParentID).Left) + Control(__UI_Focus).InputViewStart <= __UI_ThisLineChars(i) THEN
Control(__UI_Focus).Cursor = i - 1
EXIT FOR
END IF
NEXT
IF i > __UI_LastRenderedCharCount THEN Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus))
ELSEIF __UI_MouseLeft < Control(__UI_Focus).Left + Control(Control(__UI_Focus).ParentID).Left THEN
Control(__UI_Focus).Cursor = 0
ELSEIF __UI_MouseLeft > Control(__UI_Focus).Left + Control(Control(__UI_Focus).ParentID).Left + Control(__UI_Focus).Width THEN
Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus))
END IF
IF Control(__UI_IsSelectingTextOnID).Cursor <> Control(__UI_IsSelectingTextOnID).SelectionStart THEN
Control(__UI_IsSelectingTextOnID).TextIsSelected = True
ELSE
Control(__UI_IsSelectingTextOnID).TextIsSelected = False
END IF
ELSE
'Single line selection, word by word
DIM TempCursor AS LONG
IF __UI_MouseLeft > Control(__UI_Focus).Left + Control(Control(__UI_Focus).ParentID).Left AND __UI_MouseLeft < Control(__UI_Focus).Left + Control(Control(__UI_Focus).ParentID).Left + Control(__UI_Focus).Width THEN
FOR i = 1 TO __UI_LastRenderedCharCount
IF (__UI_MouseLeft - Control(__UI_Focus).Left - Control(Control(__UI_Focus).ParentID).Left + Control(__UI_Focus).InputViewStart) >= __UI_ThisLineChars(i - 1) AND (__UI_MouseLeft - Control(__UI_Focus).Left - Control(Control(__UI_Focus).ParentID).Left) + Control(__UI_Focus).InputViewStart <= __UI_ThisLineChars(i) THEN
TempCursor = i - 1
EXIT FOR
END IF
NEXT
ELSEIF __UI_MouseLeft < Control(__UI_Focus).Left + Control(Control(__UI_Focus).ParentID).Left THEN
TempCursor = 0
ELSEIF __UI_MouseLeft > Control(__UI_Focus).Left + Control(Control(__UI_Focus).ParentID).Left + Control(__UI_Focus).Width THEN
TempCursor = LEN(Text(__UI_Focus))
END IF
ContinuedSelection = True
IF TempCursor < WholeWordCursor THEN Control(__UI_Focus).Cursor = TempCursor: GOSUB RepositionCursorWholeWord
IF TempCursor > WholeWordSelStart THEN Control(__UI_Focus).SelectionStart = TempCursor: GOSUB RepositionSelStartWholeWord
IF TempCursor > WholeWordCursor AND TempCursor < WholeWordSelStart THEN Control(__UI_Focus).Cursor = WholeWordCursor: Control(__UI_Focus).SelectionStart = WholeWordSelStart
ContinuedSelection = False
END IF
ELSE
'Multi-line textbox click
'Calculate current line
TotalLines = __UI_CountLines(__UI_IsSelectingTextOnID)
Control(__UI_IsSelectingTextOnID).CurrentLine = Control(__UI_IsSelectingTextOnID).FirstVisibleLine - 1 + (__UI_MouseTop - Control(__UI_IsSelectingTextOnID).Top - Control(Control(__UI_IsSelectingTextOnID).ParentID).Top) / uspacing&
IF Control(__UI_IsSelectingTextOnID).CurrentLine > TotalLines THEN Control(__UI_IsSelectingTextOnID).CurrentLine = TotalLines
IF Control(__UI_IsSelectingTextOnID).CurrentLine = 0 THEN Control(__UI_IsSelectingTextOnID).CurrentLine = 1
ThisLine$ = __UI_GetTextBoxLine(__UI_IsSelectingTextOnID, Control(__UI_IsSelectingTextOnID).CurrentLine, ThisLineStart)
ThisLineLen = LEN(ThisLine$)
__UI_CharPos ThisLine$ ' print the text offscreen just to fill the right variables
'New cursor position:
FOR i = 1 TO __UI_LastRenderedCharCount
IF (__UI_MouseLeft - Control(__UI_IsSelectingTextOnID).Left - Control(Control(__UI_IsSelectingTextOnID).ParentID).Left) >= __UI_ThisLineChars(i - 1) AND (__UI_MouseLeft - Control(__UI_IsSelectingTextOnID).Left - Control(Control(__UI_IsSelectingTextOnID).ParentID).Left) <= __UI_ThisLineChars(i) THEN
Control(__UI_IsSelectingTextOnID).Cursor = ThisLineStart + i - 2
EXIT FOR
END IF
NEXT
IF i > __UI_LastRenderedCharCount THEN Control(__UI_IsSelectingTextOnID).Cursor = ThisLineStart + ThisLineLen - 1
IF Control(__UI_IsSelectingTextOnID).Cursor <> Control(__UI_IsSelectingTextOnID).SelectionStart THEN
Control(__UI_IsSelectingTextOnID).TextIsSelected = True
END IF
END IF
END IF
IF NOT __UI_SelectionRectangle THEN
IF __UI_MouseDownOnID <> __UI_HoveringID AND __UI_MouseDownOnID > 0 THEN
IF Control(__UI_HoveringID).Type = __UI_Type_MenuItem OR Control(__UI_HoveringID).Type = __UI_Type_MenuPanel THEN
__UI_MouseDownOnID = __UI_HoveringID
ELSE
__UI_PreviousMouseDownOnID = __UI_MouseDownOnID
__UI_MouseDownOnID = 0
END IF
ELSEIF __UI_HoveringID = __UI_PreviousMouseDownOnID AND __UI_PreviousMouseDownOnID > 0 THEN
__UI_MouseDownOnID = __UI_PreviousMouseDownOnID
__UI_PreviousMouseDownOnID = 0
ELSEIF __UI_MouseDownOnID = __UI_HoveringID THEN
IF Control(__UI_MouseDownOnID).Type = __UI_Type_ListBox THEN
IF NOT Control(__UI_MouseDownOnID).Disabled AND Control(__UI_MouseDownOnID).HoveringVScrollbarButton = 1 AND TIMER - __UI_MouseDownOnScrollbar > .3 THEN
'Mousedown on "up" button
Control(__UI_MouseDownOnID).InputViewStart = Control(__UI_MouseDownOnID).InputViewStart - 1
__UI_MouseDownOnScrollbar = TIMER - .25
ELSEIF NOT Control(__UI_MouseDownOnID).Disabled AND Control(__UI_MouseDownOnID).HoveringVScrollbarButton = 2 AND TIMER - __UI_MouseDownOnScrollbar > .3 THEN
'Mousedown on "down" button
IF Control(__UI_MouseDownOnID).InputViewStart + Control(__UI_MouseDownOnID).LastVisibleItem <= Control(__UI_MouseDownOnID).Max THEN
Control(__UI_MouseDownOnID).InputViewStart = Control(__UI_MouseDownOnID).InputViewStart + 1
END IF
__UI_MouseDownOnScrollbar = TIMER - .25
ELSEIF NOT Control(__UI_MouseDownOnID).Disabled AND Control(__UI_MouseDownOnID).HoveringVScrollbarButton = 4 AND TIMER - __UI_MouseDownOnScrollbar < .3 THEN
'Mousedown on "track" area above the thumb
Control(__UI_MouseDownOnID).InputViewStart = Control(__UI_MouseDownOnID).InputViewStart - (Control(__UI_MouseDownOnID).LastVisibleItem - 1)
__UI_MouseDownOnScrollbar = TIMER - .25
ELSEIF NOT Control(__UI_MouseDownOnID).Disabled AND Control(__UI_MouseDownOnID).HoveringVScrollbarButton = 5 AND TIMER - __UI_MouseDownOnScrollbar < .3 THEN
'Mousedown on "track" area below the thumb
Control(__UI_MouseDownOnID).InputViewStart = Control(__UI_MouseDownOnID).InputViewStart + (Control(__UI_MouseDownOnID).LastVisibleItem - 1)
IF Control(__UI_MouseDownOnID).InputViewStart > Control(__UI_MouseDownOnID).Max - Control(__UI_MouseDownOnID).LastVisibleItem - 1 THEN
Control(__UI_MouseDownOnID).InputViewStart = Control(__UI_MouseDownOnID).Max - Control(__UI_MouseDownOnID).LastVisibleItem - 1
END IF
__UI_MouseDownOnScrollbar = TIMER - .25
END IF
ELSEIF Control(__UI_MouseDownOnID).Type = __UI_Type_TextBox THEN
_FONT Control(__UI_MouseDownOnID).Font
IF NOT Control(__UI_MouseDownOnID).Disabled AND Control(__UI_MouseDownOnID).HoveringVScrollbarButton = 1 AND TIMER - __UI_MouseDownOnScrollbar > .3 THEN
'Mousedown on "up" button
Control(__UI_MouseDownOnID).FirstVisibleLine = Control(__UI_MouseDownOnID).FirstVisibleLine - 1
IF Control(__UI_MouseDownOnID).FirstVisibleLine < 0 THEN Control(__UI_MouseDownOnID).FirstVisibleLine = 1
ELSEIF NOT Control(__UI_MouseDownOnID).Disabled AND Control(__UI_MouseDownOnID).HoveringVScrollbarButton = 2 AND TIMER - __UI_MouseDownOnScrollbar > .3 THEN
'Mousedown on "down" button
IF Control(__UI_MouseDownOnID).FirstVisibleLine < __UI_CountLines(__UI_MouseDownOnID) - Control(__UI_MouseDownOnID).Height \ uspacing& + 1 THEN
Control(__UI_MouseDownOnID).FirstVisibleLine = Control(__UI_MouseDownOnID).FirstVisibleLine + 1
END IF
ELSEIF NOT Control(__UI_MouseDownOnID).Disabled AND Control(__UI_MouseDownOnID).HoveringVScrollbarButton = 4 AND TIMER - __UI_MouseDownOnScrollbar < .3 THEN
'Mousedown on "track" area above the thumb
Control(__UI_MouseDownOnID).InputViewStart = Control(__UI_MouseDownOnID).InputViewStart - (Control(__UI_MouseDownOnID).LastVisibleItem - 1)
ELSEIF NOT Control(__UI_MouseDownOnID).Disabled AND Control(__UI_MouseDownOnID).HoveringVScrollbarButton = 5 AND TIMER - __UI_MouseDownOnScrollbar < .3 THEN
'Mousedown on "track" area below the thumb
Control(__UI_MouseDownOnID).InputViewStart = Control(__UI_MouseDownOnID).InputViewStart + (Control(__UI_MouseDownOnID).LastVisibleItem - 1)
IF Control(__UI_MouseDownOnID).InputViewStart > Control(__UI_MouseDownOnID).Max - Control(__UI_MouseDownOnID).LastVisibleItem - 1 THEN
Control(__UI_MouseDownOnID).InputViewStart = Control(__UI_MouseDownOnID).Max - Control(__UI_MouseDownOnID).LastVisibleItem - 1
END IF
END IF
END IF
IF Control(__UI_MouseDownOnID).Type = __UI_Type_TrackBar AND NOT Control(__UI_MouseDownOnID).Disabled THEN
Control(__UI_HoveringID).Value = __UI_MAP((__UI_MouseLeft - (ContainerOffsetLeft + Control(__UI_HoveringID).Left)), 0, Control(__UI_HoveringID).Width, Control(__UI_HoveringID).Min, Control(__UI_HoveringID).Max)
IF Control(__UI_HoveringID).Value < Control(__UI_HoveringID).Min THEN
Control(__UI_HoveringID).Value = Control(__UI_HoveringID).Min
END IF
IF Control(__UI_HoveringID).Value > Control(__UI_HoveringID).Max THEN
Control(__UI_HoveringID).Value = Control(__UI_HoveringID).Max
END IF
END IF
END IF
END IF
IF __UI_MouseDownOnID = 0 AND Control(__UI_PreviousMouseDownOnID).Type = __UI_Type_TrackBar AND NOT Control(__UI_PreviousMouseDownOnID).Disabled THEN
Control(__UI_PreviousMouseDownOnID).Value = __UI_MAP((__UI_MouseLeft - (Control(Control(__UI_PreviousMouseDownOnID).ParentID).Left + Control(__UI_PreviousMouseDownOnID).Left)), 0, Control(__UI_PreviousMouseDownOnID).Width, Control(__UI_PreviousMouseDownOnID).Min, Control(__UI_PreviousMouseDownOnID).Max)
IF Control(__UI_PreviousMouseDownOnID).Value > Control(__UI_PreviousMouseDownOnID).Max THEN Control(__UI_PreviousMouseDownOnID).Value = Control(__UI_PreviousMouseDownOnID).Max
IF Control(__UI_PreviousMouseDownOnID).Value < Control(__UI_PreviousMouseDownOnID).Min THEN Control(__UI_PreviousMouseDownOnID).Value = Control(__UI_PreviousMouseDownOnID).Min
'IF Control(__UI_PreviousMouseDownOnID).PreviousValue <> Control(__UI_PreviousMouseDownOnID).Value THEN __UI_ValueChanged __UI_PreviousMouseDownOnID
END IF
END IF
ELSE
'Mouse button is released
IF __UI_MouseIsDown THEN
IF __UI_IsDragging THEN
__UI_IsDragging = False
__UI_DraggingID = 0
__UI_Snapped = 0
__UI_SnappedByProximityX = False
__UI_SnappedByProximityY = False
__UI_ForceRedraw = True
END IF
IF __UI_IsResizing THEN
__UI_IsResizing = False
__UI_ResizingID = 0
END IF
IF __UI_DraggingThumb THEN
__UI_DraggingThumb = False
__UI_DraggingThumbOnID = 0
END IF
'Fire __UI_MouseUp
IF __UI_PreviousMouseDownOnID > 0 THEN
__UI_MouseUp __UI_PreviousMouseDownOnID
ELSE
IF __UI_MouseDownOnID > 0 THEN __UI_MouseUp __UI_MouseDownOnID
END IF
'Click
IF NOT __UI_DesignMode AND __UI_MouseDownOnID = __UI_HoveringID AND __UI_HoveringID > 0 THEN
IF NOT Control(__UI_HoveringID).Disabled THEN
SELECT CASE Control(__UI_HoveringID).Type
CASE __UI_Type_RadioButton
SetRadioButtonValue __UI_HoveringID
CASE __UI_Type_CheckBox, __UI_Type_ToggleSwitch
Control(__UI_HoveringID).Value = NOT Control(__UI_HoveringID).Value
__UI_ValueChanged __UI_HoveringID
Control(__UI_HoveringID).LastChange = TIMER
CASE __UI_Type_TextBox
'DIM TempNewCursor AS LONG
'STATIC LastTextBoxClick AS SINGLE, LastTextBoxClickID AS LONG
IF Control(__UI_HoveringID).HasVScrollbar AND __UI_MouseLeft >= Control(__UI_HoveringID).Left + Control(__UI_HoveringID).Width - 25 + ContainerOffsetLeft THEN
'Control has a vertical scrollbar and it's been clicked
IF __UI_MouseTop >= Control(__UI_HoveringID).Top + ContainerOffsetTop AND NOT Control(__UI_HoveringID).Disabled AND __UI_MouseTop <= Control(__UI_HoveringID).Top + ContainerOffsetTop + __UI_ScrollbarButtonHeight THEN
'Click on "up" button
Control(__UI_MouseDownOnID).FirstVisibleLine = Control(__UI_MouseDownOnID).FirstVisibleLine - 1
IF Control(__UI_MouseDownOnID).FirstVisibleLine < 0 THEN Control(__UI_MouseDownOnID).FirstVisibleLine = 1
ELSEIF __UI_MouseTop >= Control(__UI_HoveringID).VScrollbarButton2Top + ContainerOffsetTop AND NOT Control(__UI_HoveringID).Disabled THEN
'Click on "down" button
IF Control(__UI_MouseDownOnID).FirstVisibleLine < __UI_CountLines(__UI_MouseDownOnID) - Control(__UI_MouseDownOnID).Height \ uspacing& + 1 THEN
Control(__UI_MouseDownOnID).FirstVisibleLine = Control(__UI_MouseDownOnID).FirstVisibleLine + 1
END IF
END IF
ELSE
IF TIMER - JustEnteredTextBox > .3 THEN
_FONT (Control(__UI_HoveringID).Font)
'IF NOT Control(__UI_HoveringID).Multiline THEN
' 'Single-line textbox
' TempNewCursor = ((__UI_MouseLeft - (Control(__UI_HoveringID).Left + Control(Control(__UI_HoveringID).ParentID).Left)) / _FONTWIDTH) + (Control(__UI_HoveringID).InputViewStart - 1)
' IF __UI_HoveringID = LastTextBoxClickID AND TIMER - LastTextBoxClick < .3 AND TempNewCursor = Control(__UI_HoveringID).Cursor THEN
' 'Double click in a textbox to select it all
' IF LEN(Text(__UI_HoveringID)) > 0 THEN
' Control(__UI_HoveringID).Cursor = LEN(Text(__UI_HoveringID))
' Control(__UI_HoveringID).SelectionStart = 0
' Control(__UI_HoveringID).TextIsSelected = True
' END IF
' ELSE
' Control(__UI_HoveringID).Cursor = TempNewCursor
' IF Control(__UI_HoveringID).Cursor > LEN(Text(__UI_HoveringID)) THEN Control(__UI_HoveringID).Cursor = LEN(Text(__UI_HoveringID))
' END IF
' LastTextBoxClick = TIMER
' LastTextBoxClickID = __UI_HoveringID
'ELSE
' 'Multiline textbox
'END IF
END IF
END IF
CASE __UI_Type_ListBox
IF Control(__UI_HoveringID).HasVScrollbar AND __UI_MouseLeft >= Control(__UI_HoveringID).Left + Control(__UI_HoveringID).Width - 25 + ContainerOffsetLeft THEN
'Control has a vertical scrollbar and it's been clicked
IF __UI_MouseTop >= Control(__UI_HoveringID).Top + ContainerOffsetTop AND NOT Control(__UI_HoveringID).Disabled AND __UI_MouseTop <= Control(__UI_HoveringID).Top + ContainerOffsetTop + __UI_ScrollbarButtonHeight THEN
'Click on "up" button
Control(__UI_HoveringID).InputViewStart = Control(__UI_HoveringID).InputViewStart - 1
ELSEIF __UI_MouseTop >= Control(__UI_HoveringID).VScrollbarButton2Top + ContainerOffsetTop AND NOT Control(__UI_HoveringID).Disabled THEN
'Click on "down" button
IF Control(__UI_HoveringID).InputViewStart + Control(__UI_HoveringID).LastVisibleItem <= Control(__UI_HoveringID).Max THEN
Control(__UI_HoveringID).InputViewStart = Control(__UI_HoveringID).InputViewStart + 1
END IF
END IF
ELSE
IF Control(__UI_HoveringID).Max > 0 THEN
_FONT Control(__UI_HoveringID).Font
ThisItem% = ((__UI_MouseTop - (ContainerOffsetTop + Control(__UI_HoveringID).Top) - (ABS(Control(__UI_HoveringID).HasBorder) * __UI_DefaultCaptionIndent)) \ Control(__UI_HoveringID).ItemHeight) + Control(__UI_HoveringID).InputViewStart
IF ThisItem% >= Control(__UI_HoveringID).Min AND ThisItem% <= Control(__UI_HoveringID).Max THEN
Control(__UI_HoveringID).Value = ThisItem%
ELSE
Control(__UI_HoveringID).Value = 0
END IF
END IF
IF __UI_HoveringID = __UI_ActiveDropdownList THEN
__UI_Focus = __UI_ParentDropdownList
Control(__UI_ParentDropdownList).Value = Control(__UI_ActiveDropdownList).Value
IF Control(__UI_ParentDropdownList).PreviousValue <> Control(__UI_ParentDropdownList).Value THEN
__UI_ValueChanged __UI_ParentDropdownList
Control(__UI_ParentDropdownList).PreviousValue = Control(__UI_ParentDropdownList).Value
Control(__UI_ParentDropdownList).Redraw = True
END IF
__UI_DestroyControl Control(__UI_ActiveDropdownList)
ELSE
IF Control(__UI_HoveringID).PreviousValue <> Control(__UI_HoveringID).Value THEN
__UI_ValueChanged __UI_HoveringID
Control(__UI_HoveringID).PreviousValue = Control(__UI_HoveringID).Value
Control(__UI_HoveringID).Redraw = True
END IF
END IF
END IF
CASE __UI_Type_DropdownList
IF __UI_ActiveDropdownList = 0 THEN
__UI_ActivateDropdownlist Control(__UI_HoveringID)
ELSE
__UI_DestroyControl Control(__UI_ActiveDropdownList)
END IF
CASE __UI_Type_MenuBar
IF __UI_TotalActiveMenus > 0 AND NOT __UI_JustOpenedMenu THEN
__UI_Focus = __UI_PreviousFocus
END IF
CASE __UI_Type_MenuItem
IF Control(__UI_HoveringID).SubMenu THEN
__UI_ActivateMenu Control(__UI_HoveringID), False
ELSE
__UI_Focus = __UI_PreviousFocus
__UI_DestroyControl Control(__UI_ActiveMenu(__UI_TotalActiveMenus))
__UI_ForceRedraw = True
IF Control(__UI_HoveringID).BulletStyle = __UI_Bullet THEN SetRadioButtonValue __UI_HoveringID
END IF
END SELECT
__UI_LastMouseClick = TIMER
__UI_JustOpenedMenu = False
__UI_MouseDownOnID = 0
ProcessClick:
IF RTRIM$(Control(Control(__UI_HoveringID).ParentID).Name) = "__UI_TextFieldMenu" OR RTRIM$(Control(Control(__UI_HoveringID).ParentID).Name) = "__UI_PreviewMenu" THEN
'Internal context menus - Text field/Design mode options
IF RTRIM$(Control(Control(__UI_HoveringID).ParentID).Name) = "__UI_TextFieldMenu" THEN
__UI_Focus = __UI_PreviousFocus
ELSEIF RTRIM$(Control(Control(__UI_HoveringID).ParentID).Name) = "__UI_PreviewMenu" THEN
__UI_DestroyControl Control(__UI_ActiveMenu(__UI_TotalActiveMenus))
END IF
ProcessHotkey:
__UI_FillSelectedText 0, 0
IF UCASE$(LEFT$(Control(__UI_HoveringID).Name, 16)) = "__UI_PREVIEWMENU" THEN __UI_KeyPress 216
SELECT CASE UCASE$(RTRIM$(Control(__UI_HoveringID).Name))
CASE "__UI_TEXTMENUCUT"
IF LEN(__UI_SelectedText) > 0 THEN
_CLIPBOARD$ = __UI_SelectedText
__UI_DeleteSelection
END IF
CASE "__UI_TEXTMENUCOPY"
IF LEN(__UI_SelectedText) > 0 THEN _CLIPBOARD$ = __UI_SelectedText
CASE "__UI_TEXTMENUPASTE"
DIM ContextMenuPaste AS _BYTE
ContextMenuPaste = True
GOSUB PasteIntoTextBox
CASE "__UI_TEXTMENUDELETE"
__UI_DeleteSelection
CASE "__UI_TEXTMENUSELECT"
IF LEN(Text(__UI_Focus)) > 0 THEN
Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus))
Control(__UI_Focus).SelectionStart = 0
Control(__UI_Focus).TextIsSelected = True
END IF
CASE "__UI_PREVIEWMENUALIGNLEFT"
__UI_KeyPress 201
CASE "__UI_PREVIEWMENUALIGNRIGHT"
__UI_KeyPress 202
CASE "__UI_PREVIEWMENUALIGNTOPS"
__UI_KeyPress 203
CASE "__UI_PREVIEWMENUALIGNBOTTOMS"
__UI_KeyPress 204
CASE "__UI_PREVIEWMENUALIGNCENTERSV"
__UI_KeyPress 205
CASE "__UI_PREVIEWMENUALIGNCENTERSH"
__UI_KeyPress 206
CASE "__UI_PREVIEWMENUALIGNCENTERV"
__UI_KeyPress 207
CASE "__UI_PREVIEWMENUALIGNCENTERH"
__UI_KeyPress 208
CASE "__UI_PREVIEWMENUDISTRIBUTEV"
__UI_KeyPress 209
CASE "__UI_PREVIEWMENUDISTRIBUTEH"
__UI_KeyPress 210
CASE "__UI_PREVIEWMENUIMAGEORIGINALSIZE"
IF LEN(Text(__UI_FirstSelectedID)) THEN
__UI_RestoreImageOriginalSize
END IF
CASE UCASE$("__UI_PreviewMenuNumericOnly")
__UI_KeyPress 223
CASE UCASE$("__UI_PreviewMenuSetDefaultButton")
IF __UI_DefaultButtonID = __UI_FirstSelectedID THEN
__UI_DefaultButtonID = 0
ELSE
__UI_DefaultButtonID = __UI_FirstSelectedID
END IF
CASE UCASE$("__UI_PreviewMenuNewMenuBar")
__UI_KeyPress 224
CASE UCASE$("__UI_PreviewMenuConvertType")
__UI_KeyPress 225
CASE UCASE$("__UI_PreviewMenuNewContextMenu")
__UI_KeyPress 226
CASE UCASE$("__UI_PreviewMenuShowInvisibleControls")
__UI_KeyPress 227
CASE UCASE$("__UI_PreviewMenuBindControls")
__UI_KeyPress 228
CASE "__UI_PREVIEWMENUCUT": GOTO ControlCut
CASE "__UI_PREVIEWMENUCOPY": GOTO ControlCopy
CASE "__UI_PREVIEWMENUPASTE": GOTO ControlPaste
CASE "__UI_PREVIEWMENUDELETE": GOTO ControlDelete
CASE "__UI_PREVIEWMENUSELECT": GOTO ControlSelect
END SELECT
__UI_KeyPress __UI_Focus
ELSE
__UI_Click __UI_HoveringID
__UI_KeyHit = 0
END IF
ELSE
__UI_CloseAllMenus
__UI_Focus = __UI_PreviousFocus
__UI_ForceRedraw = True
END IF
END IF
__UI_IsSelectingText = False
__UI_IsSelectingTextOnID = 0
__UI_MouseIsDown = False
__UI_MouseDownOnID = 0
__UI_PreviousMouseDownOnID = 0
__UI_SelectionRectangle = False
END IF
END IF
'Drag update
IF __UI_IsDragging AND __UI_DraggingID = __UI_FormID THEN __UI_IsDragging = False
__UI_Snapped = False
__UI_SnappedByProximityX = False
__UI_SnappedByProximityY = False
__UI_SnappedX = -1
__UI_SnappedY = -1
DIM SetNewParent AS _BYTE, LeftOffset AS INTEGER, TopOffset AS INTEGER
IF (__UI_IsDragging AND __UI_DraggingID > 0) THEN
IF Control(__UI_DraggingID).Type <> __UI_Type_Frame THEN
IF Control(__UI_BelowHoveringID).Type = __UI_Type_Frame OR Control(__UI_HoveringID).Type = __UI_Type_Frame THEN
IF Control(__UI_HoveringID).Type = __UI_Type_Frame THEN __UI_BelowHoveringID = __UI_HoveringID
IF Control(__UI_FirstSelectedID).ParentID <> __UI_BelowHoveringID THEN
SetNewParent = True
LeftOffset = Control(__UI_BelowHoveringID).Left
TopOffset = Control(__UI_BelowHoveringID).Top
END IF
ELSEIF Control(__UI_BelowHoveringID).Type = __UI_Type_Form OR __UI_BelowHoveringID = 0 THEN
IF Control(__UI_FirstSelectedID).ParentID > 0 THEN
LeftOffset = Control(Control(__UI_FirstSelectedID).ParentID).Left
TopOffset = Control(Control(__UI_FirstSelectedID).ParentID).Top
__UI_BelowHoveringID = 0
SetNewParent = True
END IF
END IF
END IF
FOR i = 1 TO UBOUND(Control)
IF Control(i).ControlIsSelected THEN
Control(i).Top = Control(i).Top + (__UI_MouseTop - __UI_DragY)
Control(i).Left = Control(i).Left + (__UI_MouseLeft - __UI_DragX)
IF SetNewParent THEN
Control(i).ParentID = __UI_BelowHoveringID
Control(i).ParentName = Control(__UI_BelowHoveringID).Name
IF __UI_BelowHoveringID = 0 THEN
Control(i).Top = Control(i).Top + TopOffset
Control(i).Left = Control(i).Left + LeftOffset
ELSE
Control(i).Top = Control(i).Top - TopOffset
Control(i).Left = Control(i).Left - LeftOffset
END IF
END IF
END IF
NEXT
'Snapping (dragging): -----------------------------------------------------------------
'Last snap coordinates, for priority comparison:
DIM PrevXSnapOffset AS INTEGER, PrevYSnapOffset AS INTEGER
PrevXSnapOffset = 10
PrevYSnapOffset = 10
IF (_KEYDOWN(100305) = 0 AND _KEYDOWN(100306) = 0) AND __UI_SnapLines THEN
'How far the mouse is from the currently being dragged control:
DIM MouseXOffset AS INTEGER, MouseYOffset AS INTEGER
'How distant from the neighboring snapped control's edge we are:
DIM XSnapOffset AS INTEGER, YSnapOffset AS INTEGER
'Look for a control nearby to which this one may be aligned automatically
MouseYOffset = ABS(__UI_MouseTop - (Control(__UI_DraggingID).Top + Control(Control(__UI_DraggingID).ParentID).Top + OriginalDragY))
MouseXOffset = ABS(__UI_MouseLeft - (Control(__UI_DraggingID).Left + Control(Control(__UI_DraggingID).ParentID).Left + OriginalDragX))
'Snap to form borders first: -------------------------------
IF Control(__UI_DraggingID).ParentID = 0 THEN
'Right to left of form snap when close:
XSnapOffset = Control(__UI_DraggingID).Left
IF XSnapOffSet >= __UI_SnapDistanceFromForm / 2 AND XSnapOffset =< __UI_SnapDistanceFromForm AND MouseXOffset < 10 THEN
Control(__UI_DraggingID).Left = __UI_SnapDistanceFromForm
__UI_Snapped = True
__UI_SnappedX = __UI_SnapDistanceFromForm
__UI_SnappedByProximityX = 3
END IF
'Left to right of form snap when close:
XSnapOffset = ABS((Control(__UI_DraggingID).Left + Control(__UI_DraggingID).Width + __UI_SnapDistanceFromForm) - Control(__UI_FormID).Width)
IF XSnapOffSet < __UI_SnapDistanceFromForm AND MouseXOffset < 10 THEN
Control(__UI_DraggingID).Left = Control(__UI_FormID).Width - (Control(__UI_DraggingID).Width + __UI_SnapDistanceFromForm)
__UI_Snapped = True
__UI_SnappedX = Control(__UI_DraggingID).Left
__UI_SnappedByProximityX = 4
END IF
'Top to top of form snap when close:
YSnapOffset = Control(__UI_DraggingID).Top
IF YSnapOffSet >= __UI_SnapDistanceFromForm / 2 AND YSnapOffset =< __UI_SnapDistanceFromForm AND MouseYOffset < 10 THEN
Control(__UI_DraggingID).Top = __UI_SnapDistanceFromForm
__UI_Snapped = True
__UI_SnappedY = __UI_SnapDistanceFromForm
__UI_SnappedByProximityY = 3
END IF
'Bottom to bottom of form snap when close:
YSnapOffset = ABS((Control(__UI_DraggingID).Top + Control(__UI_DraggingID).Height + __UI_SnapDistanceFromForm) - Control(__UI_FormID).Height)
IF YSnapOffSet < __UI_SnapDistanceFromForm AND MouseYOffset < 10 THEN
Control(__UI_DraggingID).Top = Control(__UI_FormID).Height - (Control(__UI_DraggingID).Height + __UI_SnapDistanceFromForm)
__UI_Snapped = True
__UI_SnappedY = Control(__UI_DraggingID).Top
__UI_SnappedByProximityY = 4
END IF
'Middle of form:
YSnapOffset = ABS(((Control(__UI_FormID).Height - __UI_MenuBarOffsetV) / 2 + __UI_MenuBarOffsetV) - (Control(__UI_DraggingID).Top + Control(__UI_DraggingID).Height / 2))
IF YSnapOffset < 5 AND MouseYOffset < 10 THEN
Control(__UI_DraggingID).Top = (Control(__UI_FormID).Height - __UI_MenuBarOffsetV) / 2 + __UI_MenuBarOffsetV - Control(__UI_DraggingID).Height / 2
__UI_Snapped = True
__UI_SnappedY = (Control(__UI_FormID).Height - __UI_MenuBarOffsetV) / 2 + __UI_MenuBarOffsetV
END IF
'Center of form:
XSnapOffset = ABS((Control(__UI_FormID).Width / 2) - (Control(__UI_DraggingID).Left + Control(__UI_DraggingID).Width / 2))
IF XSnapOffset < 5 AND MouseXOffset < 10 THEN
Control(__UI_DraggingID).Left = Control(__UI_FormID).Width / 2 - Control(__UI_DraggingID).Width / 2
__UI_Snapped = True
__UI_SnappedX = Control(__UI_FormID).Width / 2
END IF
END IF
'Snap to other controls: -----------------------------------
FOR i = 1 TO UBOUND(Control)
IF Control(i).ParentID = Control(__UI_DraggingID).ParentID AND Control(i).Type > 0 AND _
i <> __UI_DraggingID AND Control(i).Type <> __UI_Type_ContextMenu AND Control(i).Type <> __UI_Type_Form AND Control(i).Type <> __UI_Type_Font AND Control(i).Type <> __UI_Type_MenuItem AND Control(i).Type <> __UI_Type_MenuBar AND Control(i).Type <> __UI_Type_MenuPanel AND _
Control(i).ControlIsSelected = False THEN
'Tops:
YSnapOffset = ABS((Control(i).Top + Control(Control(i).ParentID).Top) - (Control(__UI_DraggingID).Top + Control(Control(__UI_DraggingID).ParentID).Top))
IF YSnapOffset < 5 AND YSnapOffset < PrevYSnapOffset AND MouseYOffset < 10 THEN
PrevYSnapOffset = YSnapOffset
Control(__UI_DraggingID).Top = Control(i).Top + Control(Control(i).ParentID).Top
__UI_Snapped = True
__UI_SnappedY = Control(i).Top + Control(Control(i).ParentID).Top
__UI_SnappedYID = i
END IF
'Middles:
YSnapOffset = ABS((Control(i).Top + Control(i).Height / 2 + Control(Control(i).ParentID).Top) - (Control(__UI_DraggingID).Top + Control(__UI_DraggingID).Height / 2 + Control(Control(__UI_DraggingID).ParentID).Top))
IF YSnapOffset < 5 AND YSnapOffset < PrevYSnapOffset AND MouseYOffset < 10 THEN
PrevYSnapOffset = YSnapOffset
Control(__UI_DraggingID).Top = Control(i).Top + Control(i).Height / 2 - Control(__UI_DraggingID).Height / 2 + Control(Control(i).ParentID).Top
__UI_Snapped = True
__UI_SnappedY = Control(i).Top + Control(i).Height / 2 + Control(Control(i).ParentID).Top
__UI_SnappedYID = i
END IF
'Bases:
YSnapOffset = ABS((Control(i).Top + Control(i).Height + Control(Control(i).ParentID).Top) - (Control(__UI_DraggingID).Top + Control(__UI_DraggingID).Height + Control(Control(__UI_DraggingID).ParentID).Top))
IF YSnapOffset < 5 AND YSnapOffset < PrevYSnapOffset AND MouseYOffset < 10 THEN
PrevYSnapOffset = YSnapOffset
Control(__UI_DraggingID).Top = Control(i).Top + Control(i).Height - Control(__UI_DraggingID).Height + Control(Control(i).ParentID).Top
__UI_Snapped = True
__UI_SnappedY = Control(i).Top + Control(i).Height + Control(Control(i).ParentID).Top
__UI_SnappedYID = i
END IF
'Lefts:
XSnapOffset = ABS((Control(i).Left + Control(Control(i).ParentID).Left) - (Control(__UI_DraggingID).Left + Control(Control(__UI_DraggingID).ParentID).Left))
IF XSnapOffset < 5 AND XSnapOffset < PrevXSnapOffset AND MouseXOffset < 10 THEN
PrevXSnapOffset = XSnapOffset
Control(__UI_DraggingID).Left = Control(i).Left + Control(Control(i).ParentID).Left
__UI_Snapped = True
__UI_SnappedX = Control(i).Left + Control(Control(i).ParentID).Left
__UI_SnappedXID = i
END IF
'Centers:
XSnapOffset = ABS((Control(i).Left + Control(i).Width / 2 + Control(Control(i).ParentID).Left) - (Control(__UI_DraggingID).Left + Control(__UI_DraggingID).Width / 2 + Control(Control(__UI_DraggingID).ParentID).Left))
IF XSnapOffset < 5 AND XSnapOffset < PrevXSnapOffset AND MouseXOffset < 10 THEN
PrevXSnapOffset = XSnapOffset
Control(__UI_DraggingID).Left = Control(i).Left + Control(i).Width / 2 - Control(__UI_DraggingID).Width / 2 + Control(Control(i).ParentID).Left
__UI_Snapped = True
__UI_SnappedX = Control(i).Left + Control(i).Width / 2 + Control(Control(i).ParentID).Left
__UI_SnappedXID = i
END IF
'Rights:
XSnapOffset = ABS((Control(i).Left + Control(i).Width + Control(Control(i).ParentID).Left) - (Control(__UI_DraggingID).Left + Control(__UI_DraggingID).Width + Control(Control(__UI_DraggingID).ParentID).Left))
IF XSnapOffset < 5 AND XSnapOffset < PrevXSnapOffset AND MouseXOffset < 10 THEN
PrevXSnapOffset = XSnapOffset
Control(__UI_DraggingID).Left = Control(i).Left + Control(i).Width - Control(__UI_DraggingID).Width + Control(Control(i).ParentID).Left
__UI_Snapped = True
__UI_SnappedX = Control(i).Left + Control(i).Width + Control(Control(i).ParentID).Left
__UI_SnappedXID = i
END IF
'Right to left snap when close:
XSnapOffset = ABS((Control(i).Left + Control(i).Width + Control(Control(i).ParentID).Left + __UI_SnapDistance) - (Control(__UI_DraggingID).Left + Control(Control(__UI_DraggingID).ParentID).Left))
IF XSnapOffset < 5 AND XSnapOffset < PrevXSnapOffset AND MouseXOffset < 10 THEN
IF (Control(__UI_DraggingID).Top <= Control(i).Top + Control(i).Height AND _
Control(__UI_DraggingID).Top >= Control(i).Top) OR _
(Control(__UI_DraggingID).Top + Control(__UI_DraggingID).Height >= Control(i).Top AND _
Control(__UI_DraggingID).Top + Control(__UI_DraggingID).Height <= Control(i).Top + Control(i).Height) THEN
PrevXSnapOffset = XSnapOffset
Control(__UI_DraggingID).Left = Control(i).Left + Control(i).Width + Control(Control(i).ParentID).Left + __UI_SnapDistance
__UI_Snapped = True
__UI_SnappedX = Control(i).Left + Control(i).Width + Control(Control(i).ParentID).Left + __UI_SnapDistance
__UI_SnappedXID = i
__UI_SnappedByProximityX = 1
END IF
END IF
'Left to right snap when close:
XSnapOffset = ABS((Control(i).Left - __UI_SnapDistance) - (Control(__UI_DraggingID).Left + Control(__UI_DraggingID).Width + Control(Control(__UI_DraggingID).ParentID).Left))
IF XSnapOffset < 5 AND XSnapOffset < PrevXSnapOffset AND MouseXOffset < 10 THEN
IF (Control(__UI_DraggingID).Top <= Control(i).Top + Control(i).Height AND _
Control(__UI_DraggingID).Top >= Control(i).Top) OR _
(Control(__UI_DraggingID).Top + Control(__UI_DraggingID).Height >= Control(i).Top AND _
Control(__UI_DraggingID).Top + Control(__UI_DraggingID).Height <= Control(i).Top + Control(i).Height) THEN
PrevXSnapOffset = XSnapOffset
Control(__UI_DraggingID).Left = Control(i).Left - Control(__UI_DraggingID).Width - __UI_SnapDistance
__UI_Snapped = True
__UI_SnappedX = Control(i).Left - Control(__UI_DraggingID).Width - __UI_SnapDistance
__UI_SnappedXID = i
__UI_SnappedByProximityX = 2
END IF
END IF
'Bottom to top snap when close:
YSnapOffset = ABS((Control(i).Top + Control(Control(i).ParentID).Top - __UI_SnapDistance) - (Control(__UI_DraggingID).Top + Control(__UI_DraggingID).Height + Control(Control(__UI_DraggingID).ParentID).Top))
IF YSnapOffset < 5 AND YSnapOffset < PrevYSnapOffset AND MouseYOffset < 10 THEN
IF (Control(__UI_DraggingID).Left <= Control(i).Left + Control(i).Width AND _
Control(__UI_DraggingID).Left >= Control(i).Left) OR _
(Control(__UI_DraggingID).Left + Control(__UI_DraggingID).Width >= Control(i).Left AND _
Control(__UI_DraggingID).Left + Control(__UI_DraggingID).Width <= Control(i).Left + Control(i).Width) THEN
PrevYSnapOffset = YSnapOffset
Control(__UI_DraggingID).Top = Control(i).Top + Control(Control(i).ParentID).Top - Control(__UI_DraggingID).Height - __UI_SnapDistance
__UI_Snapped = True
__UI_SnappedY = Control(i).Top + Control(Control(i).ParentID).Top - Control(__UI_DraggingID).Height - __UI_SnapDistance
__UI_SnappedYID = i
__UI_SnappedByProximityY = 1
END IF
END IF
'Top to bottom snap when close:
YSnapOffset = ABS((Control(i).Top + Control(i).Height + Control(Control(i).ParentID).Top + __UI_SnapDistance) - (Control(__UI_DraggingID).Top + Control(Control(__UI_DraggingID).ParentID).Top))
IF YSnapOffset < 5 AND YSnapOffset < PrevYSnapOffset AND MouseYOffset < 10 THEN
IF (Control(__UI_DraggingID).Left <= Control(i).Left + Control(i).Width AND _
Control(__UI_DraggingID).Left >= Control(i).Left) OR _
(Control(__UI_DraggingID).Left + Control(__UI_DraggingID).Width >= Control(i).Left AND _
Control(__UI_DraggingID).Left + Control(__UI_DraggingID).Width <= Control(i).Left + Control(i).Width) THEN
PrevYSnapOffset = YSnapOffset
Control(__UI_DraggingID).Top = Control(i).Top + Control(Control(i).ParentID).Top + Control(i).Height + __UI_SnapDistance
__UI_Snapped = True
__UI_SnappedY = Control(i).Top + Control(Control(i).ParentID).Top + Control(i).Height + __UI_SnapDistance
__UI_SnappedYID = i
__UI_SnappedByProximityY = 2
END IF
END IF
END IF
NEXT
END IF
IF (_KEYDOWN(100305) OR _KEYDOWN(100306)) THEN __UI_Snapped = False: __UI_SnappedX = -1: __UI_SnappedY=-1
IF __UI_SnappedX = -1 THEN Control(__UI_DraggingID).Left = __UI_MouseLeft - OriginalDragX
IF __UI_SnappedY = -1 THEN Control(__UI_DraggingID).Top = __UI_MouseTop - OriginalDragY
Control(__UI_DraggingID).Left = Control(__UI_DraggingID).Left - Control(Control(__UI_DraggingID).ParentID).Left
Control(__UI_DraggingID).Top = Control(__UI_DraggingID).Top - Control(Control(__UI_DraggingID).ParentID).Top
IF __UI_TotalSelectedControls > 1 THEN
FOR i = 1 TO UBOUND(Control)
IF Control(i).ControlIsSelected AND i <> __UI_DraggingID THEN
Control(i).Left = Control(__UI_DraggingID).Left - Control(i).LeftOffsetFromFirstSelected
Control(i).Top = Control(__UI_DraggingID).Top - Control(i).TopOffsetFromFirstSelected
END IF
NEXT
END IF
__UI_DragY = __UI_MouseTop
__UI_DragX = __UI_MouseLeft
END IF
IF __UI_IsResizing AND __UI_ResizingID > 0 THEN
DIM __UI_RelevantID AS LONG
__UI_ForceRedraw = True
FOR i = 1 TO UBOUND(Control)
IF Control(i).ControlIsSelected THEN
'Right
IF __UI_ResizeHandleHover = 1 THEN
IF __UI_Type(Control(i).Type).RestrictResize = __UI_CantResizeH OR __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = __UI_CantResize THEN _CONTINUE
IF __UI_ShiftIsDown THEN
Control(i).Width = Control(i).Width + (2 * (__UI_MouseLeft - __UI_DragX)): IF Control(i).Width < 4 THEN Control(i).Width = 4
IF Control(i).Width > 4 THEN Control(i).Left = Control(i).Left - (__UI_MouseLeft - __UI_DragX)
ELSE
Control(i).Width = Control(i).Width + (__UI_MouseLeft - __UI_DragX): IF Control(i).Width < 4 THEN Control(i).Width = 4
END IF
GOSUB CheckResizeSnapRight
IF __UI_SnappedX = -1 THEN
IF __UI_ShiftIsDown THEN
ELSE
Control(__UI_ResizingID).Width = __UI_MouseLeft - Control(__UI_ResizingID).Left
END IF
END IF
END IF
'Bottom
IF __UI_ResizeHandleHover = 2 THEN
IF __UI_Type(Control(i).Type).RestrictResize = __UI_CantResizeV OR __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = __UI_CantResize THEN _CONTINUE
IF __UI_ShiftIsDown THEN
Control(i).Height = Control(i).Height + (2 * (__UI_MouseTop - __UI_DragY)): IF Control(i).Height < 4 THEN Control(i).Height = 4
IF Control(i).Height > 4 THEN Control(i).Top = Control(i).Top - (__UI_MouseTop - __UI_DragY)
ELSE
Control(i).Height = Control(i).Height + (__UI_MouseTop - __UI_DragY): IF Control(i).Height < 4 THEN Control(i).Height = 4
END IF
GOSUB CheckResizeSnapBottom
IF __UI_SnappedY = -1 THEN
IF __UI_ShiftIsDown THEN
ELSE
Control(__UI_ResizingID).Height = __UI_MouseTop - Control(__UI_ResizingID).Top
END IF
END IF
END IF
'Left
IF __UI_ResizeHandleHover = 3 THEN
IF __UI_Type(Control(i).Type).RestrictResize = __UI_CantResizeH OR __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = __UI_CantResize THEN _CONTINUE
IF __UI_ShiftIsDown THEN
Control(i).Width = Control(i).Width - (2 * (__UI_MouseLeft - __UI_DragX)): IF Control(i).Width < 4 THEN Control(i).Width = 4
IF Control(i).Width > 4 THEN Control(i).Left = Control(i).Left + (__UI_MouseLeft - __UI_DragX)
ELSE
Control(i).Width = Control(i).Width - (__UI_MouseLeft - __UI_DragX)
IF Control(i).Width < 4 THEN
Control(i).Width = 4
ELSE
Control(i).Left = Control(i).Left + (__UI_MouseLeft - __UI_DragX)
END IF
END IF
GOSUB CheckResizeSnapLeft
END IF
'Top
IF __UI_ResizeHandleHover = 4 THEN
IF __UI_Type(Control(i).Type).RestrictResize = __UI_CantResizeV OR __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = __UI_CantResize THEN _CONTINUE
IF __UI_ShiftIsDown THEN
Control(i).Height = Control(i).Height - (2 * (__UI_MouseTop - __UI_DragY)): IF Control(i).Height < 4 THEN Control(i).Height = 4
IF Control(i).Height > 4 THEN Control(i).Top = Control(i).Top + (__UI_MouseTop - __UI_DragY)
ELSE
Control(i).Height = Control(i).Height - (__UI_MouseTop - __UI_DragY): IF Control(i).Height < 4 THEN Control(i).Height = 4 ELSE Control(i).Top = Control(i).Top + (__UI_MouseTop - __UI_DragY)
END IF
GOSUB CheckResizeSnapTop
END IF
DIM OldAlignmentY AS INTEGER
'Resizing by corners keeps original aspect ratio for PictureBox controls
'Top-right
IF __UI_ResizeHandleHover = 5 THEN
IF __UI_ShiftIsDown THEN
IF __UI_Type(Control(i).Type).RestrictResize <> __UI_CantResizeH AND __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResize THEN
Control(i).Width = Control(i).Width + (2 * (__UI_MouseLeft - __UI_DragX)): IF Control(i).Width < 4 THEN Control(i).Width = 4
IF Control(i).Width > 4 THEN Control(i).Left = Control(i).Left - (__UI_MouseLeft - __UI_DragX)
END IF
IF __UI_Type(Control(i).Type).RestrictResize = __UI_CantResizeV OR __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = __UI_CantResize THEN _CONTINUE
Control(i).Height = Control(i).Height - (2 * (__UI_MouseTop - __UI_DragY)): IF Control(i).Height < 4 THEN Control(i).Height = 4
IF Control(i).Height > 4 THEN Control(i).Top = Control(i).Top + (__UI_MouseTop - __UI_DragY)
IF Control(i).Type = __UI_Type_PictureBox AND LEN(Text(i)) > 0 THEN
OldAlignmentY = Control(i).Top + Control(i).Height / 2
Control(i).Height = (_HEIGHT(Control(i).HelperCanvas) / _WIDTH(Control(i).HelperCanvas)) * Control(i).Width
Control(i).Top = OldAlignmentY - Control(i).Height / 2
END IF
ELSE
IF __UI_Type(Control(i).Type).RestrictResize <> __UI_CantResizeV AND __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResize THEN
Control(i).Height = Control(i).Height - (__UI_MouseTop - __UI_DragY): IF Control(i).Height < 4 THEN Control(i).Height = 4 ELSE Control(i).Top = Control(i).Top + (__UI_MouseTop - __UI_DragY)
END IF
IF __UI_Type(Control(i).Type).RestrictResize = __UI_CantResizeH OR __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = __UI_CantResize THEN _CONTINUE
Control(i).Width = Control(i).Width + (__UI_MouseLeft - __UI_DragX): IF Control(i).Width < 4 THEN Control(i).Width = 4
IF Control(i).Type = __UI_Type_PictureBox AND LEN(Text(i)) > 0 THEN
OldAlignmentY = Control(i).Top + Control(i).Height
Control(i).Height = (_HEIGHT(Control(i).HelperCanvas) / _WIDTH(Control(i).HelperCanvas)) * Control(i).Width
Control(i).Top = OldAlignmentY - Control(i).Height
END IF
GOSUB CheckResizeSnapRight
GOSUB CheckResizeSnapTop
END IF
END IF
'Top-left
IF __UI_ResizeHandleHover = 6 THEN
IF __UI_ShiftIsDown THEN
IF __UI_Type(Control(i).Type).RestrictResize <> __UI_CantResizeH AND __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResize THEN
Control(i).Width = Control(i).Width - (2 * (__UI_MouseLeft - __UI_DragX)): IF Control(i).Width < 4 THEN Control(i).Width = 4
IF Control(i).Width > 4 THEN Control(i).Left = Control(i).Left + (__UI_MouseLeft - __UI_DragX)
END IF
IF __UI_Type(Control(i).Type).RestrictResize = __UI_CantResizeV OR __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = __UI_CantResize THEN _CONTINUE
Control(i).Height = Control(i).Height - (2 * (__UI_MouseTop - __UI_DragY)): IF Control(i).Height < 4 THEN Control(i).Height = 4
IF Control(i).Height > 4 THEN Control(i).Top = Control(i).Top + (__UI_MouseTop - __UI_DragY)
IF Control(i).Type = __UI_Type_PictureBox AND LEN(Text(i)) > 0 THEN
OldAlignmentY = Control(i).Top + Control(i).Height / 2
Control(i).Height = (_HEIGHT(Control(i).HelperCanvas) / _WIDTH(Control(i).HelperCanvas)) * Control(i).Width
Control(i).Top = OldAlignmentY - Control(i).Height / 2
END IF
ELSE
IF __UI_Type(Control(i).Type).RestrictResize <> __UI_CantResizeV AND __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResize THEN
Control(i).Height = Control(i).Height - (__UI_MouseTop - __UI_DragY): IF Control(i).Height < 4 THEN Control(i).Height = 4 ELSE Control(i).Top = Control(i).Top + (__UI_MouseTop - __UI_DragY)
END IF
IF __UI_Type(Control(i).Type).RestrictResize = __UI_CantResizeH OR __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = __UI_CantResize THEN _CONTINUE
Control(i).Width = Control(i).Width - (__UI_MouseLeft - __UI_DragX): IF Control(i).Width < 4 THEN Control(i).Width = 4 ELSE Control(i).Left = Control(i).Left + (__UI_MouseLeft - __UI_DragX)
IF Control(i).Type = __UI_Type_PictureBox AND LEN(Text(i)) > 0 THEN
OldAlignmentY = Control(i).Top + Control(i).Height
Control(i).Height = (_HEIGHT(Control(i).HelperCanvas) / _WIDTH(Control(i).HelperCanvas)) * Control(i).Width
Control(i).Top = OldAlignmentY - Control(i).Height
END IF
GOSUB CheckResizeSnapLeft
GOSUB CheckResizeSnapTop
END IF
END IF
'Bottom-right
IF __UI_ResizeHandleHover = 7 THEN
IF __UI_ShiftIsDown THEN
IF __UI_Type(Control(i).Type).RestrictResize <> __UI_CantResizeH AND __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResize THEN
Control(i).Width = Control(i).Width + (2 * (__UI_MouseLeft - __UI_DragX)): IF Control(i).Width < 4 THEN Control(i).Width = 4
IF Control(i).Width > 4 THEN Control(i).Left = Control(i).Left - (__UI_MouseLeft - __UI_DragX)
END IF
IF __UI_Type(Control(i).Type).RestrictResize = __UI_CantResizeV OR __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = __UI_CantResize THEN _CONTINUE
Control(i).Height = Control(i).Height + (2 * (__UI_MouseTop - __UI_DragY)): IF Control(i).Height < 4 THEN Control(i).Height = 4
IF Control(i).Height > 4 THEN Control(i).Top = Control(i).Top - (__UI_MouseTop - __UI_DragY)
IF Control(i).Type = __UI_Type_PictureBox AND LEN(Text(i)) > 0 THEN
OldAlignmentY = Control(i).Top + Control(i).Height / 2
Control(i).Height = (_HEIGHT(Control(i).HelperCanvas) / _WIDTH(Control(i).HelperCanvas)) * Control(i).Width
Control(i).Top = OldAlignmentY - Control(i).Height / 2
END IF
ELSE
IF __UI_Type(Control(i).Type).RestrictResize <> __UI_CantResizeV AND __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResize THEN
Control(i).Height = Control(i).Height + (__UI_MouseTop - __UI_DragY): IF Control(i).Height < 4 THEN Control(i).Height = 4
END IF
IF __UI_Type(Control(i).Type).RestrictResize = __UI_CantResizeH OR __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = __UI_CantResize THEN _CONTINUE
Control(i).Width = Control(i).Width + (__UI_MouseLeft - __UI_DragX): IF Control(i).Width < 4 THEN Control(i).Width = 4
IF Control(i).Type = __UI_Type_PictureBox AND LEN(Text(i)) > 0 THEN
Control(i).Height = (_HEIGHT(Control(i).HelperCanvas) / _WIDTH(Control(i).HelperCanvas)) * Control(i).Width
END IF
GOSUB CheckResizeSnapRight
GOSUB CheckResizeSnapBottom
END IF
END IF
'Bottom-left
IF __UI_ResizeHandleHover = 8 THEN
IF __UI_ShiftIsDown THEN
IF __UI_Type(Control(i).Type).RestrictResize <> __UI_CantResizeH AND __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResize THEN
Control(i).Width = Control(i).Width - (2 * (__UI_MouseLeft - __UI_DragX)): IF Control(i).Width < 4 THEN Control(i).Width = 4
IF Control(i).Width > 4 THEN Control(i).Left = Control(i).Left + (__UI_MouseLeft - __UI_DragX)
END IF
IF __UI_Type(Control(i).Type).RestrictResize = __UI_CantResizeV OR __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = __UI_CantResize THEN _CONTINUE
Control(i).Height = Control(i).Height + (2 * (__UI_MouseTop - __UI_DragY)): IF Control(i).Height < 4 THEN Control(i).Height = 4
IF Control(i).Height > 4 THEN Control(i).Top = Control(i).Top - (__UI_MouseTop - __UI_DragY)
IF Control(i).Type = __UI_Type_PictureBox AND LEN(Text(i)) > 0 THEN
OldAlignmentY = Control(i).Top + Control(i).Height / 2
Control(i).Height = (_HEIGHT(Control(i).HelperCanvas) / _WIDTH(Control(i).HelperCanvas)) * Control(i).Width
Control(i).Top = OldAlignmentY - Control(i).Height / 2
END IF
ELSE
IF __UI_Type(Control(i).Type).RestrictResize <> __UI_CantResizeV AND __UI_Type(Control(__UI_HoveringID).Type).RestrictResize <> __UI_CantResize THEN
Control(i).Height = Control(i).Height + (__UI_MouseTop - __UI_DragY): IF Control(i).Height < 4 THEN Control(i).Height = 4
END IF
IF __UI_Type(Control(i).Type).RestrictResize = __UI_CantResizeH OR __UI_Type(Control(__UI_HoveringID).Type).RestrictResize = __UI_CantResize THEN _CONTINUE
Control(i).Width = Control(i).Width - (__UI_MouseLeft - __UI_DragX): IF Control(i).Width < 4 THEN Control(i).Width = 4 ELSE Control(i).Left = Control(i).Left + (__UI_MouseLeft - __UI_DragX)
IF Control(i).Type = __UI_Type_PictureBox AND LEN(Text(i)) > 0 THEN
Control(i).Height = (_HEIGHT(Control(i).HelperCanvas) / _WIDTH(Control(i).HelperCanvas)) * Control(i).Width
END IF
GOSUB CheckResizeSnapLeft
GOSUB CheckResizeSnapBottom
END IF
END IF
END IF
NEXT
__UI_DragY = __UI_MouseTop
__UI_DragX = __UI_MouseLeft
END IF
IF __UI_DraggingThumb = True THEN
IF Control(__UI_DraggingThumbOnID).Type = __UI_Type_ListBox THEN
IF __UI_MouseTop >= Control(__UI_DraggingThumbOnID).Top + Control(Control(__UI_DraggingThumbOnID).ParentID).Top + __UI_ScrollbarButtonHeight AND __UI_MouseTop <= Control(__UI_DraggingThumbOnID).Top + Control(Control(__UI_DraggingThumbOnID).ParentID).Top + Control(__UI_DraggingThumbOnID).Height - __UI_ScrollbarButtonHeight THEN
'Dragging in the track area
Control(__UI_DraggingThumbOnID).InputViewStart = Control(__UI_DraggingThumbOnID).InputViewStart + ((__UI_MouseTop - __UI_ThumbDragTop) * Control(__UI_DraggingThumbOnID).VScrollbarRatio)
IF Control(__UI_DraggingThumbOnID).InputViewStart + Control(__UI_DraggingThumbOnID).LastVisibleItem - 1 > Control(__UI_DraggingThumbOnID).Max THEN Control(__UI_DraggingThumbOnID).InputViewStart = Control(__UI_DraggingThumbOnID).Max - Control(__UI_DraggingThumbOnID).LastVisibleItem + 1
__UI_ThumbDragTop = __UI_MouseTop
ELSEIF __UI_MouseTop < Control(__UI_DraggingThumbOnID).Top + Control(Control(__UI_DraggingThumbOnID).ParentID).Top + __UI_ScrollbarButtonHeight THEN
'Dragging above the track area
Control(__UI_DraggingThumbOnID).InputViewStart = 1
ELSEIF __UI_MouseTop > Control(__UI_DraggingThumbOnID).Top + Control(Control(__UI_DraggingThumbOnID).ParentID).Top + Control(__UI_DraggingThumbOnID).Height - __UI_ScrollbarButtonHeight THEN
'Dragging below the track area
Control(__UI_DraggingThumbOnID).InputViewStart = Control(__UI_DraggingThumbOnID).Max - Control(__UI_DraggingThumbOnID).LastVisibleItem + 1
END IF
ELSEIF Control(__UI_DraggingThumbOnID).Type = __UI_Type_TextBox THEN
_FONT Control(__UI_DraggingThumbOnID).Font
IF __UI_MouseTop >= Control(__UI_DraggingThumbOnID).Top + Control(Control(__UI_DraggingThumbOnID).ParentID).Top + __UI_ScrollbarButtonHeight AND __UI_MouseTop <= Control(__UI_DraggingThumbOnID).Top + Control(Control(__UI_DraggingThumbOnID).ParentID).Top + Control(__UI_DraggingThumbOnID).Height - __UI_ScrollbarButtonHeight THEN
'Dragging in the track area
Control(__UI_DraggingThumbOnID).FirstVisibleLine = Control(__UI_DraggingThumbOnID).FirstVisibleLine + ((__UI_MouseTop - __UI_ThumbDragTop) * Control(__UI_DraggingThumbOnID).VScrollbarRatio)
__UI_ThumbDragTop = __UI_MouseTop
ELSEIF __UI_MouseTop < Control(__UI_DraggingThumbOnID).Top + Control(Control(__UI_DraggingThumbOnID).ParentID).Top + __UI_ScrollbarButtonHeight THEN
'Dragging above the track area
Control(__UI_DraggingThumbOnID).FirstVisibleLine = 1
ELSEIF __UI_MouseTop > Control(__UI_DraggingThumbOnID).Top + Control(Control(__UI_DraggingThumbOnID).ParentID).Top + Control(__UI_DraggingThumbOnID).Height - __UI_ScrollbarButtonHeight THEN
'Dragging below the track area
Control(__UI_DraggingThumbOnID).FirstVisibleLine = __UI_CountLines(__UI_DraggingThumbOnID) - Control(__UI_DraggingThumbOnID).Height \ uspacing&
END IF
END IF
END IF
IF __UI_SelectionRectangle THEN
DoSelectionRectangle:
DIM tsmx AS INTEGER, tmx AS INTEGER
DIM tsmy AS INTEGER, tmy AS INTEGER
DIM parentOffsetX AS INTEGER, parentOffsetY AS INTEGER
DIM selectingInFrame AS _BYTE, thisParent AS LONG
tsmx = __UI_SelectionRectangleLeft: tmx = __UI_MouseLeft
tsmy = __UI_SelectionRectangleTop: tmy = __UI_MouseTop
parentOffsetX = 0: parentOffsetY = 0
selectingInFrame = False
IF tsmx > tmx THEN SWAP tsmx, tmx
IF tsmy > tmy THEN SWAP tsmy, tmy
'Check if the selection rectangle intersects with any control
IF (_KEYDOWN(100303) OR _KEYDOWN(100304)) AND __UI_FirstSelectedID > 0 AND __UI_SelectionRectangle = False THEN
IF Control(__UI_FirstSelectedID).ParentID = Control(__UI_HoveringID).ParentID THEN
thisParent = Control(__UI_FirstSelectedID).ParentID
parentOffsetX = Control(thisParent).Left
parentOffsetY = Control(thisParent).Top
selectingInFrame = True
END IF
END IF
__UI_TotalSelectedControls = 0
FOR i = 1 TO UBOUND(Control)
Control(i).ControlIsSelected = False
IF Control(i).Type <> __UI_Type_Form AND Control(i).Type <> __UI_Type_Font AND Control(i).Type <> __UI_Type_MenuBar AND Control(i).Type <> __UI_Type_MenuItem AND Control(i).Type <> __UI_Type_MenuPanel AND Control(i).Type <> __UI_Type_ContextMenu THEN
IF selectingInFrame THEN
IF Control(i).ParentID = thisParent THEN
IF tsmx < Control(i).Left + Control(i).Width + Control(thisParent).Left AND _
Control(i).Left + Control(thisParent).Left < tmx AND _
tsmy < Control(i).Top + Control(i).Height + Control(thisParent).Top AND _
Control(i).Top + Control(thisParent).Top < tmy THEN
Control(i).ControlIsSelected = True
__UI_TotalSelectedControls = __UI_TotalSelectedControls + 1
IF __UI_TotalSelectedControls = 1 THEN __UI_FirstSelectedID = i
END IF
END IF
ELSE
IF Control(i).ParentID = 0 THEN
IF tsmx < Control(i).Left + Control(i).Width AND _
Control(i).Left < tmx AND _
tsmy < Control(i).Top + Control(i).Height AND _
Control(i).Top < tmy THEN
Control(i).ControlIsSelected = True
__UI_TotalSelectedControls = __UI_TotalSelectedControls + 1
IF __UI_TotalSelectedControls = 1 THEN __UI_FirstSelectedID = i
END IF
END IF
END IF
END IF
NEXT
END IF
'Keyboard handler
'Modifiers (Ctrl, Alt, Shift):
IF __UI_KeyHit = 100303 OR __UI_KeyHit = 100304 THEN __UI_ShiftIsDown = True
IF __UI_KeyHit = -100303 OR __UI_KeyHit = -100304 THEN __UI_ShiftIsDown = False
IF __UI_KeyHit = 100305 OR __UI_KeyHit = 100306 THEN __UI_CtrlIsDown = True
IF __UI_KeyHit = -100305 OR __UI_KeyHit = -100306 THEN __UI_CtrlIsDown = False
IF __UI_KeyHit = 100307 OR __UI_KeyHit = 100308 THEN __UI_AltIsDown = True
IF __UI_KeyHit = -100307 OR __UI_KeyHit = -100308 THEN __UI_AltIsDown = False
'Key combos can be associated with controls using the RegisterKeyCombo method;
'Key combos take precedence over other keyboard events:
DIM DoCombo AS _BYTE
DoCombo = False
IF __UI_BypassKeyCombos = False AND __UI_DesignMode = False AND __UI_AltIsDown = False AND __UI_KeyHit > 0 AND __UI_TotalActiveMenus = 0 THEN
DIM ComboKey AS STRING
DIM tempCombo$
FOR i = 1 TO __UI_TotalKeyCombos
IF __UI_KeyCombo(i).ControlID <= 0 THEN _CONTINUE 'handled internally
ComboKey = ""
tempCombo$ = RTRIM$(UCASE$(__UI_KeyCombo(i).Combo))
FOR j = LEN(tempCombo$) TO 1 STEP -1
IF MID$(tempCombo$, j, 1) = "+" THEN
ComboKey = MID$(tempCombo$, j + 1)
EXIT FOR
END IF
NEXT
IF ComboKey = "" THEN ComboKey = tempCombo$
IF (INSTR(tempCombo$, "SHIFT+") > 0) <> __UI_ShiftIsDown THEN _CONTINUE
IF (INSTR(tempCombo$, "CTRL+") > 0) <> __UI_CtrlIsDown THEN _CONTINUE
IF LEFT$(ComboKey, 1) = "F" THEN
IF VAL(MID$(ComboKey, 2)) >= 1 AND VAL(MID$(ComboKey, 2)) <= 12 THEN
'Function key
IF __UI_KeyHit = __UI_FKey(VAL(MID$(ComboKey, 2))) THEN
DoCombo = True
EXIT FOR
END IF
ELSE
IF __UI_KeyHit = ASC("F") OR __UI_KeyHit = ASC("f") THEN
'Combo match
DoCombo = True
EXIT FOR
END IF
END IF
ELSE
IF __UI_KeyHit = ASC(ComboKey) OR __UI_KeyHit = ASC(LCASE$(ComboKey)) THEN
'Combo match
DoCombo = True
EXIT FOR
END IF
END IF
NEXT
IF DoCombo THEN
IF Control(__UI_KeyCombo(i).ControlID).Disabled = False AND Control(__UI_KeyCombo(i).ControlID).Hidden = False THEN
IF Control(__UI_KeyCombo(i).ControlID).Type = __UI_Type_RadioButton THEN
SetRadioButtonValue __UI_KeyCombo(i).ControlID
ELSEIF Control(__UI_KeyCombo(i).ControlID).Type = __UI_Type_CheckBox OR Control(__UI_KeyCombo(i).ControlID).Type = __UI_Type_ToggleSwitch THEN
Control(__UI_KeyCombo(i).ControlID).Value = NOT Control(__UI_KeyCombo(i).ControlID).Value
__UI_ValueChanged __UI_KeyCombo(i).ControlID
Control(__UI_KeyCombo(i).ControlID).LastChange = TIMER
ELSEIF Control(__UI_KeyCombo(i).ControlID).Type = __UI_Type_MenuItem THEN
IF Control(__UI_KeyCombo(i).ControlID).BulletStyle = __UI_Bullet THEN SetRadioButtonValue __UI_KeyCombo(i).ControlID
END IF
__UI_Click __UI_KeyCombo(i).ControlID
END IF
EXIT SUB
END IF
END IF
'Alt:
IF NOT __UI_DesignMode THEN
IF __UI_AltIsDown AND Control(__UI_Focus).Type = __UI_Type_MenuBar THEN
__UI_Focus = __UI_PreviousFocus
__UI_AltIsDown = False
__UI_ForceRedraw = True 'Trigger a global redraw
ELSEIF __UI_AltIsDown AND __UI_TotalActiveMenus > 0 THEN
__UI_Focus = __UI_PreviousFocus
__UI_CloseAllMenus
__UI_ForceRedraw = True
__UI_KeyHit = 0
__UI_AltIsDown = False
ELSEIF __UI_AltIsDown THEN
IF NOT __UI_ShowHotKeys THEN
__UI_ShowHotKeys = True
__UI_ForceRedraw = True 'Trigger a global redraw
END IF
SELECT CASE __UI_KeyHit
CASE 48 TO 57, 65 TO 90, 97 TO 122 'Alphanumeric
__UI_AltCombo$ = __UI_AltCombo$ + CHR$(__UI_KeyHit)
IF __UI_KeyHit >= 97 THEN __UI_KeyHit = __UI_KeyHit - 32 'Turn to capitals
IF __UI_KeyHit > 0 THEN
'Search for a matching hot key in controls
FOR i = 1 TO UBOUND(Control)
IF Control(i).HotKey = __UI_KeyHit AND NOT Control(i).Disabled AND Control(i).Type <> __UI_Type_MenuItem THEN
SELECT CASE Control(i).Type
CASE __UI_Type_Button
IF Control(i).CanHaveFocus THEN __UI_Focus = Control(i).ID
__UI_Click Control(i).ID
CASE __UI_Type_RadioButton
IF Control(i).CanHaveFocus THEN __UI_Focus = Control(i).ID
SetRadioButtonValue Control(i).ID
__UI_Click Control(i).ID
CASE __UI_Type_CheckBox
IF Control(i).CanHaveFocus THEN __UI_Focus = Control(i).ID
Control(i).Value = NOT Control(i).Value
__UI_Click Control(i).ID
__UI_ValueChanged Control(i).ID
CASE __UI_Type_Frame
'Find the first children in this frame that can have focus
FOR j = i + 1 TO UBOUND(Control)
IF Control(j).ParentID = Control(i).ID AND Control(j).CanHaveFocus AND NOT Control(j).Disabled THEN
__UI_Focus = Control(j).ID
EXIT FOR
END IF
NEXT
CASE __UI_Type_Label
'Find the next control in the same container that can have focus
FOR j = i + 1 TO UBOUND(Control)
IF Control(j).ParentID = Control(i).ParentID AND Control(j).CanHaveFocus AND NOT Control(j).Disabled THEN
__UI_Focus = Control(j).ID
EXIT FOR
END IF
NEXT
CASE __UI_Type_MenuBar
IF __UI_TotalActiveMenus = 0 THEN
__UI_PreviousFocus = __UI_Focus
__UI_ActivateMenu Control(i), True
__UI_ForceRedraw = True
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Value = __UI_Focus
__UI_KeyHit = 0
__UI_AltIsDown = False
END IF
END SELECT
EXIT FOR
END IF
NEXT
END IF
__UI_KeyHit = 0
END SELECT
ELSE
IF __UI_ShowHotKeys THEN
__UI_ShowHotKeys = False
__UI_ForceRedraw = True 'Trigger a global redraw
IF LEN(__UI_AltCombo$) THEN
'Numeric keypresses with alt pressed are converted into the proper ASCII character
'and inserted into the active textbox, if any.
IF VAL(__UI_AltCombo$) >= 32 AND VAL(__UI_AltCombo$) <= 254 THEN
__UI_KeyHit = VAL(__UI_AltCombo$)
END IF
__UI_AltCombo$ = ""
ELSE
'Alt was released with no key having been pressed in the meantime,
'so the menubar will be activated, if it exists (unless a dropdown
'list was activated
IF __UI_HasMenuBar AND __UI_ActiveDropdownList = 0 THEN
__UI_PreviousFocus = __UI_Focus
__UI_Focus = __UI_FirstMenuBarControl
END IF
END IF
END IF
END IF
END IF
'Control-specific keyboard handler:
IF __UI_DesignMode THEN
IF __UI_KeyHit = 27 THEN
FOR i = 1 TO UBOUND(Control)
Control(i).ControlIsSelected = False
NEXT
__UI_TotalSelectedControls = 0
__UI_FirstSelectedID = 0
END IF
END IF
IF __UI_Focus > 0 AND __UI_KeyHit <> 0 AND __UI_DesignMode = False THEN
__UI_KeyPress __UI_Focus
__UI_KeyboardFocus = True
'Enter activates the selected/default button, if any
IF __UI_IsDragging = False AND __UI_KeyHit = -13 AND NOT Control(__UI_Focus).Disabled THEN
IF Control(__UI_Focus).Type = __UI_Type_Button OR Control(__UI_Focus).Type = __UI_Type_MenuItem THEN
i = __UI_Focus
IF Control(__UI_Focus).Type = __UI_Type_MenuItem THEN
IF Control(__UI_Focus).SubMenu THEN
__UI_ActivateMenu Control(__UI_Focus), True
ELSE
__UI_Focus = __UI_PreviousFocus
__UI_CloseAllMenus
__UI_ForceRedraw = True
__UI_KeyHit = 0
END IF
END IF
__UI_HoveringID = i
GOTO ProcessClick
ELSEIF Control(__UI_Focus).Type = __UI_Type_ListBox AND __UI_Focus = __UI_ActiveDropdownList THEN
__UI_Focus = __UI_ParentDropdownList
Control(__UI_ParentDropdownList).Value = Control(__UI_ActiveDropdownList).Value
__UI_DestroyControl Control(__UI_ActiveDropdownList)
IF Control(__UI_Focus).PreviousValue <> Control(__UI_Focus).Value THEN
__UI_ValueChanged __UI_Focus
Control(__UI_Focus).PreviousValue = Control(__UI_Focus).Value
Control(__UI_Focus).Redraw = True
END IF
ELSEIF Control(__UI_Focus).Type = __UI_Type_MenuBar THEN
__UI_ActivateMenu Control(__UI_Focus), True
ELSEIF Control(__UI_Focus).Type = __UI_Type_TextBox AND Control(__UI_Focus).Multiline THEN
'Do nothing. Enter will add a new line to a multiline textbox (below).
ELSEIF __UI_Focus <> __UI_DefaultButtonID AND __UI_DefaultButtonID > 0 THEN
__UI_Click __UI_DefaultButtonID
END IF
ELSE
SELECT CASE Control(__UI_Focus).Type
CASE __UI_Type_TrackBar
SELECT CASE __UI_KeyHit
CASE 19200 'Left
IF Control(__UI_Focus).Value > Control(__UI_Focus).Min THEN
IF __UI_CtrlIsDown THEN
IF Control(__UI_Focus).MinInterval > 0 AND Control(__UI_Focus).MinInterval < Control(__UI_Focus).Interval THEN
Control(__UI_Focus).Value = Control(__UI_Focus).Value - Control(__UI_Focus).MinInterval
ELSE
Control(__UI_Focus).Value = Control(__UI_Focus).Value - Control(__UI_Focus).Interval
END IF
ELSE
Control(__UI_Focus).Value = Control(__UI_Focus).Value - Control(__UI_Focus).Interval
END IF
IF Control(__UI_Focus).Value < Control(__UI_Focus).Min THEN _
Control(__UI_Focus).Value = Control(__UI_Focus).Min
'IF Control(__UI_Focus).PreviousValue <> Control(__UI_Focus).Value THEN __UI_ValueChanged __UI_Focus
END IF
CASE 19712 'Right
IF Control(__UI_Focus).Value < Control(__UI_Focus).Max THEN
IF __UI_CtrlIsDown THEN
Control(__UI_Focus).Value = Control(__UI_Focus).Value + Control(__UI_Focus).MinInterval
ELSE
Control(__UI_Focus).Value = Control(__UI_Focus).Value + Control(__UI_Focus).Interval
END IF
IF Control(__UI_Focus).Value > Control(__UI_Focus).Max THEN _
Control(__UI_Focus).Value = Control(__UI_Focus).Max
'IF Control(__UI_Focus).PreviousValue <> Control(__UI_Focus).Value THEN __UI_ValueChanged __UI_Focus
END IF
CASE 18176 'Home
Control(__UI_Focus).Value = Control(__UI_Focus).Min
'IF Control(__UI_Focus).PreviousValue <> Control(__UI_Focus).Value THEN __UI_ValueChanged __UI_Focus
CASE 20224 'End
Control(__UI_Focus).Value = Control(__UI_Focus).Max
'IF Control(__UI_Focus).PreviousValue <> Control(__UI_Focus).Value THEN __UI_ValueChanged __UI_Focus
END SELECT
CASE __UI_Type_MenuBar
SELECT CASE __UI_KeyHit
CASE 48 TO 57, 65 TO 90, 97 TO 122 'Alphanumeric
IF __UI_KeyHit >= 97 THEN __UI_KeyHit = __UI_KeyHit - 32 'Turn to capitals
'Search for a matching hot key in menu bar items
IF __UI_CtrlIsDown = False THEN
FOR i = 1 TO UBOUND(Control)
IF Control(i).HotKey = __UI_KeyHit AND NOT Control(i).Disabled AND Control(i).Type = __UI_Type_MenuBar THEN
IF __UI_TotalActiveMenus = 0 THEN
__UI_ActivateMenu Control(i), True
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Value = __UI_Focus
__UI_ForceRedraw = True
__UI_KeyHit = 0
END IF
EXIT FOR
END IF
NEXT
END IF
CASE 27 'Esc
__UI_Focus = __UI_PreviousFocus
__UI_KeyHit = 0
CASE 19200 'Left
__UI_Focus = __UI_PreviousMenuBarControl(__UI_Focus)
CASE 19712 'Right
__UI_Focus = __UI_NextMenuBarControl(__UI_Focus)
CASE 18432, 20480 'Up, down
__UI_ActivateMenu Control(__UI_Focus), True
__UI_KeyHit = 0
END SELECT
CASE __UI_Type_MenuPanel, __UI_Type_MenuItem
HandleDesignMenu:
SELECT CASE __UI_KeyHit
CASE 48 TO 57, 65 TO 90, 97 TO 122 'Alphanumeric
IF __UI_CtrlIsDown = False THEN
IF __UI_KeyHit >= 97 THEN __UI_KeyHit = __UI_KeyHit - 32 'Turn to capitals
'Search for a matching hot key in menu bar items
FOR i = 1 TO UBOUND(Control)
IF Control(i).HotKey = __UI_KeyHit AND NOT Control(i).Disabled AND Control(i).Type = __UI_Type_MenuItem AND Control(i).ParentID = __UI_ParentMenu(__UI_TotalActiveMenus) THEN
IF LEFT$(Control(i).Name, 5) = "__UI_" THEN
__UI_HoveringID = i
GOTO ProcessHotkey
ELSE
IF Control(i).SubMenu THEN
__UI_KeyHit = 0
__UI_Focus = Control(i).ID
__UI_ForceRedraw = True
_DELAY .1
__UI_ActivateMenu Control(i), True
ELSE
__UI_Focus = __UI_PreviousFocus
__UI_CloseAllMenus
__UI_ForceRedraw = True
__UI_KeyHit = 0
__UI_Click i
END IF
END IF
EXIT FOR
END IF
NEXT
END IF
CASE 27 'Esc
IF __UI_TotalActiveMenus > 1 THEN
__UI_Focus = __UI_ParentMenu(__UI_TotalActiveMenus)
__UI_DestroyControl Control(__UI_ActiveMenu(__UI_TotalActiveMenus))
ELSEIF __UI_TotalActiveMenus = 1 THEN
__UI_Focus = __UI_ParentMenu(__UI_TotalActiveMenus)
__UI_CloseAllMenus
ELSEIF __UI_TotalActiveMenus > 0 AND __UI_ActiveMenuIsContextMenu THEN
__UI_CloseAllMenus
__UI_Focus = __UI_PreviousFocus
END IF
__UI_KeyHit = 0
CASE 19200 'Left
IF __UI_TotalActiveMenus > 1 THEN
'close sub-menu
__UI_Focus = __UI_ParentMenu(__UI_TotalActiveMenus)
__UI_DestroyControl Control(__UI_ActiveMenu(__UI_TotalActiveMenus))
ELSEIF __UI_TotalActiveMenus = 1 THEN
IF __UI_ActiveMenuIsContextMenu = False THEN
'activate left neighbor menubar item
__UI_CloseAllMenus
__UI_ActivateMenu Control(__UI_PreviousMenuBarControl(__UI_TopMenuBarItem)), True
__UI_ForceRedraw = True
END IF
END IF
__UI_KeyHit = 0
CASE 19712 'Right
IF Control(__UI_Focus).SubMenu THEN
__UI_ActivateMenu Control(__UI_Focus), True
ELSE
IF __UI_ActiveMenuIsContextMenu = False THEN
__UI_CloseAllMenus
__UI_ActivateMenu Control(__UI_NextMenuBarControl(__UI_TopMenuBarItem)), True
__UI_ForceRedraw = True
END IF
END IF
__UI_KeyHit = 0
CASE 18432 'Up
__UI_Focus = __UI_PreviousMenuItem(__UI_Focus)
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Value = Control(__UI_Focus).ID
CASE 20480 'Down
__UI_Focus = __UI_NextMenuItem(__UI_Focus)
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Value = Control(__UI_Focus).ID
END SELECT
CASE __UI_Type_Button, __UI_Type_RadioButton, __UI_Type_CheckBox, __UI_Type_ToggleSwitch
SELECT CASE __UI_KeyHit
CASE 32
'Emulate mouse down/click
IF __UI_IsDragging = False AND NOT Control(__UI_Focus).Disabled THEN
'Space bar down on a button
IF __UI_KeyIsDown = False AND __UI_KeyDownOnID = 0 THEN
__UI_KeyDownOnID = __UI_Focus
__UI_KeyIsDown = True
END IF
END IF
CASE -32
IF __UI_IsDragging = False AND NOT Control(__UI_Focus).Disabled THEN
'Space bar released and a button has focus
IF __UI_KeyIsDown AND __UI_Focus = __UI_KeyDownOnID THEN
IF Control(__UI_KeyDownOnID).Type = __UI_Type_RadioButton THEN
SetRadioButtonValue __UI_KeyDownOnID
ELSEIF Control(__UI_KeyDownOnID).Type = __UI_Type_CheckBox OR _
Control(__UI_KeyDownOnID).Type = __UI_Type_ToggleSwitch THEN
Control(__UI_KeyDownOnID).Value = NOT Control(__UI_KeyDownOnID).Value
__UI_ValueChanged __UI_KeyDownOnID
Control(__UI_KeyDownOnID).LastChange = TIMER
END IF
__UI_KeyDownOnID = 0
__UI_KeyIsDown = False
__UI_Click __UI_Focus
END IF
END IF
CASE 18432, 20480 'Up, down
IF (Control(__UI_Focus).Type = __UI_Type_RadioButton OR Control(__UI_Focus).Type = __UI_Type_CheckBox) THEN
__UI_FocusSearch = __UI_Focus
DO
IF _KEYDOWN(100304) OR _KEYDOWN(100303) THEN
__UI_FocusSearch = (__UI_FocusSearch + UBOUND(Control) - 2) MOD UBOUND(Control) + 1
ELSE
__UI_FocusSearch = __UI_FocusSearch MOD UBOUND(Control) + 1
END IF
IF __UI_FocusSearch = __UI_Focus THEN
'Full circle. No similar control can have focus
EXIT DO
END IF
IF Control(__UI_FocusSearch).CanHaveFocus AND NOT Control(__UI_FocusSearch).Disabled AND Control(__UI_Focus).Type = Control(__UI_FocusSearch).Type THEN
__UI_KeepFocus = False: __UI_FocusOut __UI_Focus
IF __UI_KeepFocus = False THEN
__UI_Focus = __UI_FocusSearch
__UI_FocusIn __UI_Focus
IF Control(__UI_FocusSearch).Type = __UI_Type_RadioButton THEN SetRadioButtonValue __UI_Focus
END IF
EXIT DO
END IF
LOOP
END IF
END SELECT
CASE __UI_Type_ListBox, __UI_Type_DropdownList
IF NOT Control(__UI_Focus).Disabled AND Control(__UI_Focus).Max > 0 THEN
_FONT (Control(__UI_Focus).Font)
SELECT EVERYCASE __UI_KeyHit
CASE 32 TO 254 'Printable ASCII characters
DIM CurrentItem%
CurrentItem% = Control(__UI_Focus).Value
__UI_ListBoxSearchItem Control(__UI_Focus)
IF CurrentItem% <> Control(__UI_Focus).Value THEN
'Adjust view:
IF Control(__UI_Focus).Value < Control(__UI_Focus).InputViewStart THEN
Control(__UI_Focus).InputViewStart = Control(__UI_Focus).Value
ELSEIF Control(__UI_Focus).Value > Control(__UI_Focus).InputViewStart + Control(__UI_Focus).LastVisibleItem - 1 THEN
Control(__UI_Focus).InputViewStart = Control(__UI_Focus).Value - Control(__UI_Focus).LastVisibleItem + 1
END IF
END IF
CASE 18432 'Up
IF Control(__UI_Focus).Value > 1 THEN
Control(__UI_Focus).Value = Control(__UI_Focus).Value - 1
IF Control(__UI_Focus).PreviousValue <> Control(__UI_Focus).Value THEN
__UI_ValueChanged __UI_Focus
Control(__UI_Focus).PreviousValue = Control(__UI_Focus).Value
Control(__UI_Focus).Redraw = True
END IF
END IF
CASE 20480 'Down
IF __UI_AltIsDown THEN
IF Control(__UI_Focus).Type = __UI_Type_DropdownList THEN
__UI_ActivateDropdownlist Control(__UI_Focus)
END IF
ELSE
IF Control(__UI_Focus).Value < Control(__UI_Focus).Max THEN
Control(__UI_Focus).Value = Control(__UI_Focus).Value + 1
IF Control(__UI_Focus).PreviousValue <> Control(__UI_Focus).Value THEN
__UI_ValueChanged __UI_Focus
Control(__UI_Focus).PreviousValue = Control(__UI_Focus).Value
Control(__UI_Focus).Redraw = True
END IF
END IF
END IF
CASE 18688 'Page up
Control(__UI_Focus).Value = Control(__UI_Focus).Value - Control(__UI_Focus).LastVisibleItem
IF Control(__UI_Focus).Value < 1 THEN Control(__UI_Focus).Value = 1
IF Control(__UI_Focus).PreviousValue <> Control(__UI_Focus).Value THEN
__UI_ValueChanged __UI_Focus
Control(__UI_Focus).PreviousValue = Control(__UI_Focus).Value
Control(__UI_Focus).Redraw = True
END IF
CASE 20736 'Page down
IF Control(__UI_Focus).Value < Control(__UI_Focus).Max - Control(__UI_Focus).LastVisibleItem THEN
Control(__UI_Focus).Value = Control(__UI_Focus).Value + Control(__UI_Focus).LastVisibleItem - 1
ELSE
Control(__UI_Focus).Value = Control(__UI_Focus).Max
END IF
IF Control(__UI_Focus).PreviousValue <> Control(__UI_Focus).Value THEN
__UI_ValueChanged __UI_Focus
Control(__UI_Focus).PreviousValue = Control(__UI_Focus).Value
Control(__UI_Focus).Redraw = True
END IF
CASE 18176 'Home
Control(__UI_Focus).Value = 1
IF Control(__UI_Focus).PreviousValue <> Control(__UI_Focus).Value THEN
__UI_ValueChanged __UI_Focus
Control(__UI_Focus).PreviousValue = Control(__UI_Focus).Value
Control(__UI_Focus).Redraw = True
END IF
CASE 20224 'End
Control(__UI_Focus).Value = Control(__UI_Focus).Max
IF Control(__UI_Focus).PreviousValue <> Control(__UI_Focus).Value THEN
__UI_ValueChanged __UI_Focus
Control(__UI_Focus).PreviousValue = Control(__UI_Focus).Value
Control(__UI_Focus).Redraw = True
END IF
CASE 18432, 20480, 18688, 20736, 18176, 20224
'Adjust view:
IF Control(__UI_Focus).Value < Control(__UI_Focus).InputViewStart THEN
Control(__UI_Focus).InputViewStart = Control(__UI_Focus).Value
ELSEIF Control(__UI_Focus).Value > Control(__UI_Focus).InputViewStart + Control(__UI_Focus).LastVisibleItem - 1 THEN
Control(__UI_Focus).InputViewStart = Control(__UI_Focus).Value - Control(__UI_Focus).LastVisibleItem + 1
END IF
END SELECT
END IF
CASE __UI_Type_TextBox
DIM Clip$, FindLF&
DIM s1 AS LONG, s2 AS LONG
IF NOT Control(__UI_Focus).Disabled THEN
SELECT EVERYCASE __UI_KeyHit
CASE 32 TO 254 'Printable ASCII characters
IF __UI_KeyHit = ASC("v") OR __UI_KeyHit = ASC("V") THEN 'Paste from clipboard (Ctrl+V)
IF __UI_CtrlIsDown THEN
PasteIntoTextBox:
IF Control(__UI_Focus).Multiline THEN
Clip$ = Replace(_CLIPBOARD$, CHR$(13) + CHR$(10), CHR$(10), False, 0)
IF LEN(Clip$) > 0 THEN
IF NOT Control(__UI_Focus).TextIsSelected THEN
IF Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus)) THEN
Text(__UI_Focus) = Text(__UI_Focus) + Clip$
Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus))
ELSE
Text(__UI_Focus) = LEFT$(Text(__UI_Focus), Control(__UI_Focus).Cursor) + Clip$ + MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor + 1)
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor + LEN(Clip$)
END IF
ELSE
's1 = Control(__UI_Focus).SelectionStart
's2 = Control(__UI_Focus).Cursor
'IF s1 > s2 THEN SWAP s1, s2
'Text(__UI_Focus) = LEFT$(Text(__UI_Focus), s1) + Clip$ + MID$(Text(__UI_Focus), s2 + 1)
'Control(__UI_Focus).Cursor = s1 + LEN(Clip$)
'Control(__UI_Focus).TextIsSelected = False
'__UI_SelectedText = ""
'__UI_SelectionLength = 0
END IF
__UI_TextChanged __UI_Focus
IF Control(__UI_Focus).NumericOnly THEN
Control(__UI_Focus).Value = VAL(Text(__UI_Focus))
__UI_ValidateBounds __UI_Focus
END IF
END IF
IF ContextMenuPaste THEN
ContextMenuPaste = False
RETURN
END IF
__UI_KeyHit = 0
ELSE
Clip$ = _CLIPBOARD$
FindLF& = INSTR(Clip$, CHR$(13))
IF FindLF& > 0 THEN Clip$ = LEFT$(Clip$, FindLF& - 1)
FindLF& = INSTR(Clip$, CHR$(10))
IF FindLF& > 0 THEN Clip$ = LEFT$(Clip$, FindLF& - 1)
IF LEN(Clip$) > 0 THEN
IF LEN(Mask(__UI_Focus)) > 0 THEN
'Paste only numbers and only up until the limit of
'numeric placeholders:
DIM NumericClip$
NumericClip$ = ""
FOR i = 1 TO LEN(Clip$)
IF ASC(Clip$, i) >= 48 AND ASC(Clip$, i) <= 57 THEN
NumericClip$ = NumericClip$ + CHR$(ASC(Clip$, i))
END IF
NEXT
IF LEN(NumericClip$) THEN
Text(__UI_Focus) = ""
FOR i = 1 TO LEN(Mask(__UI_Focus))
SELECT CASE MID$(Mask(__UI_Focus), i, 1)
CASE "0", "9", "#"
IF LEN(NumericClip$) THEN
Text(__UI_Focus) = Text(__UI_Focus) + LEFT$(NumericClip$, 1)
NumericClip$ = MID$(NumericClip$, 2)
ELSE
Text(__UI_Focus) = Text(__UI_Focus) + "_"
END IF
CASE ELSE
Text(__UI_Focus) = Text(__UI_Focus) + MID$(Mask(__UI_Focus), i, 1)
END SELECT
NEXT
END IF
ELSE
IF Control(__UI_Focus).NumericOnly THEN
'Paste only if clipboard$ contains a number
IF NOT isNumber(Clip$) THEN Clip$ = ""
END IF
IF LEN(Clip$) THEN
IF NOT Control(__UI_Focus).TextIsSelected THEN
IF Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus)) THEN
Text(__UI_Focus) = Text(__UI_Focus) + Clip$
Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus))
ELSE
Text(__UI_Focus) = LEFT$(Text(__UI_Focus), Control(__UI_Focus).Cursor) + Clip$ + MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor + 1)
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor + LEN(Clip$)
END IF
ELSE
s1 = Control(__UI_Focus).SelectionStart
s2 = Control(__UI_Focus).Cursor
IF s1 > s2 THEN SWAP s1, s2
Text(__UI_Focus) = LEFT$(Text(__UI_Focus), s1) + Clip$ + MID$(Text(__UI_Focus), s2 + 1)
Control(__UI_Focus).Cursor = s1 + LEN(Clip$)
Control(__UI_Focus).TextIsSelected = False
__UI_FillSelectedText 0, 0
END IF
END IF
END IF
__UI_TextChanged __UI_Focus
IF Control(__UI_Focus).NumericOnly THEN
Control(__UI_Focus).Value = VAL(Text(__UI_Focus))
__UI_ValidateBounds __UI_Focus
END IF
END IF
IF ContextMenuPaste THEN
ContextMenuPaste = False
RETURN
END IF
__UI_KeyHit = 0
END IF
END IF
ELSEIF __UI_KeyHit = ASC("c") OR __UI_KeyHit = ASC("C") THEN 'Copy selection to clipboard (Ctrl+C)
IF __UI_CtrlIsDown THEN
__UI_FillSelectedText 0, 0
IF LEN(__UI_SelectedText) > 0 THEN _CLIPBOARD$ = __UI_SelectedText
__UI_KeyHit = 0
END IF
ELSEIF __UI_KeyHit = ASC("x") OR __UI_KeyHit = ASC("X") THEN 'Cut selection to clipboard (Ctrl+X)
IF __UI_CtrlIsDown THEN
__UI_FillSelectedText 0, 0
IF LEN(__UI_SelectedText) > 0 THEN
_CLIPBOARD$ = __UI_SelectedText
__UI_DeleteSelection
__UI_TextChanged __UI_Focus
IF Control(__UI_Focus).NumericOnly THEN
Control(__UI_Focus).Value = VAL(Text(__UI_Focus))
__UI_ValidateBounds __UI_Focus
END IF
END IF
__UI_KeyHit = 0
END IF
ELSEIF __UI_KeyHit = ASC("a") OR __UI_KeyHit = ASC("A") THEN 'Select all text (Ctrl+A)
IF __UI_CtrlIsDown THEN
Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus))
Control(__UI_Focus).SelectionStart = 0
Control(__UI_Focus).TextIsSelected = True
__UI_KeyHit = 0
END IF
END IF
IF Control(__UI_Focus).NumericOnly THEN
IF __UI_KeyHit = 45 THEN
IF INSTR(Text(__UI_Focus), "-") > 0 THEN
IF INSTR(__UI_SelectedText, "-") = 0 THEN
__UI_KeyHit = 0
END IF
ELSE
IF (Control(__UI_Focus).Cursor > 0 AND Control(__UI_Focus).TextIsSelected = False) THEN
__UI_KeyHit = 0
END IF
END IF
ELSEIF __UI_KeyHit = 46 THEN
IF INSTR(Text(__UI_Focus), ".") > 0 THEN
IF INSTR(__UI_SelectedText, ".") = 0 THEN
__UI_KeyHit = 0
END IF
ELSE
IF Control(__UI_Focus).Cursor = 0 AND LEFT$(Text(__UI_Focus), 1) = "-" THEN
__UI_KeyHit = 0
END IF
END IF
ELSEIF __UI_KeyHit < 48 OR __UI_KeyHit > 57 THEN
__UI_KeyHit = 0
END IF
END IF
IF __UI_KeyHit THEN
IF __UI_KeyHit = 13 THEN __UI_KeyHit = 10
IF Mask(__UI_Focus) = "" OR Control(__UI_Focus).Multiline THEN
IF NOT Control(__UI_Focus).TextIsSelected THEN
IF Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus)) THEN
IF (Control(__UI_Focus).Max > 0 AND LEN(Text(__UI_Focus)) < Control(__UI_Focus).Max) OR Control(__UI_Focus).Max = 0 THEN
Text(__UI_Focus) = Text(__UI_Focus) + CHR$(__UI_KeyHit)
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor + LEN(CHR$(__UI_KeyHit))
END IF
ELSE
IF (Control(__UI_Focus).Max > 0 AND LEN(Text(__UI_Focus)) < Control(__UI_Focus).Max) OR Control(__UI_Focus).Max = 0 THEN
Text(__UI_Focus) = LEFT$(Text(__UI_Focus), Control(__UI_Focus).Cursor) + CHR$(__UI_KeyHit) + MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor + 1)
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor + 1
END IF
END IF
ELSE
s1 = Control(__UI_Focus).SelectionStart
s2 = Control(__UI_Focus).Cursor
IF s1 > s2 THEN SWAP s1, s2
Text(__UI_Focus) = LEFT$(Text(__UI_Focus), s1) + CHR$(__UI_KeyHit) + MID$(Text(__UI_Focus), s2 + 1)
Control(__UI_Focus).TextIsSelected = False
__UI_SelectedText = ""
__UI_SelectionLength = 0
Control(__UI_Focus).Cursor = s1 + 1
END IF
ELSE
'Masked input KeyHit:
IF Control(__UI_Focus).TextIsSelected THEN
__UI_DeleteSelectionMasked
END IF
IF __UI_KeyHit >= 48 AND __UI_KeyHit <= 57 THEN
DO
SELECT CASE MID$(Mask(__UI_Focus), Control(__UI_Focus).Cursor + 1, 1)
CASE "0", "9", "#"
MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor + 1, 1) = CHR$(__UI_KeyHit)
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor + 1
EXIT DO
CASE ELSE
IF Control(__UI_Focus).Cursor < LEN(Mask(__UI_Focus)) THEN
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor + 1
ELSE
EXIT DO
END IF
END SELECT
LOOP
END IF
END IF
__UI_TextChanged __UI_Focus
IF Control(__UI_Focus).NumericOnly THEN
Control(__UI_Focus).Value = VAL(Text(__UI_Focus))
__UI_ValidateBounds __UI_Focus
END IF
END IF
CASE 8 'Backspace
IF Mask(__UI_Focus) = "" OR Control(__UI_Focus).Multiline THEN
IF LEN(Text(__UI_Focus)) > 0 THEN
IF NOT Control(__UI_Focus).TextIsSelected THEN
IF Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus)) THEN
IF Control(__UI_Focus).Multiline AND RIGHT$(Text(__UI_Focus), 1) = CHR$(10) THEN
Control(__UI_Focus).CurrentLine = Control(__UI_Focus).CurrentLine - 1
END IF
Text(__UI_Focus) = LEFT$(Text(__UI_Focus), LEN(Text(__UI_Focus)) - 1)
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor - 1
ELSEIF Control(__UI_Focus).Cursor >= 1 THEN
IF Control(__UI_Focus).Multiline AND MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor, 1) = CHR$(10) THEN
Control(__UI_Focus).CurrentLine = Control(__UI_Focus).CurrentLine - 1
END IF
Text(__UI_Focus) = LEFT$(Text(__UI_Focus), Control(__UI_Focus).Cursor - 1) + MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor + 1)
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor - 1
END IF
ELSE
__UI_DeleteSelection
END IF
__UI_TextChanged __UI_Focus
IF Control(__UI_Focus).NumericOnly THEN
Control(__UI_Focus).Value = VAL(Text(__UI_Focus))
__UI_ValidateBounds __UI_Focus
END IF
END IF
ELSE
'Masked input Backspace:
IF NOT Control(__UI_Focus).TextIsSelected THEN
IF Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus)) THEN
Text(__UI_Focus) = LEFT$(Text(__UI_Focus), LEN(Text(__UI_Focus)) - 1)
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor - 1
ELSEIF Control(__UI_Focus).Cursor >= 1 THEN
IF Control(__UI_Focus).Multiline AND MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor, 1) = CHR$(10) THEN
Control(__UI_Focus).CurrentLine = Control(__UI_Focus).CurrentLine - 1
END IF
Text(__UI_Focus) = LEFT$(Text(__UI_Focus), Control(__UI_Focus).Cursor - 1) + MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor + 1)
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor - 1
END IF
Text(__UI_Focus) = __UI_MaskToText$(__UI_Focus)
ELSE
__UI_DeleteSelectionMasked
END IF
__UI_TextChanged __UI_Focus
IF Control(__UI_Focus).NumericOnly THEN
Control(__UI_Focus).Value = VAL(Text(__UI_Focus))
__UI_ValidateBounds __UI_Focus
END IF
END IF
CASE 21248 'Delete
IF LEN(Mask(__UI_Focus)) = 0 THEN
IF NOT Control(__UI_Focus).TextIsSelected THEN
IF LEN(Text(__UI_Focus)) > 0 THEN
IF Control(__UI_Focus).Cursor = 0 THEN
Text(__UI_Focus) = RIGHT$(Text(__UI_Focus), LEN(Text(__UI_Focus)) - 1)
ELSEIF Control(__UI_Focus).Cursor > 0 AND Control(__UI_Focus).Cursor <= LEN(Text(__UI_Focus)) - 1 THEN
Text(__UI_Focus) = LEFT$(Text(__UI_Focus), Control(__UI_Focus).Cursor) + MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor + 2)
END IF
__UI_TextChanged __UI_Focus
IF Control(__UI_Focus).NumericOnly THEN
Control(__UI_Focus).Value = VAL(Text(__UI_Focus))
__UI_ValidateBounds __UI_Focus
END IF
END IF
ELSE
__UI_DeleteSelection
__UI_TextChanged __UI_Focus
IF Control(__UI_Focus).NumericOnly THEN
Control(__UI_Focus).Value = VAL(Text(__UI_Focus))
__UI_ValidateBounds __UI_Focus
END IF
END IF
ELSE
'Masked input Delete:
IF NOT Control(__UI_Focus).TextIsSelected THEN
IF LEN(Text(__UI_Focus)) > 0 THEN
IF Control(__UI_Focus).Cursor < LEN(Text(__UI_Focus)) THEN
MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor + 1, 1) = MID$(__UI_EmptyMask$(__UI_Focus), Control(__UI_Focus).Cursor + 1, 1)
__UI_TextChanged __UI_Focus
IF Control(__UI_Focus).NumericOnly THEN
Control(__UI_Focus).Value = VAL(Text(__UI_Focus))
__UI_ValidateBounds __UI_Focus
END IF
END IF
END IF
ELSE
__UI_DeleteSelectionMasked
__UI_TextChanged __UI_Focus
IF Control(__UI_Focus).NumericOnly THEN
Control(__UI_Focus).Value = VAL(Text(__UI_Focus))
__UI_ValidateBounds __UI_Focus
END IF
END IF
END IF
CASE 19200 'Left arrow key
__UI_CheckSelection __UI_Focus
IF __UI_CtrlIsDown THEN
IF Control(__UI_Focus).Cursor > 0 THEN
'Go back until we hit a nonseparator character
DO
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor - 1
IF Control(__UI_Focus).Cursor = 0 THEN EXIT DO
LOOP UNTIL INSTR(SEP$, MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor + 1, 1)) = 0
'Find the beginning of a word
DO
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor - 1
IF Control(__UI_Focus).Cursor = 0 THEN EXIT DO
LOOP WHILE INSTR(SEP$, MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor + 1, 1)) = 0
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor + 1
END IF
ELSE
IF Control(__UI_Focus).Cursor > 0 THEN Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor - 1
END IF
IF MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor + 1, 1) = CHR$(10) THEN Control(__UI_Focus).CurrentLine = Control(__UI_Focus).CurrentLine - 1
CASE 19712 'Right arrow key
__UI_CheckSelection __UI_Focus
IF __UI_CtrlIsDown THEN
IF Control(__UI_Focus).Cursor < LEN(Text(__UI_Focus)) THEN
DO
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor + 1
IF Control(__UI_Focus).Cursor > LEN(Text(__UI_Focus)) THEN EXIT DO
LOOP WHILE INSTR(SEP$, MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor + 1, 1)) = 0
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor + 1
END IF
ELSE
IF Control(__UI_Focus).Cursor < LEN(Text(__UI_Focus)) THEN Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor + 1
END IF
IF MID$(Text(__UI_Focus), Control(__UI_Focus).Cursor, 1) = CHR$(10) THEN Control(__UI_Focus).CurrentLine = Control(__UI_Focus).CurrentLine + 1
CASE 18432 'Up arrow key
IF Control(__UI_Focus).Multiline THEN
IF Control(__UI_Focus).CurrentLine > 1 THEN
Control(__UI_Focus).CurrentLine = Control(__UI_Focus).CurrentLine - 1
END IF
END IF
CASE 20480 'Down arrow key
IF Control(__UI_Focus).Multiline THEN
IF Control(__UI_Focus).CurrentLine < __UI_CountLines(__UI_Focus) THEN
Control(__UI_Focus).CurrentLine = Control(__UI_Focus).CurrentLine + 1
END IF
END IF
CASE 18432, 20480 'For both up and down keys
IF Control(__UI_Focus).Multiline THEN
ThisLineLen = LEN(__UI_GetTextBoxLine(__UI_Focus, Control(__UI_Focus).CurrentLine, ThisLineStart))
Control(__UI_Focus).Cursor = ThisLineStart + Control(__UI_Focus).VisibleCursor - 1
IF Control(__UI_Focus).Cursor > ThisLineStart + ThisLineLen - 1 THEN
Control(__UI_Focus).Cursor = ThisLineStart + ThisLineLen - 1
END IF
END IF
CASE 18176 'Home
__UI_CheckSelection __UI_Focus
IF Control(__UI_Focus).Multiline THEN
IF __UI_CtrlIsDown THEN
Control(__UI_Focus).Cursor = 0
Control(__UI_Focus).CurrentLine = 1
ELSE
Control(__UI_Focus).Cursor = Control(__UI_Focus).Cursor - Control(__UI_Focus).VisibleCursor
END IF
ELSE
Control(__UI_Focus).Cursor = 0
END IF
CASE 20224 'End
__UI_CheckSelection __UI_Focus
IF Control(__UI_Focus).Multiline THEN
IF __UI_CtrlIsDown THEN
Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus))
Control(__UI_Focus).CurrentLine = __UI_CountLines(__UI_Focus)
ELSE
ThisLineLen = LEN(__UI_GetTextBoxLine(__UI_Focus, Control(__UI_Focus).CurrentLine, ThisLineStart))
Control(__UI_Focus).Cursor = ThisLineStart + ThisLineLen - 1
END IF
ELSE
Control(__UI_Focus).Cursor = LEN(Text(__UI_Focus))
END IF
END SELECT
IF Control(__UI_Focus).Multiline THEN
_FONT Control(__UI_Focus).Font
IF Control(__UI_Focus).CurrentLine < Control(__UI_Focus).FirstVisibleLine THEN
Control(__UI_Focus).FirstVisibleLine = Control(__UI_Focus).CurrentLine
ELSEIF Control(__UI_Focus).CurrentLine + 1 > Control(__UI_Focus).FirstVisibleLine + Control(__UI_Focus).Height \ uspacing& THEN
Control(__UI_Focus).FirstVisibleLine = Control(__UI_Focus).CurrentLine - Control(__UI_Focus).Height \ uspacing& + 1
END IF
END IF
END IF
END SELECT
END IF
ELSEIF __UI_DesignMode AND __UI_KeyHit <> 0 THEN 'No buttons will respond while in design mode
'But the design menu must respond:
IF __UI_TotalActiveMenus > 0 AND LEFT$(Control(__UI_ParentMenu(__UI_TotalActiveMenus)).Name, 5) = "__UI_" THEN GOTO HandleDesignMenu
SELECT CASE __UI_Keyhit
CASE ASC("Z"), ASC("z")
IF __UI_CtrlIsDown THEN
__UI_KeyPress 214
END IF
CASE ASC("Y"), ASC("y")
IF __UI_CtrlIsDown THEN
__UI_KeyPress 215
END IF
CASE ASC("A"), ASC("a")
IF __UI_CtrlIsDown THEN
ControlSelect:
__UI_KeyPress 221
END IF
CASE ASC("X"), ASC("x")
IF __UI_CtrlIsDown AND __UI_TotalSelectedControls > 0 THEN
ControlCut:
__UI_KeyPress 216
__UI_KeyPress 219
END IF
CASE ASC("C"), ASC("c")
IF __UI_CtrlIsDown AND __UI_TotalSelectedControls > 0 THEN
ControlCopy:
__UI_KeyPress 217
END IF
CASE ASC("V"), ASC("v")
IF __UI_CtrlIsDown THEN
ControlPaste:
Clip$ = _CLIPBOARD$
IF LEFT$(Clip$, LEN(__UI_ClipboardCheck$)) = __UI_ClipboardCheck$ THEN
__UI_KeyPress 218
END IF
END IF
CASE 21248 'Delete
ControlDelete:
__UI_KeyPress 216
__UI_KeyPress 220
CASE 19200 'Left arrow key
__UI_KeyPress 216
FOR i = 1 TO UBOUND(Control)
IF Control(i).ControlIsSelected AND Control(i).Type <> __UI_Type_MenuBar AND Control(i).Type <> __UI_Type_MenuItem THEN
IF __UI_ShiftIsDown THEN
Control(i).Width = Control(i).Width - 1
__UI_IsResizing = True
__UI_ResizingID = i
ELSE
Control(i).Left = Control(i).Left - 1
END IF
END IF
NEXT
CASE 19712 'Right arrow key
__UI_KeyPress 216
FOR i = 1 TO UBOUND(Control)
IF Control(i).ControlIsSelected AND Control(i).Type <> __UI_Type_MenuBar AND Control(i).Type <> __UI_Type_MenuItem THEN
IF __UI_ShiftIsDown THEN
Control(i).Width = Control(i).Width + 1
__UI_IsResizing = True
__UI_ResizingID = i
ELSE
Control(i).Left = Control(i).Left + 1
END IF
END IF
NEXT
CASE 18432 'Up arrow key
__UI_KeyPress 216
FOR i = 1 TO UBOUND(Control)
IF Control(i).ControlIsSelected AND Control(i).Type <> __UI_Type_MenuBar AND Control(i).Type <> __UI_Type_MenuItem THEN
IF __UI_ShiftIsDown THEN
__UI_IsResizing = True
__UI_ResizingID = i
Control(i).Height = Control(i).Height - 1
ELSE
Control(i).Top = Control(i).Top - 1
END IF
END IF
NEXT
CASE 20480 'Down arrow key
__UI_KeyPress 216
FOR i = 1 TO UBOUND(Control)
IF Control(i).ControlIsSelected AND Control(i).Type <> __UI_Type_MenuBar AND Control(i).Type <> __UI_Type_MenuItem THEN
IF __UI_ShiftIsDown THEN
Control(i).Height = Control(i).Height + 1
__UI_IsResizing = True
__UI_ResizingID = i
ELSE
Control(i).Top = Control(i).Top + 1
END IF
END IF
NEXT
END SELECT
IF __UI_TotalActiveMenus > 0 THEN __UI_ActivateMenu Control(__UI_ParentMenu(__UI_TotalActiveMenus)), False
ELSEIF __UI_KeyHit <> 0 THEN 'No control has focus
'Enter activates the default button, if any
IF __UI_IsDragging = False AND __UI_KeyHit = -13 AND __UI_DefaultButtonID > 0 THEN
'Enter released and there is a default button
__UI_Click __UI_DefaultButtonID
__UI_KeyHit = 0
END IF
END IF
__UI_LastHoveringID = __UI_HoveringID
EXIT SUB
CheckResizeSnapRight:
'Snap right
IF i = __UI_ResizingID AND (_KEYDOWN(100305) = 0 AND _KEYDOWN(100306) = 0) AND __UI_SnapLines THEN
IF Control(i).ParentID = 0 THEN __UI_RelevantID = __UI_FormID ELSE __UI_RelevantID = Control(i).ParentID
'Form:
IF (Control(i).Left + Control(i).Width) > Control(__UI_RelevantID).Width - __UI_SnapDistanceFromForm OR _
((Control(__UI_RelevantID).Width - __UI_SnapDistanceFromForm) - (Control(i).Left + Control(i).Width)) <= __UI_SnapDistanceFromForm / 2 THEN
Control(i).Width = Control(__UI_RelevantID).Width - __UI_SnapDistanceFromForm - Control(i).Left
__UI_Snapped = True
__UI_SnappedX = __UI_SnapDistanceFromForm
__UI_SnappedByProximityX = 4
END IF
'Neighboring controls:
PrevXSnapOffset = 10
FOR j = 1 TO UBOUND(Control)
IF Control(j).ParentID = Control(__UI_ResizingID).ParentID AND Control(j).Type > 0 AND _
j <> __UI_ResizingID AND Control(j).Type <> __UI_Type_ContextMenu AND Control(j).Type <> __UI_Type_Form AND Control(j).Type <> __UI_Type_Font AND Control(j).Type <> __UI_Type_MenuItem AND Control(j).Type <> __UI_Type_MenuBar AND Control(j).Type <> __UI_Type_MenuPanel AND _
Control(j).ControlIsSelected = False THEN
XSnapOffset = ABS((Control(i).Left + Control(i).Width) - (Control(j).Left))
IF XSnapOffset < 5 AND XSnapOffset < PrevXSnapOffset THEN
PrevXSnapOffset = XSnapOffset
Control(i).Width = (Control(j).Left) - Control(i).Left
__UI_Snapped = True
__UI_SnappedX = Control(j).Left
__UI_SnappedXID = j
END IF
XSnapOffset = ABS((Control(i).Left + Control(i).Width) - (Control(j).Left + Control(j).Width))
IF XSnapOffset < 5 AND XSnapOffset < PrevXSnapOffset THEN
PrevXSnapOffset = XSnapOffset
Control(i).Width = (Control(j).Left + Control(j).Width) - Control(i).Left
__UI_Snapped = True
__UI_SnappedX = Control(i).Left + Control(i).Width
__UI_SnappedXID = j
END IF
END IF
NEXT
END IF
RETURN
CheckResizeSnapLeft:
'Snap left
IF i = __UI_ResizingID AND (_KEYDOWN(100305) = 0 AND _KEYDOWN(100306) = 0) AND __UI_SnapLines THEN
IF Control(i).ParentID = 0 THEN __UI_RelevantID = __UI_FormID ELSE __UI_RelevantID = Control(i).ParentID
'Form:
IF (Control(i).Left) < __UI_SnapDistanceFromForm OR _
(Control(i).Left) <= __UI_SnapDistanceFromForm * 1.5 THEN
Control(i).Left = __UI_SnapDistanceFromForm
Control(i).Width = OriginalResizeRightSide - __UI_SnapDistanceFromForm
__UI_Snapped = True
__UI_SnappedX = __UI_SnapDistanceFromForm
__UI_SnappedByProximityX = 3
END IF
'Neighboring controls:
END IF
RETURN
CheckResizeSnapTop:
'Snap top
IF i = __UI_ResizingID AND (_KEYDOWN(100305) = 0 AND _KEYDOWN(100306) = 0) AND __UI_SnapLines THEN
IF Control(i).ParentID = 0 THEN __UI_RelevantID = __UI_FormID ELSE __UI_RelevantID = Control(i).ParentID
'Form:
IF (Control(i).Top) < __UI_SnapDistanceFromForm OR _
(Control(i).Top) <= __UI_SnapDistanceFromForm * 1.5 THEN
Control(i).Top = __UI_SnapDistanceFromForm
Control(i).Height = OriginalResizeBottom - __UI_SnapDistanceFromForm
__UI_Snapped = True
__UI_SnappedY = __UI_SnapDistanceFromForm
__UI_SnappedByProximityY = 3
END IF
'Neighboring controls:
END IF
RETURN
CheckResizeSnapBottom:
'Snap bottom
IF i = __UI_ResizingID AND (_KEYDOWN(100305) = 0 AND _KEYDOWN(100306) = 0) AND __UI_SnapLines THEN
IF Control(i).ParentID = 0 THEN __UI_RelevantID = __UI_FormID ELSE __UI_RelevantID = Control(i).ParentID
'Form:
IF (Control(i).Top + Control(i).Height) > Control(__UI_RelevantID).Height - __UI_SnapDistanceFromForm OR _
((Control(__UI_RelevantID).Height - __UI_SnapDistanceFromForm) - (Control(i).Top + Control(i).Height)) <= __UI_SnapDistanceFromForm / 2 THEN
Control(i).Height = Control(__UI_RelevantID).Height - __UI_SnapDistanceFromForm - Control(i).Top
__UI_Snapped = True
__UI_SnappedY = Control(__UI_RelevantID).Height - __UI_SnapDistanceFromForm
__UI_SnappedByProximityY = 4
END IF
'Neighboring controls:
PrevYSnapOffset = 10
FOR j = 1 TO UBOUND(Control)
IF Control(j).ParentID = Control(__UI_ResizingID).ParentID AND Control(j).Type > 0 AND _
j <> __UI_ResizingID AND Control(j).Type <> __UI_Type_ContextMenu AND Control(j).Type <> __UI_Type_Form AND Control(j).Type <> __UI_Type_Font AND Control(j).Type <> __UI_Type_MenuItem AND Control(j).Type <> __UI_Type_MenuBar AND Control(j).Type <> __UI_Type_MenuPanel AND _
Control(j).ControlIsSelected = False THEN
YSnapOffset = ABS((Control(i).Top + Control(i).Height) - (Control(j).Top - __UI_SnapDistance))
IF YSnapOffset < 5 AND YSnapOffset < PrevYSnapOffset THEN
PrevYSnapOffset = YSnapOffset
Control(i).Height = (Control(j).Top - Control(i).Top) - __UI_SnapDistance
__UI_Snapped = True
__UI_SnappedY = Control(j).Top - __UI_SnapDistance
__UI_SnappedYID = j
__UI_SnappedByProximityY = 1
END IF
YSnapOffset = ABS((Control(i).Top + Control(i).Height) - (Control(j).Top + Control(j).Height))
IF YSnapOffset < 5 AND YSnapOffset < PrevYSnapOffset THEN
PrevYSnapOffset = YSnapOffset
Control(i).Height = (Control(j).Top + Control(j).Height) - Control(i).Top
__UI_Snapped = True
__UI_SnappedY = Control(i).Top + Control(i).Height
__UI_SnappedYID = j
END IF
END IF
NEXT
END IF
RETURN
END SUB
SUB __UI_ValidateBounds(this AS LONG)
IF Control(this).NumericOnly = __UI_NumericWithBounds THEN
'Max and Min properties can be used for NumericOnly textboxes
'set as .NumericOnly = __UI_NumericWithBounds
IF Control(this).Value < Control(this).Min THEN
Control(this).Value = Control(this).Min
END IF
IF Control(this).Value > Control(this).Max THEN
Control(this).Value = Control(this).Max
END IF
END IF
END SUB
'---------------------------------------------------------------------------------
SUB AutoSizeLabel (this AS __UI_ControlTYPE)
DIM tempFont AS LONG, tempCenter AS INTEGER
DIM autoWidth AS INTEGER, autoHeight AS INTEGER
IF this.AutoSize = False THEN EXIT SUB
IF this.WordWrap = False THEN
tempFont = _FONT
_FONT this.Font
autoWidth = __UI_PrintWidth(Caption(this.ID))
IF this.Padding THEN autoWidth = autoWidth + this.Padding * 2
IF this.HasBorder THEN autoWidth = autoWidth + (__UI_DefaultCaptionIndent + this.BorderSize) * 2
IF this.Width <> autoWidth OR this.Height <> uspacing + 6 THEN
this.Width = autoWidth
autoHeight = uspacing + 6
IF this.HasBorder THEN autoHeight = autoHeight + this.BorderSize * 2
IF this.Height <> autoHeight THEN
tempCenter = this.Top + this.Height / 2
this.Height = autoHeight
this.Top = tempCenter - this.Height / 2
END IF
this.Redraw = True
END IF
_FONT tempFont
END IF
END SUB
'---------------------------------------------------------------------------------
FUNCTION Darken~& (WhichColor~&, ByHowMuch%)
Darken~& = _RGB32(_RED32(WhichColor~&) * (ByHowMuch% / 100), _GREEN32(WhichColor~&) * (ByHowMuch% / 100), _BLUE32(WhichColor~&) * (ByHowMuch% / 100))
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION isNumber%% (__a$)
'This function adapted from qb64.bas
DIM i AS LONG, a AS INTEGER, dp AS _BYTE, a$
a$ = LTRIM$(RTRIM$(__a$))
IF LEN(a$) = 0 THEN EXIT FUNCTION
FOR i = 1 TO LEN(a$)
a = ASC(MID$(a$, i, 1))
IF a = 45 THEN
IF i <> 1 THEN EXIT FUNCTION
_CONTINUE
END IF
IF a = 46 THEN
IF dp = 1 THEN EXIT FUNCTION
dp = 1
_CONTINUE
END IF
IF a >= 48 AND a <= 57 THEN _CONTINUE
EXIT FUNCTION
NEXT
isNumber%% = True
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION RegisterKeyCombo (__Combo$, id AS LONG)
DIM i AS LONG, j AS LONG, Combo$
IF Control(id).ID = 0 THEN EXIT FUNCTION
IF LEN(LTRIM$(RTRIM$(__Combo$))) = 0 THEN
IF id > 0 THEN
'delete assignment
FOR i = 1 TO __UI_TotalKeyCombos
IF __UI_KeyCombo(i).ControlID = id THEN
Control(__UI_KeyCombo(i).ControlID).KeyCombo = 0
__UI_KeyCombo(i).ControlID = 0
EXIT FOR
END IF
NEXT
END IF
EXIT FUNCTION
END IF
Combo$ = UCASE$(LTRIM$(RTRIM$(__Combo$)))
IF INSTR(Combo$, "CTRL+") = 0 THEN
IF LEFT$(Combo$, 1) = "F" AND (VAL(MID$(Combo$, 2)) >= 1 AND VAL(MID$(Combo$, 2)) <= 12) THEN
'valid
ELSEIF LEFT$(Combo$, 7) = "SHIFT+F" AND (VAL(MID$(Combo$, 8)) >= 1 AND VAL(MID$(Combo$, 8)) <= 12) THEN
'valid
ELSE
EXIT FUNCTION
END IF
END IF
FOR i = 1 TO __UI_TotalKeyCombos
IF RTRIM$(__UI_KeyCombo(i).Combo) = Combo$ THEN
IF __UI_KeyCombo(i).ControlID >= 0 THEN
'Check if this id is already assigned to a combo
FOR j = 1 TO __UI_TotalKeyCombos
IF __UI_KeyCombo(j).ControlID = id THEN
Control(__UI_KeyCombo(j).ControlID).KeyCombo = 0
__UI_KeyCombo(j).ControlID = 0
END IF
NEXT
'Reassign combo to different control
Control(__UI_KeyCombo(i).ControlID).KeyCombo = 0
__UI_KeyCombo(i).ControlID = id
Control(id).KeyCombo = i
RegisterKeyCombo = True
EXIT FUNCTION
ELSE
EXIT FUNCTION
END IF
END IF
NEXT
IF __UI_TotalKeyCombos + 1 > UBOUND(__UI_KeyCombo) THEN
REDIM _PRESERVE __UI_KeyCombo(0 TO UBOUND(__UI_KeyCombo) + 100) AS __UI_KeyCombos
END IF
__UI_TotalKeyCombos = __UI_TotalKeyCombos + 1
__UI_KeyCombo(__UI_TotalKeyCombos).Combo = Combo$
__UI_KeyCombo(__UI_TotalKeyCombos).FriendlyCombo = __UI_FriendlyCombo(Combo$)
FOR i = 1 TO __UI_TotalKeyCombos
IF __UI_KeyCombo(i).ControlID = id THEN
__UI_KeyCombo(i).ControlID = 0
END IF
NEXT
__UI_KeyCombo(__UI_TotalKeyCombos).ControlID = id
Control(id).KeyCombo = __UI_TotalKeyCombos
RegisterKeyCombo = True
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION __UI_FriendlyCombo$ (__Combo$)
DIM i AS LONG, isCapital AS _BYTE
DIM Combo$
isCapital = True
FOR i = 1 TO LEN(__Combo$)
IF isCapital THEN
Combo$ = Combo$ + UCASE$(MID$(__Combo$, i, 1))
isCapital = False
ELSE
Combo$ = Combo$ + LCASE$(MID$(__Combo$, i, 1))
END IF
IF RIGHT$(Combo$, 1) = "+" THEN isCapital = True
NEXT
__UI_FriendlyCombo$ = Combo$
END FUNCTION
'---------------------------------------------------------------------------------
SUB __UI_RestoreFKeys
RESTORE __UI_FKeysData
DIM i AS LONG
FOR i = 1 TO 12
READ __UI_FKey(i)
NEXT
__UI_FKeysData:
DATA 15104,15360,15616,15872,16128,16384
DATA 16640,16896,17152,17408,34048,34304
END SUB
'---------------------------------------------------------------------------------
SUB __UI_RestoreImageOriginalSize
DIM KeepCenterX AS INTEGER, KeepCenterY AS INTEGER
KeepCenterY = Control(__UI_FirstSelectedID).Top + Control(__UI_FirstSelectedID).Height / 2
KeepCenterX = Control(__UI_FirstSelectedID).Left + Control(__UI_FirstSelectedID).Width / 2
Control(__UI_FirstSelectedID).Height = _HEIGHT(Control(__UI_FirstSelectedID).HelperCanvas) + Control(__UI_FirstSelectedID).BorderSize * ABS(Control(__UI_FirstSelectedID).HasBorder)
Control(__UI_FirstSelectedID).Width = _WIDTH(Control(__UI_FirstSelectedID).HelperCanvas) + Control(__UI_FirstSelectedID).BorderSize * ABS(Control(__UI_FirstSelectedID).HasBorder)
Control(__UI_FirstSelectedID).Top = KeepCenterY - Control(__UI_FirstSelectedID).Height / 2
Control(__UI_FirstSelectedID).Left = KeepCenterX - Control(__UI_FirstSelectedID).Width / 2
Control(__UI_FirstSelectedID).Redraw = True
END SUB
'---------------------------------------------------------------------------------
FUNCTION __UI_MaskToText$(id AS LONG)
DIM i AS LONG
DIM Text$
Text$ = Text(id)
IF LEN(Text$) < LEN(Mask(id)) THEN Text$ = Text$ + SPACE$(LEN(Mask(id)) - LEN(Text$))
FOR i = 1 TO LEN(Mask(id))
SELECT CASE MID$(Mask(id), i, 1)
CASE "0", "9", "#"
IF MID$(Text$, i, 1) <> MID$(Mask(id), i, 1) AND ASC(Text$, i) >= 48 AND ASC(Text$, i) <= 57 THEN
'Do nothing
ELSEIF MID$(Text$, i, 1) <> MID$(Mask(id), i, 1) THEN
MID$(Text$, i, 1) = "_"
END IF
CASE ELSE
MID$(Text$, i, 1) = MID$(Mask(id), i, 1)
END SELECT
NEXT
__UI_MaskToText$ = Text$
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION RawText$(id AS LONG)
DIM t$, c$, i AS INTEGER
IF Mask(id) = "" THEN
RawText$ = Text(id)
ELSE
FOR i = 1 TO LEN(Mask(id))
c$ = MID$(Text(id), i, 1)
SELECT CASE MID$(Mask(id), i, 1)
CASE "0", "9", "#"
IF c$ <> "_" THEN
t$ = t$ + c$
ELSE
t$ = t$ + " "
END IF
END SELECT
NEXT
RawText$ = t$
END IF
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION __UI_EmptyMask$(id AS LONG)
DIM i AS LONG
DIM Text$
FOR i = 1 TO LEN(Mask(id))
SELECT CASE MID$(Mask(id), i, 1)
CASE "0", "9", "#"
Text$ = Text$ + "_"
CASE ELSE
Text$ = Text$ + MID$(Mask(id), i, 1)
END SELECT
NEXT
__UI_EmptyMask$ = Text$
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION __UI_GetID (ControlName$)
DIM i AS LONG, ControlSearch$
ControlSearch$ = UCASE$(RTRIM$(ControlName$))
IF LEN(ControlSearch$) = 0 THEN EXIT FUNCTION
FOR i = 1 TO UBOUND(Control)
IF Control(i).ID > 0 AND UCASE$(RTRIM$(Control(i).Name)) = ControlSearch$ THEN
__UI_GetID = i
EXIT FUNCTION
END IF
NEXT
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION __UI_GetFontID (FontHandle&)
DIM i AS LONG
FOR i = 1 TO UBOUND(Control)
IF Control(i).Type = __UI_Type_Font AND Control(i).Value = FontHandle& THEN
__UI_GetFontID = i
EXIT FUNCTION
END IF
NEXT
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION SetFont& (__NewFontFile AS STRING, NewFontSize AS INTEGER)
DIM NextSlot AS LONG, i AS LONG
DIM NewFontFile AS STRING, PassedFontFile AS STRING, FindSep AS LONG
DIM TotalPassedFonts AS LONG
REDIM PassedFonts(0 TO 10) AS STRING
'common sense is not to use question marks for file names, so
'we'll use it as a separator for multiple font assignments.
'"arial.ttf?cour.ttf?lucon.ttf" - First font that is found is used.
PassedFontFile = __NewFontFile
DO
FindSep = INSTR(PassedFontFile, "?")
IF FindSep > 0 THEN
NewFontFile = LEFT$(PassedFontFile, FindSep - 1)
PassedFontFile = RTRIM$(LTRIM$(MID$(PassedFontFile, FindSep + 1)))
ELSE
NewFontFile = RTRIM$(LTRIM$(PassedFontFile))
END IF
TotalPassedFonts = TotalPassedFonts + 1
IF TotalPassedFonts > UBOUND(PassedFonts) THEN REDIM _PRESERVE PassedFonts(0 TO UBOUND(PassedFonts) + 9) AS STRING
PassedFonts(TotalPassedFonts) = NewFontFile
'If the passed font is already loaded, we'll just return its handle
FOR NextSlot = 1 TO UBOUND(Control)
IF Control(NextSlot).Type = __UI_Type_Font THEN
IF (UCASE$(ToolTip(NextSlot)) = UCASE$(__NewFontFile)) AND Control(NextSlot).Max = NewFontSize THEN
SetFont& = Control(NextSlot).Value
EXIT FUNCTION
END IF
END IF
NEXT
LOOP WHILE FindSep > 0
'-------------------------------------------------
'The font isn't loaded, so we'll attempt to do so.
'Increase the global count of fonts
__UI_Type(__UI_Type_Font).Count = __UI_Type(__UI_Type_Font).Count + 1
'Find an empty slot for the new font control
FOR NextSlot = UBOUND(Control) TO 1 STEP -1
IF Control(NextSlot).ID <> 0 THEN
NextSlot = NextSlot + 1
EXIT FOR
ELSE
IF NextSlot = 1 THEN NextSlot = UBOUND(Control) + 1: EXIT FOR
END IF
NEXT
IF NextSlot = UBOUND(Control) + 1 THEN
'No empty slots. We must increase Control() and its helper arrays
REDIM _PRESERVE Control(0 TO NextSlot + 99) AS __UI_ControlTYPE
REDIM _PRESERVE Caption(0 TO NextSlot + 99) AS STRING
REDIM _PRESERVE __UI_TempCaptions(0 TO NextSlot + 99) AS STRING
REDIM _PRESERVE Text(0 TO NextSlot + 99) AS STRING
REDIM _PRESERVE __UI_TempTexts(0 TO NextSlot + 99) AS STRING
REDIM _PRESERVE Mask(0 TO NextSlot + 99) AS STRING
REDIM _PRESERVE __UI_TempMask(0 TO NextSlot + 99) AS STRING
REDIM _PRESERVE ToolTip(0 TO NextSlot + 99) AS STRING
REDIM _PRESERVE __UI_TempTips(0 TO NextSlot + 99) AS STRING
END IF
'Initialize new control
Control(NextSlot).ID = NextSlot
Control(NextSlot).Type = __UI_Type_Font
Control(NextSlot).Name = "Font" + LTRIM$(STR$(__UI_Type(__UI_Type_Font).Count))
NewFontFile = ""
FOR i = 1 TO TotalPassedFonts
IF _FILEEXISTS(PassedFonts(i)) OR _FILEEXISTS("C:\Windows\Fonts\" + PassedFonts(i)) THEN
NewFontFile = PassedFonts(i)
EXIT FOR
END IF
NEXT
IF NewFontFile = "" THEN
'Internal emulated fonts
IF NewFontSize <> 8 AND NewFontSize <> 16 THEN
Control(NextSlot).Value = 16
Control(NextSlot).Max = 16
ELSE
Control(NextSlot).Value = NewFontSize
Control(NextSlot).Max = NewFontSize
END IF
SetFont& = Control(NextSlot).Value
ELSE
Control(NextSlot).Value = _LOADFONT(NewFontFile, NewFontSize)
Control(NextSlot).Max = NewFontSize
Text(NextSlot) = NewFontFile
ToolTip(NextSlot) = __NewFontFile 'save the original string passed
SetFont& = Control(NextSlot).Value
'If loading the requested font fails, we default to _FONT 16
IF Control(NextSlot).Value <= 0 THEN
__UI_DestroyControl Control(NextSlot)
SetFont& = 16
END IF
END IF
END FUNCTION
'---------------------------------------------------------------------------------
SUB __UI_AdjustNewMenuBarTopHeight (NextSlot AS LONG)
DIM TempCanvas AS LONG, PrevDest AS LONG
IF _PIXELSIZE = 0 THEN
'Temporarily create a 32bit screen for proper font handling, in case
'we're still at form setup (SCREEN 0)
TempCanvas = _NEWIMAGE(10, 10, 32)
PrevDest = _DEST
_DEST TempCanvas
END IF
IF Control(__UI_FormID).Font THEN _FONT Control(__UI_FormID).Font
Control(NextSlot).Height = _ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset) + 5
Control(NextSlot).Top = 0
IF TempCanvas <> 0 THEN
_DEST PrevDest
_FREEIMAGE TempCanvas
END IF
IF __UI_HasMenuBar = False THEN
__UI_HasMenuBar = True
'Add menubar div to main form's canvas
IF Control(__UI_FormID).Canvas <> 0 THEN _FREEIMAGE Control(__UI_FormID).Canvas
Control(__UI_FormID).Canvas = _NEWIMAGE(Control(__UI_FormID).Width, Control(__UI_FormID).Height, 32)
_DEST Control(__UI_FormID).Canvas
COLOR Control(__UI_FormID).ForeColor, Control(__UI_FormID).BackColor
CLS
IF Control(__UI_FormID).Font THEN _FONT Control(__UI_FormID).Font
__UI_MenuBarOffsetV = _ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset) + 5 + 2
LINE (0, _ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset) + 5 + 1)-STEP(Control(__UI_FormID).Width - 1, 0), Darken(Control(__UI_FormID).BackColor, 80)
LINE (0, _ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset) + 5 + 2)-STEP(Control(__UI_FormID).Width - 1, 0), Darken(Control(__UI_FormID).BackColor, 120)
_DEST 0
END IF
END SUB
'---------------------------------------------------------------------------------
FUNCTION __UI_NewControl (ControlType AS INTEGER, ControlName AS STRING, NewWidth AS INTEGER, NewHeight AS INTEGER, NewLeft AS INTEGER, NewTop AS INTEGER, ParentID AS LONG)
DIM NextSlot AS LONG, i AS LONG
STATIC InternalMenus AS LONG, FirstControl AS _BYTE
IF ControlType = 0 THEN EXIT SUB
__UI_ExpandControlDrawOrder 1
'Increase the global count of controls of this type
__UI_Type(ControlType).Count = __UI_Type(ControlType).Count + 1
'Give control a generic name, if none is provided
IF ControlType = __UI_Type_MenuItem AND LEFT$(ControlName, 5) = "__UI_" THEN InternalMenus = InternalMenus + 1
IF ControlType = __UI_Type_ContextMenu AND LEFT$(ControlName, 5) = "__UI_" THEN __UI_InternalContextMenus = __UI_InternalContextMenus + 1
IF ControlName = "" THEN
IF ControlType = __UI_Type_MenuItem THEN
ControlName = RTRIM$(__UI_Type(ControlType).Name) + LTRIM$(STR$(__UI_Type(ControlType).Count - InternalMenus))
ELSEIF ControlType = __UI_Type_ContextMenu THEN
ControlName = RTRIM$(__UI_Type(ControlType).Name) + LTRIM$(STR$(__UI_Type(ControlType).Count - __UI_InternalContextMenus))
ELSE
ControlName = RTRIM$(__UI_Type(ControlType).Name) + LTRIM$(STR$(__UI_Type(ControlType).Count))
END IF
END IF
'Make sure this ControlName is unique:
IF ControlType <> __UI_Type_Font THEN
i = 1
DO
IF __UI_GetID(ControlName) = 0 THEN EXIT DO
i = i + 1
ControlName = ControlName + "_" + LTRIM$(STR$(i))
LOOP
END IF
'Find an empty slot for the new control
IF FirstControl = False THEN
NextSlot = 1
FirstControl = True
ELSE
FOR NextSlot = UBOUND(Control) TO 1 STEP -1
IF Control(NextSlot).ID <> 0 THEN
NextSlot = NextSlot + 1
EXIT FOR
ELSE
IF NextSlot = 1 THEN NextSlot = UBOUND(Control) + 1: EXIT FOR
END IF
NEXT
END IF
ControlDrawOrder(UBOUND(ControlDrawOrder)) = NextSlot
IF NextSlot = UBOUND(Control) + 1 THEN
'No empty slots. We must increase Control() and its helper arrays
REDIM _PRESERVE Control(0 TO NextSlot + 99) AS __UI_ControlTYPE
REDIM _PRESERVE Caption(0 TO NextSlot + 99) AS STRING
REDIM _PRESERVE __UI_TempCaptions(0 TO NextSlot + 99) AS STRING
REDIM _PRESERVE Text(0 TO NextSlot + 99) AS STRING
REDIM _PRESERVE __UI_TempTexts(0 TO NextSlot + 99) AS STRING
REDIM _PRESERVE Mask(0 TO NextSlot + 99) AS STRING
REDIM _PRESERVE __UI_TempMask(0 TO NextSlot + 99) AS STRING
REDIM _PRESERVE ToolTip(0 TO NextSlot + 99) AS STRING
REDIM _PRESERVE __UI_TempTips(0 TO NextSlot + 99) AS STRING
END IF
'Initialize new control
Control(NextSlot).ID = NextSlot
Control(NextSlot).Type = ControlType
Control(NextSlot).Name = ControlName
IF ControlType = __UI_Type_Form AND __UI_FormID = 0 THEN __UI_FormID = NextSlot
Control(NextSlot).ParentID = ParentID
Control(NextSlot).ParentName = Control(ParentID).Name
IF ControlType = __UI_Type_MenuItem THEN
IF Control(ParentID).Type = __UI_Type_MenuItem THEN
Control(ParentID).SubMenu = True
END IF
END IF
IF (ControlType <> __UI_Type_Form AND ParentID = 0) THEN
'Inherit main form's font
Control(NextSlot).Font = Control(__UI_FormID).Font
ELSEIF (ControlType <> __UI_Type_Frame AND ParentID > 0) THEN
'Inherit container's font
Control(NextSlot).Font = Control(ParentID).Font
END IF
Control(NextSlot).Width = NewWidth
Control(NextSlot).Height = NewHeight
Control(NextSlot).Left = NewLeft
Control(NextSlot).Top = NewTop
Control(NextSlot).ForeColor = __UI_DefaultColor(ControlType, 1)
Control(NextSlot).BackColor = __UI_DefaultColor(ControlType, 2)
Control(NextSlot).SelectedForeColor = __UI_DefaultColor(ControlType, 3)
Control(NextSlot).SelectedBackColor = __UI_DefaultColor(ControlType, 4)
Control(NextSlot).BorderColor = __UI_DefaultColor(ControlType, 5)
IF ControlType = __UI_Type_MenuBar THEN
__UI_AdjustNewMenuBarTopHeight NextSlot
END IF
IF ControlType = __UI_Type_ToggleSwitch OR ControlType = __UI_Type_TrackBar OR ControlType = __UI_Type_TextBox OR ControlType = __UI_Type_Button OR ControlType = __UI_Type_CheckBox OR ControlType = __UI_Type_RadioButton OR ControlType = __UI_Type_ListBox OR ControlType = __UI_Type_DropdownList THEN
Control(NextSlot).CanHaveFocus = True
END IF
IF ControlType = __UI_Type_Frame THEN
IF NewWidth = 0 THEN NewWidth = 10
IF NewHeight = 0 THEN NewHeight = 10
Control(NextSlot).Canvas = _NEWIMAGE(NewWidth, NewHeight, 32)
END IF
IF __UI_DesignMode THEN
'Control(NextSlot).ContextMenuID = __UI_GetID("__UI_PreviewMenu")
ELSE
IF ControlType = __UI_Type_TextBox THEN
'Programmer can assign any custom menus to his controls, later
'but by default textboxes and other textfields will be
'assigned the internal __UI_TextFieldMenu.
Control(NextSlot).ContextMenuID = __UI_GetID("__UI_TextFieldMenu")
END IF
END IF
IF ControlType = __UI_Type_ProgressBar THEN
Control(NextSlot).Max = 100
Caption(NextSlot) = "\#"
END IF
IF ControlType = __UI_Type_TrackBar THEN
Control(NextSlot).Max = 10
Control(NextSlot).Interval = 1
END IF
IF ControlType = __UI_Type_Form THEN
'Create main window bg:
Control(__UI_FormID).Canvas = _NEWIMAGE(NewWidth, NewHeight, 32)
_DEST Control(__UI_FormID).Canvas
COLOR Control(__UI_FormID).ForeColor, Control(__UI_FormID).BackColor
CLS
_DEST 0
END IF
IF (ControlType = __UI_Type_PictureBox AND __UI_DesignMode) OR ControlType = __UI_Type_TextBox OR ControlType = __UI_Type_Frame OR ControlType = __UI_Type_ListBox OR ControlType = __UI_Type_DropdownList THEN
Control(NextSlot).HasBorder = True
Control(NextSlot).BorderSize = 1
END IF
IF ControlType = __UI_Type_PictureBox THEN
Control(NextSlot).HelperCanvas = _NEWIMAGE(NewWIdth, NewHeight, 32)
IF __UI_DesignMode THEN Control(NextSlot).Stretch = True
Control(NextSlot).Align = __UI_Center
Control(NextSlot).VAlign = __UI_Middle
END IF
IF ControlType = __UI_Type_Label AND __UI_DesignMode THEN Control(NextSlot).VAlign = __UI_Middle
__UI_NewControl = NextSlot
END FUNCTION
'---------------------------------------------------------------------------------
SUB __UI_DestroyControl (This AS __UI_ControlTYPE)
DIM i AS LONG, uw AS LONG
__UI_AutoRefresh = False
IF This.ID > 0 THEN
Caption(This.ID) = ""
__UI_TempCaptions(This.ID) = ""
Text(This.ID) = ""
__UI_TempTexts(This.ID) = ""
ToolTip(This.ID) = ""
__UI_TempTips(This.ID) = ""
Mask(This.ID) = ""
IF This.Type = __UI_Type_ListBox THEN
IF __UI_ActiveDropdownList = This.ID THEN
__UI_ActiveDropdownList = 0
__UI_ParentDropdownList = 0
END IF
ELSEIF This.Type = __UI_Type_MenuPanel THEN
FOR i = 1 TO UBOUND(Control)
IF Control(i).MenuPanelID = This.ID THEN
IF Control(i).ControlIsSelected THEN
Control(i).ControlIsSelected = False
END IF
END IF
NEXT
IF Control(This.SourceControl).Type = __UI_Type_ContextMenu THEN
__UI_ActiveMenuIsContextMenu = False
END IF
__UI_TotalActiveMenus = __UI_TotalActiveMenus - 1
IF __UI_TotalActiveMenus < 0 THEN __UI_TotalActiveMenus = 0
END IF
__UI_Type(This.Type).Count = __UI_Type(This.Type).Count - 1
'Check if this was the last control using this font
IF This.Font > 0 AND This.Font <> 8 AND This.Font <> 16 THEN
FOR i = 1 TO UBOUND(Control)
IF Control(i).Type <> __UI_Type_Font THEN
IF This.ID <> i AND This.Font = Control(i).Font THEN EXIT FOR
END IF
NEXT
IF i > UBOUND(Control) THEN
__UI_DestroyControl Control(__UI_GetFontID(This.Font))
This.Font = 0
END IF
ELSE
This.Font = 0
END IF
END IF
DIM EmptyControl AS __UI_ControlTYPE
IF This.Canvas <> 0 THEN _FREEIMAGE This.Canvas: This.Canvas = 0
IF This.HelperCanvas <> 0 THEN _FREEIMAGE This.HelperCanvas: This.HelperCanvas = 0
IF This.ControlIsSelected THEN This.ControlIsSelected = False: __UI_TotalSelectedControls = __UI_TotalSelectedControls - 1
uw& = GetControlDrawOrder(This.ID)
ControlDrawOrder(uw&) = 0
This = EmptyControl
__UI_HasMenuBar = (__UI_FirstMenuBarControl > 0)
__UI_AutoRefresh = True
END SUB
'---------------------------------------------------------------------------------
SUB SetCaption (ThisID AS LONG, TempCaption$)
DIM FindSep%, NewCaption$, FindEscape%
DIM PrevFont AS LONG, TempCanvas AS LONG, PrevDest AS LONG
IF ThisID = 0 THEN EXIT SUB
NewCaption$ = RestoreCHR$(TempCaption$)
'Parse for hotkey markers
StartSearchForSep:
FindSep% = INSTR(FindSep% + 1, NewCaption$, "&")
IF FindSep% > 0 AND FindSep% < LEN(NewCaption$) THEN
IF FindSep% > 1 THEN
IF ASC(NewCaption$, FindSep% - 1) = 92 THEN
'\& doesnt count as a hot key marker as the backslash
'serves as an escape character
GOTO StartSearchForSep
END IF
END IF
NewCaption$ = LEFT$(NewCaption$, FindSep% - 1) + MID$(NewCaption$, FindSep% + 1)
Control(ThisID).HotKey = ASC(UCASE$(NewCaption$), FindSep%)
Control(ThisID).HotKeyPosition = FindSep%
FindEscape% = INSTR(NewCaption$, "\&")
DO WHILE FindEscape% > 0
IF FindEscape% < FindSep% THEN
FindSep% = FindSep% - 1
END IF
NewCaption$ = LEFT$(NewCaption$, FindEscape% - 1) + MID$(NewCaption$, FindEscape% + 1)
FindEscape% = INSTR(NewCaption$, "\&")
LOOP
PrevFont = _FONT
IF _PIXELSIZE = 0 THEN
'Temporarily create a 32bit screen for proper font handling, in case
'we're still at form setup (SCREEN 0)
TempCanvas = _NEWIMAGE(10, 10, 32)
PrevDest = _DEST
_DEST TempCanvas
END IF
_FONT (Control(ThisID).Font)
IF Control(ThisID).HotKeyPosition = 1 THEN
Control(ThisID).HotKeyOffset = 0
ELSE
Control(ThisID).HotKeyOffset = __UI_PrintWidth(LEFT$(NewCaption$, Control(ThisID).HotKeyPosition - 1))
END IF
IF TempCanvas <> 0 THEN
_DEST PrevDest
_FREEIMAGE TempCanvas
END IF
_FONT PrevFont
ELSE
Control(ThisID).HotKey = 0
END IF
'Replace \n for line breaks:
NewCaption$ = Replace$(NewCaption$, "\n", CHR$(10), False, 0)
Caption(ThisID) = NewCaption$
END SUB
'---------------------------------------------------------------------------------
SUB BeginDraw(ThisID AS LONG)
IF Control(ThisID).Type <> __UI_Type_PictureBox THEN EXIT SUB
_DEST Control(ThisID).HelperCanvas
END SUB
'---------------------------------------------------------------------------------
SUB EndDraw(ThisID AS LONG)
IF Control(ThisID).Type <> __UI_Type_PictureBox THEN EXIT SUB
_DEST 0
Control(ThisID).Redraw = True
END SUB
'---------------------------------------------------------------------------------
SUB LoadImage (This AS __UI_ControlTYPE, File$)
DIM PrevDest AS LONG, ErrorMessage$
STATIC NotFoundImage AS LONG
IF This.HelperCanvas <> 0 THEN _FREEIMAGE This.HelperCanvas
IF _FILEEXISTS(File$) THEN
This.HelperCanvas = _LOADIMAGE(File$, 32)
IF This.HelperCanvas >= -1 THEN
'Maybe it's an .ICO file
This.HelperCanvas = IconPreview(File$)
IF This.HelperCanvas >= -1 THEN ErrorMessage$ = "Unable to load file:"
END IF
ELSE
IF File$ = "" THEN
'Passing an empty file name can be used to clean the canvas
IF This.Type = __UI_Type_PictureBox THEN
This.HelperCanvas = _NEWIMAGE(This.Width, This.Height, 32)
END IF
ELSE
ErrorMessage$ = "Missing image file:"
END IF
END IF
IF LEN(ErrorMessage$) THEN
IF NotFoundImage = 0 THEN NotFoundImage = __UI_LoadThemeImage("notfound.png")
PrevDest = _DEST
This.HelperCanvas = _NEWIMAGE(This.Width, This.Height, 32)
_DEST This.HelperCanvas
_PRINTMODE _KEEPBACKGROUND
_FONT (This.Font)
CLS , _RGBA32(0, 0, 0, 0)
'Place the "missing" icon
_PUTIMAGE (This.Width / 2 - _WIDTH(NotFoundImage) / 2, This.Height / 2 - _HEIGHT(NotFoundImage) / 2), NotFoundImage
COLOR This.ForeColor
__UI_PrintString 5, 5, ErrorMessage$
__UI_PrintString 5, 5 + uspacing&, File$
_DEST PrevDest
Text(This.ID) = ""
ELSE
IF This.Type = __UI_Type_PictureBox OR This.Type = __UI_Type_Button OR This.Type = __UI_Type_MenuItem THEN
Text(This.ID) = File$
END IF
END IF
This.Redraw = True
END SUB
'---------------------------------------------------------------------------------
SUB __UI_ClearColor (Image&, Left AS _UNSIGNED LONG, Top AS INTEGER)
'This SUB may be invoked with two syntaxes:
' __UI_ClearColor Image&, Left, Top
' In which case the color at the (left,top) coordinate will be read and then cleared
'OR
' __UI_ClearColor Image&, Color, -1
' In which case the 32bit color provided will be cleared
DIM PrevSource AS LONG
IF NOT Image& < -1 THEN EXIT SUB
IF Top = -1 THEN
_CLEARCOLOR Left, Image&
ELSE
PrevSource = _SOURCE
_SOURCE Image&
_CLEARCOLOR POINT(Left, Top), Image&
_SOURCE PrevSource
END IF
END SUB
'---------------------------------------------------------------------------------
SUB __UI_ClearHelperCanvasColor (This AS __UI_ControlTYPE, Left AS INTEGER, Top AS INTEGER)
DIM PrevSource AS LONG
IF NOT This.HelperCanvas < -1 THEN EXIT SUB
PrevSource = _SOURCE
_SOURCE This.HelperCanvas
This.TransparentColor = POINT(Left, Top)
_CLEARCOLOR This.TransparentColor, This.HelperCanvas
_SOURCE PrevSource
END SUB
'---------------------------------------------------------------------------------
FUNCTION __UI_LoadThemeImage& (FileName$)
'Contains portions of Dav's BIN2BAS
'http://www.qbasicnews.com/dav/qb64.php
DIM A$, i&, B$, C%, F$, C$, t%, B&, X$, btemp$, BASFILE$
DIM MemoryBlock AS _MEM, TempImage AS LONG, NextSlot AS LONG
DIM NewWidth AS INTEGER, NewHeight AS INTEGER
'Check if this FileName$ has already been loaded
FOR NextSlot = 1 TO UBOUND(__UI_ThemeImages)
IF UCASE$(RTRIM$(__UI_ThemeImages(NextSlot).FileName)) = UCASE$(FileName$) THEN
__UI_LoadThemeImage& = __UI_ThemeImages(NextSlot).Handle
EXIT FUNCTION
ELSEIF RTRIM$(__UI_ThemeImages(NextSlot).FileName) = "" THEN
'Found an empty slot
END IF
NEXT
A$ = __UI_ImageData$(FileName$)
IF LEN(A$) = 0 THEN EXIT FUNCTION
NewWidth = CVI(LEFT$(A$, 2))
NewHeight = CVI(MID$(A$, 3, 2))
A$ = MID$(A$, 5)
FOR i& = 1 TO LEN(A$) STEP 4: B$ = MID$(A$, i&, 4)
IF INSTR(1, B$, "%") THEN
FOR C% = 1 TO LEN(B$): F$ = MID$(B$, C%, 1)
IF F$ <> "%" THEN C$ = C$ + F$
NEXT: B$ = C$
END IF: FOR t% = LEN(B$) TO 1 STEP -1
B& = B& * 64 + ASC(MID$(B$, t%)) - 48
NEXT: X$ = "": FOR t% = 1 TO LEN(B$) - 1
X$ = X$ + CHR$(B& AND 255): B& = B& \ 256
NEXT: btemp$ = btemp$ + X$: NEXT
BASFILE$ = btemp$
TempImage = _NEWIMAGE(NewWidth, NewHeight, 32)
MemoryBlock = _MEMIMAGE(TempImage)
__UI_MemCopy MemoryBlock.OFFSET, _OFFSET(BASFILE$), LEN(BASFILE$)
_MEMFREE MemoryBlock
IF NextSlot > UBOUND(__UI_ThemeImages) THEN
'No empty slots. We must increase __UI_ThemeImages()
REDIM _PRESERVE __UI_ThemeImages(0 TO NextSlot + 99) AS __UI_ThemeImagesType
END IF
__UI_ThemeImages(NextSlot).FileName = FileName$
__UI_ThemeImages(NextSlot).Handle = TempImage
__UI_LoadThemeImage& = TempImage
END FUNCTION
'---------------------------------------------------------------------------------
SUB SetRadioButtonValue (id AS LONG)
'Radio buttons will change value of others in the same group
'Also works for menus with the .BulletStyle set to __UI_Bullet
DIM i AS LONG
IF Control(id).Type = __UI_Type_MenuItem AND Control(id).BulletStyle <> __UI_Bullet THEN
Control(id).Value = NOT Control(id).Value
EXIT SUB
END IF
IF Control(id).Type = __UI_Type_MenuItem OR Control(id).Type = __UI_Type_RadioButton THEN
FOR i = 1 TO UBOUND(Control)
SELECT CASE Control(id).Type
CASE __UI_Type_RadioButton
IF Control(i).Type = __UI_Type_RadioButton AND Control(i).ParentID = Control(id).ParentID THEN
IF Control(i).Value THEN
Control(i).Value = False
__UI_ValueChanged i
END IF
END IF
CASE __UI_Type_MenuItem
IF (Control(i).Type = __UI_Type_MenuItem AND Control(i).BulletStyle = __UI_Bullet) AND Control(i).ParentID = Control(id).ParentID THEN
IF Control(i).MenuItemGroup = Control(id).MenuItemGroup THEN
Control(i).Value = False
END IF
END IF
END SELECT
NEXT
Control(id).Value = True
IF Control(id).Type = __UI_Type_RadioButton THEN __UI_ValueChanged id
Control(id).Redraw = True
END IF
END SUB
'---------------------------------------------------------------------------------
SUB __UI_CheckSelection (id)
IF NOT Control(id).Multiline THEN
IF __UI_ShiftIsDown THEN
IF NOT Control(id).TextIsSelected THEN
Control(id).TextIsSelected = True
Control(id).SelectionStart = Control(id).Cursor
END IF
ELSE
Control(id).TextIsSelected = False
__UI_FillSelectedText 0, 0
END IF
END IF
END SUB
SUB __UI_FillSelectedText(__ss1 AS LONG, __ss2 AS LONG)
DIM i AS LONG
i = __UI_Focus
__UI_SelectedText = ""
__UI_SelectionLength = 0
IF Control(i).Type = __UI_Type_TextBox AND Control(i).TextIsSelected THEN
DIM s1 AS LONG, s2 AS LONG
DIM ss1 AS LONG, ss2 AS LONG
s1 = Control(i).SelectionStart
s2 = Control(i).Cursor
IF s1 > s2 THEN
SWAP s1, s2
IF Control(i).InputViewStart > 1 THEN
ss1 = s1 - Control(i).InputViewStart + 1
ELSE
ss1 = s1
END IF
ss2 = s2 - s1
IF ss1 + ss2 > Control(i).FieldArea THEN ss2 = Control(i).FieldArea - ss1
ELSE
ss1 = s1
ss2 = s2 - s1
IF ss1 < Control(i).InputViewStart THEN ss1 = 0: ss2 = s2 - Control(i).InputViewStart + 1
IF ss1 > Control(i).InputViewStart THEN ss1 = ss1 - Control(i).InputViewStart + 1: ss2 = s2 - s1
END IF
__UI_SelectedText = MID$(Text(i), s1 + 1, s2 - s1)
__UI_SelectionLength = LEN(__UI_SelectedText)
__ss1 = ss1
__ss2 = ss2
END IF
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DeleteSelection
DIM s1 AS LONG, s2 AS LONG
IF NOT Control(__UI_Focus).Multiline THEN
s1 = Control(__UI_Focus).SelectionStart
s2 = Control(__UI_Focus).Cursor
IF s1 > s2 THEN SWAP s1, s2
Text(__UI_Focus) = LEFT$(Text(__UI_Focus), s1) + MID$(Text(__UI_Focus), s2 + 1)
Control(__UI_Focus).TextIsSelected = False
__UI_FillSelectedText 0, 0
Control(__UI_Focus).Cursor = s1
END IF
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DeleteSelectionMasked
DIM s1 AS LONG, s2 AS LONG
s1 = Control(__UI_Focus).SelectionStart
s2 = Control(__UI_Focus).Cursor
IF s1 > s2 THEN SWAP s1, s2
MID$(Text(__UI_Focus), s1 + 1, s2 - s1) = MID$(__UI_EmptyMask$(__UI_Focus), s1 + 1, s2 - s1)
Control(__UI_Focus).TextIsSelected = False
__UI_FillSelectedText 0, 0
Control(__UI_Focus).Cursor = s1
END SUB
'---------------------------------------------------------------------------------
SUB __UI_CursorAdjustments(This AS LONG)
IF NOT Control(This).Multiline AND Control(This).Type = __UI_Type_TextBox THEN
IF Control(This).VisibleCursor >= (Control(This).Width - ((Control(This).BorderSize + __UI_DefaultCaptionIndent) * ABS(Control(This).HasBorder))) THEN
Control(This).InputViewStart = __UI_FocusedTextBoxChars(Control(This).Cursor) - Control(This).Width / 2 'Control(This).InputViewStart + Control(This).Width / 4
ELSEIF Control(This).VisibleCursor <= 0 THEN
IF Control(This).Cursor >= LBOUND(__UI_FocusedTextBoxChars) AND Control(This).Cursor <= UBOUND(__UI_FocusedTextBoxChars) THEN
Control(This).InputViewStart = __UI_FocusedTextBoxChars(Control(This).Cursor) - Control(This).Width / 2 'Control(This).InputViewStart - Control(This).Width / 4
END IF
END IF
IF Control(This).InputViewStart < 0 THEN Control(This).InputViewStart = 0
ELSEIF Control(This).Multiline AND Control(This).Type = __UI_Type_TextBox THEN
'DIM ThisLineStart AS LONG, ThisLineLen AS LONG
'ThisLineLen = LEN(__UI_GetTextBoxLine(This, Control(This).CurrentLine, ThisLineStart))
'IF Control(This).VisibleCursor > ThisLineLen THEN Control(This).VisibleCursor = ThisLineLen
'IF Control(This).VisibleCursor > Control(This).PrevVisibleCursor THEN
' IF Control(This).VisibleCursor - Control(This).InputViewStart + 2 > Control(This).FieldArea THEN Control(This).InputViewStart = (Control(This).VisibleCursor - Control(This).FieldArea) + 2
'ELSEIF Control(This).VisibleCursor < Control(This).PrevVisibleCursor THEN
' IF Control(This).VisibleCursor < Control(This).InputViewStart - 1 THEN Control(This).InputViewStart = Control(This).VisibleCursor
'END IF
'IF Control(This).InputViewStart < 1 THEN Control(This).InputViewStart = 1
END IF
END SUB
'---------------------------------------------------------------------------------
FUNCTION Replace$ (TempText$, SubString$, NewString$, CaseSensitive AS _BYTE, TotalReplacements AS LONG)
DIM FindSubString AS LONG, Text$
IF LEN(TempText$) = 0 THEN EXIT SUB
Text$ = TempText$
TotalReplacements = 0
DO
IF CaseSensitive THEN
FindSubString = INSTR(FindSubString + 1, Text$, SubString$)
ELSE
FindSubString = INSTR(FindSubString + 1, UCASE$(Text$), UCASE$(SubString$))
END IF
IF FindSubString = 0 THEN EXIT DO
IF LEFT$(SubString$, 1) = "\" THEN 'Escape sequence
'Replace the Substring if it's not preceeded by another backslash
IF MID$(Text$, FindSubstring - 1, 1) <> "\" THEN
Text$ = LEFT$(Text$, FindSubString - 1) + NewString$ + MID$(Text$, FindSubString + LEN(SubString$))
TotalReplacements = TotalReplacements + 1
END IF
ELSE
Text$ = LEFT$(Text$, FindSubString - 1) + NewString$ + MID$(Text$, FindSubString + LEN(SubString$))
TotalReplacements = TotalReplacements + 1
END IF
LOOP
Replace$ = Text$
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION __UI_CountLines&(id AS LONG)
DIM FindLF AS LONG, TotalLines AS LONG
IF LEN(Text(id)) = 0 THEN EXIT FUNCTION
FindLF = INSTR(Text(id), CHR$(10))
IF FindLF = 0 THEN
__UI_CountLines& = 1
EXIT FUNCTION
END IF
'There are at least two lines, as one line break was found.
'The search continues from there
TotalLines = 2
DO
FindLF = INSTR(FindLF + 1, Text(id), CHR$(10))
IF FindLF = 0 THEN
__UI_CountLines& = TotalLines
EXIT FUNCTION
END IF
TotalLines = TotalLines + 1
LOOP
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION __UI_GetTextBoxLine$ (id AS LONG, LineNumber AS LONG, StartPosition AS LONG)
'StartPosition is a return parameter
DIM This AS __UI_ControlTYPE, ThisLine AS LONG, FindLF AS LONG, LastLF AS LONG
This = Control(id)
StartPosition = 1
IF NOT This.MultiLine THEN
__UI_GetTextBoxLine$ = Text(id)
EXIT FUNCTION
END IF
FindLF = INSTR(Text(id), CHR$(10))
IF LineNumber = 1 THEN
IF FindLF = 0 THEN
__UI_GetTextBoxLine$ = Text(id)
EXIT FUNCTION
ELSE
__UI_GetTextBoxLine$ = LEFT$(Text(id), FindLF - 1)
EXIT FUNCTION
END IF
END IF
'Scan forward until the desired line is reached or
'until the end of the text is found:
ThisLine = 2
DO
LastLF = FindLF
FindLF = INSTR(LastLF + 1, Text(id), CHR$(10))
IF FindLF > 0 THEN
IF ThisLine = LineNumber THEN
__UI_GetTextBoxLine$ = MID$(Text(id), LastLF + 1, FindLF - LastLF - 1)
StartPosition = LastLF + 1
EXIT FUNCTION
END IF
ELSE
IF ThisLine = LineNumber THEN
__UI_GetTextBoxLine$ = MID$(Text(id), LastLF + 1)
StartPosition = LastLF + 1
END IF
EXIT FUNCTION
END IF
ThisLine = ThisLine + 1
LOOP
'We reached the end of the text. LineNumber seems to not exist.
StartPosition = 0
END FUNCTION
'---------------------------------------------------------------------------------
SUB AddItem (WhichListBox AS LONG, TempItem$)
DIM ThisID AS LONG, prevFont AS LONG
DIM BorderOffset AS INTEGER, Item$
ThisID = WhichListBox
IF Control(ThisID).Type <> __UI_Type_ListBox AND Control(ThisID).Type <> __UI_Type_DropdownList THEN EXIT SUB
Item$ = Replace$(RestoreCHR$(TempItem$), CHR$(10), CHR$(13), False, 0)
IF LEN(Text(ThisID)) > 0 AND RIGHT$(Text(ThisID), 1) <> CHR$(10) THEN Text(ThisID) = Text(ThisID) + CHR$(10)
Text(ThisID) = Text(ThisID) + Item$ + CHR$(10)
Control(ThisID).Max = Control(ThisID).Max + 1
IF Control(ThisID).AutoScroll THEN
prevFont = _FONT
BorderOffset = ABS(Control(ThisID).HasBorder) * 5
_FONT Control(ThisID).Font
IF Control(ThisID).Max > FIX((Control(ThisID).Height - BorderOffset) / Control(ThisID).ItemHeight) THEN
Control(ThisID).InputViewStart = Control(ThisID).Max - FIX((Control(ThisID).Height - BorderOffset) / Control(ThisID).ItemHeight) + 1
END IF
_FONT prevFont
END IF
Control(ThisID).LastVisibleItem = 0 'Reset this var so it'll be recalculated
Control(ThisID).Redraw = True
END SUB
'---------------------------------------------------------------------------------
SUB RemoveItem (WhichListBox AS LONG, ItemToRemove AS INTEGER)
DIM This AS __UI_ControlTYPE, TempText$, ThisItem%, FindLF&, TempCaption$
This = Control(WhichListBox)
IF This.Type <> __UI_Type_ListBox AND This.Type <> __UI_Type_DropdownList THEN EXIT SUB
IF ItemToRemove > This.Max THEN EXIT SUB
TempText$ = Text(This.ID)
Text(This.ID) = ""
ThisItem% = 0
DO WHILE LEN(TempText$)
ThisItem% = ThisItem% + 1
FindLF& = INSTR(TempText$, CHR$(10))
IF FindLF& THEN
TempCaption$ = LEFT$(TempText$, FindLF& - 1)
TempText$ = MID$(TempText$, FindLF& + 1)
ELSE
TempCaption$ = TempText$
TempText$ = ""
END IF
IF ThisItem% <> ItemToRemove THEN Text(This.ID) = Text(This.ID) + TempCaption$ + CHR$(10)
LOOP
This.Max = This.Max - 1
This.LastVisibleItem = 0 'Reset this var so it'll be recalculated
IF This.Value = ItemToRemove THEN
This.Value = 0
ELSEIF This.Value > ItemToRemove THEN
This.Value = This.Value - 1
END IF
Control(This.ID) = This
Control(This.ID).Redraw = True
END SUB
'---------------------------------------------------------------------------------
SUB ResetList (WhichListBox AS LONG)
DIM This AS __UI_ControlTYPE
This = Control(WhichListBox)
IF This.Type <> __UI_Type_ListBox AND This.Type <> __UI_Type_DropdownList THEN EXIT SUB
Text(This.ID) = ""
This.Max = 0
This.LastVisibleItem = 0 'Reset this var so it'll be recalculated
This.InputViewStart = 1
This.Value = 0
Control(This.ID) = This
Control(This.ID).Redraw = True
END SUB
'---------------------------------------------------------------------------------
SUB ReplaceItem (WhichListBox AS LONG, ItemToReplace AS INTEGER, NewText$)
DIM This AS __UI_ControlTYPE, TempText$, ThisItem%, FindLF&, TempCaption$
This = Control(WhichListBox)
IF This.Type <> __UI_Type_ListBox AND This.Type <> __UI_Type_DropdownList THEN EXIT SUB
IF ItemToReplace > This.Max THEN EXIT SUB
TempText$ = Text(This.ID)
Text(This.ID) = ""
ThisItem% = 0
DO WHILE LEN(TempText$)
ThisItem% = ThisItem% + 1
FindLF& = INSTR(TempText$, CHR$(10))
IF FindLF& THEN
TempCaption$ = LEFT$(TempText$, FindLF& - 1)
TempText$ = MID$(TempText$, FindLF& + 1)
ELSE
TempCaption$ = TempText$
TempText$ = ""
END IF
IF ThisItem% <> ItemToReplace THEN
Text(This.ID) = Text(This.ID) + TempCaption$ + CHR$(10)
ELSE
Text(This.ID) = Text(This.ID) + NewText$ + CHR$(10)
END IF
LOOP
Control(This.ID).Redraw = True
END SUB
'---------------------------------------------------------------------------------
FUNCTION SelectItem%% (id AS LONG, __Item$)
'Locates first item in ListBox 'id' that matches Item$;
'Sets .Value; returns True when found;
DIM b$, Item$, i AS LONG
IF Control(id).Type <> __UI_Type_ListBox AND Control(id).Type <> __UI_Type_DropdownList THEN
EXIT FUNCTION
END IF
Item$ = RTRIM$(LTRIM$(__Item$))
IF LEN(Item$) = 0 THEN EXIT FUNCTION
FOR i = 1 TO Control(id).Max
b$ = GetItem$(id, i)
IF b$ = Item$ THEN
Control(id).Value = i
Control(id).Redraw = True
SelectItem%% = True
EXIT FUNCTION
END IF
NEXT
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION GetItem$ (id AS LONG, Item AS LONG)
DIM This AS __UI_ControlTYPE, ThisItem AS LONG, FindLF AS LONG, LastLF AS LONG
This = Control(id)
FindLF = INSTR(Text(id), CHR$(10))
IF Item = 1 THEN
IF FindLF = 0 THEN
GetItem$ = Text(id)
EXIT FUNCTION
ELSE
GetItem$ = LEFT$(Text(id), FindLF - 1)
EXIT FUNCTION
END IF
END IF
'Scan forward until the desired item is reached or
'until the end of the text is found:
ThisItem = 2
DO
LastLF = FindLF
FindLF = INSTR(LastLF + 1, Text(id), CHR$(10))
IF FindLF > 0 THEN
IF ThisItem = Item THEN
GetItem$ = MID$(Text(id), LastLF + 1, FindLF - LastLF - 1)
EXIT FUNCTION
END IF
ELSE
IF ThisItem = Item THEN
GetItem$ = MID$(Text(id), LastLF + 1)
END IF
EXIT FUNCTION
END IF
ThisItem = ThisItem + 1
LOOP
'We reached the end of the text. Item seems to not exist.
END FUNCTION
'---------------------------------------------------------------------------------
SUB __UI_ListBoxSearchItem (This AS __UI_ControlTYPE)
STATIC SearchPattern$, LastListKeyHit AS SINGLE
DIM ThisItem%, FindLF&, TempCaption$, TempText$
DIM ListItems$(1 TO This.Max)
TempText$ = Text(This.ID)
DO WHILE LEN(TempText$)
ThisItem% = ThisItem% + 1
FindLF& = INSTR(TempText$, CHR$(10))
IF FindLF& THEN
TempCaption$ = LEFT$(TempText$, FindLF& - 1)
TempText$ = MID$(TempText$, FindLF& + 1)
ELSE
TempCaption$ = TempText$
TempText$ = ""
END IF
ListItems$(ThisItem%) = TempCaption$
LOOP
IF TIMER - LastListKeyHit < 1 THEN
SearchPattern$ = SearchPattern$ + UCASE$(CHR$(__UI_KeyHit))
ThisItem% = This.Value
ELSE
SearchPattern$ = UCASE$(CHR$(__UI_KeyHit))
ThisItem% = This.Value + 1
IF ThisItem% > This.Max THEN ThisItem% = 1
END IF
DO
IF UCASE$(LEFT$(ListItems$(ThisItem%), LEN(SearchPattern$))) = SearchPattern$ THEN
This.Value = ThisItem%
__UI_ValueChanged This.ID
EXIT DO
END IF
ThisItem% = ThisItem% + 1
IF ThisItem% > This.Max THEN ThisItem% = 1
IF ThisItem% = This.Value THEN EXIT DO
LOOP
LastListKeyHit = TIMER
END SUB
'---------------------------------------------------------------------------------
SUB __UI_PrintString(Left AS INTEGER, Top AS INTEGER, Text$)
DIM Utf$
IF LEFT$(Text$, 1) = CHR$(7) AND (_FONT = 8 OR _FONT = 16) THEN
Utf$ = Text$
ELSE
IF Control(__UI_FormID).Encoding = 1252 THEN
Utf$ = FromCP1252$(Text$)
ELSE 'Default to 437
Utf$ = FromCP437$(Text$)
END IF
END IF
DIM PM AS LONG: PM = _PRINTMODE
_PRINTMODE _KEEPBACKGROUND
_UPRINTSTRING (Left, Top), Utf$, , 8
SELECT CASE PM
CASE 1
_PRINTMODE _KEEPBACKGROUND
CASE 2
_PRINTMODE _ONLYBACKGROUND
CASE 3
_PRINTMODE _FILLBACKGROUND
END SELECT
END SUB
SUB __UI_CharPos(Text$)
DIM Utf$
IF LEFT$(Text$, 1) = CHR$(7) AND (_FONT = 8 OR _FONT = 16) THEN
Utf$ = Text$
ELSE
IF Control(__UI_FormID).Encoding = 1252 THEN
Utf$ = FromCP1252$(Text$)
ELSE 'Default to 437
Utf$ = FromCP437$(Text$)
END IF
END IF
REDIM __UI_ThisLineChars(0 TO LEN(Utf$)) AS LONG
__UI_LastRenderedCharCount = _UCHARPOS(Utf$, __UI_ThisLineChars(), 8)
REDIM _PRESERVE __UI_ThisLineChars(__UI_LastRenderedCharCount) AS LONG
END SUB
'---------------------------------------------------------------------------------
FUNCTION __UI_PrintWidth&(Text$)
__UI_PrintWidth& = _UPRINTWIDTH(Text$, 8)
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION __UI_WordWrap$ (PassedText AS STRING, Width AS INTEGER, LongestLine AS INTEGER, Lines AS INTEGER)
DIM Temp$, TempCaption$, FindSep AS LONG, PrevSep AS LONG
DIM NextSlot AS LONG, TempLine$, i AS LONG, Text AS STRING
DIM ThisLineWidth AS INTEGER
Text = RTRIM$(PassedText)
IF Text = "" THEN Lines = 1: EXIT FUNCTION
FOR i = 1 TO UBOUND(__UI_WordWrapHistoryTexts)
IF __UI_WordWrapHistoryTexts(i) = "" THEN EXIT FOR
IF __UI_WordWrapHistoryTexts(i) = Text THEN
'Text has been processed before. If it was under the same Width and Font,
'the previously stored result is returned
IF __UI_WordWrapHistory(i).Width = Width AND __UI_WordWrapHistory(i).Font = _FONT THEN
__UI_WordWrap$ = __UI_WordWrapHistoryResults(i)
Lines = __UI_WordWrapHistory(i).TotalLines
LongestLine = __UI_WordWrapHistory(i).LongestLine
EXIT FUNCTION
ELSE
'Otherwise, it'll be reprocessed
EXIT FOR
ENDIF
END IF
NEXT
NextSlot = i
IF NextSlot > UBOUND(__UI_WordWrapHistory) THEN
REDIM _PRESERVE __UI_WordWrapHistory(1 TO NextSlot + 99) AS __UI_WordWrapHistoryType
REDIM _PRESERVE __UI_WordWrapHistoryTexts(1 TO NextSlot + 99) AS STRING
REDIM _PRESERVE __UI_WordWrapHistoryResults(1 TO NextSlot + 99) AS STRING
END IF
__UI_WordWrapHistoryTexts(NextSlot) = Text
__UI_WordWrapHistory(NextSlot).Width = Width
__UI_WordWrapHistory(NextSlot).Font = _FONT
Lines = 0
LongestLine = 0
TempCaption$ = Text
IF __UI_PrintWidth&(TempCaption$) > Width THEN
'Word wrap is faster for fixed-width fonts.
'CHR$(10) is a line break. CHR$(1) is a soft break (word wrap)
DO WHILE LEN(TempCaption$)
FindSep = INSTR(TempCaption$, CHR$(10)) 'process the passed text line by line
IF FindSep > 0 THEN
TempLine$ = LEFT$(TempCaption$, FindSep - 1)
TempCaption$ = MID$(TempCaption$, FindSep + 1)
ELSE
TempLine$ = TempCaption$
TempCaption$ = ""
END IF
DO WHILE LEN(TempLine$)
IF __UI_PrintWidth&(TempLine$) < Width THEN
IF LEN(Temp$) > 0 THEN Temp$ = Temp$ + CHR$(1)
ThisLineWidth = __UI_PrintWidth(Templine$)
IF LongestLine < ThisLineWidth THEN LongestLine = ThisLineWidth
Temp$ = Temp$ + TempLine$
TempLine$ = ""
Lines = Lines + 1
ELSE
PrevSep = 0
DO
FindSep = INSTR(PrevSep + 1, TempLine$, " ")
IF FindSep > 0 THEN
IF __UI_PrintWidth(LEFT$(TempLine$, FindSep - 1)) > Width THEN
IF PrevSep = 0 THEN
'This word alone is > than the width, can't fight that.
IF LEN(Temp$) > 0 THEN Temp$ = Temp$ + CHR$(1)
Temp$ = Temp$ + LEFT$(TempLine$, FindSep - 1)
TempLine$ = MID$(TempLine$, FindSep + 1)
Lines = Lines + 1
EXIT DO
ELSE
IF LEN(Temp$) > 0 THEN Temp$ = Temp$ + CHR$(1)
Temp$ = Temp$ + LEFT$(TempLine$, PrevSep - 1)
ThisLineWidth = __UI_PrintWidth(LEFT$(TempLine$, PrevSep - 1))
IF LongestLine < ThisLineWidth THEN LongestLine = ThisLineWidth
TempLine$ = MID$(TempLine$, PrevSep + 1)
Lines = Lines + 1
EXIT DO
END IF
END IF
PrevSep = FindSep
ELSE
IF PrevSep > 0 THEN
IF LEN(Temp$) > 0 THEN Temp$ = Temp$ + CHR$(1)
Temp$ = Temp$ + LEFT$(TempLine$, PrevSep - 1)
ThisLineWidth = __UI_PrintWidth(LEFT$(TempLine$, PrevSep - 1))
IF LongestLine < ThisLineWidth THEN LongestLine = ThisLineWidth
TempLine$ = MID$(TempLine$, PrevSep + 1)
Lines = Lines + 1
EXIT DO
ELSE
IF LEN(Temp$) > 0 THEN Temp$ = Temp$ + CHR$(1)
Temp$ = Temp$ + Templine$
ThisLineWidth = __UI_PrintWidth(Templine$)
IF LongestLine < ThisLineWidth THEN LongestLine = ThisLineWidth
TempLine$ = ""
Lines = Lines + 1
EXIT DO
END IF
END IF
LOOP
END IF
LOOP
LOOP
__UI_WordWrap$ = Temp$
__UI_WordWrapHistoryResults(NextSlot) = Temp$
__UI_WordWrapHistory(NextSlot).TotalLines = Lines
__UI_WordWrapHistory(NextSlot).LongestLine = LongestLine
ELSE
'Count line breaks
Lines = 1
LongestLine = 0
Temp$ = TempCaption$
FindSep = INSTR(TempCaption$, CHR$(10))
IF FindSep > 0 THEN
Temp$ = ""
Lines = 0
DO WHILE LEN(TempCaption$)
FindSep = INSTR(TempCaption$, CHR$(10))
IF FindSep > 0 THEN
Lines = Lines + 1
IF LEN(Temp$) > 0 THEN Temp$ = Temp$ + CHR$(1)
Temp$ = Temp$ + LEFT$(TempCaption$, FindSep - 1)
ThisLineWidth = __UI_PrintWidth(LEFT$(TempCaption$, FindSep - 1))
IF LongestLine < ThisLineWidth THEN LongestLine = ThisLineWidth
TempCaption$ = MID$(TempCaption$, FindSep + 1)
ELSE
Lines = Lines + 1
Temp$ = Temp$ + CHR$(1) + TempCaption$
EXIT DO
END IF
LOOP
ELSE
LongestLine = __UI_PrintWidth(TempCaption$)
END IF
__UI_WordWrap$ = Temp$
__UI_WordWrapHistoryResults(NextSlot) = Temp$
__UI_WordWrapHistory(NextSlot).TotalLines = Lines
__UI_WordWrapHistory(NextSlot).LongestLine = LongestLine
END IF
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION __UI_MAP! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
__UI_MAP! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION
'---------------------------------------------------------------------------------
SUB __UI_ActivateDropdownlist (This AS __UI_ControlTYPE)
IF NOT This.Disabled THEN
__UI_ParentDropdownList = This.ID
__UI_ActiveDropdownList = __UI_NewControl(__UI_Type_ListBox, RTRIM$(This.Name) + CHR$(254) + "DropdownList", 0, 0, 0, 0, 0)
Text(__UI_ActiveDropdownList) = Text(This.ID)
Control(__UI_ActiveDropdownList).Left = This.Left + Control(This.ParentID).Left
Control(__UI_ActiveDropdownList).Width = This.Width
Control(__UI_ActiveDropdownList).Top = This.Top + This.Height + Control(This.ParentID).Top
'Make up to 14 items visible:
DIM MaxVisible AS INTEGER
IF This.Max > 14 THEN MaxVisible = 14 ELSE MaxVisible = This.Max
_FONT This.Font
Control(__UI_ActiveDropdownList).Height = (uspacing& + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset) + 3) * (MaxVisible + .5)
IF Control(__UI_ActiveDropdownList).Top + Control(__UI_ActiveDropdownList).Height > Control(__UI_FormID).Height THEN
Control(__UI_ActiveDropdownList).Top = Control(__UI_FormID).Height - Control(__UI_ActiveDropdownList).Height
END IF
Control(__UI_ActiveDropdownList).Max = This.Max
Control(__UI_ActiveDropdownList).Value = This.Value
Control(__UI_ActiveDropdownList).ForeColor = This.ForeColor
Control(__UI_ActiveDropdownList).BackColor = This.BackColor
Control(__UI_ActiveDropdownList).SelectedForeColor = This.SelectedForeColor
Control(__UI_ActiveDropdownList).SelectedBackColor = This.SelectedBackColor
Control(__UI_ActiveDropdownList).Font = This.Font
Control(__UI_ActiveDropdownList).HasBorder = True
Control(__UI_ActiveDropdownList).BorderSize = 1
Control(__UI_ActiveDropdownList).BorderColor = _RGB32(0, 0, 0)
Control(__UI_ActiveDropdownList).CanHaveFocus = True
Control(__UI_ActiveDropdownList).InputViewStart = 1
Control(__UI_ActiveDropdownList).LastVisibleItem = MaxVisible
__UI_Focus = __UI_ActiveDropdownList
'Adjust view:
IF Control(__UI_Focus).Value < Control(__UI_Focus).InputViewStart THEN
Control(__UI_Focus).InputViewStart = Control(__UI_Focus).Value
ELSEIF Control(__UI_Focus).Value > Control(__UI_Focus).InputViewStart + Control(__UI_Focus).LastVisibleItem - 1 THEN
Control(__UI_Focus).InputViewStart = Control(__UI_Focus).Value - Control(__UI_Focus).LastVisibleItem + 1
END IF
END IF
END SUB
'---------------------------------------------------------------------------------
SUB __UI_CloseAllMenus
DIM i AS LONG
FOR i = 1 TO UBOUND(Control)
IF Control(i).Type = __UI_Type_MenuPanel THEN
__UI_DestroyControl Control(i)
END IF
NEXT
END SUB
'---------------------------------------------------------------------------------
FUNCTION __UI_GetActiveMenuIndex(id AS LONG)
DIM i AS LONG
FOR i = 1 TO __UI_TotalActiveMenus
IF __UI_ActiveMenu(i) = id THEN
__UI_GetActiveMenuIndex = i
EXIT FUNCTION
END IF
NEXT
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION __UI_GetParentMenu(id AS LONG)
DIM i AS LONG
FOR i = 1 TO __UI_TotalActiveMenus
IF __UI_ActiveMenu(i) = id THEN
__UI_GetParentMenu = __UI_ParentMenu(i)
EXIT FUNCTION
END IF
NEXT
END FUNCTION
'---------------------------------------------------------------------------------
SUB __UI_ActivateMenu (This AS __UI_ControlTYPE, SelectFirstItem AS _BYTE)
DIM i AS LONG, ItemHeight AS SINGLE, TotalItems AS INTEGER
DIM CurrentGroup AS INTEGER, ComboSpacing AS INTEGER
IF NOT This.Disabled THEN
IF This.Type = __UI_Type_ContextMenu THEN __UI_CloseAllMenus: __UI_ForceRedraw = True
IF __UI_GetID(RTRIM$(This.Name) + CHR$(254) + "Panel") > 0 THEN
__UI_ActiveMenu(__UI_TotalActiveMenus) = __UI_GetID(RTRIM$(This.Name) + CHR$(254) + "Panel")
IF NOT __UI_DesignMode THEN EXIT SUB
ELSE
IF __UI_TotalActiveMenus + 1 > UBOUND(__UI_ActiveMenu) THEN
EXIT SUB
END IF
__UI_ActiveMenu(__UI_TotalActiveMenus + 1) = __UI_NewControl(__UI_Type_MenuPanel, RTRIM$(This.Name) + CHR$(254) + "Panel", 0, 0, 0, 0, 0)
__UI_TotalActiveMenus = __UI_TotalActiveMenus + 1
IF __UI_ActiveMenu(__UI_TotalActiveMenus) = 0 THEN
__UI_TotalActiveMenus = __UI_TotalActiveMenus - 1
EXIT SUB
END IF
END IF
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).SourceControl = This.ID
__UI_ParentMenu(__UI_TotalActiveMenus) = This.ID
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Font = This.Font
_FONT (This.Font)
IF This.Type = __UI_Type_MenuBar THEN
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Left = This.Left
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Top = _ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset) + 3
__UI_TopMenuBarItem = This.ID
ELSEIF This.Type = __UI_Type_MenuItem THEN
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Left = Control(This.MenuPanelID).Left + Control(This.MenuPanelID).Width - __UI_MenuItemOffset / 4
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Top = Control(This.MenuPanelID).Top + This.Top
ELSEIF This.Type = __UI_Type_ContextMenu THEN
IF __UI_DesignMode AND LEFT$(This.Name, 5) <> "__UI_" THEN
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Left = This.Left + This.Width
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Top = Control(__UI_FormID).Height
ELSE
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Left = __UI_MouseLeft
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Top = __UI_MouseTop
END IF
__UI_ActiveMenuIsContextMenu = True
END IF
'Calculate panel's width and position the menu items
ItemHeight = _ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset) + 3
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Height = (((_FONT = 8) * -1) * 3 + _ulinespacing) / 4
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Width = 0
CurrentGroup = 1
ComboSpacing = 0
FOR i = 1 TO UBOUND(Control)
IF Control(i).ParentID = This.ID AND NOT Control(i).Hidden THEN
TotalItems = TotalItems + 1
Control(i).Width = __UI_MenuItemOffset * 2 + __UI_PrintWidth(Caption(i))
IF Control(i).KeyCombo > 0 THEN
IF __UI_MenuItemOffset + __UI_PrintWidth(RTRIM$(__UI_KeyCombo(Control(i).KeyCombo).FriendlyCombo)) > ComboSpacing THEN
ComboSpacing = __UI_MenuItemOffset + __UI_PrintWidth(RTRIM$(__UI_KeyCombo(Control(i).KeyCombo).FriendlyCombo))
END IF
END IF
IF Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Width < Control(i).Width THEN
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Width = Control(i).Width
END IF
'Reposition menu items:
Control(i).Top = Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Height
Control(i).Height = ItemHeight
'Link menu item to this panel
Control(i).MenuPanelID = Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).ID
'Grow the panel:
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Height = Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Height + ItemHeight
'Assign MenuItemGroup to properly handle Bullet items
Control(i).MenuItemGroup = CurrentGroup
IF RIGHT$(Caption(i), 1) = "-" THEN 'Separator
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Height = Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Height + ItemHeight / 3
CurrentGroup = CurrentGroup + 1
END IF
END IF
NEXT
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Height = Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Height + (((((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset) + _ulinespacing) / 4)
IF Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Width = 0 THEN Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Width = Control(__UI_FormID).Width / 4
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Width = Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Width + ComboSpacing
IF __UI_DesignMode AND LEFT$(This.Name, 5) <> "__UI_" THEN Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Height = Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Height + ItemHeight
IF Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Left + Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Width > Control(__UI_FormID).Width THEN
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Left = Control(__UI_FormID).Width - Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Width - 5
IF This.Type = __UI_Type_MenuItem THEN
'Sub-menus must not overlap their parent menu panel
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Left = Control(This.MenuPanelID).Left - Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Width + __UI_MenuItemOffset / 4
END IF
END IF
IF Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Top + Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Height > Control(__UI_FormID).Height THEN
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Top = Control(__UI_FormID).Height - Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Height - 5
IF __UI_DesignMode AND LEFT$(This.Name, 5) <> "__UI_" THEN Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Top = Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Top - This.Height
END IF
IF SelectFirstItem AND NOT __UI_DesignMode AND TotalItems > 0 THEN
__UI_Focus = __UI_NextMenuItem(0)
ELSE
IF TotalItems = 0 THEN
Control(__UI_ActiveMenu(__UI_TotalActiveMenus)).Width = __UI_MenuItemOffset * 2 + __UI_PrintWidth("Add new")
END IF
__UI_Focus = __UI_ActiveMenu(__UI_TotalActiveMenus)
END IF
END IF
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DoEvents
__UI_ProcessInput
IF __UI_HasInput THEN
__UI_EventDispatcher
END IF
END SUB
'---------------------------------------------------------------------------------
FUNCTION __UI_TrimAt0$(Text$)
IF INSTR(Text$, CHR$(0)) > 0 THEN
__UI_TrimAt0$ = LEFT$(Text$, INSTR(Text$, CHR$(0)) - 1)
ELSE
__UI_TrimAt0$ = Text$
END IF
END FUNCTION
'---------------------------------------------------------------------------------
SUB __UI_MakeHardwareImageFromCanvas (This AS __UI_ControlTYPE)
DIM TempCanvas AS LONG
IF This.ID = 0 OR This.Canvas = 0 OR __UI_DesignMode = True THEN EXIT SUB
'Convert to hardware images only those that aren't contained in a frame
IF This.ParentID = 0 THEN
TempCanvas = _COPYIMAGE(This.Canvas, 33)
IF This.Canvas <> 0 THEN _FREEIMAGE This.Canvas
This.Canvas = TempCanvas
END IF
END SUB
'---------------------------------------------------------------------------------
SUB __UI_MakeHardwareImage (This AS LONG)
DIM TempCanvas AS LONG
IF __UI_DesignMode = True THEN EXIT SUB
TempCanvas = _COPYIMAGE(This, 33)
_FREEIMAGE This
This = TempCanvas
END SUB
'---------------------------------------------------------------------------------
FUNCTION __UI_FirstMenuBarControl
DIM i AS LONG
FOR i = 1 TO UBOUND(Control)
IF Control(i).ID > 0 AND Control(i).Type = __UI_Type_MenuBar AND NOT Control(i).Hidden THEN
__UI_FirstMenuBarControl = i
EXIT FUNCTION
END IF
NEXT
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION __UI_NextMenuBarControl (CurrentMenuBarControl)
DIM i AS LONG
i = CurrentMenuBarControl
DO
i = i + 1
IF i > UBOUND(Control) THEN i = 1
IF i = CurrentMenuBarControl THEN EXIT DO
IF Control(i).Type = __UI_Type_MenuBar AND NOT Control(i).Hidden AND NOT Control(i).Disabled THEN
EXIT DO
END IF
LOOP
__UI_NextMenuBarControl = i
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION __UI_PreviousMenuBarControl (CurrentMenuBarControl)
DIM i AS LONG
i = CurrentMenuBarControl
DO
i = i - 1
IF i < 1 THEN i = UBOUND(Control)
IF i = CurrentMenuBarControl THEN EXIT DO
IF Control(i).Type = __UI_Type_MenuBar AND NOT Control(i).Hidden AND NOT Control(i).Disabled THEN
EXIT DO
END IF
LOOP
__UI_PreviousMenuBarControl = i
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION __UI_NextMenuItem (CurrentMenuItemControl)
DIM i AS LONG
i = CurrentMenuItemControl
DO
i = i + 1
IF i > UBOUND(Control) THEN i = 1
IF i = CurrentMenuItemControl THEN EXIT DO
IF Control(i).Type = __UI_Type_MenuItem AND NOT Control(i).Hidden AND Control(i).ParentID = __UI_ParentMenu(__UI_TotalActiveMenus) THEN
EXIT DO
END IF
LOOP
__UI_NextMenuItem = i
END FUNCTION
'---------------------------------------------------------------------------------
FUNCTION __UI_PreviousMenuItem (CurrentMenuItemControl)
DIM i AS LONG
i = CurrentMenuItemControl
DO
i = i - 1
IF i < 1 THEN i = UBOUND(Control)
IF i = CurrentMenuItemControl THEN EXIT DO
IF Control(i).Type = __UI_Type_MenuItem AND NOT Control(i).Hidden AND Control(i).ParentID = __UI_ParentMenu(__UI_TotalActiveMenus) THEN
EXIT DO
END IF
LOOP
__UI_PreviousMenuItem = i
END FUNCTION
'---------------------------------------------------------------------------------
SUB __UI_RefreshMenuBar
'Calculate menu items' .Left and .Width
DIM LeftOffset AS INTEGER, i AS LONG
DIM TotalItems AS INTEGER, LastMenuItem AS LONG
_FONT (Control(__UI_FormID).Font)
FOR i = 1 TO UBOUND(Control)
IF Control(i).ID > 0 THEN
IF Control(i).Type = __UI_Type_MenuBar AND NOT Control(i).Hidden THEN
TotalItems = TotalItems + 1
IF TotalItems = 1 THEN
LeftOffset = __UI_MenuBarOffset
ELSE
LeftOffset = LeftOffset + Control(LastMenuItem).Width
END IF
Control(i).Width = __UI_MenuBarOffset + __UI_PrintWidth(Caption(i)) + __UI_MenuBarOffset
IF Control(i).Align = __UI_Left THEN
Control(i).Left = LeftOffset
ELSE
Control(i).Left = Control(__UI_FormID).Width - 1 - __UI_MenuBarOffset - Control(i).Width
END IF
LastMenuItem = i
__UI_NewMenuBarTextLeft = Control(i).Left + Control(i).Width
END IF
END IF
NEXT
END SUB
'---------------------------------------------------------------------------------
'UTF conversion functions courtesy of Luke Ceddia.
'http://www.qb64.net/forum/index.php?topic=13981.msg121324#msg121324
FUNCTION FromCP437$ (source$)
STATIC init&
IF init& = 0 THEN
DIM i&
FOR i& = 0 TO 127
table437$(i&) = CHR$(i&)
NEXT i&
table437$(7) = CHR$(226) + CHR$(151) + CHR$(143) 'UTF-8 e2978f
table437$(128) = CHR$(&HE2) + CHR$(&H82) + CHR$(&HAC)
table437$(128) = CHR$(&HC3) + CHR$(&H87)
table437$(129) = CHR$(&HC3) + CHR$(&HBC)
table437$(130) = CHR$(&HC3) + CHR$(&HA9)
table437$(131) = CHR$(&HC3) + CHR$(&HA2)
table437$(132) = CHR$(&HC3) + CHR$(&HA4)
table437$(133) = CHR$(&HC3) + CHR$(&HA0)
table437$(134) = CHR$(&HC3) + CHR$(&HA5)
table437$(135) = CHR$(&HC3) + CHR$(&HA7)
table437$(136) = CHR$(&HC3) + CHR$(&HAA)
table437$(137) = CHR$(&HC3) + CHR$(&HAB)
table437$(138) = CHR$(&HC3) + CHR$(&HA8)
table437$(139) = CHR$(&HC3) + CHR$(&HAF)
table437$(140) = CHR$(&HC3) + CHR$(&HAE)
table437$(141) = CHR$(&HC3) + CHR$(&HAC)
table437$(142) = CHR$(&HC3) + CHR$(&H84)
table437$(143) = CHR$(&HC3) + CHR$(&H85)
table437$(144) = CHR$(&HC3) + CHR$(&H89)
table437$(145) = CHR$(&HC3) + CHR$(&HA6)
table437$(146) = CHR$(&HC3) + CHR$(&H86)
table437$(147) = CHR$(&HC3) + CHR$(&HB4)
table437$(148) = CHR$(&HC3) + CHR$(&HB6)
table437$(149) = CHR$(&HC3) + CHR$(&HB2)
table437$(150) = CHR$(&HC3) + CHR$(&HBB)
table437$(151) = CHR$(&HC3) + CHR$(&HB9)
table437$(152) = CHR$(&HC3) + CHR$(&HBF)
table437$(153) = CHR$(&HC3) + CHR$(&H96)
table437$(154) = CHR$(&HC3) + CHR$(&H9C)
table437$(155) = CHR$(&HC2) + CHR$(&HA2)
table437$(156) = CHR$(&HC2) + CHR$(&HA3)
table437$(157) = CHR$(&HC2) + CHR$(&HA5)
table437$(158) = CHR$(&HE2) + CHR$(&H82) + CHR$(&HA7)
table437$(159) = CHR$(&HC6) + CHR$(&H92)
table437$(160) = CHR$(&HC3) + CHR$(&HA1)
table437$(161) = CHR$(&HC3) + CHR$(&HAD)
table437$(162) = CHR$(&HC3) + CHR$(&HB3)
table437$(163) = CHR$(&HC3) + CHR$(&HBA)
table437$(164) = CHR$(&HC3) + CHR$(&HB1)
table437$(165) = CHR$(&HC3) + CHR$(&H91)
table437$(166) = CHR$(&HC2) + CHR$(&HAA)
table437$(167) = CHR$(&HC2) + CHR$(&HBA)
table437$(168) = CHR$(&HC2) + CHR$(&HBF)
table437$(169) = CHR$(&HE2) + CHR$(&H8C) + CHR$(&H90)
table437$(170) = CHR$(&HC2) + CHR$(&HAC)
table437$(171) = CHR$(&HC2) + CHR$(&HBD)
table437$(172) = CHR$(&HC2) + CHR$(&HBC)
table437$(173) = CHR$(&HC2) + CHR$(&HA1)
table437$(174) = CHR$(&HC2) + CHR$(&HAB)
table437$(175) = CHR$(&HC2) + CHR$(&HBB)
table437$(176) = CHR$(&HE2) + CHR$(&H96) + CHR$(&H91)
table437$(177) = CHR$(&HE2) + CHR$(&H96) + CHR$(&H92)
table437$(178) = CHR$(&HE2) + CHR$(&H96) + CHR$(&H93)
table437$(179) = CHR$(&HE2) + CHR$(&H94) + CHR$(&H82)
table437$(180) = CHR$(&HE2) + CHR$(&H94) + CHR$(&HA4)
table437$(181) = CHR$(&HE2) + CHR$(&H95) + CHR$(&HA1)
table437$(182) = CHR$(&HE2) + CHR$(&H95) + CHR$(&HA2)
table437$(183) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H96)
table437$(184) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H95)
table437$(185) = CHR$(&HE2) + CHR$(&H95) + CHR$(&HA3)
table437$(186) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H91)
table437$(187) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H97)
table437$(188) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H9D)
table437$(189) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H9C)
table437$(190) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H9B)
table437$(191) = CHR$(&HE2) + CHR$(&H94) + CHR$(&H90)
table437$(192) = CHR$(&HE2) + CHR$(&H94) + CHR$(&H94)
table437$(193) = CHR$(&HE2) + CHR$(&H94) + CHR$(&HB4)
table437$(194) = CHR$(&HE2) + CHR$(&H94) + CHR$(&HAC)
table437$(195) = CHR$(&HE2) + CHR$(&H94) + CHR$(&H9C)
table437$(196) = CHR$(&HE2) + CHR$(&H94) + CHR$(&H80)
table437$(197) = CHR$(&HE2) + CHR$(&H94) + CHR$(&HBC)
table437$(198) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H9E)
table437$(199) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H9F)
table437$(200) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H9A)
table437$(201) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H94)
table437$(202) = CHR$(&HE2) + CHR$(&H95) + CHR$(&HA9)
table437$(203) = CHR$(&HE2) + CHR$(&H95) + CHR$(&HA6)
table437$(204) = CHR$(&HE2) + CHR$(&H95) + CHR$(&HA0)
table437$(205) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H90)
table437$(206) = CHR$(&HE2) + CHR$(&H95) + CHR$(&HAC)
table437$(207) = CHR$(&HE2) + CHR$(&H95) + CHR$(&HA7)
table437$(208) = CHR$(&HE2) + CHR$(&H95) + CHR$(&HA8)
table437$(209) = CHR$(&HE2) + CHR$(&H95) + CHR$(&HA4)
table437$(210) = CHR$(&HE2) + CHR$(&H95) + CHR$(&HA5)
table437$(211) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H99)
table437$(212) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H98)
table437$(213) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H92)
table437$(214) = CHR$(&HE2) + CHR$(&H95) + CHR$(&H93)
table437$(215) = CHR$(&HE2) + CHR$(&H95) + CHR$(&HAB)
table437$(216) = CHR$(&HE2) + CHR$(&H95) + CHR$(&HAA)
table437$(217) = CHR$(&HE2) + CHR$(&H94) + CHR$(&H98)
table437$(218) = CHR$(&HE2) + CHR$(&H94) + CHR$(&H8C)
table437$(219) = CHR$(&HE2) + CHR$(&H96) + CHR$(&H88)
table437$(220) = CHR$(&HE2) + CHR$(&H96) + CHR$(&H84)
table437$(221) = CHR$(&HE2) + CHR$(&H96) + CHR$(&H8C)
table437$(222) = CHR$(&HE2) + CHR$(&H96) + CHR$(&H90)
table437$(223) = CHR$(&HE2) + CHR$(&H96) + CHR$(&H80)
table437$(224) = CHR$(&HCE) + CHR$(&HB1)
table437$(225) = CHR$(&HC3) + CHR$(&H9F)
table437$(226) = CHR$(&HCE) + CHR$(&H93)
table437$(227) = CHR$(&HCF) + CHR$(&H80)
table437$(228) = CHR$(&HCE) + CHR$(&HA3)
table437$(229) = CHR$(&HCF) + CHR$(&H83)
table437$(230) = CHR$(&HC2) + CHR$(&HB5)
table437$(231) = CHR$(&HCF) + CHR$(&H84)
table437$(232) = CHR$(&HCE) + CHR$(&HA6)
table437$(233) = CHR$(&HCE) + CHR$(&H98)
table437$(234) = CHR$(&HCE) + CHR$(&HA9)
table437$(235) = CHR$(&HCE) + CHR$(&HB4)
table437$(236) = CHR$(&HE2) + CHR$(&H88) + CHR$(&H9E)
table437$(237) = CHR$(&HCF) + CHR$(&H86)
table437$(238) = CHR$(&HCE) + CHR$(&HB5)
table437$(239) = CHR$(&HE2) + CHR$(&H88) + CHR$(&HA9)
table437$(240) = CHR$(&HE2) + CHR$(&H89) + CHR$(&HA1)
table437$(241) = CHR$(&HC2) + CHR$(&HB1)
table437$(242) = CHR$(&HE2) + CHR$(&H89) + CHR$(&HA5)
table437$(243) = CHR$(&HE2) + CHR$(&H89) + CHR$(&HA4)
table437$(244) = CHR$(&HE2) + CHR$(&H8C) + CHR$(&HA0)
table437$(245) = CHR$(&HE2) + CHR$(&H8C) + CHR$(&HA1)
table437$(246) = CHR$(&HC3) + CHR$(&HB7)
table437$(247) = CHR$(&HE2) + CHR$(&H89) + CHR$(&H88)
table437$(248) = CHR$(&HC2) + CHR$(&HB0)
table437$(249) = CHR$(&HE2) + CHR$(&H88) + CHR$(&H99)
table437$(250) = CHR$(&HC2) + CHR$(&HB7)
table437$(251) = CHR$(&HE2) + CHR$(&H88) + CHR$(&H9A)
table437$(252) = CHR$(&HE2) + CHR$(&H81) + CHR$(&HBF)
table437$(253) = CHR$(&HC2) + CHR$(&HB2)
table437$(254) = CHR$(&HE2) + CHR$(&H96) + CHR$(&HA0)
table437$(255) = CHR$(&HC2) + CHR$(&HA0)
init& = -1
END IF
FromCP437$ = UTF8$(source$, table437$())
END FUNCTION
FUNCTION FromCP1252$ (source$)
STATIC init&
IF init& = 0 THEN
DIM i&
FOR i& = 0 TO 127
table1252$(i&) = CHR$(i&)
NEXT i&
table1252$(7) = CHR$(226) + CHR$(151) + CHR$(143) 'UTF-8 e2978f
table1252$(128) = CHR$(&HE2) + CHR$(&H82) + CHR$(&HAC)
table1252$(130) = CHR$(&HE2) + CHR$(&H80) + CHR$(&H9A)
table1252$(131) = CHR$(&HC6) + CHR$(&H92)
table1252$(132) = CHR$(&HE2) + CHR$(&H80) + CHR$(&H9E)
table1252$(133) = CHR$(&HE2) + CHR$(&H80) + CHR$(&HA6)
table1252$(134) = CHR$(&HE2) + CHR$(&H80) + CHR$(&HA0)
table1252$(135) = CHR$(&HE2) + CHR$(&H80) + CHR$(&HA1)
table1252$(136) = CHR$(&HCB) + CHR$(&H86)
table1252$(137) = CHR$(&HE2) + CHR$(&H80) + CHR$(&HB0)
table1252$(138) = CHR$(&HC5) + CHR$(&HA0)
table1252$(139) = CHR$(&HE2) + CHR$(&H80) + CHR$(&HB9)
table1252$(140) = CHR$(&HC5) + CHR$(&H92)
table1252$(142) = CHR$(&HC5) + CHR$(&HBD)
table1252$(145) = CHR$(&HE2) + CHR$(&H80) + CHR$(&H98)
table1252$(146) = CHR$(&HE2) + CHR$(&H80) + CHR$(&H99)
table1252$(147) = CHR$(&HE2) + CHR$(&H80) + CHR$(&H9C)
table1252$(148) = CHR$(&HE2) + CHR$(&H80) + CHR$(&H9D)
table1252$(149) = CHR$(&HE2) + CHR$(&H80) + CHR$(&HA2)
table1252$(150) = CHR$(&HE2) + CHR$(&H80) + CHR$(&H93)
table1252$(151) = CHR$(&HE2) + CHR$(&H80) + CHR$(&H94)
table1252$(152) = CHR$(&HCB) + CHR$(&H9C)
table1252$(153) = CHR$(&HE2) + CHR$(&H84) + CHR$(&HA2)
table1252$(154) = CHR$(&HC5) + CHR$(&HA1)
table1252$(155) = CHR$(&HE2) + CHR$(&H80) + CHR$(&HBA)
table1252$(156) = CHR$(&HC5) + CHR$(&H93)
table1252$(158) = CHR$(&HC5) + CHR$(&HBE)
table1252$(159) = CHR$(&HC5) + CHR$(&HB8)
table1252$(160) = CHR$(&HC2) + CHR$(&HA0)
table1252$(161) = CHR$(&HC2) + CHR$(&HA1)
table1252$(162) = CHR$(&HC2) + CHR$(&HA2)
table1252$(163) = CHR$(&HC2) + CHR$(&HA3)
table1252$(164) = CHR$(&HC2) + CHR$(&HA4)
table1252$(165) = CHR$(&HC2) + CHR$(&HA5)
table1252$(166) = CHR$(&HC2) + CHR$(&HA6)
table1252$(167) = CHR$(&HC2) + CHR$(&HA7)
table1252$(168) = CHR$(&HC2) + CHR$(&HA8)
table1252$(169) = CHR$(&HC2) + CHR$(&HA9)
table1252$(170) = CHR$(&HC2) + CHR$(&HAA)
table1252$(171) = CHR$(&HC2) + CHR$(&HAB)
table1252$(172) = CHR$(&HC2) + CHR$(&HAC)
table1252$(173) = CHR$(&HC2) + CHR$(&HAD)
table1252$(174) = CHR$(&HC2) + CHR$(&HAE)
table1252$(175) = CHR$(&HC2) + CHR$(&HAF)
table1252$(176) = CHR$(&HC2) + CHR$(&HB0)
table1252$(177) = CHR$(&HC2) + CHR$(&HB1)
table1252$(178) = CHR$(&HC2) + CHR$(&HB2)
table1252$(179) = CHR$(&HC2) + CHR$(&HB3)
table1252$(180) = CHR$(&HC2) + CHR$(&HB4)
table1252$(181) = CHR$(&HC2) + CHR$(&HB5)
table1252$(182) = CHR$(&HC2) + CHR$(&HB6)
table1252$(183) = CHR$(&HC2) + CHR$(&HB7)
table1252$(184) = CHR$(&HC2) + CHR$(&HB8)
table1252$(185) = CHR$(&HC2) + CHR$(&HB9)
table1252$(186) = CHR$(&HC2) + CHR$(&HBA)
table1252$(187) = CHR$(&HC2) + CHR$(&HBB)
table1252$(188) = CHR$(&HC2) + CHR$(&HBC)
table1252$(189) = CHR$(&HC2) + CHR$(&HBD)
table1252$(190) = CHR$(&HC2) + CHR$(&HBE)
table1252$(191) = CHR$(&HC2) + CHR$(&HBF)
table1252$(192) = CHR$(&HC3) + CHR$(&H80)
table1252$(193) = CHR$(&HC3) + CHR$(&H81)
table1252$(194) = CHR$(&HC3) + CHR$(&H82)
table1252$(195) = CHR$(&HC3) + CHR$(&H83)
table1252$(196) = CHR$(&HC3) + CHR$(&H84)
table1252$(197) = CHR$(&HC3) + CHR$(&H85)
table1252$(198) = CHR$(&HC3) + CHR$(&H86)
table1252$(199) = CHR$(&HC3) + CHR$(&H87)
table1252$(200) = CHR$(&HC3) + CHR$(&H88)
table1252$(201) = CHR$(&HC3) + CHR$(&H89)
table1252$(202) = CHR$(&HC3) + CHR$(&H8A)
table1252$(203) = CHR$(&HC3) + CHR$(&H8B)
table1252$(204) = CHR$(&HC3) + CHR$(&H8C)
table1252$(205) = CHR$(&HC3) + CHR$(&H8D)
table1252$(206) = CHR$(&HC3) + CHR$(&H8E)
table1252$(207) = CHR$(&HC3) + CHR$(&H8F)
table1252$(208) = CHR$(&HC3) + CHR$(&H90)
table1252$(209) = CHR$(&HC3) + CHR$(&H91)
table1252$(210) = CHR$(&HC3) + CHR$(&H92)
table1252$(211) = CHR$(&HC3) + CHR$(&H93)
table1252$(212) = CHR$(&HC3) + CHR$(&H94)
table1252$(213) = CHR$(&HC3) + CHR$(&H95)
table1252$(214) = CHR$(&HC3) + CHR$(&H96)
table1252$(215) = CHR$(&HC3) + CHR$(&H97)
table1252$(216) = CHR$(&HC3) + CHR$(&H98)
table1252$(217) = CHR$(&HC3) + CHR$(&H99)
table1252$(218) = CHR$(&HC3) + CHR$(&H9A)
table1252$(219) = CHR$(&HC3) + CHR$(&H9B)
table1252$(220) = CHR$(&HC3) + CHR$(&H9C)
table1252$(221) = CHR$(&HC3) + CHR$(&H9D)
table1252$(222) = CHR$(&HC3) + CHR$(&H9E)
table1252$(223) = CHR$(&HC3) + CHR$(&H9F)
table1252$(224) = CHR$(&HC3) + CHR$(&HA0)
table1252$(225) = CHR$(&HC3) + CHR$(&HA1)
table1252$(226) = CHR$(&HC3) + CHR$(&HA2)
table1252$(227) = CHR$(&HC3) + CHR$(&HA3)
table1252$(228) = CHR$(&HC3) + CHR$(&HA4)
table1252$(229) = CHR$(&HC3) + CHR$(&HA5)
table1252$(230) = CHR$(&HC3) + CHR$(&HA6)
table1252$(231) = CHR$(&HC3) + CHR$(&HA7)
table1252$(232) = CHR$(&HC3) + CHR$(&HA8)
table1252$(233) = CHR$(&HC3) + CHR$(&HA9)
table1252$(234) = CHR$(&HC3) + CHR$(&HAA)
table1252$(235) = CHR$(&HC3) + CHR$(&HAB)
table1252$(236) = CHR$(&HC3) + CHR$(&HAC)
table1252$(237) = CHR$(&HC3) + CHR$(&HAD)
table1252$(238) = CHR$(&HC3) + CHR$(&HAE)
table1252$(239) = CHR$(&HC3) + CHR$(&HAF)
table1252$(240) = CHR$(&HC3) + CHR$(&HB0)
table1252$(241) = CHR$(&HC3) + CHR$(&HB1)
table1252$(242) = CHR$(&HC3) + CHR$(&HB2)
table1252$(243) = CHR$(&HC3) + CHR$(&HB3)
table1252$(244) = CHR$(&HC3) + CHR$(&HB4)
table1252$(245) = CHR$(&HC3) + CHR$(&HB5)
table1252$(246) = CHR$(&HC3) + CHR$(&HB6)
table1252$(247) = CHR$(&HC3) + CHR$(&HB7)
table1252$(248) = CHR$(&HC3) + CHR$(&HB8)
table1252$(249) = CHR$(&HC3) + CHR$(&HB9)
table1252$(250) = CHR$(&HC3) + CHR$(&HBA)
table1252$(251) = CHR$(&HC3) + CHR$(&HBB)
table1252$(252) = CHR$(&HC3) + CHR$(&HBC)
table1252$(253) = CHR$(&HC3) + CHR$(&HBD)
table1252$(254) = CHR$(&HC3) + CHR$(&HBE)
table1252$(255) = CHR$(&HC3) + CHR$(&HBF)
init& = -1
END IF
FromCP1252$ = UTF8$(source$, table1252$())
END FUNCTION
FUNCTION UTF8$ (source$, table$())
DIM i AS LONG, dest$
FOR i = 1 TO LEN(source$)
dest$ = dest$ + table$(ASC(source$, i))
NEXT i
UTF8$ = dest$
END FUNCTION
FUNCTION GetControlDrawOrder&(ctrlRef AS LONG)
DIM i AS LONG
FOR i& = 1 to UBOUND(ControlDrawOrder)
IF ControlDrawOrder(i&) = ctrlRef THEN GetControlDrawOrder& = i&: EXIT FUNCTION
NEXT i&
END FUNCTION
SUB __UI_ExpandControlDrawOrder (size&)
REDIM _PRESERVE ControlDrawOrder(0 TO UBOUND(ControlDrawOrder) + size&) AS LONG
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
FUNCTION RestoreCHR$ (__Text$)
DIM Text$, BackSlash AS LONG, SemiColon AS LONG
DIM j AS LONG, tempNum$
Text$ = __Text$
IF INSTR(Text$, "\") = 0 THEN
RestoreCHR$ = Text$
EXIT FUNCTION
END IF
DO
BackSlash = INSTR(BackSlash + 1, Text$, "\")
IF BackSlash = 0 THEN EXIT DO
SemiColon = INSTR(BackSlash + 1, Text$, ";")
IF SemiColon = 0 THEN _CONTINUE
IF MID$(Text$, BackSlash + 1, 1) = "\" THEN
'Skip this code as the backslash is doubled \\
Text$ = LEFT$(Text$, BackSlash) + MID$(Text$, BackSlash + 2)
_CONTINUE
END IF
tempNum$ = ""
FOR j = BackSlash + 1 TO SemiColon - 1
IF ASC(Text$, j) < 48 OR ASC(Text$, j) > 57 THEN tempNum$ = "": EXIT FOR
tempNum$ = tempNum$ + MID$(Text$, j, 1)
NEXT
IF LEN(tempNum$) THEN
Text$ = LEFT$(Text$, BackSlash - 1) + CHR$(VAL(tempNum$)) + MID$(Text$, SemiColon + 1)
END IF
LOOP
RestoreCHR$ = Text$
END FUNCTION
FUNCTION __UI_StrUsing$ (format$, value##)
DIM prevDest AS LONG, prevSource AS LONG
DIM tempScreen AS LONG
DIM i AS LONG, temp$
DIM length AS LONG
prevDest = _DEST
prevSource = _SOURCE
tempScreen = _NEWIMAGE(LEN(format$) * 2, 2, 0)
_DEST tempScreen
_SOURCE tempScreen
PRINT USING format$; value##;
length = POS(0) - 1
temp$ = SPACE$(length)
FOR i = 1 TO length
ASC(temp$, i) = SCREEN(1, i)
NEXT
_DEST prevDest
_SOURCE prevSource
_FREEIMAGE tempScreen
__UI_StrUsing$ = temp$
END FUNCTION
SUB __UI_Bind(id AS LONG, targetID AS LONG, __PropertyID$, __PropertyTargetID$)
DIM PropertyID$, PropertyTargetID$
PropertyID$ = UCASE$(__PropertyID$)
PropertyTargetID$ = UCASE$(__PropertyTargetID$)
'Clear eventual previous bindings
IF Control(id).BoundTo > 0 THEN
Control(Control(id).BoundTo).BoundTo = 0
END IF
IF Control(targetID).BoundTo > 0 THEN
Control(Control(targetID).BoundTo).BoundTo = 0
END IF
Control(id).BoundTo = targetID
Control(id).BoundProperty = __UI_PropertyEnum(PropertyID$, 0)
IF Control(id).BoundProperty = 0 THEN Control(id).BoundTo = 0: EXIT SUB
Control(targetID).BoundTo = id
Control(targetID).BoundProperty = __UI_PropertyEnum(PropertyTargetID$, 0)
IF Control(targetID).BoundProperty = 0 THEN
Control(id).BoundTo = 0
Control(targetID).BoundTo = 0
END IF
__UI_CheckBinding targetID 'acquire current value of targetID
END SUB
FUNCTION __UI_PropertyEnum& (__property$, index AS LONG)
'If __property$ is passed:
' - __UI_PropertyEnum& returns the index/hash value;
'If index is passed:
' - __property$ returns the property name found and
' - __UI_PropertyEnum& returns True (-1)
DIM property$, NextAt AS LONG
STATIC EnumInitialized AS _BYTE, Enum$
IF LEN(_TRIM$(__property$)) = 0 AND index = 0 THEN EXIT FUNCTION
IF NOT EnumInitialized THEN
RESTORE EnumNames
DO
READ property$
IF property$ = "*" THEN EXIT DO
Enum$ = Enum$ + "@" + property$
LOOP
Enum$ = Enum$ + "@"
EnumInitialized = True
END IF
IF index > 0 THEN
'return property name
IF index > LEN(Enum$) THEN EXIT FUNCTION
IF ASC(Enum$, index) <> 64 THEN EXIT FUNCTION
NextAt = INSTR(index + 1, Enum$, "@")
__property$ = MID$(Enum$, index + 1, NextAt - index - 1)
__UI_PropertyEnum& = -1
ELSE
'return index
property$ = "@" + _TRIM$(UCASE$(__property$)) + "@"
__UI_PropertyEnum& = INSTR(UCASE$(Enum$), property$)
END IF
EXIT FUNCTION
EnumNames:
DATA Top,Left,Width,Height,Bordersize,Padding,Value
DATA Min,Max,Interval,MinInterval,Stretch,HasBorder,ShowPercentage
DATA AutoScroll,AutoSize,PasswordMask,Disabled,Hidden
DATA *
END FUNCTION
SUB __UI_UnBind(id AS LONG)
IF Control(id).BoundTo > 0 THEN
Control(Control(id).BoundTo).Redraw = True
Control(Control(id).BoundTo).BoundTo = 0
Control(id).BoundTo = 0
Control(id).Redraw = True
END IF
END SUB
SUB __UI_CheckBinding(id AS LONG)
DIM BindTarget AS LONG, Temp AS _FLOAT
BindTarget = Control(id).BoundTo
IF BindTarget = 0 THEN EXIT SUB
'IF Control(id).BoundProperty = Control(BindTarget).BoundProperty AND _
' Control(id).BoundProperty = __UI_PropertyEnum&("Value", 0) THEN
' Control(id).Min = Control(BindTarget).Min
' Control(id).Max = Control(BindTarget).Max
'END IF
SELECT CASE Control(id).BoundProperty
CASE __UI_PropertyEnum&("Top", 0)
Temp = Control(id).Top
CASE __UI_PropertyEnum&("Left", 0)
Temp = Control(id).Left
CASE __UI_PropertyEnum&("Width", 0)
Temp = Control(id).Width
CASE __UI_PropertyEnum&("Height", 0)
Temp = Control(id).Height
CASE __UI_PropertyEnum&("BorderSize", 0)
Temp = Control(id).BorderSize
CASE __UI_PropertyEnum&("Padding", 0)
Temp = Control(id).Padding
CASE __UI_PropertyEnum&("Value", 0)
Temp = Control(id).Value
CASE __UI_PropertyEnum&("Min", 0)
Temp = Control(id).Min
CASE __UI_PropertyEnum&("Max", 0)
Temp = Control(id).Max
CASE __UI_PropertyEnum&("Interval", 0)
Temp = Control(id).Interval
CASE __UI_PropertyEnum&("Mininterval", 0)
Temp = Control(id).Mininterval
CASE __UI_PropertyEnum&("Stretch", 0)
Temp = Control(id).Stretch
CASE __UI_PropertyEnum&("HasBorder", 0)
Temp = Control(id).HasBorder
CASE __UI_PropertyEnum&("ShowPercentage", 0)
Temp = Control(id).ShowPercentage
CASE __UI_PropertyEnum&("AutoScroll", 0)
Temp = Control(id).AutoScroll
CASE __UI_PropertyEnum&("AutoSize", 0)
Temp = Control(id).AutoSize
CASE __UI_PropertyEnum&("PasswordField", 0)
Temp = Control(id).PasswordField
CASE __UI_PropertyEnum&("Disabled", 0)
Temp = Control(id).Disabled
CASE __UI_PropertyEnum&("Hidden", 0)
Temp = Control(id).Hidden
END SELECT
SELECT CASE Control(BindTarget).BoundProperty
CASE __UI_PropertyEnum&("Top", 0)
Control(BindTarget).Top = Temp
CASE __UI_PropertyEnum&("Left", 0)
Control(BindTarget).Left = Temp
CASE __UI_PropertyEnum&("Width", 0)
Control(BindTarget).Width = Temp
CASE __UI_PropertyEnum&("Height", 0)
Control(BindTarget).Height = Temp
CASE __UI_PropertyEnum&("BorderSize", 0)
Control(BindTarget).BorderSize = Temp
CASE __UI_PropertyEnum&("Padding", 0)
Control(BindTarget).Padding = Temp
CASE __UI_PropertyEnum&("Value", 0)
Control(BindTarget).Value = Temp
CASE __UI_PropertyEnum&("Min", 0)
Control(BindTarget).Min = Temp
CASE __UI_PropertyEnum&("Max", 0)
Control(BindTarget).Max = Temp
CASE __UI_PropertyEnum&("Interval", 0)
Control(BindTarget).Interval = Temp
CASE __UI_PropertyEnum&("MinInterval", 0)
Control(BindTarget).MinInterval = Temp
CASE __UI_PropertyEnum&("Stretch", 0)
Control(BindTarget).Stretch = Temp
CASE __UI_PropertyEnum&("HasBorder", 0)
Control(BindTarget).HasBorder = Temp
CASE __UI_PropertyEnum&("ShowPercentage", 0)
Control(BindTarget).ShowPercentage = Temp
CASE __UI_PropertyEnum&("AutoScroll", 0)
Control(BindTarget).AutoScroll = Temp
CASE __UI_PropertyEnum&("AutoSize", 0)
Control(BindTarget).AutoSize = Temp
CASE __UI_PropertyEnum&("PasswordField", 0)
Control(BindTarget).PasswordField = Temp
CASE __UI_PropertyEnum&("Disabled", 0)
Control(BindTarget).Disabled = Temp
CASE __UI_PropertyEnum&("Hidden", 0)
Control(BindTarget).Hidden = Temp
END SELECT
Control(id).Redraw = True
Control(BindTarget).Redraw = True
END SUB
'Control drawing: -------------------------------------------------------------
'---------------------------------------------------------------------------------
SUB __UI_DrawButton (This AS __UI_ControlTYPE, ControlState AS _BYTE)
'ControlState: 1 = Normal; 2 = Hover/focus; 3 = Mouse down; 4 = Disabled
DIM TempCaption$
DIM PrevDest AS LONG, TempControlState AS _BYTE
STATIC ControlImage AS LONG
CONST ButtonHeight = 21
CONST ButtonWidth = 18
IF ControlImage = 0 THEN ControlImage = __UI_LoadThemeImage("button.png")
TempControlState = ControlState
IF TempControlState = 1 THEN
IF (This.ID = __UI_DefaultButtonID AND This.ID <> __UI_Focus AND Control(__UI_Focus).Type <> __UI_Type_Button) OR This.ID = __UI_Focus THEN
TempControlState = 5
END IF
END IF
IF This.Redraw OR This.ControlState <> TempControlState OR This.FocusState <> (__UI_Focus = This.ID) OR Caption(This.ID) <> __UI_TempCaptions(This.ID) OR This.PreviousParentID <> This.ParentID OR __UI_ForceRedraw _
OR This.Font <> This.PreviousFont THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.Redraw = False
This.ControlState = TempControlState
This.PreviousFont = This.Font
This.FocusState = __UI_Focus = This.ID
__UI_TempCaptions(This.ID) = Caption(This.ID)
This.PreviousParentID = This.ParentID
IF This.ParentID THEN Control(This.ParentID).ChildrenRedrawn = True
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
END IF
This.Canvas = _NEWIMAGE(This.Width, This.Height, 32)
PrevDest = _DEST
_DEST This.Canvas
_FONT (This.Font)
CLS , _RGBA32(0, 0, 0, 0)
TempCaption$ = __UI_TrimAt0$(Caption(This.ID))
'Back surface
_PUTIMAGE (0, 3)-(This.Width - 1, This.Height - 4), ControlImage, , (3, TempControlState * ButtonHeight - ButtonHeight + 3)-STEP(11, ButtonHeight - 7)
'Does this button have a helper canvas (icon)?
DIM IconWidth AS INTEGER, IconHeight AS INTEGER
IF This.HelperCanvas < -1 THEN
IF LEN(TempCaption$) THEN
'Icon will be to the left of caption
IconHeight = This.Height - 6
IconWidth = _WIDTH(This.HelperCanvas) * IconHeight / _HEIGHT(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
DIM PictureOffsetX AS INTEGER, PictureOffsetY AS INTEGER
IF This.ControlState = 3 THEN
PictureOffsetX = 1
PictureOffsetY = 1
END IF
IconHeight = This.Height - 6
IconWidth = _WIDTH(This.HelperCanvas) * (IconHeight / _HEIGHT(This.HelperCanvas))
_PUTIMAGE (This.Width \ 2 - ((IconWidth \ 2)) + PictureOffsetX, This.Height / 2 - ((This.Height - 4) / 2) + 1 + PictureOffsetY)-STEP(IconWidth - 1, IconHeight - 1), This.HelperCanvas
END IF
END IF
'Top and bottom edges
_PUTIMAGE (3, 0)-STEP(This.Width - 6, 3), ControlImage, , (3, TempControlState * ButtonHeight - ButtonHeight)-STEP(11, 3)
_PUTIMAGE (3, This.Height - 3)-STEP(This.Width - 6, 3), ControlImage, , (3, TempControlState * ButtonHeight - ButtonHeight + 18)-STEP(11, 3)
'Left edges and corners:
_PUTIMAGE (0, 2)-STEP(2, This.Height - 4), ControlImage, , (0, TempControlState * ButtonHeight - ButtonHeight + 2)-STEP(2, ButtonHeight - 6)
_PUTIMAGE (0, 0), ControlImage, , (0, TempControlState * ButtonHeight - ButtonHeight)-STEP(2, 2)
_PUTIMAGE (0, This.Height - 3), ControlImage, , (0, TempControlState * ButtonHeight - 3)-STEP(2, 2)
'Right edges and corners:
_PUTIMAGE (This.Width - 3, 2)-STEP(2, This.Height - 4), ControlImage, , (ButtonWidth - 3, TempControlState * ButtonHeight - ButtonHeight + 2)-STEP(2, ButtonHeight - 6)
_PUTIMAGE (This.Width - 2, 0), ControlImage, , (ButtonWidth - 2, TempControlState * ButtonHeight - ButtonHeight)-STEP(2, 2)
_PUTIMAGE (This.Width - 3, This.Height - 3), ControlImage, , (ButtonWidth - 3, TempControlState * ButtonHeight - 3)-STEP(2, 2)
'Caption:
IF NOT This.Disabled THEN
COLOR This.ForeColor
ELSE
COLOR Darken(Control(__UI_FormID).BackColor, 80)
END IF
__UI_PrintString (IconWidth / 2) + (This.Width \ 2 - __UI_PrintWidth&(TempCaption$) \ 2), ((This.Height \ 2) - _ufontheight \ 2), TempCaption$
'Hot key:
IF (This.HotKey > 0 AND (__UI_ShowHotKeys AND NOT This.Disabled)) OR (This.HotKey > 0 AND __UI_DesignMode) THEN
LINE ((This.Width \ 2 - __UI_PrintWidth&(TempCaption$) \ 2) + This.HotKeyOffset, ((This.Height \ 2) + _ufontheight \ 2))-STEP(__UI_PrintWidth&(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
'Focus outline:
IF __UI_Focus = This.ID AND __UI_KeyboardFocus THEN
LINE (2, 2)-STEP(This.Width - 5, This.Height - 5), _RGB32(0, 0, 0), B , 21845
END IF
__UI_MakeHardwareImageFromCanvas This
_DEST PrevDest
END IF
IF This.Canvas THEN _PUTIMAGE (This.Left, This.Top), This.Canvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawLabel (This AS __UI_ControlTYPE, ControlState AS _BYTE)
DIM PrevDest AS LONG, i AS LONG
DIM CaptionIndent AS INTEGER, TempCaption$, TempLine$
IF This.Redraw OR This.ControlState <> ControlState OR Caption(This.ID) <> __UI_TempCaptions(This.ID) OR This.PreviousParentID <> This.ParentID OR __UI_ForceRedraw _
OR This.PreviousFont <> This.Font _
OR Mask(This.ID) <> __UI_TempMask(This.ID) _
OR This.Value <> This.PreviousValue _
OR This.PrevAlign <> This.Align _
OR This.PrevVAlign <> This.VAlign THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.Redraw = False
This.ControlState = ControlState
This.PreviousFont = This.Font
__UI_TempCaptions(This.ID) = Caption(This.ID)
__UI_TempMask(This.ID) = Mask(This.ID)
This.PrevAlign = This.Align
This.PrevVAlign = This.VAlign
This.PreviousValue = This.Value
IF This.ParentID THEN Control(This.ParentID).ChildrenRedrawn = True
This.PreviousParentID = This.ParentID
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
END IF
This.Canvas = _NEWIMAGE(This.Width, This.Height, 32)
PrevDest = _DEST
_DEST This.Canvas
_FONT This.Font
IF This.HasBorder THEN
IF This.BorderSize > __UI_MaxBorderSize THEN
This.BorderSize = __UI_MaxBorderSize
ELSEIF This.BorderSize < 1 THEN
This.BorderSize = 1
END IF
CaptionIndent = __UI_DefaultCaptionIndent + This.BorderSize
END IF
IF This.BackStyle = __UI_Opaque THEN
CLS , This.BackColor
ELSE
CLS , _RGBA32(0, 0, 0, 0)
END IF
IF NOT This.Disabled THEN
COLOR This.ForeColor
ELSE
COLOR Darken(Control(__UI_FormID).BackColor, 80)
END IF
'Caption:
DIM CaptionLeft AS INTEGER, FindLF&, FindSep&, ThisLine%
DIM CaptionLeftFirstLine AS INTEGER, CaptionTopFirstLine AS INTEGER, TextTop%
DIM TotalLines AS INTEGER
IF This.WordWrap THEN
TempCaption$ = __UI_TrimAt0$(__UI_WordWrap(Caption(This.ID), This.Width - ((CaptionIndent + This.Padding) * 2), 0, TotalLines))
DO WHILE LEN(TempCaption$)
ThisLine% = ThisLine% + 1
IF This.VAlign = __UI_Top THEN
TextTop% = CaptionIndent + ThisLine% * uspacing& - uspacing&
ELSEIF This.VAlign = __UI_Middle THEN
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&))
ELSE
'Snap to top of the label's boundaries
'if there are more lines than meet the eye
TextTop% = CaptionIndent + ThisLine% * uspacing& - uspacing&
END IF
ELSEIF This.VAlign = __UI_Bottom THEN
TextTop% = This.Height - CaptionIndent - (TotalLines * uspacing&) + (ThisLine% * uspacing& - uspacing&)
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$ = ""
END IF
END IF
SELECT CASE This.Align
CASE __UI_Left
CaptionLeft = CaptionIndent + This.Padding
CASE __UI_Center
CaptionLeft = (This.Width \ 2 - __UI_PrintWidth&(TempLine$) \ 2)
CASE __UI_Right
CaptionLeft = (This.Width - __UI_PrintWidth&(TempLine$)) - (CaptionIndent + This.Padding)
END SELECT
__UI_PrintString CaptionLeft, TextTop%, TempLine$
IF ThisLine% = 1 THEN CaptionLeftFirstLine = CaptionLeft: CaptionTopFirstLine = TextTop%
LOOP
'Hot key:
IF (This.HotKey > 0 AND (__UI_ShowHotKeys AND NOT This.Disabled)) OR (This.HotKey > 0 AND __UI_DesignMode) THEN
LINE (CaptionLeftFirstLine + This.HotKeyOffset, CaptionTopFirstLine + uspacing&)-STEP(__UI_PrintWidth&(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
ELSE
IF LEN(Mask(This.ID)) THEN
TempCaption$ = __UI_StrUsing$(Mask(This.ID), This.Value)
ELSE
TempCaption$ = __UI_TrimAt0$(Caption(This.ID))
END IF
SELECT CASE This.Align
CASE __UI_Left
CaptionLeft = CaptionIndent + This.Padding
CASE __UI_Center
CaptionLeft = (This.Width \ 2 - __UI_PrintWidth&(TempCaption$) \ 2)
CASE __UI_Right
CaptionLeft = This.Width - __UI_PrintWidth&(TempCaption$) - (CaptionIndent + This.Padding)
END SELECT
IF This.VAlign = __UI_Top THEN
TextTop% = CaptionIndent
ELSEIF This.VAlign = __UI_Middle THEN
TextTop% = (This.Height \ 2) - uspacing& \ 2
ELSEIF This.VAlign = __UI_Bottom THEN
TextTop% = This.Height - CaptionIndent - uspacing&
END IF
CaptionLeftFirstLine = CaptionLeft
__UI_PrintString CaptionLeft, TextTop%, TempCaption$
'Hot key:
IF (This.HotKey > 0 AND (__UI_ShowHotKeys AND NOT This.Disabled)) OR (This.HotKey > 0 AND __UI_DesignMode) THEN
LINE (CaptionLeftFirstLine + This.HotKeyOffset, (TextTop% + uspacing&))-STEP(__UI_PrintWidth&(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
END IF
IF This.HasBorder THEN
FOR i = 0 TO This.BorderSize - 1
LINE (i, i)-STEP(This.Width - 1 - i * 2, This.Height - 1 - i * 2), This.BorderColor, B
NEXT
END IF
__UI_MakeHardwareImageFromCanvas This
_DEST PrevDest
END IF
IF This.Canvas THEN _PUTIMAGE (This.Left, This.Top), This.Canvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawToggleSwitch (This AS __UI_ControlTYPE, ControlState AS _BYTE)
DIM PrevDest AS LONG
DIM CaptionIndent AS INTEGER
'STATIC ControlImage AS LONG
CONST ImageHeight = 15
CONST ImageWidth = 30
'IF ControlImage = 0 THEN ControlImage = __UI_LoadThemeImage("radiobutton.png")
IF This.Redraw OR This.ControlState <> ControlState OR TIMER - This.LastChange < .5 OR This.FocusState <> (__UI_Focus = This.ID) OR Caption(This.ID) <> __UI_TempCaptions(This.ID) OR This.Value <> This.PreviousValue OR This.PreviousParentID <> This.ParentID _
OR __UI_ForceRedraw OR This.PreviousFont <> This.Font THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.Redraw = False
This.ControlState = ControlState
This.PreviousFont = This.Font
This.FocusState = __UI_Focus = This.ID
IF This.PreviousValue <> This.Value THEN
__UI_StateHasChanged = True
This.PreviousValue = This.Value
END IF
__UI_TempCaptions(This.ID) = Caption(This.ID)
IF This.ParentID THEN Control(This.ParentID).ChildrenRedrawn = True
This.PreviousParentID = This.ParentID
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
END IF
IF This.Height < ImageHeight THEN This.Height = ImageHeight
IF This.Width < ImageWidth THEN This.Width = ImageWidth
This.Canvas = _NEWIMAGE(This.Width + 1, This.Height + 1, 32)
PrevDest = _DEST
_DEST This.Canvas
_FONT This.Font
'------
IF This.BackStyle = __UI_Opaque THEN
CLS , This.BackColor
ELSE
CLS , _RGBA32(0, 0, 0, 0)
END IF
CaptionIndent = 0
DIM AnimationOffset AS SINGLE
AnimationOffset = __UI_MAP(TIMER - This.LastChange, 0, .2, This.Width / 2, 0)
IF AnimationOffset < 0 THEN AnimationOffset = 0
IF AnimationOffset > This.Width / 2 THEN AnimationOffset = This.Width / 2
IF This.Value THEN
IF NOT This.Disabled THEN
LINE (0, 0)-(This.Width, This.Height), This.SelectedBackColor, BF
ELSE
LINE (0, 0)-(This.Width, This.Height), Darken(This.SelectedBackColor, 150), BF
END IF
LINE (This.Width / 2 + 4 - AnimationOffset, 4)-STEP(This.Width / 2 - 8, This.Height - 8), This.SelectedForeColor, BF
LINE (0, 0)-(This.Width, This.Height), This.BorderColor, B
ELSE
IF NOT This.Disabled THEN
LINE (0, 0)-(This.Width, This.Height), This.BackColor, BF
ELSE
LINE (0, 0)-(This.Width, This.Height), Darken(This.BackColor, 80), BF
END IF
LINE (4 + AnimationOffset, 4)-STEP(This.Width / 2 - 8, This.Height - 8), This.ForeColor, BF
LINE (0, 0)-(This.Width, This.Height), This.BorderColor, B
END IF
'Focus outline
IF __UI_Focus = This.ID AND __UI_KeyboardFocus THEN
LINE (1, 1)-STEP(This.Width - 2, This.Height - 2), _RGB32(0, 0, 0), B , 21845
END IF
'------
__UI_MakeHardwareImageFromCanvas This
_DEST PrevDest
END IF
IF This.Canvas THEN _PUTIMAGE (This.Left, This.Top), This.Canvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawRadioButton (This AS __UI_ControlTYPE, ControlState AS _BYTE)
DIM PrevDest AS LONG
DIM CaptionIndent AS INTEGER, TempCaption$
STATIC ControlImage AS LONG
CONST ImageHeight = 13
CONST ImageWidth = 13
IF ControlImage = 0 THEN ControlImage = __UI_LoadThemeImage("radiobutton.png")
IF This.Redraw OR This.ControlState <> ControlState OR This.FocusState <> (__UI_Focus = This.ID) OR Caption(This.ID) <> __UI_TempCaptions(This.ID) OR This.Value <> This.PreviousValue OR This.PreviousParentID <> This.ParentID _
OR __UI_ForceRedraw OR This.PreviousFont <> This.Font THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.Redraw = False
This.PreviousFont = This.Font
This.ControlState = ControlState
This.FocusState = __UI_Focus = This.ID
This.PreviousValue = This.Value
__UI_TempCaptions(This.ID) = Caption(This.ID)
IF This.ParentID THEN Control(This.ParentID).ChildrenRedrawn = True
This.PreviousParentID = This.ParentID
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
END IF
IF This.Height < ImageHeight THEN This.Height = ImageHeight
This.Canvas = _NEWIMAGE(This.Width + 1, This.Height + 1, 32)
PrevDest = _DEST
_DEST This.Canvas
_FONT This.Font
'------
IF This.BackStyle = __UI_Opaque THEN
CLS , This.BackColor
ELSE
CLS , _RGBA32(0, 0, 0, 0)
END IF
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.Value THEN ControlState = ControlState + 4
_PUTIMAGE (0, This.Height \ 2 - (ImageHeight \ 2))-STEP(ImageWidth - 1, ImageHeight - 1), ControlImage, , (0, ControlState * ImageHeight - ImageHeight)-STEP(12, 12)
CaptionIndent = CaptionIndent + ImageWidth * 1.5
TempCaption$ = __UI_TrimAt0$(Caption(This.ID))
IF NOT This.Disabled THEN
COLOR This.ForeColor
ELSE
COLOR Darken(Control(__UI_FormID).BackColor, 80)
END IF
__UI_PrintString CaptionIndent, ((This.Height \ 2) - uspacing& \ 2) + 1, TempCaption$
'Hot key:
IF (This.HotKey > 0 AND (__UI_ShowHotKeys AND NOT This.Disabled)) OR (This.HotKey > 0 AND __UI_DesignMode) THEN
LINE (CaptionIndent + This.HotKeyOffset, ((This.Height \ 2) + uspacing& \ 2))-STEP(__UI_PrintWidth(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
'Focus outline
IF __UI_Focus = This.ID AND __UI_KeyboardFocus THEN
LINE (CaptionIndent - 1, 0)-STEP(This.Width - CaptionIndent - 1, This.Height - 1), _RGB32(0, 0, 0), B , 21845
END IF
'------
__UI_MakeHardwareImageFromCanvas This
_DEST PrevDest
END IF
IF This.Canvas THEN _PUTIMAGE (This.Left, This.Top), This.Canvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawCheckBox (This AS __UI_ControlTYPE, ControlState AS _BYTE)
DIM PrevDest AS LONG
DIM CaptionIndent AS INTEGER, TempCaption$
STATIC ControlImage AS LONG
CONST ImageHeight = 13
CONST ImageWidth = 13
IF ControlImage = 0 THEN ControlImage = __UI_LoadThemeImage("checkbox.png")
IF This.Redraw OR This.ControlState <> ControlState OR This.FocusState <> (__UI_Focus = This.ID) OR Caption(This.ID) <> __UI_TempCaptions(This.ID) OR This.Value <> This.PreviousValue OR This.PreviousParentID <> This.ParentID _
OR __UI_ForceRedraw OR This.PreviousFont <> This.Font THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.Redraw = False
This.ControlState = ControlState
This.PreviousFont = This.Font
This.FocusState = __UI_Focus = This.ID
IF This.PreviousValue <> This.Value THEN
__UI_StateHasChanged = True
This.PreviousValue = This.Value
END IF
__UI_TempCaptions(This.ID) = Caption(This.ID)
IF This.ParentID THEN Control(This.ParentID).ChildrenRedrawn = True
This.PreviousParentID = This.ParentID
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
END IF
IF This.Height < ImageHeight THEN This.Height = ImageHeight
This.Canvas = _NEWIMAGE(This.Width + 2, This.Height + 2, 32)
PrevDest = _DEST
_DEST This.Canvas
_FONT This.Font
'------
IF This.BackStyle = __UI_Opaque THEN
CLS , This.BackColor
ELSE
CLS , _RGBA32(0, 0, 0, 0)
END IF
CaptionIndent = 0
IF This.Value THEN ControlState = ControlState + 4
_PUTIMAGE (0, This.Height \ 2 - (ImageHeight \ 2))-STEP(ImageWidth - 1, ImageHeight - 1), ControlImage, , (0, ControlState * ImageHeight - ImageHeight)-STEP(ImageWidth - 1, ImageHeight - 1)
CaptionIndent = CaptionIndent + ImageWidth * 1.5
TempCaption$ = __UI_TrimAt0$(Caption(This.ID))
IF NOT This.Disabled THEN
COLOR This.ForeColor
ELSE
COLOR Darken(Control(__UI_FormID).BackColor, 80)
END IF
__UI_PrintString CaptionIndent, ((This.Height \ 2) - uspacing& \ 2) + 1, TempCaption$
'Hot key:
IF (This.HotKey > 0 AND (__UI_ShowHotKeys AND NOT This.Disabled)) OR (This.HotKey > 0 AND __UI_DesignMode) THEN
LINE (CaptionIndent + This.HotKeyOffset, ((This.Height \ 2) + uspacing& \ 2))-STEP(__UI_PrintWidth(CHR$(This.HotKey)) - 1, 0), This.ForeColor
END IF
'Focus outline
IF __UI_Focus = This.ID AND __UI_KeyboardFocus THEN
LINE (CaptionIndent - 1, 0)-STEP(This.Width - CaptionIndent - 1, This.Height - 1), _RGB32(0, 0, 0), B , 21845
END IF
'------
__UI_MakeHardwareImageFromCanvas This
_DEST PrevDest
END IF
IF This.Canvas THEN _PUTIMAGE (This.Left, This.Top), This.Canvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawProgressBar (This AS __UI_ControlTYPE, ControlState)
DIM PrevDest AS LONG, Temp&
DIM TempCaption$, TempLine$
STATIC ControlImage_Track AS LONG, ControlImage_Chunk AS LONG
IF ControlImage_Chunk = 0 THEN ControlImage_Chunk = __UI_LoadThemeImage("progresschunk.png")
IF ControlImage_Track = 0 THEN ControlImage_Track = __UI_LoadThemeImage("progresstrack.png")
IF This.Redraw OR This.ControlState <> ControlState OR This.FocusState <> (__UI_Focus = This.ID) OR Caption(This.ID) <> __UI_TempCaptions(This.ID) OR This.Value <> This.PreviousValue OR This.PreviousParentID <> This.ParentID _
OR __UI_ForceRedraw OR This.PreviousFont <> This.Font THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.Redraw = False
This.PreviousFont = This.Font
This.ControlState = ControlState
This.FocusState = __UI_Focus = This.ID
This.PreviousValue = This.Value
__UI_TempCaptions(This.ID) = Caption(This.ID)
IF This.ParentID THEN Control(This.ParentID).ChildrenRedrawn = True
This.PreviousParentID = This.ParentID
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
END IF
This.Canvas = _NEWIMAGE(This.Width, This.Height, 32)
PrevDest = _DEST
_DEST This.Canvas
_FONT (This.Font)
CLS , _RGBA32(0, 0, 0, 0)
'------
'Draw track
'Back
_PUTIMAGE (5, 4)-STEP(This.Width - 9, This.Height - 8), ControlImage_Track, , (5, 4)-STEP(0, 11)
'Left side
_PUTIMAGE (0, 0), ControlImage_Track, , (0, 0)-(4, 4) 'top corner
_PUTIMAGE (0, This.Height - 3), ControlImage_Track, , (0, 16)-STEP(3, 2) 'bottom corner
_PUTIMAGE (0, 4)-(4, This.Height - 4), ControlImage_Track, , (0, 4)-STEP(4, 11) 'vertical stretch
'Right side
_PUTIMAGE (This.Width - 4, 0), ControlImage_Track, , (6, 0)-STEP(2, 3) 'top corner
_PUTIMAGE (This.Width - 4, This.Height - 3), ControlImage_Track, , (6, 16)-STEP(2, 3) 'bottom corner
_PUTIMAGE (This.Width - 4, 4)-STEP(2, This.Height - 8), ControlImage_Track, , (6, 4)-STEP(2, 11) 'vertical stretch
'Top
_PUTIMAGE (4, 0)-STEP(This.Width - 9, 3), ControlImage_Track, , (4, 0)-STEP(1, 3)
'Bottom
_PUTIMAGE (4, This.Height - 3)-STEP(This.Width - 9, 2), ControlImage_Track, , (4, 16)-STEP(1, 2)
'Draw progress
IF This.Value THEN
_PUTIMAGE (4, 3)-STEP(((This.Width - 9) / This.Max) * This.Value, This.Height - 7), ControlImage_Chunk
END IF
IF This.ShowPercentage THEN
DIM ProgressString$
ProgressString$ = LTRIM$(STR$(FIX((This.Value / This.Max) * 100))) + "%"
IF LEN(Caption(This.ID)) THEN
TempCaption$ = Replace$(Caption(This.ID), "\#", ProgressString$, 0, 0)
ELSE
TempCaption$ = ProgressString$
END IF
IF NOT This.Disabled THEN
COLOR This.ForeColor
ELSE
COLOR Darken(Control(__UI_FormID).BackColor, 70)
END IF
'Caption:
DIM CaptionLeft AS INTEGER, FindLF&, FindSep&, ThisLine%
DIM CaptionLeftFirstLine AS INTEGER, CaptionTopFirstLine AS INTEGER, TextTop%
DIM TotalLines AS INTEGER
IF INSTR(TempCaption$, CHR$(10)) > 0 THEN
TempCaption$ = __UI_TrimAt0$(__UI_WordWrap(TempCaption$, This.Width - ((__UI_DefaultCaptionIndent) * 2), 0, TotalLines))
DO WHILE LEN(TempCaption$)
ThisLine% = ThisLine% + 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&))
ELSE
'Snap to top of the label's boundaries
'if there are more lines than meet the eye
TextTop% = __UI_DefaultCaptionIndent + ThisLine% * uspacing& - uspacing&
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$ = ""
END IF
END IF
CaptionLeft = (This.Width \ 2 - __UI_PrintWidth&(TempLine$) \ 2)
__UI_PrintString CaptionLeft, TextTop%, TempLine$
IF ThisLine% = 1 THEN CaptionLeftFirstLine = CaptionLeft: CaptionTopFirstLine = TextTop%
LOOP
ELSE
Temp& = __UI_PrintWidth(TempCaption$)
__UI_PrintString This.Width \ 2 - Temp& \ 2, This.Height \ 2 - uspacing& \ 2 + 1, TempCaption$
END IF
END IF
'------
__UI_MakeHardwareImageFromCanvas This
_DEST PrevDest
END IF
IF This.Canvas THEN _PUTIMAGE (This.Left, This.Top), This.Canvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawTrackBar (This AS __UI_ControlTYPE, ControlState)
DIM PrevDest AS LONG, i AS LONG, TempControlState AS _BYTE
STATIC ControlImage_Track AS LONG, ControlImage_Slider AS LONG
CONST SliderHeight = 21
CONST SliderWidth = 11
IF ControlImage_Track = 0 THEN ControlImage_Track = __UI_LoadThemeImage("slidertrack.png")
IF ControlImage_Slider = 0 THEN
ControlImage_Slider = __UI_LoadThemeImage("sliderdown.png")
__UI_ClearColor ControlImage_Slider, 0, 0
END IF
TempControlState = ControlState
IF This.Disabled THEN TempControlState = 5
IF This.Redraw OR This.ControlState <> TempControlState OR This.FocusState <> (__UI_Focus = This.ID) OR This.Value <> This.PreviousValue OR This.PreviousParentID <> This.ParentID _
OR __UI_ForceRedraw OR This.PreviousFont <> This.Font OR _
This.PrevMin <> This.Min OR This.PrevMax <> This.Max OR _
This.PrevInterval <> This.Interval OR This.PrevMinInterval <> This.MinInterval THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.Redraw = False
This.ControlState = TempControlState
This.PreviousFont = This.Font
This.FocusState = __UI_Focus = This.ID
IF This.PreviousValue <> This.Value THEN
__UI_StateHasChanged = True
This.PreviousValue = This.Value
END IF
This.PrevMin = This.Min
This.PrevMax = This.Max
This.PrevInterval = This.Interval
This.PrevMinInterval = This.MinInterval
IF This.ParentID THEN Control(This.ParentID).ChildrenRedrawn = True
This.PreviousParentID = This.ParentID
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
END IF
This.Canvas = _NEWIMAGE(This.Width, This.Height, 32)
PrevDest = _DEST
_DEST This.Canvas
_FONT (This.Font)
CLS , _RGBA32(0, 0, 0, 0)
'------
'Draw track
_PUTIMAGE (3, 10), ControlImage_Track, , (0, 0)-STEP(1, 4)
_PUTIMAGE (5, 10)-STEP(This.Width - 10, 5), ControlImage_Track, , (2, 0)-STEP(0, 4)
_PUTIMAGE (This.Width - 4, 10), ControlImage_Track, , (3, 0)-STEP(1, 4)
'Interval ticks
DIM IntervalSize AS INTEGER, MinIntervalSize AS INTEGER
MinIntervalSize = 2
LINE (5, 30)-STEP(0, 3), This.BorderColor
IF This.Interval = 0 THEN This.Interval = 1
IF This.MinInterval > This.Interval THEN
This.MinInterval = 0
ELSEIF This.MinInterval < This.Interval AND This.MinInterval > 0 THEN
FOR i = This.Min TO This.Max STEP This.MinInterval
LINE (__UI_MAP(i, This.Min, This.Max, 5, This.Width - 6), 30)-STEP(0, MinIntervalSize), This.BorderColor
NEXT i
ENDIF
IF This.MinInterval > 0 THEN IntervalSize = 5 ELSE IntervalSize = 2
FOR i = This.Min TO This.Max STEP This.Interval
LINE (__UI_MAP(i, This.Min, This.Max, 5, This.Width - 6), 30)-STEP(0, IntervalSize), This.BorderColor
NEXT i
LINE (5 + (This.Width - SliderWidth), 30)-STEP(0, 3), This.BorderColor
'Draw slider
_PUTIMAGE (__UI_MAP(This.Value, This.Min, This.Max, 0, This.Width - SliderWidth), 2), ControlImage_Slider, , (0, TempControlState * SliderHeight - SliderHeight)-STEP(SliderWidth - 1, SliderHeight - 1)
'Focus outline
IF __UI_Focus = This.ID AND __UI_KeyboardFocus THEN
LINE (0, 0)-STEP(This.Width - 1, This.Height - 1), _RGB32(0, 0, 0), B , 21845
END IF
'------
__UI_MakeHardwareImageFromCanvas This
_DEST PrevDest
END IF
IF This.Canvas THEN _PUTIMAGE (This.Left, This.Top), This.Canvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawTextBox (This AS __UI_ControlTYPE, ControlState)
DIM PrevDest AS LONG
DIM CaptionIndent AS INTEGER, i AS LONG, TempCaption$
STATIC SetCursor#, cursorBlink%%
IF This.FirstVisibleLine = 0 THEN This.FirstVisibleLine = 1
IF This.CurrentLine = 0 THEN This.CurrentLine = 1
__UI_CursorAdjustments This.ID
IF This.Redraw OR This.ControlState <> ControlState OR _
This.FocusState <> (__UI_Focus = This.ID) OR _
Caption(This.ID) <> __UI_TempCaptions(This.ID) OR _
Text(This.ID) <> __UI_TempTexts(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 _
Mask(This.ID) <> __UI_TempMask(This.ID) OR _
This.PreviousFont <> This.Font OR _
__UI_ForceRedraw THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.Redraw = False
This.ControlState = ControlState
This.PreviousFont = This.Font
This.FocusState = __UI_Focus = This.ID
__UI_TempCaptions(This.ID) = Caption(This.ID)
IF Mask(This.ID) <> __UI_TempMask(This.ID) THEN
IF NOT __UI_EditorMode THEN Mask(This.ID) = RestoreCHR$(Mask(This.ID))
__UI_TempMask(This.ID) = Mask(This.ID)
Text(This.ID) = __UI_EmptyMask(This.ID)
END IF
IF __UI_TempTexts(This.ID) <> Text(This.ID) THEN
__UI_StateHasChanged = True
IF NOT __UI_EditorMode THEN Text(This.ID) = RestoreCHR$(Text(This.ID))
__UI_TempTexts(This.ID) = Text(This.ID)
END IF
This.SelectionLength = __UI_SelectionLength
This.PrevCursor = This.Cursor
This.PrevVisibleCursor = This.VisibleCursor
IF This.ParentID THEN Control(This.ParentID).ChildrenRedrawn = True
This.PreviousParentID = This.ParentID
This.PrevFirstVisibleLine = This.FirstVisibleLine
This.PrevCurrentLine = This.CurrentLine
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
END IF
This.Canvas = _NEWIMAGE(This.Width, This.Height, 32)
PrevDest = _DEST
_DEST This.Canvas
_FONT (This.Font)
'------
_PRINTMODE _KEEPBACKGROUND
CLS , This.BackColor
TempCaption$ = __UI_TrimAt0$(Caption(This.ID))
CaptionIndent = 0
IF This.HasBorder THEN
IF This.BorderSize > __UI_MaxBorderSize THEN
This.BorderSize = __UI_MaxBorderSize
ELSEIF This.BorderSize < 1 THEN
This.BorderSize = 1
END IF
CaptionIndent = __UI_DefaultCaptionIndent + This.BorderSize
END IF
IF NOT This.Disabled AND (LEN(Text(This.ID)) OR This.Multiline) THEN
COLOR This.ForeColor, This.BackColor
ELSE
COLOR Darken(Control(__UI_FormID).BackColor, 80), This.BackColor
END IF
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
DIM ThisTempText$
ThisTempText$ = __UI_TrimAt0$(Text(This.ID))
IF LEN(ThisTempText$) > 0 AND This.PasswordField = True THEN
ThisTempText$ = STRING$(LEN(ThisTempText$), 7)
END IF
IF ((__UI_Focus = This.ID) OR (This.ID = __UI_PreviousFocus AND __UI_ParentMenu(__UI_TotalActiveMenus) = This.ContextMenuID)) AND NOT This.Disabled THEN
IF LEN(Text(This.ID)) THEN
__UI_PrintString CaptionIndent - This.InputViewStart, ((This.Height \ 2) - uspacing& \ 2), ThisTempText$
__UI_CharPos ThisTempText$
ELSE
__UI_PrintString CaptionIndent, ((This.Height \ 2) - uspacing& \ 2), TempCaption$
__UI_CharPos TempCaption$
END IF
IF This.TextIsSelected THEN
LINE (Captionindent - This.InputViewStart + __UI_ThisLineChars(This.SelectionStart), ((This.Height \ 2) - uspacing& \ 2))-(Captionindent - This.InputViewStart + __UI_ThisLineChars(This.Cursor), ((This.Height \ 2) - uspacing& \ 2) + uspacing&), c, BF
END IF
IF TIMER - SetCursor# > .3 THEN
SetCursor# = TIMER
cursorBlink%% = NOT cursorBlink%%
END IF
IF _WINDOWHASFOCUS = False THEN cursorBlink%% = False
IF This.Cursor > UBOUND(__UI_ThisLineChars) THEN This.Cursor = UBOUND(__UI_ThisLineChars)
This.VisibleCursor = CaptionIndent + __UI_ThisLineChars(This.Cursor) - This.InputViewStart
STATIC PrevFocusedText$
IF PrevFocusedText$ <> ThisTempText$ THEN
PrevFocusedText$ = ThisTempText$
REDIM __UI_FocusedTextBoxChars(0 TO UBOUND(__UI_ThisLineChars)) AS LONG
DIM M1 AS _MEM, M2 AS _MEM
M1 = _MEM(__UI_ThisLineChars())
M2 = _MEM(__UI_FocusedTextBoxChars())
_MEMCOPY M1, M1.OFFSET, M1.SIZE TO M2, M2.OFFSET
_MEMFREE M1
_MEMFREE M2
END IF
SELECT CASE MID$(Mask(This.ID), This.Cursor + 1, 1)
CASE "0", "9", "#" 'Digit placeholders
LINE (This.VisibleCursor, ((This.Height \ 2) - uspacing& \ 2))-STEP(__UI_ThisLineChars(This.Cursor + 1) - __UI_ThisLineChars(This.Cursor), uspacing&), c, BF
CASE ELSE
IF cursorBlink%% THEN
LINE (This.VisibleCursor, ((This.Height \ 2) - uspacing& \ 2))-STEP(0, uspacing&), _RGB32(0, 0, 0)
END IF
END SELECT
ELSE
IF LEN(Text(This.ID)) THEN
__UI_PrintString CaptionIndent, ((This.Height \ 2) - uspacing& \ 2), ThisTempText$
ELSE
IF LEN(Mask(This.ID)) = 0 THEN
__UI_PrintString CaptionIndent, ((This.Height \ 2) - uspacing& \ 2), TempCaption$
ELSE
Text(This.ID) = __UI_EmptyMask$(This.ID)
END IF
END IF
END IF
ELSE
'Multi line textbox
DIM ThisTop AS INTEGER, TempLine AS STRING
DIM TotalLines AS INTEGER
'DIM ThisLine AS LONG, ThisLineStart AS LONG
DIM s1 AS LONG, s2 AS LONG
STATIC PrevTotalLines AS LONG
IF This.TextIsSelected THEN
s1 = This.SelectionStart + 1
s2 = This.Cursor + 1
IF s1 > s2 THEN SWAP s1, s2
END IF
ThisTop = CaptionIndent - uspacing&
TempCaption$ = __UI_TrimAt0$(__UI_WordWrap(Text(This.ID), This.Width - __UI_ScrollbarWidth - 5, 0, TotalLines))
IF This.HelperCanvas = 0 OR PrevTotalLines <> TotalLines THEN
PrevTotalLines = TotalLines
IF This.HelperCanvas < -1 THEN _FREEIMAGE This.HelperCanvas
This.HelperCanvas = _NEWIMAGE(This.Width - __UI_ScrollbarWidth, TotalLines * uspacing& + uspacing& / 2)
END IF
_DEST This.HelperCanvas
_FONT This.Font
CLS , This.BackColor
IF TIMER - SetCursor# > .3 THEN
SetCursor# = TIMER
cursorBlink%% = NOT cursorBlink%%
END IF
'FOR ThisLine = 1 TO TotalLines
' 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
DO WHILE LEN(TempCaption$)
DIM ThisLine%, TextTop%, FindSep&, FindLF&, CaptionLeft AS INTEGER
ThisLine% = ThisLine% + 1
TextTop% = CaptionIndent + ThisLine% * uspacing& - uspacing&
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$ = ""
END IF
END IF
CaptionLeft = CaptionIndent
__UI_PrintString CaptionLeft, TextTop%, TempLine$
LOOP
IF This.ID = __UI_Focus THEN
FOR i = Control(__UI_Focus).Cursor TO 0 STEP -1
IF MID$(Text(__UI_Focus), i, 1) = CHR$(10) OR i = 0 THEN
Control(__UI_Focus).VisibleCursor = Control(__UI_Focus).Cursor - i
EXIT FOR
END IF
NEXT
END IF
_DEST This.Canvas
_PUTIMAGE (0,0),This.HelperCanvas
IF TotalLines > This.Height \ uspacing& THEN
This.HasVScrollbar = True
__UI_DrawVScrollBar This, ControlState
ELSE
This.HasVScrollbar = False
__UI_DrawVScrollBar This, 4 'ControlState = 4 (Disabled)
END IF
END IF
IF This.HasBorder THEN
FOR i = 0 TO This.BorderSize - 1
LINE (i, i)-STEP(This.Width - 1 - i * 2, This.Height - 1 - i * 2), This.BorderColor, B
NEXT
END IF
'------
__UI_MakeHardwareImageFromCanvas This
_DEST PrevDest
END IF
IF This.Canvas THEN _PUTIMAGE (This.Left, This.Top), This.Canvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawListBox (This AS __UI_ControlTYPE, ControlState)
DIM PrevDest AS LONG, i AS LONG
DIM CaptionIndent AS INTEGER, TempCaption$
IF This.Redraw OR This.ControlState <> ControlState OR This.FocusState <> (__UI_Focus = This.ID) OR This.PreviousValue <> This.Value OR Text(This.ID) <> __UI_TempTexts(This.ID) OR This.PreviousInputViewStart <> This.InputViewStart OR This.PreviousParentID <> This.ParentID _
OR __UI_ForceRedraw OR This.PreviousFont <> This.Font THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.Redraw = False
This.PreviousFont = This.Font
This.ControlState = ControlState
This.FocusState = __UI_Focus = This.ID
IF This.PreviousValue <> This.Value THEN
__UI_StateHasChanged = True
This.PreviousValue = This.Value
END IF
This.PreviousInputViewStart = This.InputViewStart
IF INSTR(Text(This.ID), CHR$(13) + CHR$(10)) > 0 THEN
Text(This.ID) = Replace(Text(This.ID), CHR$(13) + CHR$(10), CHR$(10), 0, 0)
END IF
__UI_TempTexts(This.ID) = Text(This.ID)
IF This.ParentID THEN Control(This.ParentID).ChildrenRedrawn = True
This.PreviousParentID = This.ParentID
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
END IF
IF This.Width + This.Height > 0 THEN
This.Canvas = _NEWIMAGE(This.Width, This.Height, 32)
ELSE
EXIT SUB
END IF
PrevDest = _DEST
_DEST This.Canvas
_FONT (This.Font)
'------
IF This.BackStyle = __UI_Opaque THEN
CLS , This.BackColor
ELSE
CLS , _RGBA32(0, 0, 0, 0)
END IF
IF This.HasBorder THEN
IF This.BorderSize > __UI_MaxBorderSize THEN
This.BorderSize = __UI_MaxBorderSize
ELSEIF This.BorderSize < 1 THEN
This.BorderSize = 1
END IF
CaptionIndent = __UI_DefaultCaptionIndent + This.BorderSize
END IF
IF LEN(Text(This.ID)) THEN
DIM TempText$, Position&, FindLF&, ThisItem%, ThisItemTop%
DIM ItemHeight AS INTEGER, LastVisibleItem AS INTEGER
ItemHeight = uspacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset) + 3
This.ItemHeight = ItemHeight
TempText$ = __UI_TrimAt0$(Text(This.ID))
ThisItem% = 0
Position& = 1
DO WHILE LEN(TempText$)
ThisItem% = ThisItem% + 1
FindLF& = INSTR(Position&, TempText$, CHR$(10))
IF FindLF& THEN
TempCaption$ = MID$(TempText$, Position&, FindLF& - Position&)
ELSE
TempCaption$ = MID$(TempText$, Position&)
TempText$ = ""
END IF
Position& = FindLF& + 1
IF ThisItem% >= This.InputViewStart THEN
ThisItemTop% = ((ThisItem% - This.InputViewStart + 1) * ItemHeight - ItemHeight) + CaptionIndent
IF ThisItemTop% + ItemHeight > This.Height THEN
IF This.Max = 0 THEN _CONTINUE
EXIT DO
END IF
LastVisibleItem = LastVisibleItem + 1
IF ThisItem% = This.Value AND __UI_Focus = This.ID THEN Caption(This.ID) = TempCaption$
IF NOT This.Disabled THEN
COLOR This.ForeColor
ELSE
COLOR Darken(Control(__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, ItemHeight), This.SelectedBackColor, BF
ELSE
LINE (CaptionIndent, ThisItemTop% - 1)-STEP(This.Width - CaptionIndent * 2, ItemHeight), _RGBA32(0, 0, 0, 50), BF
END IF
END IF
SELECT CASE This.Align
CASE __UI_Left
__UI_PrintString CaptionIndent * 2, ThisItemTop% + ((ItemHeight - uspacing&) / 2), TempCaption$
CASE __UI_Center
__UI_PrintString (This.Width \ 2 - __UI_PrintWidth(TempCaption$) \ 2), ThisItemTop% + ((ItemHeight - uspacing&) / 2), TempCaption$
CASE __UI_Right
__UI_PrintString (This.Width - __UI_PrintWidth(TempCaption$)) - CaptionIndent, ThisItemTop% + ((ItemHeight - uspacing&) / 2), TempCaption$
END SELECT
END IF
LOOP
IF This.Max = 0 THEN This.Max = ThisItem%
IF This.LastVisibleItem < LastVisibleItem THEN This.LastVisibleItem = LastVisibleItem
IF This.InputViewStart > This.Max THEN This.InputViewStart = 0
IF This.Value > This.Max THEN This.Value = 0
IF This.Max > This.LastVisibleItem THEN
This.HasVScrollbar = True
__UI_DrawVScrollBar This, ControlState
ELSE
This.HasVScrollbar = False
END IF
END IF
IF This.HasBorder THEN
FOR i = 0 TO This.BorderSize - 1
LINE (i, i)-STEP(This.Width - 1 - i * 2, This.Height - 1 - i * 2), This.BorderColor, B
NEXT
END IF
'------
__UI_MakeHardwareImageFromCanvas This
_DEST PrevDest
END IF
IF This.Canvas THEN _PUTIMAGE (This.Left, This.Top), This.Canvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawVScrollBar (TempThis AS __UI_ControlTYPE, ControlState AS _BYTE)
DIM TrackHeight AS INTEGER, ThumbHeight AS INTEGER, ThumbTop AS INTEGER
DIM Ratio AS SINGLE
DIM This AS __UI_ControlTYPE
STATIC ControlImage_Button AS LONG, ControlImage_Track AS LONG
STATIC ControlImage_Thumb AS LONG
CONST ImageHeight_Button = 17
CONST ImageWidth_Button = 17
CONST ImageHeight_Thumb = 22
CONST ImageWidth_Thumb = 15
IF ControlImage_Button = 0 THEN ControlImage_Button = __UI_LoadThemeImage("scrollbuttons.png")
IF ControlImage_Track = 0 THEN ControlImage_Track = __UI_LoadThemeImage("scrolltrack.png")
IF ControlImage_Thumb = 0 THEN ControlImage_Thumb = __UI_LoadThemeImage("scrollthumb.png")
This = TempThis
_FONT This.Font
IF This.Type = __UI_Type_ListBox THEN
This.Min = 0
This.Max = This.Max - This.LastVisibleItem
This.Value = This.InputViewStart - 1
This.Left = This.Width - __UI_ScrollbarWidth - 1
This.Top = 1
This.Height = This.Height - 1
This.Width = __UI_ScrollbarWidth
ELSEIF This.Type = __UI_Type_TextBox THEN
This.Min = 0
This.Max = __UI_CountLines(This.ID) - This.Height \ uspacing&
'IF This.HasHScrollbar THEN This.Height = This.Height - __UI_ScrollbarWidth
This.Value = This.FirstVisibleLine - 1
This.Left = This.Width - __UI_ScrollbarWidth - 1
This.Top = 1
This.Height = This.Height - 1
This.Width = __UI_ScrollbarWidth
END IF
'Scrollbar measurements:
TrackHeight = This.Height - __UI_ScrollbarButtonHeight * 2 - 1
Ratio = (This.Max) / TrackHeight
ThumbHeight = TrackHeight - This.Height * Ratio
IF ThumbHeight < 22 THEN ThumbHeight = 22
IF ThumbHeight > TrackHeight THEN ThumbHeight = TrackHeight
ThumbTop = This.Top + (TrackHeight - ThumbHeight) * (This.Value / This.Max)
TempThis.ThumbTop = TempThis.Top + ThumbTop + __UI_ScrollbarButtonHeight
'Draw the bar
IF ControlState <> 4 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)
ELSE
_PUTIMAGE (This.Left, This.Top)-STEP(ImageWidth_Button - 1, This.Height - 1), ControlImage_Track, , (0, 4 * ImageHeight_Button - ImageHeight_Button)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1)
END IF
'Mousedown on the track:
IF __UI_MouseDownOnID = This.ID AND This.HoveringVScrollbarButton = 4 AND __UI_DraggingThumb = False THEN
'Above the thumb
_PUTIMAGE (This.Left, This.Top)-STEP(ImageWidth_Button - 1, ThumbTop + ThumbHeight + __UI_ScrollbarButtonHeight - 1), ControlImage_Track, , (0, 3 * ImageHeight_Button - ImageHeight_Button)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1)
ELSEIF __UI_MouseDownOnID = This.ID AND This.HoveringVScrollbarButton = 5 AND __UI_DraggingThumb = False THEN
'Below the thumb
_PUTIMAGE (This.Left, This.Top + ThumbTop + __UI_ScrollbarButtonHeight)-STEP(ImageWidth_Button - 1, This.Height - (This.Top + ThumbTop + __UI_ScrollbarButtonHeight) - 1), ControlImage_Track, , (0, 3 * ImageHeight_Button - ImageHeight_Button)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1)
END IF
'Draw buttons
IF ControlState = 4 THEN
_PUTIMAGE (This.Left, This.Top)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1), ControlImage_Button, , (0, 4 * ImageHeight_Button - ImageHeight_Button)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1)
ELSEIF This.HoveringVScrollbarButton = 1 AND __UI_MouseDownOnID = This.ID THEN
_PUTIMAGE (This.Left, This.Top)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1), ControlImage_Button, , (0, 3 * ImageHeight_Button - ImageHeight_Button)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1)
ELSEIF This.HoveringVScrollbarButton = 1 THEN
_PUTIMAGE (This.Left, This.Top)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1), ControlImage_Button, , (0, 2 * ImageHeight_Button - ImageHeight_Button)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1)
ELSE
_PUTIMAGE (This.Left, This.Top)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1), ControlImage_Button, , (0, 1 * ImageHeight_Button - ImageHeight_Button)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1)
END IF
IF ControlState = 4 THEN
_PUTIMAGE (This.Left, This.Top + This.Height - ImageHeight_Button - 1)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1), ControlImage_Button, , (0, 8 * ImageHeight_Button - ImageHeight_Button)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1)
ELSEIF This.HoveringVScrollbarButton = 2 AND __UI_MouseDownOnID = This.ID THEN
_PUTIMAGE (This.Left, This.Top + This.Height - ImageHeight_Button - 1)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1), ControlImage_Button, , (0, 7 * ImageHeight_Button - ImageHeight_Button)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1)
ELSEIF This.HoveringVScrollbarButton = 2 THEN
_PUTIMAGE (This.Left, This.Top + This.Height - ImageHeight_Button - 1)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1), ControlImage_Button, , (0, 6 * ImageHeight_Button - ImageHeight_Button)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1)
ELSE
_PUTIMAGE (This.Left, This.Top + This.Height - ImageHeight_Button - 1)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1), ControlImage_Button, , (0, 5 * ImageHeight_Button - ImageHeight_Button)-STEP(ImageWidth_Button - 1, ImageHeight_Button - 1)
END IF
'Draw thumb
IF ControlState = 4 THEN
'No thumb is shown for disabled scrollbar
ELSEIF __UI_DraggingThumb = True THEN
_PUTIMAGE (This.Left + 1, ThumbTop + __UI_ScrollbarButtonHeight)-STEP(ImageWidth_Thumb - 2, ThumbHeight - 1), ControlImage_Thumb, , (0, 3 * ImageHeight_Thumb - ImageHeight_Thumb + 2)-STEP(ImageWidth_Thumb - 1, ImageHeight_Thumb - 5)
_PUTIMAGE (This.Left + 1, ThumbTop + __UI_ScrollbarButtonHeight)-STEP(ImageWidth_Thumb - 2, 1), ControlImage_Thumb, , (0, 3 * ImageHeight_Thumb - ImageHeight_Thumb)-STEP(ImageWidth_Thumb - 1, 1)
_PUTIMAGE (This.Left + 1, ThumbTop + __UI_ScrollbarButtonHeight + ThumbHeight - 2)-STEP(ImageWidth_Thumb - 2, 1), ControlImage_Thumb, , (0, 3 * ImageHeight_Thumb - 4)-STEP(ImageWidth_Thumb - 1, 3)
ELSEIF This.HoveringVScrollbarButton = 3 AND __UI_DraggingThumb = False THEN
_PUTIMAGE (This.Left + 1, ThumbTop + __UI_ScrollbarButtonHeight)-STEP(ImageWidth_Thumb - 2, ThumbHeight - 1), ControlImage_Thumb, , (0, 2 * ImageHeight_Thumb - ImageHeight_Thumb + 2)-STEP(ImageWidth_Thumb - 1, ImageHeight_Thumb - 5)
_PUTIMAGE (This.Left + 1, ThumbTop + __UI_ScrollbarButtonHeight)-STEP(ImageWidth_Thumb - 2, 1), ControlImage_Thumb, , (0, 2 * ImageHeight_Thumb - ImageHeight_Thumb)-STEP(ImageWidth_Thumb - 1, 1)
_PUTIMAGE (This.Left + 1, ThumbTop + __UI_ScrollbarButtonHeight + ThumbHeight - 2)-STEP(ImageWidth_Thumb - 2, 1), ControlImage_Thumb, , (0, 2 * ImageHeight_Thumb - 4)-STEP(ImageWidth_Thumb - 1, 3)
ELSE
_PUTIMAGE (This.Left + 1, ThumbTop + __UI_ScrollbarButtonHeight)-STEP(ImageWidth_Thumb - 2, ThumbHeight - 1), ControlImage_Thumb, , (0, 1 * ImageHeight_Thumb - ImageHeight_Thumb + 2)-STEP(ImageWidth_Thumb - 1, ImageHeight_Thumb - 5)
_PUTIMAGE (This.Left + 1, ThumbTop + __UI_ScrollbarButtonHeight)-STEP(ImageWidth_Thumb - 2, 1), ControlImage_Thumb, , (0, 1 * ImageHeight_Thumb - ImageHeight_Thumb)-STEP(ImageWidth_Thumb - 1, 1)
_PUTIMAGE (This.Left + 1, ThumbTop + __UI_ScrollbarButtonHeight + ThumbHeight - 2)-STEP(ImageWidth_Thumb - 2, 1), ControlImage_Thumb, , (0, 1 * ImageHeight_Thumb - 4)-STEP(ImageWidth_Thumb - 1, 3)
END IF
'Pass scrollbar parameters back to caller ID
TempThis.VScrollbarButton2Top = This.Top + This.Height - ImageHeight_Button - 1
TempThis.ThumbHeight = ThumbHeight
TempThis.VScrollbarRatio = Ratio
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawDropdownList (This AS __UI_ControlTYPE, ControlState)
DIM PrevDest AS LONG, i AS LONG
DIM CaptionIndent AS INTEGER, TempCaption$
STATIC ControlImage AS LONG
STATIC ControlImage_Arrow AS LONG
CONST ButtonHeight = 21
CONST ButtonWidth = 18
CONST ArrowWidth = 9
CONST ArrowHeight = 9
IF ControlImage = 0 THEN ControlImage = __UI_LoadThemeImage("button.png")
IF ControlImage_Arrow = 0 THEN
ControlImage_Arrow = __UI_LoadThemeImage("arrows.png")
__UI_ClearColor ControlImage_Arrow, 0, 0
END IF
IF This.Redraw OR This.ControlState <> ControlState OR _
This.FocusState <> (__UI_Focus = This.ID) OR _
This.PreviousValue <> This.Value OR _
Text(This.ID) <> __UI_TempTexts(This.ID) OR _
This.PreviousInputViewStart <> This.InputViewStart OR _
This.PreviousParentID <> This.ParentID OR _
This.PreviousFont <> This.Font OR _
__UI_ForceRedraw THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.Redraw = False
This.ControlState = ControlState
This.PreviousFont = This.Font
This.FocusState = __UI_Focus = This.ID
IF This.PreviousValue <> This.Value THEN
__UI_StateHasChanged = True
This.PreviousValue = This.Value
END IF
This.PreviousInputViewStart = This.InputViewStart
__UI_TempTexts(This.ID) = Text(This.ID)
IF This.ParentID THEN Control(This.ParentID).ChildrenRedrawn = True
This.PreviousParentID = This.ParentID
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
END IF
This.Canvas = _NEWIMAGE(This.Width, This.Height, 32)
PrevDest = _DEST
_DEST This.Canvas
_FONT This.Font
'------
IF This.BackStyle = __UI_Opaque THEN
CLS , This.BackColor
ELSE
CLS , _RGBA32(0, 0, 0, 0)
END IF
IF This.HasBorder THEN
IF This.BorderSize > __UI_MaxBorderSize THEN
This.BorderSize = __UI_MaxBorderSize
ELSEIF This.BorderSize < 1 THEN
This.BorderSize = 1
END IF
CaptionIndent = __UI_DefaultCaptionIndent + This.BorderSize
FOR i = 0 TO This.BorderSize - 1
LINE (i, i)-STEP(This.Width - 1 - i * 2, This.Height - 1 - i * 2), This.BorderColor, B
NEXT
END IF
DIM TempText$, ThisItem%, FindLF&, ThisItemTop%
IF This.Value > 0 THEN
IF LEN(Text(This.ID)) THEN
TempText$ = Text(This.ID)
ThisItem% = 0
DO WHILE LEN(TempText$)
ThisItem% = ThisItem% + 1
FindLF& = INSTR(TempText$, CHR$(10))
IF FindLF& THEN
TempCaption$ = LEFT$(TempText$, FindLF& - 1)
TempText$ = MID$(TempText$, FindLF& + 1)
ELSE
TempCaption$ = TempText$
TempText$ = ""
END IF
IF ThisItem% = This.Value THEN
ThisItemTop% = This.Height \ 2 - uspacing& \ 2 + 1
IF ThisItem% = This.Value AND __UI_Focus = This.ID THEN Caption(This.ID) = TempCaption$
IF NOT This.Disabled THEN
COLOR This.ForeColor
ELSE
COLOR Darken(Control(__UI_FormID).BackColor, 80)
END IF
IF __UI_Focus = This.ID THEN
COLOR 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
__UI_PrintString CaptionIndent * 2, ThisItemTop%, TempCaption$
CASE __UI_Center
__UI_PrintString (This.Width \ 2 - __UI_PrintWidth(TempCaption$) \ 2), ThisItemTop%, TempCaption$
CASE __UI_Right
__UI_PrintString (This.Width - __UI_PrintWidth(TempCaption$)) - CaptionIndent, ThisItemTop%, TempCaption$
END SELECT
EXIT DO
END IF
LOOP
END IF
END IF
'Draw "dropdown" button
DIM DropdownState AS _BYTE
IF __UI_TotalActiveMenus > 0 AND __UI_ParentDropdownList = This.ID THEN
DropdownState = 3
ELSEIF (This.ID = __UI_HoveringID OR This.ID = __UI_ParentDropdownList) AND NOT This.Disabled THEN
DropdownState = 2
ELSEIF This.Disabled = True THEN
DropdownState = 4
ELSE
DropdownState = 1
END IF
'Back surface
_PUTIMAGE (This.Width - (__UI_ScrollbarWidth + 2), 3)-(This.Width - 1, This.Height - 4), ControlImage, , (3, DropdownState * ButtonHeight - ButtonHeight + 3)-STEP(11, ButtonHeight - 7)
'Top and bottom edges
_PUTIMAGE (This.Width - (__UI_ScrollbarWidth + 1), 0)-STEP(__UI_ScrollbarWidth - 2, 3), ControlImage, , (3, DropdownState * ButtonHeight - ButtonHeight)-STEP(11, 3)
_PUTIMAGE (This.Width - (__UI_ScrollbarWidth + 1), This.Height - 3)-STEP(__UI_ScrollbarWidth - 2, 3), ControlImage, , (3, DropdownState * ButtonHeight - ButtonHeight + 18)-STEP(11, 3)
'Left edges and corners:
_PUTIMAGE (This.Width - (__UI_ScrollbarWidth + 2), 2)-STEP(2, This.Height - 4), ControlImage, , (0, DropdownState * ButtonHeight - ButtonHeight + 2)-STEP(2, ButtonHeight - 6)
_PUTIMAGE (This.Width - (__UI_ScrollbarWidth + 2), 0), ControlImage, , (0, DropdownState * ButtonHeight - ButtonHeight)-STEP(2, 2)
_PUTIMAGE (This.Width - (__UI_ScrollbarWidth + 2), This.Height - 3), ControlImage, , (0, DropdownState * ButtonHeight - 3)-STEP(2, 2)
'Right edges and corners:
_PUTIMAGE (This.Width - 3, 2)-STEP(2, This.Height - 4), ControlImage, , (ButtonWidth - 3, DropdownState * ButtonHeight - ButtonHeight + 2)-STEP(2, ButtonHeight - 6)
_PUTIMAGE (This.Width - 2, 0), ControlImage, , (ButtonWidth - 2, DropdownState * ButtonHeight - ButtonHeight)-STEP(2, 2)
_PUTIMAGE (This.Width - 3, This.Height - 3), ControlImage, , (ButtonWidth - 3, DropdownState * ButtonHeight - 3)-STEP(2, 2)
'Arrow
_PUTIMAGE (This.Width - 1 - (__UI_ScrollbarWidth / 2) - ArrowWidth / 2, This.Height / 2 - ArrowHeight / 2), ControlImage_Arrow, , (0, (DropdownState + 4) * ArrowHeight - ArrowHeight)-STEP(ArrowWidth - 1, ArrowHeight - 1)
'------
__UI_MakeHardwareImageFromCanvas This
_DEST PrevDest
END IF
IF This.Canvas THEN _PUTIMAGE (This.Left, This.Top), This.Canvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawFrame (This AS __UI_ControlTYPE)
DIM TempCaption$, CaptionIndent AS INTEGER, Temp&
DIM TempCanvas AS LONG
STATIC ControlImage AS LONG
IF ControlImage = 0 THEN
ControlImage = __UI_LoadThemeImage("frame.png")
__UI_ClearColor ControlImage, 0, 0
END IF
IF This.Redraw OR This.PreviouslyHidden <> This.Hidden OR This.ChildrenRedrawn OR Caption(This.ID) <> __UI_TempCaptions(This.ID) OR This.HelperCanvas = 0 OR (__UI_IsDragging AND Control(__UI_DraggingID).ParentID = This.ID) OR This.Value <> This.PreviousValue OR __UI_ForceRedraw _
OR __UI_DesignMode OR This.PreviousFont <> This.Font THEN
'Last time we drew this frame its children had different images
This.Redraw = False
This.ChildrenRedrawn = False
This.PreviousFont = This.Font
This.PreviousValue = This.Value
This.PreviouslyHidden = This.Hidden
__UI_TempCaptions(This.ID) = Caption(This.ID)
_FONT This.Font
TempCanvas = _NEWIMAGE(This.Width, This.Height + uspacing& \ 2, 32)
_DEST TempCanvas
_FONT This.Font
'------
IF LEN(Caption(This.ID)) > 0 THEN TempCaption$ = " " + __UI_TrimAt0$(Caption(This.ID)) + " "
_FONT This.Font
IF This.Hidden = False THEN
IF This.BackStyle = __UI_Opaque THEN
CLS , This.BackColor
ELSE
CLS , _RGBA32(0, 0, 0, 0)
END IF
CaptionIndent = 0
IF This.HasBorder THEN CaptionIndent = 5
IF NOT This.Disabled THEN
COLOR This.ForeColor
ELSE
COLOR Darken(Control(__UI_FormID).BackColor, 80)
END IF
'This.Canvas holds the children controls' images
_PUTIMAGE (CaptionIndent, CaptionIndent + uspacing& \ 2), This.Canvas, TempCanvas, (CaptionIndent, CaptionIndent)-(This.Width, This.Height)
IF This.HasBorder THEN
'Four corners;
_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, 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, 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
IF LEN(TempCaption$) > 0 THEN
SELECT CASE This.Align
CASE __UI_Left
CaptionLeft = CaptionIndent
CASE __UI_Center
CaptionLeft = (This.Width \ 2 - __UI_PrintWidth(TempCaption$) \ 2)
CASE __UI_Right
CaptionLeft = (This.Width - __UI_PrintWidth(TempCaption$)) - CaptionIndent
END SELECT
LINE (CaptionLeft, 0)-STEP(__UI_PrintWidth(TempCaption$), uspacing&), This.BackColor, BF
__UI_PrintString CaptionLeft, 0, TempCaption$
'Hot key:
IF (This.HotKey > 0 AND (__UI_ShowHotKeys AND NOT This.Disabled)) OR (This.HotKey > 0 AND __UI_DesignMode) THEN
Temp& = __UI_PrintWidth(CHR$(This.HotKey))
LINE (CaptionLeft + Temp& + This.HotKeyOffset, _ufontheight)-STEP(Temp& - 1, 0), This.ForeColor
END IF
END IF
END IF
'------
__UI_MakeHardwareImage TempCanvas
IF This.HelperCanvas <> 0 THEN _FREEIMAGE This.HelperCanvas
This.HelperCanvas = TempCanvas
_DEST 0
END IF
_FONT This.Font
IF This.HelperCanvas < -1 THEN _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, TempCaption$
DIM Temp&
IF This.Redraw OR This.FocusState <> (__UI_Focus = This.ID) OR This.Value <> This.PreviousValue OR This.ControlState <> ControlState OR Caption(This.ID) <> __UI_TempCaptions(This.ID) _
OR __UI_ForceRedraw OR This.PreviousFont <> This.Font THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.Redraw = False
This.ControlState = ControlState
This.PreviousFont = This.Font
This.PreviousValue = This.Value
IF Caption(This.ID) <> __UI_TempCaptions(This.ID) THEN
__UI_RefreshMenuBar
END IF
__UI_TempCaptions(This.ID) = Caption(This.ID)
This.FocusState = (__UI_Focus = This.ID)
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
END IF
This.Canvas = _NEWIMAGE(This.Width, This.Height, 32)
PrevDest = _DEST
_DEST This.Canvas
_FONT (This.Font)
'---
CLS , This.BackColor
TempCaption$ = __UI_TrimAt0$(Caption(This.ID))
IF __UI_Focus = This.ID OR _
(__UI_ParentMenu(__UI_TotalActiveMenus) = This.ID AND (Control(__UI_Focus).Type = __UI_Type_MenuPanel OR Control(__UI_Focus).Type = __UI_Type_MenuItem)) OR _
(__UI_HoveringID = This.ID AND (Control(__UI_Focus).Type <> __UI_Type_MenuPanel AND Control(__UI_Focus).Type <> __UI_Type_MenuBar AND Control(__UI_Focus).Type <> __UI_Type_MenuItem)) THEN
LINE (0, 0)-STEP(This.Width - 1, This.Height - 1), This.SelectedBackColor, BF
COLOR This.SelectedForeColor
ELSE
COLOR This.ForeColor
END IF
IF This.Disabled THEN
COLOR Darken(Control(__UI_FormID).BackColor, 80)
END IF
__UI_PrintString __UI_MenuBarOffset, ((This.Height \ 2) - (_ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset)) \ 2), TempCaption$
IF This.HotKey > 0 AND (__UI_AltIsDown OR Control(__UI_Focus).Type = __UI_Type_MenuBar OR __UI_DesignMode) THEN
'Has "hot-key"
Temp& = __UI_PrintWidth(CHR$(This.HotKey))
LINE (__UI_MenuBarOffset + This.HotKeyOffset, ((This.Height \ 2) + (_ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset)) \ 2) - 1)-STEP(Temp& - 1, 0), _DEFAULTCOLOR
END IF
IF __UI_DesignMode THEN
IF This.Left + This.Width = __UI_NewMenuBarTextLeft THEN
'Last menu bar item. Next is "Add new"
_DEST Control(__UI_FormID).Canvas
COLOR Darken(Control(__UI_FormID).BackColor, 80)
_FONT (This.Font)
LINE (__UI_NewMenuBarTextLeft + __UI_MenuBarOffset, ((This.Height \ 2) - (_ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset)) \ 2))-STEP(__UI_PrintWidth("Add new"),(_ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset))), Control(__UI_FormID).BackColor, BF
__UI_PrintString __UI_NewMenuBarTextLeft + __UI_MenuBarOffset, ((This.Height \ 2) - (_ulinespacing + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset)) \ 2), "Add new"
END IF
END IF
'---
__UI_MakeHardwareImageFromCanvas This
_DEST PrevDest
END IF
IF This.Canvas THEN _PUTIMAGE (This.Left, This.Top), This.Canvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawMenuPanel (This AS __UI_ControlTYPE, Parent AS LONG)
DIM PrevDest AS LONG, TempCaption$
DIM Temp&
DIM CheckMarkIndex AS _BYTE
STATIC ControlImage AS LONG, SubMenuArrow AS LONG
CONST CheckMarkWidth = 7
CONST CheckMarkHeight = 7
IF ControlImage = 0 THEN
ControlImage = __UI_LoadThemeImage("menucheckmark.bmp")
__UI_ClearColor ControlImage, 0, 0
END IF
IF SubMenuArrow = 0 THEN
SubMenuArrow = _NEWIMAGE(4, 7, 32)
PrevDest = _DEST
_DEST SubMenuArrow
LINE (0, 0)-(3, 3), _RGB32(0, 0, 0)
LINE -(0, 6), _RGB32(0, 0, 0)
LINE -(0, 0), _RGB32(0, 0, 0)
PAINT (2, 3), _RGB32(0, 0, 0)
_DEST PrevDest
END IF
IF This.Redraw OR This.Value <> This.PreviousValue OR This.FocusState <> (__UI_Focus = This.ID) _
OR __UI_ForceRedraw OR This.PreviousFont <> This.Font THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.Redraw = False
This.FocusState = (__UI_Focus = This.ID)
This.PreviousFont = This.Font
This.PreviousValue = This.Value
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
END IF
This.Canvas = _NEWIMAGE(This.Width + 5, This.Height + 5, 32)
PrevDest = _DEST
_DEST This.Canvas
_FONT (This.Font)
'---
COLOR , _RGBA32(0, 0, 0, 0)
CLS
'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, HasSeparator as _BYTE
FOR i = 1 TO UBOUND(Control)
IF Control(i).Type = __UI_Type_MenuItem AND NOT Control(i).Hidden AND Control(i).ParentID = Parent THEN
TempCaption$ = __UI_TrimAt0$(Caption(i))
IF RIGHT$(TempCaption$, 1) = "-" THEN
HasSeparator = True
TempCaption$ = LEFT$(TempCaption$, LEN(TempCaption$) - 1)
ELSE
HasSeparator = False
END IF
IF __UI_Focus = i OR (__UI_HoveringID = i AND __UI_Focus = i) THEN
LINE (3, Control(i).Top)-STEP(This.Width - 7, Control(i).Height - 1), This.SelectedBackColor, BF
COLOR This.SelectedForeColor
CheckMarkIndex = 2
ELSE
COLOR This.ForeColor
CheckMarkIndex = 1
END IF
IF Control(i).Disabled THEN
COLOR Darken(Control(__UI_FormID).BackColor, 80)
CheckMarkIndex = 3
END IF
__UI_PrintString Control(i).Left + __UI_MenuItemOffset, Control(i).Top + Control(i).Height \ 2 - _ufontheight \ 2, TempCaption$
IF Control(i).KeyCombo > 0 THEN
__UI_PrintString Control(i).Left + This.Width - __UI_MenuItemOffset - __UI_PrintWidth(RTRIM$(__UI_KeyCombo(Control(i).KeyCombo).FriendlyCombo)), Control(i).Top + Control(i).Height \ 2 - _ufontheight \ 2, RTRIM$(__UI_KeyCombo(Control(i).KeyCombo).FriendlyCombo)
END IF
IF Control(i).SubMenu THEN
_PUTIMAGE (This.Width - __UI_MenuItemOffset / 2, Control(i).Top + Control(i).Height / 2 - 3), SubMenuArrow
END IF
IF Control(i).HotKey > 0 THEN
'Has "hot-key"
Temp& = __UI_PrintWidth(CHR$(Control(i).HotKey))
LINE (Control(i).Left + __UI_MenuItemOffset + Control(i).HotKeyOffset, Control(i).Top + Control(i).Height \ 2 + _ufontheight \ 2 - 1)-STEP(Temp& - 1, 0), _DEFAULTCOLOR
END IF
IF Control(i).Value = True THEN
'Checked menu item
IF Control(i).BulletStyle = __UI_Bullet%% THEN
__UI_PrintString __UI_MenuItemOffset \ 2 - __UI_PrintWidth(CHR$(7)) \ 2, Control(i).Top + Control(i).Height \ 2 - _ufontheight \ 2, CHR$(7)
ELSE
_PUTIMAGE (__UI_MenuItemOffset \ 2 - CheckMarkWidth \ 2, Control(i).Top + Control(i).Height \ 2 - CheckMarkHeight \ 2), ControlImage, , (0, CheckMarkIndex * CheckMarkHeight - CheckMarkHeight)-STEP(6, 6)
END IF
ELSE
'Does this menu item have a helper canvas (icon)?
DIM IconWidth AS INTEGER, IconHeight AS INTEGER
IF Control(i).HelperCanvas < -1 THEN
IF _HEIGHT(Control(i).HelperCanvas) = 16 AND _WIDTH(Control(i).HelperCanvas) MOD 16 = 0 THEN
'If the HelperCanvas is 16px in height and either 16, 32 or 48px in width,
'we assume that we have icons for Hover and Disabled states.
SELECT CASE CheckMarkIndex
CASE 1 'normal
_PUTIMAGE(3, Control(i).Top + Control(i).Height / 2 - 8)-STEP(15, 15), Control(i).HelperCanvas, ,(0, 0)-STEP(15, 15)
CASE 2 'hovered/selected
IF _WIDTH(Control(i).HelperCanvas) >= 32 THEN
_PUTIMAGE(3, Control(i).Top + Control(i).Height / 2 - 8)-STEP(15, 15), Control(i).HelperCanvas, ,(16, 0)-STEP(15, 15)
ELSE
_PUTIMAGE(3, Control(i).Top + Control(i).Height / 2 - 8)-STEP(15, 15), Control(i).HelperCanvas, ,(0, 0)-STEP(15, 15)
END IF
CASE 3 'disabled
IF _WIDTH(Control(i).HelperCanvas) >= 48 THEN
_PUTIMAGE(3, Control(i).Top + Control(i).Height / 2 - 8)-STEP(15, 15), Control(i).HelperCanvas, ,(32, 0)-STEP(15, 15)
ELSE
_PUTIMAGE(3, Control(i).Top + Control(i).Height / 2 - 8)-STEP(15, 15), Control(i).HelperCanvas, ,(0, 0)-STEP(15, 15)
END IF
END SELECT
ELSE
'Icon will be to the left of caption
IconHeight = 16
IconWidth = _WIDTH(Control(i).HelperCanvas) * IconHeight / _HEIGHT(Control(i).HelperCanvas)
_PUTIMAGE (3, Control(i).Top + Control(i).Height / 2 - IconHeight / 2)-STEP(IconWidth - 1, IconHeight - 1), Control(i).HelperCanvas
END IF
END IF
END IF
IF HasSeparator THEN
LINE (4, Control(i).Top + Control(i).Height + 3)-STEP(This.Width - 9, 0), This.BorderColor
END IF
END IF
NEXT
IF __UI_DesignMode AND LEFT$(This.Name, 5) <> "__UI_" THEN
COLOR Darken(Control(__UI_FormID).BackColor, 80)
__UI_PrintString __UI_MenuItemOffset, This.Height - (_ufontheight + 6), "Add new"
END IF
'---
__UI_MakeHardwareImageFromCanvas This
_DEST PrevDest
END IF
IF This.Canvas THEN _PUTIMAGE (This.Left, This.Top), This.Canvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawContextMenuHandle (This AS __UI_ControlTYPE, ControlState AS _BYTE)
DIM PrevDest AS LONG
DIM i AS LONG
IF This.Redraw OR Control(__UI_FormID).Height <> This.PreviousValue OR This.ControlState <> ControlState OR __UI_ForceRedraw THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.Redraw = False
This.ControlState = ControlState
This.PreviousValue = Control(__UI_FormID).Height
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
END IF
This.Canvas = _NEWIMAGE(This.Width, This.Height, 32)
This.Top = Control(__UI_FormID).Height - This.Height - __UI_SnapDistanceFromForm
PrevDest = _DEST
_DEST This.Canvas
_FONT This.Font
'------
SELECT CASE This.ControlState
'1 = Normal; 2 = Hover/focus; 3 = Mouse down; 4 = Disabled;
CASE 1
COLOR This.SelectedBackColor, This.SelectedForeColor
CASE 2
COLOR This.SelectedForeColor, This.SelectedBackColor
END SELECT
CLS
IF This.HelperCanvas < -1 THEN
_PUTIMAGE ((_WIDTH - _WIDTH(This.HelperCanvas)) / 2, (_HEIGHT - _HEIGHT(This.HelperCanvas)) / 2), This.HelperCanvas
END IF
i = 0
LINE (i, i)-STEP(This.Width - 1 - i * 2, This.Height - 1 - i * 2), This.BorderColor, B
'------
__UI_MakeHardwareImageFromCanvas This
_DEST PrevDest
END IF
IF This.Canvas THEN _PUTIMAGE (This.Left, This.Top), This.Canvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_DrawPictureBox (This AS __UI_ControlTYPE, ControlState AS _BYTE)
DIM PrevDest AS LONG, TheX AS INTEGER, TheY AS INTEGER
DIM i AS LONG
IF This.Redraw OR This.Stretch <> This.PreviousStretch OR This.PreviousValue <> This.HelperCanvas OR This.ControlState <> ControlState OR This.PreviousParentID <> This.ParentID _
OR __UI_ForceRedraw OR This.PreviousFont <> This.Font THEN
'Last time this control was drawn it had a different state/caption, so it'll be redrawn
This.Redraw = False
This.ControlState = ControlState
This.PreviousFont = This.Font
IF This.ParentID THEN Control(This.ParentID).ChildrenRedrawn = True
This.PreviousParentID = This.ParentID
This.PreviousValue = This.HelperCanvas
This.PreviousStretch = This.Stretch
IF This.Canvas <> 0 THEN
_FREEIMAGE This.Canvas
END IF
This.Canvas = _NEWIMAGE(This.Width, This.Height, 32)
PrevDest = _DEST
_DEST This.Canvas
'------
IF This.BackStyle = __UI_Opaque THEN
CLS , This.BackColor
ELSE
CLS , _RGBA32(0, 0, 0, 0)
END IF
IF This.HasBorder THEN
IF This.BorderSize > __UI_MaxBorderSize THEN
This.BorderSize = __UI_MaxBorderSize
ELSEIF This.BorderSize < 1 THEN
This.BorderSize = 1
END IF
END IF
IF This.Stretch THEN
_PUTIMAGE (This.BorderSize * ABS(This.HasBorder), This.BorderSize * ABS(This.HasBorder))-(This.Width - (This.BorderSize * ABS(This.HasBorder) + 1), This.Height - (This.BorderSize * ABS(This.HasBorder) + 1)), This.HelperCanvas, This.Canvas
ELSE
TheX = This.BorderSize * ABS(This.HasBorder) 'Default = Left
IF This.Align = __UI_Center THEN TheX = This.Width / 2 - _WIDTH(This.HelperCanvas) / 2
IF This.Align = __UI_Right THEN TheX = This.Width - 1 - _WIDTH(This.HelperCanvas) - (This.BorderSize * ABS(This.HasBorder))
TheY = This.BorderSize * ABS(This.HasBorder) 'Default = Top
IF This.VAlign = __UI_Middle THEN TheY = This.Height / 2 - _HEIGHT(This.HelperCanvas) / 2
IF This.VAlign = __UI_Bottom THEN TheY = This.Height - 1 - _HEIGHT(This.HelperCanvas) - (This.BorderSize * ABS(This.HasBorder))
_PUTIMAGE (TheX, TheY), This.HelperCanvas, This.Canvas
END IF
IF This.HasBorder THEN
FOR i = 0 TO This.BorderSize - 1
LINE (i, i)-STEP(This.Width - 1 - i * 2, This.Height - 1 - i * 2), This.BorderColor, B
NEXT
END IF
'------
__UI_MakeHardwareImageFromCanvas This
_DEST PrevDest
END IF
IF This.Canvas THEN _PUTIMAGE (This.Left, This.Top), This.Canvas
END SUB
'---------------------------------------------------------------------------------
SUB __UI_ShadowBox (bX AS INTEGER, bY AS INTEGER, bW AS INTEGER, bH AS INTEGER, C AS LONG, shadowLevel AS INTEGER, shadowSize AS INTEGER)
DIM i AS INTEGER
FOR i = 1 TO shadowSize
LINE (bX + i, bY + i)-STEP(bW, bH), _RGBA32(0, 0, 0, shadowLevel - (shadowLevel / shadowSize) * i), BF
NEXT i
LINE (bX, bY)-STEP(bW, bH), C, BF
END SUB