QB64/InForm
QB64/InForm
1
1
Fork 0
mirror of https://github.com/FellippeHeitor/InForm.git synced 2024-05-12 06:50:12 +00:00
Code Issues Releases Wiki Activity

Change all keyword case to upper

Browse source
This commit is contained in:
Samuel Gomes 2023-05-09 04:39:01 +05:30
parent 1451684677
commit a15eb6f601
10 changed files with 6668 additions and 6670 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

438
InForm/InForm.bi
View file

@ -1,238 +1,238 @@
'InForm - GUI library for QB64
'Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
'
Declare Library
Function __UI_GetPID Alias getpid ()
End Declare
DECLARE LIBRARY
FUNCTION __UI_GetPID ALIAS getpid ()
END DECLARE
Declare CustomType Library
Sub __UI_MemCopy Alias memcpy (ByVal dest As _Offset, Byval source As _Offset, Byval bytes As Long)
End Declare
DECLARE CUSTOMTYPE LIBRARY
SUB __UI_MemCopy ALIAS memcpy (BYVAL dest AS _OFFSET, BYVAL source AS _OFFSET, BYVAL bytes AS LONG)
END DECLARE
$If WIN Then
Declare Library
Function GetSystemMetrics& (ByVal WhichMetric&)
End Declare
$IF WIN THEN
DECLARE LIBRARY
FUNCTION GetSystemMetrics& (BYVAL WhichMetric&)
END DECLARE
Const __UI_SM_SWAPBUTTON = 23
$End If
CONST __UI_SM_SWAPBUTTON = 23
$END IF
$ScreenHide
_ControlChr Off
$SCREENHIDE
_CONTROLCHR OFF
Type __UI_ControlTYPE
ID As Long
ParentID As Long
PreviousParentID As Long
ContextMenuID As Long
Type As Integer
Name As String * 40
ParentName As String * 40
SubMenu As _Byte
MenuPanelID As Long
SourceControl As Long
Top As Integer
Left As Integer
Width As Integer
Height As Integer
Canvas As Long
HelperCanvas As Long
TransparentColor As _Unsigned Long
Stretch As _Byte
PreviousStretch As _Byte
Font As Integer
PreviousFont As Integer
BackColor As _Unsigned Long
ForeColor As _Unsigned Long
SelectedForeColor As _Unsigned Long
SelectedBackColor As _Unsigned Long
BackStyle As _Byte
HasBorder As _Byte
BorderSize As Integer
Padding As Integer
Encoding As Long
Align As _Byte
PrevAlign As _Byte
VAlign As _Byte
PrevVAlign As _Byte
BorderColor As _Unsigned Long
Value As _Float
PreviousValue As _Float
Min As _Float
PrevMin As _Float
Max As _Float
PrevMax As _Float
Interval As _Float
PrevInterval As _Float
MinInterval As _Float
PrevMinInterval As _Float
HotKey As Integer
HotKeyOffset As Integer
HotKeyPosition As Integer
ShowPercentage As _Byte
AutoScroll As _Byte
AutoSize As _Byte
InputViewStart As Long
PreviousInputViewStart As Long
LastVisibleItem As Integer
ItemHeight As Integer
HasVScrollbar As _Byte
VScrollbarButton2Top As Integer
HoveringVScrollbarButton As _Byte
ThumbHeight As Integer
ThumbTop As Integer
VScrollbarRatio As Single
Cursor As Long
PasswordField As _Byte
PrevCursor As Long
FieldArea As Long
PreviousFieldArea As Long
TextIsSelected As _Byte
BypassSelectOnFocus As _Byte
Multiline As _Byte
NumericOnly As _Byte
FirstVisibleLine As Long
PrevFirstVisibleLine As Long
CurrentLine As Long
PrevCurrentLine As Long
VisibleCursor As Long
PrevVisibleCursor As Long
ControlIsSelected As _Byte
LeftOffsetFromFirstSelected As Integer
TopOffsetFromFirstSelected As Integer
SelectionLength As Long
SelectionStart As Long
WordWrap As _Byte
CanResize As _Byte
CanHaveFocus As _Byte
Disabled As _Byte
Hidden As _Byte
PreviouslyHidden As _Byte
CenteredWindow As _Byte
ControlState As _Byte
ChildrenRedrawn As _Byte
FocusState As Long
LastChange As Single
Redraw As _Byte
BulletStyle As _Byte
MenuItemGroup As Integer
KeyCombo As Long
BoundTo As Long
BoundProperty As Long
End Type
TYPE __UI_ControlTYPE
ID AS LONG
ParentID AS LONG
PreviousParentID AS LONG
ContextMenuID AS LONG
Type AS INTEGER
Name AS STRING * 40
ParentName AS STRING * 40
SubMenu AS _BYTE
MenuPanelID AS LONG
SourceControl AS LONG
Top AS INTEGER
Left AS INTEGER
Width AS INTEGER
Height AS INTEGER
Canvas AS LONG
HelperCanvas AS LONG
TransparentColor AS _UNSIGNED LONG
Stretch AS _BYTE
PreviousStretch AS _BYTE
Font AS INTEGER
PreviousFont AS INTEGER
BackColor AS _UNSIGNED LONG
ForeColor AS _UNSIGNED LONG
SelectedForeColor AS _UNSIGNED LONG
SelectedBackColor AS _UNSIGNED LONG
BackStyle AS _BYTE
HasBorder AS _BYTE
BorderSize AS INTEGER
Padding AS INTEGER
Encoding AS LONG
Align AS _BYTE
PrevAlign AS _BYTE
VAlign AS _BYTE
PrevVAlign AS _BYTE
BorderColor AS _UNSIGNED LONG
Value AS _FLOAT
PreviousValue AS _FLOAT
Min AS _FLOAT
PrevMin AS _FLOAT
Max AS _FLOAT
PrevMax AS _FLOAT
Interval AS _FLOAT
PrevInterval AS _FLOAT
MinInterval AS _FLOAT
PrevMinInterval AS _FLOAT
HotKey AS INTEGER
HotKeyOffset AS INTEGER
HotKeyPosition AS INTEGER
ShowPercentage AS _BYTE
AutoScroll AS _BYTE
AutoSize AS _BYTE
InputViewStart AS LONG
PreviousInputViewStart AS LONG
LastVisibleItem AS INTEGER
ItemHeight AS INTEGER
HasVScrollbar AS _BYTE
VScrollbarButton2Top AS INTEGER
HoveringVScrollbarButton AS _BYTE
ThumbHeight AS INTEGER
ThumbTop AS INTEGER
VScrollbarRatio AS SINGLE
Cursor AS LONG
PasswordField AS _BYTE
PrevCursor AS LONG
FieldArea AS LONG
PreviousFieldArea AS LONG
TextIsSelected AS _BYTE
BypassSelectOnFocus AS _BYTE
Multiline AS _BYTE
NumericOnly AS _BYTE
FirstVisibleLine AS LONG
PrevFirstVisibleLine AS LONG
CurrentLine AS LONG
PrevCurrentLine AS LONG
VisibleCursor AS LONG
PrevVisibleCursor AS LONG
ControlIsSelected AS _BYTE
LeftOffsetFromFirstSelected AS INTEGER
TopOffsetFromFirstSelected AS INTEGER
SelectionLength AS LONG
SelectionStart AS LONG
WordWrap AS _BYTE
CanResize AS _BYTE
CanHaveFocus AS _BYTE
Disabled AS _BYTE
Hidden AS _BYTE
PreviouslyHidden AS _BYTE
CenteredWindow AS _BYTE
ControlState AS _BYTE
ChildrenRedrawn AS _BYTE
FocusState AS LONG
LastChange AS SINGLE
Redraw AS _BYTE
BulletStyle AS _BYTE
MenuItemGroup AS INTEGER
KeyCombo AS LONG
BoundTo AS LONG
BoundProperty AS LONG
END TYPE
Type __UI_Types
Name As String * 16
Count As Long
TurnsInto As Integer
DefaultHeight As Integer
MinimumHeight As Integer
DefaultWidth As Integer
MinimumWidth As Integer
RestrictResize As _Byte
End Type
TYPE __UI_Types
Name AS STRING * 16
Count AS LONG
TurnsInto AS INTEGER
DefaultHeight AS INTEGER
MinimumHeight AS INTEGER
DefaultWidth AS INTEGER
MinimumWidth AS INTEGER
RestrictResize AS _BYTE
END TYPE
Type __UI_ThemeImagesType
FileName As String * 32
Handle As Long
End Type
TYPE __UI_ThemeImagesType
FileName AS STRING * 32
Handle AS LONG
END TYPE
Type __UI_WordWrapHistoryType
StringSlot As Long
Width As Integer
LongestLine As Integer
Font As Long
TotalLines As Integer
End Type
TYPE __UI_WordWrapHistoryType
StringSlot AS LONG
Width AS INTEGER
LongestLine AS INTEGER
Font AS LONG
TotalLines AS INTEGER
END TYPE
Type __UI_KeyCombos
Combo As String * 14 ' "CTRL+SHIFT+F12"
FriendlyCombo As String * 14 ' "Ctrl+Shift+F12"
ControlID As Long
End Type
TYPE __UI_KeyCombos
Combo AS STRING * 14 ' "CTRL+SHIFT+F12"
FriendlyCombo AS STRING * 14 ' "Ctrl+Shift+F12"
ControlID AS LONG
END TYPE
ReDim Shared Caption(0 To 100) As String
ReDim Shared __UI_TempCaptions(0 To 100) As String
ReDim Shared Text(0 To 100) As String
ReDim Shared __UI_TempTexts(0 To 100) As String
ReDim Shared Mask(0 To 100) As String
ReDim Shared __UI_TempMask(0 To 100) As String
ReDim Shared ToolTip(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 ControlDrawOrder(0) As Long
ReDim Shared __UI_ThemeImages(0 To 100) As __UI_ThemeImagesType
ReDim Shared __UI_WordWrapHistoryTexts(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_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_KeyCombo(0 To 100) As __UI_KeyCombos
REDIM SHARED Caption(0 TO 100) AS STRING
REDIM SHARED __UI_TempCaptions(0 TO 100) AS STRING
REDIM SHARED Text(0 TO 100) AS STRING
REDIM SHARED __UI_TempTexts(0 TO 100) AS STRING
REDIM SHARED Mask(0 TO 100) AS STRING
REDIM SHARED __UI_TempMask(0 TO 100) AS STRING
REDIM SHARED ToolTip(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 ControlDrawOrder(0) AS LONG
REDIM SHARED __UI_ThemeImages(0 TO 100) AS __UI_ThemeImagesType
REDIM SHARED __UI_WordWrapHistoryTexts(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_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_KeyCombo(0 TO 100) AS __UI_KeyCombos
Dim Shared __UI_TotalKeyCombos As Long, __UI_BypassKeyCombos As _Byte
Dim Shared table1252$(0 To 255), table437$(0 To 255)
Dim Shared __UI_MouseLeft As Integer, __UI_MouseTop As Integer
Dim Shared __UI_MouseWheel As Integer, __UI_MouseButtonsSwap As _Byte
Dim Shared __UI_PrevMouseLeft As Integer, __UI_PrevMouseTop As Integer
Dim Shared __UI_MouseButton1 As _Byte, __UI_MouseButton2 As _Byte
Dim Shared __UI_MouseIsDown As _Byte, __UI_MouseDownOnID As Long
Dim Shared __UI_Mouse2IsDown As _Byte, __UI_Mouse2DownOnID As Long
Dim Shared __UI_PreviousMouseDownOnID 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_AltIsDown As _Byte, __UI_ShowHotKeys As _Byte, __UI_AltCombo$
Dim Shared __UI_LastMouseClick As Single, __UI_MouseDownOnScrollbar As Single
Dim Shared __UI_DragX As Integer, __UI_DragY As Integer
Dim Shared __UI_DefaultButtonID As Long
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_HoveringID As Long, __UI_LastHoveringID As Long, __UI_BelowHoveringID 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_ResizeHandleHover As _Byte
Dim Shared __UI_IsSelectingText As _Byte, __UI_IsSelectingTextOnID As Long
Dim Shared __UI_SelectedText As String, __UI_SelectionLength As Long
Dim Shared __UI_StateHasChanged As _Byte
Dim Shared __UI_DraggingThumb As _Byte, __UI_ThumbDragTop As Integer
Dim Shared __UI_DraggingThumbOnID As Long
Dim Shared __UI_HasInput As _Byte, __UI_ProcessInputTimer As Single
Dim Shared __UI_UnloadSignal As _Byte, __UI_HasResized As _Byte
Dim Shared __UI_ExitTriggered As _Byte
Dim Shared __UI_Loaded As _Byte
Dim Shared __UI_EventsTimer As Integer, __UI_RefreshTimer As Integer
Dim Shared __UI_ActiveDropdownList As Long, __UI_ParentDropdownList As Long
Dim Shared __UI_TotalActiveMenus As Long, __UI_ActiveMenuIsContextMenu As _Byte
Dim Shared __UI_SubMenuDelay As Single, __UI_HoveringSubMenu As _Byte
Dim Shared __UI_TopMenuBarItem 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_FormID As Long, __UI_HasMenuBar As Long
Dim Shared __UI_ScrollbarWidth As Integer, __UI_ScrollbarButtonHeight 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_ForceRedraw As _Byte, __UI_AutoRefresh As _Byte
Dim Shared __UI_CurrentTitle As String
Dim Shared __UI_DesignMode As _Byte, __UI_FirstSelectedID 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_LastRenderedCharCount As Long
Dim Shared __UI_SelectionRectangleTop As Integer, __UI_SelectionRectangleLeft As Integer
Dim Shared __UI_SelectionRectangle 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_SnappedByProximityX As _Byte, __UI_SnappedByProximityY As _Byte
Dim Shared __UI_SnappedX As Integer, __UI_SnappedY As Integer
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_FrameRate As Single, __UI_Font8Offset As Integer, __UI_Font16Offset As Integer
Dim Shared __UI_ClipboardCheck$, __UI_MenuBarOffsetV 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_ContextMenuSourceID As Long
Dim Shared __UI_FKey(1 To 12) As Long
DIM SHARED __UI_TotalKeyCombos AS LONG, __UI_BypassKeyCombos AS _BYTE
DIM SHARED table1252$(0 TO 255), table437$(0 TO 255)
DIM SHARED __UI_MouseLeft AS INTEGER, __UI_MouseTop AS INTEGER
DIM SHARED __UI_MouseWheel AS INTEGER, __UI_MouseButtonsSwap AS _BYTE
DIM SHARED __UI_PrevMouseLeft AS INTEGER, __UI_PrevMouseTop AS INTEGER
DIM SHARED __UI_MouseButton1 AS _BYTE, __UI_MouseButton2 AS _BYTE
DIM SHARED __UI_MouseIsDown AS _BYTE, __UI_MouseDownOnID AS LONG
DIM SHARED __UI_Mouse2IsDown AS _BYTE, __UI_Mouse2DownOnID AS LONG
DIM SHARED __UI_PreviousMouseDownOnID 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_AltIsDown AS _BYTE, __UI_ShowHotKeys AS _BYTE, __UI_AltCombo$
DIM SHARED __UI_LastMouseClick AS SINGLE, __UI_MouseDownOnScrollbar AS SINGLE
DIM SHARED __UI_DragX AS INTEGER, __UI_DragY AS INTEGER
DIM SHARED __UI_DefaultButtonID AS LONG
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_HoveringID AS LONG, __UI_LastHoveringID AS LONG, __UI_BelowHoveringID 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_ResizeHandleHover AS _BYTE
DIM SHARED __UI_IsSelectingText AS _BYTE, __UI_IsSelectingTextOnID AS LONG
DIM SHARED __UI_SelectedText AS STRING, __UI_SelectionLength AS LONG
DIM SHARED __UI_StateHasChanged AS _BYTE
DIM SHARED __UI_DraggingThumb AS _BYTE, __UI_ThumbDragTop AS INTEGER
DIM SHARED __UI_DraggingThumbOnID AS LONG
DIM SHARED __UI_HasInput AS _BYTE, __UI_ProcessInputTimer AS SINGLE
DIM SHARED __UI_UnloadSignal AS _BYTE, __UI_HasResized AS _BYTE
DIM SHARED __UI_ExitTriggered AS _BYTE
DIM SHARED __UI_Loaded AS _BYTE
DIM SHARED __UI_EventsTimer AS INTEGER, __UI_RefreshTimer AS INTEGER
DIM SHARED __UI_ActiveDropdownList AS LONG, __UI_ParentDropdownList AS LONG
DIM SHARED __UI_TotalActiveMenus AS LONG, __UI_ActiveMenuIsContextMenu AS _BYTE
DIM SHARED __UI_SubMenuDelay AS SINGLE, __UI_HoveringSubMenu AS _BYTE
DIM SHARED __UI_TopMenuBarItem 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_FormID AS LONG, __UI_HasMenuBar AS LONG
DIM SHARED __UI_ScrollbarWidth AS INTEGER, __UI_ScrollbarButtonHeight 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_ForceRedraw AS _BYTE, __UI_AutoRefresh AS _BYTE
DIM SHARED __UI_CurrentTitle AS STRING
DIM SHARED __UI_DesignMode AS _BYTE, __UI_FirstSelectedID 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_LastRenderedCharCount AS LONG
DIM SHARED __UI_SelectionRectangleTop AS INTEGER, __UI_SelectionRectangleLeft AS INTEGER
DIM SHARED __UI_SelectionRectangle 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_SnappedByProximityX AS _BYTE, __UI_SnappedByProximityY AS _BYTE
DIM SHARED __UI_SnappedX AS INTEGER, __UI_SnappedY AS INTEGER
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_FrameRate AS SINGLE, __UI_Font8Offset AS INTEGER, __UI_Font16Offset AS INTEGER
DIM SHARED __UI_ClipboardCheck$, __UI_MenuBarOffsetV 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_ContextMenuSourceID AS LONG
DIM SHARED __UI_FKey(1 TO 12) AS LONG
'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_Frame).Name = "Frame"

8
InForm/InFormVersion.bas
View file

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

5888
InForm/UiEditor.bas
View file

File diff suppressed because it is too large Load diff

5432
InForm/UiEditorPreview.bas
View file

File diff suppressed because it is too large Load diff

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

94
InForm/extensions/gifplay.bi
View file

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

98
InForm/extensions/gifplaySample.bas
View file

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

26
InForm/ini.bi
View file

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

852
InForm/ini.bm
View file

File diff suppressed because it is too large Load diff

412
InForm/vbdos2inform.bas
View file

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