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

Change keyword case to mixed

This commit is contained in:
Samuel Gomes 2023-05-09 03:00:44 +05:30
parent 8a7f850c93
commit 7305a3ecca
10 changed files with 6665 additions and 6665 deletions

View file

@ -1,235 +1,235 @@
'InForm - GUI library for QB64 'InForm - GUI library for QB64
'Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor 'Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
' '
DECLARE CUSTOMTYPE LIBRARY Declare CustomType Library
FUNCTION __UI_GetPID ALIAS getpid () Function __UI_GetPID Alias getpid ()
SUB __UI_MemCopy ALIAS memcpy (BYVAL dest AS _OFFSET, BYVAL source AS _OFFSET, BYVAL bytes AS LONG) Sub __UI_MemCopy Alias memcpy (ByVal dest As _Offset, Byval source As _Offset, Byval bytes As Long)
END DECLARE End Declare
$IF WIN THEN $If WIN Then
DECLARE LIBRARY Declare Library
FUNCTION GetSystemMetrics& (BYVAL WhichMetric&) Function GetSystemMetrics& (ByVal WhichMetric&)
END DECLARE End Declare
CONST __UI_SM_SWAPBUTTON = 23 Const __UI_SM_SWAPBUTTON = 23
$END IF $End If
$SCREENHIDE $ScreenHide
_CONTROLCHR OFF _ControlChr Off
TYPE __UI_ControlTYPE Type __UI_ControlTYPE
ID AS LONG ID As Long
ParentID AS LONG ParentID As Long
PreviousParentID AS LONG PreviousParentID As Long
ContextMenuID AS LONG ContextMenuID As Long
Type AS INTEGER Type As Integer
Name AS STRING * 40 Name As String * 40
ParentName AS STRING * 40 ParentName As String * 40
SubMenu AS _BYTE SubMenu As _Byte
MenuPanelID AS LONG MenuPanelID As Long
SourceControl AS LONG SourceControl As Long
Top AS INTEGER Top As Integer
Left AS INTEGER Left As Integer
Width AS INTEGER Width As Integer
Height AS INTEGER Height As Integer
Canvas AS LONG Canvas As Long
HelperCanvas AS LONG HelperCanvas As Long
TransparentColor AS _UNSIGNED LONG TransparentColor As _Unsigned Long
Stretch AS _BYTE Stretch As _Byte
PreviousStretch AS _BYTE PreviousStretch As _Byte
Font AS INTEGER Font As Integer
PreviousFont AS INTEGER PreviousFont As Integer
BackColor AS _UNSIGNED LONG BackColor As _Unsigned Long
ForeColor AS _UNSIGNED LONG ForeColor As _Unsigned Long
SelectedForeColor AS _UNSIGNED LONG SelectedForeColor As _Unsigned Long
SelectedBackColor AS _UNSIGNED LONG SelectedBackColor As _Unsigned Long
BackStyle AS _BYTE BackStyle As _Byte
HasBorder AS _BYTE HasBorder As _Byte
BorderSize AS INTEGER BorderSize As Integer
Padding AS INTEGER Padding As Integer
Encoding AS LONG Encoding As Long
Align AS _BYTE Align As _Byte
PrevAlign AS _BYTE PrevAlign As _Byte
VAlign AS _BYTE VAlign As _Byte
PrevVAlign AS _BYTE PrevVAlign As _Byte
BorderColor AS _UNSIGNED LONG BorderColor As _Unsigned Long
Value AS _FLOAT Value As _Float
PreviousValue AS _FLOAT PreviousValue As _Float
Min AS _FLOAT Min As _Float
PrevMin AS _FLOAT PrevMin As _Float
Max AS _FLOAT Max As _Float
PrevMax AS _FLOAT PrevMax As _Float
Interval AS _FLOAT Interval As _Float
PrevInterval AS _FLOAT PrevInterval As _Float
MinInterval AS _FLOAT MinInterval As _Float
PrevMinInterval AS _FLOAT PrevMinInterval As _Float
HotKey AS INTEGER HotKey As Integer
HotKeyOffset AS INTEGER HotKeyOffset As Integer
HotKeyPosition AS INTEGER HotKeyPosition As Integer
ShowPercentage AS _BYTE ShowPercentage As _Byte
AutoScroll AS _BYTE AutoScroll As _Byte
AutoSize AS _BYTE AutoSize As _Byte
InputViewStart AS LONG InputViewStart As Long
PreviousInputViewStart AS LONG PreviousInputViewStart As Long
LastVisibleItem AS INTEGER LastVisibleItem As Integer
ItemHeight AS INTEGER ItemHeight As Integer
HasVScrollbar AS _BYTE HasVScrollbar As _Byte
VScrollbarButton2Top AS INTEGER VScrollbarButton2Top As Integer
HoveringVScrollbarButton AS _BYTE HoveringVScrollbarButton As _Byte
ThumbHeight AS INTEGER ThumbHeight As Integer
ThumbTop AS INTEGER ThumbTop As Integer
VScrollbarRatio AS SINGLE VScrollbarRatio As Single
Cursor AS LONG Cursor As Long
PasswordField AS _BYTE PasswordField As _Byte
PrevCursor AS LONG PrevCursor As Long
FieldArea AS LONG FieldArea As Long
PreviousFieldArea AS LONG PreviousFieldArea As Long
TextIsSelected AS _BYTE TextIsSelected As _Byte
BypassSelectOnFocus AS _BYTE BypassSelectOnFocus As _Byte
Multiline AS _BYTE Multiline As _Byte
NumericOnly AS _BYTE NumericOnly As _Byte
FirstVisibleLine AS LONG FirstVisibleLine As Long
PrevFirstVisibleLine AS LONG PrevFirstVisibleLine As Long
CurrentLine AS LONG CurrentLine As Long
PrevCurrentLine AS LONG PrevCurrentLine As Long
VisibleCursor AS LONG VisibleCursor As Long
PrevVisibleCursor AS LONG PrevVisibleCursor As Long
ControlIsSelected AS _BYTE ControlIsSelected As _Byte
LeftOffsetFromFirstSelected AS INTEGER LeftOffsetFromFirstSelected As Integer
TopOffsetFromFirstSelected AS INTEGER TopOffsetFromFirstSelected As Integer
SelectionLength AS LONG SelectionLength As Long
SelectionStart AS LONG SelectionStart As Long
WordWrap AS _BYTE WordWrap As _Byte
CanResize AS _BYTE CanResize As _Byte
CanHaveFocus AS _BYTE CanHaveFocus As _Byte
Disabled AS _BYTE Disabled As _Byte
Hidden AS _BYTE Hidden As _Byte
PreviouslyHidden AS _BYTE PreviouslyHidden As _Byte
CenteredWindow AS _BYTE CenteredWindow As _Byte
ControlState AS _BYTE ControlState As _Byte
ChildrenRedrawn AS _BYTE ChildrenRedrawn As _Byte
FocusState AS LONG FocusState As Long
LastChange AS SINGLE LastChange As Single
Redraw AS _BYTE Redraw As _Byte
BulletStyle AS _BYTE BulletStyle As _Byte
MenuItemGroup AS INTEGER MenuItemGroup As Integer
KeyCombo AS LONG KeyCombo As Long
BoundTo AS LONG BoundTo As Long
BoundProperty AS LONG BoundProperty As Long
END TYPE End Type
TYPE __UI_Types Type __UI_Types
Name AS STRING * 16 Name As String * 16
Count AS LONG Count As Long
TurnsInto AS INTEGER TurnsInto As Integer
DefaultHeight AS INTEGER DefaultHeight As Integer
MinimumHeight AS INTEGER MinimumHeight As Integer
DefaultWidth AS INTEGER DefaultWidth As Integer
MinimumWidth AS INTEGER MinimumWidth As Integer
RestrictResize AS _BYTE RestrictResize As _Byte
END TYPE End Type
TYPE __UI_ThemeImagesType Type __UI_ThemeImagesType
FileName AS STRING * 32 FileName As String * 32
Handle AS LONG Handle As Long
END TYPE End Type
TYPE __UI_WordWrapHistoryType Type __UI_WordWrapHistoryType
StringSlot AS LONG StringSlot As Long
Width AS INTEGER Width As Integer
LongestLine AS INTEGER LongestLine As Integer
Font AS LONG Font As Long
TotalLines AS INTEGER TotalLines As Integer
END TYPE End Type
TYPE __UI_KeyCombos Type __UI_KeyCombos
Combo AS STRING * 14 ' "CTRL+SHIFT+F12" Combo As String * 14 ' "CTRL+SHIFT+F12"
FriendlyCombo AS STRING * 14 ' "Ctrl+Shift+F12" FriendlyCombo As String * 14 ' "Ctrl+Shift+F12"
ControlID AS LONG ControlID As Long
END TYPE End Type
REDIM SHARED Caption(0 TO 100) AS STRING ReDim Shared Caption(0 To 100) As String
REDIM SHARED __UI_TempCaptions(0 TO 100) AS STRING ReDim Shared __UI_TempCaptions(0 To 100) As String
REDIM SHARED Text(0 TO 100) AS STRING ReDim Shared Text(0 To 100) As String
REDIM SHARED __UI_TempTexts(0 TO 100) AS STRING ReDim Shared __UI_TempTexts(0 To 100) As String
REDIM SHARED Mask(0 TO 100) AS STRING ReDim Shared Mask(0 To 100) As String
REDIM SHARED __UI_TempMask(0 TO 100) AS STRING ReDim Shared __UI_TempMask(0 To 100) As String
REDIM SHARED ToolTip(0 TO 100) AS STRING ReDim Shared ToolTip(0 To 100) As String
REDIM SHARED __UI_TempTips(0 TO 100) AS STRING ReDim Shared __UI_TempTips(0 To 100) As String
REDIM SHARED Control(0 TO 100) AS __UI_ControlTYPE ReDim Shared Control(0 To 100) As __UI_ControlTYPE
REDIM SHARED ControlDrawOrder(0) AS LONG ReDim Shared ControlDrawOrder(0) As Long
REDIM SHARED __UI_ThemeImages(0 TO 100) AS __UI_ThemeImagesType ReDim Shared __UI_ThemeImages(0 To 100) As __UI_ThemeImagesType
REDIM SHARED __UI_WordWrapHistoryTexts(0 TO 100) AS STRING ReDim Shared __UI_WordWrapHistoryTexts(0 To 100) As String
REDIM SHARED __UI_WordWrapHistoryResults(0 TO 100) AS STRING ReDim Shared __UI_WordWrapHistoryResults(0 To 100) As String
REDIM SHARED __UI_WordWrapHistory(0 TO 100) AS __UI_WordWrapHistoryType ReDim Shared __UI_WordWrapHistory(0 To 100) As __UI_WordWrapHistoryType
REDIM SHARED __UI_ThisLineChars(0) AS LONG, __UI_FocusedTextBoxChars(0) AS LONG ReDim Shared __UI_ThisLineChars(0) As Long, __UI_FocusedTextBoxChars(0) As Long
REDIM SHARED __UI_ActiveMenu(0 TO 100) AS LONG, __UI_ParentMenu(0 TO 100) AS LONG ReDim Shared __UI_ActiveMenu(0 To 100) As Long, __UI_ParentMenu(0 To 100) As Long
REDIM SHARED __UI_KeyCombo(0 TO 100) AS __UI_KeyCombos ReDim Shared __UI_KeyCombo(0 To 100) As __UI_KeyCombos
DIM SHARED __UI_TotalKeyCombos AS LONG, __UI_BypassKeyCombos AS _BYTE Dim Shared __UI_TotalKeyCombos As Long, __UI_BypassKeyCombos As _Byte
DIM SHARED table1252$(0 TO 255), table437$(0 TO 255) Dim Shared table1252$(0 To 255), table437$(0 To 255)
DIM SHARED __UI_MouseLeft AS INTEGER, __UI_MouseTop AS INTEGER Dim Shared __UI_MouseLeft As Integer, __UI_MouseTop As Integer
DIM SHARED __UI_MouseWheel AS INTEGER, __UI_MouseButtonsSwap AS _BYTE Dim Shared __UI_MouseWheel As Integer, __UI_MouseButtonsSwap As _Byte
DIM SHARED __UI_PrevMouseLeft AS INTEGER, __UI_PrevMouseTop AS INTEGER Dim Shared __UI_PrevMouseLeft As Integer, __UI_PrevMouseTop As Integer
DIM SHARED __UI_MouseButton1 AS _BYTE, __UI_MouseButton2 AS _BYTE Dim Shared __UI_MouseButton1 As _Byte, __UI_MouseButton2 As _Byte
DIM SHARED __UI_MouseIsDown AS _BYTE, __UI_MouseDownOnID AS LONG Dim Shared __UI_MouseIsDown As _Byte, __UI_MouseDownOnID As Long
DIM SHARED __UI_Mouse2IsDown AS _BYTE, __UI_Mouse2DownOnID AS LONG Dim Shared __UI_Mouse2IsDown As _Byte, __UI_Mouse2DownOnID As Long
DIM SHARED __UI_PreviousMouseDownOnID AS LONG Dim Shared __UI_PreviousMouseDownOnID As Long
DIM SHARED __UI_KeyIsDown AS _BYTE, __UI_KeyDownOnID AS LONG Dim Shared __UI_KeyIsDown As _Byte, __UI_KeyDownOnID As Long
DIM SHARED __UI_ShiftIsDown AS _BYTE, __UI_CtrlIsDown AS _BYTE Dim Shared __UI_ShiftIsDown As _Byte, __UI_CtrlIsDown As _Byte
DIM SHARED __UI_AltIsDown AS _BYTE, __UI_ShowHotKeys AS _BYTE, __UI_AltCombo$ Dim Shared __UI_AltIsDown As _Byte, __UI_ShowHotKeys As _Byte, __UI_AltCombo$
DIM SHARED __UI_LastMouseClick AS SINGLE, __UI_MouseDownOnScrollbar AS SINGLE Dim Shared __UI_LastMouseClick As Single, __UI_MouseDownOnScrollbar As Single
DIM SHARED __UI_DragX AS INTEGER, __UI_DragY AS INTEGER Dim Shared __UI_DragX As Integer, __UI_DragY As Integer
DIM SHARED __UI_DefaultButtonID AS LONG Dim Shared __UI_DefaultButtonID As Long
DIM SHARED __UI_KeyHit AS LONG, __UI_KeepFocus AS _BYTE Dim Shared __UI_KeyHit As Long, __UI_KeepFocus As _Byte
DIM SHARED __UI_Focus AS LONG, __UI_PreviousFocus AS LONG, __UI_KeyboardFocus AS _BYTE Dim Shared __UI_Focus As Long, __UI_PreviousFocus As Long, __UI_KeyboardFocus As _Byte
DIM SHARED __UI_HoveringID AS LONG, __UI_LastHoveringID AS LONG, __UI_BelowHoveringID AS LONG Dim Shared __UI_HoveringID As Long, __UI_LastHoveringID As Long, __UI_BelowHoveringID As Long
DIM SHARED __UI_IsDragging AS _BYTE, __UI_DraggingID AS LONG Dim Shared __UI_IsDragging As _Byte, __UI_DraggingID As Long
DIM SHARED __UI_IsResizing AS _BYTE, __UI_ResizingID AS LONG Dim Shared __UI_IsResizing As _Byte, __UI_ResizingID As Long
DIM SHARED __UI_ResizeHandleHover AS _BYTE Dim Shared __UI_ResizeHandleHover As _Byte
DIM SHARED __UI_IsSelectingText AS _BYTE, __UI_IsSelectingTextOnID AS LONG Dim Shared __UI_IsSelectingText As _Byte, __UI_IsSelectingTextOnID As Long
DIM SHARED __UI_SelectedText AS STRING, __UI_SelectionLength AS LONG Dim Shared __UI_SelectedText As String, __UI_SelectionLength As Long
DIM SHARED __UI_StateHasChanged AS _BYTE Dim Shared __UI_StateHasChanged As _Byte
DIM SHARED __UI_DraggingThumb AS _BYTE, __UI_ThumbDragTop AS INTEGER Dim Shared __UI_DraggingThumb As _Byte, __UI_ThumbDragTop As Integer
DIM SHARED __UI_DraggingThumbOnID AS LONG Dim Shared __UI_DraggingThumbOnID As Long
DIM SHARED __UI_HasInput AS _BYTE, __UI_ProcessInputTimer AS SINGLE Dim Shared __UI_HasInput As _Byte, __UI_ProcessInputTimer As Single
DIM SHARED __UI_UnloadSignal AS _BYTE, __UI_HasResized AS _BYTE Dim Shared __UI_UnloadSignal As _Byte, __UI_HasResized As _Byte
DIM SHARED __UI_ExitTriggered AS _BYTE Dim Shared __UI_ExitTriggered As _Byte
DIM SHARED __UI_Loaded AS _BYTE Dim Shared __UI_Loaded As _Byte
DIM SHARED __UI_EventsTimer AS INTEGER, __UI_RefreshTimer AS INTEGER Dim Shared __UI_EventsTimer As Integer, __UI_RefreshTimer As Integer
DIM SHARED __UI_ActiveDropdownList AS LONG, __UI_ParentDropdownList AS LONG Dim Shared __UI_ActiveDropdownList As Long, __UI_ParentDropdownList As Long
DIM SHARED __UI_TotalActiveMenus AS LONG, __UI_ActiveMenuIsContextMenu AS _BYTE Dim Shared __UI_TotalActiveMenus As Long, __UI_ActiveMenuIsContextMenu As _Byte
DIM SHARED __UI_SubMenuDelay AS SINGLE, __UI_HoveringSubMenu AS _BYTE Dim Shared __UI_SubMenuDelay As Single, __UI_HoveringSubMenu As _Byte
DIM SHARED __UI_TopMenuBarItem AS LONG Dim Shared __UI_TopMenuBarItem As Long
DIM SHARED __UI_ActiveTipID AS LONG, __UI_TipTimer AS SINGLE, __UI_PreviousTipID AS LONG Dim Shared __UI_ActiveTipID As Long, __UI_TipTimer As Single, __UI_PreviousTipID As Long
DIM SHARED __UI_ActiveTipTop AS INTEGER, __UI_ActiveTipLeft AS INTEGER Dim Shared __UI_ActiveTipTop As Integer, __UI_ActiveTipLeft As Integer
DIM SHARED __UI_FormID AS LONG, __UI_HasMenuBar AS LONG Dim Shared __UI_FormID As Long, __UI_HasMenuBar As Long
DIM SHARED __UI_ScrollbarWidth AS INTEGER, __UI_ScrollbarButtonHeight AS INTEGER Dim Shared __UI_ScrollbarWidth As Integer, __UI_ScrollbarButtonHeight As Integer
DIM SHARED __UI_MenuBarOffset AS INTEGER, __UI_MenuItemOffset AS INTEGER Dim Shared __UI_MenuBarOffset As Integer, __UI_MenuItemOffset As Integer
DIM SHARED __UI_NewMenuBarTextLeft AS INTEGER, __UI_DefaultCaptionIndent AS INTEGER Dim Shared __UI_NewMenuBarTextLeft As Integer, __UI_DefaultCaptionIndent As Integer
DIM SHARED __UI_ForceRedraw AS _BYTE, __UI_AutoRefresh AS _BYTE Dim Shared __UI_ForceRedraw As _Byte, __UI_AutoRefresh As _Byte
DIM SHARED __UI_CurrentTitle AS STRING Dim Shared __UI_CurrentTitle As String
DIM SHARED __UI_DesignMode AS _BYTE, __UI_FirstSelectedID AS LONG Dim Shared __UI_DesignMode As _Byte, __UI_FirstSelectedID As Long
DIM SHARED __UI_WaitMessage AS STRING, __UI_TotalSelectedControls AS LONG Dim Shared __UI_WaitMessage As String, __UI_TotalSelectedControls As Long
DIM SHARED __UI_WaitMessageHandle AS LONG, __UI_EditorMode AS _BYTE Dim Shared __UI_WaitMessageHandle As Long, __UI_EditorMode As _Byte
DIM SHARED __UI_LastRenderedCharCount AS LONG Dim Shared __UI_LastRenderedCharCount As Long
DIM SHARED __UI_SelectionRectangleTop AS INTEGER, __UI_SelectionRectangleLeft AS INTEGER Dim Shared __UI_SelectionRectangleTop As Integer, __UI_SelectionRectangleLeft As Integer
DIM SHARED __UI_SelectionRectangle AS _BYTE Dim Shared __UI_SelectionRectangle As _Byte
DIM SHARED __UI_CantShowContextMenu AS _BYTE, __UI_ShowPositionAndSize AS _BYTE Dim Shared __UI_CantShowContextMenu As _Byte, __UI_ShowPositionAndSize As _Byte
DIM SHARED __UI_ShowInvisibleControls AS _BYTE, __UI_Snapped AS _BYTE Dim Shared __UI_ShowInvisibleControls As _Byte, __UI_Snapped As _Byte
DIM SHARED __UI_SnappedByProximityX AS _BYTE, __UI_SnappedByProximityY AS _BYTE Dim Shared __UI_SnappedByProximityX As _Byte, __UI_SnappedByProximityY As _Byte
DIM SHARED __UI_SnappedX AS INTEGER, __UI_SnappedY AS INTEGER Dim Shared __UI_SnappedX As Integer, __UI_SnappedY As Integer
DIM SHARED __UI_SnappedXID AS LONG, __UI_SnappedYID AS LONG Dim Shared __UI_SnappedXID As Long, __UI_SnappedYID As Long
DIM SHARED __UI_SnapLines AS _BYTE, __UI_SnapDistance AS INTEGER, __UI_SnapDistanceFromForm AS INTEGER Dim Shared __UI_SnapLines As _Byte, __UI_SnapDistance As Integer, __UI_SnapDistanceFromForm As Integer
DIM SHARED __UI_FrameRate AS SINGLE, __UI_Font8Offset AS INTEGER, __UI_Font16Offset AS INTEGER Dim Shared __UI_FrameRate As Single, __UI_Font8Offset As Integer, __UI_Font16Offset As Integer
DIM SHARED __UI_ClipboardCheck$, __UI_MenuBarOffsetV AS INTEGER Dim Shared __UI_ClipboardCheck$, __UI_MenuBarOffsetV As Integer
DIM SHARED __UI_KeepScreenHidden AS _BYTE, __UI_MaxBorderSize AS INTEGER Dim Shared __UI_KeepScreenHidden As _Byte, __UI_MaxBorderSize As Integer
DIM SHARED __UI_InternalContextMenus AS LONG, __UI_DidClick AS _BYTE Dim Shared __UI_InternalContextMenus As Long, __UI_DidClick As _Byte
DIM SHARED __UI_ContextMenuSourceID AS LONG Dim Shared __UI_ContextMenuSourceID As Long
DIM SHARED __UI_FKey(1 TO 12) AS LONG Dim Shared __UI_FKey(1 To 12) As Long
'Control types: ----------------------------------------------- 'Control types: -----------------------------------------------
DIM SHARED __UI_Type(0 TO 18) AS __UI_Types Dim Shared __UI_Type(0 To 18) As __UI_Types
__UI_Type(__UI_Type_Form).Name = "Form" __UI_Type(__UI_Type_Form).Name = "Form"
__UI_Type(__UI_Type_Frame).Name = "Frame" __UI_Type(__UI_Type_Frame).Name = "Frame"

View file

@ -1,7 +1,7 @@
'Starting with v1.0, __UI_VersionNumber is actually the current build. 'Starting with v1.0, __UI_VersionNumber is actually the current build.
CONST __UI_Version = "v1.5" Const __UI_Version = "v1.5"
CONST __UI_VersionNumber = 0 Const __UI_VersionNumber = 0
CONST __UI_VersionIsBeta = 1 Const __UI_VersionIsBeta = 1
CONST __UI_CopyrightSpan = "2016-2023" Const __UI_CopyrightSpan = "2016-2023"

File diff suppressed because it is too large Load diff

File diff suppressed because it is too large Load diff

View file

@ -1,64 +1,64 @@
FUNCTION Download$ (url$, file$, timelimit) STATIC Function Download$ (url$, file$, timelimit) Static
'as seen on http://www.qb64.org/wiki/Downloading_Files 'as seen on http://www.qb64.org/wiki/Downloading_Files
'adapted for use with InForm 'adapted for use with InForm
DIM theClient AS LONG, l AS LONG Dim theClient As Long, l As Long
DIM prevUrl$, prevUrl2$, url2$, x AS LONG Dim prevUrl$, prevUrl2$, url2$, x As Long
DIM e$, url3$, x$, t!, a2$, a$, i AS LONG Dim e$, url3$, x$, t!, a2$, a$, i As Long
DIM i2 AS LONG, i3 AS LONG, d$, fh AS LONG Dim i2 As Long, i3 As Long, d$, fh As Long
IF url$ <> prevUrl$ OR url$ = "" THEN If url$ <> prevUrl$ Or url$ = "" Then
prevUrl$ = url$ prevUrl$ = url$
IF url$ = "" THEN If url$ = "" Then
IF theClient THEN CLOSE theClient: theClient = 0 If theClient Then Close theClient: theClient = 0
EXIT FUNCTION Exit Function
END IF End If
url2$ = url$ url2$ = url$
x = INSTR(url2$, "/") x = InStr(url2$, "/")
IF x THEN url2$ = LEFT$(url$, x - 1) If x Then url2$ = Left$(url$, x - 1)
IF url2$ <> prevUrl2$ THEN If url2$ <> prevUrl2$ Then
prevUrl2$ = url2$ prevUrl2$ = url2$
IF theClient THEN CLOSE theClient: theClient = 0 If theClient Then Close theClient: theClient = 0
theClient = _OPENCLIENT("TCP/IP:80:" + url2$) theClient = _OpenClient("TCP/IP:80:" + url2$)
IF theClient = 0 THEN Download = MKI$(2): prevUrl$ = "": EXIT FUNCTION If theClient = 0 Then Download = MKI$(2): prevUrl$ = "": Exit Function
END IF End If
e$ = CHR$(13) + CHR$(10) ' end of line characters e$ = Chr$(13) + Chr$(10) ' end of line characters
url3$ = RIGHT$(url$, LEN(url$) - x + 1) url3$ = Right$(url$, Len(url$) - x + 1)
x$ = "GET " + url3$ + " HTTP/1.1" + e$ x$ = "GET " + url3$ + " HTTP/1.1" + e$
x$ = x$ + "Host: " + url2$ + e$ + e$ x$ = x$ + "Host: " + url2$ + e$ + e$
PUT #theClient, , x$ Put #theClient, , x$
t! = TIMER ' start time t! = Timer ' start time
END IF End If
GET #theClient, , a2$ Get #theClient, , a2$
a$ = a$ + a2$ a$ = a$ + a2$
i = INSTR(a$, "Content-Length:") i = InStr(a$, "Content-Length:")
IF i THEN If i Then
i2 = INSTR(i, a$, e$) i2 = InStr(i, a$, e$)
IF i2 THEN If i2 Then
l = VAL(MID$(a$, i + 15, i2 - i - 14)) l = Val(Mid$(a$, i + 15, i2 - i - 14))
i3 = INSTR(i2, a$, e$ + e$) i3 = InStr(i2, a$, e$ + e$)
IF i3 THEN If i3 Then
i3 = i3 + 4 'move i3 to start of data i3 = i3 + 4 'move i3 to start of data
IF (LEN(a$) - i3 + 1) = l THEN If (Len(a$) - i3 + 1) = l Then
d$ = MID$(a$, i3, l) d$ = Mid$(a$, i3, l)
fh = FREEFILE fh = FreeFile
OPEN file$ FOR OUTPUT AS #fh: CLOSE #fh 'Warning! Clears data from existing file Open file$ For Output As #fh: Close #fh 'Warning! Clears data from existing file
OPEN file$ FOR BINARY AS #fh Open file$ For Binary As #fh
PUT #fh, , d$ Put #fh, , d$
CLOSE #fh Close #fh
Download = MKI$(1) + MKL$(l) 'indicates download was successful Download = MKI$(1) + MKL$(l) 'indicates download was successful
prevUrl$ = "" prevUrl$ = ""
prevUrl2$ = "" prevUrl2$ = ""
a$ = "" a$ = ""
CLOSE theClient Close theClient
theClient = 0 theClient = 0
EXIT FUNCTION Exit Function
END IF ' availabledata = l End If ' availabledata = l
END IF ' i3 End If ' i3
END IF ' i2 End If ' i2
END IF ' i End If ' i
IF TIMER > t! + timelimit THEN CLOSE theClient: theClient = 0: Download = MKI$(3): prevUrl$ = "": EXIT FUNCTION If Timer > t! + timelimit Then Close theClient: theClient = 0: Download = MKI$(3): prevUrl$ = "": Exit Function
Download = MKI$(0) 'still working Download = MKI$(0) 'still working
END FUNCTION End Function

View file

@ -6,53 +6,53 @@
'####################################################################################### '#######################################################################################
'Adapted for use with InForm's PictureBox controls by @FellippeHeitor 'Adapted for use with InForm's PictureBox controls by @FellippeHeitor
TYPE GIFDATA Type GIFDATA
ID AS LONG ID As Long
file AS INTEGER file As Integer
sigver AS STRING * 6 sigver As String * 6
width AS _UNSIGNED INTEGER width As _Unsigned Integer
height AS _UNSIGNED INTEGER height As _Unsigned Integer
bpp AS _UNSIGNED _BYTE bpp As _Unsigned _Byte
sortFlag AS _BYTE ' Unused sortFlag As _Byte ' Unused
colorRes AS _UNSIGNED _BYTE colorRes As _Unsigned _Byte
colorTableFlag AS _BYTE colorTableFlag As _Byte
bgColor AS _UNSIGNED _BYTE bgColor As _Unsigned _Byte
aspect AS SINGLE ' Unused aspect As Single ' Unused
numColors AS _UNSIGNED INTEGER numColors As _Unsigned Integer
palette AS STRING * 768 palette As String * 768
firstFrame AS LONG firstFrame As Long
totalFrames AS LONG totalFrames As Long
IsPlaying AS _BYTE IsPlaying As _Byte
Frame AS LONG Frame As Long
LoadedFrames AS LONG LoadedFrames As Long
GifLoadComplete AS _BYTE GifLoadComplete As _Byte
LastFrameServed AS LONG LastFrameServed As Long
LastFrameUpdate AS SINGLE LastFrameUpdate As Single
LastFrameDelay AS SINGLE LastFrameDelay As Single
HideOverlay AS _BYTE HideOverlay As _Byte
END TYPE End Type
TYPE FRAMEDATA Type FRAMEDATA
ID AS LONG ID As Long
thisFrame AS LONG thisFrame As Long
addr AS LONG addr As Long
left AS _UNSIGNED INTEGER left As _Unsigned Integer
top AS _UNSIGNED INTEGER top As _Unsigned Integer
width AS _UNSIGNED INTEGER width As _Unsigned Integer
height AS _UNSIGNED INTEGER height As _Unsigned Integer
localColorTableFlag AS _BYTE localColorTableFlag As _Byte
interlacedFlag AS _BYTE interlacedFlag As _Byte
sortFlag AS _BYTE ' Unused sortFlag As _Byte ' Unused
palBPP AS _UNSIGNED _BYTE palBPP As _Unsigned _Byte
minimumCodeSize AS _UNSIGNED _BYTE minimumCodeSize As _Unsigned _Byte
transparentFlag AS _BYTE 'GIF89a-specific (animation) values transparentFlag As _Byte 'GIF89a-specific (animation) values
userInput AS _BYTE ' Unused userInput As _Byte ' Unused
disposalMethod AS _UNSIGNED _BYTE disposalMethod As _Unsigned _Byte
delay AS SINGLE delay As Single
transColor AS _UNSIGNED _BYTE transColor As _Unsigned _Byte
END TYPE End Type
REDIM SHARED GifData(0) AS GIFDATA ReDim Shared GifData(0) As GIFDATA
REDIM SHARED GifFrameData(0) AS FRAMEDATA ReDim Shared GifFrameData(0) As FRAMEDATA
DIM SHARED TotalGIFLoaded AS LONG, TotalGIFFrames AS LONG Dim Shared TotalGIFLoaded As Long, TotalGIFFrames As Long

View file

@ -5,10 +5,10 @@
'----------------------------------------------------------- '-----------------------------------------------------------
': Controls' IDs: ------------------------------------------------------------------ ': Controls' IDs: ------------------------------------------------------------------
DIM SHARED gifplaySample AS LONG Dim Shared gifplaySample As Long
DIM SHARED PictureBox1 AS LONG Dim Shared PictureBox1 As Long
DIM SHARED LoadBT AS LONG Dim Shared LoadBT As Long
DIM SHARED PlayBT AS LONG Dim Shared PlayBT As Long
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'gifplay.bi' '$INCLUDE:'gifplay.bi'
@ -18,81 +18,81 @@ DIM SHARED PlayBT AS LONG
'$INCLUDE:'gifplay.bm' '$INCLUDE:'gifplay.bm'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit Sub __UI_BeforeInit
END SUB End Sub
SUB __UI_OnLoad Sub __UI_OnLoad
Control(PlayBT).Disabled = True Control(PlayBT).Disabled = True
END SUB End Sub
SUB __UI_BeforeUpdateDisplay Sub __UI_BeforeUpdateDisplay
UpdateGif PictureBox1 UpdateGif PictureBox1
END SUB End Sub
SUB __UI_BeforeUnload Sub __UI_BeforeUnload
END SUB End Sub
SUB __UI_Click (id AS LONG) Sub __UI_Click (id As Long)
SELECT CASE id Select Case id
CASE LoadBT Case LoadBT
'file 'globe.gif' comes from: 'file 'globe.gif' comes from:
'https://en.wikipedia.org/wiki/GIF#/media/File:Rotating_earth_(large).gif 'https://en.wikipedia.org/wiki/GIF#/media/File:Rotating_earth_(large).gif
IF OpenGif(PictureBox1, "globe.gif") THEN If OpenGif(PictureBox1, "globe.gif") Then
Control(PlayBT).Disabled = False Control(PlayBT).Disabled = False
IF TotalFrames(PictureBox1) > 1 THEN If TotalFrames(PictureBox1) > 1 Then
Caption(PlayBT) = "Play" Caption(PlayBT) = "Play"
ELSE Else
Caption(PlayBT) = "Static gif" Caption(PlayBT) = "Static gif"
Control(PlayBT).Disabled = True Control(PlayBT).Disabled = True
END IF End If
Caption(LoadBT) = "globe.gif loaded" Caption(LoadBT) = "globe.gif loaded"
Control(LoadBT).Disabled = True Control(LoadBT).Disabled = True
ELSE Else
_MESSAGEBOX "GIFPlay Sample", "File 'globe.gif' could not be found.", "error" _MessageBox "GIFPlay Sample", "File 'globe.gif' could not be found.", "error"
END IF End If
CASE PlayBT Case PlayBT
IF GifIsPlaying(PictureBox1) THEN If GifIsPlaying(PictureBox1) Then
PauseGif PictureBox1 PauseGif PictureBox1
Caption(PlayBT) = "Play" Caption(PlayBT) = "Play"
ELSE Else
PlayGif PictureBox1 PlayGif PictureBox1
Caption(PlayBT) = "Pause" Caption(PlayBT) = "Pause"
END IF End If
CASE PictureBox1 Case PictureBox1
HideGifOverlay PictureBox1 HideGifOverlay PictureBox1
END SELECT End Select
END SUB End Sub
SUB __UI_MouseEnter (id AS LONG) Sub __UI_MouseEnter (id As Long)
END SUB End Sub
SUB __UI_MouseLeave (id AS LONG) Sub __UI_MouseLeave (id As Long)
END SUB End Sub
SUB __UI_FocusIn (id AS LONG) Sub __UI_FocusIn (id As Long)
END SUB End Sub
SUB __UI_FocusOut (id AS LONG) Sub __UI_FocusOut (id As Long)
END SUB End Sub
SUB __UI_MouseDown (id AS LONG) Sub __UI_MouseDown (id As Long)
END SUB End Sub
SUB __UI_MouseUp (id AS LONG) Sub __UI_MouseUp (id As Long)
END SUB End Sub
SUB __UI_KeyPress (id AS LONG) Sub __UI_KeyPress (id As Long)
END SUB End Sub
SUB __UI_TextChanged (id AS LONG) Sub __UI_TextChanged (id As Long)
END SUB End Sub
SUB __UI_ValueChanged (id AS LONG) Sub __UI_ValueChanged (id As Long)
END SUB End Sub
SUB __UI_FormResized Sub __UI_FormResized
END SUB End Sub
'$INCLUDE:'..\InForm.ui' '$INCLUDE:'..\InForm.ui'

View file

@ -5,17 +5,17 @@
'unless you intend to use OPTION _EXPLICIT 'unless you intend to use OPTION _EXPLICIT
'Global variables declaration 'Global variables declaration
DIM currentIniFileName$ Dim currentIniFileName$
DIM currentIniFileLOF AS _UNSIGNED LONG Dim currentIniFileLOF As _Unsigned Long
DIM IniWholeFile$ Dim IniWholeFile$
DIM IniSectionData$ Dim IniSectionData$
DIM IniPosition AS _UNSIGNED LONG Dim IniPosition As _Unsigned Long
DIM IniNewFile$ Dim IniNewFile$
DIM IniLastSection$ Dim IniLastSection$
DIM IniLastKey$ Dim IniLastKey$
DIM IniLF$ Dim IniLF$
DIM IniDisableAutoCommit Dim IniDisableAutoCommit
DIM IniCODE Dim IniCODE
DIM IniAllowBasicComments Dim IniAllowBasicComments
DIM IniForceReload Dim IniForceReload

File diff suppressed because it is too large Load diff

View file

@ -1,48 +1,48 @@
OPTION _EXPLICIT Option _Explicit
'$INCLUDE:'InFormVersion.bas' '$INCLUDE:'InFormVersion.bas'
PRINT "InForm - GUI system for QB64 - "; __UI_Version Print "InForm - GUI system for QB64 - "; __UI_Version
PRINT "VBDOS to InForm form conversion utility" Print "VBDOS to InForm form conversion utility"
PRINT "-------------------------------------------------" Print "-------------------------------------------------"
DIM lf AS STRING * 1, q AS STRING * 1 Dim lf As String * 1, q As String * 1
DIM theFile$ Dim theFile$
lf = CHR$(10) lf = Chr$(10)
q = CHR$(34) q = Chr$(34)
IF LEN(COMMAND$) > 0 THEN If Len(Command$) > 0 Then
IF _FILEEXISTS(COMMAND$) = 0 THEN PRINT "File not found.": END If _FileExists(Command$) = 0 Then Print "File not found.": End
theFile$ = COMMAND$ theFile$ = Command$
ELSE Else
DO Do
INPUT "File to convert (.frm):", theFile$ Input "File to convert (.frm):", theFile$
IF LEN(theFile$) = 0 THEN END If Len(theFile$) = 0 Then End
IF UCASE$(RIGHT$(theFile$, 4)) <> ".FRM" THEN theFile$ = theFile$ + ".FRM" If UCase$(Right$(theFile$, 4)) <> ".FRM" Then theFile$ = theFile$ + ".FRM"
IF _FILEEXISTS(theFile$) = 0 THEN PRINT "File "; theFile$; " not found." ELSE EXIT DO If _FileExists(theFile$) = 0 Then Print "File "; theFile$; " not found." Else Exit Do
LOOP Loop
END IF End If
OPEN theFile$ FOR BINARY AS #1 Open theFile$ For Binary As #1
DIM a$ Dim a$
LINE INPUT #1, a$ Line Input #1, a$
IF a$ <> "Version 1.00" THEN If a$ <> "Version 1.00" Then
PRINT "Expected VBDOS text form file. Exiting." Print "Expected VBDOS text form file. Exiting."
END End
END IF End If
LINE INPUT #1, a$ Line Input #1, a$
IF LEFT$(a$, 11) <> "BEGIN Form " THEN If Left$(a$, 11) <> "BEGIN Form " Then
PRINT "Invalid VBDOS text form file. Exiting." Print "Invalid VBDOS text form file. Exiting."
END End
END IF End If
DIM FormName$: FormName$ = MID$(a$, 12) Dim FormName$: FormName$ = Mid$(a$, 12)
DIM o$: o$ = "'InForm - GUI system for QB64 - " + __UI_Version Dim o$: o$ = "'InForm - GUI system for QB64 - " + __UI_Version
o$ = o$ + lf + "'Fellippe Heitor, " + __UI_CopyrightSpan + " - fellippe@qb64.org - @FellippeHeitor" o$ = o$ + lf + "'Fellippe Heitor, " + __UI_CopyrightSpan + " - fellippe@qb64.org - @FellippeHeitor"
o$ = o$ + lf + "'-----------------------------------------------------------" o$ = o$ + lf + "'-----------------------------------------------------------"
o$ = o$ + lf + "SUB __UI_LoadForm" o$ = o$ + lf + "SUB __UI_LoadForm"
@ -51,231 +51,231 @@ o$ = o$ + lf + " DIM __UI_NewID AS LONG"
o$ = o$ + lf o$ = o$ + lf
o$ = o$ + lf + " __UI_NewID = __UI_NewControl(__UI_Type_Form, " + q + FormName$ + q + ", " o$ = o$ + lf + " __UI_NewID = __UI_NewControl(__UI_Type_Form, " + q + FormName$ + q + ", "
DIM row AS LONG: row = CSRLIN Dim row As Long: row = CsrLin
DIM percentage%, eq AS LONG, i AS LONG Dim percentage%, eq As Long, i As Long
DIM property$, value$, width$, height$, backColor$, foreColor$, caption$, text$ Dim property$, value$, width$, height$, backColor$, foreColor$, caption$, text$
DIM leftSide$, top$, disabled$, hidden$, controlType$, control$, controlName$, i$ Dim leftSide$, top$, disabled$, hidden$, controlType$, control$, controlName$, i$
DIM controlList$, caseAll$, caseFocus$, caseList$, caseTextBox$, assignIDs$ Dim controlList$, caseAll$, caseFocus$, caseList$, caseTextBox$, assignIDs$
DIM controlIDsDIM$, Frame$ Dim controlIDsDIM$, Frame$
DO Do
IF EOF(1) THEN EXIT DO If EOF(1) Then Exit Do
LINE INPUT #1, a$ Line Input #1, a$
DO WHILE LEFT$(a$, 1) = CHR$(9) Do While Left$(a$, 1) = Chr$(9)
a$ = MID$(a$, 2) a$ = Mid$(a$, 2)
LOOP Loop
percentage% = (SEEK(1) / LOF(1)) * 100 percentage% = (Seek(1) / LOF(1)) * 100
LOCATE row, 1: COLOR 7: PRINT STRING$(80, 176); Locate row, 1: Color 7: Print String$(80, 176);
LOCATE row, 1: COLOR 11: PRINT STRING$((80 * percentage%) / 100, 219); Locate row, 1: Color 11: Print String$((80 * percentage%) / 100, 219);
COLOR 8 Color 8
LOCATE row + 1, 1: PRINT SPACE$(80); Locate row + 1, 1: Print Space$(80);
LOCATE row + 1, 1: PRINT a$; Locate row + 1, 1: Print a$;
COLOR 7 Color 7
eq = INSTR(a$, "=") eq = InStr(a$, "=")
IF eq THEN If eq Then
property$ = RTRIM$(LEFT$(a$, eq - 1)) property$ = RTrim$(Left$(a$, eq - 1))
value$ = LTRIM$(RTRIM$(MID$(a$, eq + 1))) value$ = LTrim$(RTrim$(Mid$(a$, eq + 1)))
SELECT CASE property$ Select Case property$
CASE "Width" Case "Width"
IF LEFT$(value$, 5) = "Char(" THEN width$ = STR$(VAL(MID$(value$, 6)) * _FONTWIDTH + 5) If Left$(value$, 5) = "Char(" Then width$ = Str$(Val(Mid$(value$, 6)) * _FontWidth + 5)
CASE "Height" Case "Height"
IF LEFT$(value$, 5) = "Char(" THEN height$ = STR$(VAL(MID$(value$, 6)) * _FONTHEIGHT + 15) If Left$(value$, 5) = "Char(" Then height$ = Str$(Val(Mid$(value$, 6)) * _FontHeight + 15)
CASE "BackColor" Case "BackColor"
IF LEFT$(value$, 8) = "QBColor(" THEN backColor$ = QBColor2QB64$(VAL(MID$(value$, 9))) If Left$(value$, 8) = "QBColor(" Then backColor$ = QBColor2QB64$(Val(Mid$(value$, 9)))
CASE "ForeColor" Case "ForeColor"
IF LEFT$(value$, 8) = "QBColor(" THEN foreColor$ = QBColor2QB64$(VAL(MID$(value$, 9))) If Left$(value$, 8) = "QBColor(" Then foreColor$ = QBColor2QB64$(Val(Mid$(value$, 9)))
CASE "Caption" Case "Caption"
caption$ = value$ caption$ = value$
CASE "Text" Case "Text"
text$ = value$ text$ = value$
CASE "Left" Case "Left"
IF LEFT$(value$, 5) = "Char(" THEN leftSide$ = STR$(VAL(MID$(value$, 6)) * _FONTWIDTH + 5) If Left$(value$, 5) = "Char(" Then leftSide$ = Str$(Val(Mid$(value$, 6)) * _FontWidth + 5)
CASE "Top" Case "Top"
IF LEFT$(value$, 5) = "Char(" THEN top$ = STR$(VAL(MID$(value$, 6)) * _FONTHEIGHT + 15) If Left$(value$, 5) = "Char(" Then top$ = Str$(Val(Mid$(value$, 6)) * _FontHeight + 15)
CASE "Enabled" Case "Enabled"
IF value$ = "0" THEN disabled$ = "True" If value$ = "0" Then disabled$ = "True"
CASE "Visible" Case "Visible"
IF value$ = "0" THEN hidden$ = "True" If value$ = "0" Then hidden$ = "True"
END SELECT End Select
ELSE Else
COLOR 15 Color 15
IF LEFT$(a$, 6) = "BEGIN " THEN If Left$(a$, 6) = "BEGIN " Then
IF LEN(FormName$) THEN If Len(FormName$) Then
FormName$ = "" FormName$ = ""
o$ = o$ + width$ + "," + height$ + ", 0, 0, 0)" o$ = o$ + width$ + "," + height$ + ", 0, 0, 0)"
o$ = o$ + lf + " Control(__UI_NewID).Font = SetFont(" + q + q + ", 16, " + q + q + ")" o$ = o$ + lf + " Control(__UI_NewID).Font = SetFont(" + q + q + ", 16, " + q + q + ")"
GOSUB AddProperties GoSub AddProperties
ELSEIF controlType$ = "__UI_Type_Frame" THEN ElseIf controlType$ = "__UI_Type_Frame" Then
GOSUB FinishFrame GoSub FinishFrame
END IF End If
control$ = MID$(a$, 7) control$ = Mid$(a$, 7)
controlType$ = LEFT$(control$, INSTR(control$, " ") - 1) controlType$ = Left$(control$, InStr(control$, " ") - 1)
controlName$ = MID$(control$, INSTR(control$, " ") + 1) controlName$ = Mid$(control$, InStr(control$, " ") + 1)
i = 1: i$ = "" i = 1: i$ = ""
DO WHILE INSTR(controlList$, "$" + controlName$ + i$ + "$") > 0 Do While InStr(controlList$, "$" + controlName$ + i$ + "$") > 0
i = i + 1: i$ = LTRIM$(STR$(i)) i = i + 1: i$ = LTrim$(Str$(i))
LOOP Loop
controlName$ = controlName$ + i$ controlName$ = controlName$ + i$
controlList$ = controlList$ + "$" + controlName$ + "$" controlList$ = controlList$ + "$" + controlName$ + "$"
caseAll$ = caseAll$ + " CASE " + controlName$ + lf + lf caseAll$ = caseAll$ + " CASE " + controlName$ + lf + lf
SELECT CASE controlType$ Select Case controlType$
CASE "Label" Case "Label"
controlType$ = "__UI_Type_Label" controlType$ = "__UI_Type_Label"
CASE "ComboBox", "DriveListBox" Case "ComboBox", "DriveListBox"
controlType$ = "__UI_Type_DropdownList" controlType$ = "__UI_Type_DropdownList"
caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf
CASE "CommandButton" Case "CommandButton"
controlType$ = "__UI_Type_Button" controlType$ = "__UI_Type_Button"
caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf
CASE "ListBox", "DirListBox", "FileListBox" Case "ListBox", "DirListBox", "FileListBox"
controlType$ = "__UI_Type_ListBox" controlType$ = "__UI_Type_ListBox"
caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf
caseList$ = caseList$ + " CASE " + controlName$ + lf + lf caseList$ = caseList$ + " CASE " + controlName$ + lf + lf
CASE "Frame" Case "Frame"
controlType$ = "__UI_Type_Frame" controlType$ = "__UI_Type_Frame"
CASE "CheckBox" Case "CheckBox"
controlType$ = "__UI_Type_CheckBox" controlType$ = "__UI_Type_CheckBox"
caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf
CASE "OptionButton" Case "OptionButton"
controlType$ = "__UI_Type_RadioButton" controlType$ = "__UI_Type_RadioButton"
caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf
CASE "PictureBox" Case "PictureBox"
controlType$ = "__UI_Type_PictureBox" controlType$ = "__UI_Type_PictureBox"
CASE "TextBox" Case "TextBox"
controlType$ = "__UI_Type_TextBox" controlType$ = "__UI_Type_TextBox"
caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf
caseTextBox$ = caseTextBox$ + " CASE " + controlName$ + lf + lf caseTextBox$ = caseTextBox$ + " CASE " + controlName$ + lf + lf
CASE ELSE Case Else
controlType$ = "__UI_Type_PictureBox" controlType$ = "__UI_Type_PictureBox"
END SELECT End Select
assignIDs$ = assignIDs$ + lf + " " + controlName$ + " = __UI_GetID(" + q + controlName$ + q + ")" assignIDs$ = assignIDs$ + lf + " " + controlName$ + " = __UI_GetID(" + q + controlName$ + q + ")"
controlIDsDIM$ = controlIDsDIM$ + lf + "DIM SHARED " + controlName$ + " AS LONG" controlIDsDIM$ = controlIDsDIM$ + lf + "DIM SHARED " + controlName$ + " AS LONG"
IF controlType$ = "__UI_Type_Frame" THEN If controlType$ = "__UI_Type_Frame" Then
Frame$ = controlName$ Frame$ = controlName$
control$ = "" control$ = ""
END IF End If
ELSEIF a$ = "END" THEN ElseIf a$ = "END" Then
IF LEN(control$) > 0 THEN If Len(control$) > 0 Then
FinishFrame: FinishFrame:
o$ = o$ + lf + " __UI_NewID = __UI_NewControl(" + controlType$ + ", " + q + controlName$ + q + ", " o$ = o$ + lf + " __UI_NewID = __UI_NewControl(" + controlType$ + ", " + q + controlName$ + q + ", "
o$ = o$ + width$ + "," + height$ + ", " + leftSide$ + ", " + top$ + ", " o$ = o$ + width$ + "," + height$ + ", " + leftSide$ + ", " + top$ + ", "
IF LEN(Frame$) > 0 AND controlType$ <> "__UI_Type_Frame" THEN If Len(Frame$) > 0 And controlType$ <> "__UI_Type_Frame" Then
o$ = o$ + "__UI_GetID(" + q + Frame$ + q + "))" o$ = o$ + "__UI_GetID(" + q + Frame$ + q + "))"
ELSE Else
o$ = o$ + "0)" o$ = o$ + "0)"
END IF End If
GOSUB AddProperties GoSub AddProperties
control$ = "" control$ = ""
IF controlType$ = "__UI_Type_Frame" THEN RETURN If controlType$ = "__UI_Type_Frame" Then Return
ELSE Else
IF LEN(Frame$) THEN If Len(Frame$) Then
Frame$ = "" Frame$ = ""
ELSE Else
EXIT DO Exit Do
END IF End If
END IF End If
END IF End If
END IF End If
_LIMIT 500 _Limit 500
LOOP Loop
o$ = o$ + lf + "END SUB" o$ = o$ + lf + "END SUB"
o$ = o$ + lf o$ = o$ + lf
o$ = o$ + lf + "SUB __UI_AssignIDs" o$ = o$ + lf + "SUB __UI_AssignIDs"
o$ = o$ + assignIDs$ o$ = o$ + assignIDs$
o$ = o$ + lf + "END SUB" o$ = o$ + lf + "END SUB"
DIM newFile$: newFile$ = LEFT$(theFile$, INSTR(theFile$, ".") - 1) + "_InForm.frm" Dim newFile$: newFile$ = Left$(theFile$, InStr(theFile$, ".") - 1) + "_InForm.frm"
CLOSE Close
OPEN newFile$ FOR BINARY AS #1 Open newFile$ For Binary As #1
PUT #1, , o$ Put #1, , o$
CLOSE Close
DIM TextFileNum AS LONG: TextFileNum = FREEFILE Dim TextFileNum As Long: TextFileNum = FreeFile
DIM newTextFile$: newTextFile$ = LEFT$(theFile$, INSTR(theFile$, ".") - 1) + "_InForm.bas" Dim newTextFile$: newTextFile$ = Left$(theFile$, InStr(theFile$, ".") - 1) + "_InForm.bas"
OPEN newTextFile$ FOR OUTPUT AS #TextFileNum Open newTextFile$ For Output As #TextFileNum
PRINT #TextFileNum, "': This program was generated by" Print #TextFileNum, "': This program was generated by"
PRINT #TextFileNum, "': InForm - GUI system for QB64 - "; __UI_Version Print #TextFileNum, "': InForm - GUI system for QB64 - "; __UI_Version
PRINT #TextFileNum, "': Fellippe Heitor, " + __UI_CopyrightSpan + " - fellippe@qb64.org - @fellippeheitor" Print #TextFileNum, "': Fellippe Heitor, " + __UI_CopyrightSpan + " - fellippe@qb64.org - @fellippeheitor"
PRINT #TextFileNum, "'-----------------------------------------------------------" Print #TextFileNum, "'-----------------------------------------------------------"
PRINT #TextFileNum, Print #TextFileNum,
PRINT #TextFileNum, "': Controls' IDs: ------------------------------------------------------------------"; Print #TextFileNum, "': Controls' IDs: ------------------------------------------------------------------";
PRINT #TextFileNum, controlIDsDIM$ Print #TextFileNum, controlIDsDIM$
PRINT #TextFileNum, Print #TextFileNum,
PRINT #TextFileNum, "': External modules: ---------------------------------------------------------------" Print #TextFileNum, "': External modules: ---------------------------------------------------------------"
PRINT #TextFileNum, "'$INCLUDE:'InForm\InForm.ui'" Print #TextFileNum, "'$INCLUDE:'InForm\InForm.ui'"
PRINT #TextFileNum, "'$INCLUDE:'InForm\xp.uitheme'" Print #TextFileNum, "'$INCLUDE:'InForm\xp.uitheme'"
PRINT #TextFileNum, "'$INCLUDE:'" + newFile$ + "'" Print #TextFileNum, "'$INCLUDE:'" + newFile$ + "'"
PRINT #TextFileNum, Print #TextFileNum,
PRINT #TextFileNum, "': Event procedures: ---------------------------------------------------------------" Print #TextFileNum, "': Event procedures: ---------------------------------------------------------------"
FOR i = 0 TO 14 For i = 0 To 14
SELECT EVERYCASE i Select EveryCase i
CASE 0: PRINT #TextFileNum, "SUB __UI_BeforeInit" Case 0: Print #TextFileNum, "SUB __UI_BeforeInit"
CASE 1: PRINT #TextFileNum, "SUB __UI_OnLoad" Case 1: Print #TextFileNum, "SUB __UI_OnLoad"
CASE 2: PRINT #TextFileNum, "SUB __UI_BeforeUpdateDisplay" Case 2: Print #TextFileNum, "SUB __UI_BeforeUpdateDisplay"
CASE 3: PRINT #TextFileNum, "SUB __UI_BeforeUnload" Case 3: Print #TextFileNum, "SUB __UI_BeforeUnload"
CASE 4: PRINT #TextFileNum, "SUB __UI_Click (id AS LONG)" Case 4: Print #TextFileNum, "SUB __UI_Click (id AS LONG)"
CASE 5: PRINT #TextFileNum, "SUB __UI_MouseEnter (id AS LONG)" Case 5: Print #TextFileNum, "SUB __UI_MouseEnter (id AS LONG)"
CASE 6: PRINT #TextFileNum, "SUB __UI_MouseLeave (id AS LONG)" Case 6: Print #TextFileNum, "SUB __UI_MouseLeave (id AS LONG)"
CASE 7: PRINT #TextFileNum, "SUB __UI_FocusIn (id AS LONG)" Case 7: Print #TextFileNum, "SUB __UI_FocusIn (id AS LONG)"
CASE 8: PRINT #TextFileNum, "SUB __UI_FocusOut (id AS LONG)" Case 8: Print #TextFileNum, "SUB __UI_FocusOut (id AS LONG)"
CASE 9: PRINT #TextFileNum, "SUB __UI_MouseDown (id AS LONG)" Case 9: Print #TextFileNum, "SUB __UI_MouseDown (id AS LONG)"
CASE 10: PRINT #TextFileNum, "SUB __UI_MouseUp (id AS LONG)" Case 10: Print #TextFileNum, "SUB __UI_MouseUp (id AS LONG)"
CASE 11: PRINT #TextFileNum, "SUB __UI_KeyPress (id AS LONG)" Case 11: Print #TextFileNum, "SUB __UI_KeyPress (id AS LONG)"
CASE 12: PRINT #TextFileNum, "SUB __UI_TextChanged (id AS LONG)" Case 12: Print #TextFileNum, "SUB __UI_TextChanged (id AS LONG)"
CASE 13: PRINT #TextFileNum, "SUB __UI_ValueChanged (id AS LONG)" Case 13: Print #TextFileNum, "SUB __UI_ValueChanged (id AS LONG)"
CASE 14: PRINT #TextFileNum, "SUB __UI_FormResized" Case 14: Print #TextFileNum, "SUB __UI_FormResized"
CASE 0 TO 3, 14 Case 0 To 3, 14
PRINT #TextFileNum, Print #TextFileNum,
CASE 4 TO 6, 9, 10 'All controls except for Menu panels, and internal context menus Case 4 To 6, 9, 10 'All controls except for Menu panels, and internal context menus
PRINT #TextFileNum, " SELECT CASE id" Print #TextFileNum, " SELECT CASE id"
PRINT #TextFileNum, caseAll$; Print #TextFileNum, caseAll$;
PRINT #TextFileNum, " END SELECT" Print #TextFileNum, " END SELECT"
CASE 7, 8, 11 'Controls that can have focus only Case 7, 8, 11 'Controls that can have focus only
PRINT #TextFileNum, " SELECT CASE id" Print #TextFileNum, " SELECT CASE id"
PRINT #TextFileNum, caseFocus$; Print #TextFileNum, caseFocus$;
PRINT #TextFileNum, " END SELECT" Print #TextFileNum, " END SELECT"
CASE 12 'Text boxes Case 12 'Text boxes
PRINT #TextFileNum, " SELECT CASE id" Print #TextFileNum, " SELECT CASE id"
PRINT #TextFileNum, caseTextBox$; Print #TextFileNum, caseTextBox$;
PRINT #TextFileNum, " END SELECT" Print #TextFileNum, " END SELECT"
CASE 13 'Dropdown list, List box and Track bar Case 13 'Dropdown list, List box and Track bar
PRINT #TextFileNum, " SELECT CASE id" Print #TextFileNum, " SELECT CASE id"
PRINT #TextFileNum, caseList$; Print #TextFileNum, caseList$;
PRINT #TextFileNum, " END SELECT" Print #TextFileNum, " END SELECT"
END SELECT End Select
PRINT #TextFileNum, "END SUB" Print #TextFileNum, "END SUB"
PRINT #TextFileNum, Print #TextFileNum,
NEXT Next
CLOSE #TextFileNum Close #TextFileNum
LOCATE row, 1: COLOR 11: PRINT STRING$(80, 219); Locate row, 1: Color 11: Print String$(80, 219);
COLOR 15 Color 15
PRINT Print
PRINT "Conversion finished. Files output:" Print "Conversion finished. Files output:"
PRINT " "; newFile$ Print " "; newFile$
PRINT " "; newTextFile$ Print " "; newTextFile$
END End
AddProperties: AddProperties:
IF LEN(caption$) THEN o$ = o$ + lf + " SetCaption __UI_NewID, " + caption$: caption$ = "" If Len(caption$) Then o$ = o$ + lf + " SetCaption __UI_NewID, " + caption$: caption$ = ""
DIM formBackColor$, formForeColor$ Dim formBackColor$, formForeColor$
IF LEN(FormName$) = 0 THEN If Len(FormName$) = 0 Then
IF backColor$ = formBackColor$ THEN backColor$ = "" If backColor$ = formBackColor$ Then backColor$ = ""
IF foreColor$ = formForeColor$ THEN foreColor$ = "" If foreColor$ = formForeColor$ Then foreColor$ = ""
END IF End If
IF LEN(backColor$) THEN o$ = o$ + lf + " Control(__UI_NewID).BackColor = " + backColor$: IF control$ = "" THEN formBackColor$ = backColor$: backColor$ = "" If Len(backColor$) Then o$ = o$ + lf + " Control(__UI_NewID).BackColor = " + backColor$: If control$ = "" Then formBackColor$ = backColor$: backColor$ = ""
IF LEN(foreColor$) THEN o$ = o$ + lf + " Control(__UI_NewID).ForeColor = " + foreColor$: IF control$ = "" THEN formForeColor$ = foreColor$: foreColor$ = "" If Len(foreColor$) Then o$ = o$ + lf + " Control(__UI_NewID).ForeColor = " + foreColor$: If control$ = "" Then formForeColor$ = foreColor$: foreColor$ = ""
IF LEN(text$) THEN o$ = o$ + lf + " Text(__UI_NewID) = " + text$: text$ = "" If Len(text$) Then o$ = o$ + lf + " Text(__UI_NewID) = " + text$: text$ = ""
IF LEN(disabled$) THEN o$ = o$ + lf + " Control(__UI_NewID).Disabled = True": disabled$ = "" If Len(disabled$) Then o$ = o$ + lf + " Control(__UI_NewID).Disabled = True": disabled$ = ""
IF LEN(hidden$) THEN o$ = o$ + lf + " Control(__UI_NewID).Hidden = True": hidden$ = "" If Len(hidden$) Then o$ = o$ + lf + " Control(__UI_NewID).Hidden = True": hidden$ = ""
o$ = o$ + lf o$ = o$ + lf
RETURN Return
FUNCTION QBColor2QB64$ (index AS _BYTE) Function QBColor2QB64$ (index As _Byte)
QBColor2QB64$ = "_RGB32(" + LTRIM$(STR$(_RED(index))) + ", " + LTRIM$(STR$(_GREEN(index))) + ", " + LTRIM$(STR$(_BLUE(index))) + ")" QBColor2QB64$ = "_RGB32(" + LTrim$(Str$(_Red(index))) + ", " + LTrim$(Str$(_Green(index))) + ", " + LTrim$(Str$(_Blue(index))) + ")"
END FUNCTION End Function