Compare commits
71 commits
931a8e0f1d
...
fa00fa0f9b
Author | SHA1 | Date | |
---|---|---|---|
fa00fa0f9b | |||
33f896aaaa | |||
022fd0a97f | |||
6f5546221d | |||
07a2b55433 | |||
0918df0d11 | |||
4e6a167f15 | |||
c23c1e85d1 | |||
1b7ccb6891 | |||
79d319ee77 | |||
347b7e07fe | |||
a76449ad62 | |||
b62e99935b | |||
af6eb0957d | |||
db355486c1 | |||
08121bfb4f | |||
9e7b10b283 | |||
e02474e09f | |||
85fec0c0fc | |||
80c99f5e90 | |||
6ecde5b106 | |||
006980987f | |||
338232bab2 | |||
47f51909a8 | |||
3867088da3 | |||
ce2d98fb3e | |||
b5bb8a6f5c | |||
e576210b9e | |||
2de157987d | |||
3cfec04cce | |||
1ad363bec8 | |||
28d9a5b56b | |||
ed6305b10c | |||
a7df4058e0 | |||
2bbd574a22 | |||
c34e514e18 | |||
0039fd6ade | |||
6fe16f957c | |||
e2ee59af0f | |||
4052343623 | |||
a4166a9091 | |||
71363923ce | |||
e01342ef04 | |||
b6515f6ea8 | |||
a05d79f5b4 | |||
3ca90982c6 | |||
7f39847ce2 | |||
e5b60db74d | |||
10b66ac722 | |||
a15eb6f601 | |||
1451684677 | |||
3ce23c8d1f | |||
7305a3ecca | |||
8a7f850c93 | |||
a3ba9a6feb | |||
fb177d6abf | |||
fdf2e841ec | |||
42a0b9d017 | |||
fc4d90c25e | |||
527e53143a | |||
ea659c62be | |||
bea4115510 | |||
72368e2ca2 | |||
2719b4801a | |||
c9ba19465b | |||
b0053228d8 | |||
dbb7a97a0c | |||
5d833897ca | |||
7780ac9ceb | |||
6309128821 | |||
36a7f9a339 |
2
.gitattributes
vendored
Normal file
|
@ -0,0 +1,2 @@
|
|||
# Auto detect text files and perform LF normalization
|
||||
* text=auto
|
19
.gitignore
vendored
|
@ -1,2 +1,17 @@
|
|||
/build.bat
|
||||
/copy.bat
|
||||
# Ignore all
|
||||
*
|
||||
# Unignore all with extensions
|
||||
!*.*
|
||||
# Unignore all dirs
|
||||
!*/
|
||||
# Unignore wiki
|
||||
!docs/wiki
|
||||
# Ignore all exe files
|
||||
*.exe
|
||||
# Ignore all ini files
|
||||
*.ini
|
||||
# Other temp files
|
||||
*.frmbin
|
||||
#Ignore macOS stuff
|
||||
*.command
|
||||
!setup_inform_osx.command
|
||||
|
|
3
.gitmodules
vendored
Normal file
|
@ -0,0 +1,3 @@
|
|||
[submodule "docs/wiki"]
|
||||
path = docs/wiki
|
||||
url = https://github.com/a740g/InForm-PE.wiki
|
458
InForm/InForm.bi
|
@ -1,352 +1,118 @@
|
|||
'InForm - GUI library for QB64
|
||||
'Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
|
||||
'
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
' InForm-PE GUI engine for QB64-PE
|
||||
' Copyright (c) 2024 Samuel Gomes
|
||||
' Copyright (c) 2023 George McGinn
|
||||
' Copyright (c) 2022 Fellippe Heitor
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
DECLARE LIBRARY
|
||||
FUNCTION __UI_GetPID ALIAS getpid ()
|
||||
END DECLARE
|
||||
$IF INFORM_BI = UNDEFINED THEN
|
||||
$LET INFORM_BI = TRUE
|
||||
|
||||
DECLARE CUSTOMTYPE LIBRARY
|
||||
SUB __UI_MemCopy ALIAS memcpy (BYVAL dest AS _OFFSET, BYVAL source AS _OFFSET, BYVAL bytes AS LONG)
|
||||
END DECLARE
|
||||
$SCREENHIDE
|
||||
_CONTROLCHR OFF
|
||||
|
||||
DECLARE LIBRARY "falcon"
|
||||
SUB uprint_extra (BYVAL x&, BYVAL y&, BYVAL chars%&, BYVAL length%&, BYVAL kern&, BYVAL do_render&, txt_width&, BYVAL charpos%&, charcount&, BYVAL colour~&, BYVAL max_width&)
|
||||
FUNCTION uprint (BYVAL x&, BYVAL y&, chars$, BYVAL txt_len&, BYVAL colour~&, BYVAL max_width&)
|
||||
FUNCTION uprintwidth (chars$, BYVAL txt_len&, BYVAL max_width&)
|
||||
FUNCTION uheight& ()
|
||||
FUNCTION falcon_uspacing& ALIAS uspacing ()
|
||||
FUNCTION uascension& ()
|
||||
END DECLARE
|
||||
'$INCLUDE:'InFormCommon.bi'
|
||||
|
||||
$IF WIN THEN
|
||||
DECLARE LIBRARY
|
||||
FUNCTION __UI_MB& ALIAS MessageBox (BYVAL ignore&, message$, title$, BYVAL type&)
|
||||
FUNCTION GetSystemMetrics& (BYVAL WhichMetric&)
|
||||
END DECLARE
|
||||
'Control types: -----------------------------------------------
|
||||
__UI_Type(__UI_Type_Form).Name = "Form"
|
||||
|
||||
__UI_Type(__UI_Type_Frame).Name = "Frame"
|
||||
__UI_Type(__UI_Type_Frame).DefaultWidth = 230
|
||||
__UI_Type(__UI_Type_Frame).DefaultHeight = 150
|
||||
|
||||
__UI_Type(__UI_Type_Button).Name = "Button"
|
||||
__UI_Type(__UI_Type_Button).DefaultWidth = 80
|
||||
__UI_Type(__UI_Type_Button).DefaultHeight = 23
|
||||
|
||||
__UI_Type(__UI_Type_Label).Name = "Label"
|
||||
__UI_Type(__UI_Type_Label).DefaultWidth = 150
|
||||
__UI_Type(__UI_Type_Label).DefaultHeight = 23
|
||||
|
||||
__UI_Type(__UI_Type_CheckBox).Name = "CheckBox"
|
||||
__UI_Type(__UI_Type_CheckBox).DefaultWidth = 150
|
||||
__UI_Type(__UI_Type_CheckBox).DefaultHeight = 23
|
||||
__UI_Type(__UI_Type_CheckBox).TurnsInto = __UI_Type_ToggleSwitch
|
||||
|
||||
__UI_Type(__UI_Type_RadioButton).Name = "RadioButton"
|
||||
__UI_Type(__UI_Type_RadioButton).DefaultWidth = 150
|
||||
__UI_Type(__UI_Type_RadioButton).DefaultHeight = 23
|
||||
|
||||
__UI_Type(__UI_Type_TextBox).Name = "TextBox"
|
||||
__UI_Type(__UI_Type_TextBox).DefaultWidth = 120
|
||||
__UI_Type(__UI_Type_TextBox).DefaultHeight = 23
|
||||
|
||||
__UI_Type(__UI_Type_ProgressBar).Name = "ProgressBar"
|
||||
__UI_Type(__UI_Type_ProgressBar).DefaultWidth = 300
|
||||
__UI_Type(__UI_Type_ProgressBar).DefaultHeight = 23
|
||||
|
||||
__UI_Type(__UI_Type_ListBox).Name = "ListBox"
|
||||
__UI_Type(__UI_Type_ListBox).DefaultWidth = 200
|
||||
__UI_Type(__UI_Type_ListBox).DefaultHeight = 200
|
||||
__UI_Type(__UI_Type_ListBox).TurnsInto = __UI_Type_DropdownList
|
||||
|
||||
__UI_Type(__UI_Type_DropdownList).Name = "DropdownList"
|
||||
__UI_Type(__UI_Type_DropdownList).DefaultWidth = 200
|
||||
__UI_Type(__UI_Type_DropdownList).DefaultHeight = 23
|
||||
__UI_Type(__UI_Type_DropdownList).TurnsInto = __UI_Type_ListBox
|
||||
|
||||
__UI_Type(__UI_Type_MenuBar).Name = "MenuBar"
|
||||
__UI_Type(__UI_Type_MenuBar).TurnsInto = __UI_Type_ContextMenu
|
||||
__UI_Type(__UI_Type_MenuBar).RestrictResize = __UI_CantResizeV
|
||||
|
||||
__UI_Type(__UI_Type_MenuItem).Name = "MenuItem"
|
||||
__UI_Type(__UI_Type_MenuItem).RestrictResize = __UI_CantResizeV
|
||||
|
||||
__UI_Type(__UI_Type_MenuPanel).Name = "MenuPanel"
|
||||
|
||||
__UI_Type(__UI_Type_PictureBox).Name = "PictureBox"
|
||||
__UI_Type(__UI_Type_PictureBox).DefaultWidth = 230
|
||||
__UI_Type(__UI_Type_PictureBox).DefaultHeight = 150
|
||||
|
||||
__UI_Type(__UI_Type_TrackBar).Name = "TrackBar"
|
||||
__UI_Type(__UI_Type_TrackBar).DefaultWidth = 300
|
||||
__UI_Type(__UI_Type_TrackBar).DefaultHeight = 40
|
||||
__UI_Type(__UI_Type_TrackBar).MinimumHeight = 30
|
||||
__UI_Type(__UI_Type_TrackBar).RestrictResize = __UI_CantResizeV
|
||||
|
||||
__UI_Type(__UI_Type_ContextMenu).Name = "ContextMenu"
|
||||
__UI_Type(__UI_Type_ContextMenu).TurnsInto = __UI_Type_MenuBar
|
||||
__UI_Type(__UI_Type_ContextMenu).RestrictResize = __UI_CantResize
|
||||
__UI_Type(__UI_Type_ContextMenu).DefaultWidth = 22
|
||||
__UI_Type(__UI_Type_ContextMenu).DefaultHeight = 22
|
||||
|
||||
__UI_Type(__UI_Type_Font).Name = "Font"
|
||||
|
||||
__UI_Type(__UI_Type_ToggleSwitch).Name = "ToggleSwitch"
|
||||
__UI_Type(__UI_Type_ToggleSwitch).DefaultWidth = 40
|
||||
__UI_Type(__UI_Type_ToggleSwitch).DefaultHeight = 17
|
||||
__UI_Type(__UI_Type_ToggleSwitch).TurnsInto = __UI_Type_CheckBox
|
||||
__UI_Type(__UI_Type_ToggleSwitch).RestrictResize = __UI_CantResize
|
||||
'--------------------------------------------------------------
|
||||
|
||||
__UI_RestoreFKeys
|
||||
|
||||
__UI_SubMenuDelay = .4
|
||||
__UI_SnapDistance = 5
|
||||
__UI_SnapDistanceFromForm = 10
|
||||
__UI_MaxBorderSize = 10
|
||||
__UI_Font8Offset = 5
|
||||
__UI_Font16Offset = 3
|
||||
__UI_ClipboardCheck$ = "InForm" + STRING$(2, 10) + "BEGIN CONTROL DATA" + CHR$(10) + STRING$(60, 45) + CHR$(10)
|
||||
|
||||
__UI_ThemeSetup
|
||||
__UI_InternalMenus
|
||||
__UI_LoadForm
|
||||
|
||||
__UI_Init
|
||||
|
||||
'Main loop
|
||||
DO
|
||||
_LIMIT 1
|
||||
LOOP
|
||||
|
||||
SYSTEM
|
||||
|
||||
__UI_ErrorHandler:
|
||||
RESUME NEXT
|
||||
|
||||
CONST __UI_SM_SWAPBUTTON = 23
|
||||
$ELSE
|
||||
DECLARE LIBRARY ""
|
||||
FUNCTION __UI_MB& ALIAS MessageBox (BYVAL ignore&, message$, title$, BYVAL type&)
|
||||
END DECLARE
|
||||
$END IF
|
||||
|
||||
$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_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_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
|
||||
|
||||
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_LastRenderedLineWidth AS LONG, __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
|
||||
__UI_Type(__UI_Type_Form).Name = "Form"
|
||||
|
||||
__UI_Type(__UI_Type_Frame).Name = "Frame"
|
||||
__UI_Type(__UI_Type_Frame).DefaultWidth = 230
|
||||
__UI_Type(__UI_Type_Frame).DefaultHeight = 150
|
||||
|
||||
__UI_Type(__UI_Type_Button).Name = "Button"
|
||||
__UI_Type(__UI_Type_Button).DefaultWidth = 80
|
||||
__UI_Type(__UI_Type_Button).DefaultHeight = 23
|
||||
|
||||
__UI_Type(__UI_Type_Label).Name = "Label"
|
||||
__UI_Type(__UI_Type_Label).DefaultWidth = 150
|
||||
__UI_Type(__UI_Type_Label).DefaultHeight = 23
|
||||
|
||||
__UI_Type(__UI_Type_CheckBox).Name = "CheckBox"
|
||||
__UI_Type(__UI_Type_CheckBox).DefaultWidth = 150
|
||||
__UI_Type(__UI_Type_CheckBox).DefaultHeight = 23
|
||||
__UI_Type(__UI_Type_CheckBox).TurnsInto = __UI_Type_ToggleSwitch
|
||||
|
||||
__UI_Type(__UI_Type_RadioButton).Name = "RadioButton"
|
||||
__UI_Type(__UI_Type_RadioButton).DefaultWidth = 150
|
||||
__UI_Type(__UI_Type_RadioButton).DefaultHeight = 23
|
||||
|
||||
__UI_Type(__UI_Type_TextBox).Name = "TextBox"
|
||||
__UI_Type(__UI_Type_TextBox).DefaultWidth = 120
|
||||
__UI_Type(__UI_Type_TextBox).DefaultHeight = 23
|
||||
|
||||
__UI_Type(__UI_Type_ProgressBar).Name = "ProgressBar"
|
||||
__UI_Type(__UI_Type_ProgressBar).DefaultWidth = 300
|
||||
__UI_Type(__UI_Type_ProgressBar).DefaultHeight = 23
|
||||
|
||||
__UI_Type(__UI_Type_ListBox).Name = "ListBox"
|
||||
__UI_Type(__UI_Type_ListBox).DefaultWidth = 200
|
||||
__UI_Type(__UI_Type_ListBox).DefaultHeight = 200
|
||||
__UI_Type(__UI_Type_ListBox).TurnsInto = __UI_Type_DropdownList
|
||||
|
||||
__UI_Type(__UI_Type_DropdownList).Name = "DropdownList"
|
||||
__UI_Type(__UI_Type_DropdownList).DefaultWidth = 200
|
||||
__UI_Type(__UI_Type_DropdownList).DefaultHeight = 23
|
||||
__UI_Type(__UI_Type_DropdownList).TurnsInto = __UI_Type_ListBox
|
||||
|
||||
__UI_Type(__UI_Type_MenuBar).Name = "MenuBar"
|
||||
__UI_Type(__UI_Type_MenuBar).TurnsInto = __UI_Type_ContextMenu
|
||||
__UI_Type(__UI_Type_MenuBar).RestrictResize = __UI_CantResizeV
|
||||
|
||||
__UI_Type(__UI_Type_MenuItem).Name = "MenuItem"
|
||||
__UI_Type(__UI_Type_MenuItem).RestrictResize = __UI_CantResizeV
|
||||
|
||||
__UI_Type(__UI_Type_MenuPanel).Name = "MenuPanel"
|
||||
|
||||
__UI_Type(__UI_Type_PictureBox).Name = "PictureBox"
|
||||
__UI_Type(__UI_Type_PictureBox).DefaultWidth = 230
|
||||
__UI_Type(__UI_Type_PictureBox).DefaultHeight = 150
|
||||
|
||||
__UI_Type(__UI_Type_TrackBar).Name = "TrackBar"
|
||||
__UI_Type(__UI_Type_TrackBar).DefaultWidth = 300
|
||||
__UI_Type(__UI_Type_TrackBar).DefaultHeight = 40
|
||||
__UI_Type(__UI_Type_TrackBar).MinimumHeight = 30
|
||||
__UI_Type(__UI_Type_TrackBar).RestrictResize = __UI_CantResizeV
|
||||
|
||||
__UI_Type(__UI_Type_ContextMenu).Name = "ContextMenu"
|
||||
__UI_Type(__UI_Type_ContextMenu).TurnsInto = __UI_Type_MenuBar
|
||||
__UI_Type(__UI_Type_ContextMenu).RestrictResize = __UI_CantResize
|
||||
__UI_Type(__UI_Type_ContextMenu).DefaultWidth = 22
|
||||
__UI_Type(__UI_Type_ContextMenu).DefaultHeight = 22
|
||||
|
||||
__UI_Type(__UI_Type_Font).Name = "Font"
|
||||
|
||||
__UI_Type(__UI_Type_ToggleSwitch).Name = "ToggleSwitch"
|
||||
__UI_Type(__UI_Type_ToggleSwitch).DefaultWidth = 40
|
||||
__UI_Type(__UI_Type_ToggleSwitch).DefaultHeight = 17
|
||||
__UI_Type(__UI_Type_ToggleSwitch).TurnsInto = __UI_Type_CheckBox
|
||||
__UI_Type(__UI_Type_ToggleSwitch).RestrictResize = __UI_CantResize
|
||||
'--------------------------------------------------------------
|
||||
|
||||
__UI_RestoreFKeys
|
||||
|
||||
CONST True = -1, False = 0
|
||||
'$INCLUDE:'InFormVersion.bas'
|
||||
__UI_SubMenuDelay = .4
|
||||
__UI_SnapDistance = 5
|
||||
__UI_SnapDistanceFromForm = 10
|
||||
__UI_MaxBorderSize = 10
|
||||
__UI_Font8Offset = 5
|
||||
__UI_Font16Offset = 3
|
||||
__UI_ClipboardCheck$ = "InForm" + STRING$(2, 10) + "BEGIN CONTROL DATA" + CHR$(10) + STRING$(60, 45) + CHR$(10)
|
||||
|
||||
__UI_ThemeSetup
|
||||
__UI_InternalMenus
|
||||
__UI_LoadForm
|
||||
|
||||
__UI_Init
|
||||
|
||||
'Main loop
|
||||
DO
|
||||
_LIMIT 1
|
||||
LOOP
|
||||
|
||||
SYSTEM
|
||||
__UI_ErrorHandler:
|
||||
RESUME NEXT
|
||||
|
||||
|
|
15625
InForm/InForm.ui
342
InForm/InFormCommon.bi
Normal file
|
@ -0,0 +1,342 @@
|
|||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
' Common InForm header. This is included by the main InForm header file
|
||||
' Copyright (c) 2024 Samuel Gomes
|
||||
' Copyright (c) 2022 Fellippe Heitor
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
$IF INFORMCOMMON_BI = UNDEFINED THEN
|
||||
$LET INFORMCOMMON_BI = TRUE
|
||||
|
||||
' Do a complier check to ensure we have the minimum version needed
|
||||
$IF VERSION < 3.11.0 THEN
|
||||
$ERROR 'This requires the latest version of QB64-PE from https://github.com/QB64-Phoenix-Edition/QB64pe/releases'
|
||||
$END IF
|
||||
|
||||
'$INCLUDE:'InFormVersion.bi'
|
||||
'$INCLUDE:'extensions/HashTable.bi'
|
||||
|
||||
CONST FALSE%% = 0%%, TRUE%% = NOT FALSE
|
||||
|
||||
' InForm theme image IDs
|
||||
CONST __INFORM_THEME_IMAGE_ARROWS~%% = 1~%%
|
||||
CONST __INFORM_THEME_IMAGE_BUTTON~%% = 2~%%
|
||||
CONST __INFORM_THEME_IMAGE_CHECKBOX~%% = 3~%%
|
||||
CONST __INFORM_THEME_IMAGE_FRAME~%% = 4~%%
|
||||
CONST __INFORM_THEME_IMAGE_MENUCHECKMARK~%% = 5~%%
|
||||
CONST __INFORM_THEME_IMAGE_NOTFOUND~%% = 6~%%
|
||||
CONST __INFORM_THEME_IMAGE_PROGRESSCHUNK~%% = 7~%%
|
||||
CONST __INFORM_THEME_IMAGE_PROGRESSTRACK~%% = 8~%%
|
||||
CONST __INFORM_THEME_IMAGE_RADIOBUTTON~%% = 9~%%
|
||||
CONST __INFORM_THEME_IMAGE_SCROLLBUTTONS~%% = 10~%%
|
||||
CONST __INFORM_THEME_IMAGE_SCROLLHBUTTONS~%% = 11~%%
|
||||
CONST __INFORM_THEME_IMAGE_SCROLLHTHUMB~%% = 12~%%
|
||||
CONST __INFORM_THEME_IMAGE_SCROLLHTRACK~%% = 13~%%
|
||||
CONST __INFORM_THEME_IMAGE_SCROLLTHUMB~%% = 14~%%
|
||||
CONST __INFORM_THEME_IMAGE_SCROLLTRACK~%% = 15~%%
|
||||
CONST __INFORM_THEME_IMAGE_SLIDERDOWN~%% = 16~%%
|
||||
CONST __INFORM_THEME_IMAGE_SLIDERTRACK~%% = 17~%%
|
||||
|
||||
'Control types:
|
||||
CONST __UI_Type_Form%% = 1%%
|
||||
CONST __UI_Type_Frame%% = 2%%
|
||||
CONST __UI_Type_Button%% = 3%%
|
||||
CONST __UI_Type_Label%% = 4%%
|
||||
CONST __UI_Type_CheckBox%% = 5%%
|
||||
CONST __UI_Type_RadioButton%% = 6%%
|
||||
CONST __UI_Type_TextBox%% = 7%%
|
||||
CONST __UI_Type_ProgressBar%% = 8%%
|
||||
CONST __UI_Type_ListBox%% = 9%%
|
||||
CONST __UI_Type_DropdownList%% = 10%%
|
||||
CONST __UI_Type_MenuBar%% = 11%%
|
||||
CONST __UI_Type_MenuItem%% = 12%%
|
||||
CONST __UI_Type_MenuPanel%% = 13%%
|
||||
CONST __UI_Type_PictureBox%% = 14%%
|
||||
CONST __UI_Type_TrackBar%% = 15%%
|
||||
CONST __UI_Type_ContextMenu%% = 16%%
|
||||
CONST __UI_Type_Font%% = 17%%
|
||||
CONST __UI_Type_ToggleSwitch%% = 18%%
|
||||
|
||||
'Back styles:
|
||||
CONST __UI_Opaque%% = 0%%
|
||||
CONST __UI_Transparent%% = -1%%
|
||||
|
||||
'Text alignment
|
||||
CONST __UI_Left%% = 0%%
|
||||
CONST __UI_Center%% = 1%%
|
||||
CONST __UI_Right%% = 2%%
|
||||
CONST __UI_Top%% = 0%%
|
||||
CONST __UI_Middle%% = 1%%
|
||||
CONST __UI_Bottom%% = 2%%
|
||||
|
||||
'Textbox controls
|
||||
CONST __UI_NumericWithoutBounds%% = -1%%
|
||||
CONST __UI_NumericWithBounds%% = 2%%
|
||||
|
||||
'BulletStyle
|
||||
CONST __UI_CheckMark%% = 0%%
|
||||
CONST __UI_Bullet%% = 1%%
|
||||
|
||||
'General constants
|
||||
CONST __UI_ToolTipTimeOut! = 0.8!
|
||||
CONST __UI_CantResizeV%% = 1%%
|
||||
CONST __UI_CantResizeH%% = 2%%
|
||||
CONST __UI_CantResize%% = 3%%
|
||||
|
||||
'Messagebox constants
|
||||
CONST MsgBox_OkOnly& = 1&
|
||||
CONST MsgBox_OkCancel& = 2&
|
||||
CONST MsgBox_AbortRetryIgnore& = 4&
|
||||
CONST MsgBox_YesNoCancel& = 8&
|
||||
CONST MsgBox_YesNo& = 16&
|
||||
CONST MsgBox_RetryCancel& = 32&
|
||||
CONST MsgBox_CancelTryAgainContinue& = 64&
|
||||
|
||||
CONST MsgBox_Critical& = 128&
|
||||
CONST MsgBox_Question& = 256&
|
||||
CONST MsgBox_Exclamation& = 512&
|
||||
CONST MsgBox_Information& = 1024&
|
||||
|
||||
CONST MsgBox_DefaultButton1& = 2048&
|
||||
CONST MsgBox_DefaultButton2& = 4096&
|
||||
CONST MsgBox_DefaultButton3& = 8192&
|
||||
CONST MsgBox_Defaultbutton4& = 16384&
|
||||
|
||||
CONST MsgBox_AppModal& = 32768&
|
||||
CONST MsgBox_SystemModal& = 65536&
|
||||
CONST MsgBox_SetForeground& = 131072&
|
||||
|
||||
CONST MsgBox_Ok& = 1&
|
||||
CONST MsgBox_Yes& = 2&
|
||||
CONST MsgBox_No& = 3&
|
||||
CONST MsgBox_Cancel& = 4&
|
||||
CONST MsgBox_Abort& = 5&
|
||||
CONST MsgBox_Retry& = 6&
|
||||
CONST MsgBox_Ignore& = 7&
|
||||
CONST MsgBox_TryAgain& = 8&
|
||||
CONST MsgBox_Continue& = 9&
|
||||
|
||||
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
|
||||
|
||||
$IF WIN THEN
|
||||
DECLARE LIBRARY
|
||||
FUNCTION GetSystemMetrics& (BYVAL WhichMetric&)
|
||||
END DECLARE
|
||||
|
||||
CONST __UI_SM_SWAPBUTTON = 23
|
||||
$END IF
|
||||
|
||||
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_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
|
||||
|
||||
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 __UI_ThemeImages(0 TO 0) AS HashTableType
|
||||
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_Type(0 TO 18) AS __UI_Types
|
||||
|
||||
$END IF
|
|
@ -1,5 +0,0 @@
|
|||
'Starting with v1.0, __UI_VersionNumber is actually the current build.
|
||||
Const __UI_Version = "v1.4"
|
||||
Const __UI_VersionNumber = 21
|
||||
Const __UI_VersionIsBeta = 0
|
||||
Const __UI_CopyrightSpan = "2016-2021"
|
29
InForm/InFormVersion.bi
Normal file
|
@ -0,0 +1,29 @@
|
|||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
' InForm SemVer (Major.Minor.Patch). This is included by the common header file
|
||||
' Copyright (c) 2024 Samuel Gomes
|
||||
' Copyright (c) 2022 Fellippe Heitor
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
$IF INFORMVERSION_BI = UNDEFINED THEN
|
||||
$LET INFORMVERSION_BI = TRUE
|
||||
|
||||
CONST __UI_VersionMajor = "1"
|
||||
CONST __UI_VersionMinor = "5"
|
||||
CONST __UI_VersionPatch = "3"
|
||||
CONST __UI_Version = __UI_VersionMajor + "." + __UI_VersionMinor + "." + __UI_VersionPatch
|
||||
|
||||
' This is only added when the file is included from UiEditor.bas
|
||||
$IF UIEDITOR_BAS = DEFINED THEN
|
||||
$VERSIONINFO:CompanyName='Samuel Gomes, George McGinn, Fellippe Heitor'
|
||||
$VERSIONINFO:FileDescription='InForm-PE Form Designer executable'
|
||||
$VERSIONINFO:InternalName='UiEditor'
|
||||
$VERSIONINFO:LegalCopyright='Copyright (c) 2024 Samuel Gomes, George McGinn, Fellippe Heitor'
|
||||
$VERSIONINFO:LegalTrademarks='All trademarks are property of their respective owners'
|
||||
$VERSIONINFO:OriginalFilename='UiEditor.exe'
|
||||
$VERSIONINFO:ProductName='InForm-PE Form Designer'
|
||||
$VERSIONINFO:Web='https://github.com/a740g/InForm-PE'
|
||||
$VERSIONINFO:Comments='https://github.com/a740g/InForm-PE'
|
||||
$VERSIONINFO:FILEVERSION#=1,5,3,0
|
||||
$VERSIONINFO:PRODUCTVERSION#=1,5,3,0
|
||||
$END IF
|
||||
$END IF
|
|
@ -1,21 +0,0 @@
|
|||
MIT License
|
||||
|
||||
Copyright (c) 2018 Fellippe Heitor
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
in the Software without restriction, including without limitation the rights
|
||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
copies of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in all
|
||||
copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
SOFTWARE.
|
7327
InForm/UiEditor.bas
|
@ -227,23 +227,6 @@ SUB __UI_LoadForm
|
|||
SetCaption __UI_NewID, "&Auto-name controls"
|
||||
Control(__UI_NewID).Value = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "OptionsMenuAutoUpdate", 155, 18, 0, 4, __UI_GetID("OptionsMenu"))
|
||||
$IF WIN THEN
|
||||
SetCaption __UI_NewID, "Auto-&Update"
|
||||
$ELSE
|
||||
SetCaption __UI_NewID, "Auto-&Update-"
|
||||
$END IF
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "OptionsMenuCheckUpdates", 155, 18, 0, 4, __UI_GetID("OptionsMenuAutoUpdate"))
|
||||
SetCaption __UI_NewID, "&Check for updates at start-up"
|
||||
Control(__UI_NewID).Value = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "OptionsMenuDevChannel", 155, 18, 0, 4, __UI_GetID("OptionsMenuAutoUpdate"))
|
||||
SetCaption __UI_NewID, "Receive &development updates-"
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "OptionsMenuCheckUpdatesNow", 155, 18, 0, 4, __UI_GetID("OptionsMenuAutoUpdate"))
|
||||
SetCaption __UI_NewID, "Check for updates &now"
|
||||
|
||||
$IF WIN THEN
|
||||
$ELSE
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "OptionsMenuSwapButtons", 0, 0, 0, 0, __UI_GetID("OptionsMenu"))
|
||||
|
@ -834,9 +817,11 @@ SUB __UI_LoadForm
|
|||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "CancelBindBT", 80, 23, 341, 220, __UI_GetID("SetControlBinding"))
|
||||
SetCaption __UI_NewID, "Cancel"
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_AssignIDs
|
||||
|
||||
UiEditor = __UI_GetID("UiEditor")
|
||||
StatusBar = __UI_GetID("StatusBar")
|
||||
FileMenu = __UI_GetID("FileMenu")
|
||||
|
@ -981,9 +966,6 @@ SUB __UI_AssignIDs
|
|||
ControlToggles = __UI_GetID("ControlToggles")
|
||||
BulletOptions = __UI_GetID("BulletOptions")
|
||||
BulletOptionsLB = __UI_GetID("BulletOptionsLB")
|
||||
OptionsMenuCheckUpdates = __UI_GetID("OptionsMenuCheckUpdates")
|
||||
OptionsMenuCheckUpdatesNow = __UI_GetID("OptionsMenuCheckUpdatesNow")
|
||||
OptionsMenuDevChannel = __UI_GetID("OptionsMenuDevChannel")
|
||||
BooleanOptions = __UI_GetID("BooleanOptions")
|
||||
BooleanLB = __UI_GetID("BooleanLB")
|
||||
FontList = __UI_GetID("FontList")
|
||||
|
@ -1025,4 +1007,5 @@ SUB __UI_AssignIDs
|
|||
TargetPropertyList = __UI_GetID("TargetPropertyList")
|
||||
BindBT = __UI_GetID("BindBT")
|
||||
CancelBindBT = __UI_GetID("CancelBindBT")
|
||||
|
||||
END SUB
|
||||
|
|
|
@ -2,16 +2,17 @@
|
|||
': InForm - GUI library for QB64 - Beta version 9
|
||||
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
|
||||
'-----------------------------------------------------------
|
||||
|
||||
SUB __UI_LoadForm
|
||||
|
||||
DIM __UI_NewID AS LONG
|
||||
|
||||
$RESIZE:ON
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Form, "Form1", 300, 300, 0, 0,0)
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Form, "Form1", 300, 300, 0, 0, 0)
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_AssignIDs
|
||||
|
||||
END SUB
|
||||
|
||||
|
|
192
InForm/extensions/Base64.bas
Normal file
|
@ -0,0 +1,192 @@
|
|||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
' Base64 encoder, decoder & resource loading library
|
||||
' Copyright (c) 2024 Samuel Gomes
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
$IF BASE64_BAS = UNDEFINED THEN
|
||||
$LET BASE64_BAS = TRUE
|
||||
|
||||
'-------------------------------------------------------------------------------------------------------------------
|
||||
' Test code for debugging the library
|
||||
'-------------------------------------------------------------------------------------------------------------------
|
||||
'DEFLNG A-Z
|
||||
'OPTION _EXPLICIT
|
||||
|
||||
'CONST ITERATIONS = 1000000
|
||||
'CONST LOREM_IPSUM = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut " + _
|
||||
' "labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip " + _
|
||||
' "ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat " + _
|
||||
' "nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
|
||||
|
||||
'DIM encTxt AS STRING, decTxt AS STRING, i AS LONG, t AS DOUBLE
|
||||
|
||||
'PRINT ITERATIONS; "iterations,"; LEN(LOREM_IPSUM); "bytes."
|
||||
|
||||
'PRINT "Base64 encode..."
|
||||
|
||||
't = TIMER
|
||||
'FOR i = 1 TO ITERATIONS
|
||||
' encTxt = Base64_Encode(LOREM_IPSUM)
|
||||
'NEXT
|
||||
'PRINT USING "#####.##### seconds"; TIMER - t
|
||||
|
||||
'PRINT "Base64 decode..."
|
||||
|
||||
't = TIMER
|
||||
'FOR i = 1 TO ITERATIONS
|
||||
' decTxt = Base64_Decode(encTxt)
|
||||
'NEXT
|
||||
'PRINT USING "#####.##### seconds"; TIMER - t
|
||||
|
||||
'IF _STRCMP(decTxt, LOREM_IPSUM) = 0 THEN
|
||||
' PRINT "Passed"
|
||||
'ELSE
|
||||
' PRINT "Failed"
|
||||
'END IF
|
||||
|
||||
'END
|
||||
'-------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
' Converts a normal string or binary data to a base64 string
|
||||
FUNCTION Base64_Encode$ (s AS STRING)
|
||||
CONST BASE64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
|
||||
|
||||
DIM srcSize AS _UNSIGNED LONG: srcSize = LEN(s)
|
||||
DIM srcSize3rem AS _UNSIGNED LONG: srcSize3rem = srcSize MOD 3
|
||||
DIM srcSize3mul AS _UNSIGNED LONG: srcSize3mul = srcSize - srcSize3rem
|
||||
DIM buffer AS STRING: buffer = SPACE$(((srcSize + 2) \ 3) * 4) ' preallocate complete buffer
|
||||
DIM j AS _UNSIGNED LONG: j = 1
|
||||
|
||||
DIM i AS _UNSIGNED LONG: FOR i = 1 TO srcSize3mul STEP 3
|
||||
DIM char1 AS _UNSIGNED _BYTE: char1 = ASC(s, i)
|
||||
DIM char2 AS _UNSIGNED _BYTE: char2 = ASC(s, i + 1)
|
||||
DIM char3 AS _UNSIGNED _BYTE: char3 = ASC(s, i + 2)
|
||||
|
||||
ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (_SHR(char1, 2)))
|
||||
j = j + 1
|
||||
ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (_SHL((char1 AND 3), 4) OR _SHR(char2, 4)))
|
||||
j = j + 1
|
||||
ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (_SHL((char2 AND 15), 2) OR _SHR(char3, 6)))
|
||||
j = j + 1
|
||||
ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (char3 AND 63))
|
||||
j = j + 1
|
||||
NEXT i
|
||||
|
||||
' Add padding
|
||||
IF srcSize3rem > 0 THEN
|
||||
char1 = ASC(s, i)
|
||||
|
||||
ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (_SHR(char1, 2)))
|
||||
j = j + 1
|
||||
|
||||
IF srcSize3rem = 1 THEN
|
||||
ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (_SHL(char1 AND 3, 4)))
|
||||
j = j + 1
|
||||
ASC(buffer, j) = 61 ' "="
|
||||
j = j + 1
|
||||
ASC(buffer, j) = 61 ' "="
|
||||
ELSE ' srcSize3rem = 2
|
||||
char2 = ASC(s, i + 1)
|
||||
|
||||
ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (_SHL((char1 AND 3), 4) OR _SHR(char2, 4)))
|
||||
j = j + 1
|
||||
ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (_SHL(char2 AND 15, 2)))
|
||||
j = j + 1
|
||||
ASC(buffer, j) = 61 ' "="
|
||||
END IF
|
||||
END IF
|
||||
|
||||
Base64_Encode = buffer
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Converts a base64 string to a normal string or binary data
|
||||
FUNCTION Base64_Decode$ (s AS STRING)
|
||||
DIM srcSize AS _UNSIGNED LONG: srcSize = LEN(s)
|
||||
DIM buffer AS STRING: buffer = SPACE$((srcSize \ 4) * 3) ' preallocate complete buffer
|
||||
DIM j AS _UNSIGNED LONG: j = 1
|
||||
DIM AS _UNSIGNED _BYTE index, char1, char2, char3, char4
|
||||
|
||||
DIM i AS _UNSIGNED LONG: FOR i = 1 TO srcSize STEP 4
|
||||
index = ASC(s, i): GOSUB find_index: char1 = index
|
||||
index = ASC(s, i + 1): GOSUB find_index: char2 = index
|
||||
index = ASC(s, i + 2): GOSUB find_index: char3 = index
|
||||
index = ASC(s, i + 3): GOSUB find_index: char4 = index
|
||||
|
||||
ASC(buffer, j) = _SHL(char1, 2) OR _SHR(char2, 4)
|
||||
j = j + 1
|
||||
ASC(buffer, j) = _SHL(char2 AND 15, 4) OR _SHR(char3, 2)
|
||||
j = j + 1
|
||||
ASC(buffer, j) = _SHL(char3 AND 3, 6) OR char4
|
||||
j = j + 1
|
||||
NEXT i
|
||||
|
||||
' Remove padding
|
||||
IF RIGHT$(s, 2) = "==" THEN
|
||||
buffer = LEFT$(buffer, LEN(buffer) - 2)
|
||||
ELSEIF RIGHT$(s, 1) = "=" THEN
|
||||
buffer = LEFT$(buffer, LEN(buffer) - 1)
|
||||
END IF
|
||||
|
||||
Base64_Decode = buffer
|
||||
EXIT FUNCTION
|
||||
|
||||
find_index:
|
||||
IF index >= 65 AND index <= 90 THEN
|
||||
index = index - 65
|
||||
ELSEIF index >= 97 AND index <= 122 THEN
|
||||
index = index - 97 + 26
|
||||
ELSEIF index >= 48 AND index <= 57 THEN
|
||||
index = index - 48 + 52
|
||||
ELSEIF index = 43 THEN
|
||||
index = 62
|
||||
ELSEIF index = 47 THEN
|
||||
index = 63
|
||||
END IF
|
||||
RETURN
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' This function loads a resource directly from a string variable or constant (like the ones made by Bin2Data)
|
||||
FUNCTION Base64_LoadResourceString$ (src AS STRING, ogSize AS _UNSIGNED LONG, isComp AS _BYTE)
|
||||
' Decode the data
|
||||
DIM buffer AS STRING: buffer = Base64_Decode(src)
|
||||
|
||||
' Expand the data if needed
|
||||
IF isComp THEN buffer = _INFLATE$(buffer, ogSize)
|
||||
|
||||
Base64_LoadResourceString = buffer
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Loads a binary file encoded with Bin2Data
|
||||
' Usage:
|
||||
' 1. Encode the binary file with Bin2Data
|
||||
' 2. Include the file or it's contents
|
||||
' 3. Load the file like so:
|
||||
' Restore label_generated_by_bin2data
|
||||
' Dim buffer As String
|
||||
' buffer = LoadResource ' buffer will now hold the contents of the file
|
||||
FUNCTION Base64_LoadResourceData$
|
||||
DIM ogSize AS _UNSIGNED LONG, resize AS _UNSIGNED LONG, isComp AS _BYTE
|
||||
READ ogSize, resize, isComp ' read the header
|
||||
|
||||
DIM buffer AS STRING: buffer = SPACE$(resize) ' preallocate complete buffer
|
||||
|
||||
' Read the whole resource data
|
||||
DIM i AS _UNSIGNED LONG: DO WHILE i < resize
|
||||
DIM chunk AS STRING: READ chunk
|
||||
MID$(buffer, i + 1) = chunk
|
||||
i = i + LEN(chunk)
|
||||
LOOP
|
||||
|
||||
' Decode the data
|
||||
buffer = Base64_Decode(buffer)
|
||||
|
||||
' Expand the data if needed
|
||||
IF isComp THEN buffer = _INFLATE$(buffer, ogSize)
|
||||
|
||||
Base64_LoadResourceData = buffer
|
||||
END FUNCTION
|
||||
|
||||
$END IF
|
949
InForm/extensions/GIFPlay.bas
Normal file
|
@ -0,0 +1,949 @@
|
|||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
' Animated GIF Player library
|
||||
' Copyright (c) 2024 Samuel Gomes
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
$IF GIFPLAY_BAS = UNDEFINED THEN
|
||||
$LET GIFPLAY_BAS = TRUE
|
||||
|
||||
'$INCLUDE:'GIFPlay.bi'
|
||||
|
||||
'-------------------------------------------------------------------------------------------------------------------
|
||||
' Test code for debugging the library
|
||||
'-------------------------------------------------------------------------------------------------------------------
|
||||
'$RESIZE:SMOOTH
|
||||
'$CONSOLE
|
||||
|
||||
'DEFLNG A-Z
|
||||
'OPTION _EXPLICIT
|
||||
|
||||
'CONST GIF_ID = 1
|
||||
|
||||
'DO
|
||||
' DIM gifFileName AS STRING: gifFileName = _OPENFILEDIALOG$("Open GIF", , "*.gif|*.GIF|*.Gif", "GIF Files")
|
||||
' IF LEN(gifFileName) = 0 THEN EXIT DO
|
||||
|
||||
' IF GIF_LoadFromFile(GIF_ID, gifFileName) THEN
|
||||
' DIM surface AS LONG: surface = _NEWIMAGE(GIF_GetWidth(GIF_ID), GIF_GetHeight(GIF_ID), 32)
|
||||
' SCREEN surface
|
||||
' _ALLOWFULLSCREEN _SQUAREPIXELS , _SMOOTH
|
||||
|
||||
' GIF_Play GIF_ID
|
||||
|
||||
' DO
|
||||
' DIM k AS LONG: k = _KEYHIT
|
||||
|
||||
' IF k = 32 THEN
|
||||
' IF GIF_IsPlaying(GIF_ID) THEN GIF_Pause (GIF_ID) ELSE GIF_Play (GIF_ID)
|
||||
' END IF
|
||||
|
||||
' CLS
|
||||
' GIF_Draw GIF_ID
|
||||
' _DISPLAY
|
||||
|
||||
' _LIMIT 30
|
||||
' LOOP UNTIL k = 27
|
||||
|
||||
' SCREEN 0
|
||||
' _FREEIMAGE surface
|
||||
' END IF
|
||||
'LOOP
|
||||
|
||||
'END
|
||||
'-------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
' Opens a GIF file from a buffer in memory
|
||||
FUNCTION GIF_LoadFromMemory%% (Id AS LONG, buffer AS STRING)
|
||||
$IF INFORM_BI = DEFINED THEN
|
||||
IF Control(ID).Type <> __UI_Type_PictureBox THEN
|
||||
ERROR 5
|
||||
EXIT FUNCTION
|
||||
END IF
|
||||
$END IF
|
||||
|
||||
DIM sf AS StringFileType
|
||||
|
||||
StringFile_Create sf, buffer
|
||||
|
||||
GIF_LoadFromMemory = __GIF_Load(Id, sf)
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Opens a GIF file from a file on disk
|
||||
FUNCTION GIF_LoadFromFile%% (Id AS LONG, fileName AS STRING)
|
||||
$IF INFORM_BI = DEFINED THEN
|
||||
IF Control(ID).Type <> __UI_Type_PictureBox THEN
|
||||
ERROR 5
|
||||
EXIT FUNCTION
|
||||
END IF
|
||||
$END IF
|
||||
|
||||
DIM sf AS StringFileType
|
||||
|
||||
IF StringFile_Load(sf, fileName) THEN
|
||||
GIF_LoadFromFile = __GIF_Load(Id, sf)
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Free a GIF and all associated resources
|
||||
SUB GIF_Free (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
SHARED __GIFPlayFrame() AS __GIFPlayFrameType
|
||||
SHARED __GIF_FirstFreeFrame AS LONG
|
||||
|
||||
' Nothing to do if Id is invalid
|
||||
IF NOT HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN EXIT SUB
|
||||
|
||||
' Get the slot we need to free
|
||||
DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id)
|
||||
|
||||
' Walk the whole animation chain to free all the frames and associated data
|
||||
__GIFPlay(idx).frame = __GIFPlay(idx).firstFrame
|
||||
|
||||
DO
|
||||
' Free the image being held by the frame
|
||||
IF __GIFPlayFrame(__GIFPlay(idx).frame).image < -1 THEN
|
||||
_FREEIMAGE __GIFPlayFrame(__GIFPlay(idx).frame).image
|
||||
__GIFPlayFrame(__GIFPlay(idx).frame).image = 0
|
||||
END IF
|
||||
|
||||
' Mark the frame slot as unused so that it can be reused
|
||||
__GIFPlayFrame(__GIFPlay(idx).frame).isUsed = __GIF_FALSE
|
||||
|
||||
' Note the lowest free frame
|
||||
IF __GIF_FirstFreeFrame > __GIFPlay(idx).frame THEN __GIF_FirstFreeFrame = __GIFPlay(idx).frame
|
||||
|
||||
' Move to the next frame
|
||||
__GIFPlay(idx).frame = __GIFPlayFrame(__GIFPlay(idx).frame).nextFrame
|
||||
LOOP UNTIL __GIFPlay(idx).frame = __GIFPlay(idx).firstFrame ' loop until we come back to the first frame
|
||||
|
||||
' Free the rendered image
|
||||
IF __GIFPlay(idx).image < -1 THEN
|
||||
_FREEIMAGE __GIFPlay(idx).image
|
||||
__GIFPlay(idx).image = 0
|
||||
END IF
|
||||
|
||||
' Free the saved rendered image
|
||||
IF __GIFPlay(idx).savedImage < -1 THEN
|
||||
_FREEIMAGE __GIFPlay(idx).savedImage
|
||||
__GIFPlay(idx).savedImage = 0
|
||||
END IF
|
||||
|
||||
' Finally mark the GIF slot as unused so that it can be reused
|
||||
__GIFPlay(idx).isUsed = __GIF_FALSE
|
||||
|
||||
' Remove Id from the hash table
|
||||
HashTable_Remove __GIFPlayHashTable(), Id
|
||||
END SUB
|
||||
|
||||
|
||||
' Returns the width of the animation in pixels
|
||||
FUNCTION GIF_GetWidth~& (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_GetWidth = _WIDTH(__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).image)
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Returns the height of the animation in pixels
|
||||
FUNCTION GIF_GetHeight~& (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_GetHeight = _HEIGHT(__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).image)
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Returns the number of currently playing frame
|
||||
FUNCTION GIF_GetFrameNumber~& (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_GetFrameNumber = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).frameNumber
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Returns the total frames in the GIF. If this is 1 then it is a static image
|
||||
FUNCTION GIF_GetTotalFrames~& (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_GetTotalFrames = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).frameCount
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Resume or starts playback
|
||||
SUB GIF_Play (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id)
|
||||
|
||||
__GIFPlay(idx).isPlaying = __GIF_TRUE
|
||||
__GIFPlay(idx).lastTick = __GIF_GetTicks
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
' Pauses playback. That same frame is served as long as playback is paused
|
||||
SUB GIF_Pause (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isPlaying = __GIF_FALSE
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
' Stops playing the GIF and resets the cursor to the first frame
|
||||
SUB GIF_Stop (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id)
|
||||
|
||||
__GIFPlay(idx).isPlaying = __GIF_FALSE
|
||||
__GIFPlay(idx).frame = __GIFPlay(idx).firstFrame
|
||||
__GIFPlay(idx).frameNumber = 0
|
||||
__GIFPlay(idx).loopCounter = 0
|
||||
__GIFPlay(idx).elapsedTime = 0
|
||||
__GIFPlay(idx).lastFrameRendered = -1
|
||||
__GIFPlay(idx).hasSavedImage = __GIF_FALSE
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
' Return True if GIF is currently playing
|
||||
FUNCTION GIF_IsPlaying%% (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_IsPlaying = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isPlaying
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' This draws the current frame on the destination surface @ (0, 0) (stretching the frame if needed)
|
||||
' This will also draw the overlay if the playback is stopped / paused
|
||||
SUB GIF_Draw (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
$IF INFORM_BI = DEFINED THEN
|
||||
BeginDraw ID
|
||||
$END IF
|
||||
|
||||
' Get the rendered image handle
|
||||
DIM renderedFrame AS LONG: renderedFrame = GIF_GetFrame(Id)
|
||||
|
||||
' Cache the GIF index because we'll be using this a lot
|
||||
DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id)
|
||||
|
||||
' Clear the surface using the background color (this will be black if the GIF has no global color table)
|
||||
CLS , __GIFPlay(idx).bgColor
|
||||
|
||||
' Blit the rendered frame
|
||||
_PUTIMAGE , renderedFrame, , , _SMOOTH
|
||||
|
||||
' Render the overlay if needed
|
||||
IF NOT __GIFPlay(idx).isPlaying AND __GIFPlay(idx).overlayEnabled AND __GIFPlay(idx).frameCount > 1 THEN
|
||||
DIM overlayImage AS LONG: overlayImage = __GIF_GetOverlayImage
|
||||
|
||||
_PUTIMAGE (_SHR(_WIDTH, 1) - _SHR(_WIDTH(overlayImage), 1), _SHR(_HEIGHT, 1) - _SHR(_HEIGHT(overlayImage), 1)), overlayImage
|
||||
END IF
|
||||
|
||||
$IF INFORM_BI = DEFINED THEN
|
||||
EndDraw ID
|
||||
$END IF
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
' This returns the current rendered frame (QB64 image) to be played
|
||||
' Playback is time sensitive so frames may be skipped or the last frame may be returned
|
||||
' Use this if you want to do your own rendering
|
||||
' Also do not free the image. The library will do that when it is no longer needed
|
||||
FUNCTION GIF_GetFrame& (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
SHARED __GIFPlayFrame() AS __GIFPlayFrameType
|
||||
|
||||
' Exit if Id is not valid
|
||||
IF NOT HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN EXIT FUNCTION
|
||||
|
||||
' Cache the GIF index because we'll be using this a lot
|
||||
DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id)
|
||||
|
||||
' Always return the rendered image handle (since this does not change during the GIFs lifetime)
|
||||
GIF_GetFrame = __GIFPlay(idx).image
|
||||
|
||||
' Exit if we are paused or not ready
|
||||
IF NOT __GIFPlay(idx).isPlaying OR NOT __GIFPlay(idx).isReady THEN EXIT FUNCTION
|
||||
|
||||
' Exit if we finished a single or the specified number of loops
|
||||
IF __GIFPlay(idx).loops <> 0 AND (__GIFPlay(idx).loopCounter < 0 OR __GIFPlay(idx).loopCounter >= __GIFPlay(idx).loops) THEN EXIT FUNCTION
|
||||
|
||||
' Fetch and store the current tick
|
||||
DIM currentTick AS _UNSIGNED _INTEGER64: currentTick = __GIF_GetTicks
|
||||
|
||||
' Remember the last frame index
|
||||
DIM lastFrameRendered AS LONG: lastFrameRendered = __GIFPlay(idx).frame
|
||||
|
||||
' Walk through the animation chain and find the frame we have to render based on the tick we recorded the last time
|
||||
DO UNTIL currentTick < __GIFPlay(idx).lastTick + __GIFPlayFrame(__GIFPlay(idx).frame).duration
|
||||
' Add the current frame duration to lastTick so that we can do frame skips if needed
|
||||
__GIFPlay(idx).lastTick = __GIFPlay(idx).lastTick + __GIFPlayFrame(__GIFPlay(idx).frame).duration
|
||||
' Increment elapsed time
|
||||
__GIFPlay(idx).elapsedTime = __GIFPlay(idx).elapsedTime + __GIFPlayFrame(__GIFPlay(idx).frame).duration
|
||||
' We crossed the duration of the current frame, so move to the next one
|
||||
__GIFPlay(idx).frame = __GIFPlayFrame(__GIFPlay(idx).frame).nextFrame ' this should correctly loop back to the first frame
|
||||
' Increment the frame counter and loop back to 0 if needed
|
||||
__GIFPlay(idx).frameNumber = __GIFPlay(idx).frameNumber + 1
|
||||
IF __GIFPlay(idx).frameNumber >= __GIFPlay(idx).frameCount THEN
|
||||
__GIFPlay(idx).frameNumber = 0
|
||||
__GIFPlay(idx).loopCounter = __GIFPlay(idx).loopCounter + 1
|
||||
|
||||
IF __GIFPlay(idx).loops < 0 THEN
|
||||
__GIFPlay(idx).loopCounter = -1 ' single-shot animation
|
||||
ELSE
|
||||
__GIFPlay(idx).elapsedTime = 0 ' only reset the elapsed time for looping playback
|
||||
END IF
|
||||
END IF
|
||||
LOOP
|
||||
|
||||
' If the last frame rendered is the same as the current frame then just return the previously rendered frame image
|
||||
IF __GIFPlay(idx).frame = __GIFPlay(idx).lastFrameRendered THEN EXIT FUNCTION
|
||||
|
||||
' We now have the frame to display, so save the currentTick and update lastFrameRendered
|
||||
__GIFPlay(idx).lastTick = currentTick
|
||||
__GIFPlay(idx).lastFrameRendered = lastFrameRendered
|
||||
|
||||
' Take appropriate action based on the disposal method of the previous frame
|
||||
IF __GIFPlay(idx).frame = __GIFPlay(idx).firstFrame THEN
|
||||
' If this is the first frame, then we do not have any previous disposal method
|
||||
CLS , __GIFPlay(idx).bgColor, __GIFPlay(idx).image ' clear the render image using the BG color
|
||||
ELSE
|
||||
SELECT CASE __GIFPlayFrame(__GIFPlayFrame(__GIFPlay(idx).frame).prevFrame).disposalMethod
|
||||
CASE 2 ' Restore to background color
|
||||
CLS , __GIFPlay(idx).bgColor, __GIFPlay(idx).image
|
||||
_CLEARCOLOR __GIFPlay(idx).bgColor, __GIFPlay(idx).image
|
||||
|
||||
CASE 3 ' Restore to previous
|
||||
IF __GIFPlay(idx).hasSavedImage THEN
|
||||
' Copy back the saved image and unset the flag
|
||||
_PUTIMAGE , __GIFPlay(idx).savedImage, __GIFPlay(idx).image
|
||||
__GIFPlay(idx).hasSavedImage = __GIF_FALSE
|
||||
END IF
|
||||
|
||||
' All other disposal methods do not require any action
|
||||
END SELECT
|
||||
END IF
|
||||
|
||||
' If the current frame's disposal method is 3 (restore to previous) then save the current rendered frame and set the flag
|
||||
IF __GIFPlayFrame(__GIFPlay(idx).frame).disposalMethod = 3 THEN
|
||||
_PUTIMAGE , __GIFPlay(idx).image, __GIFPlay(idx).savedImage
|
||||
__GIFPlay(idx).hasSavedImage = __GIF_TRUE
|
||||
END IF
|
||||
|
||||
' Render the frame at the correct (x, y) offset on the final image
|
||||
_PUTIMAGE (__GIFPlayFrame(__GIFPlay(idx).frame).L, __GIFPlayFrame(__GIFPlay(idx).frame).T), __GIFPlayFrame(__GIFPlay(idx).frame).image, __GIFPlay(idx).image
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Returns the background color that should be used to clear the surface before drawing the final rendered frame
|
||||
FUNCTION GIF_GetBackgroundColor~& (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_GetBackgroundColor = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).bgColor
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Returns the total runtime of the animation in ms
|
||||
FUNCTION GIF_GetTotalDuration~&& (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_GetTotalDuration = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).duration
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Returns the total runtime of the current frame in ms
|
||||
FUNCTION GIF_GetFrameDuration~&& (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
SHARED __GIFPlayFrame() AS __GIFPlayFrameType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_GetFrameDuration = __GIFPlayFrame(__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).frame).duration
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Returns the current runtime of the animation in ms
|
||||
FUNCTION GIF_GetElapsedTime~&& (Id AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_GetElapsedTime = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).elapsedTime
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Set the looping behavior
|
||||
SUB GIF_SetLoop (Id AS LONG, loops AS LONG)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).loops = loops
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
' Sets the GIF overlay to enable / disable
|
||||
SUB GIF_EnableOverlay (Id AS LONG, isEnabled AS _BYTE)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).overlayEnabled = isEnabled
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
' Returns TRUE if a GIF with Id is loaded
|
||||
FUNCTION GIF_IsLoaded%% (Id AS LONG)
|
||||
$CHECKING:OFF
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_IsLoaded = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isReady
|
||||
END IF
|
||||
$CHECKING:ON
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Deinterlaces a raw GIF frame
|
||||
SUB __GIF_DeinterlaceFrameImage (bmp AS LONG)
|
||||
DIM W AS LONG: W = _WIDTH(bmp)
|
||||
DIM H AS LONG: H = _HEIGHT(bmp)
|
||||
DIM MX AS LONG: MX = W - 1
|
||||
DIM n AS LONG: n = _NEWIMAGE(W, H, 256)
|
||||
|
||||
DIM AS LONG y, i
|
||||
|
||||
WHILE y < H
|
||||
_PUTIMAGE (0, y), bmp, n, (0, i)-(MX, i)
|
||||
i = i + 1
|
||||
y = y + 8
|
||||
WEND
|
||||
|
||||
y = 4
|
||||
WHILE y < H
|
||||
_PUTIMAGE (0, y), bmp, n, (0, i)-(MX, i)
|
||||
i = i + 1
|
||||
y = y + 8
|
||||
WEND
|
||||
|
||||
y = 2
|
||||
WHILE y < H
|
||||
_PUTIMAGE (0, y), bmp, n, (0, i)-(MX, i)
|
||||
i = i + 1
|
||||
y = y + 4
|
||||
WEND
|
||||
|
||||
y = 1
|
||||
WHILE y < H
|
||||
_PUTIMAGE (0, y), bmp, n, (0, i)-(MX, i)
|
||||
i = i + 1
|
||||
y = y + 2
|
||||
WEND
|
||||
|
||||
_PUTIMAGE , n, bmp
|
||||
_FREEIMAGE n
|
||||
END SUB
|
||||
|
||||
|
||||
' https://commandlinefanatic.com/cgi-bin/showarticle.cgi?article=art011
|
||||
FUNCTION __GIF_ReadLZWCode& (sf AS StringFileType, buffer AS STRING, bitPos AS LONG, bitSize AS LONG)
|
||||
DIM AS LONG code, p: p = 1
|
||||
|
||||
DIM i AS LONG: FOR i = 1 TO bitSize
|
||||
DIM bytePos AS LONG: bytePos = _SHR(bitPos, 3) AND 255
|
||||
|
||||
IF bytePos = 0 THEN
|
||||
DIM dataLen AS LONG: dataLen = StringFile_ReadByte(sf)
|
||||
|
||||
IF dataLen = 0 THEN
|
||||
__GIF_ReadLZWCode = -1
|
||||
EXIT FUNCTION
|
||||
END IF
|
||||
|
||||
MID$(buffer, 257 - dataLen, dataLen) = StringFile_ReadString(sf, dataLen)
|
||||
|
||||
bytePos = 256 - dataLen
|
||||
bitPos = _SHL(bytePos, 3)
|
||||
END IF
|
||||
|
||||
IF ASC(buffer, 1 + bytePos) AND _SHL(1, bitPos AND 7) THEN code = code + p
|
||||
|
||||
p = p + p
|
||||
bitPos = bitPos + 1
|
||||
NEXT i
|
||||
|
||||
__GIF_ReadLZWCode = code
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' https://stackoverflow.com/questions/26894809/gif-lzw-decompression
|
||||
FUNCTION __GIF_DecodeLZW%% (sf AS StringFileType, bmpMem AS _MEM)
|
||||
TYPE __LZWCodeType
|
||||
c AS LONG
|
||||
prefix AS LONG
|
||||
length AS LONG
|
||||
END TYPE
|
||||
|
||||
DIM codes(0 TO 4095) AS __LZWCodeType ' maximum bit size is 12
|
||||
|
||||
DIM origBitSize AS LONG: origBitSize = StringFile_ReadByte(sf)
|
||||
DIM n AS LONG: n = 2 + _SHL(1, origBitSize)
|
||||
|
||||
DIM i AS LONG: WHILE i < n
|
||||
codes(i).c = i
|
||||
codes(i).length = 0
|
||||
i = i + 1
|
||||
WEND
|
||||
|
||||
DIM clearMarker AS LONG: clearMarker = n - 2
|
||||
DIM endMarker AS LONG: endMarker = n - 1
|
||||
|
||||
DIM buffer AS STRING: buffer = SPACE$(256)
|
||||
DIM bitSize AS LONG: bitSize = origBitSize + 1
|
||||
DIM bitPos AS LONG
|
||||
|
||||
' Expect to read clear code as first code here
|
||||
DIM prev AS LONG: prev = __GIF_ReadLZWCode(sf, buffer, bitPos, bitSize)
|
||||
IF prev = -1 THEN EXIT FUNCTION
|
||||
|
||||
DO
|
||||
DIM code AS LONG: code = __GIF_ReadLZWCode(sf, buffer, bitPos, bitSize)
|
||||
IF code = -1 THEN EXIT FUNCTION
|
||||
|
||||
IF code = clearMarker THEN
|
||||
bitSize = origBitSize
|
||||
n = _SHL(1, bitSize) + 2
|
||||
bitSize = bitSize + 1
|
||||
prev = code
|
||||
_CONTINUE
|
||||
END IF
|
||||
|
||||
IF code = endMarker THEN EXIT DO
|
||||
|
||||
' Known code: ok. Else: must be doubled char
|
||||
DIM c AS LONG: IF code < n THEN c = code ELSE c = prev
|
||||
|
||||
' Output the code
|
||||
DIM outPos AS LONG: outPos = outPos + codes(c).length
|
||||
|
||||
i = 0
|
||||
DO
|
||||
_MEMPUT bmpMem, bmpMem.OFFSET + outPos - i, codes(c).c AS _UNSIGNED _BYTE
|
||||
|
||||
IF codes(c).length <> 0 THEN
|
||||
c = codes(c).prefix
|
||||
ELSE
|
||||
EXIT DO
|
||||
END IF
|
||||
|
||||
i = i + 1
|
||||
LOOP
|
||||
|
||||
outPos = outPos + 1
|
||||
|
||||
' Unknown code -> must be double char
|
||||
IF code >= n THEN
|
||||
_MEMPUT bmpMem, bmpMem.OFFSET + outPos, codes(c).c AS _UNSIGNED _BYTE
|
||||
outPos = outPos + 1
|
||||
END IF
|
||||
|
||||
' Except after clear marker, build new code
|
||||
IF prev <> clearMarker AND n < 4096 THEN
|
||||
codes(n).prefix = prev
|
||||
codes(n).length = codes(prev).length + 1
|
||||
codes(n).c = codes(c).c
|
||||
n = n + 1
|
||||
END IF
|
||||
|
||||
' Out of bits? Increase
|
||||
IF _SHL(1, bitSize) = n THEN
|
||||
IF bitSize < 12 THEN bitSize = bitSize + 1
|
||||
END IF
|
||||
|
||||
prev = code
|
||||
LOOP
|
||||
|
||||
__GIF_DecodeLZW = __GIF_TRUE
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' This applies the palette and transparency to a raw GIF frame image
|
||||
' info - the GIF global and local frame data needed to prepare the frame image
|
||||
' bmp - the raw frame image
|
||||
SUB __GIF_PrepareFrameImage (info AS __GIFFrameType, bmp AS LONG)
|
||||
' Set the 8-bit image palette
|
||||
DIM AS LONG x, y
|
||||
IF info.localColors = 0 THEN
|
||||
' No local palette, so use the global one
|
||||
WHILE y < info.globalColors
|
||||
x = y * 3
|
||||
_PALETTECOLOR y, _RGB32(ASC(info.globalPalette, x + 1), ASC(info.globalPalette, x + 2), ASC(info.globalPalette, x + 3)), bmp
|
||||
y = y + 1
|
||||
WEND
|
||||
ELSE
|
||||
' Use the local palette
|
||||
WHILE y < info.localColors
|
||||
x = y * 3
|
||||
_PALETTECOLOR y, _RGB32(ASC(info.localPalette, x + 1), ASC(info.localPalette, x + 2), ASC(info.localPalette, x + 3)), bmp
|
||||
y = y + 1
|
||||
WEND
|
||||
END IF
|
||||
|
||||
' Set the transparent color
|
||||
IF info.transparentColor >= 0 THEN _CLEARCOLOR info.transparentColor, bmp
|
||||
END SUB
|
||||
|
||||
|
||||
' This is an internal loading function common for both memory and file loaders
|
||||
FUNCTION __GIF_Load%% (Id AS LONG, sf AS StringFileType)
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
SHARED __GIFPlayFrame() AS __GIFPlayFrameType
|
||||
SHARED __GIF_FirstFreeFrame AS LONG
|
||||
|
||||
' Check if Id already exists and if so free it
|
||||
IF GIF_IsLoaded(Id) THEN GIF_Free Id
|
||||
|
||||
' Check if we can read the signature at a minimum
|
||||
IF StringFile_GetSize(sf) < 6 THEN EXIT FUNCTION
|
||||
|
||||
' Check the file signature before proceeding further
|
||||
DIM buffer AS STRING: buffer = StringFile_ReadString(sf, 6)
|
||||
IF buffer <> "GIF87a" AND buffer <> "GIF89a" THEN EXIT FUNCTION
|
||||
|
||||
' Ok, so it is a GIF. Allocate resources to load the rest of the file
|
||||
DIM idx AS LONG: FOR idx = 0 TO UBOUND(__GIFPlay)
|
||||
IF NOT __GIFPlay(idx).isUsed THEN EXIT FOR
|
||||
NEXT idx
|
||||
|
||||
' No free GIF slots?
|
||||
IF idx > UBOUND(__GIFPlay) THEN REDIM _PRESERVE __GIFPlay(0 TO idx) AS __GIFPlayType
|
||||
|
||||
__GIFPlay(idx).isUsed = __GIF_TRUE ' occupy the slot
|
||||
HashTable_InsertLong __GIFPlayHashTable(), Id, idx ' add it to the hash table
|
||||
|
||||
' Reset some stuff
|
||||
__GIFPlay(idx).isReady = __GIF_FALSE
|
||||
__GIFPlay(idx).firstFrame = -1
|
||||
__GIFPlay(idx).lastFrame = -1
|
||||
__GIFPlay(idx).frame = -1
|
||||
__GIFPlay(idx).frameCount = 0
|
||||
__GIFPlay(idx).frameNumber = 0
|
||||
__GIFPlay(idx).isPlaying = __GIF_FALSE
|
||||
__GIFPlay(idx).loops = 0
|
||||
__GIFPlay(idx).loopCounter = 0
|
||||
__GIFPlay(idx).duration = 0
|
||||
__GIFPlay(idx).lastTick = 0
|
||||
__GIFPlay(idx).elapsedTime = 0
|
||||
__GIFPlay(idx).lastFrameRendered = -1
|
||||
__GIFPlay(idx).hasSavedImage = __GIF_FALSE
|
||||
__GIFPlay(idx).overlayEnabled = __GIF_TRUE
|
||||
|
||||
' Get width and height
|
||||
DIM W AS _UNSIGNED INTEGER: W = StringFile_ReadInteger(sf)
|
||||
DIM H AS _UNSIGNED INTEGER: H = StringFile_ReadInteger(sf)
|
||||
|
||||
' Create the 32bpp rendered image using the width and height we got above
|
||||
__GIFPlay(idx).image = _NEWIMAGE(W, H, 32)
|
||||
__GIFPlay(idx).savedImage = _NEWIMAGE(W, H, 32)
|
||||
IF __GIFPlay(idx).image >= -1 OR __GIFPlay(idx).savedImage >= -1 THEN GOTO gif_load_error
|
||||
|
||||
DIM i AS _UNSIGNED _BYTE: i = StringFile_ReadByte(sf)
|
||||
|
||||
DIM rawFrame AS __GIFFrameType
|
||||
rawFrame.globalPalette = STRING$(768, 0)
|
||||
rawFrame.localPalette = STRING$(768, 0)
|
||||
rawFrame.transparentColor = -1 ' no transparent color
|
||||
|
||||
' Global color table?
|
||||
IF _READBIT(i, 7) THEN rawFrame.globalColors = _SHL(1, ((i AND 7) + 1))
|
||||
|
||||
' Background color is only valid with a global palette
|
||||
i = StringFile_ReadByte(sf)
|
||||
|
||||
' Skip aspect ratio
|
||||
StringFile_Seek sf, StringFile_GetPosition(sf) + 1
|
||||
|
||||
' Read the global palette data
|
||||
IF rawFrame.globalColors > 0 THEN MID$(rawFrame.globalPalette, 1, 3 * rawFrame.globalColors) = StringFile_ReadString(sf, 3 * rawFrame.globalColors)
|
||||
|
||||
' Get RGBA value from the global palette for the backgrond color
|
||||
__GIFPlay(idx).bgColor = _RGB32(ASC(rawFrame.globalPalette, i + 1), ASC(rawFrame.globalPalette, i + 2), ASC(rawFrame.globalPalette, i + 3))
|
||||
|
||||
DIM frameIdx AS LONG: frameIdx = -1
|
||||
|
||||
DO
|
||||
i = StringFile_ReadByte(sf)
|
||||
|
||||
SELECT CASE i
|
||||
CASE &H2C ' image descriptor
|
||||
' Look for a free slot from the last lowest freed index
|
||||
FOR frameIdx = __GIF_FirstFreeFrame TO UBOUND(__GIFPlayFrame)
|
||||
IF NOT __GIFPlayFrame(frameIdx).isUsed THEN
|
||||
__GIF_FirstFreeFrame = frameIdx + 1
|
||||
EXIT FOR
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
IF frameIdx > UBOUND(__GIFPlayFrame) THEN
|
||||
' Search from the beginning
|
||||
FOR frameIdx = 0 TO UBOUND(__GIFPlayFrame)
|
||||
IF NOT __GIFPlayFrame(frameIdx).isUsed THEN EXIT FOR
|
||||
NEXT
|
||||
END IF
|
||||
|
||||
' If still no free frame slot then allocate one
|
||||
IF frameIdx > UBOUND(__GIFPlayFrame) THEN REDIM _PRESERVE __GIFPlayFrame(0 TO frameIdx) AS __GIFPlayFrameType
|
||||
|
||||
' Occupy the slot
|
||||
__GIFPlayFrame(frameIdx).isUsed = __GIF_TRUE
|
||||
|
||||
' Read frame size and offset
|
||||
__GIFPlayFrame(frameIdx).L = StringFile_ReadInteger(sf)
|
||||
__GIFPlayFrame(frameIdx).T = StringFile_ReadInteger(sf)
|
||||
W = StringFile_ReadInteger(sf)
|
||||
H = StringFile_ReadInteger(sf)
|
||||
|
||||
' Create a raw frame image from the width and height we got above
|
||||
__GIFPlayFrame(frameIdx).image = _NEWIMAGE(W, H, 256)
|
||||
IF __GIFPlayFrame(frameIdx).image >= -1 THEN GOTO gif_load_error
|
||||
|
||||
i = StringFile_ReadByte(sf)
|
||||
|
||||
' Local palette?
|
||||
IF _READBIT(i, 7) THEN
|
||||
rawFrame.localColors = _SHL(1, ((i AND 7) + 1))
|
||||
MID$(rawFrame.localPalette, 1, 3 * rawFrame.localColors) = StringFile_ReadString(sf, 3 * rawFrame.localColors)
|
||||
END IF
|
||||
|
||||
' Decode the frame bitmap data
|
||||
DIM mI AS _MEM: mI = _MEMIMAGE(__GIFPlayFrame(frameIdx).image)
|
||||
IF mI.SIZE = 0 THEN GOTO gif_load_error
|
||||
|
||||
IF NOT __GIF_DecodeLZW(sf, mI) THEN
|
||||
_MEMFREE mI
|
||||
GOTO gif_load_error
|
||||
END IF
|
||||
|
||||
_MEMFREE mI
|
||||
|
||||
' De-interlace the bitmap if it is interlaced
|
||||
IF _READBIT(i, 6) THEN __GIF_DeinterlaceFrameImage __GIFPlayFrame(frameIdx).image
|
||||
|
||||
' Apply palette and transparency
|
||||
__GIF_PrepareFrameImage rawFrame, __GIFPlayFrame(frameIdx).image
|
||||
|
||||
' Update GIF properties
|
||||
IF __GIFPlay(idx).firstFrame = -1 THEN
|
||||
' This is the first frame of the animation
|
||||
__GIFPlay(idx).firstFrame = frameIdx
|
||||
__GIFPlay(idx).frame = frameIdx ' the starting frame
|
||||
__GIFPlayFrame(frameIdx).prevFrame = frameIdx ' make previous frame to point to this
|
||||
__GIFPlayFrame(frameIdx).nextFrame = frameIdx ' make next frame to point to this
|
||||
ELSE
|
||||
' This is not the first frame
|
||||
__GIFPlayFrame(__GIFPlay(idx).firstFrame).prevFrame = frameIdx ' update first frame's previous frame
|
||||
__GIFPlayFrame(__GIFPlay(idx).lastFrame).nextFrame = frameIdx ' udpate last frames's next frame
|
||||
__GIFPlayFrame(frameIdx).prevFrame = __GIFPlay(idx).lastFrame ' previous frame is the last frame
|
||||
__GIFPlayFrame(frameIdx).nextFrame = __GIFPlay(idx).firstFrame ' next frame is the the first frame
|
||||
|
||||
END IF
|
||||
__GIFPlay(idx).lastFrame = frameIdx ' make the last frame to point to this
|
||||
__GIFPlayFrame(frameIdx).disposalMethod = rawFrame.disposalMethod
|
||||
IF rawFrame.duration = 0 THEN rawFrame.duration = 10~% ' 0.1 seconds if no duration is specified (this behavior is from the erstwhile GIFPlay library)
|
||||
__GIFPlayFrame(frameIdx).duration = 10~&& * rawFrame.duration ' convert to ticks (ms)
|
||||
__GIFPlay(idx).duration = __GIFPlay(idx).duration + __GIFPlayFrame(frameIdx).duration ' add the frame duration to the global duration
|
||||
__GIFPlay(idx).frameCount = __GIFPlay(idx).frameCount + 1
|
||||
|
||||
' Prepare for next frame
|
||||
rawFrame.localColors = 0
|
||||
rawFrame.localPalette = STRING$(768, 0)
|
||||
rawFrame.disposalMethod = 0
|
||||
rawFrame.transparentColor = -1 ' no transparent color
|
||||
rawFrame.duration = 0
|
||||
|
||||
CASE &H21 ' extension introducer
|
||||
DIM j AS _UNSIGNED _BYTE: j = StringFile_ReadByte(sf) ' extension type
|
||||
i = StringFile_ReadByte(sf) ' size
|
||||
|
||||
IF j = &HF9 THEN ' graphic control extension
|
||||
' Size must be 4
|
||||
IF i <> 4 THEN GOTO gif_load_error
|
||||
|
||||
i = StringFile_ReadByte(sf)
|
||||
|
||||
rawFrame.disposalMethod = _SHR(i, 2) AND 7
|
||||
rawFrame.duration = StringFile_ReadInteger(sf)
|
||||
|
||||
IF _READBIT(i, 0) THEN ' transparency?
|
||||
rawFrame.transparentColor = StringFile_ReadByte(sf)
|
||||
ELSE
|
||||
StringFile_Seek sf, StringFile_GetPosition(sf) + 1
|
||||
END IF
|
||||
|
||||
i = StringFile_ReadByte(sf) ' size
|
||||
ELSEIF j = &HFF THEN ' application extension
|
||||
IF i = 11 THEN
|
||||
buffer = StringFile_ReadString(sf, 11)
|
||||
i = StringFile_ReadByte(sf) ' size
|
||||
IF _STRCMP(buffer, "NETSCAPE2.0") = 0 THEN
|
||||
IF i = 3 THEN
|
||||
j = StringFile_ReadByte(sf)
|
||||
__GIFPlay(idx).loops = StringFile_ReadInteger(sf)
|
||||
IF j <> 1 THEN __GIFPlay(idx).loops = 0
|
||||
i = StringFile_ReadByte(sf) ' size
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
|
||||
' Possibly more blocks until terminator block (0)
|
||||
WHILE i > 0
|
||||
StringFile_Seek sf, StringFile_GetPosition(sf) + i
|
||||
i = StringFile_ReadByte(sf)
|
||||
WEND
|
||||
|
||||
CASE &H3B ' GIF trailer
|
||||
EXIT DO
|
||||
END SELECT
|
||||
LOOP WHILE NOT StringFile_IsEOF(sf)
|
||||
|
||||
' Bad / corrupt GIF?
|
||||
IF __GIFPlay(idx).frameCount = 0 THEN GOTO gif_load_error
|
||||
|
||||
'__GIF_PrintDebugInfo idx
|
||||
|
||||
__GIFPlay(idx).isReady = __GIF_TRUE ' set the ready flag
|
||||
|
||||
' Render the first frame and then stop
|
||||
GIF_Play Id
|
||||
DIM dummy AS LONG: dummy = GIF_GetFrame(Id)
|
||||
GIF_Stop Id
|
||||
|
||||
__GIF_Load = __GIF_TRUE
|
||||
EXIT FUNCTION
|
||||
|
||||
gif_load_error:
|
||||
GIF_Free Id ' use GIF_Free() to cleanup if we encountered any error
|
||||
END FUNCTION
|
||||
|
||||
|
||||
'SUB __GIF_PrintDebugInfo (index AS LONG)
|
||||
' SHARED __GIFPlay() AS __GIFPlayType
|
||||
' SHARED __GIFPlayFrame() AS __GIFPlayFrameType
|
||||
|
||||
' _ECHO "Dump for GIF:" + STR$(index) + CHR$(10)
|
||||
|
||||
' _ECHO "isUsed =" + STR$(__GIFPlay(index).isUsed)
|
||||
' _ECHO "image =" + STR$(__GIFPlay(index).image)
|
||||
' _ECHO "bgColor =" + STR$(__GIFPlay(index).bgColor)
|
||||
' _ECHO "firstFrame =" + STR$(__GIFPlay(index).firstFrame)
|
||||
' _ECHO "lastFrame =" + STR$(__GIFPlay(index).lastFrame)
|
||||
' _ECHO "frame =" + STR$(__GIFPlay(index).frame)
|
||||
' _ECHO "frameCount =" + STR$(__GIFPlay(index).frameCount)
|
||||
' _ECHO "frameNumber =" + STR$(__GIFPlay(index).frameNumber)
|
||||
' _ECHO "isPlaying =" + STR$(__GIFPlay(index).isPlaying)
|
||||
' _ECHO "loops =" + STR$(__GIFPlay(index).loops)
|
||||
' _ECHO "loopCounter =" + STR$(__GIFPlay(index).loopCounter)
|
||||
' _ECHO "duration =" + STR$(__GIFPlay(index).duration)
|
||||
' _ECHO "lastTick =" + STR$(__GIFPlay(index).lastTick)
|
||||
' _ECHO "lastFrameRendered =" + STR$(__GIFPlay(index).lastFrameRendered)
|
||||
' _ECHO "savedImage =" + STR$(__GIFPlay(index).savedImage)
|
||||
' _ECHO "hasSavedImage =" + STR$(__GIFPlay(index).hasSavedImage)
|
||||
' _ECHO "overlayEnabled =" + STR$(__GIFPlay(index).overlayEnabled)
|
||||
|
||||
' _ECHO CHR$(10) + "Walking animation chain..." + CHR$(10)
|
||||
|
||||
' DO
|
||||
' _ECHO "Dump for frame:" + STR$(__GIFPlay(index).frame) + CHR$(10)
|
||||
|
||||
' _ECHO "isUsed =" + STR$(__GIFPlayFrame(__GIFPlay(index).frame).isUsed)
|
||||
' _ECHO "prevFrame =" + STR$(__GIFPlayFrame(__GIFPlay(index).frame).prevFrame)
|
||||
' _ECHO "nextFrame =" + STR$(__GIFPlayFrame(__GIFPlay(index).frame).nextFrame)
|
||||
' _ECHO "image =" + STR$(__GIFPlayFrame(__GIFPlay(index).frame).image)
|
||||
' _ECHO "L =" + STR$(__GIFPlayFrame(__GIFPlay(index).frame).L)
|
||||
' _ECHO "T =" + STR$(__GIFPlayFrame(__GIFPlay(index).frame).T)
|
||||
' _ECHO "disposalMethod =" + STR$(__GIFPlayFrame(__GIFPlay(index).frame).disposalMethod)
|
||||
' _ECHO "duration =" + STR$(__GIFPlayFrame(__GIFPlay(index).frame).duration)
|
||||
|
||||
' _ECHO CHR$(10) + "Changing to next frame..."
|
||||
' __GIFPlay(index).frame = __GIFPlayFrame(__GIFPlay(index).frame).nextFrame
|
||||
' LOOP UNTIL __GIFPlay(index).frame = __GIFPlay(index).firstFrame
|
||||
'END SUB
|
||||
|
||||
|
||||
' This gets the GIF overlay image (real loading only happens once)
|
||||
FUNCTION __GIF_GetOverlayImage&
|
||||
CONST SIZE_GIFOVERLAYIMAGE_BMP_16506~& = 16506~&
|
||||
CONST COMP_GIFOVERLAYIMAGE_BMP_16506%% = -1%%
|
||||
CONST DATA_GIFOVERLAYIMAGE_BMP_16506 = _
|
||||
"eNpy8q1yYACDKiDOAWIHKGZkUGBgZsAF/kMQjDM4gRSgfbsGjt+I4jgexj+2YU57nd27H0Nl6htD6wkzJ31hqFyFWkMVZmZm5rzjMyjfzcwLvEKj" + _
|
||||
"tXTnFbyZjxn0O60WBBjDdVjDU/gAP0LwK77CW3gKa7gOY+B3c1k13Ic3ICm9gftQQ8h1BIt4GdInL2MRRxBKHcd1+BIyIF/iehzHYdWpmMXnkEPy" + _
|
||||
"OWZxKgZZV2AbEohtXI5B1Di+hQTmW4z3ub3fBQncXX04Hs7CKiQnVnFWhtkfh+TM4zgrgza/AsmplZTHwh2QnLszRT8vheA/LlyObyAF8Q0u9zjm" + _
|
||||
"tyEFs52wL5iFFNRsgrXMZ5CC+gwnY/JfBym462LW719BCu4rHIGtRUhJLNo+H29ASuINMxYMQ1JooIUOekYHLTQgFpromJ8V1NFGV7+HOiQjw9C6" + _
|
||||
"L0VumzlOB02TvWehhTZ6VoavwX3QehXixWz7ysrK7rPPPrsXmXJfc98zGdqoa8bNzc2/f++tt97a19dJ9/tPP/20H1EPPfSQ/o0mJAOvwdVFabK7" + _
|
||||
"bFHCeuSRR/ZMWxh4fuMiTBygzff+u9267XY/X3vttT33Nc3gyn08NTW1474fQP4J3ATx0LH7/eabbzbt24D7mUajEWmWQPLfhHXffT8yMrJjs6Nr" + _
|
||||
"+3k00LZZAsq/jqcgCbX+u+8/++yzfc2OOgR1bSNWgPmfwoe+bd/ljig93tGCOLrd/ctvwM4dPLyL7yAJ9Rxt+/Pz8ztmnzTRc1+PYirT/Ibna/AF" + _
|
||||
"5KD56Qc0f72v+ROU+V1J6JeM89v2Hy+A/Inav8mm45ht/7b/i9FBPZD2n0X/107ye0YnhP4vzfjnti3BuqShc0FdC7iPQxn/fOc/msX2ZTr/Qd2u" + _
|
||||
"be2cIaD5/3oW81/tByzl5vsRZecM2R//3ucJbsLYQdc/bnv/u8616wCX2635Isrse6eRYX6r67H+uRDiqYWeo/mSjE8cN6aPzm78i5mTxbkIrl5J" + _
|
||||
"8xroOlfHBbvmN+2iAwkg/6vQuhfixfRvCWj/KN7nv/x1Pc9/DfX5/GcD9ZTnP5Fp/zdkzn+/Xsrz39X1D63z8SWk4L7Eker6Z2mvfx9HXM2U+P4H" + _
|
||||
"HQu2IAVDJrIlq8uKd/8TmfxqrMT3v2ndBsm526v7X6v7n6v736vnH6rnX6rnnzI+HmYCeP5tBqeW8PnH63A8wOdfX4L0yUvm+ddQq4a78QokpVdw" + _
|
||||
"N2rIY+nz70tYxZN431x3/g7v40msYmlQz7//BcxY2A4="
|
||||
|
||||
STATIC overlayImage AS LONG
|
||||
|
||||
' Only do this once
|
||||
IF overlayImage = 0 THEN
|
||||
overlayImage = _LOADIMAGE(Base64_LoadResourceString(DATA_GIFOVERLAYIMAGE_BMP_16506, SIZE_GIFOVERLAYIMAGE_BMP_16506, COMP_GIFOVERLAYIMAGE_BMP_16506), 32, "memory")
|
||||
END IF
|
||||
|
||||
__GIF_GetOverlayImage = overlayImage
|
||||
END FUNCTION
|
||||
|
||||
'$INCLUDE:'HashTable.bas'
|
||||
'$INCLUDE:'StringFile.bas'
|
||||
'$INCLUDE:'Base64.bas'
|
||||
|
||||
$END IF
|
70
InForm/extensions/GIFPlay.bi
Normal file
|
@ -0,0 +1,70 @@
|
|||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
' Animated GIF Player library
|
||||
' Copyright (c) 2024 Samuel Gomes
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
$IF GIFPLAY_BI = UNDEFINED THEN
|
||||
$LET GIFPLAY_BI = TRUE
|
||||
|
||||
'$INCLUDE:'HashTable.bi'
|
||||
'$INCLUDE:'StringFile.bi'
|
||||
|
||||
CONST __GIF_FALSE%% = 0%%, __GIF_TRUE%% = NOT __GIF_FALSE
|
||||
|
||||
' This is the master animation type that holds info about a complete animation
|
||||
TYPE __GIFPlayType
|
||||
isUsed AS _BYTE ' is this slot being used (this is only here to assist slot allocation)
|
||||
isReady AS _BYTE ' this is set if the GIF is fully loaded (helps fix issues with InForm-PE TIMERs)
|
||||
image AS LONG ' the rendered 32bpp frame image
|
||||
bgColor AS _UNSIGNED LONG ' background color (32-bit RGBA!)
|
||||
firstFrame AS LONG ' index of the first frame in the frame data array
|
||||
lastFrame AS LONG ' index of the last frame in the frame data array
|
||||
frame AS LONG ' index of the current frame being played
|
||||
frameCount AS _UNSIGNED LONG ' total number of frames counted while loading
|
||||
frameNumber AS _UNSIGNED LONG ' this is simply the number of current frame since playback (re)started
|
||||
isPlaying AS _BYTE ' set to true if the animation is currently playing
|
||||
loops AS LONG ' -1 = no, 0 = forever, n = that many times
|
||||
loopCounter AS _UNSIGNED LONG ' this counts the number of loops
|
||||
duration AS _UNSIGNED _INTEGER64 ' total duration in ticks (ms)
|
||||
lastTick AS _UNSIGNED _INTEGER64 ' the tick recorded when the last frame was played
|
||||
elapsedTime AS _UNSIGNED _INTEGER64 ' the time (ms) that has passed since the animation was started
|
||||
lastFrameRendered AS LONG ' index of the last frame that was rendered
|
||||
savedImage AS LONG ' copy of the current frame when disposal method 3 (restore to previous) is encountered
|
||||
hasSavedImage AS _BYTE ' set to true if we have a valid saved frame
|
||||
overlayEnabled AS _BYTE ' should the "GIF" overlay be shown / hidden when it is not playing
|
||||
END TYPE
|
||||
|
||||
' This type holds information for a single animation frame
|
||||
TYPE __GIFPlayFrameType
|
||||
isUsed AS _BYTE ' is this frame slot being used?
|
||||
prevFrame AS LONG ' previous frame (this will link back to the last frame if this is the first one)
|
||||
nextFrame AS LONG ' next frame (this will link back to the first frame if this is the last one)
|
||||
image AS LONG ' QB64 image handle
|
||||
L AS _UNSIGNED INTEGER ' frame left (x offset)
|
||||
T AS _UNSIGNED INTEGER ' frame top (y offset)
|
||||
disposalMethod AS _UNSIGNED _BYTE ' 0 = don't care, 1 = keep, 2 = background, 3 = previous
|
||||
duration AS _UNSIGNED _INTEGER64 ' frame duration in ticks (ms)
|
||||
END TYPE
|
||||
|
||||
' This is an internal type that defines whatever is needed (except the pixel info) from a raw GIF frame data to construct a QB64 image
|
||||
TYPE __GIFFrameType
|
||||
globalColors AS _UNSIGNED INTEGER ' total colors in the global palette
|
||||
globalPalette AS STRING * 768 ' global palette - 256 colors * 3 components
|
||||
localColors AS _UNSIGNED INTEGER ' total colors in the local frame palette
|
||||
localPalette AS STRING * 768 ' local frame palette - 256 colors * 3 components
|
||||
disposalMethod AS _UNSIGNED _BYTE ' 0 = don't care, 1 = keep, 2 = background, 3 = previous
|
||||
transparentColor AS INTEGER ' transparent color for this frame (< 0 means none)
|
||||
duration AS _UNSIGNED INTEGER ' raw duration data in 1/100th seconds
|
||||
END TYPE
|
||||
|
||||
' GetTicks returns the number of "ticks" (ms) since the program started execution where 1000 "ticks" (ms) = 1 second
|
||||
DECLARE LIBRARY
|
||||
FUNCTION __GIF_GetTicks~&& ALIAS "GetTicks"
|
||||
END DECLARE
|
||||
|
||||
REDIM __GIFPlayHashTable(0 TO 0) AS HashTableType ' shared hash table to keep user supplied IDs (the values here points to indexes in __GIFPlay)
|
||||
REDIM __GIFPlay(0 TO 0) AS __GIFPlayType ' main GIFPlay array - each array element is for a single GIF
|
||||
REDIM __GIFPlayFrame(0 TO 0) AS __GIFPlayFrameType ' shared GIF frame array - this holds GIF frame and frame information for all loaded GIFs
|
||||
DIM __GIF_FirstFreeFrame AS LONG ' index of the lowest free frame in __GIFPlayFrame
|
||||
|
||||
$END IF
|
217
InForm/extensions/HashTable.bas
Normal file
|
@ -0,0 +1,217 @@
|
|||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
' A simple hash table for integers and QB64-PE handles
|
||||
' Copyright (c) 2024 Samuel Gomes
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
$IF HASHTABLE_BAS = UNDEFINED THEN
|
||||
$LET HASHTABLE_BAS = TRUE
|
||||
|
||||
'$INCLUDE:'HashTable.bi'
|
||||
|
||||
'-------------------------------------------------------------------------------------------------------------------
|
||||
' Test code for debugging the library
|
||||
'-------------------------------------------------------------------------------------------------------------------
|
||||
'DEFLNG A-Z
|
||||
'OPTION _EXPLICIT
|
||||
|
||||
'REDIM MyHashTable(0 TO 0) AS HashTableType
|
||||
|
||||
'CONST TEST_LB = 1
|
||||
'CONST TEST_UB = 9999999
|
||||
|
||||
'RANDOMIZE TIMER
|
||||
|
||||
'DIM myarray(TEST_LB TO TEST_UB) AS LONG, t AS DOUBLE
|
||||
'DIM AS _UNSIGNED LONG k, i, x
|
||||
|
||||
'FOR k = 1 TO 4
|
||||
' PRINT "Add element to array..."
|
||||
' t = TIMER
|
||||
' FOR i = TEST_UB TO TEST_LB STEP -1
|
||||
' myarray(i) = x
|
||||
' x = x + 1
|
||||
' NEXT
|
||||
' PRINT USING "#####.##### seconds"; TIMER - t
|
||||
|
||||
' PRINT "Add element to hash table..."
|
||||
' t = TIMER
|
||||
' FOR i = TEST_UB TO TEST_LB STEP -1
|
||||
' HashTable_InsertLong MyHashTable(), i, myarray(i)
|
||||
' NEXT
|
||||
' PRINT USING "#####.##### seconds"; TIMER - t
|
||||
|
||||
' PRINT "Read element from array..."
|
||||
' t = TIMER
|
||||
' FOR i = TEST_UB TO TEST_LB STEP -1
|
||||
' x = myarray(i)
|
||||
' NEXT
|
||||
' PRINT USING "#####.##### seconds"; TIMER - t
|
||||
|
||||
' PRINT "Read element from hash table..."
|
||||
' t = TIMER
|
||||
' FOR i = TEST_UB TO TEST_LB STEP -1
|
||||
' x = HashTable_LookupLong(MyHashTable(), i)
|
||||
' NEXT
|
||||
' PRINT USING "#####.##### seconds"; TIMER - t
|
||||
|
||||
' PRINT "Remove element from hash table..."
|
||||
' t = TIMER
|
||||
' FOR i = TEST_UB TO TEST_LB STEP -1
|
||||
' HashTable_Remove MyHashTable(), i
|
||||
' NEXT
|
||||
' PRINT USING "#####.##### seconds"; TIMER - t
|
||||
'NEXT
|
||||
|
||||
'FOR i = TEST_UB TO TEST_LB STEP -1
|
||||
' LOCATE , 1: PRINT "Adding key"; i; "Size:"; UBOUND(MyHashTable) + 1;
|
||||
' HashTable_InsertLong MyHashTable(), i, myarray(i)
|
||||
'NEXT
|
||||
'PRINT
|
||||
|
||||
'FOR i = TEST_UB TO TEST_LB STEP -1
|
||||
' LOCATE , 1: PRINT "Verifying key: "; i;
|
||||
' IF HashTable_LookupLong(MyHashTable(), i) <> myarray(i) THEN
|
||||
' PRINT "[fail] ";
|
||||
' SLEEP 1
|
||||
' ELSE
|
||||
' PRINT "[pass] ";
|
||||
' END IF
|
||||
'NEXT
|
||||
'PRINT
|
||||
|
||||
'FOR i = TEST_UB TO TEST_LB STEP -1
|
||||
' LOCATE , 1: PRINT "Removing key"; i; "Size:"; UBOUND(MyHashTable) + 1;
|
||||
' HashTable_Remove MyHashTable(), i
|
||||
'NEXT
|
||||
'PRINT
|
||||
|
||||
'HashTable_InsertLong MyHashTable(), 42, 666
|
||||
'HashTable_InsertLong MyHashTable(), 7, 123454321
|
||||
'HashTable_InsertLong MyHashTable(), 21, 69
|
||||
|
||||
'PRINT "Value for key 42:"; HashTable_LookupLong(MyHashTable(), 42)
|
||||
'PRINT "Value for key 7:"; HashTable_LookupLong(MyHashTable(), 7)
|
||||
'PRINT "Value for key 21:"; HashTable_LookupLong(MyHashTable(), 21)
|
||||
|
||||
'PRINT HashTable_IsKeyPresent(MyHashTable(), 100)
|
||||
|
||||
'END
|
||||
'-------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
' Simple hash function: k is the 32-bit key and l is the upper bound of the array
|
||||
FUNCTION __HashTable_GetHash~& (k AS _UNSIGNED LONG, l AS _UNSIGNED LONG)
|
||||
$CHECKING:OFF
|
||||
' Actually this should be k MOD (l + 1)
|
||||
' However, we can get away using AND because our arrays size always doubles in multiples of 2
|
||||
' So, if l = 255, then (k MOD (l + 1)) = (k AND l)
|
||||
' Another nice thing here is that we do not need to do the addition :)
|
||||
__HashTable_GetHash = k AND l
|
||||
$CHECKING:ON
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Subroutine to resize and rehash the elements in a hash table
|
||||
SUB __HashTable_ResizeAndRehash (hashTable() AS HashTableType)
|
||||
DIM uB AS _UNSIGNED LONG: uB = UBOUND(hashTable)
|
||||
|
||||
' Resize the array to double its size while preserving contents
|
||||
DIM newUB AS _UNSIGNED LONG: newUB = _SHL(uB + 1, 1) - 1
|
||||
REDIM _PRESERVE hashTable(0 TO newUB) AS HashTableType
|
||||
|
||||
' Rehash and swap all the elements
|
||||
DIM i AS _UNSIGNED LONG: FOR i = 0 TO uB
|
||||
IF hashTable(i).U THEN SWAP hashTable(i), hashTable(__HashTable_GetHash(hashTable(i).K, newUB))
|
||||
NEXT i
|
||||
END SUB
|
||||
|
||||
|
||||
' This returns an array index in hashTable where k can be inserted
|
||||
' If there is a collision it will grow the array, re-hash and copy all elements
|
||||
FUNCTION __HashTable_GetInsertIndex& (hashTable() AS HashTableType, k AS _UNSIGNED LONG)
|
||||
DIM uB AS _UNSIGNED LONG: uB = UBOUND(hashTable)
|
||||
DIM idx AS _UNSIGNED LONG: idx = __HashTable_GetHash(k, uB)
|
||||
|
||||
IF hashTable(idx).U THEN
|
||||
' Used slot
|
||||
IF hashTable(idx).K = k THEN
|
||||
' Duplicate key
|
||||
__HashTable_GetInsertIndex = __HASHTABLE_KEY_EXISTS
|
||||
ELSE
|
||||
' Collision
|
||||
__HashTable_ResizeAndRehash hashTable()
|
||||
__HashTable_GetInsertIndex = __HashTable_GetInsertIndex(hashTable(), k)
|
||||
END IF
|
||||
ELSE
|
||||
' Empty slot
|
||||
__HashTable_GetInsertIndex = idx
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' This function returns the index from hashTable for the key k if k is in use
|
||||
FUNCTION __HashTable_GetLookupIndex& (hashTable() AS HashTableType, k AS _UNSIGNED LONG)
|
||||
DIM uB AS _UNSIGNED LONG: uB = UBOUND(hashTable)
|
||||
DIM idx AS _UNSIGNED LONG: idx = __HashTable_GetHash(k, uB)
|
||||
|
||||
IF hashTable(idx).U THEN
|
||||
' Used slot
|
||||
IF hashTable(idx).K = k THEN
|
||||
' Key found
|
||||
__HashTable_GetLookupIndex = idx
|
||||
ELSE
|
||||
' Unknown key
|
||||
__HashTable_GetLookupIndex = __HASHTABLE_KEY_UNAVAILABLE
|
||||
END IF
|
||||
ELSE
|
||||
' Unknown key
|
||||
__HashTable_GetLookupIndex = __HASHTABLE_KEY_UNAVAILABLE
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Return TRUE if k is available in the hash table
|
||||
FUNCTION HashTable_IsKeyPresent%% (hashTable() AS HashTableType, k AS _UNSIGNED LONG)
|
||||
$CHECKING:OFF
|
||||
HashTable_IsKeyPresent = (__HashTable_GetLookupIndex(hashTable(), k) >= 0)
|
||||
$CHECKING:ON
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Remove an element from the hash table
|
||||
SUB HashTable_Remove (hashTable() AS HashTableType, k AS _UNSIGNED LONG)
|
||||
DIM idx AS LONG: idx = __HashTable_GetLookupIndex(hashTable(), k)
|
||||
|
||||
IF idx >= 0 THEN
|
||||
hashTable(idx).U = __HASHTABLE_FALSE
|
||||
ELSE
|
||||
ERROR 9
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
' Inserts a long value in the table using a key
|
||||
SUB HashTable_InsertLong (hashTable() AS HashTableType, k AS _UNSIGNED LONG, v AS LONG)
|
||||
DIM idx AS LONG: idx = __HashTable_GetInsertIndex(hashTable(), k)
|
||||
|
||||
IF idx >= 0 THEN
|
||||
hashTable(idx).U = __HASHTABLE_TRUE
|
||||
hashTable(idx).K = k
|
||||
hashTable(idx).V = v
|
||||
ELSE
|
||||
ERROR 9
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
' Returns the long value from the table using a key
|
||||
FUNCTION HashTable_LookupLong& (hashTable() AS HashTableType, k AS _UNSIGNED LONG)
|
||||
DIM idx AS LONG: idx = __HashTable_GetLookupIndex(hashTable(), k)
|
||||
|
||||
IF idx >= 0 THEN
|
||||
HashTable_LookupLong = hashTable(idx).V
|
||||
ELSE
|
||||
ERROR 9
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
$END IF
|
22
InForm/extensions/HashTable.bi
Normal file
|
@ -0,0 +1,22 @@
|
|||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
' A simple hash table for integers and QB64-PE handles
|
||||
' Copyright (c) 2024 Samuel Gomes
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
$IF HASHTABLE_BI = UNDEFINED THEN
|
||||
$LET HASHTABLE_BI = TRUE
|
||||
|
||||
CONST __HASHTABLE_FALSE%% = 0%%, __HASHTABLE_TRUE%% = NOT __HASHTABLE_FALSE
|
||||
CONST __HASHTABLE_KEY_EXISTS& = -1&
|
||||
CONST __HASHTABLE_KEY_UNAVAILABLE& = -2&
|
||||
|
||||
' Hash table entry type
|
||||
' To extended supported data types, add other value types after V and then write
|
||||
' wrappers around __HashTable_GetInsertIndex() & __HashTable_GetLookupIndex()
|
||||
TYPE HashTableType
|
||||
U AS _BYTE ' used?
|
||||
K AS _UNSIGNED LONG ' key
|
||||
V AS LONG ' value
|
||||
END TYPE
|
||||
|
||||
$END IF
|
801
InForm/extensions/Ini.bas
Normal file
|
@ -0,0 +1,801 @@
|
|||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
' INI Manager
|
||||
' Copyright (c) 2024 Samuel Gomes
|
||||
' Copyright (c) 2022 Fellippe Heitor
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
$IF INI_BAS = UNDEFINED THEN
|
||||
$LET INI_BAS = TRUE
|
||||
|
||||
'$INCLUDE:'Ini.bi'
|
||||
|
||||
SUB IniSortSection (file$, __section$)
|
||||
SHARED IniCODE AS LONG, IniLastKey$, IniWholeFile$
|
||||
SHARED IniDisableAutoCommit AS _BYTE
|
||||
|
||||
REDIM Keys(1 TO 100) AS STRING
|
||||
DIM TotalKeys, tempValue$, i AS LONG, Backup$, CommitBackup
|
||||
|
||||
IF IniFormatSection$(__section$) = "[]" THEN IniCODE = 15: EXIT SUB
|
||||
|
||||
DO
|
||||
tempValue$ = ReadSetting(file$, __section$, "")
|
||||
IF LEFT$(IniINFO$, 7) = "ERROR: " THEN EXIT SUB
|
||||
IF IniCODE = 10 THEN EXIT DO
|
||||
|
||||
TotalKeys = TotalKeys + 1
|
||||
IF TotalKeys > UBOUND(Keys) THEN
|
||||
REDIM _PRESERVE Keys(1 TO UBOUND(Keys) + 100) AS STRING
|
||||
END IF
|
||||
|
||||
Keys(TotalKeys) = IniLastKey$ + "=" + tempValue$
|
||||
LOOP
|
||||
|
||||
REDIM _PRESERVE Keys(1 TO TotalKeys) AS STRING
|
||||
IF IniArraySort(Keys()) = 0 THEN IniCODE = 23: EXIT SUB
|
||||
|
||||
CommitBackup = IniDisableAutoCommit
|
||||
IniDisableAutoCommit = -1 'Prevent every minor change from being written to disk
|
||||
Backup$ = IniWholeFile$
|
||||
|
||||
FOR i = 1 TO TotalKeys
|
||||
IniDeleteKey file$, __section$, LEFT$(Keys(i), INSTR(Keys(i), "=") - 1)
|
||||
IF LEFT$(IniINFO$, 7) = "ERROR: " THEN
|
||||
IniDisableAutoCommit = CommitBackup
|
||||
IniWholeFile$ = Backup$
|
||||
EXIT SUB
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
FOR i = 1 TO TotalKeys
|
||||
WriteSetting file$, __section$, LEFT$(Keys(i), INSTR(Keys(i), "=") - 1), MID$(Keys(i), INSTR(Keys(i), "=") + 1)
|
||||
IF LEFT$(IniINFO$, 7) = "ERROR: " THEN
|
||||
IniDisableAutoCommit = CommitBackup
|
||||
IniWholeFile$ = Backup$
|
||||
EXIT SUB
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
IniDisableAutoCommit = CommitBackup 'Restore writing to disk (or previously set state) and
|
||||
IniCommit ' commit changes.
|
||||
|
||||
IniCODE = 22
|
||||
END SUB
|
||||
|
||||
SUB IniDeleteSection (file$, __section$)
|
||||
SHARED IniNewFile$, IniCODE AS LONG, currentIniFileName$
|
||||
SHARED IniLF$, IniWholeFile$, currentIniFileLOF AS _UNSIGNED LONG
|
||||
|
||||
IniLoad file$
|
||||
IF IniCODE THEN EXIT SUB
|
||||
|
||||
DIM a$
|
||||
IniCODE = 0
|
||||
a$ = IniGetSection(__section$)
|
||||
IF IniCODE THEN EXIT SUB
|
||||
|
||||
IniNewFile$ = LEFT$(IniWholeFile$, INSTR(IniWholeFile$, a$) - 1)
|
||||
IniNewFile$ = IniNewFile$ + MID$(IniWholeFile$, INSTR(IniWholeFile$, a$) + LEN(a$ + IniLF$))
|
||||
|
||||
IniCommit
|
||||
IniCODE = 13
|
||||
END SUB
|
||||
|
||||
SUB IniDeleteKey (file$, __section$, __key$)
|
||||
SHARED IniPosition AS _UNSIGNED LONG, IniCODE AS LONG
|
||||
SHARED IniLF$, IniWholeFile$, IniSectionData$
|
||||
SHARED IniLastSection$, IniLastKey$, IniNewFile$
|
||||
|
||||
DIM tempValue$
|
||||
DIM section$, key$
|
||||
DIM FoundLF AS _UNSIGNED LONG
|
||||
|
||||
IniCODE = 0
|
||||
|
||||
'prepare variables for the write operation
|
||||
section$ = IniFormatSection$(__section$)
|
||||
IF IniCODE THEN EXIT SUB
|
||||
|
||||
key$ = LTRIM$(RTRIM$(__key$))
|
||||
IF key$ = "" THEN IniCODE = 12: EXIT SUB
|
||||
IniLastKey$ = key$
|
||||
|
||||
'Read the existing key to fill IniPosition
|
||||
tempValue$ = ReadSetting$(file$, section$, key$)
|
||||
IF IniCODE > 0 AND IniCODE <> 2 THEN EXIT SUB 'key not found
|
||||
|
||||
'map IniPosition (set in the section block) to the global file position
|
||||
IniPosition = INSTR(IniWholeFile$, IniSectionData$) + IniPosition - 1
|
||||
|
||||
FoundLF = INSTR(IniPosition, IniWholeFile$, IniLF$)
|
||||
IF FoundLF = 0 THEN FoundLF = LEN(IniWholeFile$)
|
||||
|
||||
IniNewFile$ = LEFT$(IniWholeFile$, IniPosition - 1) + MID$(IniWholeFile$, FoundLF + LEN(IniLF$))
|
||||
|
||||
IniCommit
|
||||
IniCODE = 19
|
||||
END SUB
|
||||
|
||||
SUB IniMoveKey (file$, __section$, __key$, __newsection$)
|
||||
'A move operation is a copy operation + a delete operation
|
||||
|
||||
SHARED IniCODE AS LONG
|
||||
|
||||
DIM tempValue$
|
||||
|
||||
tempValue$ = ReadSetting(file$, __section$, __key$)
|
||||
IF IniCODE > 0 AND IniCODE <> 2 THEN EXIT SUB
|
||||
|
||||
WriteSetting file$, __newsection$, __key$, tempValue$
|
||||
IF IniCODE > 0 AND IniCODE <> 2 AND IniCODE <> 7 AND IniCODE <> 9 THEN EXIT SUB
|
||||
|
||||
IniDeleteKey file$, __section$, __key$
|
||||
IF IniCODE = 19 THEN IniCODE = 20
|
||||
END SUB
|
||||
|
||||
SUB IniCommit
|
||||
SHARED currentIniFileName$, IniWholeFile$, currentIniFileLOF AS _UNSIGNED LONG
|
||||
SHARED IniNewFile$, IniDisableAutoCommit AS _BYTE, IniCODE AS LONG
|
||||
SHARED LoadedFiles$
|
||||
|
||||
IF currentIniFileName$ = "" THEN IniCODE = 18: EXIT SUB
|
||||
|
||||
IniWholeFile$ = IniNewFile$
|
||||
currentIniFileLOF = LEN(IniNewFile$)
|
||||
|
||||
IF NOT IniDisableAutoCommit THEN
|
||||
DIM fileNum AS INTEGER, findFile AS INTEGER
|
||||
|
||||
'search LoadedFiles$, so we use the same file handle every time
|
||||
findFile = INSTR(LoadedFiles$, "@" + currentIniFileName$ + "@")
|
||||
IF findFile = 0 THEN
|
||||
fileNum = FREEFILE
|
||||
LoadedFiles$ = LoadedFiles$ + "@" + MKI$(fileNum) + "@" + currentIniFileName$ + "@"
|
||||
ELSE
|
||||
fileNum = CVI(MID$(LoadedFiles$, findFile - 2, 2))
|
||||
CLOSE fileNum
|
||||
END IF
|
||||
|
||||
OPEN currentIniFileName$ FOR BINARY AS #fileNum
|
||||
|
||||
IF LEN(IniWholeFile$) < LOF(fileNum) THEN
|
||||
CLOSE fileNum
|
||||
OPEN currentIniFileName$ FOR OUTPUT AS #fileNum: CLOSE #fileNum
|
||||
OPEN currentIniFileName$ FOR BINARY AS #fileNum
|
||||
END IF
|
||||
|
||||
PUT #fileNum, 1, IniNewFile$
|
||||
CLOSE #fileNum 'flush
|
||||
OPEN currentIniFileName$ FOR BINARY AS #fileNum 'keep open
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
FUNCTION IniGetSection$ (__section$)
|
||||
SHARED IniPosition AS _UNSIGNED LONG, IniCODE AS LONG, currentIniFileName$
|
||||
SHARED IniLF$, IniWholeFile$, currentIniFileLOF AS _UNSIGNED LONG
|
||||
|
||||
IF currentIniFileName$ = "" THEN IniCODE = 18: EXIT FUNCTION
|
||||
IF currentIniFileLOF = 0 OR LEN(LTRIM$(RTRIM$(IniWholeFile$))) = 0 THEN IniCODE = 17: EXIT FUNCTION
|
||||
|
||||
IniCODE = 0
|
||||
|
||||
DIM section$, foundSection AS _UNSIGNED LONG, endSection AS _UNSIGNED LONG
|
||||
DIM i AS _UNSIGNED LONG, Bracket1 AS _UNSIGNED LONG, sectionStart AS _UNSIGNED LONG
|
||||
DIM inQuote AS _BYTE
|
||||
|
||||
section$ = IniFormatSection$(__section$)
|
||||
IF IniCODE THEN EXIT FUNCTION
|
||||
|
||||
IF section$ = "[]" THEN
|
||||
'fetch the "global" section, if present
|
||||
sectionStart = INSTR(IniWholeFile$, "[")
|
||||
IF sectionStart = 0 THEN IniGetSection$ = IniWholeFile$: EXIT FUNCTION
|
||||
|
||||
FOR i = sectionStart - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN foundSection = i + 1: EXIT FOR
|
||||
IF ASC(IniWholeFile$, i) <> 32 THEN EXIT FOR
|
||||
NEXT
|
||||
|
||||
IF i = 0 THEN foundSection = 1
|
||||
|
||||
IniGetSection$ = LEFT$(IniWholeFile$, foundSection - 1)
|
||||
ELSE
|
||||
DO
|
||||
sectionStart = INSTR(sectionStart + 1, LCASE$(IniWholeFile$), LCASE$(section$))
|
||||
IF sectionStart = 0 THEN IniCODE = 14: EXIT DO
|
||||
|
||||
'make sure it's a valid section header
|
||||
foundSection = 0
|
||||
FOR i = sectionStart - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN foundSection = i + 1: EXIT FOR
|
||||
IF ASC(IniWholeFile$, i) <> 32 THEN EXIT FOR
|
||||
NEXT
|
||||
|
||||
IF i = 0 THEN foundSection = 1
|
||||
|
||||
IF foundSection > 0 THEN
|
||||
'we found it; time to identify where this section ends
|
||||
'(either another [section] or the end of the file
|
||||
Bracket1 = sectionStart
|
||||
checkAgain:
|
||||
Bracket1 = INSTR(Bracket1 + 1, IniWholeFile$, "[")
|
||||
|
||||
IF Bracket1 > 0 THEN
|
||||
'found a bracket; check if it's inside quotes
|
||||
inQuote = 0
|
||||
FOR i = 1 TO Bracket1 - 1
|
||||
IF ASC(IniWholeFile$, i) = 34 THEN inQuote = NOT inQuote
|
||||
NEXT
|
||||
IF inQuote THEN GOTO checkAgain
|
||||
|
||||
FOR i = Bracket1 - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN endSection = i + 1 - LEN(IniLF$): EXIT FOR
|
||||
IF ASC(IniWholeFile$, i) = 61 THEN GOTO checkAgain 'bracket is inside a key's value
|
||||
IF i <= foundSection THEN EXIT FOR
|
||||
NEXT
|
||||
IniGetSection$ = MID$(IniWholeFile$, foundSection, endSection - foundSection)
|
||||
ELSE
|
||||
IniGetSection$ = MID$(IniWholeFile$, foundSection)
|
||||
END IF
|
||||
EXIT FUNCTION
|
||||
END IF
|
||||
LOOP
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION IniFormatSection$ (__section$)
|
||||
SHARED IniCODE AS LONG
|
||||
|
||||
DIM section$
|
||||
|
||||
section$ = LTRIM$(RTRIM$(__section$))
|
||||
|
||||
'sections are in the format [section name] - add brackets if not passed
|
||||
IF LEFT$(section$, 1) <> "[" THEN section$ = "[" + section$
|
||||
IF RIGHT$(section$, 1) <> "]" THEN section$ = section$ + "]"
|
||||
|
||||
IF INSTR(MID$(section$, 2, LEN(section$) - 3), "[") OR INSTR(MID$(section$, 2, LEN(section$) - 3), "]") THEN
|
||||
IniCODE = 15
|
||||
EXIT FUNCTION
|
||||
END IF
|
||||
|
||||
IniFormatSection$ = section$
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION ReadSetting$ (file$, __section$, __key$)
|
||||
SHARED IniLastSection$, IniLastKey$, IniWholeFile$, IniLF$
|
||||
SHARED IniPosition AS _UNSIGNED LONG, IniSectionData$
|
||||
SHARED IniCODE AS LONG, IniAllowBasicComments AS _BYTE
|
||||
SHARED currentIniFileLOF AS _UNSIGNED LONG
|
||||
|
||||
IniLoad file$
|
||||
IF IniCODE THEN EXIT FUNCTION
|
||||
|
||||
IF currentIniFileLOF = 0 OR LEN(LTRIM$(RTRIM$(IniWholeFile$))) = 0 THEN IniCODE = 17: EXIT FUNCTION
|
||||
|
||||
DIM Equal AS _UNSIGNED LONG, tempValue$, key$, section$
|
||||
DIM Quote AS _UNSIGNED LONG, Comment AS _UNSIGNED LONG
|
||||
DIM i AS LONG, FoundLF AS _UNSIGNED LONG
|
||||
|
||||
section$ = IniFormatSection(__section$)
|
||||
IF IniCODE THEN EXIT FUNCTION
|
||||
|
||||
'fetch the desired section$
|
||||
IniSectionData$ = IniGetSection(section$)
|
||||
IF IniCODE > 0 AND IniCODE <> 17 THEN EXIT FUNCTION
|
||||
|
||||
IF LEN(IniSectionData$) = 0 AND section$ <> "[]" THEN IniCODE = 14: EXIT FUNCTION
|
||||
|
||||
IniLastSection$ = section$
|
||||
|
||||
IniPosition = 0
|
||||
|
||||
key$ = LTRIM$(RTRIM$(__key$))
|
||||
IniLastKey$ = ""
|
||||
IF key$ = "" THEN
|
||||
IF section$ = "[]" THEN IniSectionData$ = IniWholeFile$
|
||||
key$ = IniNextKey
|
||||
IF IniCODE THEN EXIT FUNCTION
|
||||
IF key$ = "" THEN
|
||||
IniCODE = 10
|
||||
EXIT FUNCTION
|
||||
END IF
|
||||
END IF
|
||||
|
||||
IF LEFT$(key$, 1) = ";" OR LEFT$(key$, 1) = "'" OR INSTR(key$, "[") > 0 OR INSTR(key$, "]") > 0 OR INSTR(key$, "=") > 0 THEN
|
||||
IniCODE = 12
|
||||
EXIT FUNCTION
|
||||
END IF
|
||||
|
||||
IniLastKey$ = key$
|
||||
|
||||
IF IniPosition > 0 THEN Equal = IniPosition: GOTO KeyFound
|
||||
CheckKey:
|
||||
IniPosition = INSTR(IniPosition + 1, LCASE$(IniSectionData$), LCASE$(key$))
|
||||
|
||||
IF IniPosition > 0 THEN
|
||||
'identify if this occurrence is actually a key and not part of a key name/value
|
||||
FOR i = IniPosition - 1 TO 1 STEP -1
|
||||
IF ASC(IniSectionData$, i) = 10 THEN EXIT FOR
|
||||
IF ASC(IniSectionData$, i) <> 10 AND ASC(IniSectionData$, i) <> 32 THEN
|
||||
'not a key
|
||||
GOTO CheckKey
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
'check if there's nothing but an equal sign ahead
|
||||
FOR i = IniPosition + LEN(key$) TO LEN(IniSectionData$)
|
||||
IF ASC(IniSectionData$, i) = ASC("=") THEN EXIT FOR
|
||||
IF ASC(IniSectionData$, i) <> ASC("=") AND ASC(IniSectionData$, i) <> 32 THEN
|
||||
'not the key
|
||||
GOTO CheckKey
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
'so far so good; check if there is an assignment
|
||||
Equal = INSTR(IniPosition, IniSectionData$, "=")
|
||||
KeyFound:
|
||||
FoundLF = INSTR(IniPosition, IniSectionData$, IniLF$)
|
||||
|
||||
IF FoundLF > 0 THEN
|
||||
IF Equal > FoundLF THEN GOTO CheckKey
|
||||
ELSE
|
||||
FoundLF = LEN(IniSectionData$) + 1
|
||||
IF Equal = 0 THEN GOTO CheckKey
|
||||
END IF
|
||||
|
||||
tempValue$ = LTRIM$(RTRIM$(MID$(IniSectionData$, Equal + 1, FoundLF - Equal - 1)))
|
||||
|
||||
IF LEN(tempValue$) > 0 THEN
|
||||
IF LEFT$(tempValue$, 1) = CHR$(34) THEN
|
||||
tempValue$ = MID$(tempValue$, 2)
|
||||
Quote = INSTR(tempValue$, CHR$(34))
|
||||
IF Quote > 0 THEN
|
||||
tempValue$ = LEFT$(tempValue$, Quote - 1)
|
||||
END IF
|
||||
ELSE
|
||||
IF IniAllowBasicComments THEN Comment = INSTR(tempValue$, "'") 'BASIC style comments accepted
|
||||
IF Comment = 0 THEN Comment = INSTR(tempValue$, ";")
|
||||
IF Comment > 0 THEN
|
||||
tempValue$ = LTRIM$(RTRIM$(LEFT$(tempValue$, Comment - 1)))
|
||||
END IF
|
||||
END IF
|
||||
ELSE
|
||||
IniCODE = 2
|
||||
END IF
|
||||
ELSE
|
||||
IniCODE = 3
|
||||
EXIT FUNCTION
|
||||
END IF
|
||||
|
||||
ReadSetting$ = tempValue$
|
||||
IniLastSection$ = IniCurrentSection$
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION IniCurrentSection$
|
||||
SHARED IniPosition AS _UNSIGNED LONG, IniSectionData$, IniWholeFile$
|
||||
|
||||
DIM GlobalPosition AS _UNSIGNED LONG, i AS _UNSIGNED LONG
|
||||
DIM ClosingBracket AS _UNSIGNED LONG
|
||||
|
||||
GlobalPosition = INSTR(IniWholeFile$, IniSectionData$) + IniPosition - 1
|
||||
|
||||
CheckSection:
|
||||
FOR i = GlobalPosition - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = ASC("[") THEN
|
||||
GlobalPosition = i: EXIT FOR
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
IF i = 0 THEN IniCurrentSection$ = "[]": EXIT FUNCTION
|
||||
|
||||
'identify if this occurrence is actually a section header and not something else
|
||||
FOR i = GlobalPosition - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN EXIT FOR
|
||||
IF ASC(IniWholeFile$, i) <> 10 AND ASC(IniWholeFile$, i) <> 32 THEN
|
||||
'not a section header
|
||||
GOTO CheckSection
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
ClosingBracket = INSTR(GlobalPosition, IniWholeFile$, "]")
|
||||
IF ClosingBracket > 0 THEN
|
||||
IniCurrentSection$ = MID$(IniWholeFile$, GlobalPosition, ClosingBracket - GlobalPosition + 1)
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
SUB WriteSetting (file$, __section$, __key$, __value$)
|
||||
SHARED IniPosition AS _UNSIGNED LONG, IniCODE AS LONG, currentIniFileName$
|
||||
SHARED IniLF$, IniWholeFile$, IniSectionData$
|
||||
SHARED IniLastSection$, IniLastKey$, IniNewFile$
|
||||
|
||||
DIM tempValue$, section$, key$, value$
|
||||
|
||||
IniCODE = 0
|
||||
|
||||
'prepare variables for the write operation
|
||||
section$ = IniFormatSection$(__section$)
|
||||
IF IniCODE THEN EXIT SUB
|
||||
|
||||
key$ = LTRIM$(RTRIM$(__key$))
|
||||
IF key$ = "" THEN IniCODE = 12: EXIT SUB
|
||||
IniLastKey$ = key$
|
||||
|
||||
value$ = LTRIM$(RTRIM$(__value$))
|
||||
IF LTRIM$(STR$(VAL(value$))) <> value$ THEN
|
||||
'if not a numeric value and value contains spaces, add quotation marks
|
||||
IF INSTR(value$, CHR$(32)) THEN value$ = CHR$(34) + value$ + CHR$(34)
|
||||
END IF
|
||||
|
||||
'Read the existing key to fill IniPosition
|
||||
tempValue$ = ReadSetting$(file$, section$, key$)
|
||||
|
||||
'map IniPosition (set in the section block) to the global file position
|
||||
IniPosition = INSTR(IniWholeFile$, IniSectionData$) + IniPosition - 1
|
||||
|
||||
IF IniCODE = 1 OR IniCODE = 17 THEN
|
||||
'file not found or empty; create a new one
|
||||
IF file$ = "" THEN file$ = currentIniFileName$
|
||||
IF file$ = "" THEN IniCODE = 21: EXIT SUB
|
||||
|
||||
currentIniFileName$ = file$
|
||||
|
||||
IF section$ <> "[]" THEN
|
||||
IniNewFile$ = section$ + IniLF$
|
||||
END IF
|
||||
|
||||
IniNewFile$ = IniNewFile$ + key$ + "=" + value$
|
||||
|
||||
IniCODE = 0
|
||||
IniCommit
|
||||
IniLoad file$
|
||||
IF IniCODE = 0 THEN IniCODE = 11
|
||||
IniLastSection$ = section$
|
||||
EXIT SUB
|
||||
END IF
|
||||
|
||||
IF IniCODE = 0 OR IniCODE = 2 THEN 'key found and read back; write new value$
|
||||
IF LCASE$(IniLastSection$) = LCASE$(section$) THEN
|
||||
IF LTRIM$(RTRIM$(__value$)) = tempValue$ AND LEN(LTRIM$(RTRIM$(__value$))) > 0 THEN
|
||||
'identical values skip the writing routine
|
||||
IniCODE = 8
|
||||
EXIT SUB
|
||||
END IF
|
||||
|
||||
DIM nextLine AS _UNSIGNED LONG
|
||||
nextLine = INSTR(IniPosition + 1, IniWholeFile$, IniLF$)
|
||||
|
||||
'create new file contents
|
||||
IniNewFile$ = LEFT$(IniWholeFile$, IniPosition - 1)
|
||||
IniNewFile$ = IniNewFile$ + key$ + "=" + value$
|
||||
|
||||
IF nextLine > 0 THEN
|
||||
IniNewFile$ = IniNewFile$ + MID$(IniWholeFile$, nextLine)
|
||||
END IF
|
||||
|
||||
IniCommit
|
||||
|
||||
IniCODE = 4
|
||||
END IF
|
||||
ELSEIF IniCODE = 3 OR IniCODE = 14 THEN 'Key not found, Section not found
|
||||
IniCODE = 0
|
||||
IF LCASE$(IniLastSection$) = LCASE$(section$) THEN
|
||||
'find this section$ in the current ini file;
|
||||
DIM Bracket1 AS _UNSIGNED LONG
|
||||
DIM beginSection AS _UNSIGNED LONG, endSection AS _UNSIGNED LONG
|
||||
DIM i AS _UNSIGNED LONG
|
||||
|
||||
beginSection = 0
|
||||
endSection = 0
|
||||
|
||||
CheckSection:
|
||||
beginSection = INSTR(beginSection + 1, LCASE$(IniWholeFile$), LCASE$(section$))
|
||||
IF beginSection = 0 THEN GOTO CreateSection
|
||||
|
||||
'identify if this occurrence is actually the section header and not something else
|
||||
FOR i = beginSection - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN EXIT FOR
|
||||
IF ASC(IniWholeFile$, i) <> 10 AND ASC(IniWholeFile$, i) <> 32 THEN
|
||||
'not the section header
|
||||
GOTO CheckSection
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
'we found it; time to identify where this section ends
|
||||
'(either another [section], a blank line or the end of the file
|
||||
Bracket1 = INSTR(beginSection + 1, IniWholeFile$, "[")
|
||||
IF Bracket1 > 0 THEN
|
||||
FOR i = Bracket1 - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN endSection = i + 1 - LEN(IniLF$): EXIT FOR
|
||||
IF i <= beginSection THEN EXIT FOR
|
||||
NEXT
|
||||
END IF
|
||||
|
||||
IF endSection > 0 THEN
|
||||
'add values to the end of the specified section$
|
||||
IniNewFile$ = LEFT$(IniWholeFile$, endSection - 1)
|
||||
IniNewFile$ = IniNewFile$ + key$ + "=" + value$ + IniLF$
|
||||
IF MID$(IniWholeFile$, endSection, LEN(IniLF$)) <> IniLF$ THEN IniNewFile$ = IniNewFile$ + IniLF$
|
||||
IniNewFile$ = IniNewFile$ + MID$(IniWholeFile$, endSection)
|
||||
ELSE
|
||||
'add values to the end of the file
|
||||
IniNewFile$ = IniWholeFile$
|
||||
IF RIGHT$(IniNewFile$, LEN(IniLF$)) = IniLF$ THEN
|
||||
IniNewFile$ = IniNewFile$ + key$ + "=" + value$
|
||||
ELSE
|
||||
IniNewFile$ = IniNewFile$ + IniLF$ + key$ + "=" + value$
|
||||
END IF
|
||||
END IF
|
||||
|
||||
IniCommit
|
||||
|
||||
IF IniCODE = 0 THEN IniCODE = 7
|
||||
EXIT SUB
|
||||
ELSE
|
||||
CreateSection:
|
||||
IniNewFile$ = IniWholeFile$
|
||||
IF section$ = "[]" THEN GOTO WriteAtTop
|
||||
|
||||
IF RIGHT$(IniNewFile$, LEN(IniLF$) * 2) = IniLF$ + IniLF$ THEN
|
||||
IniNewFile$ = IniNewFile$ + section$ + IniLF$ + key$ + "=" + value$ + IniLF$
|
||||
ELSEIF RIGHT$(IniNewFile$, LEN(IniLF$)) = IniLF$ THEN
|
||||
IniNewFile$ = IniNewFile$ + IniLF$ + section$ + IniLF$ + key$ + "=" + value$ + IniLF$
|
||||
ELSE
|
||||
IniNewFile$ = IniNewFile$ + IniLF$ + IniLF$ + section$ + IniLF$ + key$ + "=" + value$ + IniLF$
|
||||
END IF
|
||||
|
||||
IniCommit
|
||||
|
||||
IF IniCODE = 0 THEN IniCODE = 9 ELSE IniCODE = 16
|
||||
EXIT SUB
|
||||
END IF
|
||||
|
||||
'if not found, key$=value$ is written to the beginning of the file
|
||||
WriteAtTop:
|
||||
IniNewFile$ = key$ + "=" + value$ + IniLF$
|
||||
IF LEFT$(LTRIM$(IniWholeFile$), 1) = "[" THEN IniNewFile$ = IniNewFile$ + IniLF$
|
||||
IniNewFile$ = IniNewFile$ + IniWholeFile$
|
||||
|
||||
IniCommit
|
||||
|
||||
IniCODE = 5
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB IniSetForceReload (state AS _BYTE)
|
||||
SHARED IniForceReload AS _BYTE
|
||||
IF state THEN
|
||||
IniForceReload = -1
|
||||
ELSE
|
||||
IniForceReload = 0
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB IniClose
|
||||
SHARED IniDisableAutoCommit AS _BYTE, currentIniFileName$
|
||||
SHARED LoadedFiles$
|
||||
DIM findFile AS INTEGER, fileNum AS INTEGER
|
||||
|
||||
IF currentIniFileName$ = "" THEN EXIT SUB
|
||||
|
||||
'search LoadedFiles$, so we use the same file handle every time
|
||||
findFile = INSTR(LoadedFiles$, "@" + currentIniFileName$ + "@")
|
||||
IF findFile = 0 THEN
|
||||
'not open; nothing to close
|
||||
EXIT SUB
|
||||
ELSE
|
||||
fileNum = CVI(MID$(LoadedFiles$, findFile - 2, 2))
|
||||
CLOSE fileNum
|
||||
END IF
|
||||
|
||||
IniDisableAutoCommit = 0
|
||||
IniCommit
|
||||
|
||||
currentIniFileName$ = ""
|
||||
END SUB
|
||||
|
||||
SUB IniLoad (file$)
|
||||
SHARED IniCODE AS LONG, currentIniFileName$, IniLF$, IniWholeFile$
|
||||
SHARED currentIniFileLOF AS _UNSIGNED LONG
|
||||
SHARED IniForceReload AS _BYTE
|
||||
SHARED LoadedFiles$
|
||||
DIM fileNum AS INTEGER, findFile AS INTEGER
|
||||
|
||||
'Error messages are returned with IniCODE
|
||||
'Error descriptions can be fetched with function IniINFO$
|
||||
IniCODE = 0
|
||||
|
||||
IF file$ <> "" AND currentIniFileName$ <> file$ THEN currentIniFileName$ = ""
|
||||
|
||||
IF IniForceReload AND LEN(currentIniFileName$) > 0 THEN
|
||||
file$ = currentIniFileName$
|
||||
currentIniFileName$ = ""
|
||||
END IF
|
||||
|
||||
'Passing an empty file$ is allowed if user already
|
||||
'passed a valid file in this session.
|
||||
IF currentIniFileName$ = "" THEN
|
||||
'initialization
|
||||
IF _FILEEXISTS(file$) THEN
|
||||
currentIniFileName$ = file$
|
||||
|
||||
'add to LoadedFiles$, so we use the same file handle every time
|
||||
findFile = INSTR(LoadedFiles$, "@" + file$ + "@")
|
||||
IF findFile = 0 THEN
|
||||
fileNum = FREEFILE
|
||||
LoadedFiles$ = LoadedFiles$ + "@" + MKI$(fileNum) + "@" + file$ + "@"
|
||||
ELSE
|
||||
fileNum = CVI(MID$(LoadedFiles$, findFile - 2, 2))
|
||||
END IF
|
||||
|
||||
'Load file into memory
|
||||
CLOSE fileNum
|
||||
OPEN currentIniFileName$ FOR BINARY AS #fileNum
|
||||
currentIniFileLOF = LOF(fileNum)
|
||||
IniWholeFile$ = SPACE$(currentIniFileLOF)
|
||||
GET #fileNum, 1, IniWholeFile$
|
||||
|
||||
'Check if this ini file uses CRLF or LF
|
||||
IF INSTR(IniWholeFile$, CHR$(13)) THEN IniLF$ = CHR$(13) + CHR$(10) ELSE IniLF$ = CHR$(10)
|
||||
ELSE
|
||||
IniFileNotFound:
|
||||
IniCODE = 1
|
||||
|
||||
$IF WIN THEN
|
||||
IniLF$ = CHR$(13) + CHR$(10)
|
||||
$ELSE
|
||||
IniLF$ = CHR$(10)
|
||||
$END IF
|
||||
EXIT SUB
|
||||
END IF
|
||||
ELSEIF NOT _FILEEXISTS(currentIniFileName$) THEN
|
||||
currentIniFileName$ = ""
|
||||
GOTO IniFileNotFound
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
FUNCTION IniNextKey$
|
||||
SHARED IniCODE AS LONG, IniLF$, currentIniFileName$, IniSectionData$
|
||||
SHARED IniPosition AS _UNSIGNED LONG
|
||||
STATIC lastDataBlock$, position AS _UNSIGNED LONG, tempLF$
|
||||
|
||||
IF currentIniFileName$ = "" THEN IniCODE = 18: EXIT FUNCTION
|
||||
|
||||
IF IniSectionData$ <> lastDataBlock$ THEN
|
||||
position = 0
|
||||
lastDataBlock$ = IniSectionData$
|
||||
|
||||
'data blocks must end with a line feed for parsing purposes
|
||||
IF RIGHT$(IniSectionData$, LEN(IniLF$)) <> IniLF$ THEN tempLF$ = IniLF$ ELSE tempLF$ = ""
|
||||
END IF
|
||||
|
||||
DIM Equal AS _UNSIGNED LONG, tempKey$
|
||||
|
||||
FindKey:
|
||||
Equal = INSTR(position, IniSectionData$ + tempLF$, "=")
|
||||
IF Equal = 0 THEN position = 0: EXIT FUNCTION
|
||||
|
||||
tempKey$ = LTRIM$(RTRIM$(MID$(IniSectionData$ + tempLF$, position + 1, Equal - position - 1)))
|
||||
|
||||
IF INSTR(tempKey$, CHR$(10)) > 0 THEN
|
||||
position = position + INSTR(tempKey$, CHR$(10)) + 1
|
||||
tempKey$ = MID$(tempKey$, INSTR(tempKey$, CHR$(10)) + 1)
|
||||
END IF
|
||||
|
||||
DO WHILE LEFT$(tempKey$, LEN(IniLF$)) = IniLF$
|
||||
tempKey$ = MID$(tempKey$, LEN(IniLF$) + 1)
|
||||
position = position + LEN(IniLF$)
|
||||
LOOP
|
||||
|
||||
position = INSTR(position + 1, IniSectionData$ + tempLF$, IniLF$)
|
||||
|
||||
IF LEFT$(tempKey$, 1) = ";" OR LEFT$(tempKey$, 1) = "'" OR INSTR(tempKey$, "[") > 0 OR INSTR(tempKey$, "]") > 0 OR INSTR(tempKey$, "=") > 0 THEN
|
||||
GOTO FindKey
|
||||
END IF
|
||||
|
||||
IniNextKey$ = tempKey$
|
||||
IniPosition = Equal
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION IniNextSection$ (file$)
|
||||
SHARED IniCODE AS LONG, IniLF$, IniWholeFile$
|
||||
|
||||
STATIC sectionStart AS _UNSIGNED LONG
|
||||
|
||||
IniLoad file$
|
||||
IF LEFT$(IniINFO$, 6) = "ERROR:" THEN EXIT FUNCTION
|
||||
|
||||
IniCODE = 0
|
||||
|
||||
DIM foundSection AS _UNSIGNED LONG, endSection AS _UNSIGNED LONG
|
||||
DIM i AS _UNSIGNED LONG, Bracket1 AS _UNSIGNED LONG, Bracket2 AS _UNSIGNED LONG
|
||||
|
||||
FindNext:
|
||||
sectionStart = INSTR(sectionStart + 1, IniWholeFile$, "[")
|
||||
IF sectionStart = 0 THEN IniCODE = 24: EXIT FUNCTION
|
||||
|
||||
'make sure it's a valid section header
|
||||
foundSection = 0
|
||||
FOR i = sectionStart - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN foundSection = i + 1: EXIT FOR
|
||||
IF ASC(IniWholeFile$, i) <> 32 THEN GOTO FindNext
|
||||
NEXT
|
||||
|
||||
IF i = 0 THEN foundSection = 1
|
||||
|
||||
IF foundSection > 0 THEN
|
||||
'we found it; time to identify where this section ends
|
||||
'(either another [section] or the end of the file
|
||||
Bracket2 = INSTR(sectionStart + 1, IniWholeFile$, "]")
|
||||
IF Bracket2 = 0 THEN IniCODE = 24: EXIT FUNCTION
|
||||
Bracket1 = INSTR(sectionStart + 1, IniWholeFile$, "[")
|
||||
IF Bracket1 > 0 THEN
|
||||
FOR i = Bracket1 - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN endSection = i + 1 - LEN(IniLF$): EXIT FOR
|
||||
IF i <= foundSection THEN EXIT FOR
|
||||
NEXT
|
||||
IniNextSection$ = MID$(IniWholeFile$, foundSection, Bracket2 - foundSection + 1)
|
||||
ELSE
|
||||
IniNextSection$ = MID$(IniWholeFile$, foundSection, Bracket2 - foundSection + 1)
|
||||
IniCODE = 24
|
||||
sectionStart = 0
|
||||
END IF
|
||||
ELSE
|
||||
IniCODE = 24
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION IniINFO$
|
||||
SHARED IniCODE AS LONG
|
||||
SELECT CASE IniCODE
|
||||
CASE 0: IniINFO$ = "Operation successful"
|
||||
CASE 1: IniINFO$ = "ERROR: File not found"
|
||||
CASE 2: IniINFO$ = "Empty value"
|
||||
CASE 3: IniINFO$ = "ERROR: Key not found"
|
||||
CASE 4: IniINFO$ = "Key updated"
|
||||
CASE 5: IniINFO$ = "Global key created"
|
||||
CASE 7: IniINFO$ = "Key created in existing section"
|
||||
CASE 8: IniINFO$ = "No changes applied (same value)"
|
||||
CASE 9: IniINFO$ = "New section created; key created"
|
||||
CASE 10: IniINFO$ = "No more keys"
|
||||
CASE 11: IniINFO$ = "File created; new key added"
|
||||
CASE 12: IniINFO$ = "ERROR: Invalid key"
|
||||
CASE 13: IniINFO$ = "Section deleted"
|
||||
CASE 14: IniINFO$ = "ERROR: Section not found"
|
||||
CASE 15: IniINFO$ = "ERROR: Invalid section"
|
||||
CASE 16: IniINFO$ = "New section created; existing key moved"
|
||||
CASE 17: IniINFO$ = "ERROR: Empty file"
|
||||
CASE 18: IniINFO$ = "ERROR: No file open"
|
||||
CASE 19: IniINFO$ = "Key deleted"
|
||||
CASE 20: IniINFO$ = "Key moved"
|
||||
CASE 21: IniINFO$ = "ERROR: Invalid file name/path"
|
||||
CASE 22: IniINFO$ = "Section sorted"
|
||||
CASE 23: IniINFO$ = "No changes applied; section already sorted"
|
||||
CASE 24: IniINFO$ = "No more sections"
|
||||
CASE ELSE: IniINFO$ = "ERROR: <invalid error code>"
|
||||
END SELECT
|
||||
END FUNCTION
|
||||
|
||||
'Written in BASIC by Luke Ceddia for ide_methods.bas (QB64)
|
||||
'After Cormen, Leiserson, Rivest & Stein "Introduction To Algoritms" via Wikipedia
|
||||
'Adapted for use in .INI Manager
|
||||
FUNCTION IniArraySort%% (arr() AS STRING)
|
||||
DIM i&, x$, j&, moves&
|
||||
|
||||
FOR i& = LBOUND(arr) + 1 TO UBOUND(arr)
|
||||
x$ = arr(i&)
|
||||
j& = i& - 1
|
||||
WHILE j& >= LBOUND(arr)
|
||||
IF arr(j&) <= x$ THEN EXIT WHILE
|
||||
moves& = moves& + 1
|
||||
arr$(j& + 1) = arr$(j&)
|
||||
j& = j& - 1
|
||||
WEND
|
||||
arr$(j& + 1) = x$
|
||||
NEXT i&
|
||||
|
||||
'Returns -1 (true) if any changes were made
|
||||
IniArraySort%% = moves& > 0
|
||||
END FUNCTION
|
||||
|
||||
$END IF
|
31
InForm/extensions/Ini.bi
Normal file
|
@ -0,0 +1,31 @@
|
|||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
' INI Manager
|
||||
' Copyright (c) 2024 Samuel Gomes
|
||||
' Copyright (c) 2022 Fellippe Heitor
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
$IF INI_BI = UNDEFINED THEN
|
||||
$LET INI_BI = TRUE
|
||||
|
||||
' TODO:
|
||||
' We should put all of this stuff into a single state type and then have just a single global to avoid possible name collisions.
|
||||
' That should also let us make the library load multiple INI files at the same time like the GIFPlayer library.
|
||||
' INI routines without namespace like prefix should also be prefixed with the "Ini_" prefix.
|
||||
|
||||
'Global variables declaration
|
||||
DIM currentIniFileName AS STRING
|
||||
DIM LoadedFiles AS STRING
|
||||
DIM currentIniFileLOF AS _UNSIGNED LONG
|
||||
DIM IniWholeFile AS STRING
|
||||
DIM IniSectionData AS STRING
|
||||
DIM IniPosition AS _UNSIGNED LONG
|
||||
DIM IniNewFile AS STRING
|
||||
DIM IniLastSection AS STRING
|
||||
DIM IniLastKey AS STRING
|
||||
DIM IniLF AS STRING
|
||||
DIM IniDisableAutoCommit AS _BYTE
|
||||
DIM IniCODE AS LONG
|
||||
DIM IniAllowBasicComments AS _BYTE
|
||||
DIM IniForceReload AS _BYTE
|
||||
|
||||
$END IF
|
|
@ -1,51 +0,0 @@
|
|||
Animated GIF decoder v1.0
|
||||
By Zom-B
|
||||
http://www.qb64.org/wiki/GIF_Images
|
||||
|
||||
Adapted for use with InForm's PictureBox controls by @FellippeHeitor
|
||||
|
||||
* Usage instructions:
|
||||
Your form must contain a PictureBox control that'll serve as a container for
|
||||
the GIF file you'll load with this library.
|
||||
|
||||
In the "External modules" section of the .bas file generated by InForm,
|
||||
$INCLUDE both gifplay.bi and gifplay.bm. The first must come before the
|
||||
line that includes InForm.ui and the second must come after that, as in
|
||||
the sample below:
|
||||
|
||||
': External modules: --------------------------------
|
||||
'$INCLUDE:'InForm\extensions\gifplay.bi'
|
||||
'$INCLUDE:'InForm\InForm.ui'
|
||||
'$INCLUDE:'InForm\xp.uitheme'
|
||||
'$INCLUDE:'gifplaySample.frm'
|
||||
'$INCLUDE:'InForm\extensions\gifplay.bm'
|
||||
|
||||
* Methods:
|
||||
|
||||
- FUNCTION OpenGif(ID, file$)
|
||||
|
||||
OpenGif is a function that takes a PictureBox control ID and a GIF
|
||||
file name and returns True if loading the animation is successful.
|
||||
|
||||
- FUNCTION TotalFrames(ID AS LONG)
|
||||
|
||||
TotalFrames returns the total number of frames in a loaded gif.
|
||||
If not an animated GIF, returns 1.
|
||||
|
||||
- SUB UpdateGif(ID)
|
||||
|
||||
UpdateGif must be called from within the __UI_BeforeUpdateDisplay event.
|
||||
That's where the frames will be updated in your PictureBox control.
|
||||
|
||||
- FUNCTION IsPlaying(ID)
|
||||
|
||||
Returns True is the PictureBox control contains a GIF that's currently
|
||||
being played.
|
||||
|
||||
- SUB PlayGif(ID), SUB PauseGif(ID), SUB StopGif(ID)
|
||||
Starts, pauses or stops playback of a GIF file loaded into the specified
|
||||
PictureBox control.
|
||||
|
||||
- SUB CloseGif(ID)
|
||||
Closes the GIF file loaded in the specified PictureBox control and frees
|
||||
the memory used by the frame data buffer attached to it.
|
332
InForm/extensions/StringFile.bas
Normal file
|
@ -0,0 +1,332 @@
|
|||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
' File I/O like routines for memory loaded files
|
||||
' Copyright (c) 2024 Samuel Gomes
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
$IF STRINGFILE_BAS = UNDEFINED THEN
|
||||
$LET STRINGFILE_BAS = TRUE
|
||||
|
||||
'$INCLUDE:'StringFile.bi'
|
||||
|
||||
'-------------------------------------------------------------------------------------------------------------------
|
||||
' Test code for debugging the library
|
||||
'-------------------------------------------------------------------------------------------------------------------
|
||||
'DEFLNG A-Z
|
||||
'OPTION _EXPLICIT
|
||||
'WIDTH , 80
|
||||
'DIM sf AS StringFileType
|
||||
'StringFile_Create sf, "This_is_a_test_buffer."
|
||||
'PRINT LEN(sf.buffer), sf.cursor
|
||||
'PRINT StringFile_GetPosition(sf)
|
||||
'PRINT StringFile_ReadString(sf, 22)
|
||||
'PRINT StringFile_GetPosition(sf)
|
||||
'PRINT StringFile_IsEOF(sf)
|
||||
'PRINT LEN(sf.buffer), sf.cursor
|
||||
'StringFile_Seek sf, StringFile_GetPosition(sf) - 1
|
||||
'StringFile_WriteString sf, "! Now adding some more text."
|
||||
'PRINT StringFile_GetPosition(sf)
|
||||
'PRINT StringFile_IsEOF(sf)
|
||||
'PRINT LEN(sf.buffer), sf.cursor
|
||||
'StringFile_Seek sf, 0
|
||||
'PRINT StringFile_GetPosition(sf)
|
||||
'PRINT StringFile_IsEOF(sf)
|
||||
'PRINT LEN(sf.buffer), sf.cursor
|
||||
'PRINT StringFile_ReadString(sf, 49)
|
||||
'PRINT StringFile_GetPosition(sf)
|
||||
'PRINT StringFile_IsEOF(sf)
|
||||
'PRINT LEN(sf.buffer), sf.cursor
|
||||
'StringFile_Seek sf, 0
|
||||
'PRINT CHR$(StringFile_ReadByte(sf))
|
||||
'PRINT LEN(sf.buffer), sf.cursor
|
||||
'StringFile_WriteString sf, "XX"
|
||||
'PRINT LEN(sf.buffer), sf.cursor
|
||||
'PRINT CHR$(StringFile_ReadByte(sf))
|
||||
'StringFile_Seek sf, 0
|
||||
'PRINT StringFile_ReadString(sf, 49)
|
||||
'PRINT StringFile_GetPosition(sf)
|
||||
'PRINT StringFile_IsEOF(sf)
|
||||
'PRINT LEN(sf.buffer), sf.cursor
|
||||
'StringFile_Seek sf, 0
|
||||
'StringFile_WriteInteger sf, 420
|
||||
'StringFile_Seek sf, 0
|
||||
'PRINT StringFile_ReadInteger(sf)
|
||||
'PRINT LEN(sf.buffer), sf.cursor
|
||||
'StringFile_Seek sf, 0
|
||||
'StringFile_WriteByte sf, 255
|
||||
'StringFile_Seek sf, 0
|
||||
'PRINT StringFile_ReadByte(sf)
|
||||
'PRINT LEN(sf.buffer), sf.cursor
|
||||
'StringFile_Seek sf, 0
|
||||
'StringFile_WriteLong sf, 192000
|
||||
'StringFile_Seek sf, 0
|
||||
'PRINT StringFile_ReadLong(sf)
|
||||
'PRINT LEN(sf.buffer), sf.cursor
|
||||
'StringFile_Seek sf, 0
|
||||
'StringFile_WriteSingle sf, 752.334
|
||||
'StringFile_Seek sf, 0
|
||||
'PRINT StringFile_ReadSingle(sf)
|
||||
'PRINT LEN(sf.buffer), sf.cursor
|
||||
'StringFile_Seek sf, 0
|
||||
'StringFile_WriteDouble sf, 23232323.242423424#
|
||||
'StringFile_Seek sf, 0
|
||||
'PRINT StringFile_ReadDouble(sf)
|
||||
'PRINT LEN(sf.buffer), sf.cursor
|
||||
'StringFile_Seek sf, 0
|
||||
'StringFile_WriteInteger64 sf, 9999999999999999&&
|
||||
'StringFile_Seek sf, 0
|
||||
'PRINT StringFile_ReadInteger64(sf)
|
||||
'PRINT LEN(sf.buffer), sf.cursor
|
||||
'END
|
||||
'-------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
' Creates a new StringFile object
|
||||
' StringFile APIs are a simple way of dealing with file that are completely loaded in memory
|
||||
' Since it uses a QB string as a backing buffer, no explicit memory management (i.e. freeing) is required
|
||||
SUB StringFile_Create (stringFile AS StringFileType, buffer AS STRING)
|
||||
stringFile.buffer = buffer
|
||||
stringFile.cursor = 0
|
||||
END SUB
|
||||
|
||||
|
||||
' Loads a whole file from disk into a StringFile object
|
||||
' This will reset the StringFile object if it was previously being used
|
||||
FUNCTION StringFile_Load%% (stringFile AS StringFileType, fileName AS STRING)
|
||||
IF _FILEEXISTS(fileName) THEN
|
||||
DIM AS LONG fh: fh = FREEFILE
|
||||
|
||||
OPEN fileName FOR BINARY ACCESS READ AS fh
|
||||
stringFile.buffer = INPUT$(LOF(fh), fh)
|
||||
stringFile.cursor = 0
|
||||
CLOSE fh
|
||||
|
||||
StringFile_Load = __STRINGFILE_TRUE
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Saves a StringFile object to a file
|
||||
' This does not disturb the read / write cursor
|
||||
FUNCTION StringFile_Save%% (stringFile AS StringFileType, fileName AS STRING, overwrite AS _BYTE)
|
||||
IF _FILEEXISTS(fileName) AND NOT overwrite THEN EXIT FUNCTION
|
||||
|
||||
DIM fh AS LONG: fh = FREEFILE
|
||||
|
||||
OPEN fileName FOR OUTPUT AS fh ' open file in text mode to wipe out the file if it exists
|
||||
PRINT #fh, stringFile.buffer; ' write the buffer to the file (works regardless of the file being opened in text mode)
|
||||
CLOSE fh
|
||||
|
||||
StringFile_Save = __STRINGFILE_TRUE
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Returns true if EOF is reached
|
||||
FUNCTION StringFile_IsEOF%% (stringFile AS StringFileType)
|
||||
StringFile_IsEOF = (stringFile.cursor >= LEN(stringFile.buffer))
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Get the size of the file
|
||||
FUNCTION StringFile_GetSize~& (stringFile AS StringFileType)
|
||||
StringFile_GetSize = LEN(stringFile.buffer)
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Gets the current r/w cursor position
|
||||
FUNCTION StringFile_GetPosition~& (stringFile AS StringFileType)
|
||||
StringFile_GetPosition = stringFile.cursor
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Seeks to a position in the file
|
||||
SUB StringFile_Seek (stringFile AS StringFileType, position AS _UNSIGNED LONG)
|
||||
IF position <= LEN(stringFile.buffer) THEN ' allow seeking to EOF position
|
||||
stringFile.cursor = position
|
||||
ELSE
|
||||
ERROR 5
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
' Resizes the file
|
||||
SUB StringFile_Resize (stringFile AS StringFileType, newSize AS _UNSIGNED LONG)
|
||||
DIM AS _UNSIGNED LONG curSize: curSize = LEN(stringFile.buffer)
|
||||
|
||||
IF newSize > curSize THEN
|
||||
stringFile.buffer = stringFile.buffer + STRING$(newSize - curSize, 0)
|
||||
ELSEIF newSize < curSize THEN
|
||||
stringFile.buffer = LEFT$(stringFile.buffer, newSize)
|
||||
IF stringFile.cursor > newSize THEN stringFile.cursor = newSize ' reposition cursor to EOF position
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
' Reads size bytes from the file
|
||||
FUNCTION StringFile_ReadString$ (stringFile AS StringFileType, size AS _UNSIGNED LONG)
|
||||
IF size > 0 THEN ' reading 0 bytes will simply do nothing
|
||||
IF stringFile.cursor < LEN(stringFile.buffer) THEN ' we'll allow partial string reads but check if we have anything to read at all
|
||||
DIM dst AS STRING: dst = MID$(stringFile.buffer, stringFile.cursor + 1, size)
|
||||
|
||||
stringFile.cursor = stringFile.cursor + LEN(dst) ' increment cursor by size bytes
|
||||
|
||||
StringFile_ReadString = dst
|
||||
ELSE ' not enough bytes to read
|
||||
ERROR 5
|
||||
END IF
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Writes a string to the file and grows the file if needed
|
||||
SUB StringFile_WriteString (stringFile AS StringFileType, src AS STRING)
|
||||
DIM srcSize AS _UNSIGNED LONG: srcSize = LEN(src)
|
||||
|
||||
IF srcSize > 0 THEN ' writing 0 bytes will simply do nothing
|
||||
DIM curSize AS _UNSIGNED LONG: curSize = LEN(stringFile.buffer)
|
||||
|
||||
' Grow the buffer if needed
|
||||
IF stringFile.cursor + srcSize >= curSize THEN stringFile.buffer = stringFile.buffer + STRING$(stringFile.cursor + srcSize - curSize, 0)
|
||||
|
||||
MID$(stringFile.buffer, stringFile.cursor + 1, srcSize) = src
|
||||
stringFile.cursor = stringFile.cursor + srcSize ' this puts the cursor right after the last positon written
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
' Reads a byte from the file
|
||||
FUNCTION StringFile_ReadByte~%% (stringFile AS StringFileType)
|
||||
IF stringFile.cursor + 1 <= LEN(stringFile.buffer) THEN ' check if we really have the amount of bytes to read
|
||||
StringFile_ReadByte = ASC(stringFile.buffer, stringFile.cursor + 1) ' read the data
|
||||
stringFile.cursor = stringFile.cursor + 1 ' this puts the cursor right after the last positon read
|
||||
ELSE ' not enough bytes to read
|
||||
ERROR 5
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Write a byte to the file
|
||||
SUB StringFile_WriteByte (stringFile AS StringFileType, src AS _UNSIGNED _BYTE)
|
||||
DIM curSize AS _UNSIGNED LONG: curSize = LEN(stringFile.buffer)
|
||||
|
||||
' Grow the buffer if needed
|
||||
IF stringFile.cursor + 1 >= curSize THEN stringFile.buffer = stringFile.buffer + STRING$(stringFile.cursor + 1 - curSize, 0)
|
||||
|
||||
ASC(stringFile.buffer, stringFile.cursor + 1) = src ' write the data
|
||||
stringFile.cursor = stringFile.cursor + 1 ' this puts the cursor right after the last positon written
|
||||
END SUB
|
||||
|
||||
|
||||
' Reads an integer from the file
|
||||
FUNCTION StringFile_ReadInteger~% (stringFile AS StringFileType)
|
||||
IF stringFile.cursor + 2 <= LEN(stringFile.buffer) THEN ' check if we really have the amount of bytes to read
|
||||
StringFile_ReadInteger = CVI(MID$(stringFile.buffer, stringFile.cursor + 1, 2)) ' read the data
|
||||
stringFile.cursor = stringFile.cursor + 2 ' this puts the cursor right after the last positon read
|
||||
ELSE ' not enough bytes to read
|
||||
ERROR 5
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Writes an integer to the file
|
||||
SUB StringFile_WriteInteger (stringFile AS StringFileType, src AS _UNSIGNED INTEGER)
|
||||
DIM curSize AS _UNSIGNED LONG: curSize = LEN(stringFile.buffer)
|
||||
|
||||
' Grow the buffer if needed
|
||||
IF stringFile.cursor + 2 >= curSize THEN stringFile.buffer = stringFile.buffer + STRING$(stringFile.cursor + 2 - curSize, 0)
|
||||
|
||||
MID$(stringFile.buffer, stringFile.cursor + 1, 2) = MKI$(src) ' write the data
|
||||
stringFile.cursor = stringFile.cursor + 2 ' this puts the cursor right after the last positon written
|
||||
END SUB
|
||||
|
||||
|
||||
' Reads a long from the file
|
||||
FUNCTION StringFile_ReadLong~& (stringFile AS StringFileType)
|
||||
IF stringFile.cursor + 4 <= LEN(stringFile.buffer) THEN ' check if we really have the amount of bytes to read
|
||||
StringFile_ReadLong = CVL(MID$(stringFile.buffer, stringFile.cursor + 1, 4)) ' read the data
|
||||
stringFile.cursor = stringFile.cursor + 4 ' this puts the cursor right after the last positon read
|
||||
ELSE ' not enough bytes to read
|
||||
ERROR 5
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Writes a long to the file
|
||||
SUB StringFile_WriteLong (stringFile AS StringFileType, src AS _UNSIGNED LONG)
|
||||
DIM curSize AS _UNSIGNED LONG: curSize = LEN(stringFile.buffer)
|
||||
|
||||
' Grow the buffer if needed
|
||||
IF stringFile.cursor + 4 >= curSize THEN stringFile.buffer = stringFile.buffer + STRING$(stringFile.cursor + 4 - curSize, 0)
|
||||
|
||||
MID$(stringFile.buffer, stringFile.cursor + 1, 4) = MKL$(src) ' write the data
|
||||
stringFile.cursor = stringFile.cursor + 4 ' this puts the cursor right after the last positon written
|
||||
END SUB
|
||||
|
||||
|
||||
' Reads a single from the file
|
||||
FUNCTION StringFile_ReadSingle! (stringFile AS StringFileType)
|
||||
IF stringFile.cursor + 4 <= LEN(stringFile.buffer) THEN ' check if we really have the amount of bytes to read
|
||||
StringFile_ReadSingle = CVS(MID$(stringFile.buffer, stringFile.cursor + 1, 4)) ' read the data
|
||||
stringFile.cursor = stringFile.cursor + 4 ' this puts the cursor right after the last positon read
|
||||
ELSE ' not enough bytes to read
|
||||
ERROR 5
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Writes a single to the file
|
||||
SUB StringFile_WriteSingle (stringFile AS StringFileType, src AS SINGLE)
|
||||
DIM curSize AS _UNSIGNED LONG: curSize = LEN(stringFile.buffer)
|
||||
|
||||
' Grow the buffer if needed
|
||||
IF stringFile.cursor + 4 >= curSize THEN stringFile.buffer = stringFile.buffer + STRING$(stringFile.cursor + 4 - curSize, 0)
|
||||
|
||||
MID$(stringFile.buffer, stringFile.cursor + 1, 4) = MKS$(src) ' write the data
|
||||
stringFile.cursor = stringFile.cursor + 4 ' this puts the cursor right after the last positon written
|
||||
END SUB
|
||||
|
||||
|
||||
' Reads an integer64 from the file
|
||||
FUNCTION StringFile_ReadInteger64~&& (stringFile AS StringFileType)
|
||||
IF stringFile.cursor + 8 <= LEN(stringFile.buffer) THEN ' check if we really have the amount of bytes to read
|
||||
StringFile_ReadInteger64 = _CV(_UNSIGNED _INTEGER64, MID$(stringFile.buffer, stringFile.cursor + 1, 8)) ' read the data
|
||||
stringFile.cursor = stringFile.cursor + 8 ' this puts the cursor right after the last positon read
|
||||
ELSE ' not enough bytes to read
|
||||
ERROR 5
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Writes an integer64 to the file
|
||||
SUB StringFile_WriteInteger64 (stringFile AS StringFileType, src AS _UNSIGNED _INTEGER64)
|
||||
DIM curSize AS _UNSIGNED LONG: curSize = LEN(stringFile.buffer)
|
||||
|
||||
' Grow the buffer if needed
|
||||
IF stringFile.cursor + 8 >= curSize THEN stringFile.buffer = stringFile.buffer + STRING$(stringFile.cursor + 8 - curSize, 0)
|
||||
|
||||
MID$(stringFile.buffer, stringFile.cursor + 1, 8) = _MK$(_UNSIGNED _INTEGER64, src) ' write the data
|
||||
stringFile.cursor = stringFile.cursor + 8 ' this puts the cursor right after the last positon written
|
||||
END SUB
|
||||
|
||||
|
||||
' Reads a double from the file
|
||||
FUNCTION StringFile_ReadDouble# (stringFile AS StringFileType)
|
||||
IF stringFile.cursor + 8 <= LEN(stringFile.buffer) THEN ' check if we really have the amount of bytes to read
|
||||
StringFile_ReadDouble = CVD(MID$(stringFile.buffer, stringFile.cursor + 1, 8)) ' read the data
|
||||
stringFile.cursor = stringFile.cursor + 8 ' this puts the cursor right after the last positon read
|
||||
ELSE ' not enough bytes to read
|
||||
ERROR 5
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
' Writes a double to the file
|
||||
SUB StringFile_WriteDouble (stringFile AS StringFileType, src AS DOUBLE)
|
||||
DIM curSize AS _UNSIGNED LONG: curSize = LEN(stringFile.buffer)
|
||||
|
||||
' Grow the buffer if needed
|
||||
IF stringFile.cursor + 8 >= curSize THEN stringFile.buffer = stringFile.buffer + STRING$(stringFile.cursor + 8 - curSize, 0)
|
||||
|
||||
MID$(stringFile.buffer, stringFile.cursor + 1, 8) = MKD$(src) ' write the data
|
||||
stringFile.cursor = stringFile.cursor + 8 ' this puts the cursor right after the last positon written
|
||||
END SUB
|
||||
|
||||
$END IF
|
17
InForm/extensions/StringFile.bi
Normal file
|
@ -0,0 +1,17 @@
|
|||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
' File I/O like routines for memory loaded files
|
||||
' Copyright (c) 2024 Samuel Gomes
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
$IF STRINGFILE_BI = UNDEFINED THEN
|
||||
$LET STRINGFILE_BI = TRUE
|
||||
|
||||
CONST __STRINGFILE_FALSE%% = 0%%, __STRINGFILE_TRUE%% = NOT __STRINGFILE_FALSE
|
||||
|
||||
' Simplified QB64-only memory-file
|
||||
TYPE StringFileType
|
||||
buffer AS STRING
|
||||
cursor AS _UNSIGNED LONG
|
||||
END TYPE
|
||||
|
||||
$END IF
|
|
@ -1,63 +0,0 @@
|
|||
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
|
||||
|
||||
IF url$ <> prevUrl$ OR url$ = "" THEN
|
||||
prevUrl$ = url$
|
||||
IF url$ = "" THEN
|
||||
IF theClient THEN CLOSE theClient: theClient = 0
|
||||
EXIT SUB
|
||||
END IF
|
||||
url2$ = url$
|
||||
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)
|
||||
x$ = "GET " + url3$ + " HTTP/1.1" + e$
|
||||
x$ = x$ + "Host: " + url2$ + e$ + e$
|
||||
PUT #theClient, , x$
|
||||
t! = TIMER ' start time
|
||||
END IF
|
||||
|
||||
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
|
||||
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
|
||||
Download = MKI$(1) + MKL$(l) 'indicates download was successful
|
||||
prevUrl$ = ""
|
||||
prevUrl2$ = ""
|
||||
a$ = ""
|
||||
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
|
||||
Download = MKI$(0) 'still working
|
||||
END FUNCTION
|
|
@ -1,57 +0,0 @@
|
|||
'#######################################################################################
|
||||
'# Animated GIF decoder v1.0 #
|
||||
'# By Zom-B #
|
||||
'# #
|
||||
'# http://www.qb64.org/wiki/GIF_Images #
|
||||
'#######################################################################################
|
||||
'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 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
|
|
@ -1,881 +0,0 @@
|
|||
'#######################################################################################
|
||||
'# Animated GIF decoder v1.0 #
|
||||
'# By Zom-B #
|
||||
'# #
|
||||
'# http://www.qb64.org/wiki/GIF_Images #
|
||||
'#######################################################################################
|
||||
'Adapted for use with InForm's PictureBox controls by @FellippeHeitor
|
||||
|
||||
SUB UpdateGif (ID AS LONG)
|
||||
DIM i AS LONG, newFrame AS LONG
|
||||
STATIC GifOverlay AS LONG
|
||||
|
||||
i = GetGifIndex(ID)
|
||||
|
||||
IF i = 0 THEN EXIT SUB
|
||||
|
||||
IF GifOverlay = 0 THEN
|
||||
GifOverlay = LoadOverlayImage&
|
||||
END IF
|
||||
|
||||
IF GifData(i).IsPlaying OR GifData(i).LastFrameServed = 0 THEN
|
||||
IF GifData(i).LastFrameUpdate > 0 AND TIMER - GifData(i).LastFrameUpdate < GifData(i).LastFrameDelay THEN
|
||||
'Wait for the GIF's frame delay
|
||||
ELSE
|
||||
GifData(i).Frame = GifData(i).Frame + 1
|
||||
GifData(i).LastFrameServed = GifData(i).Frame
|
||||
GifData(i).LastFrameUpdate = TIMER
|
||||
END IF
|
||||
END IF
|
||||
|
||||
BeginDraw ID
|
||||
newFrame = GetGifFrame&(i)
|
||||
IF newFrame THEN _PUTIMAGE , newFrame
|
||||
IF GifData(i).IsPlaying = False AND GifData(i).HideOverlay = False AND GifData(i).totalFrames > 1 THEN
|
||||
_PUTIMAGE (_WIDTH / 2 - _WIDTH(GifOverlay) / 2, _HEIGHT / 2 - _HEIGHT(GifOverlay) / 2), GifOverlay
|
||||
END IF
|
||||
EndDraw ID
|
||||
END SUB
|
||||
|
||||
FUNCTION GifIsPlaying%% (ID AS LONG)
|
||||
DIM i AS LONG
|
||||
i = GetGifIndex(ID)
|
||||
GifIsPlaying%% = GifData(i).IsPlaying
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION GifWidth%(ID AS LONG)
|
||||
DIM i AS LONG
|
||||
i = GetGifIndex(ID)
|
||||
GifWidth% = GifData(i).width
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION GifHeight%(ID AS LONG)
|
||||
DIM i AS LONG
|
||||
i = GetGifIndex(ID)
|
||||
GifHeight% = GifData(i).height
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION TotalFrames&(ID AS LONG)
|
||||
DIM i AS LONG
|
||||
i = GetGifIndex(ID)
|
||||
TotalFrames& = GifData(i).totalFrames
|
||||
END FUNCTION
|
||||
|
||||
SUB HideGifOverlay (ID AS LONG)
|
||||
DIM i AS LONG
|
||||
i = GetGifIndex(ID)
|
||||
GifData(i).HideOverlay = True
|
||||
END SUB
|
||||
|
||||
SUB PlayGif (ID AS LONG)
|
||||
DIM i AS LONG
|
||||
i = GetGifIndex(ID)
|
||||
GifData(i).IsPlaying = True
|
||||
END SUB
|
||||
|
||||
SUB PauseGif (ID AS LONG)
|
||||
DIM i AS LONG
|
||||
i = GetGifIndex(ID)
|
||||
GifData(i).IsPlaying = False
|
||||
END SUB
|
||||
|
||||
SUB StopGif (ID AS LONG)
|
||||
DIM i AS LONG
|
||||
i = GetGifIndex(ID)
|
||||
GifData(i).IsPlaying = False
|
||||
GifData(i).Frame = 1
|
||||
END SUB
|
||||
|
||||
FUNCTION OpenGif%%(ID AS LONG, filename$)
|
||||
DIM i AS LONG, Index AS LONG
|
||||
DIM byte~%%, palette$, delay~%
|
||||
|
||||
IF Control(ID).Type <> __UI_Type_PictureBox THEN ERROR 5: EXIT FUNCTION
|
||||
|
||||
Index = GetGifIndex&(ID)
|
||||
|
||||
IF Index = 0 THEN
|
||||
TotalGIFLoaded = TotalGIFLoaded + 1
|
||||
Index = TotalGIFLoaded
|
||||
REDIM _PRESERVE GifData(1 TO TotalGIFLoaded) AS GIFDATA
|
||||
ELSE
|
||||
CloseGif ID
|
||||
END IF
|
||||
|
||||
GifData(Index).ID = ID
|
||||
GifData(Index).file = FREEFILE
|
||||
IF _FILEEXISTS(filename$) = 0 THEN EXIT FUNCTION
|
||||
OPEN filename$ FOR BINARY AS GifData(Index).file
|
||||
|
||||
GET GifData(Index).file, , GifData(Index).sigver
|
||||
GET GifData(Index).file, , GifData(Index).width
|
||||
GET GifData(Index).file, , GifData(Index).height
|
||||
GET GifData(Index).file, , byte~%%
|
||||
GifData(Index).bpp = (byte~%% AND 7) + 1
|
||||
GifData(Index).sortFlag = (byte~%% AND 8) > 0
|
||||
GifData(Index).colorRes = (byte~%% \ 16 AND 7) + 1
|
||||
GifData(Index).colorTableFlag = (byte~%% AND 128) > 0
|
||||
GifData(Index).numColors = 2 ^ GifData(Index).bpp
|
||||
GET GifData(Index).file, , GifData(Index).bgColor
|
||||
GET GifData(Index).file, , byte~%%
|
||||
IF byte~%% = 0 THEN GifData(Index).aspect = 0 ELSE GifData(Index).aspect = (byte~%% + 15) / 64
|
||||
|
||||
IF GifData(Index).sigver <> "GIF87a" AND GifData(Index).sigver <> "GIF89a" THEN
|
||||
'Invalid version
|
||||
GOTO LoadError
|
||||
END IF
|
||||
|
||||
IF NOT GifData(Index).colorTableFlag THEN
|
||||
'No Color Table
|
||||
GOTO LoadError
|
||||
END IF
|
||||
|
||||
palette$ = SPACE$(3 * GifData(Index).numColors)
|
||||
GET GifData(Index).file, , palette$
|
||||
GifData(Index).palette = palette$
|
||||
DO
|
||||
GET GifData(Index).file, , byte~%%
|
||||
SELECT CASE byte~%%
|
||||
CASE &H2C ' Image Descriptor
|
||||
TotalGIFFrames = TotalGIFFrames + 1
|
||||
GifData(Index).totalFrames = GifData(Index).totalFrames + 1
|
||||
|
||||
IF GifData(Index).firstFrame = 0 THEN
|
||||
GifData(Index).firstFrame = TotalGIFFrames
|
||||
END IF
|
||||
|
||||
IF TotalGIFFrames > UBOUND(GifFrameData) THEN
|
||||
REDIM _PRESERVE GifFrameData(0 TO TotalGIFFrames * 2) AS FRAMEDATA
|
||||
END IF
|
||||
|
||||
GifFrameData(TotalGIFFrames).ID = ID
|
||||
GifFrameData(TotalGIFFrames).thisFrame = GifData(Index).totalFrames
|
||||
|
||||
GET GifData(Index).file, , GifFrameData(TotalGIFFrames).left
|
||||
GET GifData(Index).file, , GifFrameData(TotalGIFFrames).top
|
||||
GET GifData(Index).file, , GifFrameData(TotalGIFFrames).width
|
||||
GET GifData(Index).file, , GifFrameData(TotalGIFFrames).height
|
||||
GET GifData(Index).file, , byte~%%
|
||||
GifFrameData(TotalGIFFrames).localColorTableFlag = (byte~%% AND 128) > 0
|
||||
GifFrameData(TotalGIFFrames).interlacedFlag = (byte~%% AND 64) > 0
|
||||
GifFrameData(TotalGIFFrames).sortFlag = (byte~%% AND 32) > 0
|
||||
GifFrameData(TotalGIFFrames).palBPP = (byte~%% AND 7) + 1
|
||||
GifFrameData(TotalGIFFrames).addr = LOC(GifData(Index).file) + 1
|
||||
|
||||
IF GifFrameData(TotalGIFFrames).localColorTableFlag THEN
|
||||
SEEK GifData(Index).file, LOC(GifData(Index).file) + 3 * 2 ^ GifFrameData(TotalGIFFrames).palBPP + 1
|
||||
END IF
|
||||
GET GifData(Index).file, , GifFrameData(TotalGIFFrames).minimumCodeSize
|
||||
IF GifFrameData(TotalGIFFrames).disposalMethod > 2 THEN
|
||||
'Unsupported disposalMethod
|
||||
GOTO LoadError
|
||||
END IF
|
||||
SkipGIFBlocks GifData(Index).file
|
||||
CASE &H3B ' Trailer
|
||||
EXIT DO
|
||||
CASE &H21 ' Extension Introducer
|
||||
GET GifData(Index).file, , byte~%% ' Extension Label
|
||||
SELECT CASE byte~%%
|
||||
CASE &HFF, &HFE ' Application Extension, Comment Extension
|
||||
SkipGIFBlocks GifData(Index).file
|
||||
CASE &HF9
|
||||
IF TotalGIFFrames > UBOUND(GifFrameData) THEN
|
||||
REDIM _PRESERVE GifFrameData(0 TO TotalGIFFrames * 2) AS FRAMEDATA
|
||||
END IF
|
||||
GifFrameData(TotalGIFFrames).ID = ID
|
||||
|
||||
GET GifData(Index).file, , byte~%% ' Block Size (always 4)
|
||||
GET GifData(Index).file, , byte~%%
|
||||
GifFrameData(TotalGIFFrames).transparentFlag = (byte~%% AND 1) > 0
|
||||
GifFrameData(TotalGIFFrames).userInput = (byte~%% AND 2) > 0
|
||||
GifFrameData(TotalGIFFrames).disposalMethod = byte~%% \ 4 AND 7
|
||||
GET GifData(Index).file, , delay~%
|
||||
IF delay~% = 0 THEN GifFrameData(TotalGIFFrames).delay = 0.1 ELSE GifFrameData(TotalGIFFrames).delay = delay~% / 100
|
||||
GET GifData(Index).file, , GifFrameData(TotalGIFFrames).transColor
|
||||
SkipGIFBlocks GifData(Index).file
|
||||
CASE ELSE
|
||||
'Unsupported extension Label
|
||||
GOTO LoadError
|
||||
END SELECT
|
||||
CASE ELSE
|
||||
'Unsupported chunk
|
||||
GOTO LoadError
|
||||
END SELECT
|
||||
LOOP
|
||||
|
||||
REDIM _PRESERVE GifFrameData(0 TO TotalGIFFrames) AS FRAMEDATA
|
||||
|
||||
GifData(Index).IsPlaying = False
|
||||
OpenGif%% = True
|
||||
EXIT FUNCTION
|
||||
|
||||
LoadError:
|
||||
GifData(Index).ID = 0
|
||||
CLOSE GifData(Index).file
|
||||
FOR i = 1 TO TotalGIFFrames
|
||||
IF GifFrameData(i).ID = ID THEN
|
||||
GifFrameData(i).ID = 0
|
||||
END IF
|
||||
NEXT
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION GetGifIndex&(ID AS LONG)
|
||||
DIM i AS LONG
|
||||
|
||||
FOR i = 1 TO TotalGIFLoaded
|
||||
IF GifData(i).ID = ID THEN
|
||||
GetGifIndex& = i
|
||||
EXIT FOR
|
||||
END IF
|
||||
NEXT
|
||||
END FUNCTION
|
||||
|
||||
SUB CloseGif(ID AS LONG)
|
||||
DIM i AS LONG, Index AS LONG
|
||||
|
||||
Index = GetGifIndex(ID)
|
||||
|
||||
IF Index = 0 THEN EXIT SUB
|
||||
|
||||
FOR i = 0 TO UBOUND(GifFrameData)
|
||||
IF GifFrameData(i).ID = ID THEN
|
||||
GifFrameData(i).ID = 0
|
||||
IF GifFrameData(i).addr < -1 THEN
|
||||
_FREEIMAGE GifFrameData(i).addr
|
||||
END IF
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
CLOSE GifData(Index).file
|
||||
GifData(Index).ID = 0
|
||||
GifData(Index).firstFrame = 0
|
||||
END SUB
|
||||
|
||||
SUB SkipGIFBlocks (file AS INTEGER)
|
||||
DIM byte~%%
|
||||
DO
|
||||
GET file, , byte~%% ' Block Size
|
||||
SEEK file, LOC(file) + byte~%% + 1
|
||||
LOOP WHILE byte~%%
|
||||
END SUB
|
||||
|
||||
FUNCTION GetGifFrame& (Index AS LONG)
|
||||
DIM i AS LONG
|
||||
DIM frame AS LONG, previousFrame AS LONG
|
||||
DIM w AS INTEGER, h AS INTEGER
|
||||
DIM img&, actualFrame&
|
||||
DIM prevDest AS LONG
|
||||
|
||||
IF GifData(Index).Frame > GifData(Index).totalFrames THEN
|
||||
GifData(Index).Frame = 1
|
||||
END IF
|
||||
|
||||
FOR i = 1 TO UBOUND(GifFrameData)
|
||||
IF GifFrameData(i).ID = GifData(Index).ID AND GifFrameData(i).thisFrame = GifData(Index).Frame THEN
|
||||
frame = i
|
||||
EXIT FOR
|
||||
ELSEIF GifFrameData(i).ID = GifData(Index).ID AND GifFrameData(i).thisFrame < GifData(Index).Frame THEN
|
||||
previousFrame = i
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
GifData(Index).LastFrameDelay = GifFrameData(frame).delay - (GifFrameData(frame).delay / 10)
|
||||
|
||||
IF GifFrameData(frame).addr > 0 THEN
|
||||
prevDest = _DEST
|
||||
w = GifFrameData(frame).width
|
||||
h = GifFrameData(frame).height
|
||||
img& = _NEWIMAGE(w, h, 256)
|
||||
actualFrame& = _NEWIMAGE(GifData(Index).width, GifData(Index).height, 256)
|
||||
|
||||
_DEST img&
|
||||
DecodeFrame GifData(Index), GifFrameData(frame)
|
||||
|
||||
_DEST actualFrame&
|
||||
IF GifFrameData(frame).localColorTableFlag THEN
|
||||
_COPYPALETTE img&
|
||||
ELSE
|
||||
FOR i = 0 TO GifData(Index).numColors - 1
|
||||
_PALETTECOLOR i, _RGB32(ASC(GifData(Index).palette, i * 3 + 1), ASC(GifData(Index).palette, i * 3 + 2), ASC(GifData(Index).palette, i * 3 + 3))
|
||||
NEXT
|
||||
END IF
|
||||
|
||||
IF GifData(Index).Frame > 1 THEN
|
||||
SELECT CASE GifFrameData(previousFrame).disposalMethod
|
||||
CASE 0, 1
|
||||
_PUTIMAGE , GifFrameData(previousFrame).addr
|
||||
CASE 2
|
||||
CLS , GifData(Index).bgColor
|
||||
_CLEARCOLOR GifData(Index).bgColor
|
||||
END SELECT
|
||||
ELSE
|
||||
CLS , GifData(Index).bgColor
|
||||
END IF
|
||||
|
||||
IF GifFrameData(frame).transparentFlag THEN
|
||||
_CLEARCOLOR GifFrameData(frame).transColor, img&
|
||||
END IF
|
||||
_PUTIMAGE (GifFrameData(frame).left, GifFrameData(frame).top), img&
|
||||
_FREEIMAGE img&
|
||||
|
||||
GifFrameData(frame).addr = actualFrame&
|
||||
GifData(Index).LoadedFrames = GifData(Index).LoadedFrames + 1
|
||||
GifData(Index).GifLoadComplete = (GifData(Index).LoadedFrames = GifData(Index).TotalFrames)
|
||||
_DEST prevDest
|
||||
END IF
|
||||
|
||||
GetGifFrame& = GifFrameData(frame).addr
|
||||
END FUNCTION
|
||||
|
||||
SUB DecodeFrame (gifdata AS GIFDATA, GifFrameData AS FRAMEDATA)
|
||||
DIM byte AS _UNSIGNED _BYTE
|
||||
DIM prefix(4095), suffix(4095), colorStack(4095)
|
||||
DIM startCodeSize AS INTEGER, clearCode AS INTEGER
|
||||
DIM endCode AS INTEGER, minCode AS INTEGER, startMaxCode AS INTEGER
|
||||
DIM nvc AS INTEGER, codeSize AS INTEGER
|
||||
DIM maxCode AS INTEGER, bitPointer AS INTEGER, blockSize AS INTEGER
|
||||
DIM blockPointer AS INTEGER, x AS INTEGER, y AS INTEGER
|
||||
DIM palette$, i AS LONG, c&, stackPointer AS INTEGER
|
||||
DIM currentCode AS INTEGER, code AS INTEGER, lastColor AS INTEGER
|
||||
DIM oldCode AS INTEGER, WorkCode&, LastChar AS INTEGER
|
||||
DIM interlacedPass AS INTEGER, interlacedStep AS INTEGER
|
||||
DIM file AS INTEGER, a$, loopStart!
|
||||
|
||||
startCodeSize = gifdata.bpp + 1
|
||||
clearCode = 2 ^ gifdata.bpp
|
||||
endCode = clearCode + 1
|
||||
minCode = endCode + 1
|
||||
startMaxCode = clearCode * 2 - 1
|
||||
nvc = minCode
|
||||
codeSize = startCodeSize
|
||||
maxCode = startMaxCode
|
||||
|
||||
IF GifFrameData.interlacedFlag THEN interlacedPass = 0: interlacedStep = 8
|
||||
bitPointer = 0
|
||||
blockSize = 0
|
||||
blockPointer = 0
|
||||
x = 0
|
||||
y = 0
|
||||
|
||||
file = gifdata.file
|
||||
SEEK file, GifFrameData.addr
|
||||
|
||||
IF GifFrameData.localColorTableFlag THEN
|
||||
palette$ = SPACE$(3 * 2 ^ GifFrameData.palBPP)
|
||||
GET file, , palette$
|
||||
|
||||
FOR i = 0 TO gifdata.numColors - 1
|
||||
c& = _RGB32(ASC(palette$, i * 3 + 1), ASC(palette$, i * 3 + 2), ASC(palette$, i * 3 + 3))
|
||||
_PALETTECOLOR i, c&
|
||||
NEXT
|
||||
END IF
|
||||
|
||||
GET file, , byte ' minimumCodeSize
|
||||
|
||||
loopStart! = TIMER
|
||||
DO
|
||||
IF TIMER - loopStart! > 2 THEN EXIT DO
|
||||
GOSUB GetCode
|
||||
stackPointer = 0
|
||||
IF code = clearCode THEN 'Reset & Draw next color direct
|
||||
nvc = minCode ' \
|
||||
codeSize = startCodeSize ' Preset default codes
|
||||
maxCode = startMaxCode ' /
|
||||
|
||||
GOSUB GetCode
|
||||
currentCode = code
|
||||
|
||||
lastColor = code
|
||||
colorStack(stackPointer) = lastColor
|
||||
stackPointer = 1
|
||||
ELSEIF code <> endCode THEN 'Draw direct color or colors from suffix
|
||||
currentCode = code
|
||||
IF currentCode = nvc THEN 'Take last color too
|
||||
currentCode = oldCode
|
||||
colorStack(stackPointer) = lastColor
|
||||
stackPointer = stackPointer + 1
|
||||
END IF
|
||||
|
||||
WHILE currentCode >= minCode 'Extract colors from suffix
|
||||
colorStack(stackPointer) = suffix(currentCode)
|
||||
stackPointer = stackPointer + 1
|
||||
currentCode = prefix(currentCode) 'Next color from suffix is described in
|
||||
WEND ' the prefix, else prefix is the last col.
|
||||
|
||||
lastColor = currentCode ' Last color is equal to the
|
||||
colorStack(stackPointer) = lastColor ' last known code (direct, or from
|
||||
stackPointer = stackPointer + 1 ' Prefix)
|
||||
suffix(nvc) = lastColor 'Automatically, update suffix
|
||||
prefix(nvc) = oldCode 'Code from the session before (for extracting from suffix)
|
||||
nvc = nvc + 1
|
||||
|
||||
IF nvc > maxCode AND codeSize < 12 THEN
|
||||
codeSize = codeSize + 1
|
||||
maxCode = maxCode * 2 + 1
|
||||
END IF
|
||||
END IF
|
||||
|
||||
FOR i = stackPointer - 1 TO 0 STEP -1
|
||||
PSET (x, y), colorStack(i)
|
||||
x = x + 1
|
||||
IF x = GifFrameData.width THEN
|
||||
x = 0
|
||||
IF GifFrameData.interlacedFlag THEN
|
||||
y = y + interlacedStep
|
||||
IF y >= GifFrameData.height THEN
|
||||
SELECT CASE interlacedPass
|
||||
CASE 0: interlacedPass = 1: y = 4
|
||||
CASE 1: interlacedPass = 2: y = 2
|
||||
CASE 2: interlacedPass = 3: y = 1
|
||||
END SELECT
|
||||
interlacedStep = 2 * y
|
||||
END IF
|
||||
ELSE
|
||||
y = y + 1
|
||||
END IF
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
oldCode = code
|
||||
LOOP UNTIL code = endCode
|
||||
GET file, , byte
|
||||
EXIT SUB
|
||||
|
||||
GetCode:
|
||||
IF bitPointer = 0 THEN GOSUB ReadByteFromBlock: bitPointer = 8
|
||||
WorkCode& = LastChar \ (2 ^ (8 - bitPointer))
|
||||
WHILE codeSize > bitPointer
|
||||
GOSUB ReadByteFromBlock
|
||||
|
||||
WorkCode& = WorkCode& OR LastChar * (2 ^ bitPointer)
|
||||
bitPointer = bitPointer + 8
|
||||
WEND
|
||||
bitPointer = bitPointer - codeSize
|
||||
code = WorkCode& AND maxCode
|
||||
RETURN
|
||||
|
||||
ReadByteFromBlock:
|
||||
IF blockPointer = blockSize THEN
|
||||
GET file, , byte: blockSize = byte
|
||||
a$ = SPACE$(blockSize): GET file, , a$
|
||||
blockPointer = 0
|
||||
END IF
|
||||
blockPointer = blockPointer + 1
|
||||
LastChar = ASC(MID$(a$, blockPointer, 1))
|
||||
RETURN
|
||||
END SUB
|
||||
|
||||
FUNCTION gifOverlayImage$
|
||||
DIM A$
|
||||
A$ = MKI$(64) + MKI$(64)
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000J000005000`M0000M20004<000`e0000V30008?000Pl0000"
|
||||
A$ = A$ + "V3000L=000@`0000M2000L70000D0000J000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000003000PQ0000<30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?0000c0000620000300000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "00030000^1000X<000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000:3000h60000300000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000l0000@N0000Q30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000Q3000T7000`30000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000010000\5000`g0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "O3000\5000@0000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "0000000000000000000000000000000000000000R0000X;000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000j2000420"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "0000000000000000A1000D>000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000@i0000A100000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "0000000000000000000000000000000000000000000000@00000520008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000@Q0000100000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "0000000000000000000000P10000M20008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b3000d9000P1000000000000000000000000000000000000"
|
||||
A$ = A$ + "0000000000000000000000000000000000000000000000000000000000P1"
|
||||
A$ = A$ + "0000^20008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000^2000H00000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "0000000000000000000000000000000000@00000L20008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0000W00001000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "0000000000000000120008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b300088000000000000000000000"
|
||||
A$ = A$ + "0000000000000000000000000000000000000000000000000000@10008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000A10000000000000000000000000000000000"
|
||||
A$ = A$ + "0000000000000000000000000000P0000@>000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b3000@>00008000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000010000T;000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000i2000400"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000\5000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?0000G00000000000000000000"
|
||||
A$ = A$ + "000000000000000000000l0000Pg0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000N3000l0000000000000000000000000000000000"
|
||||
A$ = A$ + "00@N0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000@N000000000000000000000000000000`20000Q30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000Q3000`000000"
|
||||
A$ = A$ + "00000000000000000000^10008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000PK000000000000000000001000"
|
||||
A$ = A$ + "0l<000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000@30004000000000000000L3000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "000m0000f3000P?000Pn0000j3000X?000Pn0000h3000@?000`l0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000@m0000h3000X?0000n0000f30008?000`l0000"
|
||||
A$ = A$ + "g3000T?000Pn0000j3000X?000Pn0000j3000X?000Pn0000j3000X?000Pn"
|
||||
A$ = A$ + "0000j3000P?000`l0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00`=000000000000000R0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b3000D?0000n0000j3000X?000Pn0000"
|
||||
A$ = A$ + "j3000X?000Pn0000j3000X?000Pn0000i3000H?000Pl0000b30008?000@m"
|
||||
A$ = A$ + "0000j3000X?000Pn0000j3000X?000Pm0000g3000X?000Pn0000j3000X?0"
|
||||
A$ = A$ + "00Pn0000j3000X?000Pn0000j3000X?000Pn0000j3000X?000Pn0000i300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl00009200000000000000"
|
||||
A$ = A$ + "<30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b3000H?000Pn0000jOb9WX?WLb9oNk]gnooooooooooooooooooooooZ"
|
||||
A$ = A$ + "[^JoniWOl3000X?000Pn0000h30008?000Pl0000g3000X?^hRKoooooo;]d"
|
||||
A$ = A$ + "Bk?000Pn0000h3000T?000PnZ[^jnooooooooooooooooooooooooooooooo"
|
||||
A$ = A$ + "oooooooooooooooooooooooooooo\a6Kk3000X?000@m0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b3000d<000000000K00008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b3000H?000Pn0000j_jZ"
|
||||
A$ = A$ + "[foooooooooooooooooooooooooooooooooooooooooooooooo_dB;]oWLb9"
|
||||
A$ = A$ + "j3000X?000Pm0000b3000L?000PnhR;^mooooo_dB;]o0000j3000P?000@n"
|
||||
A$ = A$ + "0000j[^jZkoooooooooooooooooooooooooooooooooooooooooooooooooo"
|
||||
A$ = A$ + "oooooooooc6K\]?000Pn0000e30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000L000005000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b3000@?000Pn0000j;]dBkoooooooooooGLa5g_Oni7o"
|
||||
A$ = A$ + "0000j3000X?000PnIUEFk_jZ[foooooooooook]gNk?000Pn0000j3000@?0"
|
||||
A$ = A$ + "00`m0000jS;^hfooooooB;]dn3000X?0000n0000i3000X_jZ[^oooooogHS"
|
||||
A$ = A$ + "=b?000Pn0000j3000X?000Pn0000j3000X?000Pn0000j3000X?000Pn0000"
|
||||
A$ = A$ + "i30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300085000@O"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "000n0000jc9WLboooooooooooc6K\]?000Pn0000j3000X?000Pn0000j300"
|
||||
A$ = A$ + "0X?000PnIUEFkoooooooooooLb9Wl3000X?000Pm0000g3000X?^hRKooooo"
|
||||
A$ = A$ + "o;]dBk?000Pn0000h3000T?000PnZ[^jnoooooOS=f8o0000j3000X?000Pn"
|
||||
A$ = A$ + "0000j3000X?000Pn0000j3000X?000Pn0000h3000<?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000@O0000T20008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?0000m0000jOb9WXoooooooooo"
|
||||
A$ = A$ + "ogHS=b?000Pn0000i3000H?000`l0000b30008?000@m0000h3000X?WLb9o"
|
||||
A$ = A$ + "oooook]gNk?000Pn0000h3000L?000PnhR;^mooooo_dB;]o0000j3000P?0"
|
||||
A$ = A$ + "00@n0000j[^jZkoooooo=fHSl3000X?000@m0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000T20008<000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000f3000X?WLb9oooooo[^jZk?000Pn0000j3000<?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b3000@?000PnWLb9jGLa5g?WLb9oWLb9j300"
|
||||
A$ = A$ + "0X?000`m0000jS;^hfooooooB;]dn3000X?0000n0000i3000X_jZ[^ooooo"
|
||||
A$ = A$ + "ogHS=b?000Pn0000e30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008<0"
|
||||
A$ = A$ + "00@f0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "0P?000PnNk]gnooooo?WLb9o0000j3000L?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000h3000X?000Pn0000j3000X?0000n0000g3000X?^hRKo"
|
||||
A$ = A$ + "ooooo;]dBk?000Pn0000h3000T?000PnZ[^jnoooooOS=f8o0000j3000X?0"
|
||||
A$ = A$ + "00Pn0000j3000X?000Pn0000j3000P?000Pm0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000@e0000V30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000@n0000jC?mdooooooo"
|
||||
A$ = A$ + "\a6Kk3000X?000@m0000b30008?000`l0000h3000X?000Pn0000j3000X?0"
|
||||
A$ = A$ + "00Pn0000j3000X?0000n0000c3000L?000PnhR;^mooooo_dB;]o0000j300"
|
||||
A$ = A$ + "0P?000@n0000j[^jZkoooooo=fHSl3000X?000Pn0000j3000X?000Pn0000"
|
||||
A$ = A$ + "j3000X?000Pn0000j3000H?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000P30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000j3000Xooooooooooo?d@3]?000Pn0000c300"
|
||||
A$ = A$ + "08?000Pl0000i3000X?000Pn0000j3000X?000Pn0000j3000X?000Pn0000"
|
||||
A$ = A$ + "j3000X?000`m0000jS;^hfooooooB;]dn3000X?0000n0000i3000X_jZ[^o"
|
||||
A$ = A$ + "ooooooooooooooooooooooooooooooooooooooooooooooooB;]dn3000X?0"
|
||||
A$ = A$ + "000n0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "0`>000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b3000X?000Pnooooooooooo@3=dn0000j3000<?000Pl0000e3000X?K\afn"
|
||||
A$ = A$ + "ooooooooooooooooooooooooooooooooooooogHS=b?000Pn0000g3000X?^"
|
||||
A$ = A$ + "hRKoooooo;]dBk?000Pn0000h3000T?000PnZ[^jnooooooooooooooooooo"
|
||||
A$ = A$ + "ooooooooooooooooooooooooooooo;]dBk?000Pn0000h30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?0000k0000V30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pn0000jooooooo"
|
||||
A$ = A$ + "oooo\a6Kk3000X?000@m0000b3000D?000Pn\a6Kkooooooooooooooooooo"
|
||||
A$ = A$ + "ooooooooooooooooooOS=f8o0000j3000L?000PnhR;^mooooo_dB;]o0000"
|
||||
A$ = A$ + "j3000P?000@n0000j[^jZkoooooo=fHSl3000X?000Pn0000j3000X?000Pn"
|
||||
A$ = A$ + "0000j3000X?000Pn0000j3000H?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000P3000T=000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000h3000X_gNk]ooooooc9WLb?000Pn0000"
|
||||
A$ = A$ + "f30008?000Pl0000i3000X?000Pn0000j3000X?000Pn0000j[^jZkoooooo"
|
||||
A$ = A$ + "=fHSl3000X?000`m0000jS;^hfooooooB;]dn3000X?0000n0000i3000X_j"
|
||||
A$ = A$ + "Z[^oooooogHS=b?000Pn0000j3000X?000Pn0000j3000X?000Pn0000h300"
|
||||
A$ = A$ + "0H?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b3000D=000P`0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b3000H?000PnLb9Wlooooo_gNk]o0000j3000T?000`l0000b3000<?0"
|
||||
A$ = A$ + "000n0000j3000X?000Pn0000j3000X_jZ[^oooooogHS=b?000Pn0000g300"
|
||||
A$ = A$ + "0X?^hRKoooooo;]dBk?000Pn0000h3000T?000PnZ[^jnoooooOS=f8o0000"
|
||||
A$ = A$ + "j3000D?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000P`0000T20008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0000m0000j?d@"
|
||||
A$ = A$ + "3]oooooooooookWOna?000Pn0000i3000H?0000m0000b30008?0000m0000"
|
||||
A$ = A$ + "g3000T?000PnZ[^jnoooooOS=f8o0000j3000L?000PnhR;^mooooo_dB;]o"
|
||||
A$ = A$ + "0000j3000P?000@n0000j[^jZkoooooo=fHSl3000X?000@m0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000T2000d7000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b3000P?000PnLb9Wlooooooooooo"
|
||||
A$ = A$ + "niWOl3000X?000Pn0000j3000X?000Pn0000j3000X?000PnniWOlC?mdooo"
|
||||
A$ = A$ + "oooo=fHSl3000X?000`m0000jS;^hfooooooB;]dn3000X?0000n0000i300"
|
||||
A$ = A$ + "0X_jZ[^oooooogHS=b?000Pn0000e30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b3000d7000PD0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?0000m0000j3000X?^hRKooooooooooo_dB;]oLb9Wl300"
|
||||
A$ = A$ + "0X?000Pn0000jOb9WX?WLb9oZ[^jnoooooooooooZ[^jnWEFI]?000Pn0000"
|
||||
A$ = A$ + "g3000X?^hRKoooooo;]dBk?000Pn0000h3000T?000PnZ[^jnoooooOS=f8o"
|
||||
A$ = A$ + "0000j3000D?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000PD0000L000"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b3000D?000Pn0000jc9WLboooooooooooooooooooooooooooooooooooooo"
|
||||
A$ = A$ + "oooooooooooooooo[^jZm3000X?000Pn0000h3000L?000PnhR;^mooooo_d"
|
||||
A$ = A$ + "B;]o0000j3000P?000@n0000j[^jZkoooooo=fHSl3000X?000@m0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000L000000000@c0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000e3000X?0"
|
||||
A$ = A$ + "00Pn0000jc9WLbOa5GLooooooooooooooooooooooGLa5g?WLb9o0000j300"
|
||||
A$ = A$ + "0X?000Pn0000g3000<?000`m0000jS;^hfooooooB;]dn3000X?0000n0000"
|
||||
A$ = A$ + "i3000X_jZ[^oooooogHS=b?000Pn0000e30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000>300000000000000920008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?0000m0000h3000X?000Pn0000"
|
||||
A$ = A$ + "j3000X?000Pn0000j3000X?000Pn0000j3000X?0000n0000e30008?000Pl"
|
||||
A$ = A$ + "0000e3000X?000Pn0000j3000X?000Pn0000f3000L?000Pn0000j3000X?0"
|
||||
A$ = A$ + "00Pn0000j3000<?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b3000T8000000000"
|
||||
A$ = A$ + "00000P3000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?0000m0000f3000P?000Pn0000j3000X?0"
|
||||
A$ = A$ + "00Pn0000h3000H?0000m0000b30008?000Pl0000b30008?000@m0000h300"
|
||||
A$ = A$ + "0X?0000n0000f30008?000`l0000g3000T?000Pn0000h3000<?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?0000>00000000000000@00000@30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?0000d0000100000000000000000000h6000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000^10000000000"
|
||||
A$ = A$ + "00000000000000030000R30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000R3000`000000000000000000000000000000"
|
||||
A$ = A$ + "0T7000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b3000T700000000000000000000000000000000000`30000N30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b3000h=000@4000000000000"
|
||||
A$ = A$ + "00000000000000000000000000000`5000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?0000G000000000000000000000000000000000000"
|
||||
A$ = A$ + "0000000000@00000j20008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000P^"
|
||||
A$ = A$ + "000010000000000000000000000000000000000000000000000000000420"
|
||||
A$ = A$ + "000i0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?0000i0000Q0000000000000000000"
|
||||
A$ = A$ + "00000000000000000000000000000000000000000000A10008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000A1000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000`P0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl000042000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "00000000000010000`9000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000L2000400000000000000000000000000"
|
||||
A$ = A$ + "0000000000000000000000000000000000000000000000000000000000P1"
|
||||
A$ = A$ + "0000^20008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000^2000H00000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000H0000@W0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000M2000H00000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "0000000000000000000000000000000010000D8000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl000052000400000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000A1000D>000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000@i0000A1000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "0000000000P80000j20008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000P^0000Q0000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000400"
|
||||
A$ = A$ + "000G0000O30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b3000l=0000G"
|
||||
A$ = A$ + "000010000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "0000000000000000000000000000000000000000000000000l0000@N0000"
|
||||
A$ = A$ + "Q30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000Q3000X7000`3000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "00000000000000000000000000000000000000000`0000PK0000;30008?0"
|
||||
A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300"
|
||||
A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000`b0000"
|
||||
A$ = A$ + "^1000`000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000<0000920000=000Pl0000"
|
||||
A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl"
|
||||
A$ = A$ + "0000b30008?000Pl0000@3000T80000<0000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000J000005000@N0000N20008<0"
|
||||
A$ = A$ + "000f0000Y30008?000@k0000R30008=000P`0000N2000T70000D0000J000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "000000000000000000000000000000000000000000000000000000000000"
|
||||
A$ = A$ + "0000%%00"
|
||||
gifOverlayImage$ = A$
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION LoadOverlayImage&
|
||||
DIM MemoryBlock AS _MEM, TempImage AS LONG
|
||||
DIM NewWidth AS INTEGER, NewHeight AS INTEGER, A$, BASFILE$
|
||||
|
||||
A$ = gifOverlayImage$
|
||||
IF LEN(A$) = 0 THEN EXIT FUNCTION
|
||||
|
||||
NewWidth = CVI(LEFT$(A$, 2))
|
||||
NewHeight = CVI(MID$(A$, 3, 2))
|
||||
A$ = MID$(A$, 5)
|
||||
|
||||
BASFILE$ = gifUnpack$(A$)
|
||||
|
||||
TempImage = _NEWIMAGE(NewWidth, NewHeight, 32)
|
||||
MemoryBlock = _MEMIMAGE(TempImage)
|
||||
|
||||
__UI_MemCopy MemoryBlock.OFFSET, _OFFSET(BASFILE$), LEN(BASFILE$)
|
||||
_MEMFREE MemoryBlock
|
||||
|
||||
LoadOverlayImage& = TempImage
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION gifUnpack$ (PackedData$)
|
||||
'Adapted from Dav's BIN2BAS
|
||||
'http://www.qbasicnews.com/dav/qb64.php
|
||||
DIM A$, i&, B$, C%, F$, C$, t%, B&, X$, btemp$
|
||||
|
||||
A$ = PackedData$
|
||||
|
||||
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
|
||||
|
||||
gifUnpack$ = btemp$
|
||||
END FUNCTION
|
||||
'############################################################################################
|
|
@ -1,97 +0,0 @@
|
|||
': This program uses
|
||||
': InForm - GUI library for QB64 - Beta version 9
|
||||
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
|
||||
': Controls' IDs: ------------------------------------------------------------------
|
||||
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'
|
||||
'$INCLUDE:'..\InForm.bi'
|
||||
'$INCLUDE:'..\xp.uitheme'
|
||||
'$INCLUDE:'gifplaySample.frm'
|
||||
'$INCLUDE:'gifplay.bm'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_OnLoad
|
||||
Control(PlayBT).Disabled = True
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUpdateDisplay
|
||||
UpdateGif PictureBox1
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUnload
|
||||
END SUB
|
||||
|
||||
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
|
||||
Control(PlayBT).Disabled = False
|
||||
IF TotalFrames(PictureBox1) > 1 THEN
|
||||
Caption(PlayBT) = "Play"
|
||||
ELSE
|
||||
Caption(PlayBT) = "Static gif"
|
||||
Control(PlayBT).Disabled = True
|
||||
END IF
|
||||
Caption(LoadBT) = "globe.gif loaded"
|
||||
Control(LoadBT).Disabled = True
|
||||
ELSE
|
||||
Answer = MessageBox("File 'globe.gif' could not be found.", "", MsgBox_Exclamation + MsgBox_OkOnly)
|
||||
END IF
|
||||
CASE PlayBT
|
||||
IF GifIsPlaying(PictureBox1) THEN
|
||||
PauseGif PictureBox1
|
||||
Caption(PlayBT) = "Play"
|
||||
ELSE
|
||||
PlayGif PictureBox1
|
||||
Caption(PlayBT) = "Pause"
|
||||
END IF
|
||||
CASE PictureBox1
|
||||
HideGifOverlay PictureBox1
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseEnter (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseLeave (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusIn (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusOut (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseDown (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseUp (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_KeyPress (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_TextChanged (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_ValueChanged (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'..\InForm.ui'
|
|
@ -1,38 +0,0 @@
|
|||
': This form was generated by
|
||||
': InForm - GUI library for QB64 - Beta version 9
|
||||
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
SUB __UI_LoadForm
|
||||
|
||||
DIM __UI_NewID AS LONG
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Form, "gifplaySample", 300, 281, 0, 0, 0)
|
||||
SetCaption __UI_NewID, "gifplay Sample"
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).Font = SetFont("arial.ttf", 12)
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "PictureBox1", 230, 230, 36, 12, 0)
|
||||
Control(__UI_NewID).Stretch = True
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "LoadBT", 123, 23, 36, 247, 0)
|
||||
SetCaption __UI_NewID, "Load globe.gif"
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "PlayBT", 80, 23, 186, 247, 0)
|
||||
SetCaption __UI_NewID, "Play"
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_AssignIDs
|
||||
gifplaySample = __UI_GetID("gifplaySample")
|
||||
PictureBox1 = __UI_GetID("PictureBox1")
|
||||
LoadBT = __UI_GetID("LoadBT")
|
||||
PlayBT = __UI_GetID("PlayBT")
|
||||
END SUB
|
Before Width: | Height: | Size: 1.4 MiB |
|
@ -1,21 +0,0 @@
|
|||
'INI Manager
|
||||
'Fellippe Heitor, 2017-2019 - fellippe@qb64.org - @fellippeheitor
|
||||
|
||||
'This file isn't required to be at the top of your programs,
|
||||
'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
|
||||
|
758
InForm/ini.bm
|
@ -1,758 +0,0 @@
|
|||
'INI Manager - Beta 4
|
||||
'Fellippe Heitor, 2017 - fellippe@qb64.org - @fellippeheitor
|
||||
|
||||
SUB IniSortSection (file$, __section$)
|
||||
SHARED IniCODE, IniLastKey$, IniWholeFile$
|
||||
SHARED IniDisableAutoCommit
|
||||
|
||||
REDIM Keys(1 TO 100) AS STRING
|
||||
DIM TotalKeys, tempValue$, i AS LONG, Backup$, CommitBackup
|
||||
|
||||
IF IniFormatSection$(__section$) = "[]" THEN IniCODE = 15: EXIT SUB
|
||||
|
||||
DO
|
||||
tempValue$ = ReadSetting(file$, __section$, "")
|
||||
IF LEFT$(IniINFO$, 7) = "ERROR: " THEN EXIT SUB
|
||||
IF IniCODE = 10 THEN EXIT DO
|
||||
|
||||
TotalKeys = TotalKeys + 1
|
||||
IF TotalKeys > UBOUND(Keys) THEN
|
||||
REDIM _PRESERVE Keys(1 TO UBOUND(Keys) + 100) AS STRING
|
||||
END IF
|
||||
|
||||
Keys(TotalKeys) = IniLastKey$ + "=" + tempValue$
|
||||
LOOP
|
||||
|
||||
REDIM _PRESERVE Keys(1 TO TotalKeys) AS STRING
|
||||
IF IniArraySort(Keys()) = 0 THEN IniCODE = 23: EXIT SUB
|
||||
|
||||
CommitBackup = IniDisableAutoCommit
|
||||
IniDisableAutoCommit = -1 'Prevent every minor change from being written to disk
|
||||
Backup$ = IniWholeFile$
|
||||
|
||||
FOR i = 1 TO TotalKeys
|
||||
IniDeleteKey file$, __section$, LEFT$(Keys(i), INSTR(Keys(i), "=") - 1)
|
||||
IF LEFT$(IniINFO$, 7) = "ERROR: " THEN
|
||||
IniDisableAutoCommit = CommitBackup
|
||||
IniWholeFile$ = Backup$
|
||||
EXIT SUB
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
FOR i = 1 TO TotalKeys
|
||||
WriteSetting file$, __section$, LEFT$(Keys(i), INSTR(Keys(i), "=") - 1), MID$(Keys(i), INSTR(Keys(i), "=") + 1)
|
||||
IF LEFT$(IniINFO$, 7) = "ERROR: " THEN
|
||||
IniDisableAutoCommit = CommitBackup
|
||||
IniWholeFile$ = Backup$
|
||||
EXIT SUB
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
IniDisableAutoCommit = CommitBackup 'Restore writing to disk (or previously set state) and
|
||||
IniCommit ' commit changes.
|
||||
|
||||
IniCODE = 22
|
||||
END SUB
|
||||
|
||||
SUB IniDeleteSection (file$, __section$)
|
||||
SHARED IniNewFile$, IniCODE, currentIniFileName$
|
||||
SHARED IniLF$, IniWholeFile$, currentIniFileLOF AS _UNSIGNED LONG
|
||||
|
||||
IniLoad file$
|
||||
IF IniCODE THEN EXIT SUB
|
||||
|
||||
DIM a$
|
||||
IniCODE = 0
|
||||
a$ = IniGetSection(__section$)
|
||||
IF IniCODE THEN EXIT SUB
|
||||
|
||||
IniNewFile$ = LEFT$(IniWholeFile$, INSTR(IniWholeFile$, a$) - 1)
|
||||
IniNewFile$ = IniNewFile$ + MID$(IniWholeFile$, INSTR(IniWholeFile$, a$) + LEN(a$ + IniLF$))
|
||||
|
||||
IniCommit
|
||||
IniCODE = 13
|
||||
END SUB
|
||||
|
||||
SUB IniDeleteKey (file$, __section$, __key$)
|
||||
SHARED IniPosition AS _UNSIGNED LONG, IniCODE
|
||||
SHARED IniLF$, IniWholeFile$, IniSectionData$
|
||||
SHARED IniLastSection$, IniLastKey$, IniNewFile$
|
||||
|
||||
DIM tempValue$, fileNum AS INTEGER
|
||||
DIM section$, key$, thisLine$
|
||||
DIM FoundLF AS _UNSIGNED LONG
|
||||
|
||||
IniCODE = 0
|
||||
|
||||
'prepare variables for the write operation
|
||||
section$ = IniFormatSection$(__section$)
|
||||
IF IniCODE THEN EXIT SUB
|
||||
|
||||
key$ = LTRIM$(RTRIM$(__key$))
|
||||
IF key$ = "" THEN IniCODE = 12: EXIT SUB
|
||||
IniLastKey$ = key$
|
||||
|
||||
'Read the existing key to fill IniPosition
|
||||
tempValue$ = ReadSetting$(file$, section$, key$)
|
||||
IF IniCODE > 0 AND IniCODE <> 2 THEN EXIT SUB 'key not found
|
||||
|
||||
'map IniPosition (set in the section block) to the global file position
|
||||
IniPosition = INSTR(IniWholeFile$, IniSectionData$) + IniPosition - 1
|
||||
|
||||
FoundLF = INSTR(IniPosition, IniWholeFile$, IniLF$)
|
||||
IF FoundLF = 0 THEN FoundLF = LEN(IniWholeFile$)
|
||||
|
||||
IniNewFile$ = LEFT$(IniWholeFile$, IniPosition - 1) + MID$(IniWholeFile$, FoundLF + LEN(IniLF$))
|
||||
|
||||
IniCommit
|
||||
IniCODE = 19
|
||||
END SUB
|
||||
|
||||
SUB IniMoveKey (file$, __section$, __key$, __newsection$)
|
||||
'A move operation is a copy operation + a delete operation
|
||||
|
||||
SHARED IniCODE
|
||||
|
||||
DIM tempValue$
|
||||
|
||||
tempValue$ = ReadSetting(file$, __section$, __key$)
|
||||
IF IniCODE > 0 AND IniCODE <> 2 THEN EXIT SUB
|
||||
|
||||
WriteSetting file$, __newsection$, __key$, tempValue$
|
||||
IF IniCODE > 0 AND IniCODE <> 2 AND IniCODE <> 7 AND IniCODE <> 9 THEN EXIT SUB
|
||||
|
||||
IniDeleteKey file$, __section$, __key$
|
||||
IF IniCODE = 19 THEN IniCODE = 20
|
||||
END SUB
|
||||
|
||||
SUB IniCommit
|
||||
SHARED currentIniFileName$, IniWholeFile$, currentIniFileLOF AS _UNSIGNED LONG
|
||||
SHARED IniNewFile$, IniDisableAutoCommit, IniCODE
|
||||
|
||||
IF currentIniFileName$ = "" THEN IniCODE = 18: EXIT SUB
|
||||
|
||||
IniWholeFile$ = IniNewFile$
|
||||
currentIniFileLOF = LEN(IniNewFile$)
|
||||
|
||||
IF NOT IniDisableAutoCommit THEN
|
||||
DIM fileNum AS INTEGER
|
||||
fileNum = FREEFILE
|
||||
|
||||
OPEN currentIniFileName$ FOR BINARY AS #fileNum
|
||||
|
||||
IF LEN(IniWholeFile$) < LOF(fileNum) THEN
|
||||
CLOSE fileNum
|
||||
OPEN currentIniFileName$ FOR OUTPUT AS #fileNum: CLOSE #fileNum
|
||||
OPEN currentIniFileName$ FOR BINARY AS #fileNum
|
||||
END IF
|
||||
|
||||
PUT #fileNum, 1, IniNewFile$
|
||||
CLOSE #fileNum
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
FUNCTION IniGetSection$ (__section$)
|
||||
SHARED IniPosition AS _UNSIGNED LONG, IniCODE, currentIniFileName$
|
||||
SHARED IniLF$, IniWholeFile$, currentIniFileLOF AS _UNSIGNED LONG
|
||||
|
||||
IF currentIniFileName$ = "" THEN IniCODE = 18: EXIT FUNCTION
|
||||
IF currentIniFileLOF = 0 OR LEN(LTRIM$(RTRIM$(IniWholeFile$))) = 0 THEN IniCODE = 17: EXIT FUNCTION
|
||||
|
||||
IniCODE = 0
|
||||
|
||||
DIM section$, foundSection AS _UNSIGNED LONG, endSection AS _UNSIGNED LONG
|
||||
DIM i AS _UNSIGNED LONG, Bracket1 AS _UNSIGNED LONG, sectionStart AS _UNSIGNED LONG
|
||||
DIM inQuote AS _BYTE
|
||||
|
||||
section$ = IniFormatSection$(__section$)
|
||||
IF IniCODE THEN EXIT FUNCTION
|
||||
|
||||
IF section$ = "[]" THEN
|
||||
'fetch the "global" section, if present
|
||||
sectionStart = INSTR(IniWholeFile$, "[")
|
||||
IF sectionStart = 0 THEN IniGetSection$ = IniWholeFile$: EXIT FUNCTION
|
||||
|
||||
FOR i = sectionStart - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN foundSection = i + 1: EXIT FOR
|
||||
IF ASC(IniWholeFile$, i) <> 32 THEN EXIT FOR
|
||||
NEXT
|
||||
|
||||
IF i = 0 THEN foundSection = 1
|
||||
|
||||
IniGetSection$ = LEFT$(IniWholeFile$, foundSection - 1)
|
||||
ELSE
|
||||
DO
|
||||
sectionStart = INSTR(sectionStart + 1, LCASE$(IniWholeFile$), LCASE$(section$))
|
||||
IF sectionStart = 0 THEN IniCODE = 14: EXIT DO
|
||||
|
||||
'make sure it's a valid section header
|
||||
foundSection = 0
|
||||
FOR i = sectionStart - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN foundSection = i + 1: EXIT FOR
|
||||
IF ASC(IniWholeFile$, i) <> 32 THEN EXIT FOR
|
||||
NEXT
|
||||
|
||||
IF i = 0 THEN foundSection = 1
|
||||
|
||||
IF foundSection > 0 THEN
|
||||
'we found it; time to identify where this section ends
|
||||
'(either another [section] or the end of the file
|
||||
Bracket1 = sectionStart
|
||||
checkAgain:
|
||||
Bracket1 = INSTR(Bracket1 + 1, IniWholeFile$, "[")
|
||||
|
||||
IF Bracket1 > 0 THEN
|
||||
'found a bracket; check if it's inside quotes
|
||||
inQuote = 0
|
||||
FOR i = 1 TO Bracket1 - 1
|
||||
IF ASC(IniWholeFile$, i) = 34 THEN inQuote = NOT inQuote
|
||||
NEXT
|
||||
IF inQuote THEN GOTO checkAgain
|
||||
|
||||
FOR i = Bracket1 - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN endSection = i + 1 - LEN(IniLF$): EXIT FOR
|
||||
IF ASC(IniWholeFile$, i) = 61 THEN GOTO checkAgain 'bracket is inside a key's value
|
||||
IF i <= foundSection THEN EXIT FOR
|
||||
NEXT
|
||||
IniGetSection$ = MID$(IniWholeFile$, foundSection, endSection - foundSection)
|
||||
ELSE
|
||||
IniGetSection$ = MID$(IniWholeFile$, foundSection)
|
||||
END IF
|
||||
EXIT FUNCTION
|
||||
END IF
|
||||
LOOP
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION IniFormatSection$ (__section$)
|
||||
SHARED IniCODE
|
||||
|
||||
DIM section$
|
||||
|
||||
section$ = LTRIM$(RTRIM$(__section$))
|
||||
|
||||
'sections are in the format [section name] - add brackets if not passed
|
||||
IF LEFT$(section$, 1) <> "[" THEN section$ = "[" + section$
|
||||
IF RIGHT$(section$, 1) <> "]" THEN section$ = section$ + "]"
|
||||
|
||||
IF INSTR(MID$(section$, 2, LEN(section$) - 3), "[") OR INSTR(MID$(section$, 2, LEN(section$) - 3), "]") THEN
|
||||
IniCODE = 15
|
||||
EXIT FUNCTION
|
||||
END IF
|
||||
|
||||
IniFormatSection$ = section$
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION ReadSetting$ (file$, __section$, __key$)
|
||||
SHARED IniLastSection$, IniLastKey$, IniWholeFile$, IniLF$
|
||||
SHARED IniPosition AS _UNSIGNED LONG, IniSectionData$
|
||||
SHARED IniCODE, IniAllowBasicComments
|
||||
SHARED currentIniFileLOF AS _UNSIGNED LONG
|
||||
|
||||
IniLoad file$
|
||||
IF IniCODE THEN EXIT SUB
|
||||
|
||||
IF currentIniFileLOF = 0 OR LEN(LTRIM$(RTRIM$(IniWholeFile$))) = 0 THEN IniCODE = 17: EXIT FUNCTION
|
||||
|
||||
DIM Equal AS _UNSIGNED LONG, tempValue$, key$, section$
|
||||
DIM Quote AS _UNSIGNED LONG, Comment AS _UNSIGNED LONG
|
||||
DIM i AS LONG, FoundLF AS _UNSIGNED LONG
|
||||
|
||||
section$ = IniFormatSection(__section$)
|
||||
IF IniCODE THEN EXIT SUB
|
||||
|
||||
'fetch the desired section$
|
||||
IniSectionData$ = IniGetSection(section$)
|
||||
IF IniCODE > 0 AND IniCODE <> 17 THEN EXIT SUB
|
||||
|
||||
IF LEN(IniSectionData$) = 0 AND section$ <> "[]" THEN IniCODE = 14: EXIT SUB
|
||||
|
||||
IniLastSection$ = section$
|
||||
|
||||
IniPosition = 0
|
||||
|
||||
key$ = LTRIM$(RTRIM$(__key$))
|
||||
IniLastKey$ = ""
|
||||
IF key$ = "" THEN
|
||||
IF section$ = "[]" THEN IniSectionData$ = IniWholeFile$
|
||||
key$ = IniNextKey
|
||||
IF IniCODE THEN EXIT SUB
|
||||
IF key$ = "" THEN
|
||||
IniCODE = 10
|
||||
EXIT SUB
|
||||
END IF
|
||||
END IF
|
||||
|
||||
IF LEFT$(key$, 1) = ";" OR LEFT$(key$, 1) = "'" OR INSTR(key$, "[") > 0 OR INSTR(key$, "]") > 0 OR INSTR(key$, "=") > 0 THEN
|
||||
IniCODE = 12
|
||||
EXIT SUB
|
||||
END IF
|
||||
|
||||
IniLastKey$ = key$
|
||||
|
||||
IF IniPosition > 0 THEN Equal = IniPosition: GOTO KeyFound
|
||||
CheckKey:
|
||||
IniPosition = INSTR(IniPosition + 1, LCASE$(IniSectionData$), LCASE$(key$))
|
||||
|
||||
IF IniPosition > 0 THEN
|
||||
'identify if this occurrence is actually a key and not part of a key name/value
|
||||
FOR i = IniPosition - 1 TO 1 STEP -1
|
||||
IF ASC(IniSectionData$, i) = 10 THEN EXIT FOR
|
||||
IF ASC(IniSectionData$, i) <> 10 AND ASC(IniSectionData$, i) <> 32 THEN
|
||||
'not a key
|
||||
GOTO CheckKey
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
'check if there's nothing but an equal sign ahead
|
||||
FOR i = IniPosition + LEN(key$) TO LEN(IniSectionData$)
|
||||
IF ASC(IniSectionData$, i) = ASC("=") THEN EXIT FOR
|
||||
IF ASC(IniSectionData$, i) <> ASC("=") AND ASC(IniSectionData$, i) <> 32 THEN
|
||||
'not the key
|
||||
GOTO CheckKey
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
'so far so good; check if there is an assignment
|
||||
Equal = INSTR(IniPosition, IniSectionData$, "=")
|
||||
KeyFound:
|
||||
FoundLF = INSTR(IniPosition, IniSectionData$, IniLF$)
|
||||
|
||||
IF FoundLF > 0 THEN
|
||||
IF Equal > FoundLF THEN GOTO CheckKey
|
||||
ELSE
|
||||
FoundLF = LEN(IniSectionData$) + 1
|
||||
IF Equal = 0 THEN GOTO CheckKey
|
||||
END IF
|
||||
|
||||
tempValue$ = LTRIM$(RTRIM$(MID$(IniSectionData$, Equal + 1, FoundLF - Equal - 1)))
|
||||
|
||||
IF LEN(tempValue$) > 0 THEN
|
||||
IF LEFT$(tempValue$, 1) = CHR$(34) THEN
|
||||
tempValue$ = MID$(tempValue$, 2)
|
||||
Quote = INSTR(tempValue$, CHR$(34))
|
||||
IF Quote > 0 THEN
|
||||
tempValue$ = LEFT$(tempValue$, Quote - 1)
|
||||
END IF
|
||||
ELSE
|
||||
IF IniAllowBasicComments THEN Comment = INSTR(tempValue$, "'") 'BASIC style comments accepted
|
||||
IF Comment = 0 THEN Comment = INSTR(tempValue$, ";")
|
||||
IF Comment > 0 THEN
|
||||
tempValue$ = LTRIM$(RTRIM$(LEFT$(tempValue$, Comment - 1)))
|
||||
END IF
|
||||
END IF
|
||||
ELSE
|
||||
IniCODE = 2
|
||||
END IF
|
||||
ELSE
|
||||
IniCODE = 3
|
||||
EXIT FUNCTION
|
||||
END IF
|
||||
|
||||
ReadSetting$ = tempValue$
|
||||
IniLastSection$ = IniCurrentSection$
|
||||
END SUB
|
||||
|
||||
FUNCTION IniCurrentSection$
|
||||
SHARED IniPosition AS _UNSIGNED LONG, IniSectionData$, IniWholeFile$
|
||||
|
||||
DIM GlobalPosition AS _UNSIGNED LONG, i AS _UNSIGNED LONG
|
||||
DIM ClosingBracket AS _UNSIGNED LONG
|
||||
|
||||
GlobalPosition = INSTR(IniWholeFile$, IniSectionData$) + IniPosition - 1
|
||||
|
||||
CheckSection:
|
||||
FOR i = GlobalPosition - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = ASC("[") THEN
|
||||
GlobalPosition = i: EXIT FOR
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
IF i = 0 THEN IniCurrentSection$ = "[]": EXIT FUNCTION
|
||||
|
||||
'identify if this occurrence is actually a section header and not something else
|
||||
FOR i = GlobalPosition - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN EXIT FOR
|
||||
IF ASC(IniWholeFile$, i) <> 10 AND ASC(IniWholeFile$, i) <> 32 THEN
|
||||
'not a section header
|
||||
GOTO CheckSection
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
ClosingBracket = INSTR(GlobalPosition, IniWholeFile$, "]")
|
||||
IF ClosingBracket > 0 THEN
|
||||
IniCurrentSection$ = MID$(IniWholeFile$, GlobalPosition, ClosingBracket - GlobalPosition + 1)
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
SUB WriteSetting (file$, __section$, __key$, __value$)
|
||||
SHARED IniPosition AS _UNSIGNED LONG, IniCODE, currentIniFileName$
|
||||
SHARED IniLF$, IniWholeFile$, IniSectionData$
|
||||
SHARED IniLastSection$, IniLastKey$, IniNewFile$
|
||||
|
||||
DIM tempValue$, section$, key$, value$, thisLine$
|
||||
|
||||
IniCODE = 0
|
||||
|
||||
'prepare variables for the write operation
|
||||
section$ = IniFormatSection$(__section$)
|
||||
IF IniCODE THEN EXIT SUB
|
||||
|
||||
key$ = LTRIM$(RTRIM$(__key$))
|
||||
IF key$ = "" THEN IniCODE = 12: EXIT SUB
|
||||
IniLastKey$ = key$
|
||||
|
||||
value$ = LTRIM$(RTRIM$(__value$))
|
||||
IF LTRIM$(STR$(VAL(value$))) <> value$ THEN
|
||||
'if not a numeric value and value contains spaces, add quotation marks
|
||||
IF INSTR(value$, CHR$(32)) THEN value$ = CHR$(34) + value$ + CHR$(34)
|
||||
END IF
|
||||
|
||||
'Read the existing key to fill IniPosition
|
||||
tempValue$ = ReadSetting$(file$, section$, key$)
|
||||
|
||||
'map IniPosition (set in the section block) to the global file position
|
||||
IniPosition = INSTR(IniWholeFile$, IniSectionData$) + IniPosition - 1
|
||||
|
||||
IF IniCODE = 1 OR IniCODE = 17 THEN
|
||||
'file not found or empty; create a new one
|
||||
IF file$ = "" THEN file$ = currentIniFileName$
|
||||
IF file$ = "" THEN IniCODE = 21: EXIT SUB
|
||||
|
||||
currentIniFileName$ = file$
|
||||
|
||||
IF section$ <> "[]" THEN
|
||||
IniNewFile$ = section$ + IniLF$
|
||||
END IF
|
||||
|
||||
IniNewFile$ = IniNewFile$ + key$ + "=" + value$
|
||||
|
||||
IniCODE = 0
|
||||
IniCommit
|
||||
IniLoad file$
|
||||
IF IniCODE = 0 THEN IniCODE = 11
|
||||
IniLastSection$ = section$
|
||||
EXIT SUB
|
||||
END IF
|
||||
|
||||
IF IniCODE = 0 OR IniCODE = 2 THEN 'key found and read back; write new value$
|
||||
IF LCASE$(IniLastSection$) = LCASE$(section$) THEN
|
||||
IF LTRIM$(RTRIM$(__value$)) = tempValue$ AND LEN(LTRIM$(RTRIM$(__value$))) > 0 THEN
|
||||
'identical values skip the writing routine
|
||||
IniCODE = 8
|
||||
EXIT SUB
|
||||
END IF
|
||||
|
||||
DIM nextLine AS _UNSIGNED LONG
|
||||
nextLine = INSTR(IniPosition + 1, IniWholeFile$, IniLF$)
|
||||
|
||||
'create new file contents
|
||||
IniNewFile$ = LEFT$(IniWholeFile$, IniPosition - 1)
|
||||
IniNewFile$ = IniNewFile$ + key$ + "=" + value$
|
||||
|
||||
IF nextLine > 0 THEN
|
||||
IniNewFile$ = IniNewFile$ + MID$(IniWholeFile$, nextLine)
|
||||
END IF
|
||||
|
||||
IniCommit
|
||||
|
||||
IniCODE = 4
|
||||
END IF
|
||||
ELSEIF IniCODE = 3 OR IniCODE = 14 THEN 'Key not found, Section not found
|
||||
IniCODE = 0
|
||||
IF LCASE$(IniLastSection$) = LCASE$(section$) THEN
|
||||
'find this section$ in the current ini file;
|
||||
DIM Bracket1 AS _UNSIGNED LONG, Bracket2 AS _UNSIGNED LONG, foundSection$
|
||||
DIM beginSection AS _UNSIGNED LONG, endSection AS _UNSIGNED LONG
|
||||
DIM currentPos AS _UNSIGNED LONG, i AS _UNSIGNED LONG
|
||||
|
||||
beginSection = 0
|
||||
endSection = 0
|
||||
|
||||
CheckSection:
|
||||
beginSection = INSTR(beginSection + 1, LCASE$(IniWholeFile$), LCASE$(section$))
|
||||
IF beginSection = 0 THEN GOTO CreateSection
|
||||
|
||||
'identify if this occurrence is actually the section header and not something else
|
||||
FOR i = beginSection - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN EXIT FOR
|
||||
IF ASC(IniWholeFile$, i) <> 10 AND ASC(IniWholeFile$, i) <> 32 THEN
|
||||
'not the section header
|
||||
GOTO CheckSection
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
'we found it; time to identify where this section ends
|
||||
'(either another [section], a blank line or the end of the file
|
||||
Bracket1 = INSTR(beginSection + 1, IniWholeFile$, "[")
|
||||
IF Bracket1 > 0 THEN
|
||||
FOR i = Bracket1 - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN endSection = i + 1 - LEN(IniLF$): EXIT FOR
|
||||
IF i <= beginSection THEN EXIT FOR
|
||||
NEXT
|
||||
END IF
|
||||
|
||||
IF endSection > 0 THEN
|
||||
'add values to the end of the specified section$
|
||||
IniNewFile$ = LEFT$(IniWholeFile$, endSection - 1)
|
||||
IniNewFile$ = IniNewFile$ + key$ + "=" + value$ + IniLF$
|
||||
IF MID$(IniWholeFile$, endSection, 2) <> IniLF$ THEN IniNewFile$ = IniNewFile$ + IniLF$
|
||||
IniNewFile$ = IniNewFile$ + MID$(IniWholeFile$, endSection)
|
||||
ELSE
|
||||
'add values to the end of the file
|
||||
IniNewFile$ = IniWholeFile$
|
||||
IF RIGHT$(IniNewFile$, 2) = IniLF$ THEN
|
||||
IniNewFile$ = IniNewFile$ + key$ + "=" + value$
|
||||
ELSE
|
||||
IniNewFile$ = IniNewFile$ + IniLF$ + key$ + "=" + value$
|
||||
END IF
|
||||
END IF
|
||||
|
||||
IniCommit
|
||||
|
||||
IF IniCODE = 0 THEN IniCODE = 7
|
||||
EXIT SUB
|
||||
ELSE
|
||||
CreateSection:
|
||||
IniNewFile$ = IniWholeFile$
|
||||
IF section$ = "[]" THEN GOTO WriteAtTop
|
||||
|
||||
IF RIGHT$(IniNewFile$, 4) = IniLF$ + IniLF$ THEN
|
||||
IniNewFile$ = IniNewFile$ + section$ + IniLF$ + key$ + "=" + value$ + IniLF$
|
||||
ELSEIF RIGHT$(IniNewFile$, 2) = IniLF$ THEN
|
||||
IniNewFile$ = IniNewFile$ + IniLF$ + section$ + IniLF$ + key$ + "=" + value$ + IniLF$
|
||||
ELSE
|
||||
IniNewFile$ = IniNewFile$ + IniLF$ + IniLF$ + section$ + IniLF$ + key$ + "=" + value$ + IniLF$
|
||||
END IF
|
||||
|
||||
IniCommit
|
||||
|
||||
IF IniCODE = 0 THEN IniCODE = 9 ELSE IniCODE = 16
|
||||
EXIT SUB
|
||||
END IF
|
||||
|
||||
'if not found, key$=value$ is written to the beginning of the file
|
||||
WriteAtTop:
|
||||
IniNewFile$ = key$ + "=" + value$ + IniLF$
|
||||
IF LEFT$(LTRIM$(IniWholeFile$), 1) = "[" THEN IniNewFile$ = IniNewFile$ + IniLF$
|
||||
IniNewFile$ = IniNewFile$ + IniWholeFile$
|
||||
|
||||
IniCommit
|
||||
|
||||
IniCODE = 5
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB IniSetForceReload (state AS _BYTE)
|
||||
SHARED IniForceReload
|
||||
IF state THEN
|
||||
IniForceReload = -1
|
||||
ELSE
|
||||
IniForceReload = 0
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB IniClose
|
||||
SHARED IniDisableAutoCommit, currentIniFileName$
|
||||
|
||||
IniDisableAutoCommit = 0
|
||||
IniCommit
|
||||
|
||||
currentIniFileName$ = ""
|
||||
END SUB
|
||||
|
||||
SUB IniLoad (file$)
|
||||
SHARED IniCODE, currentIniFileName$, IniLF$, IniWholeFile$
|
||||
SHARED currentIniFileLOF AS _UNSIGNED LONG
|
||||
SHARED IniForceReload
|
||||
|
||||
DIM fileNum AS INTEGER
|
||||
|
||||
'Error messages are returned with IniCODE
|
||||
'Error descriptions can be fetched with function IniINFO$
|
||||
IniCODE = 0
|
||||
|
||||
IF file$ <> "" AND currentIniFileName$ <> file$ THEN currentIniFileName$ = ""
|
||||
|
||||
IF IniForceReload AND LEN(currentIniFileName$) > 0 THEN
|
||||
file$ = currentIniFileName$
|
||||
currentIniFileName$ = ""
|
||||
END IF
|
||||
|
||||
'Passing an empty file$ is allowed if user already
|
||||
'passed a valid file in this session.
|
||||
IF currentIniFileName$ = "" THEN
|
||||
'initialization
|
||||
IF _FILEEXISTS(file$) THEN
|
||||
currentIniFileName$ = file$
|
||||
|
||||
'Load file into memory
|
||||
fileNum = FREEFILE
|
||||
OPEN currentIniFileName$ FOR BINARY AS #fileNum
|
||||
currentIniFileLOF = LOF(fileNum)
|
||||
IniWholeFile$ = SPACE$(currentIniFileLOF)
|
||||
GET #fileNum, 1, IniWholeFile$
|
||||
CLOSE #fileNum
|
||||
|
||||
'Check if this ini file uses CRLF or LF
|
||||
IF INSTR(IniWholeFile$, CHR$(13)) THEN IniLF$ = CHR$(13) + CHR$(10) ELSE IniLF$ = CHR$(10)
|
||||
|
||||
'IF RIGHT$(IniWholeFile$, 2) <> IniLF$ THEN IniWholeFile$ = IniWholeFile$ + IniLF$
|
||||
ELSE
|
||||
IniFileNotFound:
|
||||
IniCODE = 1
|
||||
|
||||
$IF WIN THEN
|
||||
IniLF$ = CHR$(13) + CHR$(10)
|
||||
$ELSE
|
||||
IniLF$ = CHR$(10)
|
||||
$END IF
|
||||
EXIT SUB
|
||||
END IF
|
||||
ELSEIF NOT _FILEEXISTS(currentIniFileName$) THEN
|
||||
currentIniFileName$ = ""
|
||||
GOTO IniFileNotFound
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
FUNCTION IniNextKey$
|
||||
SHARED IniCODE, IniLF$, currentIniFileName$, IniSectionData$
|
||||
SHARED IniPosition AS _UNSIGNED LONG
|
||||
STATIC lastDataBlock$, position AS _UNSIGNED LONG, tempLF$
|
||||
|
||||
IF currentIniFileName$ = "" THEN IniCODE = 18: EXIT FUNCTION
|
||||
|
||||
IF IniSectionData$ <> lastDataBlock$ THEN
|
||||
position = 0
|
||||
lastDataBlock$ = IniSectionData$
|
||||
|
||||
'data blocks must end with a line feed for parsing purposes
|
||||
IF RIGHT$(IniSectionData$, LEN(IniLF$)) <> IniLF$ THEN tempLF$ = IniLF$ ELSE tempLF$ = ""
|
||||
END IF
|
||||
|
||||
DIM Equal AS _UNSIGNED LONG, tempKey$
|
||||
|
||||
FindKey:
|
||||
Equal = INSTR(position, IniSectionData$ + tempLF$, "=")
|
||||
IF Equal = 0 THEN position = 0: EXIT FUNCTION
|
||||
|
||||
tempKey$ = LTRIM$(RTRIM$(MID$(IniSectionData$ + tempLF$, position + 1, Equal - position - 1)))
|
||||
|
||||
IF INSTR(tempKey$, CHR$(10)) > 0 THEN tempKey$ = MID$(tempKey$, INSTR(tempKey$, CHR$(10)) + 1)
|
||||
|
||||
DO WHILE LEFT$(tempKey$, LEN(IniLF$)) = IniLF$
|
||||
tempKey$ = MID$(tempKey$, LEN(IniLF$) + 1)
|
||||
position = position + LEN(IniLF$)
|
||||
LOOP
|
||||
|
||||
position = INSTR(position, IniSectionData$ + tempLF$, IniLF$) + 1
|
||||
|
||||
IF LEFT$(tempKey$, 1) = ";" OR LEFT$(tempKey$, 1) = "'" OR INSTR(tempKey$, "[") > 0 OR INSTR(tempKey$, "]") > 0 OR INSTR(tempKey$, "=") > 0 THEN
|
||||
GOTO FindKey
|
||||
END IF
|
||||
|
||||
IniNextKey$ = tempKey$
|
||||
IniPosition = Equal
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION IniNextSection$ (file$)
|
||||
SHARED IniCODE, IniLF$, IniWholeFile$
|
||||
|
||||
STATIC sectionStart AS _UNSIGNED LONG
|
||||
|
||||
IniLoad file$
|
||||
IF LEFT$(IniINFO$, 6) = "ERROR:" THEN EXIT SUB
|
||||
|
||||
IniCODE = 0
|
||||
|
||||
DIM section$, foundSection AS _UNSIGNED LONG, endSection AS _UNSIGNED LONG
|
||||
DIM i AS _UNSIGNED LONG, Bracket1 AS _UNSIGNED LONG, Bracket2 AS _UNSIGNED LONG
|
||||
|
||||
FindNext:
|
||||
sectionStart = INSTR(sectionStart + 1, IniWholeFile$, "[")
|
||||
IF sectionStart = 0 THEN IniCODE = 24: EXIT FUNCTION
|
||||
|
||||
'make sure it's a valid section header
|
||||
foundSection = 0
|
||||
FOR i = sectionStart - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN foundSection = i + 1: EXIT FOR
|
||||
IF ASC(IniWholeFile$, i) <> 32 THEN GOTO FindNext
|
||||
NEXT
|
||||
|
||||
IF i = 0 THEN foundSection = 1
|
||||
|
||||
IF foundSection > 0 THEN
|
||||
'we found it; time to identify where this section ends
|
||||
'(either another [section] or the end of the file
|
||||
Bracket2 = INSTR(sectionStart + 1, IniWholeFile$, "]")
|
||||
IF Bracket2 = 0 THEN IniCODE = 24: EXIT FUNCTION
|
||||
Bracket1 = INSTR(sectionStart + 1, IniWholeFile$, "[")
|
||||
IF Bracket1 > 0 THEN
|
||||
FOR i = Bracket1 - 1 TO 1 STEP -1
|
||||
IF ASC(IniWholeFile$, i) = 10 THEN endSection = i + 1 - LEN(IniLF$): EXIT FOR
|
||||
IF i <= foundSection THEN EXIT FOR
|
||||
NEXT
|
||||
IniNextSection$ = MID$(IniWholeFile$, foundSection, Bracket2 - foundSection + 1)
|
||||
ELSE
|
||||
IniNextSection$ = MID$(IniWholeFile$, foundSection, Bracket2 - foundSection + 1)
|
||||
IniCODE = 24
|
||||
sectionStart = 0
|
||||
END IF
|
||||
ELSE
|
||||
IniCODE = 24
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION IniINFO$
|
||||
SHARED IniCODE
|
||||
SELECT CASE IniCODE
|
||||
CASE 0: IniINFO$ = "Operation successful"
|
||||
CASE 1: IniINFO$ = "ERROR: File not found"
|
||||
CASE 2: IniINFO$ = "Empty value"
|
||||
CASE 3: IniINFO$ = "ERROR: Key not found"
|
||||
CASE 4: IniINFO$ = "Key updated"
|
||||
CASE 5: IniINFO$ = "Global key created"
|
||||
CASE 7: IniINFO$ = "Key created in existing section"
|
||||
CASE 8: IniINFO$ = "No changes applied (same value)"
|
||||
CASE 9: IniINFO$ = "New section created; key created"
|
||||
CASE 10: IniINFO$ = "No more keys"
|
||||
CASE 11: IniINFO$ = "File created; new key added"
|
||||
CASE 12: IniINFO$ = "ERROR: Invalid key"
|
||||
CASE 13: IniINFO$ = "Section deleted"
|
||||
CASE 14: IniINFO$ = "ERROR: Section not found"
|
||||
CASE 15: IniINFO$ = "ERROR: Invalid section"
|
||||
CASE 16: IniINFO$ = "New section created; existing key moved"
|
||||
CASE 17: IniINFO$ = "ERROR: Empty file"
|
||||
CASE 18: IniINFO$ = "ERROR: No file open"
|
||||
CASE 19: IniINFO$ = "Key deleted"
|
||||
CASE 20: IniINFO$ = "Key moved"
|
||||
CASE 21: IniINFO$ = "ERROR: Invalid file name/path"
|
||||
CASE 22: IniINFO$ = "Section sorted"
|
||||
CASE 23: IniINFO$ = "No changes applied; section already sorted"
|
||||
CASE 24: IniINFO$ = "No more sections"
|
||||
CASE ELSE: IniINFO$ = "ERROR: <invalid error code>"
|
||||
END SELECT
|
||||
END FUNCTION
|
||||
|
||||
'Written in BASIC by Luke Ceddia for ide_methods.bas (QB64)
|
||||
'After Cormen, Leiserson, Rivest & Stein "Introduction To Algoritms" via Wikipedia
|
||||
'Adapted for use in .INI Manager
|
||||
FUNCTION IniArraySort%% (arr() AS STRING)
|
||||
DIM i&, x$, j&, moves&
|
||||
|
||||
FOR i& = LBOUND(arr) + 1 TO UBOUND(arr)
|
||||
x$ = arr(i&)
|
||||
j& = i& - 1
|
||||
WHILE j& >= LBOUND(arr)
|
||||
IF arr(j&) <= x$ THEN EXIT WHILE
|
||||
moves& = moves& + 1
|
||||
arr$(j& + 1) = arr$(j&)
|
||||
j& = j& - 1
|
||||
WEND
|
||||
arr$(j& + 1) = x$
|
||||
NEXT i&
|
||||
|
||||
'Returns -1 (true) if any changes were made
|
||||
IniArraySort%% = moves& > 0
|
||||
END FUNCTION
|
||||
|
|
@ -4,10 +4,3 @@ Artist: Custom Icon Design (Available for custom work)
|
|||
Iconset: Flatastic 11 Icons (60 icons)
|
||||
License: Free for non-commercial use.
|
||||
Commercial usage: Buy commercial license here: http://www.customicondesign.com/free-icons/flatastic-icon-set/flatastic-part-11
|
||||
|
||||
http://www.iconarchive.com/show/oxygen-icons-by-oxygen-icons.org/Apps-system-software-update-icon.html
|
||||
"Apps system software update Icon"
|
||||
Artist: Oxygen Team
|
||||
Iconset: Oxygen Icons (883 icons)
|
||||
License: GNU Lesser General Public License
|
||||
Commercial usage: Allowed
|
Before Width: | Height: | Size: 211 KiB |
|
@ -1,78 +0,0 @@
|
|||
': This form was generated by
|
||||
': InForm - GUI library for QB64 - Beta version 9
|
||||
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
SUB __UI_LoadForm
|
||||
|
||||
$EXEICON:'./../resources/updater.ico'
|
||||
|
||||
DIM __UI_NewID AS LONG
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Form, "InFormSetup", 500, 425, 0, 0, 0)
|
||||
SetCaption __UI_NewID, "InForm Setup"
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf?arial.ttf?/Library/Fonts/Arial.ttf?/usr/share/fonts/truetype/liberation/LiberationSans-Regular.ttf?/usr/share/fonts/TTF/arial.ttf?InForm/resources/NotoMono-Regular.ttf?cour.ttf", 12)
|
||||
Control(__UI_NewID).CenteredWindow = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "PictureBox2", 500, 150, 0, 0, 0)
|
||||
Control(__UI_NewID).Stretch = True
|
||||
Control(__UI_NewID).BackColor = _RGB32(255, 255, 255)
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "InFormresourcesApplicationicon128PX", 128, 128, 10, 11, 0)
|
||||
Control(__UI_NewID).Stretch = True
|
||||
Control(__UI_NewID).BackStyle = __UI_Transparent
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "InFormLB", 258, 90, 199, 22, 0)
|
||||
SetCaption __UI_NewID, "InForm"
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf?arial.ttf?/Library/Fonts/Arial.ttf?/usr/share/fonts/truetype/liberation/LiberationSans-Regular.ttf?/usr/share/fonts/TTF/arial.ttf?InForm/resources/NotoMono-Regular.ttf?cour.ttf", 72)
|
||||
Control(__UI_NewID).BackStyle = __UI_Transparent
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "forQB64LB", 152, 43, 305, 88, 0)
|
||||
SetCaption __UI_NewID, "for QB64"
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf?arial.ttf?/Library/Fonts/Arial.ttf?/usr/share/fonts/truetype/liberation/LiberationSans-Regular.ttf?/usr/share/fonts/TTF/arial.ttf?InForm/resources/NotoMono-Regular.ttf?cour.ttf", 32)
|
||||
Control(__UI_NewID).BackStyle = __UI_Transparent
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_ListBox, "ListBox1", 480, 224, 10, 159, 0)
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).AutoScroll = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "RetryBT", 80, 23, 10, 392, 0)
|
||||
SetCaption __UI_NewID, "&Retry"
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).Hidden = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "CancelBT", 80, 23, 410, 392, 0)
|
||||
SetCaption __UI_NewID, "&Cancel"
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "ActivityIndicator", 266, 32, 117, 388, 0)
|
||||
Control(__UI_NewID).Stretch = True
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_AssignIDs
|
||||
InFormSetup = __UI_GetID("InFormSetup")
|
||||
PictureBox2 = __UI_GetID("PictureBox2")
|
||||
InFormresourcesApplicationicon128PX = __UI_GetID("InFormresourcesApplicationicon128PX")
|
||||
InFormLB = __UI_GetID("InFormLB")
|
||||
forQB64LB = __UI_GetID("forQB64LB")
|
||||
ListBox1 = __UI_GetID("ListBox1")
|
||||
RetryBT = __UI_GetID("RetryBT")
|
||||
CancelBT = __UI_GetID("CancelBT")
|
||||
ActivityIndicator = __UI_GetID("ActivityIndicator")
|
||||
END SUB
|
|
@ -1,420 +0,0 @@
|
|||
': This program uses
|
||||
': InForm - GUI library for QB64 - Beta version 9
|
||||
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
|
||||
': Controls' IDs: ------------------------------------------------------------------
|
||||
DIM SHARED InFormUpdater AS LONG
|
||||
DIM SHARED PictureBox2 AS LONG
|
||||
DIM SHARED InFormresourcesApplicationicon128PX AS LONG
|
||||
DIM SHARED InFormLB AS LONG
|
||||
DIM SHARED forQB64LB AS LONG
|
||||
DIM SHARED ListBox1 AS LONG
|
||||
DIM SHARED RetryBT AS LONG
|
||||
DIM SHARED CancelBT AS LONG
|
||||
DIM SHARED ActivityIndicator AS LONG
|
||||
|
||||
DIM SHARED binaryExtension$, pathAppend$
|
||||
DIM SHARED CheckDevUpdates AS _BYTE
|
||||
|
||||
$IF WIN THEN
|
||||
binaryExtension$ = ".exe"
|
||||
pathAppend$ = ""
|
||||
$ELSE
|
||||
binaryExtension$ = ""
|
||||
pathAppend$ = "./"
|
||||
$END IF
|
||||
|
||||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../InForm.bi'
|
||||
'$INCLUDE:'../xp.uitheme'
|
||||
'$INCLUDE:'InFormUpdater.frm'
|
||||
'$INCLUDE:'../ini.bm'
|
||||
'$include:'../extensions/download.bas'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_OnLoad
|
||||
Report "Contacting server..."
|
||||
CHDIR "../.."
|
||||
IF _FILEEXISTS("InFormUpdate.ini") THEN KILL "InFormUpdate.ini"
|
||||
|
||||
DIM value$
|
||||
value$ = ReadSetting("InForm/InForm.ini", "InForm Settings", "Receive development updates")
|
||||
IF LEN(value$) THEN
|
||||
CheckDevUpdates = (value$ = "True")
|
||||
ELSE
|
||||
WriteSetting "InForm/InForm.ini", "InForm Settings", "Receive development updates", "False"
|
||||
CheckDevUpdates = False
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUpdateDisplay STATIC
|
||||
DIM NextEvent AS LONG, remoteFile$
|
||||
SHARED ThisStep AS INTEGER
|
||||
|
||||
IF ThisStep = 0 THEN ThisStep = 1
|
||||
|
||||
SELECT EVERYCASE ThisStep
|
||||
CASE 1 'check availability
|
||||
IF CheckDevUpdates THEN
|
||||
remoteFile$ = "www.qb64.org/inform/update/latestdev.ini"
|
||||
ELSE
|
||||
remoteFile$ = "www.qb64.org/inform/update/latest.ini"
|
||||
END IF
|
||||
Result$ = Download$(remoteFile$, "InFormUpdate.ini", 30)
|
||||
SELECT CASE CVI(LEFT$(Result$, 2))
|
||||
CASE 1 'Success
|
||||
Report "Script downloaded:" + STR$(CVL(MID$(Result$, 3))) + " bytes."
|
||||
ThisStep = 2
|
||||
NextEvent = True
|
||||
CASE 2 'Can't reach server
|
||||
Report "Can't reach server."
|
||||
ThisStep = -1
|
||||
NextEvent = True
|
||||
CASE 3 'Timeout :-(
|
||||
Report "Failed to download update script."
|
||||
ThisStep = -1
|
||||
NextEvent = True
|
||||
END SELECT
|
||||
CASE 2 'compare with current version
|
||||
IF NextEvent THEN NextEvent = False: Report "Parsing update script..."
|
||||
localVersion$ = ReadSetting("InForm/InFormVersion.bas", "", "CONST __UI_Version")
|
||||
localVersionNumber! = VAL(ReadSetting("InForm/InFormVersion.bas", "", "CONST __UI_VersionNumber"))
|
||||
localVersionisBeta%% = VAL(ReadSetting("InForm/InFormVersion.bas", "", "CONST __UI_VersionIsBeta"))
|
||||
IF localVersionisBeta%% THEN localBeta$ = " Beta Version" ELSE localBeta$ = ""
|
||||
Report "Local build:" + STR$(localVersionNumber!) + localBeta$
|
||||
|
||||
serverVersion$ = ReadSetting("InFormUpdate.ini", "", "version")
|
||||
serverBeta$ = ReadSetting("InFormUpdate.ini", "", "beta")
|
||||
serverBeta%% = (serverBeta$ = "true")
|
||||
IF serverBeta%% THEN serverBeta$ = " Beta Version" ELSE serverBeta$ = ""
|
||||
Report "Remote build: " + serverVersion$ + serverBeta$
|
||||
|
||||
IF VAL(serverVersion$) <= localVersionNumber! THEN
|
||||
NextEvent = True: ThisStep = 7: EXIT SUB
|
||||
END IF
|
||||
|
||||
thisFile% = 0
|
||||
baseUrl$ = ReadSetting("InFormUpdate.ini", "", "baseurl")
|
||||
|
||||
NextEvent = True: ThisStep = 3
|
||||
CASE 3 'download new content
|
||||
IF NextEvent THEN NextEvent = False: Report "Downloading content..."
|
||||
|
||||
IF url$ = "" THEN
|
||||
thisFile% = thisFile% + 1
|
||||
|
||||
url$ = ReadSetting("InFormUpdate.ini", LTRIM$(STR$(thisFile%)), "filename")
|
||||
IF url$ = "" THEN
|
||||
NextEvent = True: ThisStep = 4: EXIT SUB
|
||||
END IF
|
||||
IF INSTR(url$, "/") > 0 THEN
|
||||
FOR i = LEN(url$) TO 1 STEP -1
|
||||
IF ASC(url$, i) = 47 THEN '/
|
||||
target$ = LEFT$(url$, i)
|
||||
EXIT FOR
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
IF _DIREXISTS(target$) = 0 THEN MKDIR target$
|
||||
ELSE
|
||||
target$ = ""
|
||||
END IF
|
||||
outputFileName$ = url$
|
||||
checksum$ = ReadSetting("InFormUpdate.ini", LTRIM$(STR$(thisFile%)), "checksum")
|
||||
|
||||
IF _FILEEXISTS(outputFileName$) THEN
|
||||
IF getChecksum$(outputFileName$) = checksum$ THEN
|
||||
url$ = ""
|
||||
END IF
|
||||
END IF
|
||||
|
||||
IF LEN(url$) THEN Report "Downloading " + outputFileName$ + "...;"
|
||||
END IF
|
||||
|
||||
IF LEN(url$) THEN
|
||||
IF INSTR(url$, "updater") > 0 THEN
|
||||
WriteSetting "InForm/InForm.ini", "InForm Settings", "Recompile updater", "True"
|
||||
END IF
|
||||
Result$ = Download$(baseUrl$ + url$, outputFileName$, 30)
|
||||
ELSE
|
||||
Result$ = MKI$(0)
|
||||
END IF
|
||||
|
||||
SELECT CASE CVI(LEFT$(Result$, 2))
|
||||
CASE 1 'Success
|
||||
'Checksum:
|
||||
IF getChecksum(outputFileName$) <> checksum$ THEN
|
||||
Report "Failed."
|
||||
ThisStep = -1
|
||||
NextEvent = True
|
||||
EXIT SUB
|
||||
END IF
|
||||
Report " done (" + LTRIM$(STR$(CVL(MID$(Result$, 3)))) + " bytes)"
|
||||
url$ = ""
|
||||
CASE 2 'Can't reach server
|
||||
Report "failed."
|
||||
Report "Can't reach server."
|
||||
ThisStep = -1
|
||||
NextEvent = True
|
||||
CASE 3 'Timeout :-(
|
||||
Report "failed."
|
||||
Report "Failed to download update files from server."
|
||||
ThisStep = -1
|
||||
NextEvent = True
|
||||
END SELECT
|
||||
CASE 4 'compile UiEditor.bas
|
||||
IF NextEvent THEN NextEvent = False: Report "Compiling UiEditor.bas...": EXIT SUB
|
||||
SHELL _HIDE pathAppend$ + "qb64" + binaryExtension$ + " -s:exewithsource=false"
|
||||
Result% = SHELL(pathAppend$ + "qb64" + binaryExtension$ + " -x InForm/UiEditor.bas")
|
||||
IF Result% > 0 OR _FILEEXISTS(pathAppend$ + "qb64" + binaryExtension$) = 0 THEN
|
||||
Report "Compilation failed."
|
||||
ThisStep = -1
|
||||
NextEvent = True
|
||||
ELSE
|
||||
ThisStep = 5
|
||||
NextEvent = True
|
||||
END IF
|
||||
CASE 5 'compile UiEditorPreview.bas
|
||||
IF NextEvent THEN NextEvent = False: Report "Compiling UiEditorPreview.bas...": EXIT SUB
|
||||
Result% = SHELL(pathAppend$ + "qb64" + binaryExtension$ + " -x InForm/UiEditorPreview.bas -o InForm/UiEditorPreview.exe")
|
||||
IF Result% THEN
|
||||
Report "Compilation failed."
|
||||
ThisStep = -1
|
||||
NextEvent = True
|
||||
ELSE
|
||||
ThisStep = 6
|
||||
NextEvent = True
|
||||
END IF
|
||||
CASE 6 'clean up
|
||||
IF NextEvent THEN NextEvent = False: Report "Cleaning up...": EXIT SUB
|
||||
KILL "InFormUpdate.ini"
|
||||
ThisStep = 8
|
||||
NextEvent = True
|
||||
CASE 7 'already up-to-date
|
||||
DIM b$
|
||||
b$ = ""
|
||||
IF CheckDevUpdates THEN b$ = "\n(You are currently in the development channel; you can\nchange that in InForm Designer, Options menu -> Auto-update)"
|
||||
Answer = MessageBox("You already have the latest version." + b$, "", MsgBox_OkOnly + MsgBox_Information)
|
||||
KILL "InFormUpdate.ini"
|
||||
SYSTEM
|
||||
CASE 8 'done
|
||||
IF NextEvent THEN NextEvent = False: Report "Update complete.": EXIT SUB
|
||||
Result$ = Download$("", "", 30) 'close client
|
||||
Control(ActivityIndicator).Hidden = True
|
||||
Caption(CancelBT) = "Finish"
|
||||
SetFocus CancelBT
|
||||
CASE 1 TO 6
|
||||
BeginDraw ActivityIndicator
|
||||
CLS , __UI_DefaultColor(__UI_Type_Form, 2)
|
||||
angle = angle + .05
|
||||
indicatorSize = 2
|
||||
IF angle > _PI(2) THEN angle = _PI(2) - angle
|
||||
FOR i = 0 TO 360 STEP 90
|
||||
CircleFill _WIDTH / 2 + COS(angle + _D2R(i)) * (_WIDTH * .2), _HEIGHT / 2, indicatorSize, _RGBA32(0, 0, 0, map(i, 0, 360, 20, 255))
|
||||
NEXT
|
||||
EndDraw ActivityIndicator
|
||||
CASE ELSE
|
||||
IF NextEvent THEN NextEvent = False: Report "Updated failed.": AddItem ListBox1, ""
|
||||
Result$ = Download$("", "", 30)
|
||||
KILL "InFormUpdate.ini"
|
||||
Control(RetryBT).Hidden = False
|
||||
Control(ActivityIndicator).Hidden = True
|
||||
END SELECT
|
||||
|
||||
END SUB
|
||||
|
||||
SUB Report (__text$)
|
||||
STATIC Continue%%
|
||||
DIM text$
|
||||
|
||||
text$ = __text$
|
||||
|
||||
IF text$ = "" THEN
|
||||
Continue%% = False
|
||||
EXIT SUB
|
||||
END IF
|
||||
|
||||
IF RIGHT$(text$, 1) = ";" THEN
|
||||
text$ = LEFT$(text$, LEN(text$) - 1)
|
||||
GOSUB AddThisItem
|
||||
Continue%% = True
|
||||
ELSE
|
||||
GOSUB AddThisItem
|
||||
Continue%% = False
|
||||
END IF
|
||||
EXIT SUB
|
||||
|
||||
AddThisItem:
|
||||
IF Continue%% THEN
|
||||
text$ = GetItem(ListBox1, Control(ListBox1).Max) + text$
|
||||
ReplaceItem ListBox1, Control(ListBox1).Max, text$
|
||||
ELSE
|
||||
AddItem ListBox1, TIME$ + ": " + text$
|
||||
END IF
|
||||
RETURN
|
||||
END SUB
|
||||
|
||||
FUNCTION getChecksum$ (File$)
|
||||
DIM fileHandle AS LONG
|
||||
|
||||
IF _FILEEXISTS(File$) = 0 THEN EXIT SUB
|
||||
|
||||
fileHandle = FREEFILE
|
||||
OPEN File$ FOR BINARY AS fileHandle
|
||||
DataArray$ = SPACE$(LOF(fileHandle))
|
||||
GET #fileHandle, 1, DataArray$
|
||||
CLOSE #fileHandle
|
||||
|
||||
getChecksum$ = HEX$(crc32~&(DataArray$))
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION crc32~& (buf AS STRING)
|
||||
'adapted from https://rosettacode.org/wiki/CRC-32
|
||||
STATIC table(255) AS _UNSIGNED LONG
|
||||
STATIC have_table AS _BYTE
|
||||
DIM crc AS _UNSIGNED LONG, k AS _UNSIGNED LONG
|
||||
DIM i AS LONG, j AS LONG
|
||||
|
||||
IF have_table = 0 THEN
|
||||
FOR i = 0 TO 255
|
||||
k = i
|
||||
FOR j = 0 TO 7
|
||||
IF (k AND 1) THEN
|
||||
k = _SHR(k, 1)
|
||||
k = k XOR &HEDB88320
|
||||
ELSE
|
||||
k = _SHR(k, 1)
|
||||
END IF
|
||||
table(i) = k
|
||||
NEXT
|
||||
NEXT
|
||||
have_table = -1
|
||||
END IF
|
||||
|
||||
crc = NOT crc ' crc = &Hffffffff
|
||||
|
||||
FOR i = 1 TO LEN(buf)
|
||||
crc = (_SHR(crc, 8)) XOR table((crc AND &HFF) XOR ASC(buf, i))
|
||||
NEXT
|
||||
|
||||
crc32~& = NOT crc
|
||||
END FUNCTION
|
||||
|
||||
SUB CircleFill (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
|
||||
DIM x0 AS SINGLE, y0 AS SINGLE
|
||||
DIM e AS SINGLE
|
||||
|
||||
x0 = R
|
||||
y0 = 0
|
||||
e = 0
|
||||
DO WHILE y0 < x0
|
||||
IF e <= 0 THEN
|
||||
y0 = y0 + 1
|
||||
LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
|
||||
LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
|
||||
e = e + 2 * y0
|
||||
ELSE
|
||||
LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
|
||||
LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
|
||||
x0 = x0 - 1
|
||||
e = e - 2 * x0
|
||||
END IF
|
||||
LOOP
|
||||
LINE (x - R, y)-(x + R, y), C, BF
|
||||
END SUB
|
||||
|
||||
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
|
||||
map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
|
||||
END FUNCTION
|
||||
|
||||
SUB __UI_BeforeUnload
|
||||
'If you set __UI_UnloadSignal = False here you can
|
||||
'cancel the user's request to close.
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_Click (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE InFormUpdater
|
||||
|
||||
CASE RetryBT
|
||||
SHARED ThisStep AS INTEGER
|
||||
ThisStep = 1
|
||||
Control(RetryBT).Hidden = True
|
||||
Control(ActivityIndicator).Hidden = False
|
||||
Report "Contacting server"
|
||||
IF _FILEEXISTS("InFormUpdate.ini") THEN KILL "InFormUpdate.ini"
|
||||
CASE CancelBT
|
||||
IF Caption(CancelBT) = "Finish" THEN
|
||||
DIM Answer AS _BYTE
|
||||
IF _FILEEXISTS("UiEditor" + binaryExtension$) THEN
|
||||
Answer = MessageBox("Launch InForm Designer?", "", MsgBox_YesNo + MsgBox_Question)
|
||||
IF Answer = MsgBox_Yes THEN
|
||||
SHELL _DONTWAIT pathAppend$ + "UiEditor" + binaryExtension$
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
SYSTEM
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseEnter (id AS LONG)
|
||||
SELECT CASE id
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseLeave (id AS LONG)
|
||||
SELECT CASE id
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusIn (id AS LONG)
|
||||
SELECT CASE id
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusOut (id AS LONG)
|
||||
'This event occurs right before a control loses focus.
|
||||
'To prevent a control from losing focus, set __UI_KeepFocus = True below.
|
||||
SELECT CASE id
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseDown (id AS LONG)
|
||||
SELECT CASE id
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseUp (id AS LONG)
|
||||
SELECT CASE id
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_KeyPress (id AS LONG)
|
||||
'When this event is fired, __UI_KeyHit will contain the code of the key hit.
|
||||
'You can change it and even cancel it by making it = 0
|
||||
SELECT CASE id
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_TextChanged (id AS LONG)
|
||||
SELECT CASE id
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_ValueChanged (id AS LONG)
|
||||
SELECT CASE id
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FormResized
|
||||
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../InForm.ui'
|
|
@ -1,79 +0,0 @@
|
|||
': This form was generated by
|
||||
': InForm - GUI library for QB64 - Beta version 9
|
||||
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
SUB __UI_LoadForm
|
||||
|
||||
$EXEICON:'./../resources/updater.ico'
|
||||
|
||||
DIM __UI_NewID AS LONG
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Form, "InFormUpdater", 500, 425, 0, 0, 0)
|
||||
SetCaption __UI_NewID, "InForm Updater"
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).Font = SetFont("../resources/NotoMono-Regular.ttf", 12)
|
||||
Control(__UI_NewID).CenteredWindow = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "PictureBox2", 500, 150, 0, 0, 0)
|
||||
Control(__UI_NewID).Stretch = True
|
||||
Control(__UI_NewID).BackColor = _RGB32(255, 255, 255)
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "InFormresourcesApplicationicon128PX", 128, 128, 10, 11, 0)
|
||||
LoadImage Control(__UI_NewID), "../resources/Application-icon-128.png"
|
||||
Control(__UI_NewID).Stretch = True
|
||||
Control(__UI_NewID).BackStyle = __UI_Transparent
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "InFormLB", 258, 90, 199, 22, 0)
|
||||
SetCaption __UI_NewID, "InForm"
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).Font = SetFont("../resources/NotoMono-Regular.ttf", 72)
|
||||
Control(__UI_NewID).BackStyle = __UI_Transparent
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "forQB64LB", 152, 43, 305, 88, 0)
|
||||
SetCaption __UI_NewID, "for QB64"
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).Font = SetFont("../resources/NotoMono-Regular.ttf", 32)
|
||||
Control(__UI_NewID).BackStyle = __UI_Transparent
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_ListBox, "ListBox1", 480, 224, 10, 159, 0)
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).AutoScroll = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "RetryBT", 80, 23, 10, 392, 0)
|
||||
SetCaption __UI_NewID, "&Retry"
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).Hidden = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "CancelBT", 80, 23, 410, 392, 0)
|
||||
SetCaption __UI_NewID, "&Cancel"
|
||||
Control(__UI_NewID).Stretch = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "ActivityIndicator", 266, 32, 117, 388, 0)
|
||||
Control(__UI_NewID).Stretch = True
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_AssignIDs
|
||||
InFormUpdater = __UI_GetID("InFormUpdater")
|
||||
PictureBox2 = __UI_GetID("PictureBox2")
|
||||
InFormresourcesApplicationicon128PX = __UI_GetID("InFormresourcesApplicationicon128PX")
|
||||
InFormLB = __UI_GetID("InFormLB")
|
||||
forQB64LB = __UI_GetID("forQB64LB")
|
||||
ListBox1 = __UI_GetID("ListBox1")
|
||||
RetryBT = __UI_GetID("RetryBT")
|
||||
CancelBT = __UI_GetID("CancelBT")
|
||||
ActivityIndicator = __UI_GetID("ActivityIndicator")
|
||||
END SUB
|
|
@ -1,12 +1,27 @@
|
|||
'$INCLUDE:'InFormVersion.bas'
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
' VBDOS to InForm form conversion utility
|
||||
' Copyright (c) 2024 Samuel Gomes
|
||||
' Copyright (c) 2023 George McGinn
|
||||
' Copyright (c) 2022 Fellippe Heitor
|
||||
'-----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
PRINT "InForm - GUI system for QB64 - "; __UI_Version
|
||||
$CONSOLE:ONLY
|
||||
OPTION _EXPLICIT
|
||||
|
||||
CONST FALSE%% = 0%%, TRUE%% = NOT FALSE
|
||||
|
||||
'$INCLUDE:'InFormVersion.bi'
|
||||
|
||||
PRINT "InForm GUI engine for QB64-PE - v"; __UI_Version
|
||||
PRINT "VBDOS to InForm form conversion utility"
|
||||
PRINT "-------------------------------------------------"
|
||||
|
||||
DIM lf AS STRING * 1, q AS STRING * 1
|
||||
DIM theFile$
|
||||
|
||||
lf = CHR$(10)
|
||||
q = CHR$(34)
|
||||
|
||||
IF LEN(COMMAND$) > 0 THEN
|
||||
IF _FILEEXISTS(COMMAND$) = 0 THEN PRINT "File not found.": END
|
||||
theFile$ = COMMAND$
|
||||
|
@ -18,8 +33,11 @@ ELSE
|
|||
IF _FILEEXISTS(theFile$) = 0 THEN PRINT "File "; theFile$; " not found." ELSE EXIT DO
|
||||
LOOP
|
||||
END IF
|
||||
|
||||
OPEN theFile$ FOR BINARY AS #1
|
||||
|
||||
DIM a$
|
||||
|
||||
LINE INPUT #1, a$
|
||||
IF a$ <> "Version 1.00" THEN
|
||||
PRINT "Expected VBDOS text form file. Exiting."
|
||||
|
@ -32,10 +50,11 @@ IF LEFT$(a$, 11) <> "BEGIN Form " THEN
|
|||
END
|
||||
END IF
|
||||
|
||||
FormName$ = MID$(a$, 12)
|
||||
DIM FormName$: FormName$ = MID$(a$, 12)
|
||||
|
||||
o$ = "'InForm - GUI system for QB64 - " + __UI_Version
|
||||
o$ = o$ + lf + "'Fellippe Heitor, " + __UI_CopyrightSpan + " - fellippe@qb64.org - @FellippeHeitor"
|
||||
DIM o$: o$ = "' InForm GUI engine for QB64-PE - v" + __UI_Version
|
||||
o$ = o$ + lf + "' Fellippe Heitor, (2016 - 2022) - @FellippeHeitor"
|
||||
o$ = o$ + lf + "' Samuel Gomes, (2023 - 2024) - @a740g"
|
||||
o$ = o$ + lf + "'-----------------------------------------------------------"
|
||||
o$ = o$ + lf + "SUB __UI_LoadForm"
|
||||
o$ = o$ + lf
|
||||
|
@ -43,7 +62,13 @@ o$ = o$ + lf + " DIM __UI_NewID AS LONG"
|
|||
o$ = o$ + lf
|
||||
o$ = o$ + lf + " __UI_NewID = __UI_NewControl(__UI_Type_Form, " + q + FormName$ + q + ", "
|
||||
|
||||
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$
|
||||
|
||||
DO
|
||||
IF EOF(1) THEN EXIT DO
|
||||
|
@ -171,17 +196,18 @@ o$ = o$ + lf + "SUB __UI_AssignIDs"
|
|||
o$ = o$ + assignIDs$
|
||||
o$ = o$ + lf + "END SUB"
|
||||
|
||||
newFile$ = LEFT$(theFile$, INSTR(theFile$, ".") - 1) + "_InForm.frm"
|
||||
DIM newFile$: newFile$ = LEFT$(theFile$, INSTR(theFile$, ".") - 1) + "_InForm.frm"
|
||||
CLOSE
|
||||
OPEN newFile$ FOR BINARY AS #1
|
||||
PUT #1, , o$
|
||||
CLOSE
|
||||
TextFileNum = FREEFILE
|
||||
newTextFile$ = LEFT$(theFile$, INSTR(theFile$, ".") - 1) + "_InForm.bas"
|
||||
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, "': InForm GUI engine for QB64-PE - v"; __UI_Version
|
||||
PRINT #TextFileNum, "': Fellippe Heitor, (2016 - 2022) - @FellippeHeitor"
|
||||
PRINT #TextFileNum, "': Samuel Gomes, (2023 - 2024) - @a740g"
|
||||
PRINT #TextFileNum, "'-----------------------------------------------------------"
|
||||
PRINT #TextFileNum,
|
||||
PRINT #TextFileNum, "': Controls' IDs: ------------------------------------------------------------------";
|
||||
|
@ -248,6 +274,7 @@ 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$ = ""
|
||||
|
|
1409
InForm/xp.uitheme
|
@ -1,6 +1,8 @@
|
|||
MIT License
|
||||
|
||||
Copyright (c) 2016-2019 Fellippe Heitor
|
||||
Copyright (c) 2024 Samuel Gomes
|
||||
Copyright (c) 2023 George McGinn
|
||||
Copyright (c) 2022 Fellippe Heitor
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
|
|
129
README.md
|
@ -1,35 +1,110 @@
|
|||
# INFORM-PE
|
||||
|
||||
![InForm logo](InForm/resources/Application-icon-128.png)
|
||||
|
||||
# InForm
|
||||
A GUI engine and WYSIWYG interface designer for QB64
|
||||
[InForm-PE](https://github.com/a740g/InForm-PE) is a GUI engine and WYSIWYG interface designer for [QB64-PE](https://github.com/QB64-Phoenix-Edition/QB64pe). It is a fork of [InForm](https://github.com/FellippeHeitor/InForm), authored by [Fellippe Heitor](https://github.com/FellippeHeitor).
|
||||
|
||||
Wiki: https://github.com/FellippeHeitor/InForm/wiki
|
||||
InForm-PE's main goal is to generate *event-driven* QB64-PE applications. This means that you design a graphical user interface with interactive controls and then write the code to respond to such controls once they are manipulated.
|
||||
|
||||
Official page: https://www.qb64.org/inform
|
||||
Wiki: <https://github.com/a740g/InForm-PE/wiki>
|
||||
|
||||
## Event-driven QB64 programs
|
||||
InForm's main goal is to generate event-driven QB64 applications. This means that you design a graphical user interface with interactive controls and then write the code to respond to such controls once they are manipulated.
|
||||
## FEATURES
|
||||
|
||||
## Workflow
|
||||
After your form looks the way you want it to, click File -> Save to export its contents and generate a .bas source file. Two files are output:
|
||||
* **.frm**
|
||||
the generated form in QB64 code. This can be loaded back into InForm's designer or manually edited in QB64 or any text editor later, if you want to adjust fine details.
|
||||
|
||||
* **.bas**
|
||||
the actual program you will add your code to.
|
||||
- WYSIWYG interface designer
|
||||
- Event-driven application design
|
||||
- Works on Windows, Linux & macOS
|
||||
- Everything is statically linked (no shared library dependencies)
|
||||
|
||||
### You add code to respond to events:
|
||||
* *Click*
|
||||
* *MouseEnter/MouseLeave* (hover)
|
||||
* *FocusIn/FocusOut*
|
||||
* *MouseDown/MouseUp* (events preceding a Click)
|
||||
* *KeyPress*
|
||||
* *TextChanged* (for text box controls)
|
||||
* *ValueChanged* (for track bars, lists and dropdown lists)
|
||||
## USAGE
|
||||
|
||||
### There are also events that occur in specific moments, to which you can respond/add code:
|
||||
* *BeforeInit*, triggered just before the form is shown.
|
||||
* *OnLoad*, triggered right after the form is first shown.
|
||||
* *BeforeUpdateDisplay*, triggered everytime the form is about to be repainted.
|
||||
* *BeforeUnload*, triggered when the user tries to close the program, either via clicking the window's X button, right click in the task bar -> Close or with Alt+F4 (Windows only).
|
||||
* *FormResized*, triggered when a form with the CanResize property is resized at runtime.
|
||||
Install InForm-PE and QB64-PE side-by-side in their own directories. There is no need to copy InForm-PE files to the QB64-PE directory.
|
||||
|
||||
> The following directory setup is recommended
|
||||
|
||||
```text
|
||||
<some-drive-or-directory>
|
||||
|
|
||||
|-------<InForm-PE>
|
||||
| |
|
||||
| |-------<UiEditor[.exe]>
|
||||
|
|
||||
|-------<QB64pe>
|
||||
|
|
||||
|-------<qb64pe[.exe]>
|
||||
```
|
||||
|
||||
Assuming your setup is like the above, do the following:
|
||||
|
||||
- Open Terminal and change to the InForm-PE directory using an appropriate OS command
|
||||
- Run `setup_inform_lnx.sh`, `setup_inform_osx.command` or `setup_inform_win.cmd` depending on the OS you are on. This will run make with the correct parameters. If the build fails, ensure QB64-PE is installed in the **QB64pe** directory (next to the InForm-PE directory). If QB64-PE is installed elsewhere, then edit the setup scripts to change the location
|
||||
- Once InForm-PE is compiled, you will find the UiEditor[.exe] executable in the InForm-PE directory
|
||||
- Run UiEditor[.exe] to start designing your forms
|
||||
- After your form looks the way you want it to, click **File > Save** to export its contents and generate a **.bas** source file. Two files are exported:
|
||||
- **.frm** - the generated form in QB64-PE code. This can be loaded back into InForm-PE's designer or manually edited in QB64-PE or any text editor later, if you want to adjust fine details
|
||||
- **.bas** - the actual program you will add your code to
|
||||
|
||||
***You add code to respond to events.***
|
||||
|
||||
- *Click*
|
||||
- *MouseEnter/MouseLeave* (hover)
|
||||
- *FocusIn/FocusOut*
|
||||
- *MouseDown/MouseUp* (events preceding a Click)
|
||||
- *KeyPress*
|
||||
- *TextChanged* (for text box controls)
|
||||
- *ValueChanged* (for track bars, lists and dropdown lists)
|
||||
|
||||
***There are also events that occur in specific moments, to which you can respond/add code.***
|
||||
|
||||
- *BeforeInit*, triggered just before the form is shown.
|
||||
- *OnLoad*, triggered right after the form is first shown.
|
||||
- *BeforeUpdateDisplay*, triggered every time the form is about to be repainted.
|
||||
- *BeforeUnload*, triggered when the user tries to close the program, either via clicking the window's X button, right click in the task bar -> Close or with Alt+F4 (Windows only).
|
||||
- *FormResized*, triggered when a form with the CanResize property is resized at runtime.
|
||||
|
||||
***IMPORTANT: The following files must be copied to your project directory for it to compile.***
|
||||
|
||||
```text
|
||||
InForm/InForm.bi
|
||||
InForm/InForm.ui
|
||||
InForm/InFormCommon.bi
|
||||
InForm/InFormVersion.bi
|
||||
InForm/xp.uitheme
|
||||
InForm/extensions/*.*
|
||||
```
|
||||
|
||||
## EXAMPLES
|
||||
|
||||
| Name | Author |
|
||||
|------|-------------|
|
||||
| Bin2Include | Zachary Spriggs |
|
||||
| Calculator | Terry Ritchie |
|
||||
| ClickTheVoid | Fellippe Heitor |
|
||||
| ClockPatience | Richard Notley |
|
||||
| DuckShoot | Richard Notley |
|
||||
| ebacCalculator | George McGinn |
|
||||
| Fahrenheit-Celsius | Richard Notley |
|
||||
| Fireworks2 | Fellippe Heitor |
|
||||
| GIFPlaySample | Fellippe Heitor |
|
||||
| GravitationSimulation | Richard Notley |
|
||||
| InFormPaint | Fellippe Heitor |
|
||||
| InsideOutsideTriangle | Richard Notley |
|
||||
| Lander1 | B+ |
|
||||
| Lander2 | B+ |
|
||||
| Mahjong | Richard Notley |
|
||||
| MasterMindGuessTheSequence | TempodiBasic |
|
||||
| Pelmanism | Richard Notley |
|
||||
| PictureGrid | Richard Notley |
|
||||
| PlayFX | Samuel Gomes |
|
||||
| RockPaperScissorsSpockLizard | TempodiBasic |
|
||||
| Stopwatch | Fellippe Heitor |
|
||||
| TextFetch | B+ |
|
||||
| ThemePreview | Fellippe Heitor |
|
||||
| TicTacToe | Fellippe Heitor |
|
||||
| TicTacToe2 | Fellippe Heitor |
|
||||
| Trackword | Richard Notley |
|
||||
| WordClock | Fellippe Heitor |
|
||||
| wordSearch | George McGinn |
|
||||
|
||||
## NOTES
|
||||
|
||||
- This requires the latest version of [QB64-PE](https://github.com/QB64-Phoenix-Edition/QB64pe/releases/latest). QB64, or other forks of QB64 will not work!
|
||||
|
|
145
docs/GIFPlay.md
Normal file
|
@ -0,0 +1,145 @@
|
|||
# Animated GIF Player Library
|
||||
|
||||
***By [a740g](https://github.com/a740g)***
|
||||
|
||||
## Usage instructions
|
||||
|
||||
You can use the Library either standalone or with InForm-PE.
|
||||
|
||||
### Standalone
|
||||
|
||||
```vb
|
||||
' At the top of your code include GIFPlay.bi
|
||||
'$INCLUDE:'GIFPlay.bi'
|
||||
|
||||
' Your code here...
|
||||
|
||||
' At the bottom of your code include GIFPlay.bas
|
||||
'$INCLUDE:'GIFPlay.bas'
|
||||
```
|
||||
|
||||
### With InForm-PE
|
||||
|
||||
Your form must contain a PictureBox control that'll serve as a container for the GIF file you'll load with this library.
|
||||
In the **External modules section** of the .bas file generated by InForm, `$INCLUDE` both `GIFPlay.bi` and `GIFPlay.bas`.
|
||||
The first must come ***before*** the line that includes `InForm.ui` and the second must come after that, as in the sample below:
|
||||
|
||||
```vb
|
||||
': External modules: --------------------------------
|
||||
'$INCLUDE:'InForm/extensions/GIFPlay.bi'
|
||||
'$INCLUDE:'InForm/InForm.ui'
|
||||
'$INCLUDE:'InForm/xp.uitheme'
|
||||
'$INCLUDE:'gifplaySample.frm'
|
||||
'$INCLUDE:'InForm/extensions/GIFPlay.bas'
|
||||
```
|
||||
|
||||
## API
|
||||
|
||||
```vb
|
||||
FUNCTION GIF_LoadFromFile%% (Id AS LONG, fileName AS STRING)
|
||||
FUNCTION GIF_LoadFromMemory%% (Id AS LONG, buffer AS STRING)
|
||||
```
|
||||
|
||||
GIF_LoadFromFile is a function that takes a PictureBox control ID (or any unique ID) and a GIF file name and returns True if loading the animation is successful.
|
||||
GIF_LoadFromMemory does the same. However, it loads the animation from a STRING buffer.
|
||||
|
||||
```vb
|
||||
SUB GIF_Free (Id AS LONG)
|
||||
```
|
||||
|
||||
Frees resources used by the GIF file loaded previously using GIF_LoadFromFile or GIF_LoadFromMemory.
|
||||
|
||||
```vb
|
||||
FUNCTION GIF_IsLoaded%% (Id AS LONG)
|
||||
```
|
||||
|
||||
Returns True if GIF file is completely loaded and ready for use.
|
||||
|
||||
```vb
|
||||
FUNCTION GIF_GetWidth~& (Id AS LONG)
|
||||
```
|
||||
|
||||
Returns the width of the GIF in pixels.
|
||||
|
||||
```vb
|
||||
FUNCTION GIF_GetHeight~& (Id AS LONG)
|
||||
```
|
||||
|
||||
Returns the height of the GIF in pixels.
|
||||
|
||||
```vb
|
||||
FUNCTION GIF_GetFrameNumber~& (Id AS LONG)
|
||||
```
|
||||
|
||||
Returns the number of currently playing frame.
|
||||
|
||||
```vb
|
||||
FUNCTION GIF_GetTotalFrames~& (Id AS LONG)
|
||||
```
|
||||
|
||||
Returns the total number of frames in a loaded GIF. If not an animated GIF, it returns 1.
|
||||
|
||||
```vb
|
||||
FUNCTION GIF_IsPlaying%% (Id AS LONG)
|
||||
```
|
||||
|
||||
Returns True if a GIF is currently being played.
|
||||
|
||||
```vb
|
||||
SUB GIF_Play (Id AS LONG)
|
||||
SUB GIF_Pause (Id AS LONG)
|
||||
SUB GIF_Stop (Id AS LONG)
|
||||
```
|
||||
|
||||
Starts, pauses or stops playback of a loaded GIF file.
|
||||
|
||||
```vb
|
||||
FUNCTION GIF_GetTotalDuration~&& (Id AS LONG)
|
||||
```
|
||||
|
||||
Returns the total runtime of the animation in ms.
|
||||
|
||||
```vb
|
||||
FUNCTION GIF_GetFrameDuration~&& (Id AS LONG)
|
||||
```
|
||||
|
||||
Returns the total runtime of the current frame in ms.
|
||||
|
||||
```vb
|
||||
FUNCTION GIF_GetElapsedTime~&& (Id AS LONG)
|
||||
```
|
||||
|
||||
Returns the current runtime of the animation in ms.
|
||||
|
||||
```vb
|
||||
SUB GIF_SetLoop (Id AS LONG, loops AS LONG)
|
||||
```
|
||||
|
||||
Set the looping behavior, where < 0 means play once, 0 means loop forever and +n means loop n times.
|
||||
|
||||
```vb
|
||||
SUB GIF_Draw (Id AS LONG)
|
||||
```
|
||||
|
||||
Draws the current frame on a destination surface @ (0, 0) (stretching the frame if needed).
|
||||
GIF_Draw must be called from within the __UI_BeforeUpdateDisplay event. That's where the frames will be updated in your PictureBox control.
|
||||
|
||||
```vb
|
||||
FUNCTION GIF_GetFrame& (Id AS LONG)
|
||||
```
|
||||
|
||||
Returns the current rendered frame image to be played. Playback is time sensitive so frames may be skipped or the last frame may be returned.
|
||||
Use this if you want to do your own final _PUTIMAGE. Do not free the image. The library will do that when it is no longer needed.
|
||||
|
||||
```vb
|
||||
FUNCTION GIF_GetBackgroundColor~& (Id AS LONG)
|
||||
```
|
||||
|
||||
Returns the background color that should be used to clear the surface before drawing the final rendered frame.
|
||||
Use this if you want to do your own final _PUTIMAGE.
|
||||
|
||||
```vb
|
||||
SUB GIF_EnableOverlay (Id AS LONG, isEnabled AS _BYTE)
|
||||
```
|
||||
|
||||
Hides the **GIF** overlay image when the GIF is not playing or paused.
|
|
@ -1,6 +1,7 @@
|
|||
InForm - GUI library for QB64
|
||||
Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
|
||||
https://github.com/FellippeHeitor/InForm
|
||||
|
||||
-----------------------------------------------------------
|
||||
Below is the binary format for exchange of controls data. It is
|
||||
used for UiEditorPreview.frmbin, which is read/written to by both
|
||||
|
@ -86,4 +87,4 @@ FOR EACH CONTROL (FORM INCLUDED):
|
|||
INTEGER -48 (BoundTo) + INTEGER Which control + INTEGER Which
|
||||
Property
|
||||
-------------------
|
||||
INTEGER -1024 (End of file)
|
||||
INTEGER -1024 (End of file)
|
1
docs/wiki
Submodule
|
@ -0,0 +1 @@
|
|||
Subproject commit 3fdcd29cf67deba354ffd0848dd68a50da5dc93a
|
715
examples/Bin2Include/BIN2INCLUDE.bas
Normal file
|
@ -0,0 +1,715 @@
|
|||
': This program uses
|
||||
': InForm - GUI library for QB64 - v1.5
|
||||
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
|
||||
$VERSIONINFO:CompanyName='SpriggsySpriggs'
|
||||
$VERSIONINFO:FileDescription='Converts a binary file into an INCLUDE-able'
|
||||
$VERSIONINFO:LegalCopyright='(c) 2019-2020 SpriggsySpriggs'
|
||||
$VERSIONINFO:ProductName='BIN2INCLUDE'
|
||||
$VERSIONINFO:InternalName='BIN2INCLUDE'
|
||||
$VERSIONINFO:OriginalFilename='BIN2INCLUDE.exe'
|
||||
$VERSIONINFO:Web='https://github.com/a740g/QB64-Museum/tree/main/SpriggsySpriggs/Bin2Include'
|
||||
$VERSIONINFO:Comments='QB64-PE and InForm-PE port by a740g'
|
||||
$VERSIONINFO:FILEVERSION#=2,6,0,0
|
||||
$VERSIONINFO:PRODUCTVERSION#=2,6,0,0
|
||||
|
||||
OPTION _EXPLICIT
|
||||
|
||||
$EXEICON:'./BIN2INCLUDE.ico'
|
||||
|
||||
': Controls' IDs: ------------------------------------------------------------------
|
||||
DIM SHARED BIN2INCLUDE AS LONG
|
||||
DIM SHARED SelectedFileTB AS LONG
|
||||
DIM SHARED OpenBT AS LONG
|
||||
DIM SHARED SaveBT AS LONG
|
||||
DIM SHARED CONVERTBT AS LONG
|
||||
DIM SHARED OutputFileTB AS LONG
|
||||
DIM SHARED ListBox1 AS LONG
|
||||
DIM SHARED ClearLogBT AS LONG
|
||||
DIM SHARED BIN2BASRB AS LONG
|
||||
DIM SHARED PIC2MEMRB AS LONG
|
||||
DIM SHARED ResetBT AS LONG
|
||||
|
||||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'BIN2INCLUDE.frm'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Custom procedures: --------------------------------------------------------------
|
||||
FUNCTION checkExt%% (OFile$)
|
||||
IF UCASE$(RIGHT$(OFile$, 4)) <> ".BMP" AND UCASE$(RIGHT$(OFile$, 4)) <> ".JPG" _
|
||||
AND UCASE$(RIGHT$(OFile$, 4)) <> ".PNG" AND UCASE$(RIGHT$(OFile$, 5)) <> ".JPEG" _
|
||||
AND UCASE$(RIGHT$(OFile$, 4)) <> ".GIF" THEN
|
||||
checkExt = FALSE
|
||||
ELSE
|
||||
checkExt = TRUE
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION ReplaceString$ (a AS STRING, b AS STRING, c AS STRING)
|
||||
DIM j AS LONG: j = INSTR(a, b)
|
||||
DIM r AS STRING
|
||||
IF j > 0 THEN
|
||||
r = LEFT$(a, j - 1) + c + ReplaceString(RIGHT$(a, LEN(a) - j + 1 - LEN(b)), b, c)
|
||||
ELSE
|
||||
r = a
|
||||
END IF
|
||||
ReplaceString = r
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION StripDirectory$ (s AS STRING)
|
||||
DIM t AS STRING: t = MID$(s, _INSTRREV(s, "\") + 1)
|
||||
StripDirectory = t
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION E$ (BS AS STRING)
|
||||
DIM AS LONG t, b
|
||||
|
||||
FOR t = LEN(BS) TO 1 STEP -1
|
||||
b = b * 256 + ASC(MID$(BS, t))
|
||||
NEXT
|
||||
|
||||
DIM AS STRING a, g
|
||||
|
||||
FOR t = 1 TO LEN(BS) + 1
|
||||
g = CHR$(48 + (b AND 63)): b = b \ 64
|
||||
IF g = "@" THEN g = "#"
|
||||
a = a + g
|
||||
NEXT
|
||||
|
||||
E = a
|
||||
END FUNCTION
|
||||
|
||||
SUB bin2bas (IN$, OUT$)
|
||||
OPEN IN$ FOR BINARY AS 1
|
||||
IF LOF(1) = 0 THEN
|
||||
CLOSE 1
|
||||
ELSE
|
||||
DIM INDATA$: INDATA$ = (INPUT$(LOF(1), 1))
|
||||
INDATA$ = _DEFLATE$(INDATA$)
|
||||
OPEN OUT$ FOR OUTPUT AS 2
|
||||
DIM Q$: Q$ = CHR$(34) 'quotation mark
|
||||
DIM inFunc$: inFunc$ = LEFT$(IN$, LEN(IN$) - 4)
|
||||
DIM i AS LONG
|
||||
FOR i = 32 TO 64
|
||||
IF INSTR(inFunc$, CHR$(i)) THEN
|
||||
inFunc$ = ReplaceString(inFunc$, CHR$(i), "")
|
||||
END IF
|
||||
NEXT
|
||||
FOR i = 91 TO 96
|
||||
IF INSTR(inFunc$, CHR$(i)) THEN
|
||||
IF i <> 92 THEN
|
||||
inFunc$ = ReplaceString(inFunc$, CHR$(i), "")
|
||||
END IF
|
||||
END IF
|
||||
NEXT
|
||||
PRINT #2, "SUB __" + StripDirectory(inFunc$)
|
||||
PRINT #2, "IF NOT _FILEEXISTS(" + Q$ + StripDirectory(IN$) + Q$ + ") THEN"
|
||||
AddItem ListBox1, TIME$ + ": Opening file: " + IN$
|
||||
AddItem ListBox1, TIME$ + ": Processing file..."
|
||||
PRINT #2, "DIM A$:A$="; Q$;
|
||||
AddItem ListBox1, TIME$ + ": Converting lines..."
|
||||
DIM BC&: BC& = 1
|
||||
DO
|
||||
DIM a$: a$ = MID$(INDATA$, BC&, 3)
|
||||
BC& = BC& + 3
|
||||
DIM LL&: LL& = LL& + 4
|
||||
IF LL& = 60 THEN
|
||||
LL& = 0
|
||||
PRINT #2, E$(a$);
|
||||
PRINT #2, Q$
|
||||
PRINT #2, "A$=A$+"; Q$;
|
||||
ELSE
|
||||
PRINT #2, E$(a$);
|
||||
END IF
|
||||
IF LEN(INDATA$) - BC& < 3 THEN
|
||||
a$ = MID$(INDATA$, LEN(INDATA$) - BC&, 1)
|
||||
DIM B$: B$ = E$(a$)
|
||||
SELECT CASE LEN(B$)
|
||||
CASE 0: a$ = Q$
|
||||
CASE 1: a$ = "%%%" + B$ + Q$
|
||||
CASE 2: a$ = "%%" + B$ + Q$
|
||||
CASE 3: a$ = "%" + B$ + Q$
|
||||
END SELECT:
|
||||
PRINT #2, a$;
|
||||
EXIT DO
|
||||
END IF
|
||||
LOOP
|
||||
PRINT #2, ""
|
||||
AddItem ListBox1, TIME$ + ": DONE"
|
||||
AddItem ListBox1, TIME$ + ": Writing decoding function to file..."
|
||||
PRINT #2, "DIM btemp$,i&,B$,C%,F$,C$,j,t%,B&,X$,BASFILE$"
|
||||
PRINT #2, "FOR i&=1TO LEN(A$) STEP 4"
|
||||
PRINT #2, "B$=MID$(A$,i&,4)"
|
||||
PRINT #2, "IF INSTR(1,B$,"; Q$; "%"; Q$; ") THEN"
|
||||
PRINT #2, "FOR C%=1 TO LEN(B$)"
|
||||
PRINT #2, "F$=MID$(B$,C%,1)"
|
||||
PRINT #2, "IF F$<>"; Q$; "%"; Q$; "THEN C$=C$+F$"
|
||||
PRINT #2, "NEXT"
|
||||
PRINT #2, "B$=C$"
|
||||
PRINT #2, "END IF"
|
||||
PRINT #2, "FOR j=1 TO LEN(B$)"
|
||||
PRINT #2, "IF MID$(B$,j,1)="; Q$; "#"; Q$; " THEN"
|
||||
PRINT #2, "MID$(B$,j)="; Q$; "@"; Q$
|
||||
PRINT #2, "END IF"
|
||||
PRINT #2, "NEXT"
|
||||
PRINT #2, "FOR t%=LEN(B$) TO 1 STEP-1"
|
||||
PRINT #2, "B&=B&*64+ASC(MID$(B$,t%))-48"
|
||||
PRINT #2, "NEXT"
|
||||
PRINT #2, "X$="; Q$; Q$
|
||||
PRINT #2, "FOR t%=1 TO LEN(B$)-1"
|
||||
PRINT #2, "X$=X$+CHR$(B& AND 255)"
|
||||
PRINT #2, "B&=B&\256"
|
||||
PRINT #2, "NEXT"
|
||||
PRINT #2, "btemp$=btemp$+X$"
|
||||
PRINT #2, "NEXT"
|
||||
PRINT #2, "BASFILE$=_INFLATE$(btemp$,"; LTRIM$(STR$(LOF(1))); " )"
|
||||
PRINT #2, "DIM FF&: FF&=FREEFILE"
|
||||
PRINT #2, "OPEN "; Q$; StripDirectory(IN$); Q$; " FOR OUTPUT AS #FF&"
|
||||
PRINT #2, "PRINT #FF&, BASFILE$;"
|
||||
PRINT #2, "CLOSE #FF&"
|
||||
PRINT #2, "END IF"
|
||||
PRINT #2, "END SUB"
|
||||
CLOSE #1
|
||||
CLOSE #2
|
||||
AddItem ListBox1, TIME$ + ": DONE"
|
||||
AddItem ListBox1, TIME$ + ": File exported to " + OUT$
|
||||
ToolTip(ListBox1) = TIME$ + ": File exported to " + OUT$
|
||||
Text(SelectedFileTB) = ""
|
||||
Text(OutputFileTB) = ""
|
||||
Control(CONVERTBT).Disabled = TRUE
|
||||
Control(OpenBT).Disabled = TRUE
|
||||
Control(BIN2BASRB).Value = FALSE
|
||||
Control(PIC2MEMRB).Value = FALSE
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB pic2mem (IN$, OUT$)
|
||||
AddItem ListBox1, TIME$ + ": Opening file: " + IN$
|
||||
AddItem ListBox1, TIME$ + ": Processing file..."
|
||||
|
||||
'Load image file to screen mode
|
||||
DIM pic AS LONG: pic = _LOADIMAGE(IN$, 32)
|
||||
DIM m AS _MEM: m = _MEMIMAGE(pic)
|
||||
|
||||
'Grab screen data
|
||||
DIM INDATA$: INDATA$ = SPACE$(m.SIZE)
|
||||
_MEMGET m, m.OFFSET, INDATA$
|
||||
'Compress it
|
||||
INDATA$ = _DEFLATE$(INDATA$)
|
||||
'get screen specs
|
||||
DIM AS LONG wid, hih
|
||||
wid = _WIDTH(pic): hih = _HEIGHT(pic)
|
||||
|
||||
OPEN OUT$ FOR OUTPUT AS 2
|
||||
|
||||
DIM Q$: Q$ = CHR$(34) 'quotation mark
|
||||
DIM inFunc$: inFunc$ = LEFT$(IN$, LEN(IN$) - 4)
|
||||
DIM AS LONG i
|
||||
FOR i = 32 TO 64
|
||||
IF INSTR(inFunc$, CHR$(i)) THEN
|
||||
inFunc$ = ReplaceString(inFunc$, CHR$(i), "")
|
||||
END IF
|
||||
NEXT
|
||||
FOR i = 91 TO 96
|
||||
IF INSTR(inFunc$, CHR$(i)) THEN
|
||||
IF i <> 92 THEN
|
||||
inFunc$ = ReplaceString(inFunc$, CHR$(i), "")
|
||||
END IF
|
||||
END IF
|
||||
NEXT
|
||||
PRINT #2, "FUNCTION __" + StripDirectory(inFunc$) + "&"
|
||||
PRINT #2, "DIM A$,btemp$,i&,B$,C%,F$,C$,j,t%,B&,X$"
|
||||
PRINT #2, "DIM v&:v&=_NEWIMAGE("; wid; ","; hih; ",32)"
|
||||
PRINT #2, "DIM m AS _MEM:m=_MEMIMAGE(v&)"
|
||||
PRINT #2, "A$="; Q$;
|
||||
|
||||
DIM BC&: BC& = 1
|
||||
|
||||
DO
|
||||
DIM a$: a$ = MID$(INDATA$, BC&, 3)
|
||||
BC& = BC& + 3
|
||||
DIM LL&: LL& = LL& + 4
|
||||
IF LL& = 60 THEN
|
||||
LL& = 0
|
||||
PRINT #2, E$(a$);: PRINT #2, Q$
|
||||
PRINT #2, "A$=A$+"; Q$;
|
||||
ELSE
|
||||
PRINT #2, E$(a$);
|
||||
END IF
|
||||
IF LEN(INDATA$) - BC& < 3 THEN
|
||||
a$ = MID$(INDATA$, LEN(INDATA$) - BC&, 1)
|
||||
DIM B$: B$ = E$(a$)
|
||||
SELECT CASE LEN(B$)
|
||||
CASE 0: a$ = Q$
|
||||
CASE 1: a$ = "%%%" + B$ + Q$
|
||||
CASE 2: a$ = "%%" + B$ + Q$
|
||||
CASE 3: a$ = "%" + B$ + Q$
|
||||
END SELECT: PRINT #2, a$;: EXIT DO
|
||||
END IF
|
||||
LOOP: PRINT #2, ""
|
||||
|
||||
PRINT #2, "FOR i&=1TO LEN(A$) STEP 4"
|
||||
PRINT #2, "B$=MID$(A$,i&,4)"
|
||||
PRINT #2, "IF INSTR(1,B$,"; Q$; "%"; Q$; ") THEN"
|
||||
PRINT #2, "FOR C%=1 TO LEN(B$)"
|
||||
PRINT #2, "F$=MID$(B$,C%,1)"
|
||||
PRINT #2, "IF F$<>"; Q$; "%"; Q$; "THEN C$=C$+F$"
|
||||
PRINT #2, "NEXT"
|
||||
PRINT #2, "B$=C$"
|
||||
PRINT #2, "END IF"
|
||||
PRINT #2, "FOR j=1 TO LEN(B$)"
|
||||
PRINT #2, "IF MID$(B$,j,1)="; Q$; "#"; Q$; " THEN"
|
||||
PRINT #2, "MID$(B$,j)="; Q$; "@"; Q$
|
||||
PRINT #2, "END IF"
|
||||
PRINT #2, "NEXT"
|
||||
PRINT #2, "FOR t%=LEN(B$) TO 1 STEP-1"
|
||||
PRINT #2, "B&=B&*64+ASC(MID$(B$,t%))-48"
|
||||
PRINT #2, "NEXT"
|
||||
PRINT #2, "X$="; Q$; Q$
|
||||
PRINT #2, "FOR t%=1 TO LEN(B$)-1"
|
||||
PRINT #2, "X$=X$+CHR$(B& AND 255)"
|
||||
PRINT #2, "B&=B&\256"
|
||||
PRINT #2, "NEXT"
|
||||
PRINT #2, "btemp$=btemp$+X$"
|
||||
PRINT #2, "NEXT"
|
||||
PRINT #2, "btemp$=_INFLATE$(btemp$,m.SIZE)"
|
||||
PRINT #2, "_MEMPUT m,m.OFFSET,btemp$"
|
||||
PRINT #2, "_MEMFREE m"
|
||||
PRINT #2, "__" + StripDirectory(inFunc$) + "&=v&"
|
||||
PRINT #2, "END FUNCTION"
|
||||
|
||||
CLOSE #2
|
||||
_MEMFREE m
|
||||
_FREEIMAGE pic
|
||||
|
||||
AddItem ListBox1, TIME$ + ": Image converted to MEM successfully"
|
||||
AddItem ListBox1, TIME$ + ": File exported to " + OUT$
|
||||
ToolTip(ListBox1) = TIME$ + ": File exported to " + OUT$
|
||||
Text(SelectedFileTB) = ""
|
||||
Text(OutputFileTB) = ""
|
||||
Control(CONVERTBT).Disabled = TRUE
|
||||
Control(OpenBT).Disabled = TRUE
|
||||
Control(BIN2BASRB).Value = FALSE
|
||||
Control(PIC2MEMRB).Value = FALSE
|
||||
END SUB
|
||||
|
||||
FUNCTION __opensmall&
|
||||
DIM v&
|
||||
DIM A$
|
||||
DIM btemp$
|
||||
DIM i&
|
||||
DIM B$
|
||||
DIM C%
|
||||
DIM F$
|
||||
DIM C$
|
||||
DIM j
|
||||
DIM t%
|
||||
DIM B&
|
||||
DIM X$
|
||||
v& = _NEWIMAGE(16, 16, 32)
|
||||
DIM m AS _MEM: m = _MEMIMAGE(v&)
|
||||
A$ = "haiHP1:6<GPhK34O7Xh[24W99XooS3\jDXng<#lD#3g>#\\4Yna5n^0a\#1j"
|
||||
A$ = A$ + "74FIlXoo0e>^1N`bS5moGPhf0R5Q82c`Vo?66P4V_MPhOCTn3HZ[1PHi0RO>"
|
||||
A$ = A$ + "96><APhU14c7#l59Am^EPHV1RiV18aeTRN_4#<_#moMCRjmY<PJh?XdEKQ8`"
|
||||
A$ = A$ + "K28^IPHa`GT1m600eW8R%%%0"
|
||||
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 j = 1 TO LEN(B$)
|
||||
IF MID$(B$, j, 1) = "#" THEN
|
||||
MID$(B$, j) = "@"
|
||||
END IF
|
||||
NEXT
|
||||
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
|
||||
btemp$ = _INFLATE$(btemp$, m.SIZE)
|
||||
_MEMPUT m, m.OFFSET, btemp$: _MEMFREE m
|
||||
__opensmall& = v&
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION __convert&
|
||||
DIM v&
|
||||
DIM A$
|
||||
DIM btemp$
|
||||
DIM i&
|
||||
DIM B$
|
||||
DIM C%
|
||||
DIM F$
|
||||
DIM C$
|
||||
DIM j
|
||||
DIM t%
|
||||
DIM B&
|
||||
DIM X$
|
||||
v& = _NEWIMAGE(16, 16, 32)
|
||||
DIM m AS _MEM: m = _MEMIMAGE(v&)
|
||||
A$ = "haIM#f6BC6557olUj3A#R44H98hDS4c\b:B]V:Jj23JiCBjl56FKfHVV6[Dc"
|
||||
A$ = A$ + "5R_lm\_F8dl;1Q8EFOaNA4[Xd4eLY=L[mBZK=leIcmfYcARAbcj2ohN_?Wko"
|
||||
A$ = A$ + "O?gkA_NQRd[G#E4#Bc=;7dYk2`2]E5h\MUBMgeEAJN[molNE0fKE1#WAM`PN"
|
||||
A$ = A$ + "`=gLILS=F4GK=Kh#3e?bOW81>?OF2T`2A0RAMX_lThlDm[kcgjX7?^aEFI1d"
|
||||
A$ = A$ + "U[i`16XGT7L=R4_o]_8H]UBUJBW0BcPikDBjdjn8P6J#V6ongPng;7fQ13M7"
|
||||
A$ = A$ + "V2;<QF8P^ZA;<CSbQ>DY1NUVc1CMSRTA0eFKNJ34`;jekJKc1O?hg2G?C5e3"
|
||||
A$ = A$ + "9;X?<2293?_VlH7PJeIGG`Pn#Onl8ba;7n3H^:^fCX<ZnGXlB:^h31bUO##Y"
|
||||
A$ = A$ + "b<^IX#1#onm:bQQGlFLL;^a?>[3L4Sf`QoZE\Wn72Y\Z8T`i;[\CdHX#1a01"
|
||||
A$ = A$ + "l;baSO6Ug\CLhY<Q_KRIaGo5Sh3jMP]j]DFe4988L4Mln8iXWnO3>YEghkoV"
|
||||
A$ = A$ + "U`>J[K3Q9jSOi>b?oh_;ng1kPO;LoPkY?\_1AS>F6oT9kKc1O?hgBlbZ_>9B"
|
||||
A$ = A$ + "f]VDCM?M69B<[26lk;^:>Vii5iH4SfahbGK300kR8V8A<IEIkcm;?h4fL9b1"
|
||||
A$ = A$ + "gCS=gJd=Fa758TmX\C2dVb1P9;9MXf37;\gD??4cI[^9[;i5WNnU4ihcVF0i"
|
||||
A$ = A$ + "jCOUC24m=CYW:MC:>=_6YIYAWB1`nbXbF]_R?L6W[:bahVMQLMcUW1HYR<Cj"
|
||||
A$ = A$ + "7EVeX418\#Pdm?ZXBkBMjLmP8k`jBo6ig2g?hNZA7[RLM>?MN`FEW1LXD:h\"
|
||||
A$ = A$ + "jL`W:;=YDnhfan?FCk<nLjno1EoFo1`f%%L2"
|
||||
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 j = 1 TO LEN(B$)
|
||||
IF MID$(B$, j, 1) = "#" THEN
|
||||
MID$(B$, j) = "@"
|
||||
END IF
|
||||
NEXT
|
||||
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
|
||||
btemp$ = _INFLATE$(btemp$, m.SIZE)
|
||||
_MEMPUT m, m.OFFSET, btemp$: _MEMFREE m
|
||||
__convert& = v&
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION __reset&
|
||||
DIM v&
|
||||
DIM A$
|
||||
DIM btemp$
|
||||
DIM i&
|
||||
DIM B$
|
||||
DIM C%
|
||||
DIM F$
|
||||
DIM C$
|
||||
DIM j
|
||||
DIM t%
|
||||
DIM B&
|
||||
DIM X$
|
||||
v& = _NEWIMAGE(16, 16, 32)
|
||||
DIM m AS _MEM: m = _MEMIMAGE(v&)
|
||||
A$ = "haiHP1J3`03<#1S<bXP<a4C:cHS=>;Pd6B<jc#3=D:PZO10a_08N30aM3D_["
|
||||
A$ = A$ + "58mS0Rg;#\LhB_VK^ib0Dnk3dNKAK]eV7dTVAPVCQP<GPbK;jj=d#3UIPbM9"
|
||||
A$ = A$ + "PbE0bRS^J1jnL6Xj^WeFK=_PhkP3>`2#ni3DM12TNoXK^05ki0MGRSVI>IPR"
|
||||
A$ = A$ + "g3<g5#fG6Tj0jnf3#jSPVnOQYVJZ4Xi6<1Xh?59eh6#lo1R_6#\bX[O#f5#k"
|
||||
A$ = A$ + "\NPH=19V:ZX2k05kGjYWNL3CM0]kT0:6oXkn19>#L3Pd?#ie0GjWD0Xkn9E0"
|
||||
A$ = A$ + "JQOTZM3>n3;Y?84P9Pj[8LUn1G0PZ=EPjIM4CjG\10Znh1Rc4HJ038Ag;A10"
|
||||
A$ = A$ + "0lQl%%h1"
|
||||
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 j = 1 TO LEN(B$)
|
||||
IF MID$(B$, j, 1) = "#" THEN
|
||||
MID$(B$, j) = "@"
|
||||
END IF
|
||||
NEXT
|
||||
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
|
||||
btemp$ = _INFLATE$(btemp$, m.SIZE)
|
||||
_MEMPUT m, m.OFFSET, btemp$: _MEMFREE m
|
||||
__reset& = v&
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION __deletesmall&
|
||||
DIM v&
|
||||
DIM A$
|
||||
DIM btemp$
|
||||
DIM i&
|
||||
DIM B$
|
||||
DIM C%
|
||||
DIM F$
|
||||
DIM C$
|
||||
DIM j
|
||||
DIM t%
|
||||
DIM B&
|
||||
DIM X$
|
||||
v& = _NEWIMAGE(16, 16, 32)
|
||||
DIM m AS _MEM: m = _MEMIMAGE(v&)
|
||||
A$ = "haiHP1D16JXQm04o7S=fhoS<6ZHMa010PDWEFI5_X;>8a0:g_aVN<b8Sj3Kf"
|
||||
A$ = A$ + "9^`PD;#md9Q\CL1PjFn5BjoG0=g68Al?ABon2e]A\jmo0MonP\K2TH#Y;28^"
|
||||
A$ = A$ + "#THG4d`XRQa6VJaQn1K74PmXjWfYo=1<^J34P=fdo[0:_iX;>j0C<a4[0VNk"
|
||||
A$ = A$ + "5HAon34oBR8_c;0UN5Vn04BU%%h1"
|
||||
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 j = 1 TO LEN(B$)
|
||||
IF MID$(B$, j, 1) = "#" THEN
|
||||
MID$(B$, j) = "@"
|
||||
END IF
|
||||
NEXT
|
||||
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
|
||||
btemp$ = _INFLATE$(btemp$, m.SIZE)
|
||||
_MEMPUT m, m.OFFSET, btemp$: _MEMFREE m
|
||||
__deletesmall& = v&
|
||||
END FUNCTION
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
END SUB
|
||||
|
||||
SUB __UI_OnLoad
|
||||
Control(OpenBT).HelperCanvas = __opensmall&
|
||||
Control(CONVERTBT).HelperCanvas = __convert&
|
||||
Control(ResetBT).HelperCanvas = __reset&
|
||||
Control(ClearLogBT).HelperCanvas = __deletesmall&
|
||||
Control(OpenBT).Disabled = TRUE
|
||||
SetFrameRate 60
|
||||
_ACCEPTFILEDROP
|
||||
AddItem ListBox1, "Open a file above or drag and drop."
|
||||
AddItem ListBox1, "Select BIN2BAS to convert a binary file to BM or select PIC2MEM to convert an image to MEM."
|
||||
AddItem ListBox1, "To compile a file that is creating memory errors,"
|
||||
AddItem ListBox1, "consult the readme on https://github.com/SpriggsySpriggs/BIN2INCLUDE"
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUpdateDisplay
|
||||
IF _TOTALDROPPEDFILES THEN
|
||||
DIM drop$: drop$ = _DROPPEDFILE
|
||||
IF _FILEEXISTS(drop$) THEN
|
||||
IF NOT checkExt(drop$) AND Control(PIC2MEMRB).Value = FALSE THEN
|
||||
Control(BIN2BASRB).Value = TRUE
|
||||
Control(PIC2MEMRB).Disabled = TRUE
|
||||
Text(SelectedFileTB) = drop$
|
||||
Text(OutputFileTB) = drop$ + ".BM"
|
||||
Control(CONVERTBT).Disabled = FALSE
|
||||
ELSEIF checkExt(drop$) AND Control(PIC2MEMRB).Value = TRUE THEN
|
||||
Control(BIN2BASRB).Disabled = TRUE
|
||||
Text(SelectedFileTB) = drop$
|
||||
Text(OutputFileTB) = drop$ + ".MEM"
|
||||
Control(CONVERTBT).Disabled = FALSE
|
||||
ELSEIF checkExt(drop$) = 0 AND Control(PIC2MEMRB).Value = TRUE THEN
|
||||
MessageBox "Unsupported file type for PIC2MEM", Caption(BIN2INCLUDE), MsgBox_Critical
|
||||
Control(BIN2BASRB).Disabled = FALSE
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUnload
|
||||
END SUB
|
||||
|
||||
SUB __UI_Click (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE BIN2INCLUDE
|
||||
CASE SelectedFileTB
|
||||
CASE OpenBT
|
||||
IF Control(BIN2BASRB).Value = TRUE THEN
|
||||
_DELAY 0.2 ' delay a bit to allow InFrom to draw and refresh all comtrols before the modal dialog box takes over
|
||||
DIM oFile$: oFile$ = _OPENFILEDIALOG$(Caption(BIN2INCLUDE) + ": Open")
|
||||
Control(PIC2MEMRB).Disabled = TRUE
|
||||
ELSEIF Control(PIC2MEMRB).Value = TRUE THEN
|
||||
_DELAY 0.2 ' delay a bit to allow InFrom to draw and refresh all comtrols before the modal dialog box takes over
|
||||
oFile$ = _OPENFILEDIALOG$(Caption(BIN2INCLUDE) + ": Open", , "*.BMP|*.bmp|*.JPG|*.jpg|*.JPEG|*.jpeg|*.PNG|*.png|*.GIF|*.gif", "Supported image files")
|
||||
Control(BIN2BASRB).Disabled = TRUE
|
||||
END IF
|
||||
IF oFile$ <> "" THEN
|
||||
IF checkExt(oFile$) = 0 AND Control(PIC2MEMRB).Value = TRUE THEN
|
||||
MessageBox "Unsupported file type for PIC2MEM", Caption(BIN2INCLUDE), MsgBox_Critical
|
||||
Control(BIN2BASRB).Disabled = FALSE
|
||||
ELSEIF checkExt(oFile$) AND Control(PIC2MEMRB).Value = TRUE THEN
|
||||
Control(CONVERTBT).Disabled = FALSE
|
||||
Text(SelectedFileTB) = oFile$
|
||||
Text(OutputFileTB) = oFile$ + ".MEM"
|
||||
ELSE
|
||||
Control(CONVERTBT).Disabled = FALSE
|
||||
Text(SelectedFileTB) = oFile$
|
||||
Text(OutputFileTB) = oFile$ + ".BM"
|
||||
END IF
|
||||
ELSE
|
||||
Text(SelectedFileTB) = ""
|
||||
Text(OutputFileTB) = ""
|
||||
Control(BIN2BASRB).Disabled = FALSE
|
||||
Control(PIC2MEMRB).Disabled = FALSE
|
||||
Control(CONVERTBT).Disabled = TRUE
|
||||
END IF
|
||||
CASE CONVERTBT
|
||||
IF Control(BIN2BASRB).Value = TRUE THEN
|
||||
Caption(BIN2INCLUDE) = Caption(BIN2INCLUDE) + " - WORKING..."
|
||||
bin2bas Text(SelectedFileTB), Text(OutputFileTB)
|
||||
Control(PIC2MEMRB).Disabled = FALSE
|
||||
Caption(BIN2INCLUDE) = "BIN2INCLUDE"
|
||||
ELSEIF Control(PIC2MEMRB).Value = TRUE THEN
|
||||
Caption(BIN2INCLUDE) = Caption(BIN2INCLUDE) + " - WORKING..."
|
||||
pic2mem Text(SelectedFileTB), Text(OutputFileTB)
|
||||
Control(BIN2BASRB).Disabled = FALSE
|
||||
Caption(BIN2INCLUDE) = "BIN2INCLUDE"
|
||||
ELSE
|
||||
MessageBox "Select an option BIN2BAS or PIC2MEM first.", Caption(BIN2INCLUDE), MsgBox_Exclamation
|
||||
END IF
|
||||
CASE OutputFileTB
|
||||
CASE ListBox1
|
||||
CASE ClearLogBT
|
||||
ResetList ListBox1
|
||||
CASE ResetBT
|
||||
ResetScreen
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB ResetScreen
|
||||
Text(SelectedFileTB) = ""
|
||||
Text(OutputFileTB) = ""
|
||||
Control(BIN2BASRB).Disabled = FALSE
|
||||
Control(PIC2MEMRB).Disabled = FALSE
|
||||
Control(CONVERTBT).Disabled = TRUE
|
||||
ToolTip(ListBox1) = ""
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseEnter (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE BIN2INCLUDE
|
||||
CASE SelectedFileTB
|
||||
CASE OpenBT
|
||||
CASE CONVERTBT
|
||||
CASE SaveBT
|
||||
CASE OutputFileTB
|
||||
CASE ListBox1
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseLeave (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE BIN2INCLUDE
|
||||
CASE SelectedFileTB
|
||||
CASE OpenBT
|
||||
CASE CONVERTBT
|
||||
CASE SaveBT
|
||||
CASE OutputFileTB
|
||||
CASE ListBox1
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusIn (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE SelectedFileTB
|
||||
CASE OpenBT
|
||||
CASE CONVERTBT
|
||||
CASE SaveBT
|
||||
CASE OutputFileTB
|
||||
CASE ListBox1
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusOut (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE SelectedFileTB
|
||||
CASE OpenBT
|
||||
CASE CONVERTBT
|
||||
CASE SaveBT
|
||||
CASE OutputFileTB
|
||||
CASE ListBox1
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseDown (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE BIN2INCLUDE
|
||||
CASE SelectedFileTB
|
||||
CASE OpenBT
|
||||
CASE CONVERTBT
|
||||
CASE SaveBT
|
||||
CASE OutputFileTB
|
||||
CASE ListBox1
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseUp (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE BIN2INCLUDE
|
||||
CASE SelectedFileTB
|
||||
CASE OpenBT
|
||||
CASE CONVERTBT
|
||||
CASE SaveBT
|
||||
CASE OutputFileTB
|
||||
CASE ListBox1
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_KeyPress (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE SelectedFileTB
|
||||
CASE OpenBT
|
||||
CASE CONVERTBT
|
||||
CASE OutputFileTB
|
||||
CASE ListBox1
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_TextChanged (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE SelectedFileTB
|
||||
CASE OutputFileTB
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_ValueChanged (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE ListBox1
|
||||
CASE BIN2BASRB
|
||||
Control(OpenBT).Disabled = FALSE
|
||||
_TITLE "BIN2INCLUDE - BIN2BAS"
|
||||
CASE PIC2MEMRB
|
||||
Control(OpenBT).Disabled = FALSE
|
||||
_TITLE "BIN2INCLUDE - PIC2MEM"
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
90
examples/Bin2Include/BIN2INCLUDE.frm
Normal file
|
@ -0,0 +1,90 @@
|
|||
': This form was generated by
|
||||
': InForm - GUI library for QB64 - v1.5
|
||||
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
SUB __UI_LoadForm
|
||||
|
||||
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Form, "BIN2INCLUDE", 589, 324, 0, 0, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "BIN2INCLUDE"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 12)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CenteredWindow = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_TextBox, "SelectedFileTB", 567, 23, 11, 10, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Selected File"
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).Disabled = True
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "OpenBT", 80, 23, 11, 78, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Open"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "CONVERTBT", 80, 23, 96, 78, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Convert"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).Disabled = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_TextBox, "OutputFileTB", 567, 23, 11, 38, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Output File"
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).Disabled = True
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_ListBox, "ListBox1", 567, 200, 11, 114, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
Control(__UI_NewID).AutoScroll = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "ClearLogBT", 80, 23, 498, 78, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Clear Log"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "BIN2BASRB", 76, 23, 189, 78, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "BIN2BAS"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "PIC2MEMRB", 82, 23, 270, 78, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "PIC2MEM"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "ResetBT", 80, 23, 413, 78, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Reset"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_AssignIDs
|
||||
BIN2INCLUDE = __UI_GetID("BIN2INCLUDE")
|
||||
SelectedFileTB = __UI_GetID("SelectedFileTB")
|
||||
OpenBT = __UI_GetID("OpenBT")
|
||||
CONVERTBT = __UI_GetID("CONVERTBT")
|
||||
OutputFileTB = __UI_GetID("OutputFileTB")
|
||||
ListBox1 = __UI_GetID("ListBox1")
|
||||
ClearLogBT = __UI_GetID("ClearLogBT")
|
||||
BIN2BASRB = __UI_GetID("BIN2BASRB")
|
||||
PIC2MEMRB = __UI_GetID("PIC2MEMRB")
|
||||
ResetBT = __UI_GetID("ResetBT")
|
||||
END SUB
|
BIN
examples/Bin2Include/BIN2INCLUDE.ico
Normal file
After Width: | Height: | Size: 7.8 KiB |
1043
examples/Calculator/Calculator.bas
Normal file
293
examples/Calculator/Calculator.frm
Normal file
|
@ -0,0 +1,293 @@
|
|||
': This form was generated by
|
||||
': InForm - GUI library for QB64 - v1.5
|
||||
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
SUB __UI_LoadForm
|
||||
|
||||
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Form, "Calculator", 235, 265, 0, 0, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Calculator"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 12)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "frmResults", 220, 51, 8, 36, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Value = 3
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_MenuBar, "mnuEdit", 36, 23, 8, 0, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "&Edit"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_MenuBar, "mnuHelp", 41, 23, 44, 0, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Help"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butMC", 40, 23, 8, 92, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "MC"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butMR", 40, 23, 53, 92, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "MR"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butMS", 40, 23, 98, 92, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "MS"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butMplus", 40, 23, 143, 92, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "M+"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butMminus", 40, 23, 188, 92, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "M-"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butBS", 40, 23, 8, 120, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "BS"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butCE", 40, 23, 53, 120, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "CE"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butC", 40, 23, 98, 120, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "C"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butSign", 40, 23, 143, 120, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "+/-"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butSQR", 40, 23, 188, 120, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "SQR"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "but7", 40, 23, 8, 148, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "7"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "but8", 40, 23, 53, 148, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "8"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "but9", 40, 23, 98, 148, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "9"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butDivide", 40, 23, 143, 148, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "/"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butPercent", 40, 23, 188, 148, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "%"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "but4", 40, 23, 8, 176, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "4"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "but5", 40, 23, 53, 176, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "5"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "but6", 40, 23, 98, 176, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "6"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butMultiply", 40, 23, 143, 176, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "*"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butReciprocate", 40, 23, 188, 176, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "1/x"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "but1", 40, 23, 8, 204, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "1"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "but2", 40, 23, 53, 204, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "2"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "but3", 40, 23, 98, 204, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "3"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butSubtract", 40, 23, 143, 204, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "-"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "but0", 85, 23, 8, 232, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "0"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butPoint", 40, 23, 98, 232, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "."
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butAdd", 40, 23, 143, 232, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "+"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "butEqual", 40, 51, 188, 204, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "="
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "mnuCopy", 124, 21, 0, 4, __UI_GetID("mnuEdit"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Copy CTRL+C"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "mnuPaste", 123, 21, 0, 25, __UI_GetID("mnuEdit"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Paste CTRL+V"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "mnuAbout", 134, 21, 0, 4, __UI_GetID("mnuHelp"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "About Calculator"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "lblAnswer", 195, 33, 22, 15, __UI_GetID("frmResults"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "123456789012345"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 21)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Align = __UI_Right
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "lblMemory", 13, 24, 6, 27, __UI_GetID("frmResults"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "M"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "lblHistory", 212, 21, 4, 4, __UI_GetID("frmResults"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "89 + 89 + 32"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Align = __UI_Right
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_AssignIDs
|
||||
Calculator = __UI_GetID("Calculator")
|
||||
frmResults = __UI_GetID("frmResults")
|
||||
mnuEdit = __UI_GetID("mnuEdit")
|
||||
mnuHelp = __UI_GetID("mnuHelp")
|
||||
butMC = __UI_GetID("butMC")
|
||||
butMR = __UI_GetID("butMR")
|
||||
butMS = __UI_GetID("butMS")
|
||||
butMplus = __UI_GetID("butMplus")
|
||||
butMminus = __UI_GetID("butMminus")
|
||||
butBS = __UI_GetID("butBS")
|
||||
butCE = __UI_GetID("butCE")
|
||||
butC = __UI_GetID("butC")
|
||||
butSign = __UI_GetID("butSign")
|
||||
butSQR = __UI_GetID("butSQR")
|
||||
but7 = __UI_GetID("but7")
|
||||
but8 = __UI_GetID("but8")
|
||||
but9 = __UI_GetID("but9")
|
||||
butDivide = __UI_GetID("butDivide")
|
||||
butPercent = __UI_GetID("butPercent")
|
||||
but4 = __UI_GetID("but4")
|
||||
but5 = __UI_GetID("but5")
|
||||
but6 = __UI_GetID("but6")
|
||||
butMultiply = __UI_GetID("butMultiply")
|
||||
butReciprocate = __UI_GetID("butReciprocate")
|
||||
but1 = __UI_GetID("but1")
|
||||
but2 = __UI_GetID("but2")
|
||||
but3 = __UI_GetID("but3")
|
||||
butSubtract = __UI_GetID("butSubtract")
|
||||
but0 = __UI_GetID("but0")
|
||||
butPoint = __UI_GetID("butPoint")
|
||||
butAdd = __UI_GetID("butAdd")
|
||||
butEqual = __UI_GetID("butEqual")
|
||||
mnuCopy = __UI_GetID("mnuCopy")
|
||||
mnuPaste = __UI_GetID("mnuPaste")
|
||||
mnuAbout = __UI_GetID("mnuAbout")
|
||||
lblAnswer = __UI_GetID("lblAnswer")
|
||||
lblMemory = __UI_GetID("lblMemory")
|
||||
lblHistory = __UI_GetID("lblHistory")
|
||||
END SUB
|
181
examples/ClickTheVoid/ClickTheVoid.bas
Normal file
|
@ -0,0 +1,181 @@
|
|||
': This program was generated by
|
||||
': InForm - GUI system for QB64 - Beta version 7
|
||||
': Fellippe Heitor, 2016-2018 - fellippe@qb64.org - @fellippeheitor
|
||||
'-----------------------------------------------------------
|
||||
|
||||
OPTION _EXPLICIT
|
||||
|
||||
': Controls' IDs: ------------------------------------------------------------------
|
||||
DIM SHARED ClickTheVoid AS LONG
|
||||
DIM SHARED PictureBox1 AS LONG
|
||||
DIM SHARED Button1 AS LONG
|
||||
DIM SHARED TrackBar1 AS LONG
|
||||
DIM SHARED fpsLB AS LONG
|
||||
|
||||
DIM SHARED start!, totalFrames AS _UNSIGNED LONG, fps AS INTEGER
|
||||
DIM AS SINGLE CenterX, CenterY, Radius, MaxRadius
|
||||
|
||||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'ClickTheVoid.frm'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
END SUB
|
||||
|
||||
SUB __UI_OnLoad
|
||||
Caption(Button1) = "Clear"
|
||||
SetFrameRate 120
|
||||
start! = TIMER
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUpdateDisplay
|
||||
SHARED CenterX, CenterY, Radius, MaxRadius
|
||||
|
||||
BeginDraw PictureBox1
|
||||
LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA32(0, 0, 0, 10), BF
|
||||
|
||||
totalFrames = totalFrames + 1
|
||||
fps% = totalFrames / (TIMER - start!)
|
||||
_PRINTSTRING (0, 0), STR$(fps%)
|
||||
EndDraw PictureBox1
|
||||
|
||||
Radius = Radius + 1
|
||||
IF Radius <= MaxRadius THEN
|
||||
BeginDraw PictureBox1
|
||||
CIRCLE (CenterX, CenterY), Radius, _RGBA32(RND * 255, RND * 255, RND * 255, RND * 255)
|
||||
EndDraw PictureBox1
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUnload
|
||||
END SUB
|
||||
|
||||
SUB __UI_Click (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE TrackBar1
|
||||
|
||||
CASE fpsLB
|
||||
|
||||
CASE ClickTheVoid
|
||||
|
||||
CASE PictureBox1
|
||||
SHARED MaxRadius, CenterX, CenterY, Radius
|
||||
Radius = 0
|
||||
MaxRadius = RND * 100 + 30
|
||||
CenterX = __UI_MouseLeft - Control(id).Left
|
||||
CenterY = __UI_MouseTop - Control(id).Top
|
||||
CASE Button1
|
||||
BeginDraw PictureBox1
|
||||
CLS
|
||||
MaxRadius = 0
|
||||
start! = TIMER
|
||||
totalFrames = 0
|
||||
EndDraw PictureBox1
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseEnter (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE TrackBar1
|
||||
|
||||
CASE fpsLB
|
||||
|
||||
CASE ClickTheVoid
|
||||
|
||||
CASE PictureBox1
|
||||
|
||||
CASE Button1
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseLeave (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE TrackBar1
|
||||
|
||||
CASE fpsLB
|
||||
|
||||
CASE ClickTheVoid
|
||||
|
||||
CASE PictureBox1
|
||||
|
||||
CASE Button1
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusIn (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE TrackBar1
|
||||
|
||||
CASE Button1
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusOut (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE TrackBar1
|
||||
|
||||
CASE Button1
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseDown (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE TrackBar1
|
||||
|
||||
CASE fpsLB
|
||||
|
||||
CASE ClickTheVoid
|
||||
|
||||
CASE PictureBox1
|
||||
|
||||
CASE Button1
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseUp (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE TrackBar1
|
||||
|
||||
CASE fpsLB
|
||||
|
||||
CASE ClickTheVoid
|
||||
|
||||
CASE PictureBox1
|
||||
|
||||
CASE Button1
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_KeyPress (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE TrackBar1
|
||||
|
||||
CASE Button1
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_TextChanged (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE ELSE
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_ValueChanged (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE TrackBar1
|
||||
Caption(fpsLB) = LTRIM$(STR$(Control(id).Value)) + "fps"
|
||||
SetFrameRate Control(id).Value
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
54
examples/ClickTheVoid/ClickTheVoid.frm
Normal file
|
@ -0,0 +1,54 @@
|
|||
': This form was generated by
|
||||
': InForm - GUI library for QB64 - v1.5
|
||||
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
SUB __UI_LoadForm
|
||||
|
||||
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Form, "ClickTheVoid", 300, 322, 0, 0, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Click the void"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf?arial.ttf?/Library/Fonts/Arial.ttf?InForm/resources/NotoMono-Regular.ttf?cour.ttf", 12)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "PictureBox1", 280, 258, 10, 10, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).Stretch = True
|
||||
Control(__UI_NewID).BackColor = _RGB32(0, 0, 0)
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "Button1", 80, 23, 210, 280, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Button1"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_TrackBar, "TrackBar1", 143, 40, 16, 272, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Value = 30
|
||||
Control(__UI_NewID).Min = 30
|
||||
Control(__UI_NewID).Max = 1000
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).Interval = 50
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "fpsLB", 38, 41, 164, 272, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "30fps"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_AssignIDs
|
||||
ClickTheVoid = __UI_GetID("ClickTheVoid")
|
||||
PictureBox1 = __UI_GetID("PictureBox1")
|
||||
Button1 = __UI_GetID("Button1")
|
||||
TrackBar1 = __UI_GetID("TrackBar1")
|
||||
fpsLB = __UI_GetID("fpsLB")
|
||||
END SUB
|
663
examples/ClockPatience/Clock Patience.bas
Normal file
|
@ -0,0 +1,663 @@
|
|||
': Clock Patience (extra animations) by QWERKEY 2019-01-30 (updated 2019-03-16)
|
||||
': Version with card pick-up and placement animation
|
||||
': Images from pngimg.com, all-free-download.com, openclipart.org
|
||||
': This program uses
|
||||
': InForm - GUI library for QB64 - Beta version 8
|
||||
': Fellippe Heitor, 2016-2018 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
|
||||
': Controls' IDs: ------------------------------------------------------------------
|
||||
DIM SHARED ClockPatience AS LONG
|
||||
DIM SHARED ExitBT AS LONG
|
||||
DIM SHARED NewGameBT AS LONG
|
||||
CONST Offset%% = 7, Pi! = 3.141592, Hours! = -Pi! / 6, ZOffset! = -398, XImage% = 182, YImage% = 252
|
||||
CONST Halfwidth%% = 50, Halfheight%% = Halfwidth%% * YImage% / XImage%, Radius% = 320, Tucked%% = 7
|
||||
DIM SHARED CardsImg&(51), Obverse&, RedHighlight&, GreenHighlight&, GameOver&, GameWon&, XM%, YM%
|
||||
DIM SHARED PickedUp%%, PickedHour%%, PickedCard%%, CanPutDown%%, Orient!, Orient0!, OldHour%%
|
||||
DIM SHARED Anime1%%, Anime2%%, DoPickUp%%, TurnOver%%, GreenValid%%, RedValid%%, Cards%%(51)
|
||||
DIM SHARED DoPatience%%, Stock%%, IsComplete%%, GotOut%%, Positions!(4, 12, 1, 4), Phi!(12)
|
||||
REDIM SHARED Clock%%(12, 4, 2)
|
||||
|
||||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'Clock Patience.frm'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
$EXEICON:'.\clubs.ico'
|
||||
DoPatience%% = FALSE
|
||||
Anime1%% = 31
|
||||
Anime2%% = 43
|
||||
'Set Data
|
||||
FOR N%% = 0 TO 6
|
||||
Phi!(N%%) = N%% * Hours!
|
||||
NEXT N%%
|
||||
FOR N%% = 7 TO 11
|
||||
Phi!(N%%) = (N%% - 12) * Hours!
|
||||
NEXT N%%
|
||||
FOR S%% = 0 TO 4
|
||||
Positions!(S%%, 0, 0, 4) = 0
|
||||
Positions!(S%%, 0, 1, 4) = Radius% - Tucked%% * S%%
|
||||
Positions!(S%%, 0, 0, 3) = Positions!(S%%, 0, 0, 4) + Halfwidth%%
|
||||
Positions!(S%%, 0, 1, 3) = Positions!(S%%, 0, 1, 4) - Halfheight%%
|
||||
Positions!(S%%, 0, 0, 2) = Positions!(S%%, 0, 0, 4) - Halfwidth%%
|
||||
Positions!(S%%, 0, 1, 2) = Positions!(S%%, 0, 1, 4) - Halfheight%%
|
||||
Positions!(S%%, 0, 0, 1) = Positions!(S%%, 0, 0, 4) + Halfwidth%%
|
||||
Positions!(S%%, 0, 1, 1) = Positions!(S%%, 0, 1, 4) + Halfheight%%
|
||||
Positions!(S%%, 0, 0, 0) = Positions!(S%%, 0, 0, 4) - Halfwidth%%
|
||||
Positions!(S%%, 0, 1, 0) = Positions!(S%%, 0, 1, 4) + Halfheight%%
|
||||
NEXT S%%
|
||||
FOR S%% = 0 TO 4
|
||||
FOR N%% = 1 TO 11
|
||||
FOR M%% = 0 TO 4
|
||||
CALL Angle((Positions!(S%%, 0, 0, M%%)), (Positions!(S%%, 0, 1, M%%)), Positions!(S%%, N%%, 0, M%%), Positions!(S%%, N%%, 1, M%%), (Phi!(N%%)))
|
||||
NEXT M%%
|
||||
NEXT N%%
|
||||
NEXT S%%
|
||||
FOR S%% = 0 TO 4
|
||||
Positions!(S%%, 12, 0, 0) = Tucked%% * (3 - S%%) - Halfwidth%%
|
||||
Positions!(S%%, 12, 1, 0) = Halfheight%%
|
||||
Positions!(S%%, 12, 0, 1) = Positions!(S%%, 12, 0, 0) + 2 * Halfwidth%%
|
||||
Positions!(S%%, 12, 1, 1) = Halfheight%%
|
||||
Positions!(S%%, 12, 0, 2) = Tucked%% * (3 - S%%) - Halfwidth%%
|
||||
Positions!(S%%, 12, 1, 2) = -Halfheight%%
|
||||
Positions!(S%%, 12, 0, 3) = Positions!(S%%, 12, 0, 2) + 2 * Halfwidth%%
|
||||
Positions!(S%%, 12, 1, 3) = -Halfheight%%
|
||||
Positions!(S%%, 12, 0, 4) = Tucked%% * (3 - S%%)
|
||||
Positions!(S%%, 12, 1, 4) = 0
|
||||
NEXT S%%
|
||||
'Images
|
||||
playingcards& = _LOADIMAGE("pack of cards.png", 32)
|
||||
Corner& = _NEWIMAGE(33, 33, 32)
|
||||
_DEST Corner&
|
||||
COLOR _RGB32(247, 247, 247), _RGBA32(100, 100, 100, 0)
|
||||
CIRCLE (16, 16), 16
|
||||
PAINT (16, 16)
|
||||
CIRCLE (16, 16), 16, _RGB32(204, 119, 34)
|
||||
FOR N%% = 0 TO 51
|
||||
R1%% = N%% \ 13
|
||||
C1%% = N%% MOD 13
|
||||
R2%% = R1%% \ 2
|
||||
C2%% = R1%% MOD 2
|
||||
R3%% = C1%% \ 5
|
||||
C3%% = C1%% MOD 5
|
||||
TempImg& = _NEWIMAGE(XImage%, YImage%, 32)
|
||||
_DEST TempImg&
|
||||
COLOR _RGB32(247, 247, 247), _RGBA32(100, 100, 100, 0)
|
||||
_PUTIMAGE (0, 0), Corner&
|
||||
_PUTIMAGE (0, YImage% - 33), Corner&
|
||||
_PUTIMAGE (XImage% - 33, 0), Corner&
|
||||
_PUTIMAGE (XImage% - 33, YImage% - 33), Corner&
|
||||
LINE (16, 0)-(XImage% - 17, YImage% - 1), , BF
|
||||
LINE (0, 16)-(XImage% - 1, YImage% - 17), , BF
|
||||
LINE (16, 0)-(XImage% - 17, 0), _RGB32(204, 119, 34)
|
||||
LINE (16, YImage% - 1)-(XImage% - 17, YImage% - 1), _RGB32(204, 119, 34)
|
||||
LINE (0, 16)-(0, YImage% - 17), _RGB32(204, 119, 34)
|
||||
LINE (XImage% - 1, 16)-(XImage% - 1, YImage% - 17), _RGB32(204, 119, 34)
|
||||
X1! = 7 + 203 * C3%% + 996 * C2%%
|
||||
X2! = 167 + X1!
|
||||
Y1! = 13 + 267 * R3%% + 786 * R2%%
|
||||
Y2! = Y1! + 222
|
||||
_PUTIMAGE (6, 14)-(XImage% - 7, YImage% - 15), playingcards&, , (7 + 203 * C3%% + 996 * C2%%, Y1!)-(X2!, Y2!)
|
||||
IF N%% = 23 THEN
|
||||
F& = _LOADFONT("cyberbit.ttf", 14)
|
||||
_FONT F&
|
||||
COLOR _RGB32(226, 226, 226)
|
||||
Q1$ = "PVDQJDX"
|
||||
FOR M%% = 1 TO 7
|
||||
Q2$ = Q2$ + CHR$(ASC(MID$(Q1$, M%%, 1)) + 1)
|
||||
NEXT M%%
|
||||
_PRINTSTRING (XImage% - 110, YImage% - 20), Q2$
|
||||
_FONT 16
|
||||
_FREEFONT F&
|
||||
END IF
|
||||
CardsImg&(N%%) = _COPYIMAGE(TempImg&, 33)
|
||||
_FREEIMAGE TempImg&
|
||||
NEXT N%%
|
||||
_FREEIMAGE Corner&
|
||||
Corner& = _NEWIMAGE(33, 33, 32)
|
||||
_DEST Corner&
|
||||
COLOR _RGB32(200, 200, 247), _RGBA32(100, 100, 100, 0)
|
||||
CIRCLE (16, 16), 16
|
||||
PAINT (16, 16)
|
||||
CIRCLE (16, 16), 16, _RGB32(204, 119, 34)
|
||||
TempImg& = _NEWIMAGE(XImage%, YImage%, 32)
|
||||
_DEST TempImg&
|
||||
COLOR _RGB32(200, 200, 247)
|
||||
_PUTIMAGE (0, 0), Corner&
|
||||
_PUTIMAGE (0, YImage% - 33), Corner&
|
||||
_PUTIMAGE (XImage% - 33, 0), Corner&
|
||||
_PUTIMAGE (XImage% - 33, YImage% - 33), Corner&
|
||||
LINE (16, 0)-(XImage% - 17, YImage% - 1), , BF
|
||||
LINE (0, 16)-(XImage% - 1, YImage% - 17), , BF
|
||||
LINE (16, 0)-(XImage% - 17, 0), _RGB32(204, 119, 34)
|
||||
LINE (16, YImage% - 1)-(XImage% - 17, YImage% - 1), _RGB32(204, 119, 34)
|
||||
LINE (0, 16)-(0, YImage% - 17), _RGB32(204, 119, 34)
|
||||
LINE (XImage% - 1, 16)-(XImage% - 1, YImage% - 17), _RGB32(204, 119, 34)
|
||||
C3%% = 4
|
||||
C2%% = 0
|
||||
R3%% = 2
|
||||
R2%% = 0
|
||||
X1! = 7 + 203 * C3%% + 996 * C2%%
|
||||
X2! = 167 + X1!
|
||||
Y1! = 13 + 267 * R3%% + 786 * R2%%
|
||||
Y2! = Y1! + 222
|
||||
_PUTIMAGE (14, 14)-(XImage% - 15, YImage% - 15), playingcards&, , (14 + 203 * C3%% + 996 * C2%%, Y1!)-(X2! - 4, Y2!)
|
||||
Obverse& = _COPYIMAGE(TempImg&, 33)
|
||||
_FREEIMAGE TempImg&
|
||||
_FREEIMAGE Corner&
|
||||
_FREEIMAGE playingcards&
|
||||
TempImg& = _NEWIMAGE(81, 81, 32)
|
||||
_DEST TempImg&
|
||||
COLOR _RGB32(200, 0, 0)
|
||||
CIRCLE (40, 40), 40
|
||||
CIRCLE (40, 40), 39
|
||||
CIRCLE (40, 40), 38
|
||||
RedHighlight& = _COPYIMAGE(TempImg&, 33)
|
||||
_FREEIMAGE TempImg&
|
||||
TempImg& = _NEWIMAGE(81, 81, 32)
|
||||
_DEST TempImg&
|
||||
COLOR _RGB32(0, 200, 0)
|
||||
CIRCLE (40, 40), 40
|
||||
CIRCLE (40, 40), 39
|
||||
CIRCLE (40, 40), 38
|
||||
GreenHighlight& = _COPYIMAGE(TempImg&, 33)
|
||||
_FREEIMAGE TempImg&
|
||||
TempImg& = _NEWIMAGE(340, 80, 32)
|
||||
_DEST TempImg&
|
||||
COLOR _RGB32(0, 80, 32), _RGBA32(100, 100, 100, 0)
|
||||
F& = _LOADFONT("cyberbit.ttf", 70)
|
||||
_FONT F&
|
||||
_PRINTSTRING (5, 5), "Game End"
|
||||
_FONT 16
|
||||
_FREEFONT F&
|
||||
GameOver& = _COPYIMAGE(TempImg&, 33)
|
||||
_FREEIMAGE TempImg&
|
||||
TempImg& = _NEWIMAGE(356, 80, 32)
|
||||
_DEST TempImg&
|
||||
COLOR _RGB32(0, 80, 32), _RGBA32(100, 100, 100, 0)
|
||||
F& = _LOADFONT("cyberbit.ttf", 70)
|
||||
_FONT F&
|
||||
_PRINTSTRING (5, 5), "Completed"
|
||||
_FONT 16
|
||||
_FREEFONT F&
|
||||
GameWon& = _COPYIMAGE(TempImg&, 33)
|
||||
_FREEIMAGE TempImg&
|
||||
FOR N%% = 0 TO 51
|
||||
Cards%%(N%%) = N%% + 1 'Cards%%() values adjusted to 1 - 13: then value 0 is empty
|
||||
NEXT N%%
|
||||
FOR N%% = 1 TO 4
|
||||
CALL Shuffle(Cards%%())
|
||||
NEXT N%%
|
||||
END SUB
|
||||
|
||||
SUB __UI_OnLoad
|
||||
_SCREENMOVE 50, 0
|
||||
Caption(NewGameBT) = "Deal"
|
||||
SetFocus NewGameBT
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUpdateDisplay
|
||||
'This event occurs at approximately 30 frames per second.
|
||||
'You can change the update frequency by calling SetFrameRate DesiredRate%
|
||||
STATIC Count%, InitDone%%, Grandad&, XStart%, YStart%
|
||||
IF NOT InitDone%% THEN
|
||||
InitDone%% = TRUE
|
||||
XStart% = -120
|
||||
YStart% = 0
|
||||
Grandad& = _LOADIMAGE("Clock1.png", 33)
|
||||
END IF
|
||||
IF NOT DoPatience%% THEN
|
||||
_PUTIMAGE (201, 10), Grandad&
|
||||
ELSE
|
||||
IF GreenValid%% THEN
|
||||
_MAPTRIANGLE (0, 0)-(80, 0)-(0, 80), GreenHighlight& TO(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) - 40, ZOffset!)
|
||||
_MAPTRIANGLE (80, 80)-(0, 80)-(80, 0), GreenHighlight& TO(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + -40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) - 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)
|
||||
ELSEIF RedValid%% THEN
|
||||
_MAPTRIANGLE (0, 0)-(80, 0)-(0, 80), RedHighlight& TO(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) - 40, ZOffset!)
|
||||
_MAPTRIANGLE (80, 80)-(0, 80)-(80, 0), RedHighlight& TO(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + -40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) - 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)
|
||||
END IF
|
||||
IF Anime1%% < 31 THEN
|
||||
'Display turning-over
|
||||
IF OldHour%% = 12 THEN
|
||||
IF Anime1%% > 15 THEN
|
||||
Xtent! = 2 * Halfwidth%% * (Anime1%% - 15) / 15
|
||||
X0! = Positions!(4, OldHour%%, 0, 0)
|
||||
Y0! = Positions!(4, OldHour%%, 1, 0)
|
||||
Z0! = 0.7 * SQR((4 * Halfwidth%% * Halfwidth%%) - (Xtent! * Xtent!))
|
||||
X1! = Positions!(4, OldHour%%, 0, 0) + Xtent!
|
||||
Y1! = Positions!(4, OldHour%%, 1, 0)
|
||||
Z1! = 0
|
||||
X2! = Positions!(4, OldHour%%, 0, 2)
|
||||
Y2! = Positions!(4, OldHour%%, 1, 2)
|
||||
Z2! = 0.7 * SQR((4 * Halfwidth%% * Halfwidth%%) - (Xtent! * Xtent!))
|
||||
X3! = Positions!(4, OldHour%%, 0, 2) + Xtent!
|
||||
Y3! = Positions!(4, OldHour%%, 1, 2)
|
||||
Z3! = 0
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Z0! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Z3! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)
|
||||
ELSE
|
||||
Psi! = Anime1%% * Pi! / (2 * 15)
|
||||
X0! = Positions!(4, OldHour%%, 0, 0)
|
||||
Y0! = Positions!(4, OldHour%%, 1, 0)
|
||||
Z0! = 0
|
||||
X1! = X0! + 2 * Halfwidth%% * COS(Psi!)
|
||||
Y1! = Y0!
|
||||
Z1! = 0.7 * 2 * Halfwidth%% * SIN(Psi!)
|
||||
X2! = Positions!(4, OldHour%%, 0, 2)
|
||||
Y2! = Positions!(4, OldHour%%, 1, 2)
|
||||
Z2! = 0
|
||||
X3! = X2! + 2 * Halfwidth%% * COS(Psi!)
|
||||
Y3! = Y2!
|
||||
Z3! = 0.7 * 2 * Halfwidth%% * SIN(Psi!)
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(X0!, Y0!, Z0! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(X3!, Y3!, Z3! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)
|
||||
END IF
|
||||
ELSE
|
||||
IF Anime1%% > 15 THEN
|
||||
Xtent! = 2 * Halfwidth%% * (Anime1%% - 15) / 15
|
||||
XA! = Positions!(4, 0, 0, 0)
|
||||
YA! = Positions!(4, 0, 1, 0)
|
||||
Z0! = 0.7 * SQR((4 * Halfwidth%% * Halfwidth%%) - (Xtent! * Xtent!))
|
||||
XB! = Positions!(4, 0, 0, 0) + Xtent!
|
||||
YB! = Positions!(4, 0, 1, 0)
|
||||
Z1! = 0
|
||||
XC! = Positions!(4, 0, 0, 2)
|
||||
YC! = Positions!(4, 0, 1, 2)
|
||||
Z2! = 0.7 * SQR((4 * Halfwidth%% * Halfwidth%%) - (Xtent! * Xtent!))
|
||||
XD! = Positions!(4, 0, 0, 2) + Xtent!
|
||||
YD! = Positions!(4, 0, 1, 2)
|
||||
Z3! = 0
|
||||
CALL Angle((XA!), (YA!), X0!, Y0!, Orient0!)
|
||||
CALL Angle((XB!), (YB!), X1!, Y1!, Orient0!)
|
||||
CALL Angle((XC!), (YC!), X2!, Y2!, Orient0!)
|
||||
CALL Angle((XD!), (YD!), X3!, Y3!, Orient0!)
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Z0! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Z3! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)
|
||||
ELSE
|
||||
Psi! = Anime1%% * Pi! / (2 * 15)
|
||||
XA! = Positions!(4, 0, 0, 0)
|
||||
YA! = Positions!(4, 0, 1, 0)
|
||||
Z0! = 0
|
||||
XB! = XA! + 2 * Halfwidth%% * COS(Psi!)
|
||||
YB! = YA!
|
||||
Z1! = 0.7 * 2 * Halfwidth%% * SIN(Psi!)
|
||||
XC! = Positions!(4, 0, 0, 2)
|
||||
YC! = Positions!(4, 0, 1, 2)
|
||||
Z2! = 0
|
||||
XD! = XC! + 2 * Halfwidth%% * COS(Psi!)
|
||||
YD! = YC!
|
||||
Z3! = 0.7 * 2 * Halfwidth%% * SIN(Psi!)
|
||||
CALL Angle((XA!), (YA!), X0!, Y0!, Orient0!)
|
||||
CALL Angle((XB!), (YB!), X1!, Y1!, Orient0!)
|
||||
CALL Angle((XC!), (YC!), X2!, Y2!, Orient0!)
|
||||
CALL Angle((XD!), (YD!), X3!, Y3!, Orient0!)
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(X0!, Y0!, Z0! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(X3!, Y3!, Z3! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)
|
||||
END IF
|
||||
END IF
|
||||
Anime1%% = Anime1%% + 1
|
||||
IF Anime1%% = 31 THEN
|
||||
TurnOver%% = FALSE
|
||||
Clock%%(PickedHour%%, 4, 0) = PickedCard%%
|
||||
Clock%%(PickedHour%%, 4, 1) = TRUE 'Temporary until picked up
|
||||
END IF
|
||||
ELSEIF Anime2%% < 43 THEN
|
||||
'Display Tucking-in
|
||||
IF PickedHour%% = 12 THEN
|
||||
'Horizontal for Kings
|
||||
IF Anime2%% > 22 THEN
|
||||
Xdelta% = Positions!(1, PickedHour%%, 0, 1) - Positions!(4, PickedHour%%, 0, 0) + Tucked%%
|
||||
X0! = Positions!(4, PickedHour%%, 0, 0) + Xdelta% * (45 - Anime2%%) / 23
|
||||
Y0! = Positions!(4, PickedHour%%, 1, 0)
|
||||
X1! = Positions!(4, PickedHour%%, 0, 1) + Xdelta% * (45 - Anime2%%) / 23
|
||||
Y1! = Positions!(4, PickedHour%%, 1, 1)
|
||||
X2! = Positions!(4, PickedHour%%, 0, 2) + Xdelta% * (45 - Anime2%%) / 23
|
||||
Y2! = Positions!(4, PickedHour%%, 1, 2)
|
||||
X3! = Positions!(4, PickedHour%%, 0, 3) + Xdelta% * (45 - Anime2%%) / 23
|
||||
Y3! = Positions!(4, PickedHour%%, 1, 3)
|
||||
Zpos! = -0.5
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
|
||||
ELSE
|
||||
Xdelta% = Positions!(1, PickedHour%%, 0, 1) - Positions!(4, PickedHour%%, 0, 0) + Tucked%%
|
||||
X0! = Positions!(4, PickedHour%%, 0, 0) + Xdelta% * Anime2%% / 22
|
||||
Y0! = Positions!(4, PickedHour%%, 1, 0)
|
||||
X1! = Positions!(4, PickedHour%%, 0, 1) + Xdelta% * Anime2%% / 22
|
||||
Y1! = Positions!(4, PickedHour%%, 1, 1)
|
||||
X2! = Positions!(4, PickedHour%%, 0, 2) + Xdelta% * Anime2%% / 22
|
||||
Y2! = Positions!(4, PickedHour%%, 1, 2)
|
||||
X3! = Positions!(4, PickedHour%%, 0, 3) + Xdelta% * Anime2%% / 22
|
||||
Y3! = Positions!(4, PickedHour%%, 1, 3)
|
||||
Zpos! = 0.5
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
|
||||
END IF
|
||||
ELSE
|
||||
'Vertical for others
|
||||
IF Anime2%% > 22 THEN
|
||||
Ydelta% = Positions!(0, 0, 1, 0) - Positions!(4, 0, 1, 2) + Tucked%%
|
||||
XA! = Positions!(4, 0, 0, 0)
|
||||
YA! = Positions!(4, 0, 1, 0) + Ydelta% * (45 - Anime2%%) / 23
|
||||
XB! = Positions!(4, 0, 0, 1)
|
||||
YB! = Positions!(4, 0, 1, 1) + Ydelta% * (45 - Anime2%%) / 23
|
||||
XC! = Positions!(4, 0, 0, 2)
|
||||
YC! = Positions!(4, 0, 1, 2) + Ydelta% * (45 - Anime2%%) / 23
|
||||
XD! = Positions!(4, 0, 0, 3)
|
||||
YD! = Positions!(4, 0, 1, 3) + Ydelta% * (45 - Anime2%%) / 23
|
||||
CALL Angle((XA!), (YA!), X0!, Y0!, Orient!)
|
||||
CALL Angle((XB!), (YB!), X1!, Y1!, Orient!)
|
||||
CALL Angle((XC!), (YC!), X2!, Y2!, Orient!)
|
||||
CALL Angle((XD!), (YD!), X3!, Y3!, Orient!)
|
||||
Zpos! = -0.5
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
|
||||
ELSE
|
||||
Ydelta% = Positions!(0, 0, 1, 0) - Positions!(4, 0, 1, 2) + Tucked%%
|
||||
XA! = Positions!(4, 0, 0, 0)
|
||||
YA! = Positions!(4, 0, 1, 0) + Ydelta% * Anime2%% / 22
|
||||
XB! = Positions!(4, 0, 0, 1)
|
||||
YB! = Positions!(4, 0, 1, 1) + Ydelta% * Anime2%% / 22
|
||||
XC! = Positions!(4, 0, 0, 2)
|
||||
YC! = Positions!(4, 0, 1, 2) + Ydelta% * Anime2%% / 22
|
||||
XD! = Positions!(4, 0, 0, 3)
|
||||
YD! = Positions!(4, 0, 1, 3) + Ydelta% * Anime2%% / 22
|
||||
CALL Angle((XA!), (YA!), X0!, Y0!, Orient!)
|
||||
CALL Angle((XB!), (YB!), X1!, Y1!, Orient!)
|
||||
CALL Angle((XC!), (YC!), X2!, Y2!, Orient!)
|
||||
CALL Angle((XD!), (YD!), X3!, Y3!, Orient!)
|
||||
Zpos! = 0.5
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
|
||||
END IF
|
||||
END IF
|
||||
Anime2%% = Anime2%% + 1
|
||||
IF Anime2%% = 43 THEN CanPutDown%% = TRUE
|
||||
ELSEIF PickedUp%% THEN
|
||||
'Display picked-up card
|
||||
IF __UI_MouseLeft > 680 AND __UI_MouseTop > 738 THEN
|
||||
'Do Nothing
|
||||
ELSE
|
||||
CALL Angle(-Halfwidth%%, Halfheight%, X0!, Y0!, Orient!)
|
||||
CALL Angle(Halfwidth%%, Halfheight%, X1!, Y1!, Orient!)
|
||||
CALL Angle(-Halfwidth%%, -Halfheight%, X2!, Y2!, Orient!)
|
||||
CALL Angle(Halfwidth%%, -Halfheight%, X3!, Y3!, Orient!)
|
||||
X0! = X0! + XM%
|
||||
Y0! = Y0! + YM%
|
||||
X1! = X1! + XM%
|
||||
Y1! = Y1! + YM%
|
||||
X2! = X2! + XM%
|
||||
Y2! = Y2! + YM%
|
||||
X3! = X3! + XM%
|
||||
Y3! = Y3! + YM%
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, ZOffset!)-(X1!, Y1!, ZOffset!)-(X2!, Y2!, ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, ZOffset!)-(X2!, Y2!, ZOffset!)-(X1!, Y1!, ZOffset!)
|
||||
END IF
|
||||
END IF
|
||||
'Display Piles
|
||||
FOR S%% = 4 TO 0 STEP -1 'Maptriangle order is backwards
|
||||
FOR N%% = 0 TO 12
|
||||
IF Clock%%(N%%, S%%, 0) <> 0 THEN
|
||||
IF Clock%%(N%%, S%%, 1) THEN
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(Clock%%(N%%, S%%, 0) - 1) TO(Positions!(S%%, N%%, 0, 0), Positions!(S%%, N%%, 1, 0), ZOffset!)-(Positions!(S%%, N%%, 0, 1), Positions!(S%%, N%%, 1, 1), ZOffset!)-(Positions!(S%%, N%%, 0, 2), Positions!(S%%, N%%, 1, 2), ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(Clock%%(N%%, S%%, 0) - 1) TO(Positions!(S%%, N%%, 0, 3), Positions!(S%%, N%%, 1, 3), ZOffset!)-(Positions!(S%%, N%%, 0, 2), Positions!(S%%, N%%, 1, 2), ZOffset!)-(Positions!(S%%, N%%, 0, 1), Positions!(S%%, N%%, 1, 1), ZOffset!)
|
||||
ELSE
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(Positions!(S%%, N%%, 0, 0), Positions!(S%%, N%%, 1, 0), ZOffset!)-(Positions!(S%%, N%%, 0, 1), Positions!(S%%, N%%, 1, 1), ZOffset!)-(Positions!(S%%, N%%, 0, 2), Positions!(S%%, N%%, 1, 2), ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(Positions!(S%%, N%%, 0, 3), Positions!(S%%, N%%, 1, 3), ZOffset!)-(Positions!(S%%, N%%, 0, 2), Positions!(S%%, N%%, 1, 2), ZOffset!)-(Positions!(S%%, N%%, 0, 1), Positions!(S%%, N%%, 1, 1), ZOffset!)
|
||||
END IF
|
||||
END IF
|
||||
NEXT N%%
|
||||
NEXT S%%
|
||||
IF Stock%% > 0 THEN
|
||||
'Display Stock
|
||||
IF Stock%% > 1 THEN
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%%, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%%, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%%, ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%%, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%%, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%%, ZOffset!)
|
||||
END IF
|
||||
IF Stock%% > 10 THEN
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%% - 1, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 1, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 1, ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%% - 1, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 1, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 1, ZOffset!)
|
||||
END IF
|
||||
IF Stock%% > 20 THEN
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%% - 2, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 2, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 2, ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%% - 2, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 2, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 2, ZOffset!)
|
||||
END IF
|
||||
IF Stock%% > 30 THEN
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%% - 3, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 3, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 3, ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%% - 3, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 3, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 3, ZOffset!)
|
||||
END IF
|
||||
IF Stock%% > 41 THEN
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%% - 4, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 4, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 4, ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%% - 4, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 4, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 4, ZOffset!)
|
||||
END IF
|
||||
'Display dealt card
|
||||
S%% = (52 - Stock%%) \ 13
|
||||
N%% = (52 - Stock%%) MOD 13
|
||||
Count% = Count% + 1
|
||||
Zpos! = 50 * SIN(Pi! * Count% / 15)
|
||||
ActualAngle! = Phi!(N%%) * Count% / 15
|
||||
XPos! = XStart% + (Positions!(S%%, N%%, 0, 4) - XStart%) * Count% / 15
|
||||
YPos! = YStart% + (Positions!(S%%, N%%, 1, 4) - YStart%) * Count% / 15
|
||||
CALL Angle((-Halfwidth%%), (Halfheight%%), X0!, Y0!, (ActualAngle!))
|
||||
CALL Angle((Halfwidth%%), (Halfheight%%), X1!, Y1!, (ActualAngle!))
|
||||
CALL Angle((-Halfwidth%%), (-Halfheight%%), X2!, Y2!, (ActualAngle!))
|
||||
CALL Angle((Halfwidth%%), (-Halfheight%%), X3!, Y3!, (ActualAngle!))
|
||||
X0! = XPos! + X0!
|
||||
Y0! = YPos! + Y0!
|
||||
X1! = XPos! + X1!
|
||||
Y1! = YPos! + Y1!
|
||||
X2! = XPos! + X2!
|
||||
Y2! = YPos! + Y2!
|
||||
X3! = XPos! + X3!
|
||||
Y3! = YPos! + Y3!
|
||||
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
|
||||
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
|
||||
IF Count% = 15 THEN
|
||||
Count% = 0
|
||||
Clock%%((52 - Stock%%) MOD 13, 1 + ((52 - Stock%%) \ 13), 0) = Clock%%((52 - Stock%%) MOD 13, 1 + ((52 - Stock%%) \ 13), 2)
|
||||
Stock%% = Stock%% - 1
|
||||
END IF
|
||||
END IF
|
||||
IF IsComplete%% THEN
|
||||
_PUTIMAGE (230, 246), GameOver&
|
||||
IF GotOut%% THEN _PUTIMAGE (222, 490), GameWon&
|
||||
END IF
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUnload
|
||||
'If you set __UI_UnloadSignal = False here you can
|
||||
'cancel the user's request to close.
|
||||
END SUB
|
||||
|
||||
SUB __UI_Click (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE ClockPatience
|
||||
IF GreenValid%% THEN
|
||||
DoPickUp%% = TRUE
|
||||
ELSEIF RedValid%% THEN
|
||||
Anime2%% = 0
|
||||
END IF
|
||||
CASE ExitBT
|
||||
SYSTEM
|
||||
CASE NewGameBT
|
||||
IF NOT DoPatience%% THEN
|
||||
Control(NewGameBT).Disabled = TRUE
|
||||
Control(NewGameBT).Hidden = TRUE
|
||||
Caption(NewGameBT) = "New Game"
|
||||
SetFocus ExitBT
|
||||
CALL Patience
|
||||
ELSE
|
||||
DoPatience%% = FALSE
|
||||
Caption(NewGameBT) = "Deal"
|
||||
END IF
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseEnter (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseLeave (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusIn (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusOut (id AS LONG)
|
||||
'This event occurs right before a control loses focus.
|
||||
'To prevent a control from losing focus, set __UI_KeepFocus = True below.
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseDown (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseUp (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_KeyPress (id AS LONG)
|
||||
'When this event is fired, __UI_KeyHit will contain the code of the key hit.
|
||||
'You can change it and even cancel it by making it = 0
|
||||
END SUB
|
||||
|
||||
SUB __UI_TextChanged (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_ValueChanged (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_FormResized
|
||||
|
||||
END SUB
|
||||
|
||||
SUB Angle (Xin!, Yin!, Xout!, Yout!, Theta!)
|
||||
Xout! = Xin! * COS(Theta!) - Yin! * SIN(Theta!)
|
||||
Yout! = Xin! * SIN(Theta!) + Yin! * COS(Theta!)
|
||||
END SUB
|
||||
|
||||
SUB Patience
|
||||
RANDOMIZE (TIMER)
|
||||
BadDeal%% = TRUE
|
||||
WHILE BadDeal%%
|
||||
REDIM Clock%%(12, 4, 2)
|
||||
CALL Shuffle(Cards%%())
|
||||
'Deal Sim
|
||||
FOR N%% = 0 TO 51
|
||||
S%% = N%% \ 13
|
||||
R%% = N%% MOD 13
|
||||
Clock%%(R%%, S%% + 1, 2) = Cards%%(N%%)
|
||||
NEXT N%%
|
||||
BadDeal%% = FALSE
|
||||
FOR M%% = 0 TO 12 'Cards are in S 1 to 4
|
||||
IF Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 2, 2) MOD 13 AND Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 3, 2) MOD 13 AND Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 4, 2) MOD 13 THEN BadDeal%% = TRUE
|
||||
NEXT M%%
|
||||
WEND
|
||||
Stock%% = 52
|
||||
Anime1%% = 31
|
||||
Anime2%% = 43
|
||||
TurnOver%% = TRUE
|
||||
DoPickUp%% = FALSE
|
||||
PickedUp%% = FALSE
|
||||
PickedCard%% = 0
|
||||
PickedHour%% = 12
|
||||
CanPutDown%% = FALSE
|
||||
IsComplete%% = FALSE
|
||||
DoPatience%% = TRUE
|
||||
HangOn%% = TRUE
|
||||
HangStop%% = 50
|
||||
HCount%% = 0
|
||||
WHILE DoPatience%%
|
||||
_LIMIT 60
|
||||
GreenValid%% = FALSE
|
||||
RedValid%% = FALSE
|
||||
IF Stock%% = 0 AND HangOn%% THEN
|
||||
HCount%% = HCount%% + 1
|
||||
IF HCount%% = HangStop%% THEN
|
||||
HangOn%% = FALSE
|
||||
HCount%% = 0
|
||||
HangStop%% = 20
|
||||
END IF
|
||||
END IF
|
||||
IF Stock%% = 0 AND NOT IsComplete%% AND Anime1%% = 31 AND Anime2%% = 43 AND NOT HangOn%% THEN
|
||||
'In _MAPTRIANGLE3D, all distances relative to centre of screen
|
||||
XM% = __UI_MouseLeft - _WIDTH / 2
|
||||
YM% = _HEIGHT / 2 - __UI_MouseTop
|
||||
IF TurnOver%% THEN
|
||||
Orient0! = Phi!(PickedHour%%) 'Start orientation is from where the card is taken
|
||||
PickedCard%% = Clock%%(PickedHour%%, 4, 0) 'From 1 to 52
|
||||
Clock%%(PickedHour%%, 4, 0) = 0
|
||||
OldHour%% = PickedHour%%
|
||||
Anime1%% = 0
|
||||
ELSEIF NOT DoPickUp%% AND NOT PickedUp%% THEN
|
||||
IF SQR((Positions!(4, PickedHour%%, 0, 4) - XM%) * (Positions!(4, PickedHour%%, 0, 4) - XM%) + (Positions!(4, PickedHour%%, 1, 4) - YM%) * (Positions!(4, PickedHour%%, 1, 4) - YM%)) < 40 THEN GreenValid%% = TRUE
|
||||
ELSEIF DoPickUp%% THEN
|
||||
IF PickedHour%% = 12 THEN
|
||||
FOR R%% = 4 TO 2 STEP -1
|
||||
Clock%%(PickedHour%%, R%%, 0) = Clock%%(PickedHour%%, R%% - 1, 0)
|
||||
Clock%%(PickedHour%%, R%%, 1) = Clock%%(PickedHour%%, R%% - 1, 1)
|
||||
NEXT R%%
|
||||
Clock%%(PickedHour%%, 1, 0) = 0
|
||||
ELSE
|
||||
FOR R%% = 4 TO 1 STEP -1
|
||||
Clock%%(PickedHour%%, R%%, 0) = Clock%%(PickedHour%%, R%% - 1, 0)
|
||||
Clock%%(PickedHour%%, R%%, 1) = Clock%%(PickedHour%%, R%% - 1, 1)
|
||||
NEXT R%%
|
||||
Clock%%(PickedHour%%, 0, 0) = 0
|
||||
END IF
|
||||
PickedHour%% = PickedCard%% MOD 13
|
||||
IF PickedHour%% = 0 THEN
|
||||
PickedHour%% = 12
|
||||
ELSEIF PickedHour%% = 12 THEN
|
||||
PickedHour%% = 0
|
||||
END IF
|
||||
Orient1! = Phi!(PickedHour%%)
|
||||
PickedUp%% = TRUE
|
||||
DoPickUp%% = FALSE
|
||||
ELSEIF PickedUp%% THEN
|
||||
IF SQR((Positions!(4, PickedHour%%, 0, 4) - XM%) * (Positions!(4, PickedHour%%, 0, 4) - XM%) + (Positions!(4, PickedHour%%, 1, 4) - YM%) * (Positions!(4, PickedHour%%, 1, 4) - YM%)) < 40 THEN
|
||||
IF NOT CanPutDown%% THEN RedValid%% = TRUE
|
||||
Orient! = Orient1!
|
||||
ELSEIF SQR((Positions!(4, OldHour%%, 0, 4) - XM%) * (Positions!(4, OldHour%%, 0, 4) - XM%) + (Positions!(4, OldHour%%, 1, 4) - YM%) * (Positions!(4, OldHour%%, 1, 4) - YM%)) < 40 THEN
|
||||
Orient! = Orient0!
|
||||
ELSE
|
||||
Orient! = 0
|
||||
END IF
|
||||
IF CanPutDown%% THEN
|
||||
CanPutDown%% = FALSE
|
||||
PickedUp%% = FALSE
|
||||
HangOn%% = TRUE
|
||||
IF PickedHour%% = 12 THEN
|
||||
Clock%%(PickedHour%%, 1, 0) = PickedCard%%
|
||||
Clock%%(PickedHour%%, 1, 1) = TRUE
|
||||
ELSE
|
||||
Clock%%(PickedHour%%, 0, 0) = PickedCard%%
|
||||
Clock%%(PickedHour%%, 0, 1) = TRUE
|
||||
END IF
|
||||
PickedCard%% = 0
|
||||
IF Clock%%(12, 4, 1) AND Clock%%(12, 1, 0) <> 0 THEN 'Game Finished
|
||||
IsComplete%% = TRUE
|
||||
Control(NewGameBT).Disabled = FALSE
|
||||
Control(NewGameBT).Hidden = FALSE
|
||||
SetFocus NewGameBT
|
||||
GotOut%% = TRUE
|
||||
M%% = 0
|
||||
WHILE M%% <= 11 AND GotOut%%
|
||||
IF NOT Clock%%(M%%, 4, 1) THEN GotOut%% = FALSE
|
||||
M%% = M%% + 1
|
||||
WEND
|
||||
END IF
|
||||
IF NOT IsComplete%% THEN TurnOver%% = TRUE
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
__UI_DoEvents
|
||||
WEND
|
||||
END SUB
|
||||
|
||||
SUB Shuffle (Pack%%()) 'Fisher Yates or Knuth shuffle
|
||||
FOR S%% = 51 TO 1 STEP -1
|
||||
R%% = INT(RND * S%%) '+ 1
|
||||
SWAP Pack%%(R%%), Pack%%(S%%)
|
||||
NEXT S%%
|
||||
END SUB
|
35
examples/ClockPatience/Clock Patience.frm
Normal file
|
@ -0,0 +1,35 @@
|
|||
': This form was generated by
|
||||
': InForm - GUI library for QB64 - v1.5
|
||||
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
SUB __UI_LoadForm
|
||||
|
||||
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Form, "ClockPatience", 800, 800, 0, 0, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Clock Patience"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 12)
|
||||
Control(__UI_NewID).BackColor = _RGB32(0, 141, 0)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "ExitBT", 80, 23, 710, 768, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Exit"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "NewGameBT", 80, 23, 710, 736, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "New Game"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_AssignIDs
|
||||
ClockPatience = __UI_GetID("ClockPatience")
|
||||
ExitBT = __UI_GetID("ExitBT")
|
||||
NewGameBT = __UI_GetID("NewGameBT")
|
||||
END SUB
|
BIN
examples/ClockPatience/Clock1.png
Normal file
After Width: | Height: | Size: 490 KiB |
BIN
examples/ClockPatience/QB64bee.png
Normal file
After Width: | Height: | Size: 3.9 KiB |
BIN
examples/ClockPatience/clubs.ico
Normal file
After Width: | Height: | Size: 66 KiB |
BIN
examples/ClockPatience/cyberbit.ttf
Normal file
BIN
examples/ClockPatience/pack of cards.png
Normal file
After Width: | Height: | Size: 1.8 MiB |
BIN
examples/DuckShoot/22handgun.mp3
Normal file
1135
examples/DuckShoot/Duck Shoot.bas
Normal file
277
examples/DuckShoot/Duck Shoot.frm
Normal file
|
@ -0,0 +1,277 @@
|
|||
': This form was generated by
|
||||
': InForm - GUI library for QB64 - v1.5
|
||||
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
SUB __UI_LoadForm
|
||||
|
||||
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Form, "DuckShoot", 1240, 800, 0, 0, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Duck Shoot"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 12)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "OptionsFR", 120, 160, 1120, 640, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Value = 4
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "GameLevelFR", 100, 174, 1130, 454, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Game Level"
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Value = 6
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "AudioFR", 100, 80, 1130, 360, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Audio"
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Value = 2
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "SetKeysFR", 177, 109, 510, 325, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Set Keys"
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Value = 4
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "LeftHandKeysFR", 150, 180, 510, 456, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Left Hand Keys"
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Value = 5
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "RightHandKeysFR", 140, 150, 763, 456, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Right Hand Keys"
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Value = 4
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "SelectKeyFR", 164, 80, 763, 325, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Select Key"
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Value = 3
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "ExitBT", 80, 23, 20, 120, __UI_GetID("OptionsFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Exit"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "ResetBT", 80, 23, 20, 85, __UI_GetID("OptionsFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Reset"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "SetKeysBT", 80, 23, 20, 15, __UI_GetID("OptionsFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Set Keys"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "Level1RB", 80, 23, 12, 15, __UI_GetID("GameLevelFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Level 1"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Value = -1
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "Level2RB", 80, 23, 12, 40, __UI_GetID("GameLevelFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Level 2"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "Level3RB", 80, 23, 12, 65, __UI_GetID("GameLevelFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Level 3"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "Level4RB", 80, 23, 12, 90, __UI_GetID("GameLevelFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Level 4"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "Level5RB", 80, 23, 12, 115, __UI_GetID("GameLevelFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Level 5"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "Level6RB", 80, 23, 12, 140, __UI_GetID("GameLevelFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Level 6"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "AudioOffRB", 80, 23, 12, 15, __UI_GetID("AudioFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Audio Off"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "AudioOnRB", 80, 23, 12, 40, __UI_GetID("AudioFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Audio On"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Value = -1
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "RestartLevelBT", 80, 23, 20, 50, __UI_GetID("OptionsFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Restart Level"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "SetLeftHandKeysRB", 134, 23, 15, 15, __UI_GetID("SetKeysFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Set Left Hand Keys"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Value = -1
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "SetRightHandKeysRB", 134, 23, 15, 45, __UI_GetID("SetKeysFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Set Right Hand Keys"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "FarSightUpRB", 100, 23, 15, 15, __UI_GetID("RightHandKeysFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Far Sight Up"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Value = -1
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "FarSightLeftRB", 100, 23, 15, 45, __UI_GetID("RightHandKeysFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Far Sight Left"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "FarSightRightRB", 110, 23, 15, 75, __UI_GetID("RightHandKeysFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Far Sight Right"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "FarSightDownRB", 110, 23, 15, 105, __UI_GetID("RightHandKeysFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Far Sight Down"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "NearSightUpRB", 110, 23, 15, 15, __UI_GetID("LeftHandKeysFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Near Sight Up"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Value = -1
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "NearSightLeftRB", 110, 23, 15, 45, __UI_GetID("LeftHandKeysFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Near Sight Left"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "NearSightRightRB", 120, 23, 15, 75, __UI_GetID("LeftHandKeysFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Near Sight Right"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "NearSightDownRB", 120, 23, 15, 105, __UI_GetID("LeftHandKeysFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Near Sight Down"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "FireRB", 60, 23, 15, 135, __UI_GetID("LeftHandKeysFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Fire"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_DropdownList, "SelectKeyDD", 60, 23, 15, 45, __UI_GetID("SelectKeyFR"))
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "SelectKeyLB", 140, 23, 15, 15, __UI_GetID("SelectKeyFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Select Key (Currently w):"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "DoneBT", 50, 23, 110, 75, __UI_GetID("SetKeysFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Done"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "SetBT", 50, 23, 98, 45, __UI_GetID("SelectKeyFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Set"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "DefaultBT", 70, 23, 20, 75, __UI_GetID("SetKeysFR"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Default"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_AssignIDs
|
||||
DuckShoot = __UI_GetID("DuckShoot")
|
||||
OptionsFR = __UI_GetID("OptionsFR")
|
||||
GameLevelFR = __UI_GetID("GameLevelFR")
|
||||
AudioFR = __UI_GetID("AudioFR")
|
||||
SetKeysFR = __UI_GetID("SetKeysFR")
|
||||
LeftHandKeysFR = __UI_GetID("LeftHandKeysFR")
|
||||
RightHandKeysFR = __UI_GetID("RightHandKeysFR")
|
||||
SelectKeyFR = __UI_GetID("SelectKeyFR")
|
||||
ExitBT = __UI_GetID("ExitBT")
|
||||
ResetBT = __UI_GetID("ResetBT")
|
||||
SetKeysBT = __UI_GetID("SetKeysBT")
|
||||
Level1RB = __UI_GetID("Level1RB")
|
||||
Level2RB = __UI_GetID("Level2RB")
|
||||
Level3RB = __UI_GetID("Level3RB")
|
||||
Level4RB = __UI_GetID("Level4RB")
|
||||
Level5RB = __UI_GetID("Level5RB")
|
||||
Level6RB = __UI_GetID("Level6RB")
|
||||
AudioOffRB = __UI_GetID("AudioOffRB")
|
||||
AudioOnRB = __UI_GetID("AudioOnRB")
|
||||
RestartLevelBT = __UI_GetID("RestartLevelBT")
|
||||
SetLeftHandKeysRB = __UI_GetID("SetLeftHandKeysRB")
|
||||
SetRightHandKeysRB = __UI_GetID("SetRightHandKeysRB")
|
||||
FarSightUpRB = __UI_GetID("FarSightUpRB")
|
||||
FarSightLeftRB = __UI_GetID("FarSightLeftRB")
|
||||
FarSightRightRB = __UI_GetID("FarSightRightRB")
|
||||
FarSightDownRB = __UI_GetID("FarSightDownRB")
|
||||
NearSightUpRB = __UI_GetID("NearSightUpRB")
|
||||
NearSightLeftRB = __UI_GetID("NearSightLeftRB")
|
||||
NearSightRightRB = __UI_GetID("NearSightRightRB")
|
||||
NearSightDownRB = __UI_GetID("NearSightDownRB")
|
||||
FireRB = __UI_GetID("FireRB")
|
||||
SelectKeyDD = __UI_GetID("SelectKeyDD")
|
||||
SelectKeyLB = __UI_GetID("SelectKeyLB")
|
||||
DoneBT = __UI_GetID("DoneBT")
|
||||
SetBT = __UI_GetID("SetBT")
|
||||
DefaultBT = __UI_GetID("DefaultBT")
|
||||
END SUB
|
BIN
examples/DuckShoot/OptionsFR.png
Normal file
After Width: | Height: | Size: 4.5 KiB |
BIN
examples/DuckShoot/curtains.png
Normal file
After Width: | Height: | Size: 746 KiB |
BIN
examples/DuckShoot/cyberbit.ttf
Normal file
10
examples/DuckShoot/ducks.cfg
Normal file
|
@ -0,0 +1,10 @@
|
|||
119
|
||||
115
|
||||
97
|
||||
100
|
||||
112
|
||||
46
|
||||
108
|
||||
39
|
||||
101
|
||||
1
|
BIN
examples/DuckShoot/fallover1.mp3
Normal file
BIN
examples/DuckShoot/fanfare.mp3
Normal file
BIN
examples/DuckShoot/funfair.mp3
Normal file
BIN
examples/DuckShoot/helloducky.ico
Normal file
After Width: | Height: | Size: 41 KiB |
BIN
examples/DuckShoot/medalimg.png
Normal file
After Width: | Height: | Size: 82 KiB |
BIN
examples/DuckShoot/pigeon1.png
Normal file
After Width: | Height: | Size: 128 KiB |
BIN
examples/DuckShoot/spiral.png
Normal file
After Width: | Height: | Size: 2.4 MiB |
BIN
examples/DuckShoot/tada.mp3
Normal file
BIN
examples/DuckShoot/target.png
Normal file
After Width: | Height: | Size: 8.6 KiB |
424
examples/Fahrenheit-Celsius/Fahrenheit-Celsius.bas
Normal file
|
@ -0,0 +1,424 @@
|
|||
': Fahrenheit-Celsius Converter by Qwerkey 16/05/20
|
||||
': Images: pngimg.com
|
||||
': This program uses
|
||||
': InForm - GUI library for QB64 - v1.1
|
||||
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
|
||||
$ASSERTS
|
||||
|
||||
': Controls' IDs: ------------------------------------------------------------------
|
||||
DIM SHARED FahrenheitToCelsius AS LONG
|
||||
DIM SHARED ScaleFrame AS LONG
|
||||
DIM SHARED FahrenheitPBox AS LONG
|
||||
DIM SHARED CelsiusPBox AS LONG
|
||||
DIM SHARED DispPB AS LONG
|
||||
DIM SHARED BodyTempRB AS LONG
|
||||
DIM SHARED RoomTempRB AS LONG
|
||||
DIM SHARED FahrenheitTB AS LONG
|
||||
DIM SHARED CelsiusTB AS LONG
|
||||
DIM SHARED FahrenheitLB AS LONG
|
||||
DIM SHARED CelsiusLB AS LONG
|
||||
DIM SHARED FixTextBoxesTS AS LONG
|
||||
DIM SHARED FixTextBoxesLB AS LONG
|
||||
DIM SHARED ExitBT AS LONG
|
||||
DIM SHARED PicUpdate%%, FSetTemp!, CSetTemp!
|
||||
DIM SHARED InFahrenheit%%, InCelsius%%, TClicked%%, TempT!
|
||||
|
||||
CONST FPos% = 12, CPos% = 31, YPos% = 20, TFPos% = 28, TCPos% = 47, TYPos% = 38, ScaleMin% = 668
|
||||
CONST TT% = 38, TB% = 668, FL% = 82, FR% = 106, CL% = 321, CR% = 345
|
||||
|
||||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'Fahrenheit-Celsius.frm'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Functions: ----------------------------------------------------------------------
|
||||
FUNCTION FTOC! (T!, Deg%%)
|
||||
IF Deg%% THEN
|
||||
FTOC! = (T! - 32) * 5 / 9
|
||||
ELSE
|
||||
FTOC! = (T! * 9 / 5) + 32
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION OnePlace! (Qty!)
|
||||
OnePlace! = CINT(10 * Qty!) / 10
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION IText$ (J!)
|
||||
__IText$ = LTRIM$(STR$(J!))
|
||||
IText$ = __IText$
|
||||
IF LEFT$(__IText$, 1) = "." THEN
|
||||
IText$ = "0" + __IText$
|
||||
ELSEIF LEFT$(__IText$, 2) = "-." THEN
|
||||
IText$ = "-0." + RIGHT$(__IText$, LEN(__IText$) - 2)
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
END SUB
|
||||
|
||||
SUB __UI_OnLoad
|
||||
_SCREENMOVE 120, 5
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUpdateDisplay
|
||||
'This event occurs at approximately 30 frames per second.
|
||||
'You can change the update frequency by calling SetFrameRate DesiredRate%
|
||||
STATIC InitDone%%, FThermometer&, TBase&, FLiquid&, CThermometer&, CLiquid&
|
||||
STATIC FT%, FB%, FS%, CT%, CB%, CS%, FTMax%, CTMax%, TD%, FTMin%, CTMin%, OldScale%%
|
||||
STATIC Pics&(), TRange!()
|
||||
|
||||
IF NOT InitDone%% THEN
|
||||
': Everything (except events) is done in the __UI_BeforeUpdateDisplay SUB
|
||||
': All initiations, image loading & manipulations are done once here
|
||||
InitDone%% = TRUE
|
||||
DIM Pics&(1, 4), TRange!(1, 3)
|
||||
': Read temperature Ranges
|
||||
RESTORE temp_range
|
||||
FOR I1%% = 0 TO 1
|
||||
FOR J1%% = 0 TO 3
|
||||
READ TRange!(I1%%, J1%%)
|
||||
NEXT J1%%
|
||||
NEXT I1%%
|
||||
': Load Images
|
||||
FOR J1%% = 0 TO 4
|
||||
Pics&(0, J1%%) = _LOADIMAGE("temp" + IText$(J1%%) + ".png", 32)
|
||||
_ASSERT Pics&(0, J1%%) < -1, "Failed to load temp" + IText$(J1%%) + ".png"
|
||||
Pics&(1, J1%%) = _LOADIMAGE("temp1" + IText$(J1%%) + ".png", 32)
|
||||
_ASSERT Pics&(1, J1%%) < -1, "Failed to load temp1" + IText$(J1%%) + ".png"
|
||||
NEXT J1%%
|
||||
': _MEM processing to convert red into green for Celsius thermometer
|
||||
DIM CMem AS _MEM, COff AS _OFFSET
|
||||
FThermometer& = _LOADIMAGE("thermo.png", 32)
|
||||
_ASSERT FThermometer& < -1, "Failed to load thermo.png"
|
||||
TBase& = _LOADIMAGE("tbase.png", 32)
|
||||
_ASSERT TBase& < -1, "Failed to load tbase.png"
|
||||
FLiquid& = _LOADIMAGE("rbase.png", 32)
|
||||
_ASSERT FLiquid& < -1, "Failed to load rbase.png"
|
||||
CThermometer& = _LOADIMAGE("thermo.png", 32)
|
||||
_ASSERT CThermometer& < -1, "Failed to load thermo.png"
|
||||
CLiquid& = _LOADIMAGE("rbase.png", 32)
|
||||
_ASSERT CLiquid& < -1, "Failed to load rbase.png"
|
||||
CMem = _MEMIMAGE(CThermometer&)
|
||||
COff = 0
|
||||
WHILE COff < CMem.SIZE
|
||||
B1~%% = _MEMGET(CMem, CMem.OFFSET + COff + 1, _UNSIGNED _BYTE) 'Green
|
||||
B2~%% = _MEMGET(CMem, CMem.OFFSET + COff + 2, _UNSIGNED _BYTE) 'Red
|
||||
IF _MEMGET(CMem, CMem.OFFSET + COff + 3, _UNSIGNED _BYTE) <> 0 THEN 'Alpha
|
||||
IF B2~%% / B1~%% > 1.5 THEN
|
||||
_MEMPUT CMem, CMem.OFFSET + COff + 1, B2~%% AS _UNSIGNED _BYTE 'Green
|
||||
_MEMPUT CMem, CMem.OFFSET + COff + 2, B1~%% AS _UNSIGNED _BYTE 'Red
|
||||
END IF
|
||||
END IF
|
||||
COff = COff + 4
|
||||
WEND
|
||||
_MEMFREE CMem
|
||||
CMem = _MEMIMAGE(CLiquid&)
|
||||
COff = 0
|
||||
WHILE COff < CMem.SIZE
|
||||
B1~%% = _MEMGET(CMem, CMem.OFFSET + COff + 1, _UNSIGNED _BYTE) 'Green
|
||||
B2~%% = _MEMGET(CMem, CMem.OFFSET + COff + 2, _UNSIGNED _BYTE) 'Red
|
||||
IF _MEMGET(CMem, CMem.OFFSET + COff + 3, _UNSIGNED _BYTE) <> 0 THEN 'Alpha
|
||||
IF B2~%% / B1~%% > 1.5 THEN
|
||||
_MEMPUT CMem, CMem.OFFSET + COff + 1, B2~%% AS _UNSIGNED _BYTE 'Green
|
||||
_MEMPUT CMem, CMem.OFFSET + COff + 2, B1~%% AS _UNSIGNED _BYTE 'Red
|
||||
END IF
|
||||
END IF
|
||||
COff = COff + 4
|
||||
WEND
|
||||
_MEMFREE CMem
|
||||
': Display thermometer images in picture boxes
|
||||
': All images are software (,32)
|
||||
BeginDraw FahrenheitPBox
|
||||
'Drawing code goes here
|
||||
_PUTIMAGE (FPos%, YPos%), FThermometer&
|
||||
COLOR _RGB32(0, 0, 0), _RGB32(235, 233, 237)
|
||||
_PRINTSTRING (72, 20), CHR$(248) + "F"
|
||||
EndDraw FahrenheitPBox
|
||||
BeginDraw CelsiusPBox
|
||||
'Drawing code goes here
|
||||
_PUTIMAGE (CPos%, YPos%), CThermometer&
|
||||
COLOR _RGB32(0, 0, 0), _RGB32(235, 233, 237)
|
||||
_PRINTSTRING (10, 20), CHR$(248) + "C"
|
||||
EndDraw CelsiusPBox
|
||||
END IF
|
||||
': New Scales
|
||||
IF Control(BodyTempRB).Value <> OldScale%% THEN
|
||||
OldScale%% = Control(BodyTempRB).Value
|
||||
IF OldScale%% THEN
|
||||
': Body Temperature Scales
|
||||
FSetTemp! = 98.4
|
||||
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, TRUE))
|
||||
Text(FahrenheitTB) = IText$(FSetTemp!)
|
||||
Text(CelsiusTB) = IText$(CSetTemp!)
|
||||
FT% = 44
|
||||
FB% = 644
|
||||
FS% = 5
|
||||
CT% = 50
|
||||
CB% = 610
|
||||
CS% = 7
|
||||
FTMax% = 106
|
||||
CTMax% = 42
|
||||
TD% = 10
|
||||
FTMin% = FTMax% - (FB% - FT%) / (FS% * TD%)
|
||||
CTMin% = CTMax% - (CB% - CT%) / (CS% * TD%)
|
||||
ELSE
|
||||
': Room Temperature Scales
|
||||
FT% = 70
|
||||
FB% = 590
|
||||
FS% = 2
|
||||
CT% = 60
|
||||
CB% = 620
|
||||
CS% = 4
|
||||
FTMax% = 220
|
||||
CTMax% = 100
|
||||
TD% = 1
|
||||
FTMin% = FTMax% - (FB% - FT%) / (FS% * TD%)
|
||||
CTMin% = CTMax% - (CB% - CT%) / (CS% * TD%)
|
||||
END IF
|
||||
': Draw Scales
|
||||
BeginDraw FahrenheitPBox
|
||||
LINE (60, TT% - 1)-(100, TB% - 1), _RGB32(235, 233, 237), BF
|
||||
LINE (62, FT%)-(62, FB% + 1), _RGB32(0, 0, 0)
|
||||
LINE (63, FT%)-(63, FB% + 1), _RGB32(0, 0, 0)
|
||||
FOR N% = 0 TO (FB% - FT%) / FS%
|
||||
LINE (62, FT% + N% * FS%)-(67, FT% + N% * FS%), _RGB32(0, 0, 0)
|
||||
IF N% \ 5 = N% / 5 THEN
|
||||
LINE (62, FT% + N% * FS%)-(70, FT% + N% * FS%), _RGB32(0, 0, 0)
|
||||
IF N% \ 10 = N% / 10 THEN
|
||||
LINE (62, FT% + 1 + N% * FS%)-(70, FT% + 1 + N% * FS%), _RGB32(0, 0, 0)
|
||||
_PRINTSTRING (72, FT% - 6 + N% * FS%), IText$(FTMax% - N% / TD%)
|
||||
END IF
|
||||
END IF
|
||||
NEXT N%
|
||||
EndDraw FahrenheitPBox
|
||||
BeginDraw CelsiusPBox
|
||||
LINE (0, TT% - 1)-(39, TB% - 1), _RGB32(235, 233, 237), BF
|
||||
LINE (38, CT%)-(38, CB% + 1), _RGB32(0, 0, 0)
|
||||
LINE (37, CT%)-(37, CB% + 1), _RGB32(0, 0, 0)
|
||||
FOR N% = 0 TO (CB% - CT%) / CS%
|
||||
LINE (33, CT% + N% * CS%)-(38, CT% + N% * CS%), _RGB32(0, 0, 0)
|
||||
IF N% \ 5 = N% / 5 THEN
|
||||
LINE (30, CT% + N% * CS%)-(38, CT% + N% * CS%), _RGB32(0, 0, 0)
|
||||
IF N% \ 10 = N% / 10 THEN
|
||||
LINE (30, CT% + 1 + N% * CS%)-(38, CT% + 1 + N% * CS%), _RGB32(0, 0, 0)
|
||||
M% = CTMax% - N% / TD%
|
||||
MS$ = IText$(M%)
|
||||
IF M% > 0 AND M% < 100 THEN
|
||||
MS$ = " " + MS$
|
||||
ELSEIF M% = 0 THEN
|
||||
MS$ = " " + MS$
|
||||
END IF
|
||||
_PRINTSTRING (4, CT% - 6 + N% * CS%), MS$
|
||||
END IF
|
||||
END IF
|
||||
NEXT N%
|
||||
EndDraw CelsiusPBox
|
||||
PicUpdate%% = TRUE
|
||||
END IF
|
||||
': Poll Mouse
|
||||
LM% = __UI_MouseLeft
|
||||
TM% = __UI_MouseTop
|
||||
': Look for position inside thermometer tubes and check Click
|
||||
IF LM% > 70 + TFPos% AND LM% < 70 + TFPos% + 24 AND TM% > FT% AND TM% < FB% THEN
|
||||
InFahrenheit%% = TRUE
|
||||
TempT! = OnePlace!(FTMax% + ((TM% - FT%) * (FTMin% - FTMax%) / (FB% - FT%)))
|
||||
IF NOT TClicked%% THEN Text(FahrenheitTB) = IText$(TempT!)
|
||||
ELSEIF LM% > 290 + TCPos% AND LM% < 290 + TCPos% + 24 AND TM% > CT% AND TM% < CB% THEN
|
||||
InCelsius%% = TRUE
|
||||
TempT! = OnePlace!(CTMax% + (TM% - CT%) * (CTMin% - CTMax%) / (CB% - CT%))
|
||||
IF NOT TClicked%% THEN Text(CelsiusTB) = IText$(TempT!)
|
||||
ELSE
|
||||
IF InFahrenheit%% AND NOT TClicked%% THEN
|
||||
Text(FahrenheitTB) = IText$(FSetTemp!)
|
||||
ELSEIF InCelsius%% AND NOT TClicked%% THEN
|
||||
Text(CelsiusTB) = IText$(CSetTemp!)
|
||||
END IF
|
||||
InFahrenheit%% = FALSE
|
||||
InCelsius%% = FALSE
|
||||
IF TClicked%% THEN TClicked%% = FALSE
|
||||
END IF
|
||||
': Update thermometers
|
||||
IF PicUpdate%% THEN
|
||||
PicUpdate%% = FALSE
|
||||
YF% = FT% + (FSetTemp! - FTMax%) * (FB% - FT%) / (FTMin% - FTMax%)
|
||||
YC% = CT% + (CSetTemp! - CTMax%) * (CB% - CT%) / (CTMin% - CTMax%)
|
||||
BeginDraw FahrenheitPBox
|
||||
_PUTIMAGE (TFPos%, TYPos%), TBase&
|
||||
IF YF% >= FT% AND YF% <= FB% THEN _PUTIMAGE (TFPos%, YF%)-(TFPos% + 24, ScaleMin%), FLiquid&, , (0, 0)-(24, ScaleMin% - YF%)
|
||||
EndDraw FahrenheitPBox
|
||||
BeginDraw CelsiusPBox
|
||||
_PUTIMAGE (TCPos%, TYPos%), TBase&
|
||||
IF YC% >= CT% AND YC% <= CB% THEN _PUTIMAGE (TCPos%, YC%)-(TCPos% + 24, ScaleMin%), CLiquid&, , (0, 0)-(24, ScaleMin% - YC%)
|
||||
EndDraw CelsiusPBox
|
||||
': If temperature outside thermometer scale do not display liquid column
|
||||
IF YF% < FT% OR YF% > FB% THEN YF% = ScaleMin%
|
||||
IF YC% < CT% OR YC% > CB% THEN YC% = ScaleMin%
|
||||
': If fixed text boxes, set at default
|
||||
IF Control(FixTextBoxesTS).Value THEN
|
||||
YF% = 396
|
||||
YC% = 396
|
||||
END IF
|
||||
Control(FahrenheitTB).Top = YF% - 8
|
||||
Control(CelsiusTB).Top = YC% - 8
|
||||
Control(FahrenheitLB).Top = YF% - 8 - 23
|
||||
Control(CelsiusLB).Top = YC% - 8 - 23
|
||||
': Display Image dependent upon temperature range
|
||||
BeginDraw DispPB
|
||||
LINE (0, 0)-(119, 199), _RGB32(235, 233, 237), BF
|
||||
IF Control(BodyTempRB).Value THEN
|
||||
SELECT CASE FSetTemp!
|
||||
CASE IS < TRange!(0, 0)
|
||||
_PUTIMAGE , Pics&(0, 0)
|
||||
CASE TRange!(0, 0) TO TRange!(0, 1)
|
||||
_PUTIMAGE , Pics&(0, 1)
|
||||
CASE TRange!(0, 1) TO TRange!(0, 2)
|
||||
_PUTIMAGE , Pics&(0, 2)
|
||||
CASE TRange!(0, 2) TO TRange!(0, 3)
|
||||
_PUTIMAGE , Pics&(0, 3)
|
||||
CASE IS > TRange!(0, 3)
|
||||
_PUTIMAGE , Pics&(0, 4)
|
||||
END SELECT
|
||||
ELSE
|
||||
SELECT CASE CSetTemp!
|
||||
CASE IS < TRange!(1, 0)
|
||||
_PUTIMAGE , Pics&(1, 0)
|
||||
CASE TRange!(1, 0) TO TRange!(1, 1)
|
||||
_PUTIMAGE , Pics&(1, 1)
|
||||
CASE TRange!(1, 1) TO TRange!(1, 2)
|
||||
_PUTIMAGE , Pics&(1, 2)
|
||||
CASE TRange!(1, 2) TO TRange!(1, 3)
|
||||
_PUTIMAGE , Pics&(1, 3)
|
||||
CASE IS > TRange!(1, 3)
|
||||
_PUTIMAGE , Pics&(1, 4)
|
||||
END SELECT
|
||||
END IF
|
||||
EndDraw DispPB
|
||||
END IF
|
||||
|
||||
temp_range:
|
||||
DATA 96.4,97.4,99.4,100.4
|
||||
DATA -10,10,30,50
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUnload
|
||||
'If you set __UI_UnloadSignal = False here you can
|
||||
'cancel the user's request to close.
|
||||
END SUB
|
||||
|
||||
SUB __UI_Click (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE FahrenheitToCelsius
|
||||
|
||||
CASE ScaleFrame
|
||||
|
||||
CASE DispPB
|
||||
|
||||
CASE BodyTempRB
|
||||
|
||||
CASE RoomTempRB
|
||||
|
||||
CASE FahrenheitTB
|
||||
|
||||
CASE CelsiusTB
|
||||
|
||||
CASE FahrenheitLB
|
||||
|
||||
CASE CelsiusLB
|
||||
|
||||
CASE FixTextBoxesLB
|
||||
|
||||
CASE FahrenheitPBox
|
||||
': Check for click in thermometer columns
|
||||
IF InFahrenheit%% AND NOT TClicked%% THEN
|
||||
TClicked%% = TRUE
|
||||
FSetTemp! = OnePlace!(TempT!)
|
||||
Text(FahrenheitTB) = IText$(FSetTemp!)
|
||||
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, TRUE))
|
||||
Text(CelsiusTB) = IText$(CSetTemp!)
|
||||
PicUpdate%% = TRUE
|
||||
END IF
|
||||
CASE CelsiusPBox
|
||||
': Check for click in thermometer columns
|
||||
IF InCelsius%% AND NOT TClicked%% THEN
|
||||
TClicked%% = TRUE
|
||||
CSetTemp! = OnePlace!(TempT!)
|
||||
Text(CelsiusTB) = IText$(CSetTemp!)
|
||||
FSetTemp! = OnePlace!(FTOC!(CSetTemp!, FALSE))
|
||||
Text(FahrenheitTB) = IText$(FSetTemp!)
|
||||
PicUpdate%% = TRUE
|
||||
END IF
|
||||
CASE FixTextBoxesTS
|
||||
': Check for Toggle Switch Click
|
||||
PicUpdate%% = TRUE
|
||||
CASE ExitBT
|
||||
': Click Exit Button
|
||||
SYSTEM
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseEnter (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseLeave (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusIn (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusOut (id AS LONG)
|
||||
'This event occurs right before a control loses focus.
|
||||
'To prevent a control from losing focus, set __UI_KeepFocus = True below.
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseDown (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseUp (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_KeyPress (id AS LONG)
|
||||
'When this event is fired, __UI_KeyHit will contain the code of the key hit.
|
||||
'You can change it and even cancel it by making it = 0
|
||||
IF __UI_KeyHit = 27 THEN 'Esc key (only responds after a Click event has happened)
|
||||
SYSTEM
|
||||
ELSEIF __UI_KeyHit = 13 THEN 'CR
|
||||
SELECT CASE id
|
||||
CASE BodyTempRB
|
||||
|
||||
CASE RoomTempRB
|
||||
|
||||
CASE FixTextBoxesTS
|
||||
|
||||
CASE FahrenheitTB
|
||||
': Update Fahrenheit temperature & convert
|
||||
FSetTemp! = OnePlace!(VAL(Text(FahrenheitTB)))
|
||||
Text(FahrenheitTB) = IText$(FSetTemp!)
|
||||
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, TRUE))
|
||||
Text(CelsiusTB) = IText$(CSetTemp!)
|
||||
PicUpdate%% = TRUE
|
||||
CASE CelsiusTB
|
||||
': Update Celsius temperature & convert
|
||||
CSetTemp! = OnePlace!(VAL(Text(CelsiusTB)))
|
||||
Text(CelsiusTB) = IText$(CSetTemp!)
|
||||
FSetTemp! = OnePlace!(FTOC!(CSetTemp!, FALSE))
|
||||
Text(FahrenheitTB) = IText$(FSetTemp!)
|
||||
PicUpdate%% = TRUE
|
||||
CASE ExitBT
|
||||
SYSTEM 'Does this condition ever get met?
|
||||
END SELECT
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB __UI_TextChanged (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_ValueChanged (id AS LONG)
|
||||
END SUB
|
||||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
121
examples/Fahrenheit-Celsius/Fahrenheit-Celsius.frm
Normal file
|
@ -0,0 +1,121 @@
|
|||
': This form was generated by
|
||||
': InForm - GUI library for QB64 - v1.5
|
||||
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
SUB __UI_LoadForm
|
||||
|
||||
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Form, "FahrenheitToCelsius", 460, 750, 0, 0, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Fahrenheit To Celsius"
|
||||
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 12)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "ScaleFrame", 110, 90, 175, 75, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Scale"
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Value = 2
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "FahrenheitPBox", 100, 750, 70, 0, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).Stretch = True
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "CelsiusPBox", 100, 750, 290, 0, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).Stretch = True
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "DispPB", 120, 120, 170, 320, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "BodyTempRB", 90, 23, 10, 16, __UI_GetID("ScaleFrame"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "BodyT emp"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Value = -1
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "RoomTempRB", 90, 23, 10, 46, __UI_GetID("ScaleFrame"))
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Room Temp"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_TextBox, "FahrenheitTB", 60, 23, 5, 388, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_TextBox, "CelsiusTB", 60, 23, 395, 388, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "FahrenheitLB", 60, 23, 5, 365, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Fahrenheit"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
Control(__UI_NewID).Value = -1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "CelsiusLB", 60, 22, 395, 365, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Celsius"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_ToggleSwitch, "FixTextBoxesTS", 40, 17, 210, 600, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "FixTextBoxesLB", 90, 23, 185, 570, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Fix Text Boxes"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "ExitBT", 80, 23, 190, 714, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Exit"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_AssignIDs
|
||||
FahrenheitToCelsius = __UI_GetID("FahrenheitToCelsius")
|
||||
ScaleFrame = __UI_GetID("ScaleFrame")
|
||||
FahrenheitPBox = __UI_GetID("FahrenheitPBox")
|
||||
CelsiusPBox = __UI_GetID("CelsiusPBox")
|
||||
DispPB = __UI_GetID("DispPB")
|
||||
BodyTempRB = __UI_GetID("BodyTempRB")
|
||||
RoomTempRB = __UI_GetID("RoomTempRB")
|
||||
FahrenheitTB = __UI_GetID("FahrenheitTB")
|
||||
CelsiusTB = __UI_GetID("CelsiusTB")
|
||||
FahrenheitLB = __UI_GetID("FahrenheitLB")
|
||||
CelsiusLB = __UI_GetID("CelsiusLB")
|
||||
FixTextBoxesTS = __UI_GetID("FixTextBoxesTS")
|
||||
FixTextBoxesLB = __UI_GetID("FixTextBoxesLB")
|
||||
ExitBT = __UI_GetID("ExitBT")
|
||||
END SUB
|
BIN
examples/Fahrenheit-Celsius/rbase.png
Normal file
After Width: | Height: | Size: 2.3 KiB |
BIN
examples/Fahrenheit-Celsius/tbase.png
Normal file
After Width: | Height: | Size: 4.8 KiB |
BIN
examples/Fahrenheit-Celsius/temp0.png
Normal file
After Width: | Height: | Size: 7 KiB |
BIN
examples/Fahrenheit-Celsius/temp1.png
Normal file
After Width: | Height: | Size: 6.3 KiB |
BIN
examples/Fahrenheit-Celsius/temp10.png
Normal file
After Width: | Height: | Size: 37 KiB |
BIN
examples/Fahrenheit-Celsius/temp11.png
Normal file
After Width: | Height: | Size: 41 KiB |
BIN
examples/Fahrenheit-Celsius/temp12.png
Normal file
After Width: | Height: | Size: 47 KiB |
BIN
examples/Fahrenheit-Celsius/temp13.png
Normal file
After Width: | Height: | Size: 44 KiB |
BIN
examples/Fahrenheit-Celsius/temp14.png
Normal file
After Width: | Height: | Size: 25 KiB |
BIN
examples/Fahrenheit-Celsius/temp2.png
Normal file
After Width: | Height: | Size: 7.4 KiB |
BIN
examples/Fahrenheit-Celsius/temp3.png
Normal file
After Width: | Height: | Size: 7.1 KiB |
BIN
examples/Fahrenheit-Celsius/temp4.png
Normal file
After Width: | Height: | Size: 7.1 KiB |
BIN
examples/Fahrenheit-Celsius/thermo.png
Normal file
After Width: | Height: | Size: 14 KiB |
422
examples/Fireworks2/Fireworks.bas
Normal file
|
@ -0,0 +1,422 @@
|
|||
': This program uses
|
||||
': InForm - GUI library for QB64 - v1.0
|
||||
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
|
||||
'Improved fireworks:
|
||||
' - Particles now leave a trail behind
|
||||
' - Round explosions (sin/cos been used...)
|
||||
' - Explosion sound effect.
|
||||
|
||||
OPTION _EXPLICIT
|
||||
|
||||
TYPE Vector
|
||||
x AS SINGLE
|
||||
y AS SINGLE
|
||||
END TYPE
|
||||
|
||||
TYPE Particle
|
||||
Pos AS Vector
|
||||
Vel AS Vector
|
||||
Acc AS Vector
|
||||
Visible AS _BYTE
|
||||
Exploded AS _BYTE
|
||||
ExplosionStep AS _BYTE
|
||||
ExplosionMax AS _BYTE
|
||||
Color AS _UNSIGNED LONG
|
||||
Size AS _BYTE
|
||||
END TYPE
|
||||
|
||||
REDIM SHARED Firework(1 TO 1) AS Particle
|
||||
REDIM SHARED Boom(1 TO UBOUND(Firework) * 2, 1) AS Particle
|
||||
DIM SHARED Trail(1 TO 20000) AS Particle
|
||||
|
||||
DIM SHARED StartPointLimit AS SINGLE, InitialVel AS SINGLE
|
||||
DIM SHARED Gravity AS Vector, Pause AS _BYTE, distant AS LONG
|
||||
|
||||
InitialVel = -30
|
||||
Gravity.y = .8
|
||||
distant = _SNDOPEN("distant.wav")
|
||||
|
||||
RANDOMIZE TIMER
|
||||
|
||||
': Controls' IDs: ------------------------------------------------------------------
|
||||
DIM SHARED BabyYoureAFirework AS LONG
|
||||
DIM SHARED Canvas AS LONG
|
||||
DIM SHARED MaxFireworksLB AS LONG
|
||||
DIM SHARED MaxFireworksTrackBar AS LONG
|
||||
DIM SHARED MaxParticlesLB AS LONG
|
||||
DIM SHARED MaxParticlesTrackBar AS LONG
|
||||
DIM SHARED ShowTextCB AS LONG
|
||||
DIM SHARED YourTextHereTB AS LONG
|
||||
DIM SHARED HappyNewYearLB AS LONG
|
||||
|
||||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'Fireworks.frm'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_OnLoad
|
||||
_TITLE "Baby, you're a firework"
|
||||
StartPointLimit = Control(Canvas).Height / 3
|
||||
Control(MaxFireworksTrackBar).Value = 20
|
||||
Control(MaxParticlesTrackBar).Value = 150
|
||||
ToolTip(MaxFireworksTrackBar) = "20"
|
||||
ToolTip(MaxParticlesTrackBar) = "150"
|
||||
REDIM _PRESERVE Firework(1 TO Control(MaxFireworksTrackBar).Value) AS Particle
|
||||
REDIM _PRESERVE Boom(1 TO UBOUND(Firework) * 2, Control(MaxParticlesTrackBar).Value) AS Particle
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUpdateDisplay
|
||||
STATIC JustExploded AS _BYTE
|
||||
STATIC t AS INTEGER, Initial AS _BYTE, InitialX AS INTEGER, lastInitial#
|
||||
|
||||
DIM AS LONG j, i, a
|
||||
DIM AS _UNSIGNED LONG thisColor
|
||||
|
||||
_DEST Control(Canvas).HelperCanvas
|
||||
|
||||
IF JustExploded THEN
|
||||
JustExploded = FALSE
|
||||
CLS , _RGB32(0, 0, 50)
|
||||
ELSE
|
||||
CLS
|
||||
END IF
|
||||
IF _CEIL(RND * 20) < 2 OR (Initial = FALSE AND TIMER - lastInitial# > .1) THEN
|
||||
'Create a new particle
|
||||
FOR j = 1 TO UBOUND(Firework)
|
||||
IF Firework(j).Visible = FALSE THEN
|
||||
Firework(j).Vel.y = InitialVel
|
||||
Firework(j).Vel.x = 3 - _CEIL(RND * 6)
|
||||
IF Initial = TRUE THEN
|
||||
Firework(j).Pos.x = _CEIL(RND * Control(Canvas).Width)
|
||||
ELSE
|
||||
Firework(j).Pos.x = InitialX * (Control(Canvas).Width / 15)
|
||||
InitialX = InitialX + 1
|
||||
lastInitial# = TIMER
|
||||
IF InitialX > 15 THEN Initial = TRUE
|
||||
END IF
|
||||
Firework(j).Pos.y = Control(Canvas).Height + _CEIL(RND * StartPointLimit)
|
||||
Firework(j).Visible = TRUE
|
||||
Firework(j).Exploded = FALSE
|
||||
Firework(j).ExplosionStep = 0
|
||||
Firework(j).Size = _CEIL(RND * 2)
|
||||
IF Firework(j).Size = 1 THEN
|
||||
Firework(j).ExplosionMax = 9 + _CEIL(RND * 41)
|
||||
ELSE
|
||||
Firework(j).ExplosionMax = 9 + _CEIL(RND * 71)
|
||||
END IF
|
||||
Firework(j).ExplosionMax = 20 '0
|
||||
EXIT FOR
|
||||
END IF
|
||||
NEXT j
|
||||
END IF
|
||||
|
||||
'Show trail
|
||||
FOR i = 1 TO UBOUND(Trail)
|
||||
IF NOT Pause THEN Trail(i).Color = Darken(Trail(i).Color, 70)
|
||||
IF Trail(i).Size = 1 THEN
|
||||
PSET (Trail(i).Pos.x, Trail(i).Pos.y), Trail(i).Color
|
||||
ELSE
|
||||
PSET (Trail(i).Pos.x, Trail(i).Pos.y), Trail(i).Color
|
||||
PSET (Trail(i).Pos.x - 1, Trail(i).Pos.y), Trail(i).Color
|
||||
PSET (Trail(i).Pos.x + 1, Trail(i).Pos.y), Trail(i).Color
|
||||
PSET (Trail(i).Pos.x, Trail(i).Pos.y - 1), Trail(i).Color
|
||||
PSET (Trail(i).Pos.x, Trail(i).Pos.y + 1), Trail(i).Color
|
||||
END IF
|
||||
NEXT i
|
||||
|
||||
'Update and show particles
|
||||
FOR i = 1 TO UBOUND(Firework)
|
||||
'Update trail particles
|
||||
|
||||
IF Firework(i).Visible = TRUE AND Firework(i).Exploded = FALSE AND NOT Pause THEN
|
||||
t = t + 1: IF t > UBOUND(Trail) THEN t = 1
|
||||
Trail(t).Pos.x = Firework(i).Pos.x
|
||||
Trail(t).Pos.y = Firework(i).Pos.y
|
||||
Trail(t).Color = _RGB32(255, 255, 255)
|
||||
|
||||
'New position
|
||||
Firework(i).Vel.y = Firework(i).Vel.y + Gravity.y
|
||||
Firework(i).Pos.y = Firework(i).Pos.y + Firework(i).Vel.y
|
||||
Firework(i).Pos.x = Firework(i).Pos.x + Firework(i).Vel.x
|
||||
END IF
|
||||
|
||||
'Explode the particle if it reaches max height
|
||||
IF Firework(i).Vel.y > 0 THEN
|
||||
IF Firework(i).Exploded = FALSE THEN
|
||||
Firework(i).Exploded = TRUE
|
||||
JustExploded = TRUE
|
||||
|
||||
IF Firework(1).Size = 1 THEN
|
||||
IF distant THEN _SNDPLAYCOPY distant, .5
|
||||
ELSE
|
||||
IF distant THEN _SNDPLAYCOPY distant, 1
|
||||
END IF
|
||||
|
||||
thisColor~& = _RGB32(_CEIL(RND * 255), _CEIL(RND * 255), _CEIL(RND * 255))
|
||||
a = 0
|
||||
FOR j = 1 TO UBOUND(Boom, 2)
|
||||
Boom(i, j).Pos.x = Firework(i).Pos.x
|
||||
Boom(i, j).Pos.y = Firework(i).Pos.y
|
||||
Boom(i, j).Vel.y = SIN(a) * (RND * 10)
|
||||
Boom(i, j).Vel.x = COS(a) * (RND * 10)
|
||||
a = a + 1
|
||||
Boom(i, j).Color = thisColor~&
|
||||
|
||||
Boom(i * 2, j).Pos.x = Firework(i).Pos.x + 5
|
||||
Boom(i * 2, j).Pos.y = Firework(i).Pos.y + 5
|
||||
Boom(i * 2, j).Vel.y = Boom(i, j).Vel.y
|
||||
Boom(i * 2, j).Vel.x = Boom(i, j).Vel.x
|
||||
a = a + 1
|
||||
Boom(i * 2, j).Color = thisColor~&
|
||||
NEXT
|
||||
END IF
|
||||
END IF
|
||||
|
||||
'Show particle
|
||||
IF Firework(i).Exploded = FALSE THEN
|
||||
IF Firework(i).Size = 1 THEN
|
||||
PSET (Firework(i).Pos.x, Firework(i).Pos.y), _RGB32(255, 255, 255)
|
||||
ELSE
|
||||
PSET (Firework(i).Pos.x, Firework(i).Pos.y), _RGB32(255, 255, 255)
|
||||
PSET (Firework(i).Pos.x - 1, Firework(i).Pos.y), _RGB32(255, 255, 255)
|
||||
PSET (Firework(i).Pos.x + 1, Firework(i).Pos.y), _RGB32(255, 255, 255)
|
||||
PSET (Firework(i).Pos.x, Firework(i).Pos.y - 1), _RGB32(255, 255, 255)
|
||||
PSET (Firework(i).Pos.x, Firework(i).Pos.y + 1), _RGB32(255, 255, 255)
|
||||
END IF
|
||||
ELSEIF Firework(i).Visible THEN
|
||||
IF NOT Pause THEN Firework(i).ExplosionStep = Firework(i).ExplosionStep + 1
|
||||
FOR j = 1 TO UBOUND(Boom, 2)
|
||||
IF Firework(i).Size = 1 THEN
|
||||
PSET (Boom(i, j).Pos.x, Boom(i, j).Pos.y), Boom(i, j).Color
|
||||
ELSE
|
||||
PSET (Boom(i, j).Pos.x, Boom(i, j).Pos.y), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
|
||||
PSET (Boom(i, j).Pos.x - 1, Boom(i, j).Pos.y), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
|
||||
PSET (Boom(i, j).Pos.x + 1, Boom(i, j).Pos.y), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
|
||||
PSET (Boom(i, j).Pos.x, Boom(i, j).Pos.y - 1), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
|
||||
PSET (Boom(i, j).Pos.x, Boom(i, j).Pos.y + 1), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
|
||||
END IF
|
||||
IF NOT Pause THEN
|
||||
t = t + 1: IF t > UBOUND(Trail) THEN t = 1
|
||||
Trail(t).Pos.x = Boom(i, j).Pos.x
|
||||
Trail(t).Pos.y = Boom(i, j).Pos.y
|
||||
Trail(t).Size = Boom(i, j).Size
|
||||
Trail(t).Color = Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
|
||||
|
||||
t = t + 1: IF t > UBOUND(Trail) THEN t = 1
|
||||
Trail(t).Pos.x = Boom(i * 2, j).Pos.x
|
||||
Trail(t).Pos.y = Boom(i * 2, j).Pos.y
|
||||
Trail(t).Size = Boom(i * 2, j).Size
|
||||
Trail(t).Color = Darken(Boom(i * 2, j).Color, 150)
|
||||
|
||||
Boom(i, j).Vel.y = Boom(i, j).Vel.y + Gravity.y / 10
|
||||
Boom(i, j).Pos.x = Boom(i, j).Pos.x + Boom(i, j).Vel.x '+ Firework(i).Vel.x
|
||||
Boom(i, j).Pos.y = Boom(i, j).Pos.y + Boom(i, j).Vel.y
|
||||
Boom(i * 2, j).Vel.y = Boom(i * 2, j).Vel.y + Gravity.y / 10
|
||||
Boom(i * 2, j).Pos.x = Boom(i * 2, j).Pos.x + Boom(i * 2, j).Vel.x '+ Firework(i).Vel.x
|
||||
Boom(i * 2, j).Pos.y = Boom(i * 2, j).Pos.y + Boom(i * 2, j).Vel.y
|
||||
END IF
|
||||
NEXT
|
||||
IF Firework(i).ExplosionStep > Firework(i).ExplosionMax THEN Firework(i).Visible = FALSE
|
||||
END IF
|
||||
NEXT
|
||||
|
||||
Control(HappyNewYearLB).Hidden = NOT Control(ShowTextCB).Value
|
||||
|
||||
_DEST 0
|
||||
Control(Canvas).PreviousValue = 0
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUnload
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_Click (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE BabyYoureAFirework
|
||||
|
||||
CASE Canvas
|
||||
Pause = NOT Pause
|
||||
IF Pause THEN
|
||||
Caption(HappyNewYearLB) = "PAUSED"
|
||||
ELSE
|
||||
Caption(HappyNewYearLB) = Text(YourTextHereTB)
|
||||
END IF
|
||||
CASE MaxFireworksLB
|
||||
|
||||
CASE MaxFireworksTrackBar
|
||||
|
||||
CASE MaxParticlesLB
|
||||
|
||||
CASE MaxParticlesTrackBar
|
||||
|
||||
CASE ShowTextCB
|
||||
|
||||
CASE YourTextHereTB
|
||||
|
||||
CASE HappyNewYearLB
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseEnter (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE BabyYoureAFirework
|
||||
|
||||
CASE Canvas
|
||||
|
||||
CASE MaxFireworksLB
|
||||
|
||||
CASE MaxFireworksTrackBar
|
||||
|
||||
CASE MaxParticlesLB
|
||||
|
||||
CASE MaxParticlesTrackBar
|
||||
|
||||
CASE ShowTextCB
|
||||
|
||||
CASE YourTextHereTB
|
||||
|
||||
CASE HappyNewYearLB
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseLeave (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE BabyYoureAFirework
|
||||
|
||||
CASE Canvas
|
||||
|
||||
CASE MaxFireworksLB
|
||||
|
||||
CASE MaxFireworksTrackBar
|
||||
|
||||
CASE MaxParticlesLB
|
||||
|
||||
CASE MaxParticlesTrackBar
|
||||
|
||||
CASE ShowTextCB
|
||||
|
||||
CASE YourTextHereTB
|
||||
|
||||
CASE HappyNewYearLB
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusIn (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE MaxFireworksTrackBar
|
||||
|
||||
CASE MaxParticlesTrackBar
|
||||
|
||||
CASE ShowTextCB
|
||||
|
||||
CASE YourTextHereTB
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusOut (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE MaxFireworksTrackBar
|
||||
|
||||
CASE MaxParticlesTrackBar
|
||||
|
||||
CASE ShowTextCB
|
||||
|
||||
CASE YourTextHereTB
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseDown (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE BabyYoureAFirework
|
||||
|
||||
CASE Canvas
|
||||
|
||||
CASE MaxFireworksLB
|
||||
|
||||
CASE MaxFireworksTrackBar
|
||||
|
||||
CASE MaxParticlesLB
|
||||
|
||||
CASE MaxParticlesTrackBar
|
||||
|
||||
CASE ShowTextCB
|
||||
|
||||
CASE YourTextHereTB
|
||||
|
||||
CASE HappyNewYearLB
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseUp (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE BabyYoureAFirework
|
||||
|
||||
CASE Canvas
|
||||
|
||||
CASE MaxFireworksLB
|
||||
|
||||
CASE MaxFireworksTrackBar
|
||||
|
||||
CASE MaxParticlesLB
|
||||
|
||||
CASE MaxParticlesTrackBar
|
||||
|
||||
CASE ShowTextCB
|
||||
|
||||
CASE YourTextHereTB
|
||||
|
||||
CASE HappyNewYearLB
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_KeyPress (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE MaxFireworksTrackBar
|
||||
|
||||
CASE MaxParticlesTrackBar
|
||||
|
||||
CASE ShowTextCB
|
||||
|
||||
CASE YourTextHereTB
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_TextChanged (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE YourTextHereTB
|
||||
Caption(HappyNewYearLB) = Text(YourTextHereTB)
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_ValueChanged (id AS LONG)
|
||||
Control(id).Value = INT(Control(id).Value)
|
||||
SELECT CASE id
|
||||
CASE ShowTextCB
|
||||
|
||||
CASE MaxFireworksTrackBar
|
||||
REDIM _PRESERVE Firework(1 TO Control(MaxFireworksTrackBar).Value) AS Particle
|
||||
ToolTip(id) = STR$(Control(MaxFireworksTrackBar).Value)
|
||||
CASE MaxParticlesTrackBar
|
||||
REDIM _PRESERVE Boom(1 TO UBOUND(Firework) * 2, Control(MaxParticlesTrackBar).Value) AS Particle
|
||||
ToolTip(id) = STR$(Control(MaxParticlesTrackBar).Value)
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
90
examples/Fireworks2/Fireworks.frm
Normal file
|
@ -0,0 +1,90 @@
|
|||
': This form was generated by
|
||||
': InForm - GUI library for QB64 - v1.5
|
||||
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
SUB __UI_LoadForm
|
||||
|
||||
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Form, "BabyYoureAFirework", 810, 663, 0, 0, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Baby, you're a firework"
|
||||
Control(__UI_NewID).Font = SetFont("arial.ttf?InForm/resources/NotoMono-Regular.ttf", 12)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CenteredWindow = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "Canvas", 800, 600, 5, 5, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).Stretch = True
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "MaxFireworksLB", 86, 23, 5, 612, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Max fireworks:"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_TrackBar, "MaxFireworksTrackBar", 120, 40, 95, 612, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Min = 1
|
||||
Control(__UI_NewID).Max = 20
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).Interval = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "MaxParticlesLB", 86, 23, 235, 612, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Max particles:"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_TrackBar, "MaxParticlesTrackBar", 250, 40, 325, 612, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Min = 1
|
||||
Control(__UI_NewID).Max = 150
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).Interval = 30
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "ShowTextCB", 87, 23, 590, 620, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Show text:"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Value = -1
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_TextBox, "YourTextHereTB", 129, 23, 676, 620, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Your text here"
|
||||
Text(__UI_NewID) = "Happy New Year!"
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Label, "HappyNewYearLB", 800, 78, 5, 527, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "Happy New Year!"
|
||||
Control(__UI_NewID).Font = SetFont("cyberbit.ttf?times.ttf?arial.ttf?InForm/resources/NotoMono-Regular.ttf", 48)
|
||||
Control(__UI_NewID).ForeColor = _RGB32(255, 255, 255)
|
||||
Control(__UI_NewID).BackStyle = __UI_Transparent
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_AssignIDs
|
||||
BabyYoureAFirework = __UI_GetID("BabyYoureAFirework")
|
||||
Canvas = __UI_GetID("Canvas")
|
||||
MaxFireworksLB = __UI_GetID("MaxFireworksLB")
|
||||
MaxFireworksTrackBar = __UI_GetID("MaxFireworksTrackBar")
|
||||
MaxParticlesLB = __UI_GetID("MaxParticlesLB")
|
||||
MaxParticlesTrackBar = __UI_GetID("MaxParticlesTrackBar")
|
||||
ShowTextCB = __UI_GetID("ShowTextCB")
|
||||
YourTextHereTB = __UI_GetID("YourTextHereTB")
|
||||
HappyNewYearLB = __UI_GetID("HappyNewYearLB")
|
||||
END SUB
|
BIN
examples/Fireworks2/distant.wav
Normal file
147
examples/GIFPlaySample/GIFPlaySample.bas
Normal file
|
@ -0,0 +1,147 @@
|
|||
': This program uses
|
||||
': InForm - GUI library for QB64 - Beta version 9
|
||||
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
|
||||
DEFLNG A-Z
|
||||
OPTION _EXPLICIT
|
||||
|
||||
': Controls' IDs: ------------------------------------------------------------------
|
||||
DIM SHARED DoneProgressBar AS LONG
|
||||
DIM SHARED AboutButton AS LONG
|
||||
DIM SHARED GIFPlaySample AS LONG
|
||||
DIM SHARED GIFPictureBox AS LONG
|
||||
DIM SHARED LoadButton AS LONG
|
||||
DIM SHARED PlayButton AS LONG
|
||||
|
||||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/extensions/GIFPlay.bi'
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'GIFPlaySample.frm'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/extensions/GIFPlay.bas'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
END SUB
|
||||
|
||||
SUB __UI_OnLoad
|
||||
Control(PlayButton).Disabled = TRUE
|
||||
Control(DoneProgressBar).Disabled = TRUE
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUpdateDisplay
|
||||
IF GIF_IsLoaded(GIFPictureBox) THEN
|
||||
GIF_Draw GIFPictureBox
|
||||
Control(DoneProgressBar).Value = (GIF_GetElapsedTime(GIFPictureBox) / GIF_GetTotalDuration(GIFPictureBox)) * 100
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUnload
|
||||
END SUB
|
||||
|
||||
SUB __UI_Click (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE DoneProgressBar
|
||||
|
||||
CASE AboutButton
|
||||
MessageBox "GIFPlay library + InForm-PE demo." + STRING$(2, 10) + "Get it from https://github.com/a740g/InForm-PE", "About " + Caption(GIFPlaySample), MsgBox_OkOnly + MsgBox_Information
|
||||
|
||||
CASE GIFPlaySample
|
||||
|
||||
CASE LoadButton
|
||||
DIM fileName AS STRING: fileName = _OPENFILEDIALOG$(Caption(GIFPlaySample), , "*.gif|*.GIF|*.Gif", "GIF Files")
|
||||
|
||||
IF LEN(fileName) > 0 THEN
|
||||
IF GIF_LoadFromFile(GIFPictureBox, fileName) THEN
|
||||
' Calculate picturebox width based on the aspect ratio of the GIF
|
||||
Control(GIFPictureBox).Width = GIF_GetWidth(GIFPictureBox) / GIF_GetHeight(GIFPictureBox) * Control(GIFPictureBox).Height
|
||||
Control(GIFPlaySample).Width = Control(GIFPictureBox).Width + Control(LoadButton).Width + 24
|
||||
Control(DoneProgressBar).Width = Control(GIFPictureBox).Width
|
||||
|
||||
Control(DoneProgressBar).Disabled = FALSE
|
||||
|
||||
IF GIF_GetTotalFrames(GIFPictureBox) > 1 THEN
|
||||
Control(PlayButton).Disabled = FALSE
|
||||
Caption(PlayButton) = "Play"
|
||||
ELSE
|
||||
Control(PlayButton).Disabled = TRUE
|
||||
END IF
|
||||
ELSE
|
||||
Control(PlayButton).Disabled = TRUE
|
||||
Control(DoneProgressBar).Disabled = TRUE
|
||||
MessageBox fileName + " failed to load!", "", MsgBox_Exclamation
|
||||
END IF
|
||||
END IF
|
||||
|
||||
CASE PlayButton
|
||||
IF GIF_IsPlaying(GIFPictureBox) THEN
|
||||
GIF_Pause GIFPictureBox
|
||||
Caption(PlayButton) = "Play"
|
||||
ELSE
|
||||
GIF_Play GIFPictureBox
|
||||
Caption(PlayButton) = "Pause"
|
||||
END IF
|
||||
|
||||
CASE GIFPictureBox
|
||||
GIF_EnableOverlay GIFPictureBox, FALSE
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseEnter (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE ELSE
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseLeave (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE ELSE
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusIn (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE ELSE
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FocusOut (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE ELSE
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseDown (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE ELSE
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_MouseUp (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE ELSE
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_KeyPress (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE ELSE
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_TextChanged (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE ELSE
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_ValueChanged (id AS LONG)
|
||||
SELECT CASE id
|
||||
CASE ELSE
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
59
examples/GIFPlaySample/GIFPlaySample.frm
Normal file
|
@ -0,0 +1,59 @@
|
|||
': This form was generated by
|
||||
': InForm - GUI library for QB64 - v1.5
|
||||
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
|
||||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
SUB __UI_LoadForm
|
||||
|
||||
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Form, "GIFPlaySample", 425, 367, 0, 0, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "GIFPlay Sample"
|
||||
Control(__UI_NewID).Font = SetFont("arial.ttf", 12)
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "GIFPictureBox", 320, 320, 95, 10, 0)
|
||||
__UI_RegisterResult = 0
|
||||
Control(__UI_NewID).Stretch = True
|
||||
Control(__UI_NewID).HasBorder = True
|
||||
Control(__UI_NewID).Align = __UI_Center
|
||||
Control(__UI_NewID).VAlign = __UI_Middle
|
||||
Control(__UI_NewID).BorderSize = 1
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "LoadButton", 80, 40, 10, 10, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "&Load"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "PlayButton", 80, 40, 10, 55, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "&Play"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "AboutButton", 80, 40, 10, 100, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "&About"
|
||||
Control(__UI_NewID).Stretch = True
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
__UI_NewID = __UI_NewControl(__UI_Type_ProgressBar, "DoneProgressBar", 320, 23, 95, 335, 0)
|
||||
__UI_RegisterResult = 0
|
||||
SetCaption __UI_NewID, "\92;#"
|
||||
Control(__UI_NewID).HasBorder = False
|
||||
Control(__UI_NewID).Max = 100
|
||||
Control(__UI_NewID).ShowPercentage = True
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_AssignIDs
|
||||
GIFPlaySample = __UI_GetID("GIFPlaySample")
|
||||
GIFPictureBox = __UI_GetID("GIFPictureBox")
|
||||
LoadButton = __UI_GetID("LoadButton")
|
||||
PlayButton = __UI_GetID("PlayButton")
|
||||
AboutButton = __UI_GetID("AboutButton")
|
||||
DoneProgressBar = __UI_GetID("DoneProgressBar")
|
||||
END SUB
|
BIN
examples/GIFPlaySample/Newtons_cradle_animation_book_2.gif
Normal file
After Width: | Height: | Size: 301 KiB |
After Width: | Height: | Size: 1.6 KiB |
BIN
examples/GIFPlaySample/Rotating_earth_(large).gif
Normal file
After Width: | Height: | Size: 978 KiB |
BIN
examples/GIFPlaySample/SmallFullColourGIF.gif
Normal file
After Width: | Height: | Size: 53 KiB |
BIN
examples/GIFPlaySample/Sunflower_as_gif_websafe.gif
Normal file
After Width: | Height: | Size: 27 KiB |
BIN
examples/GIFPlaySample/badger.gif
Normal file
After Width: | Height: | Size: 104 KiB |