mirror of
https://github.com/FellippeHeitor/InForm.git
synced 2025-01-15 03:49:56 +00:00
Major refactoring. New GIFPlayer inbound
This commit is contained in:
Samuel Gomes
parent
3867088da3
commit
47f51909a8
16 changed files with 1542 additions and 1416 deletions
|
|
@ -1,6 +1,6 @@
|
||||||
'Starting with v1.0, __UI_VersionNumber is actually the current build.
|
'Starting with v1.0, __UI_VersionNumber is actually the current build.
|
||||||
|
|
||||||
CONST __UI_Version = "v1.5"
|
CONST __UI_Version = "v1.5"
|
||||||
CONST __UI_VersionNumber = 1
|
CONST __UI_VersionNumber = 2
|
||||||
CONST __UI_VersionIsBeta = 1
|
CONST __UI_VersionIsBeta = 1
|
||||||
CONST __UI_CopyrightSpan = "2016-2023"
|
CONST __UI_CopyrightSpan = "2016-2023"
|
||||||
|
|
|
||||||
|
|
@ -328,11 +328,10 @@ $ELSE
|
||||||
END DECLARE
|
END DECLARE
|
||||||
$END IF
|
$END IF
|
||||||
|
|
||||||
'$include:'ini.bi'
|
'$INCLUDE:'InForm.bi'
|
||||||
'$include:'InForm.bi'
|
'$INCLUDE:'extensions/Ini.bi'
|
||||||
'$include:'xp.uitheme'
|
'$INCLUDE:'xp.uitheme'
|
||||||
'$include:'UiEditor.frm'
|
'$INCLUDE:'UiEditor.frm'
|
||||||
'$include:'ini.bm'
|
|
||||||
|
|
||||||
'Event procedures: ---------------------------------------------------------------
|
'Event procedures: ---------------------------------------------------------------
|
||||||
SUB __UI_Click (id AS LONG)
|
SUB __UI_Click (id AS LONG)
|
||||||
|
|
@ -5115,4 +5114,5 @@ FUNCTION OutsideQuotes%% (text$, position AS LONG)
|
||||||
OutsideQuotes%% = NOT quote%%
|
OutsideQuotes%% = NOT quote%%
|
||||||
END FUNCTION
|
END FUNCTION
|
||||||
|
|
||||||
'$include:'InForm.ui'
|
'$INCLUDE:'extensions/Ini.bas'
|
||||||
|
'$INCLUDE:'InForm.ui'
|
||||||
|
|
|
||||||
|
|
@ -91,11 +91,10 @@ $END IF
|
||||||
ContextMenuIcon = LoadEditorImage("contextmenu.bmp")
|
ContextMenuIcon = LoadEditorImage("contextmenu.bmp")
|
||||||
__UI_ClearColor ContextMenuIcon, 0, 0
|
__UI_ClearColor ContextMenuIcon, 0, 0
|
||||||
|
|
||||||
'$include:'extensions/GIFPlay.bi'
|
'$INCLUDE:'InForm.bi'
|
||||||
'$include:'InForm.bi'
|
'$INCLUDE:'extensions/GIFPlay.bi'
|
||||||
'$include:'xp.uitheme'
|
'$INCLUDE:'xp.uitheme'
|
||||||
'$include:'UiEditorPreview.frm'
|
'$INCLUDE:'UiEditorPreview.frm'
|
||||||
'$include:'extensions/GIFPlay.bm'
|
|
||||||
|
|
||||||
'Event procedures: ---------------------------------------------------------------
|
'Event procedures: ---------------------------------------------------------------
|
||||||
SUB __UI_Click (id AS LONG)
|
SUB __UI_Click (id AS LONG)
|
||||||
|
|
@ -166,7 +165,7 @@ SUB __UI_BeforeUpdateDisplay
|
||||||
END IF
|
END IF
|
||||||
|
|
||||||
FOR i = 1 TO UBOUND(AutoPlayGif)
|
FOR i = 1 TO UBOUND(AutoPlayGif)
|
||||||
IF AutoPlayGif(i) THEN UpdateGif i
|
IF AutoPlayGif(i) THEN GIF_Draw i
|
||||||
NEXT
|
NEXT
|
||||||
|
|
||||||
STATIC prevDefaultButton AS LONG, prevMenuPanelActive AS INTEGER
|
STATIC prevDefaultButton AS LONG, prevMenuPanelActive AS INTEGER
|
||||||
|
|
@ -327,7 +326,7 @@ SUB __UI_BeforeUpdateDisplay
|
||||||
FOR i = 1 TO UBOUND(Control)
|
FOR i = 1 TO UBOUND(Control)
|
||||||
IF AutoPlayGif(i) THEN
|
IF AutoPlayGif(i) THEN
|
||||||
AutoPlayGif(i) = False
|
AutoPlayGif(i) = False
|
||||||
StopGif i
|
GIF_Stop i
|
||||||
END IF
|
END IF
|
||||||
NEXT
|
NEXT
|
||||||
CASE "BINDCONTROLS"
|
CASE "BINDCONTROLS"
|
||||||
|
|
@ -1531,13 +1530,13 @@ SUB __UI_BeforeUpdateDisplay
|
||||||
IF TotalLockedControls THEN
|
IF TotalLockedControls THEN
|
||||||
FOR j = 1 TO TotalLockedControls
|
FOR j = 1 TO TotalLockedControls
|
||||||
AutoPlayGif(LockedControls(j)) = CVI(b$)
|
AutoPlayGif(LockedControls(j)) = CVI(b$)
|
||||||
IF AutoPlayGif(LockedControls(j)) THEN PlayGif LockedControls(j) ELSE StopGif LockedControls(j)
|
IF AutoPlayGif(LockedControls(j)) THEN GIF_Play LockedControls(j) ELSE GIF_Stop LockedControls(j)
|
||||||
NEXT
|
NEXT
|
||||||
ELSE
|
ELSE
|
||||||
FOR i = 1 TO UBOUND(Control)
|
FOR i = 1 TO UBOUND(Control)
|
||||||
IF Control(i).ControlIsSelected THEN
|
IF Control(i).ControlIsSelected THEN
|
||||||
AutoPlayGif(i) = CVI(b$)
|
AutoPlayGif(i) = CVI(b$)
|
||||||
IF AutoPlayGif(i) THEN PlayGif i ELSE StopGif i
|
IF AutoPlayGif(i) THEN GIF_Play i ELSE GIF_Stop i
|
||||||
END IF
|
END IF
|
||||||
NEXT
|
NEXT
|
||||||
END IF
|
END IF
|
||||||
|
|
@ -2219,7 +2218,7 @@ SUB DeleteSelectedControls
|
||||||
IF __UI_TotalActiveMenus > 0 AND __UI_ParentMenu(__UI_TotalActiveMenus) = Control(i).ID THEN
|
IF __UI_TotalActiveMenus > 0 AND __UI_ParentMenu(__UI_TotalActiveMenus) = Control(i).ID THEN
|
||||||
__UI_CloseAllMenus
|
__UI_CloseAllMenus
|
||||||
END IF
|
END IF
|
||||||
CloseGif i
|
GIF_Close i
|
||||||
__UI_DestroyControl Control(i)
|
__UI_DestroyControl Control(i)
|
||||||
IF MustRefreshMenuBar THEN __UI_RefreshMenuBar
|
IF MustRefreshMenuBar THEN __UI_RefreshMenuBar
|
||||||
IF MustRefreshContextMenus THEN RefreshContextMenus
|
IF MustRefreshContextMenus THEN RefreshContextMenus
|
||||||
|
|
@ -2389,7 +2388,7 @@ SUB LoadPreview (Destination AS _BYTE)
|
||||||
IF Disk THEN
|
IF Disk THEN
|
||||||
FOR i = UBOUND(Control) TO 1 STEP -1
|
FOR i = UBOUND(Control) TO 1 STEP -1
|
||||||
IF LEFT$(Control(i).Name, 5) <> "__UI_" THEN
|
IF LEFT$(Control(i).Name, 5) <> "__UI_" THEN
|
||||||
CloseGif i
|
GIF_Close i
|
||||||
__UI_DestroyControl Control(i)
|
__UI_DestroyControl Control(i)
|
||||||
END IF
|
END IF
|
||||||
NEXT
|
NEXT
|
||||||
|
|
@ -2408,7 +2407,7 @@ SUB LoadPreview (Destination AS _BYTE)
|
||||||
ELSEIF UndoBuffer THEN
|
ELSEIF UndoBuffer THEN
|
||||||
FOR i = UBOUND(Control) TO 1 STEP -1
|
FOR i = UBOUND(Control) TO 1 STEP -1
|
||||||
IF LEFT$(Control(i).Name, 5) <> "__UI_" THEN
|
IF LEFT$(Control(i).Name, 5) <> "__UI_" THEN
|
||||||
CloseGif i
|
GIF_Close i
|
||||||
__UI_DestroyControl Control(i)
|
__UI_DestroyControl Control(i)
|
||||||
END IF
|
END IF
|
||||||
NEXT
|
NEXT
|
||||||
|
|
@ -2765,7 +2764,7 @@ SUB LoadPreview (Destination AS _BYTE)
|
||||||
IF NOT CorruptedData THEN
|
IF NOT CorruptedData THEN
|
||||||
__UI_FirstSelectedID = FirstToBeSelected
|
__UI_FirstSelectedID = FirstToBeSelected
|
||||||
ELSE
|
ELSE
|
||||||
CloseGif TempValue
|
GIF_Close TempValue
|
||||||
__UI_DestroyControl Control(TempValue)
|
__UI_DestroyControl Control(TempValue)
|
||||||
__UI_TotalSelectedControls = __UI_TotalSelectedControls - 1
|
__UI_TotalSelectedControls = __UI_TotalSelectedControls - 1
|
||||||
END IF
|
END IF
|
||||||
|
|
@ -2811,7 +2810,7 @@ SUB LoadPreviewText
|
||||||
__UI_AutoRefresh = False
|
__UI_AutoRefresh = False
|
||||||
FOR i = UBOUND(Control) TO 1 STEP -1
|
FOR i = UBOUND(Control) TO 1 STEP -1
|
||||||
IF LEFT$(Control(i).Name, 5) <> "__UI_" THEN
|
IF LEFT$(Control(i).Name, 5) <> "__UI_" THEN
|
||||||
CloseGif i
|
GIF_Close i
|
||||||
__UI_DestroyControl Control(i)
|
__UI_DestroyControl Control(i)
|
||||||
END IF
|
END IF
|
||||||
NEXT
|
NEXT
|
||||||
|
|
@ -3063,21 +3062,21 @@ SUB LoadPreviewText
|
||||||
DIM RegisterResult AS _BYTE
|
DIM RegisterResult AS _BYTE
|
||||||
DummyText$ = nextParameter(b$) 'discard first parameter
|
DummyText$ = nextParameter(b$) 'discard first parameter
|
||||||
DummyText$ = nextParameter(b$)
|
DummyText$ = nextParameter(b$)
|
||||||
RegisterResult = OpenGif(TempValue, DummyText$)
|
RegisterResult = GIF_OpenFile(TempValue, DummyText$)
|
||||||
IF RegisterResult THEN
|
IF RegisterResult THEN
|
||||||
IF LogFileLoad THEN PRINT #LogFileNum, "LOAD SUCCESSFUL"
|
IF LogFileLoad THEN PRINT #LogFileNum, "LOAD SUCCESSFUL"
|
||||||
Text(TempValue) = DummyText$ 'indicates image loaded successfully
|
Text(TempValue) = DummyText$ 'indicates image loaded successfully
|
||||||
IF Control(TempValue).HelperCanvas < -1 THEN
|
IF Control(TempValue).HelperCanvas < -1 THEN
|
||||||
_FREEIMAGE Control(TempValue).HelperCanvas
|
_FREEIMAGE Control(TempValue).HelperCanvas
|
||||||
END IF
|
END IF
|
||||||
Control(TempValue).HelperCanvas = _NEWIMAGE(GifWidth(TempValue), GifHeight(TempValue), 32)
|
Control(TempValue).HelperCanvas = _NEWIMAGE(GIF_GetWidth(TempValue), GIF_GetHeight(TempValue), 32)
|
||||||
UpdateGif TempValue
|
GIF_Draw TempValue
|
||||||
END IF
|
END IF
|
||||||
ELSEIF b$ = "IF __UI_RegisterResult THEN PlayGif __UI_NewID" OR LEFT$(b$, 8) = "PlayGif " THEN
|
ELSEIF b$ = "IF __UI_RegisterResult THEN PlayGif __UI_NewID" OR LEFT$(b$, 8) = "PlayGif " THEN
|
||||||
IF LogFileLoad THEN PRINT #LogFileNum, "AUTOPLAY GIF"
|
IF LogFileLoad THEN PRINT #LogFileNum, "AUTOPLAY GIF"
|
||||||
'Auto-play gif
|
'Auto-play gif
|
||||||
AutoPlayGif(TempValue) = True
|
AutoPlayGif(TempValue) = True
|
||||||
PlayGif TempValue
|
GIF_Play TempValue
|
||||||
ELSEIF LEFT$(b$, 22) = "ToolTip(__UI_NewID) = " THEN
|
ELSEIF LEFT$(b$, 22) = "ToolTip(__UI_NewID) = " THEN
|
||||||
IF LogFileLoad THEN PRINT #LogFileNum, "TOOLTIP"
|
IF LogFileLoad THEN PRINT #LogFileNum, "TOOLTIP"
|
||||||
'Tooltip
|
'Tooltip
|
||||||
|
|
@ -3160,24 +3159,24 @@ END SUB
|
||||||
SUB PreviewLoadImage (This AS __UI_ControlTYPE, fileName$)
|
SUB PreviewLoadImage (This AS __UI_ControlTYPE, fileName$)
|
||||||
IF LCASE$(RIGHT$(fileName$, 4)) = ".gif" THEN
|
IF LCASE$(RIGHT$(fileName$, 4)) = ".gif" THEN
|
||||||
DIM tryGif AS _BYTE
|
DIM tryGif AS _BYTE
|
||||||
CloseGif This.ID
|
GIF_Close This.ID
|
||||||
tryGif = OpenGif(This.ID, fileName$)
|
tryGif = GIF_OpenFile(This.ID, fileName$)
|
||||||
IF tryGif THEN
|
IF tryGif THEN
|
||||||
IF TotalFrames(This.ID) = 1 THEN
|
IF GIF_GetTotalFrames(This.ID) = 1 THEN
|
||||||
CloseGif This.ID
|
GIF_Close This.ID
|
||||||
ELSE
|
ELSE
|
||||||
Text(This.ID) = fileName$ 'indicates image loaded successfully
|
Text(This.ID) = fileName$ 'indicates image loaded successfully
|
||||||
IF This.HelperCanvas < -1 THEN
|
IF This.HelperCanvas < -1 THEN
|
||||||
_FREEIMAGE This.HelperCanvas
|
_FREEIMAGE This.HelperCanvas
|
||||||
END IF
|
END IF
|
||||||
This.HelperCanvas = _NEWIMAGE(GifWidth(This.ID), GifHeight(This.ID), 32)
|
This.HelperCanvas = _NEWIMAGE(GIF_GetWidth(This.ID), GIF_GetHeight(This.ID), 32)
|
||||||
AutoPlayGif(This.ID) = False
|
AutoPlayGif(This.ID) = False
|
||||||
UpdateGif This.ID
|
GIF_Draw This.ID
|
||||||
EXIT SUB
|
EXIT SUB
|
||||||
END IF
|
END IF
|
||||||
END IF
|
END IF
|
||||||
END IF
|
END IF
|
||||||
CloseGif This.ID
|
GIF_Close This.ID
|
||||||
LoadImage This, fileName$
|
LoadImage This, fileName$
|
||||||
END SUB
|
END SUB
|
||||||
|
|
||||||
|
|
@ -3582,7 +3581,7 @@ SUB SavePreview (Destination AS _BYTE)
|
||||||
b$ = MKI$(-44) + MKI$(LEN(RTRIM$(__UI_KeyCombo(Control(i).KeyCombo).FriendlyCombo))) + RTRIM$(__UI_KeyCombo(Control(i).KeyCombo).FriendlyCombo)
|
b$ = MKI$(-44) + MKI$(LEN(RTRIM$(__UI_KeyCombo(Control(i).KeyCombo).FriendlyCombo))) + RTRIM$(__UI_KeyCombo(Control(i).KeyCombo).FriendlyCombo)
|
||||||
IF Disk THEN PUT #BinFileNum, , b$ ELSE Clip$ = Clip$ + b$
|
IF Disk THEN PUT #BinFileNum, , b$ ELSE Clip$ = Clip$ + b$
|
||||||
END IF
|
END IF
|
||||||
IF GetGifIndex&(i) > 0 THEN
|
IF GIF_GetIndex(i) > 0 THEN
|
||||||
'PictureBox has an animated GIF loaded
|
'PictureBox has an animated GIF loaded
|
||||||
b$ = MKI$(-45)
|
b$ = MKI$(-45)
|
||||||
IF Disk THEN
|
IF Disk THEN
|
||||||
|
|
@ -3992,4 +3991,5 @@ FUNCTION LoadEditorImage& (FileName$)
|
||||||
LoadEditorImage& = TempImage
|
LoadEditorImage& = TempImage
|
||||||
END FUNCTION
|
END FUNCTION
|
||||||
|
|
||||||
'$include:'InForm.ui'
|
'$INCLUDE:'extensions/GIFPlay.bas'
|
||||||
|
'$INCLUDE:'InForm.ui'
|
||||||
|
|
|
||||||
|
|
@ -1,550 +1,88 @@
|
||||||
'#######################################################################################
|
'-----------------------------------------------------------------------------------------------------------------------
|
||||||
'# Animated GIF decoder v1.0 #
|
' Animated GIF Player library
|
||||||
'# By Zom-B #
|
' Copyright (c) 2023 Samuel Gomes
|
||||||
'# #
|
'-----------------------------------------------------------------------------------------------------------------------
|
||||||
'# https://qb64phoenix.com/qb64wiki/index.php/GIF_Images #
|
|
||||||
'#######################################################################################
|
|
||||||
'
|
|
||||||
' Adapted for use with InForm's PictureBox controls by @FellippeHeitor
|
|
||||||
'
|
|
||||||
' Fixed, refactored and enhanced by @a740g
|
|
||||||
|
|
||||||
$IF GIFPLAY_BAS = UNDEFINED THEN
|
$IF GIFPLAY_BAS = UNDEFINED THEN
|
||||||
$LET GIFPLAY_BAS = TRUE
|
$LET GIFPLAY_BAS = TRUE
|
||||||
|
|
||||||
'$INCLUDE:'GIFPlay.bi'
|
'$INCLUDE:'GIFPlay.bi'
|
||||||
|
|
||||||
SUB GIF_Update (ID AS LONG)
|
FUNCTION GIF_OpenFile%% (Id AS LONG, fileName AS STRING)
|
||||||
SHARED __GIFData() AS __GIFDataType
|
|
||||||
|
|
||||||
STATIC GifOverlay AS LONG
|
|
||||||
|
|
||||||
DIM i AS LONG, newFrame AS LONG
|
|
||||||
|
|
||||||
i = __GIF_GetIndex(ID)
|
|
||||||
|
|
||||||
IF i = 0 THEN EXIT SUB
|
|
||||||
|
|
||||||
IF GifOverlay = 0 THEN
|
|
||||||
GifOverlay = __GIF_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
|
|
||||||
|
|
||||||
$IF INFORM_BI = DEFINED THEN
|
|
||||||
BeginDraw ID
|
|
||||||
$END IF
|
|
||||||
|
|
||||||
newFrame = __GIF_GetFrame(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
|
|
||||||
|
|
||||||
$IF INFORM_BI = DEFINED THEN
|
|
||||||
EndDraw ID
|
|
||||||
$END IF
|
|
||||||
END SUB
|
|
||||||
|
|
||||||
|
|
||||||
FUNCTION GIF_IsPlaying%% (ID AS LONG)
|
|
||||||
SHARED __GIFData() AS __GIFDataType
|
|
||||||
|
|
||||||
DIM i AS LONG: i = __GIF_GetIndex(ID)
|
|
||||||
|
|
||||||
GIF_IsPlaying = __GIFData(i).isPlaying
|
|
||||||
END FUNCTION
|
END FUNCTION
|
||||||
|
|
||||||
|
|
||||||
FUNCTION GIF_GetWidth~% (ID AS LONG)
|
FUNCTION GIF_OpenMemory%% (Id AS LONG, buffer AS STRING)
|
||||||
SHARED __GIFData() AS __GIFDataType
|
|
||||||
|
|
||||||
DIM i AS LONG: i = __GIF_GetIndex(ID)
|
|
||||||
|
|
||||||
GIF_GetWidth = __GIFData(i).W
|
|
||||||
END FUNCTION
|
END FUNCTION
|
||||||
|
|
||||||
|
|
||||||
FUNCTION GIF_GetHeight~% (ID AS LONG)
|
SUB GIF_Close (Id AS LONG)
|
||||||
SHARED __GIFData() AS __GIFDataType
|
END SUB
|
||||||
|
|
||||||
DIM i AS LONG: i = __GIF_GetIndex(ID)
|
|
||||||
|
|
||||||
GIF_GetHeight = __GIFData(i).H
|
FUNCTION GIF_GetHeight~% (Id AS LONG)
|
||||||
END FUNCTION
|
END FUNCTION
|
||||||
|
|
||||||
|
|
||||||
FUNCTION GIF_GetTotalFrames~& (ID AS LONG)
|
FUNCTION GIF_GetWidth~% (Id AS LONG)
|
||||||
SHARED __GIFData() AS __GIFDataType
|
|
||||||
|
|
||||||
DIM i AS LONG: i = __GIF_GetIndex(ID)
|
|
||||||
GIF_GetTotalFrames = __GIFData(i).totalFrames
|
|
||||||
END FUNCTION
|
END FUNCTION
|
||||||
|
|
||||||
|
|
||||||
SUB GIF_HideOverlay (ID AS LONG)
|
FUNCTION GIF_GetCurrentFrame~& (Id AS LONG)
|
||||||
SHARED __GIFData() AS __GIFDataType
|
|
||||||
|
|
||||||
DIM i AS LONG: i = __GIF_GetIndex(ID)
|
|
||||||
|
|
||||||
__GIFData(i).hideOverlay = TRUE
|
|
||||||
END SUB
|
|
||||||
|
|
||||||
|
|
||||||
SUB GIF_Play (ID AS LONG)
|
|
||||||
SHARED __GIFData() AS __GIFDataType
|
|
||||||
|
|
||||||
DIM i AS LONG: i = __GIF_GetIndex(ID)
|
|
||||||
|
|
||||||
__GIFData(i).isPlaying = TRUE
|
|
||||||
END SUB
|
|
||||||
|
|
||||||
|
|
||||||
SUB GIF_Pause (ID AS LONG)
|
|
||||||
SHARED __GIFData() AS __GIFDataType
|
|
||||||
|
|
||||||
DIM i AS LONG: i = __GIF_GetIndex(ID)
|
|
||||||
|
|
||||||
__GIFData(i).isPlaying = FALSE
|
|
||||||
END SUB
|
|
||||||
|
|
||||||
|
|
||||||
SUB GIF_Stop (ID AS LONG)
|
|
||||||
SHARED __GIFData() AS __GIFDataType
|
|
||||||
|
|
||||||
DIM i AS LONG: i = __GIF_GetIndex(ID)
|
|
||||||
|
|
||||||
__GIFData(i).isPlaying = FALSE
|
|
||||||
__GIFData(i).frame = 1
|
|
||||||
END SUB
|
|
||||||
|
|
||||||
|
|
||||||
FUNCTION GIF_Open%% (ID AS LONG, filename$)
|
|
||||||
SHARED __GIFData() AS __GIFDataType
|
|
||||||
SHARED __GIFFrameData() AS __GIFFrameDataType
|
|
||||||
SHARED __TotalGIFLoaded AS LONG, __TotalGIFFrames AS LONG
|
|
||||||
|
|
||||||
DIM i AS LONG, Index AS LONG
|
|
||||||
DIM byte~%%, palette$, delay~%
|
|
||||||
|
|
||||||
$IF INFORM_BI = DEFINED THEN
|
|
||||||
IF Control(ID).Type <> __UI_Type_PictureBox THEN ERROR 5: EXIT FUNCTION
|
|
||||||
$END IF
|
|
||||||
|
|
||||||
Index = __GIF_GetIndex(ID)
|
|
||||||
|
|
||||||
IF Index = 0 THEN
|
|
||||||
__TotalGIFLoaded = __TotalGIFLoaded + 1
|
|
||||||
Index = __TotalGIFLoaded
|
|
||||||
REDIM _PRESERVE __GIFData(1 TO __TotalGIFLoaded) AS __GIFDataType
|
|
||||||
ELSE
|
|
||||||
GIF_Close ID
|
|
||||||
END IF
|
|
||||||
|
|
||||||
__GIFData(Index).ID = ID
|
|
||||||
__GIFData(Index).file = FREEFILE
|
|
||||||
IF NOT _FILEEXISTS(filename$) THEN EXIT FUNCTION
|
|
||||||
OPEN filename$ FOR BINARY AS __GIFData(Index).file
|
|
||||||
|
|
||||||
GET __GIFData(Index).file, , __GIFData(Index).sigver
|
|
||||||
GET __GIFData(Index).file, , __GIFData(Index).W
|
|
||||||
GET __GIFData(Index).file, , __GIFData(Index).H
|
|
||||||
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).pal = 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 __GIFFrameDataType
|
|
||||||
END IF
|
|
||||||
|
|
||||||
__GIFFrameData(__TotalGIFFrames).ID = ID
|
|
||||||
__GIFFrameData(__TotalGIFFrames).thisFrame = __GIFData(Index).totalFrames
|
|
||||||
|
|
||||||
GET __GIFData(Index).file, , __GIFFrameData(__TotalGIFFrames).L
|
|
||||||
GET __GIFData(Index).file, , __GIFFrameData(__TotalGIFFrames).T
|
|
||||||
GET __GIFData(Index).file, , __GIFFrameData(__TotalGIFFrames).W
|
|
||||||
GET __GIFData(Index).file, , __GIFFrameData(__TotalGIFFrames).H
|
|
||||||
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
|
|
||||||
__GIF_SkipBlocks __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
|
|
||||||
__GIF_SkipBlocks __GIFData(Index).file
|
|
||||||
CASE &HF9
|
|
||||||
IF __TotalGIFFrames > UBOUND(__GIFFrameData) THEN
|
|
||||||
REDIM _PRESERVE __GIFFrameData(0 TO __TotalGIFFrames * 2) AS __GIFFrameDataType
|
|
||||||
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
|
|
||||||
__GIF_SkipBlocks __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 __GIFFrameDataType
|
|
||||||
|
|
||||||
__GIFData(Index).isPlaying = FALSE
|
|
||||||
GIF_Open = 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
|
END FUNCTION
|
||||||
|
|
||||||
|
|
||||||
FUNCTION __GIF_GetIndex& (ID AS LONG)
|
FUNCTION GIF_GetTotalFrames~& (Id AS LONG)
|
||||||
SHARED __GIFData() AS __GIFDataType
|
|
||||||
SHARED __TotalGIFLoaded AS LONG
|
|
||||||
|
|
||||||
DIM i AS LONG: FOR i = 1 TO __TotalGIFLoaded
|
|
||||||
IF __GIFData(i).ID = ID THEN
|
|
||||||
__GIF_GetIndex = i
|
|
||||||
EXIT FOR
|
|
||||||
END IF
|
|
||||||
NEXT i
|
|
||||||
END FUNCTION
|
END FUNCTION
|
||||||
|
|
||||||
|
|
||||||
SUB GIF_Close (ID AS LONG)
|
SUB GIF_SetPlaybackDirection (Id AS LONG, direction AS _BYTE)
|
||||||
SHARED __GIFData() AS __GIFDataType
|
|
||||||
SHARED __GIFFrameData() AS __GIFFrameDataType
|
|
||||||
|
|
||||||
DIM i AS LONG, Index AS LONG
|
|
||||||
|
|
||||||
Index = __GIF_GetIndex(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
|
END SUB
|
||||||
|
|
||||||
|
|
||||||
SUB __GIF_SkipBlocks (file AS INTEGER)
|
FUNCTION GIF_GetPlaybackDirection%% (Id AS LONG)
|
||||||
DIM byte~%%
|
|
||||||
DO
|
|
||||||
GET file, , byte~%% ' Block Size
|
|
||||||
SEEK file, LOC(file) + byte~%% + 1
|
|
||||||
LOOP WHILE byte~%%
|
|
||||||
END SUB
|
|
||||||
|
|
||||||
|
|
||||||
FUNCTION __GIF_GetFrame& (Index AS LONG)
|
|
||||||
SHARED __GIFData() AS __GIFDataType
|
|
||||||
SHARED __GIFFrameData() AS __GIFFrameDataType
|
|
||||||
|
|
||||||
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).W
|
|
||||||
h = __GIFFrameData(frame).H
|
|
||||||
img& = _NEWIMAGE(w, h, 256)
|
|
||||||
actualFrame& = _NEWIMAGE(__GIFData(Index).W, __GIFData(Index).H, 256)
|
|
||||||
|
|
||||||
_DEST img&
|
|
||||||
__GIF_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).pal, i * 3 + 1), ASC(__GIFData(Index).pal, i * 3 + 2), ASC(__GIFData(Index).pal, 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).L, __GIFFrameData(frame).T), img&
|
|
||||||
_FREEIMAGE img&
|
|
||||||
|
|
||||||
__GIFFrameData(frame).addr = actualFrame&
|
|
||||||
__GIFData(Index).loadedFrames = __GIFData(Index).loadedFrames + 1
|
|
||||||
__GIFData(Index).isLoadComplete = (__GIFData(Index).loadedFrames = __GIFData(Index).totalFrames)
|
|
||||||
_DEST prevDest
|
|
||||||
END IF
|
|
||||||
|
|
||||||
__GIF_GetFrame = __GIFFrameData(frame).addr
|
|
||||||
END FUNCTION
|
END FUNCTION
|
||||||
|
|
||||||
|
|
||||||
SUB __GIF_DecodeFrame (gifdata AS __GIFDataType, __GIfFRAMEDATA AS __GIFFrameDataType)
|
SUB GIF_Play (Id AS LONG)
|
||||||
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.W THEN
|
|
||||||
x = 0
|
|
||||||
IF __GIfFRAMEDATA.interlacedFlag THEN
|
|
||||||
y = y + interlacedStep
|
|
||||||
IF y >= __GIfFRAMEDATA.H 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
|
END SUB
|
||||||
|
|
||||||
|
|
||||||
FUNCTION __GIF_LoadOverlayImage&
|
SUB GIF_Pause (Id AS LONG)
|
||||||
CONST SIZE_GIFOVERLAYIMAGE_BMP_16506 = 16506
|
END SUB
|
||||||
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="
|
|
||||||
|
|
||||||
__GIF_LoadOverlayImage = _LOADIMAGE(Base64_LoadResourceString(DATA_GIFOVERLAYIMAGE_BMP_16506, SIZE_GIFOVERLAYIMAGE_BMP_16506, COMP_GIFOVERLAYIMAGE_BMP_16506), 32, "memory")
|
|
||||||
|
SUB GIF_Stop (Id AS LONG)
|
||||||
|
END SUB
|
||||||
|
|
||||||
|
|
||||||
|
FUNCTION GIF_IsPlaying%% (Id AS LONG)
|
||||||
END FUNCTION
|
END FUNCTION
|
||||||
|
|
||||||
|
|
||||||
|
SUB GIF_Draw (Id AS LONG)
|
||||||
|
END SUB
|
||||||
|
|
||||||
|
|
||||||
|
SUB GIF_DrawPro (Id AS LONG, x AS LONG, y AS LONG)
|
||||||
|
END SUB
|
||||||
|
|
||||||
|
|
||||||
|
FUNCTION GIF_GetFrame& (Id AS LONG)
|
||||||
|
END FUNCTION
|
||||||
|
|
||||||
|
|
||||||
|
SUB GIF_EnableOverlay (Id AS LONG, isEnabled AS _BYTE)
|
||||||
|
END SUB
|
||||||
|
|
||||||
|
|
||||||
|
' Returns the __GIFPlay index of a loaded GIF using it's ID
|
||||||
|
' TODO: Fix line in UiEditorPreview: IF GIF_GetIndex(i) > 0 THEN
|
||||||
|
FUNCTION GIF_GetIndex~& (Id AS LONG)
|
||||||
|
END FUNCTION
|
||||||
|
|
||||||
|
'$INCLUDE:'HashTable.bas'
|
||||||
|
'$INCLUDE:'StringFile.bas'
|
||||||
'$INCLUDE:'Base64.bas'
|
'$INCLUDE:'Base64.bas'
|
||||||
|
|
||||||
$END IF
|
$END IF
|
||||||
|
|
|
||||||
|
|
@ -1,71 +1,46 @@
|
||||||
'#######################################################################################
|
'-----------------------------------------------------------------------------------------------------------------------
|
||||||
'# Animated GIF decoder v1.0 #
|
' Animated GIF Player library
|
||||||
'# By Zom-B #
|
' Copyright (c) 2023 Samuel Gomes
|
||||||
'# #
|
'-----------------------------------------------------------------------------------------------------------------------
|
||||||
'# https://qb64phoenix.com/qb64wiki/index.php/GIF_Images #
|
|
||||||
'#######################################################################################
|
|
||||||
'
|
|
||||||
' Adapted for use with InForm's PictureBox controls by @FellippeHeitor
|
|
||||||
'
|
|
||||||
' Fixed, refactored and enhanced by @a740g
|
|
||||||
|
|
||||||
$IF GIFPLAY_BI = UNDEFINED THEN
|
$IF GIFPLAY_BI = UNDEFINED THEN
|
||||||
$LET GIFPLAY_BI = TRUE
|
$LET GIFPLAY_BI = TRUE
|
||||||
|
|
||||||
$IF INFORM_BI = UNDEFINED THEN
|
$IF INFORM_BI = UNDEFINED THEN
|
||||||
|
DEFLNG A-Z
|
||||||
OPTION _EXPLICIT
|
OPTION _EXPLICIT
|
||||||
|
|
||||||
CONST FALSE = 0, TRUE = NOT FALSE
|
CONST FALSE = 0, TRUE = NOT FALSE
|
||||||
$END IF
|
$END IF
|
||||||
|
|
||||||
TYPE __GIFDataType
|
'$INCLUDE:'HashTable.bi'
|
||||||
ID AS LONG
|
'$INCLUDE:'StringFile.bi'
|
||||||
file AS INTEGER
|
|
||||||
sigver AS STRING * 6
|
TYPE __GIFPlayType
|
||||||
W AS _UNSIGNED INTEGER ' width
|
id AS LONG ' handle supplied by the user (do we need this?)
|
||||||
H AS _UNSIGNED INTEGER ' height
|
W AS _UNSIGNED INTEGER ' GIF global width (this needs to be 16-bit)
|
||||||
bpp AS _UNSIGNED _BYTE
|
H AS _UNSIGNED INTEGER ' GIF global height (this needs to be 16-bit)
|
||||||
sortFlag AS _BYTE ' Unused
|
bgColor AS _UNSIGNED _BYTE ' background color
|
||||||
colorRes AS _UNSIGNED _BYTE
|
pal AS STRING * 768 ' global palette - 256 colors * 3 components
|
||||||
colorTableFlag AS _BYTE
|
frame AS LONG ' index of the first frame in the frame data array
|
||||||
bgColor AS _UNSIGNED _BYTE
|
frames AS LONG ' total frames in the animation
|
||||||
aspect AS SINGLE ' Unused
|
hideOverlay AS _BYTE ' should the "GIF" overlay be hidden when it is not playing
|
||||||
numColors AS _UNSIGNED INTEGER
|
|
||||||
pal AS STRING * 768 ' global palette
|
|
||||||
firstFrame AS LONG
|
|
||||||
totalFrames AS _UNSIGNED LONG
|
|
||||||
isPlaying AS _BYTE
|
|
||||||
frame AS LONG
|
|
||||||
loadedFrames AS LONG
|
|
||||||
isLoadComplete AS _BYTE
|
|
||||||
lastFrameServed AS LONG
|
|
||||||
lastFrameUpdate AS SINGLE
|
|
||||||
lastFrameDelay AS SINGLE
|
|
||||||
hideOverlay AS _BYTE
|
|
||||||
END TYPE
|
END TYPE
|
||||||
|
|
||||||
TYPE __GIFFrameDataType
|
TYPE __GIFPlayFrameType
|
||||||
ID AS LONG
|
id AS LONG ' which GIF handle does this belong to?
|
||||||
thisFrame AS LONG
|
image AS LONG ' QB64 image handle
|
||||||
addr AS LONG
|
L AS _UNSIGNED INTEGER ' frame left (this needs to be 16-bit) (do we need these?)
|
||||||
L AS _UNSIGNED INTEGER ' left
|
T AS _UNSIGNED INTEGER ' frame top (this needs to be 16-bit)
|
||||||
T AS _UNSIGNED INTEGER ' top
|
W AS _UNSIGNED INTEGER ' frame width (this needs to be 16-bit)
|
||||||
W AS _UNSIGNED INTEGER ' width
|
H AS _UNSIGNED INTEGER ' frame height (this needs to be 16-bit)
|
||||||
H AS _UNSIGNED INTEGER ' height
|
pre AS LONG ' previous frame (this will link back to the last frame if this is the first one)
|
||||||
localColorTableFlag AS _BYTE
|
nxt AS LONG ' next frame (this will link back to the first frame if this is the last one)
|
||||||
interlacedFlag AS _BYTE
|
delayMs AS SINGLE ' frame delay time
|
||||||
sortFlag AS _BYTE ' Unused
|
direction AS _BYTE ' playback direction
|
||||||
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
|
END TYPE
|
||||||
|
|
||||||
REDIM __GIFData(1 TO 1) AS __GIFDataType
|
REDIM __GIFPlayHashTable(0 TO 0) AS HashTableType
|
||||||
REDIM __GIFFrameData(0 TO 0) AS __GIFFrameDataType
|
REDIM __GIFPlay(0 TO 0) AS __GIFPlayType
|
||||||
DIM __TotalGIFLoaded AS LONG, __TotalGIFFrames AS LONG
|
REDIM __GIFPlayFrame(0 TO 0) AS __GIFPlayFrameType
|
||||||
|
|
||||||
$END IF
|
$END IF
|
||||||
|
|
|
||||||
198
InForm/extensions/HashTable.bas
Normal file
198
InForm/extensions/HashTable.bas
Normal file
|
|
@ -0,0 +1,198 @@
|
||||||
|
'-----------------------------------------------------------------------------------------------------------------------
|
||||||
|
' A simple hash table for integers and QB64 handles
|
||||||
|
' Copyright (c) 2023 Samuel Gomes
|
||||||
|
'-----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
$IF HASHTABLE_BAS = UNDEFINED THEN
|
||||||
|
$LET HASHTABLE_BAS = TRUE
|
||||||
|
|
||||||
|
'$INCLUDE:'HashTable.bi'
|
||||||
|
|
||||||
|
'-------------------------------------------------------------------------------------------------------------------
|
||||||
|
' Test code for debugging the library
|
||||||
|
'-------------------------------------------------------------------------------------------------------------------
|
||||||
|
'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)
|
||||||
|
|
||||||
|
'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)
|
||||||
|
__HashTable_GetHash = k MOD (l + 1) ' + 1 is needed for 0 based arrays
|
||||||
|
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
|
||||||
|
|
||||||
|
|
||||||
|
' 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 = 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 = 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
|
||||||
28
InForm/extensions/HashTable.bi
Normal file
28
InForm/extensions/HashTable.bi
Normal file
|
|
@ -0,0 +1,28 @@
|
||||||
|
'-----------------------------------------------------------------------------------------------------------------------
|
||||||
|
' A simple hash table for integers and QB64 handles
|
||||||
|
' Copyright (c) 2023 Samuel Gomes
|
||||||
|
'-----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
$IF HASHTABLE_BI = UNDEFINED THEN
|
||||||
|
$LET HASHTABLE_BI = TRUE
|
||||||
|
|
||||||
|
$IF INFORM_BI = UNDEFINED THEN
|
||||||
|
DEFLNG A-Z
|
||||||
|
OPTION _EXPLICIT
|
||||||
|
|
||||||
|
CONST FALSE = 0, TRUE = NOT FALSE
|
||||||
|
$END IF
|
||||||
|
|
||||||
|
CONST __HASHTABLE_KEY_EXISTS = -1
|
||||||
|
CONST __HASHTABLE_KEY_UNAVAILABLE = -2
|
||||||
|
|
||||||
|
' Hash table entry type
|
||||||
|
TYPE HashTableType
|
||||||
|
U AS _BYTE ' used?
|
||||||
|
K AS _UNSIGNED LONG ' key
|
||||||
|
V AS LONG ' value
|
||||||
|
' <- add other value types here and then write wrappers
|
||||||
|
' around __HashTable_GetInsertIndex() & __HashTable_GetLookupIndex()
|
||||||
|
END TYPE
|
||||||
|
|
||||||
|
$END IF
|
||||||
801
InForm/extensions/Ini.bas
Normal file
801
InForm/extensions/Ini.bas
Normal file
|
|
@ -0,0 +1,801 @@
|
||||||
|
' INI Manager
|
||||||
|
' Fellippe Heitor, 2017-2021 - fellippe@qb64.org - @fellippeheitor
|
||||||
|
' https://github.com/FellippeHeitor/INI-Manager
|
||||||
|
'
|
||||||
|
' Add include guards - @a740g
|
||||||
|
|
||||||
|
$IF INI_BAS = UNDEFINED THEN
|
||||||
|
$LET INI_BAS = TRUE
|
||||||
|
|
||||||
|
'$INCLUDE:'Ini.bi'
|
||||||
|
|
||||||
|
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$
|
||||||
|
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
|
||||||
|
|
||||||
|
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
|
||||||
|
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, 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 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, 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
|
||||||
|
IF state THEN
|
||||||
|
IniForceReload = -1
|
||||||
|
ELSE
|
||||||
|
IniForceReload = 0
|
||||||
|
END IF
|
||||||
|
END SUB
|
||||||
|
|
||||||
|
SUB IniClose
|
||||||
|
SHARED IniDisableAutoCommit, 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, currentIniFileName$, IniLF$, IniWholeFile$
|
||||||
|
SHARED currentIniFileLOF AS _UNSIGNED LONG
|
||||||
|
SHARED IniForceReload
|
||||||
|
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, 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, 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
|
||||||
|
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
|
||||||
36
InForm/extensions/Ini.bi
Normal file
36
InForm/extensions/Ini.bi
Normal file
|
|
@ -0,0 +1,36 @@
|
||||||
|
' INI Manager
|
||||||
|
' Fellippe Heitor, 2017-2021 - fellippe@qb64.org - @fellippeheitor
|
||||||
|
' https://github.com/FellippeHeitor/INI-Manager
|
||||||
|
'
|
||||||
|
' Add include guards - @a740g
|
||||||
|
|
||||||
|
$IF INI_BI = UNDEFINED THEN
|
||||||
|
$LET INI_BI = TRUE
|
||||||
|
|
||||||
|
$IF INFORM_BI = UNDEFINED THEN
|
||||||
|
DEFLNG A-Z
|
||||||
|
OPTION _EXPLICIT
|
||||||
|
|
||||||
|
CONST FALSE = 0, TRUE = NOT FALSE
|
||||||
|
$END IF
|
||||||
|
|
||||||
|
' 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.
|
||||||
|
' INI routines without namespace like prefix should also be prefixed with the "Ini_" prefix
|
||||||
|
|
||||||
|
'Global variables declaration
|
||||||
|
DIM currentIniFileName$, LoadedFiles$
|
||||||
|
DIM currentIniFileLOF AS _UNSIGNED LONG
|
||||||
|
DIM IniWholeFile$
|
||||||
|
DIM IniSectionData$
|
||||||
|
DIM IniPosition AS _UNSIGNED LONG
|
||||||
|
DIM IniNewFile$
|
||||||
|
DIM IniLastSection$
|
||||||
|
DIM IniLastKey$
|
||||||
|
DIM IniLF$
|
||||||
|
DIM IniDisableAutoCommit ' _BYTE?
|
||||||
|
DIM IniCODE ' _BYTE?
|
||||||
|
DIM IniAllowBasicComments ' _BYTE?
|
||||||
|
DIM IniForceReload ' _BYTE?
|
||||||
|
|
||||||
|
$END IF
|
||||||
|
|
@ -1,6 +1,7 @@
|
||||||
' MessageBox compatibility functions
|
' MessageBox compatibility functions
|
||||||
' These basically emulate the legacy InForm MessageBox routines
|
' These basically emulate the legacy InForm MessageBox routines
|
||||||
' All it does is calls the new QB64-PE _MESSAGEBOX$ function
|
' All it does is calls the new QB64-PE _MESSAGEBOX$ function
|
||||||
|
' Copyright (c) 2023 Samuel Gomes
|
||||||
|
|
||||||
$IF MESSAGEBOX_BAS = UNDEFINED THEN
|
$IF MESSAGEBOX_BAS = UNDEFINED THEN
|
||||||
$LET MESSAGEBOX_BAS = TRUE
|
$LET MESSAGEBOX_BAS = TRUE
|
||||||
|
|
@ -127,7 +128,9 @@ $IF MESSAGEBOX_BAS = UNDEFINED THEN
|
||||||
END SELECT
|
END SELECT
|
||||||
END FUNCTION
|
END FUNCTION
|
||||||
|
|
||||||
|
|
||||||
SUB MessageBox (message AS STRING, caption AS STRING, setup AS LONG)
|
SUB MessageBox (message AS STRING, caption AS STRING, setup AS LONG)
|
||||||
DIM returnValue AS LONG: returnValue = MessageBox(message, caption, setup)
|
DIM returnValue AS LONG: returnValue = MessageBox(message, caption, setup)
|
||||||
END SUB
|
END SUB
|
||||||
|
|
||||||
$END IF
|
$END IF
|
||||||
|
|
|
||||||
|
|
@ -1,10 +1,18 @@
|
||||||
' MessageBox compatibility functions
|
' MessageBox compatibility functions
|
||||||
' These basically emulate the legacy InForm MessageBox routines
|
' These basically emulate the legacy InForm MessageBox routines
|
||||||
' All it does is calls the new QB64-PE _MESSAGEBOX$ function
|
' All it does is calls the new QB64-PE _MESSAGEBOX$ function
|
||||||
|
' Copyright (c) 2023 Samuel Gomes
|
||||||
|
|
||||||
$IF MESSAGEBOX_BI = UNDEFINED THEN
|
$IF MESSAGEBOX_BI = UNDEFINED THEN
|
||||||
$LET MESSAGEBOX_BI = TRUE
|
$LET MESSAGEBOX_BI = TRUE
|
||||||
|
|
||||||
|
$IF INFORM_BI = UNDEFINED THEN
|
||||||
|
DEFLNG A-Z
|
||||||
|
OPTION _EXPLICIT
|
||||||
|
|
||||||
|
CONST FALSE = 0, TRUE = NOT FALSE
|
||||||
|
$END IF
|
||||||
|
|
||||||
'Messagebox constants
|
'Messagebox constants
|
||||||
CONST MsgBox_OkOnly = 1
|
CONST MsgBox_OkOnly = 1
|
||||||
CONST MsgBox_OkCancel = 2
|
CONST MsgBox_OkCancel = 2
|
||||||
|
|
|
||||||
330
InForm/extensions/StringFile.bas
Normal file
330
InForm/extensions/StringFile.bas
Normal file
|
|
@ -0,0 +1,330 @@
|
||||||
|
'-----------------------------------------------------------------------------------------------------------------------
|
||||||
|
' File I/O like routines for memory loaded files
|
||||||
|
' Copyright (c) 2023 Samuel Gomes
|
||||||
|
'-----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
$IF STRINGFILE_BAS = UNDEFINED THEN
|
||||||
|
$LET STRINGFILE_BAS = TRUE
|
||||||
|
|
||||||
|
'$INCLUDE:'StringFile.bi'
|
||||||
|
|
||||||
|
'-------------------------------------------------------------------------------------------------------------------
|
||||||
|
' Test code for debugging the library
|
||||||
|
'-------------------------------------------------------------------------------------------------------------------
|
||||||
|
'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 completly 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 = TRUE
|
||||||
|
END IF
|
||||||
|
END FUNCTION
|
||||||
|
|
||||||
|
|
||||||
|
' Saves a string buffer 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 = 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
|
||||||
22
InForm/extensions/StringFile.bi
Normal file
22
InForm/extensions/StringFile.bi
Normal file
|
|
@ -0,0 +1,22 @@
|
||||||
|
'-----------------------------------------------------------------------------------------------------------------------
|
||||||
|
' File I/O like routines for memory loaded files
|
||||||
|
' Copyright (c) 2023 Samuel Gomes
|
||||||
|
'-----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
$IF STRINGFILE_BI = UNDEFINED THEN
|
||||||
|
$LET STRINGFILE_BI = TRUE
|
||||||
|
|
||||||
|
$IF INFORM_BI = UNDEFINED THEN
|
||||||
|
DEFLNG A-Z
|
||||||
|
OPTION _EXPLICIT
|
||||||
|
|
||||||
|
CONST FALSE = 0, TRUE = NOT FALSE
|
||||||
|
$END IF
|
||||||
|
|
||||||
|
' Simplified QB64-only memory-file
|
||||||
|
TYPE StringFileType
|
||||||
|
buffer AS STRING
|
||||||
|
cursor AS _UNSIGNED LONG
|
||||||
|
END TYPE
|
||||||
|
|
||||||
|
$END IF
|
||||||
|
|
@ -1,20 +0,0 @@
|
||||||
'INI Manager
|
|
||||||
'Fellippe Heitor, 2017-2021 - 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$, LoadedFiles$
|
|
||||||
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
|
|
||||||
791
InForm/ini.bm
791
InForm/ini.bm
|
|
@ -1,791 +0,0 @@
|
||||||
'INI Manager v1.01
|
|
||||||
'Fellippe Heitor, 2017-2021 - 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$
|
|
||||||
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
|
|
||||||
|
|
||||||
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
|
|
||||||
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, 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 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, 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
|
|
||||||
IF state THEN
|
|
||||||
IniForceReload = -1
|
|
||||||
ELSE
|
|
||||||
IniForceReload = 0
|
|
||||||
END IF
|
|
||||||
END SUB
|
|
||||||
|
|
||||||
SUB IniClose
|
|
||||||
SHARED IniDisableAutoCommit, 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, currentIniFileName$, IniLF$, IniWholeFile$
|
|
||||||
SHARED currentIniFileLOF AS _UNSIGNED LONG
|
|
||||||
SHARED IniForceReload
|
|
||||||
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, 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, 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
|
|
||||||
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
|
|
||||||
|
|
@ -42,8 +42,6 @@ SUB __UI_Click (id AS LONG)
|
||||||
DIM fileName AS STRING: fileName = _OPENFILEDIALOG$(Caption(gifplaySample), , "*.gif|*.GIF|*.Gif", "GIF Files")
|
DIM fileName AS STRING: fileName = _OPENFILEDIALOG$(Caption(gifplaySample), , "*.gif|*.GIF|*.Gif", "GIF Files")
|
||||||
|
|
||||||
IF LEN(fileName) > 0 THEN
|
IF LEN(fileName) > 0 THEN
|
||||||
GIF_Close PictureBox1 ' close any previously opened GIF
|
|
||||||
|
|
||||||
IF GIF_Open(PictureBox1, fileName) THEN
|
IF GIF_Open(PictureBox1, fileName) THEN
|
||||||
|
|
||||||
Control(PlayBT).Disabled = False
|
Control(PlayBT).Disabled = False
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue