diff --git a/InForm/InForm.bi b/InForm/InForm.bi index c2fb7a5..3265119 100644 --- a/InForm/InForm.bi +++ b/InForm/InForm.bi @@ -2,10 +2,13 @@ 'Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor ' -$IF VERSION < 3.8 THEN +$IF VERSION < 3.9.1 THEN $Error This requires the latest version of QB64-PE from https://github.com/QB64-Phoenix-Edition/QB64pe/releases $END IF +' TODO: Re-factor this file to use include guards. For now, we will just set the preprocessor variable +$LET INFORM_BI = TRUE + DECLARE LIBRARY FUNCTION __UI_GetPID ALIAS getpid () END DECLARE diff --git a/InForm/InForm.ui b/InForm/InForm.ui index 97614a0..4a22acb 100644 --- a/InForm/InForm.ui +++ b/InForm/InForm.ui @@ -2,6 +2,10 @@ 'Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor '------------------------------------------------------------------------------ + +' TODO: Re-factor this file to use include guards. For now, we will just set the preprocessor variable +$LET INFORM_UI = TRUE + 'Control types: FUNCTION __UI_Type_Form%%:__UI_Type_Form%% = 1: END FUNCTION FUNCTION __UI_Type_Frame%%: __UI_Type_Frame%% = 2: END FUNCTION @@ -49,7 +53,7 @@ FUNCTION __UI_CantResizeH%%: __UI_CantResizeH%% = 2: END FUNCTION FUNCTION __UI_CantResize%%: __UI_CantResize%% = 3: END FUNCTION '--------------------------------------------------------------------------------- -' a740g: Check if this has the expected behavior 'cause _UFONTHEIGHT actually returns the true font height for built-in fonts +' TODO: Check if this has the expected behavior 'cause _UFONTHEIGHT actually returns the true font height for built-in fonts FUNCTION uspacing& uspacing& = _UFONTHEIGHT + (((_FONT = 8) * -1) * __UI_Font8Offset + ((_FONT = 16) * -1) * __UI_Font16Offset) END FUNCTION diff --git a/InForm/UiEditor.bas b/InForm/UiEditor.bas index ca5d4c9..eb917cc 100644 --- a/InForm/UiEditor.bas +++ b/InForm/UiEditor.bas @@ -798,7 +798,7 @@ FileMenuRecent7, FileMenuRecent8, FileMenuRecent9 b$ = SPACE$(LOF(FreeFileNum)) GET #FreeFileNum, 1, b$ CLOSE #FreeFileNum - IF INSTR(b$, CHR$(10) + "'$INCLUDE:'InForm\extensions\gifplay.bm'") > 0 THEN + IF INSTR(b$, CHR$(10) + "'$INCLUDE:'InForm\extensions\GIFPlay.bas'") > 0 THEN LoadedWithGifExtension = True END IF END IF @@ -2809,7 +2809,7 @@ SUB __UI_OnLoad b$ = SPACE$(LOF(FreeFileNum)) GET #FreeFileNum, 1, b$ SEEK #FreeFileNum, 1 - IF INSTR(b$, CHR$(10) + "'$INCLUDE:'InForm\extensions\gifplay.bm'") > 0 THEN + IF INSTR(b$, CHR$(10) + "'$INCLUDE:'InForm\extensions\GIFPlay.bas'") > 0 THEN LoadedWithGifExtension = True END IF DO @@ -2853,7 +2853,7 @@ INSTR(uB$, "$INCLUDE") > 0 THEN b$ = SPACE$(LOF(FreeFileNum)) GET #FreeFileNum, 1, b$ CLOSE #FreeFileNum - IF INSTR(b$, CHR$(10) + "'$INCLUDE:'InForm\extensions\gifplay.bm'") > 0 THEN + IF INSTR(b$, CHR$(10) + "'$INCLUDE:'InForm\extensions\GIFPlay.bas'") > 0 THEN LoadedWithGifExtension = True END IF END IF @@ -4559,13 +4559,13 @@ SUB SaveForm (ExitToQB64 AS _BYTE, SaveOnlyFrm AS _BYTE) PRINT #TextFileNum, PRINT #TextFileNum, "': External modules: ---------------------------------------------------------------" IF AddGifExtension THEN - PRINT #TextFileNum, "'$INCLUDE:'InForm\extensions\gifplay.bi'" + PRINT #TextFileNum, "'$INCLUDE:'InForm\extensions\GIFPlay.bi'" END IF PRINT #TextFileNum, "'$INCLUDE:'InForm\InForm.bi'" PRINT #TextFileNum, "'$INCLUDE:'InForm\xp.uitheme'" PRINT #TextFileNum, "'$INCLUDE:'" + MID$(BaseOutputFileName, LEN(CurrentPath$) + 2) + ".frm'" IF AddGifExtension THEN - PRINT #TextFileNum, "'$INCLUDE:'InForm\extensions\gifplay.bm'" + PRINT #TextFileNum, "'$INCLUDE:'InForm\extensions\GIFPlay.bas'" END IF PRINT #TextFileNum, PRINT #TextFileNum, "': Event procedures: ---------------------------------------------------------------" @@ -4613,7 +4613,7 @@ SUB SaveForm (ExitToQB64 AS _BYTE, SaveOnlyFrm AS _BYTE) IF AddGifExtension = True AND TotalGifLoaded > 0 THEN PRINT #TextFileNum, PRINT #TextFileNum, " 'The lines below ensure your GIFs will display properly;" - PRINT #TextFileNum, " 'Please refer to the documentation in 'InForm/extensions/README - gifplay.txt'" + PRINT #TextFileNum, " 'Please refer to the documentation in 'InForm/docs/README - GIFPlay.txt'" FOR Dummy = 1 TO UBOUND(PreviewControls) IF PreviewAnimatedGif(Dummy) THEN PRINT #TextFileNum, " UpdateGif " + RTRIM$(PreviewControls(Dummy).Name) diff --git a/InForm/UiEditorPreview.bas b/InForm/UiEditorPreview.bas index 57497d1..203a25d 100644 --- a/InForm/UiEditorPreview.bas +++ b/InForm/UiEditorPreview.bas @@ -91,11 +91,11 @@ $END IF ContextMenuIcon = LoadEditorImage("contextmenu.bmp") __UI_ClearColor ContextMenuIcon, 0, 0 -'$include:'extensions/gifplay.bi' +'$include:'extensions/GIFPlay.bi' '$include:'InForm.bi' '$include:'xp.uitheme' '$include:'UiEditorPreview.frm' -'$include:'extensions/gifplay.bm' +'$include:'extensions/GIFPlay.bm' 'Event procedures: --------------------------------------------------------------- SUB __UI_Click (id AS LONG) diff --git a/InForm/extensions/README-gifplay.txt b/InForm/docs/README-GIFPlay.txt similarity index 90% rename from InForm/extensions/README-gifplay.txt rename to InForm/docs/README-GIFPlay.txt index 4b8f76f..c22f448 100644 --- a/InForm/extensions/README-gifplay.txt +++ b/InForm/docs/README-GIFPlay.txt @@ -9,16 +9,16 @@ Your form must contain a PictureBox control that'll serve as a container for the GIF file you'll load with this library. In the "External modules" section of the .bas file generated by InForm, -$INCLUDE both gifplay.bi and gifplay.bm. The first must come before the +$INCLUDE both GIFPlay.bi and GIFPlay.bas. The first must come before the line that includes InForm.ui and the second must come after that, as in the sample below: ': External modules: -------------------------------- - '$INCLUDE:'InForm\extensions\gifplay.bi' + '$INCLUDE:'InForm\extensions\GIFPlay.bi' '$INCLUDE:'InForm\InForm.ui' '$INCLUDE:'InForm\xp.uitheme' '$INCLUDE:'gifplaySample.frm' - '$INCLUDE:'InForm\extensions\gifplay.bm' + '$INCLUDE:'InForm\extensions\GIFPlay.bm' * Methods: diff --git a/InForm/extensions/Base64.bas b/InForm/extensions/Base64.bas new file mode 100644 index 0000000..c218dbb --- /dev/null +++ b/InForm/extensions/Base64.bas @@ -0,0 +1,181 @@ +'----------------------------------------------------------------------------------------------------------------------- +' Base64 Encoder and Decoder library +' Copyright (c) 2023 Samuel Gomes +'----------------------------------------------------------------------------------------------------------------------- + +$IF BASE64_BAS = UNDEFINED THEN + $LET BASE64_BAS = TRUE + + '------------------------------------------------------------------------------------------------------------------- + ' Test code for debugging the library + '------------------------------------------------------------------------------------------------------------------- + 'DEFLNG A-Z + 'OPTION _EXPLICIT + + 'CONST ITERATIONS = 1000000 + 'CONST LOREM_IPSUM = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut " + _ + ' "labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip " + _ + ' "ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat " + _ + ' "nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum." + + 'DIM encTxt AS STRING, decTxt AS STRING, i AS LONG, t AS DOUBLE + + 'PRINT ITERATIONS; "iterations,"; LEN(LOREM_IPSUM); "bytes." + + 'PRINT "Base64 encode..." + + 't = TIMER + 'FOR i = 1 TO ITERATIONS + ' encTxt = Base64_Encode(LOREM_IPSUM) + 'NEXT + 'PRINT USING "#####.##### seconds"; TIMER - t + + 'PRINT "Base64 decode..." + + 't = TIMER + 'FOR i = 1 TO ITERATIONS + ' decTxt = Base64_Decode(encTxt) + 'NEXT + 'PRINT USING "#####.##### seconds"; TIMER - t + + 'IF _STRCMP(decTxt, LOREM_IPSUM) = 0 THEN + ' PRINT "Passed" + 'ELSE + ' PRINT "Failed" + 'END IF + + 'END + '------------------------------------------------------------------------------------------------------------------- + + ' Converts a normal string or binary data to a base64 string + FUNCTION Base64_Encode$ (s AS STRING) + CONST BASE64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" + + DIM srcSize AS _UNSIGNED LONG: srcSize = LEN(s) + DIM srcSize3rem AS _UNSIGNED LONG: srcSize3rem = srcSize MOD 3 + DIM srcSize3mul AS _UNSIGNED LONG: srcSize3mul = srcSize - srcSize3rem + DIM buffer AS STRING: buffer = SPACE$(((srcSize + 2) \ 3) * 4) ' preallocate complete buffer + DIM j AS _UNSIGNED LONG: j = 1 + + DIM i AS _UNSIGNED LONG: FOR i = 1 TO srcSize3mul STEP 3 + DIM char1 AS _UNSIGNED _BYTE: char1 = ASC(s, i) + DIM char2 AS _UNSIGNED _BYTE: char2 = ASC(s, i + 1) + DIM char3 AS _UNSIGNED _BYTE: char3 = ASC(s, i + 2) + + ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (_SHR(char1, 2))) + j = j + 1 + ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (_SHL((char1 AND 3), 4) OR _SHR(char2, 4))) + j = j + 1 + ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (_SHL((char2 AND 15), 2) OR _SHR(char3, 6))) + j = j + 1 + ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (char3 AND 63)) + j = j + 1 + NEXT i + + ' Add padding + IF srcSize3rem > 0 THEN + char1 = ASC(s, i) + + ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (_SHR(char1, 2))) + j = j + 1 + + IF srcSize3rem = 1 THEN + ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (_SHL(char1 AND 3, 4))) + j = j + 1 + ASC(buffer, j) = 61 ' "=" + j = j + 1 + ASC(buffer, j) = 61 ' "=" + ELSE ' srcSize3rem = 2 + char2 = ASC(s, i + 1) + + ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (_SHL((char1 AND 3), 4) OR _SHR(char2, 4))) + j = j + 1 + ASC(buffer, j) = ASC(BASE64_CHARACTERS, 1 + (_SHL(char2 AND 15, 2))) + j = j + 1 + ASC(buffer, j) = 61 ' "=" + END IF + END IF + + Base64_Encode = buffer + END FUNCTION + + + ' Converts a base64 string to a normal string or binary data + FUNCTION Base64_Decode$ (s AS STRING) + DIM srcSize AS _UNSIGNED LONG: srcSize = LEN(s) + DIM buffer AS STRING: buffer = SPACE$((srcSize \ 4) * 3) ' preallocate complete buffer + DIM j AS _UNSIGNED LONG: j = 1 + DIM AS _UNSIGNED _BYTE index, char1, char2, char3, char4 + + DIM i AS _UNSIGNED LONG: FOR i = 1 TO srcSize STEP 4 + index = ASC(s, i): GOSUB find_index: char1 = index + index = ASC(s, i + 1): GOSUB find_index: char2 = index + index = ASC(s, i + 2): GOSUB find_index: char3 = index + index = ASC(s, i + 3): GOSUB find_index: char4 = index + + ASC(buffer, j) = _SHL(char1, 2) OR _SHR(char2, 4) + j = j + 1 + ASC(buffer, j) = _SHL(char2 AND 15, 4) OR _SHR(char3, 2) + j = j + 1 + ASC(buffer, j) = _SHL(char3 AND 3, 6) OR char4 + j = j + 1 + NEXT i + + ' Remove padding + IF RIGHT$(s, 2) = "==" THEN + buffer = LEFT$(buffer, LEN(buffer) - 2) + ELSEIF RIGHT$(s, 1) = "=" THEN + buffer = LEFT$(buffer, LEN(buffer) - 1) + END IF + + Base64_Decode = buffer + EXIT FUNCTION + + find_index: + IF index >= 65 AND index <= 90 THEN + index = index - 65 + ELSEIF index >= 97 AND index <= 122 THEN + index = index - 97 + 26 + ELSEIF index >= 48 AND index <= 57 THEN + index = index - 48 + 52 + ELSEIF index = 43 THEN + index = 62 + ELSEIF index = 47 THEN + index = 63 + END IF + RETURN + END FUNCTION + + + ' Loads a binary file encoded with Bin2Data + ' Usage: + ' 1. Encode the binary file with Bin2Data + ' 2. Include the file or it's contents + ' 3. Load the file like so: + ' Restore label_generated_by_bin2data + ' Dim buffer As String + ' buffer = LoadResource ' buffer will now hold the contents of the file + FUNCTION Base64_LoadResource$ + DIM ogSize AS LONG, resize AS LONG, isComp AS _BYTE + DIM buffer AS STRING, chunk AS STRING, i AS LONG + + READ ogSize, resize, isComp ' read the header + buffer = SPACE$(resize) ' preallocate complete buffer + + ' Read the whole resource data + DO WHILE i < resize + READ chunk + MID$(buffer, i + 1) = chunk + i = i + LEN(chunk) + LOOP + + ' Decode the data + buffer = Base64_Decode(buffer) + + ' Expand the data if needed + IF isComp THEN buffer = _INFLATE$(buffer, ogSize) + + Base64_LoadResource = buffer + END FUNCTION + +$END IF diff --git a/InForm/extensions/GIFPlay.bas b/InForm/extensions/GIFPlay.bas new file mode 100644 index 0000000..302275e --- /dev/null +++ b/InForm/extensions/GIFPlay.bas @@ -0,0 +1,957 @@ +'####################################################################################### +'# Animated GIF decoder v1.0 # +'# By Zom-B # +'# # +'# https://qb64phoenix.com/qb64wiki/index.php/GIF_Images # +'####################################################################################### +' Adapted for use with InForm's PictureBox controls by @FellippeHeitor +' Refactored by a740g to use include guards and conditional compiles + +$IF GIFPLAY_BAS = UNDEFINED THEN + $LET GIFPLAY_BAS = TRUE + + '$INCLUDE:'GIFPlay.bi' + + SUB UpdateGif (ID AS LONG) + SHARED GIFData() AS GIFDATA + + STATIC GifOverlay AS LONG + + DIM i AS LONG, newFrame AS LONG + + i = GetGifIndex(ID) + + IF i = 0 THEN EXIT SUB + + IF GifOverlay = 0 THEN + GifOverlay = LoadOverlayImage& + END IF + + IF GIFData(i).IsPlaying OR GIFData(i).LastFrameServed = 0 THEN + IF GIFData(i).LastFrameUpdate > 0 AND TIMER - GIFData(i).LastFrameUpdate < GIFData(i).LastFrameDelay THEN + 'Wait for the GIF's frame delay + ELSE + GIFData(i).Frame = GIFData(i).Frame + 1 + GIFData(i).LastFrameServed = GIFData(i).Frame + GIFData(i).LastFrameUpdate = TIMER + END IF + END IF + + $IF INFORM_BI = DEFINED THEN + BeginDraw ID + $END IF + + newFrame = GetGifFrame&(i) + IF newFrame THEN _PUTIMAGE , newFrame + IF GIFData(i).IsPlaying = FALSE AND GIFData(i).HideOverlay = FALSE AND GIFData(i).totalFrames > 1 THEN + _PUTIMAGE (_WIDTH / 2 - _WIDTH(GifOverlay) / 2, _HEIGHT / 2 - _HEIGHT(GifOverlay) / 2), GifOverlay + END IF + + $IF INFORM_BI = DEFINED THEN + EndDraw ID + $END IF + END SUB + + + FUNCTION GifIsPlaying%% (ID AS LONG) + SHARED GIFData() AS GIFDATA + + DIM i AS LONG: i = GetGifIndex(ID) + + GifIsPlaying = GIFData(i).IsPlaying + END FUNCTION + + + FUNCTION GifWidth% (ID AS LONG) + SHARED GIFData() AS GIFDATA + + DIM i AS LONG: i = GetGifIndex(ID) + + GifWidth = GIFData(i).width + END FUNCTION + + + FUNCTION GifHeight% (ID AS LONG) + SHARED GIFData() AS GIFDATA + + DIM i AS LONG: i = GetGifIndex(ID) + + GifHeight = GIFData(i).height + END FUNCTION + + + FUNCTION TotalFrames& (ID AS LONG) + SHARED GIFData() AS GIFDATA + + DIM i AS LONG: i = GetGifIndex(ID) + TotalFrames = GIFData(i).totalFrames + END FUNCTION + + + SUB HideGifOverlay (ID AS LONG) + SHARED GIFData() AS GIFDATA + + DIM i AS LONG: i = GetGifIndex(ID) + + GIFData(i).HideOverlay = TRUE + END SUB + + + SUB PlayGif (ID AS LONG) + SHARED GIFData() AS GIFDATA + + DIM i AS LONG: i = GetGifIndex(ID) + + GIFData(i).IsPlaying = TRUE + END SUB + + + SUB PauseGif (ID AS LONG) + SHARED GIFData() AS GIFDATA + + DIM i AS LONG: i = GetGifIndex(ID) + + GIFData(i).IsPlaying = FALSE + END SUB + + + SUB StopGif (ID AS LONG) + SHARED GIFData() AS GIFDATA + + DIM i AS LONG: i = GetGifIndex(ID) + + GIFData(i).IsPlaying = FALSE + GIFData(i).Frame = 1 + END SUB + + + FUNCTION OpenGif%% (ID AS LONG, filename$) + SHARED GIFData() AS GIFDATA + SHARED GIFFrameData() AS FRAMEDATA + 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 = GetGifIndex&(ID) + + IF Index = 0 THEN + TotalGIFLoaded = TotalGIFLoaded + 1 + Index = TotalGIFLoaded + REDIM _PRESERVE GIFData(1 TO TotalGIFLoaded) AS GIFDATA + ELSE + CloseGif ID + END IF + + GIFData(Index).ID = ID + GIFData(Index).file = FREEFILE + IF 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).width + GET GIFData(Index).file, , GIFData(Index).height + GET GIFData(Index).file, , byte~%% + GIFData(Index).bpp = (byte~%% AND 7) + 1 + GIFData(Index).sortFlag = (byte~%% AND 8) > 0 + GIFData(Index).colorRes = (byte~%% \ 16 AND 7) + 1 + GIFData(Index).colorTableFlag = (byte~%% AND 128) > 0 + GIFData(Index).numColors = 2 ^ GIFData(Index).bpp + GET GIFData(Index).file, , GIFData(Index).bgColor + GET GIFData(Index).file, , byte~%% + IF byte~%% = 0 THEN GIFData(Index).aspect = 0 ELSE GIFData(Index).aspect = (byte~%% + 15) / 64 + + IF GIFData(Index).sigver <> "GIF87a" AND GIFData(Index).sigver <> "GIF89a" THEN + 'Invalid version + GOTO LoadError + END IF + + IF NOT GIFData(Index).colorTableFlag THEN + 'No Color Table + GOTO LoadError + END IF + + palette$ = SPACE$(3 * GIFData(Index).numColors) + GET GIFData(Index).file, , palette$ + GIFData(Index).palette = palette$ + DO + GET GIFData(Index).file, , byte~%% + SELECT CASE byte~%% + CASE &H2C ' Image Descriptor + TotalGIFFrames = TotalGIFFrames + 1 + GIFData(Index).totalFrames = GIFData(Index).totalFrames + 1 + + IF GIFData(Index).firstFrame = 0 THEN + GIFData(Index).firstFrame = TotalGIFFrames + END IF + + IF TotalGIFFrames > UBOUND(GIFFrameData) THEN + REDIM _PRESERVE GIFFrameData(0 TO TotalGIFFrames * 2) AS FRAMEDATA + END IF + + GIFFrameData(TotalGIFFrames).ID = ID + GIFFrameData(TotalGIFFrames).thisFrame = GIFData(Index).totalFrames + + GET GIFData(Index).file, , GIFFrameData(TotalGIFFrames).left + GET GIFData(Index).file, , GIFFrameData(TotalGIFFrames).top + GET GIFData(Index).file, , GIFFrameData(TotalGIFFrames).width + GET GIFData(Index).file, , GIFFrameData(TotalGIFFrames).height + GET GIFData(Index).file, , byte~%% + GIFFrameData(TotalGIFFrames).localColorTableFlag = (byte~%% AND 128) > 0 + GIFFrameData(TotalGIFFrames).interlacedFlag = (byte~%% AND 64) > 0 + GIFFrameData(TotalGIFFrames).sortFlag = (byte~%% AND 32) > 0 + GIFFrameData(TotalGIFFrames).palBPP = (byte~%% AND 7) + 1 + GIFFrameData(TotalGIFFrames).addr = LOC(GIFData(Index).file) + 1 + + IF GIFFrameData(TotalGIFFrames).localColorTableFlag THEN + SEEK GIFData(Index).file, LOC(GIFData(Index).file) + 3 * 2 ^ GIFFrameData(TotalGIFFrames).palBPP + 1 + END IF + GET GIFData(Index).file, , GIFFrameData(TotalGIFFrames).minimumCodeSize + IF GIFFrameData(TotalGIFFrames).disposalMethod > 2 THEN + 'Unsupported disposalMethod + GOTO LoadError + END IF + SkipGIFBlocks GIFData(Index).file + CASE &H3B ' Trailer + EXIT DO + CASE &H21 ' Extension Introducer + GET GIFData(Index).file, , byte~%% ' Extension Label + SELECT CASE byte~%% + CASE &HFF, &HFE ' Application Extension, Comment Extension + SkipGIFBlocks GIFData(Index).file + CASE &HF9 + IF TotalGIFFrames > UBOUND(GIFFrameData) THEN + REDIM _PRESERVE GIFFrameData(0 TO TotalGIFFrames * 2) AS FRAMEDATA + END IF + GIFFrameData(TotalGIFFrames).ID = ID + + GET GIFData(Index).file, , byte~%% ' Block Size (always 4) + GET GIFData(Index).file, , byte~%% + GIFFrameData(TotalGIFFrames).transparentFlag = (byte~%% AND 1) > 0 + GIFFrameData(TotalGIFFrames).userInput = (byte~%% AND 2) > 0 + GIFFrameData(TotalGIFFrames).disposalMethod = byte~%% \ 4 AND 7 + GET GIFData(Index).file, , delay~% + IF delay~% = 0 THEN GIFFrameData(TotalGIFFrames).delay = 0.1 ELSE GIFFrameData(TotalGIFFrames).delay = delay~% / 100 + GET GIFData(Index).file, , GIFFrameData(TotalGIFFrames).transColor + SkipGIFBlocks GIFData(Index).file + CASE ELSE + 'Unsupported extension Label + GOTO LoadError + END SELECT + CASE ELSE + 'Unsupported chunk + GOTO LoadError + END SELECT + LOOP + + REDIM _PRESERVE GIFFrameData(0 TO TotalGIFFrames) AS FRAMEDATA + + GIFData(Index).IsPlaying = FALSE + OpenGif = TRUE + EXIT FUNCTION + + LoadError: + GIFData(Index).ID = 0 + CLOSE GIFData(Index).file + FOR i = 1 TO TotalGIFFrames + IF GIFFrameData(i).ID = ID THEN + GIFFrameData(i).ID = 0 + END IF + NEXT + END FUNCTION + + + FUNCTION GetGifIndex& (ID AS LONG) + SHARED GIFData() AS GIFDATA + SHARED TotalGIFLoaded AS LONG + + DIM i AS LONG: FOR i = 1 TO TotalGIFLoaded + IF GIFData(i).ID = ID THEN + GetGifIndex = i + EXIT FOR + END IF + NEXT i + END FUNCTION + + + SUB CloseGif (ID AS LONG) + SHARED GIFData() AS GIFDATA + SHARED GIFFrameData() AS FRAMEDATA + + DIM i AS LONG, Index AS LONG + + Index = GetGifIndex(ID) + + IF Index = 0 THEN EXIT SUB + + FOR i = 0 TO UBOUND(GIFFrameData) + IF GIFFrameData(i).ID = ID THEN + GIFFrameData(i).ID = 0 + IF GIFFrameData(i).addr < -1 THEN + _FREEIMAGE GIFFrameData(i).addr + END IF + END IF + NEXT + + CLOSE GIFData(Index).file + GIFData(Index).ID = 0 + GIFData(Index).firstFrame = 0 + END SUB + + + SUB SkipGIFBlocks (file AS INTEGER) + DIM byte~%% + DO + GET file, , byte~%% ' Block Size + SEEK file, LOC(file) + byte~%% + 1 + LOOP WHILE byte~%% + END SUB + + + FUNCTION GetGifFrame& (Index AS LONG) + SHARED GIFData() AS GIFDATA + SHARED GIFFrameData() AS FRAMEDATA + + DIM i AS LONG + DIM frame AS LONG, previousFrame AS LONG + DIM w AS INTEGER, h AS INTEGER + DIM img&, actualFrame& + DIM prevDest AS LONG + + IF GIFData(Index).Frame > GIFData(Index).totalFrames THEN + GIFData(Index).Frame = 1 + END IF + + FOR i = 1 TO UBOUND(GIFFrameData) + IF GIFFrameData(i).ID = GIFData(Index).ID AND GIFFrameData(i).thisFrame = GIFData(Index).Frame THEN + frame = i + EXIT FOR + ELSEIF GIFFrameData(i).ID = GIFData(Index).ID AND GIFFrameData(i).thisFrame < GIFData(Index).Frame THEN + previousFrame = i + END IF + NEXT + + GIFData(Index).LastFrameDelay = GIFFrameData(frame).delay - (GIFFrameData(frame).delay / 10) + + IF GIFFrameData(frame).addr > 0 THEN + prevDest = _DEST + w = GIFFrameData(frame).width + h = GIFFrameData(frame).height + img& = _NEWIMAGE(w, h, 256) + actualFrame& = _NEWIMAGE(GIFData(Index).width, GIFData(Index).height, 256) + + _DEST img& + DecodeFrame GIFData(Index), GIFFrameData(frame) + + _DEST actualFrame& + IF GIFFrameData(frame).localColorTableFlag THEN + _COPYPALETTE img& + ELSE + FOR i = 0 TO GIFData(Index).numColors - 1 + _PALETTECOLOR i, _RGB32(ASC(GIFData(Index).palette, i * 3 + 1), ASC(GIFData(Index).palette, i * 3 + 2), ASC(GIFData(Index).palette, i * 3 + 3)) + NEXT + END IF + + IF GIFData(Index).Frame > 1 THEN + SELECT CASE GIFFrameData(previousFrame).disposalMethod + CASE 0, 1 + _PUTIMAGE , GIFFrameData(previousFrame).addr + CASE 2 + CLS , GIFData(Index).bgColor + _CLEARCOLOR GIFData(Index).bgColor + END SELECT + ELSE + CLS , GIFData(Index).bgColor + END IF + + IF GIFFrameData(frame).transparentFlag THEN + _CLEARCOLOR GIFFrameData(frame).transColor, img& + END IF + _PUTIMAGE (GIFFrameData(frame).left, GIFFrameData(frame).top), img& + _FREEIMAGE img& + + GIFFrameData(frame).addr = actualFrame& + GIFData(Index).LoadedFrames = GIFData(Index).LoadedFrames + 1 + GIFData(Index).GifLoadComplete = (GIFData(Index).LoadedFrames = GIFData(Index).totalFrames) + _DEST prevDest + END IF + + GetGifFrame& = GIFFrameData(frame).addr + END FUNCTION + + + SUB DecodeFrame (gifdata AS GIFDATA, GifFrameData AS FRAMEDATA) + DIM byte AS _UNSIGNED _BYTE + DIM prefix(4095), suffix(4095), colorStack(4095) + DIM startCodeSize AS INTEGER, clearCode AS INTEGER + DIM endCode AS INTEGER, minCode AS INTEGER, startMaxCode AS INTEGER + DIM nvc AS INTEGER, codeSize AS INTEGER + DIM maxCode AS INTEGER, bitPointer AS INTEGER, blockSize AS INTEGER + DIM blockPointer AS INTEGER, x AS INTEGER, y AS INTEGER + DIM palette$, i AS LONG, c&, stackPointer AS INTEGER + DIM currentCode AS INTEGER, code AS INTEGER, lastColor AS INTEGER + DIM oldCode AS INTEGER, WorkCode&, LastChar AS INTEGER + DIM interlacedPass AS INTEGER, interlacedStep AS INTEGER + DIM file AS INTEGER, a$, loopStart! + + startCodeSize = gifdata.bpp + 1 + clearCode = 2 ^ gifdata.bpp + endCode = clearCode + 1 + minCode = endCode + 1 + startMaxCode = clearCode * 2 - 1 + nvc = minCode + codeSize = startCodeSize + maxCode = startMaxCode + + IF GifFrameData.interlacedFlag THEN interlacedPass = 0: interlacedStep = 8 + bitPointer = 0 + blockSize = 0 + blockPointer = 0 + x = 0 + y = 0 + + file = gifdata.file + SEEK file, GifFrameData.addr + + IF GifFrameData.localColorTableFlag THEN + palette$ = SPACE$(3 * 2 ^ GifFrameData.palBPP) + GET file, , palette$ + + FOR i = 0 TO gifdata.numColors - 1 + c& = _RGB32(ASC(palette$, i * 3 + 1), ASC(palette$, i * 3 + 2), ASC(palette$, i * 3 + 3)) + _PALETTECOLOR i, c& + NEXT + END IF + + GET file, , byte ' minimumCodeSize + + loopStart! = TIMER + DO + IF TIMER - loopStart! > 2 THEN EXIT DO + GOSUB GetCode + stackPointer = 0 + IF code = clearCode THEN 'Reset & Draw next color direct + nvc = minCode ' \ + codeSize = startCodeSize ' Preset default codes + maxCode = startMaxCode ' / + + GOSUB GetCode + currentCode = code + + lastColor = code + colorStack(stackPointer) = lastColor + stackPointer = 1 + ELSEIF code <> endCode THEN 'Draw direct color or colors from suffix + currentCode = code + IF currentCode = nvc THEN 'Take last color too + currentCode = oldCode + colorStack(stackPointer) = lastColor + stackPointer = stackPointer + 1 + END IF + + WHILE currentCode >= minCode 'Extract colors from suffix + colorStack(stackPointer) = suffix(currentCode) + stackPointer = stackPointer + 1 + currentCode = prefix(currentCode) 'Next color from suffix is described in + WEND ' the prefix, else prefix is the last col. + + lastColor = currentCode ' Last color is equal to the + colorStack(stackPointer) = lastColor ' last known code (direct, or from + stackPointer = stackPointer + 1 ' Prefix) + suffix(nvc) = lastColor 'Automatically, update suffix + prefix(nvc) = oldCode 'Code from the session before (for extracting from suffix) + nvc = nvc + 1 + + IF nvc > maxCode AND codeSize < 12 THEN + codeSize = codeSize + 1 + maxCode = maxCode * 2 + 1 + END IF + END IF + + FOR i = stackPointer - 1 TO 0 STEP -1 + PSET (x, y), colorStack(i) + x = x + 1 + IF x = GifFrameData.width THEN + x = 0 + IF GifFrameData.interlacedFlag THEN + y = y + interlacedStep + IF y >= GifFrameData.height THEN + SELECT CASE interlacedPass + CASE 0: interlacedPass = 1: y = 4 + CASE 1: interlacedPass = 2: y = 2 + CASE 2: interlacedPass = 3: y = 1 + END SELECT + interlacedStep = 2 * y + END IF + ELSE + y = y + 1 + END IF + END IF + NEXT + + oldCode = code + LOOP UNTIL code = endCode + GET file, , byte + EXIT SUB + + GetCode: + IF bitPointer = 0 THEN GOSUB ReadByteFromBlock: bitPointer = 8 + WorkCode& = LastChar \ (2 ^ (8 - bitPointer)) + WHILE codeSize > bitPointer + GOSUB ReadByteFromBlock + + WorkCode& = WorkCode& OR LastChar * (2 ^ bitPointer) + bitPointer = bitPointer + 8 + WEND + bitPointer = bitPointer - codeSize + code = WorkCode& AND maxCode + RETURN + + ReadByteFromBlock: + IF blockPointer = blockSize THEN + GET file, , byte: blockSize = byte + a$ = SPACE$(blockSize): GET file, , a$ + blockPointer = 0 + END IF + blockPointer = blockPointer + 1 + LastChar = ASC(MID$(a$, blockPointer, 1)) + RETURN + END SUB + + + FUNCTION gifOverlayImage$ + DIM A$ + A$ = MKI$(64) + MKI$(64) + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000J000005000`M0000M20004<000`e0000V30008?000Pl0000" + A$ = A$ + "V3000L=000@`0000M2000L70000D0000J000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000003000PQ0000<30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?0000c0000620000300000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "00030000^1000X<000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000:3000h60000300000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000l0000@N0000Q30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000Q3000T7000`30000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000010000\5000`g0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "O3000\5000@0000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "0000000000000000000000000000000000000000R0000X;000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000j2000420" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "0000000000000000A1000D>000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000@i0000A100000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "0000000000000000000000000000000000000000000000@00000520008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000@Q0000100000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "0000000000000000000000P10000M20008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b3000d9000P1000000000000000000000000000000000000" + A$ = A$ + "0000000000000000000000000000000000000000000000000000000000P1" + A$ = A$ + "0000^20008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000^2000H00000000000000000000000000000000000000000000000000" + A$ = A$ + "0000000000000000000000000000000000@00000L20008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0000W00001000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "0000000000000000120008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b300088000000000000000000000" + A$ = A$ + "0000000000000000000000000000000000000000000000000000@10008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000A10000000000000000000000000000000000" + A$ = A$ + "0000000000000000000000000000P0000@>000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b3000@>00008000000000000000000000000000000000000000000000000" + A$ = A$ + "000010000T;000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000i2000400" + A$ = A$ + "000000000000000000000000000000000000000000000\5000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?0000G00000000000000000000" + A$ = A$ + "000000000000000000000l0000Pg0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000N3000l0000000000000000000000000000000000" + A$ = A$ + "00@N0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000@N000000000000000000000000000000`20000Q30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000Q3000`000000" + A$ = A$ + "00000000000000000000^10008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000PK000000000000000000001000" + A$ = A$ + "0l<000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000@30004000000000000000L3000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "000m0000f3000P?000Pn0000j3000X?000Pn0000h3000@?000`l0000b300" + A$ = A$ + "08?000Pl0000b30008?000@m0000h3000X?0000n0000f30008?000`l0000" + A$ = A$ + "g3000T?000Pn0000j3000X?000Pn0000j3000X?000Pn0000j3000X?000Pn" + A$ = A$ + "0000j3000P?000`l0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00`=000000000000000R0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b3000D?0000n0000j3000X?000Pn0000" + A$ = A$ + "j3000X?000Pn0000j3000X?000Pn0000i3000H?000Pl0000b30008?000@m" + A$ = A$ + "0000j3000X?000Pn0000j3000X?000Pm0000g3000X?000Pn0000j3000X?0" + A$ = A$ + "00Pn0000j3000X?000Pn0000j3000X?000Pn0000j3000X?000Pn0000i300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl00009200000000000000" + A$ = A$ + "<30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b3000H?000Pn0000jOb9WX?WLb9oNk]gnooooooooooooooooooooooZ" + A$ = A$ + "[^JoniWOl3000X?000Pn0000h30008?000Pl0000g3000X?^hRKoooooo;]d" + A$ = A$ + "Bk?000Pn0000h3000T?000PnZ[^jnooooooooooooooooooooooooooooooo" + A$ = A$ + "oooooooooooooooooooooooooooo\a6Kk3000X?000@m0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b3000d<000000000K00008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b3000H?000Pn0000j_jZ" + A$ = A$ + "[foooooooooooooooooooooooooooooooooooooooooooooooo_dB;]oWLb9" + A$ = A$ + "j3000X?000Pm0000b3000L?000PnhR;^mooooo_dB;]o0000j3000P?000@n" + A$ = A$ + "0000j[^jZkoooooooooooooooooooooooooooooooooooooooooooooooooo" + A$ = A$ + "oooooooooc6K\]?000Pn0000e30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000L000005000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b3000@?000Pn0000j;]dBkoooooooooooGLa5g_Oni7o" + A$ = A$ + "0000j3000X?000PnIUEFk_jZ[foooooooooook]gNk?000Pn0000j3000@?0" + A$ = A$ + "00`m0000jS;^hfooooooB;]dn3000X?0000n0000i3000X_jZ[^oooooogHS" + A$ = A$ + "=b?000Pn0000j3000X?000Pn0000j3000X?000Pn0000j3000X?000Pn0000" + A$ = A$ + "i30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300085000@O" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "000n0000jc9WLboooooooooooc6K\]?000Pn0000j3000X?000Pn0000j300" + A$ = A$ + "0X?000PnIUEFkoooooooooooLb9Wl3000X?000Pm0000g3000X?^hRKooooo" + A$ = A$ + "o;]dBk?000Pn0000h3000T?000PnZ[^jnoooooOS=f8o0000j3000X?000Pn" + A$ = A$ + "0000j3000X?000Pn0000j3000X?000Pn0000h3000000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b3000X?000Pnooooooooooo@3=dn0000j3000300000000000000920008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?0000m0000h3000X?000Pn0000" + A$ = A$ + "j3000X?000Pn0000j3000X?000Pn0000j3000X?0000n0000e30008?000Pl" + A$ = A$ + "0000e3000X?000Pn0000j3000X?000Pn0000f3000L?000Pn0000j3000X?0" + A$ = A$ + "00Pn0000j300000000000000000@00000@30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?0000d0000100000000000000000000h6000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000^10000000000" + A$ = A$ + "00000000000000030000R30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000R3000`000000000000000000000000000000" + A$ = A$ + "0T7000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b3000T700000000000000000000000000000000000`30000N30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b3000h=000@4000000000000" + A$ = A$ + "00000000000000000000000000000`5000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?0000G000000000000000000000000000000000000" + A$ = A$ + "0000000000@00000j20008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000P^" + A$ = A$ + "000010000000000000000000000000000000000000000000000000000420" + A$ = A$ + "000i0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?0000i0000Q0000000000000000000" + A$ = A$ + "00000000000000000000000000000000000000000000A10008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000A1000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000`P0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl000042000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "00000000000010000`9000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000L2000400000000000000000000000000" + A$ = A$ + "0000000000000000000000000000000000000000000000000000000000P1" + A$ = A$ + "0000^20008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000^2000H00000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000H0000@W0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000M2000H00000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "0000000000000000000000000000000010000D8000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl000052000400000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000A1000D>000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000@i0000A1000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "0000000000P80000j20008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000P^0000Q0000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000400" + A$ = A$ + "000G0000O30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b3000l=0000G" + A$ = A$ + "000010000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "0000000000000000000000000000000000000000000000000l0000@N0000" + A$ = A$ + "Q30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000Q3000X7000`3000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "00000000000000000000000000000000000000000`0000PK0000;30008?0" + A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" + A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000`b0000" + A$ = A$ + "^1000`000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000<0000920000=000Pl0000" + A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" + A$ = A$ + "0000b30008?000Pl0000@3000T80000<0000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000J000005000@N0000N20008<0" + A$ = A$ + "000f0000Y30008?000@k0000R30008=000P`0000N2000T70000D0000J000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" + A$ = A$ + "0000%%00" + gifOverlayImage$ = A$ + END FUNCTION + + + FUNCTION LoadOverlayImage& + $IF INFORM_BI = UNDEFINED THEN + DECLARE CUSTOMTYPE LIBRARY + SUB __UI_MemCopy ALIAS memcpy (BYVAL dest AS _OFFSET, BYVAL source AS _OFFSET, BYVAL bytes AS LONG) + END DECLARE + $END IF + + DIM MemoryBlock AS _MEM, TempImage AS LONG + DIM NewWidth AS INTEGER, NewHeight AS INTEGER, A$, BASFILE$ + + A$ = gifOverlayImage$ + IF LEN(A$) = 0 THEN EXIT FUNCTION + + NewWidth = CVI(LEFT$(A$, 2)) + NewHeight = CVI(MID$(A$, 3, 2)) + A$ = MID$(A$, 5) + + BASFILE$ = gifUnpack$(A$) + + TempImage = _NEWIMAGE(NewWidth, NewHeight, 32) + MemoryBlock = _MEMIMAGE(TempImage) + + __UI_MemCopy MemoryBlock.OFFSET, _OFFSET(BASFILE$), LEN(BASFILE$) + _MEMFREE MemoryBlock + + LoadOverlayImage& = TempImage + END FUNCTION + + + FUNCTION gifUnpack$ (PackedData$) + 'Adapted from Dav's BIN2BAS + 'http://www.qbasicnews.com/dav/qb64.php + DIM A$, i&, B$, C%, F$, C$, t%, B&, X$, btemp$ + + A$ = PackedData$ + + FOR i& = 1 TO LEN(A$) STEP 4 + B$ = MID$(A$, i&, 4) + IF INSTR(1, B$, "%") THEN + FOR C% = 1 TO LEN(B$) + F$ = MID$(B$, C%, 1) + IF F$ <> "%" THEN C$ = C$ + F$ + NEXT + B$ = C$ + END IF + FOR t% = LEN(B$) TO 1 STEP -1 + B& = B& * 64 + ASC(MID$(B$, t%)) - 48 + NEXT + X$ = "" + FOR t% = 1 TO LEN(B$) - 1 + X$ = X$ + CHR$(B& AND 255) + B& = B& \ 256 + NEXT + btemp$ = btemp$ + X$ + NEXT + + gifUnpack$ = btemp$ + END FUNCTION + +$END IF diff --git a/InForm/extensions/gifplay.bi b/InForm/extensions/gifplay.bi index b194663..4c2bd1b 100644 --- a/InForm/extensions/gifplay.bi +++ b/InForm/extensions/gifplay.bi @@ -6,52 +6,63 @@ '####################################################################################### 'Adapted for use with InForm's PictureBox controls by @FellippeHeitor -TYPE GIFDATA - ID AS LONG - file AS INTEGER - sigver AS STRING * 6 - width AS _UNSIGNED INTEGER - height AS _UNSIGNED INTEGER - bpp AS _UNSIGNED _BYTE - sortFlag AS _BYTE ' Unused - colorRes AS _UNSIGNED _BYTE - colorTableFlag AS _BYTE - bgColor AS _UNSIGNED _BYTE - aspect AS SINGLE ' Unused - numColors AS _UNSIGNED INTEGER - palette AS STRING * 768 - firstFrame AS LONG - totalFrames AS LONG - IsPlaying AS _BYTE - Frame AS LONG - LoadedFrames AS LONG - GifLoadComplete AS _BYTE - LastFrameServed AS LONG - LastFrameUpdate AS SINGLE - LastFrameDelay AS SINGLE - HideOverlay AS _BYTE -END TYPE +$IF GIFPLAY_BI = UNDEFINED THEN + $LET GIFPLAY_BI = TRUE -TYPE FRAMEDATA - ID AS LONG - thisFrame AS LONG - addr AS LONG - left AS _UNSIGNED INTEGER - top AS _UNSIGNED INTEGER - width AS _UNSIGNED INTEGER - height AS _UNSIGNED INTEGER - localColorTableFlag AS _BYTE - interlacedFlag AS _BYTE - sortFlag AS _BYTE ' Unused - palBPP AS _UNSIGNED _BYTE - minimumCodeSize AS _UNSIGNED _BYTE - transparentFlag AS _BYTE 'GIF89a-specific (animation) values - userInput AS _BYTE ' Unused - disposalMethod AS _UNSIGNED _BYTE - delay AS SINGLE - transColor AS _UNSIGNED _BYTE -END TYPE + $IF INFORM_BI = UNDEFINED THEN + OPTION _EXPLICIT -REDIM SHARED GifData(0) AS GIFDATA -REDIM SHARED GifFrameData(0) AS FRAMEDATA -DIM SHARED TotalGIFLoaded AS LONG, TotalGIFFrames AS LONG + CONST FALSE = 0, TRUE = NOT FALSE + $END IF + + TYPE GIFDATA + ID AS LONG + file AS INTEGER + sigver AS STRING * 6 + width AS _UNSIGNED INTEGER + height AS _UNSIGNED INTEGER + bpp AS _UNSIGNED _BYTE + sortFlag AS _BYTE ' Unused + colorRes AS _UNSIGNED _BYTE + colorTableFlag AS _BYTE + bgColor AS _UNSIGNED _BYTE + aspect AS SINGLE ' Unused + numColors AS _UNSIGNED INTEGER + palette AS STRING * 768 + firstFrame AS LONG + totalFrames AS LONG + IsPlaying AS _BYTE + Frame AS LONG + LoadedFrames AS LONG + GifLoadComplete AS _BYTE + LastFrameServed AS LONG + LastFrameUpdate AS SINGLE + LastFrameDelay AS SINGLE + HideOverlay AS _BYTE + END TYPE + + TYPE FRAMEDATA + ID AS LONG + thisFrame AS LONG + addr AS LONG + left AS _UNSIGNED INTEGER + top AS _UNSIGNED INTEGER + width AS _UNSIGNED INTEGER + height AS _UNSIGNED INTEGER + localColorTableFlag AS _BYTE + interlacedFlag AS _BYTE + sortFlag AS _BYTE ' Unused + palBPP AS _UNSIGNED _BYTE + minimumCodeSize AS _UNSIGNED _BYTE + transparentFlag AS _BYTE 'GIF89a-specific (animation) values + userInput AS _BYTE ' Unused + disposalMethod AS _UNSIGNED _BYTE + delay AS SINGLE + transColor AS _UNSIGNED _BYTE + END TYPE + + REDIM GIFData(0) AS GIFDATA + REDIM GIFFrameData(0) AS FRAMEDATA + DIM TotalGIFLoaded AS LONG, TotalGIFFrames AS LONG + +$END IF diff --git a/InForm/extensions/gifplay.bm b/InForm/extensions/gifplay.bm deleted file mode 100644 index db35b96..0000000 --- a/InForm/extensions/gifplay.bm +++ /dev/null @@ -1,890 +0,0 @@ -'####################################################################################### -'# Animated GIF decoder v1.0 # -'# By Zom-B # -'# # -'# http://www.qb64.org/wiki/GIF_Images # -'####################################################################################### -'Adapted for use with InForm's PictureBox controls by @FellippeHeitor - -SUB UpdateGif (ID AS LONG) - DIM i AS LONG, newFrame AS LONG - STATIC GifOverlay AS LONG - - i = GetGifIndex(ID) - - IF i = 0 THEN EXIT SUB - - IF GifOverlay = 0 THEN - GifOverlay = LoadOverlayImage& - END IF - - IF GifData(i).IsPlaying OR GifData(i).LastFrameServed = 0 THEN - IF GifData(i).LastFrameUpdate > 0 AND TIMER - GifData(i).LastFrameUpdate < GifData(i).LastFrameDelay THEN - 'Wait for the GIF's frame delay - ELSE - GifData(i).Frame = GifData(i).Frame + 1 - GifData(i).LastFrameServed = GifData(i).Frame - GifData(i).LastFrameUpdate = TIMER - END IF - END IF - - BeginDraw ID - newFrame = GetGifFrame&(i) - IF newFrame THEN _PUTIMAGE , newFrame - IF GifData(i).IsPlaying = False AND GifData(i).HideOverlay = False AND GifData(i).totalFrames > 1 THEN - _PUTIMAGE (_WIDTH / 2 - _WIDTH(GifOverlay) / 2, _HEIGHT / 2 - _HEIGHT(GifOverlay) / 2), GifOverlay - END IF - EndDraw ID -END SUB - -FUNCTION GifIsPlaying%% (ID AS LONG) - DIM i AS LONG - i = GetGifIndex(ID) - GifIsPlaying%% = GifData(i).IsPlaying -END FUNCTION - -FUNCTION GifWidth% (ID AS LONG) - DIM i AS LONG - i = GetGifIndex(ID) - GifWidth% = GifData(i).width -END FUNCTION - -FUNCTION GifHeight% (ID AS LONG) - DIM i AS LONG - i = GetGifIndex(ID) - GifHeight% = GifData(i).height -END FUNCTION - -FUNCTION TotalFrames& (ID AS LONG) - DIM i AS LONG - i = GetGifIndex(ID) - TotalFrames& = GifData(i).totalFrames -END FUNCTION - -SUB HideGifOverlay (ID AS LONG) - DIM i AS LONG - i = GetGifIndex(ID) - GifData(i).HideOverlay = True -END SUB - -SUB PlayGif (ID AS LONG) - DIM i AS LONG - i = GetGifIndex(ID) - GifData(i).IsPlaying = True -END SUB - -SUB PauseGif (ID AS LONG) - DIM i AS LONG - i = GetGifIndex(ID) - GifData(i).IsPlaying = False -END SUB - -SUB StopGif (ID AS LONG) - DIM i AS LONG - i = GetGifIndex(ID) - GifData(i).IsPlaying = False - GifData(i).Frame = 1 -END SUB - -FUNCTION OpenGif%% (ID AS LONG, filename$) - DIM i AS LONG, Index AS LONG - DIM byte~%%, palette$, delay~% - - IF Control(ID).Type <> __UI_Type_PictureBox THEN ERROR 5: EXIT FUNCTION - - Index = GetGifIndex&(ID) - - IF Index = 0 THEN - TotalGIFLoaded = TotalGIFLoaded + 1 - Index = TotalGIFLoaded - REDIM _PRESERVE GifData(1 TO TotalGIFLoaded) AS GIFDATA - ELSE - CloseGif ID - END IF - - GifData(Index).ID = ID - GifData(Index).file = FREEFILE - IF 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).width - GET GifData(Index).file, , GifData(Index).height - GET GifData(Index).file, , byte~%% - GifData(Index).bpp = (byte~%% AND 7) + 1 - GifData(Index).sortFlag = (byte~%% AND 8) > 0 - GifData(Index).colorRes = (byte~%% \ 16 AND 7) + 1 - GifData(Index).colorTableFlag = (byte~%% AND 128) > 0 - GifData(Index).numColors = 2 ^ GifData(Index).bpp - GET GifData(Index).file, , GifData(Index).bgColor - GET GifData(Index).file, , byte~%% - IF byte~%% = 0 THEN GifData(Index).aspect = 0 ELSE GifData(Index).aspect = (byte~%% + 15) / 64 - - IF GifData(Index).sigver <> "GIF87a" AND GifData(Index).sigver <> "GIF89a" THEN - 'Invalid version - GOTO LoadError - END IF - - IF NOT GifData(Index).colorTableFlag THEN - 'No Color Table - GOTO LoadError - END IF - - palette$ = SPACE$(3 * GifData(Index).numColors) - GET GifData(Index).file, , palette$ - GifData(Index).palette = palette$ - DO - GET GifData(Index).file, , byte~%% - SELECT CASE byte~%% - CASE &H2C ' Image Descriptor - TotalGIFFrames = TotalGIFFrames + 1 - GifData(Index).totalFrames = GifData(Index).totalFrames + 1 - - IF GifData(Index).firstFrame = 0 THEN - GifData(Index).firstFrame = TotalGIFFrames - END IF - - IF TotalGIFFrames > UBOUND(GifFrameData) THEN - REDIM _PRESERVE GifFrameData(0 TO TotalGIFFrames * 2) AS FRAMEDATA - END IF - - GifFrameData(TotalGIFFrames).ID = ID - GifFrameData(TotalGIFFrames).thisFrame = GifData(Index).totalFrames - - GET GifData(Index).file, , GifFrameData(TotalGIFFrames).left - GET GifData(Index).file, , GifFrameData(TotalGIFFrames).top - GET GifData(Index).file, , GifFrameData(TotalGIFFrames).width - GET GifData(Index).file, , GifFrameData(TotalGIFFrames).height - GET GifData(Index).file, , byte~%% - GifFrameData(TotalGIFFrames).localColorTableFlag = (byte~%% AND 128) > 0 - GifFrameData(TotalGIFFrames).interlacedFlag = (byte~%% AND 64) > 0 - GifFrameData(TotalGIFFrames).sortFlag = (byte~%% AND 32) > 0 - GifFrameData(TotalGIFFrames).palBPP = (byte~%% AND 7) + 1 - GifFrameData(TotalGIFFrames).addr = LOC(GifData(Index).file) + 1 - - IF GifFrameData(TotalGIFFrames).localColorTableFlag THEN - SEEK GifData(Index).file, LOC(GifData(Index).file) + 3 * 2 ^ GifFrameData(TotalGIFFrames).palBPP + 1 - END IF - GET GifData(Index).file, , GifFrameData(TotalGIFFrames).minimumCodeSize - IF GifFrameData(TotalGIFFrames).disposalMethod > 2 THEN - 'Unsupported disposalMethod - GOTO LoadError - END IF - SkipGIFBlocks GifData(Index).file - CASE &H3B ' Trailer - EXIT DO - CASE &H21 ' Extension Introducer - GET GifData(Index).file, , byte~%% ' Extension Label - SELECT CASE byte~%% - CASE &HFF, &HFE ' Application Extension, Comment Extension - SkipGIFBlocks GifData(Index).file - CASE &HF9 - IF TotalGIFFrames > UBOUND(GifFrameData) THEN - REDIM _PRESERVE GifFrameData(0 TO TotalGIFFrames * 2) AS FRAMEDATA - END IF - GifFrameData(TotalGIFFrames).ID = ID - - GET GifData(Index).file, , byte~%% ' Block Size (always 4) - GET GifData(Index).file, , byte~%% - GifFrameData(TotalGIFFrames).transparentFlag = (byte~%% AND 1) > 0 - GifFrameData(TotalGIFFrames).userInput = (byte~%% AND 2) > 0 - GifFrameData(TotalGIFFrames).disposalMethod = byte~%% \ 4 AND 7 - GET GifData(Index).file, , delay~% - IF delay~% = 0 THEN GifFrameData(TotalGIFFrames).delay = 0.1 ELSE GifFrameData(TotalGIFFrames).delay = delay~% / 100 - GET GifData(Index).file, , GifFrameData(TotalGIFFrames).transColor - SkipGIFBlocks GifData(Index).file - CASE ELSE - 'Unsupported extension Label - GOTO LoadError - END SELECT - CASE ELSE - 'Unsupported chunk - GOTO LoadError - END SELECT - LOOP - - REDIM _PRESERVE GifFrameData(0 TO TotalGIFFrames) AS FRAMEDATA - - GifData(Index).IsPlaying = False - OpenGif = True - EXIT FUNCTION - - LoadError: - GifData(Index).ID = 0 - CLOSE GifData(Index).file - FOR i = 1 TO TotalGIFFrames - IF GifFrameData(i).ID = ID THEN - GifFrameData(i).ID = 0 - END IF - NEXT -END FUNCTION - -FUNCTION GetGifIndex&(ID AS LONG) - DIM i AS LONG - - FOR i = 1 TO TotalGIFLoaded - IF GifData(i).ID = ID THEN - GetGifIndex& = i - EXIT FOR - END IF - NEXT -END FUNCTION - -SUB CloseGif(ID AS LONG) - DIM i AS LONG, Index AS LONG - - Index = GetGifIndex(ID) - - IF Index = 0 THEN EXIT SUB - - FOR i = 0 TO UBOUND(GifFrameData) - IF GifFrameData(i).ID = ID THEN - GifFrameData(i).ID = 0 - IF GifFrameData(i).addr < -1 THEN - _FREEIMAGE GifFrameData(i).addr - END IF - END IF - NEXT - - CLOSE GifData(Index).file - GifData(Index).ID = 0 - GifData(Index).firstFrame = 0 -END SUB - -SUB SkipGIFBlocks (file AS INTEGER) - DIM byte~%% - DO - GET file, , byte~%% ' Block Size - SEEK file, LOC(file) + byte~%% + 1 - LOOP WHILE byte~%% -END SUB - -FUNCTION GetGifFrame& (Index AS LONG) - DIM i AS LONG - DIM frame AS LONG, previousFrame AS LONG - DIM w AS INTEGER, h AS INTEGER - DIM img&, actualFrame& - DIM prevDest AS LONG - - IF GifData(Index).Frame > GifData(Index).totalFrames THEN - GifData(Index).Frame = 1 - END IF - - FOR i = 1 TO UBOUND(GifFrameData) - IF GifFrameData(i).ID = GifData(Index).ID AND GifFrameData(i).thisFrame = GifData(Index).Frame THEN - frame = i - EXIT FOR - ELSEIF GifFrameData(i).ID = GifData(Index).ID AND GifFrameData(i).thisFrame < GifData(Index).Frame THEN - previousFrame = i - END IF - NEXT - - GifData(Index).LastFrameDelay = GifFrameData(frame).delay - (GifFrameData(frame).delay / 10) - - IF GifFrameData(frame).addr > 0 THEN - prevDest = _DEST - w = GifFrameData(frame).width - h = GifFrameData(frame).height - img& = _NEWIMAGE(w, h, 256) - actualFrame& = _NEWIMAGE(GifData(Index).width, GifData(Index).height, 256) - - _DEST img& - DecodeFrame GifData(Index), GifFrameData(frame) - - _DEST actualFrame& - IF GifFrameData(frame).localColorTableFlag THEN - _COPYPALETTE img& - ELSE - FOR i = 0 TO GifData(Index).numColors - 1 - _PALETTECOLOR i, _RGB32(ASC(GifData(Index).palette, i * 3 + 1), ASC(GifData(Index).palette, i * 3 + 2), ASC(GifData(Index).palette, i * 3 + 3)) - NEXT - END IF - - IF GifData(Index).Frame > 1 THEN - SELECT CASE GifFrameData(previousFrame).disposalMethod - CASE 0, 1 - _PUTIMAGE , GifFrameData(previousFrame).addr - CASE 2 - CLS , GifData(Index).bgColor - _CLEARCOLOR GifData(Index).bgColor - END SELECT - ELSE - CLS , GifData(Index).bgColor - END IF - - IF GifFrameData(frame).transparentFlag THEN - _CLEARCOLOR GifFrameData(frame).transColor, img& - END IF - _PUTIMAGE (GifFrameData(frame).left, GifFrameData(frame).top), img& - _FREEIMAGE img& - - GifFrameData(frame).addr = actualFrame& - GifData(Index).LoadedFrames = GifData(Index).LoadedFrames + 1 - GifData(Index).GifLoadComplete = (GifData(Index).LoadedFrames = GifData(Index).TotalFrames) - _DEST prevDest - END IF - - GetGifFrame& = GifFrameData(frame).addr -END FUNCTION - -SUB DecodeFrame (gifdata AS GIFDATA, GifFrameData AS FRAMEDATA) - DIM byte AS _UNSIGNED _BYTE - DIM prefix(4095), suffix(4095), colorStack(4095) - DIM startCodeSize AS INTEGER, clearCode AS INTEGER - DIM endCode AS INTEGER, minCode AS INTEGER, startMaxCode AS INTEGER - DIM nvc AS INTEGER, codeSize AS INTEGER - DIM maxCode AS INTEGER, bitPointer AS INTEGER, blockSize AS INTEGER - DIM blockPointer AS INTEGER, x AS INTEGER, y AS INTEGER - DIM palette$, i AS LONG, c&, stackPointer AS INTEGER - DIM currentCode AS INTEGER, code AS INTEGER, lastColor AS INTEGER - DIM oldCode AS INTEGER, WorkCode&, LastChar AS INTEGER - DIM interlacedPass AS INTEGER, interlacedStep AS INTEGER - DIM file AS INTEGER, a$, loopStart! - - startCodeSize = gifdata.bpp + 1 - clearCode = 2 ^ gifdata.bpp - endCode = clearCode + 1 - minCode = endCode + 1 - startMaxCode = clearCode * 2 - 1 - nvc = minCode - codeSize = startCodeSize - maxCode = startMaxCode - - IF GifFrameData.interlacedFlag THEN interlacedPass = 0: interlacedStep = 8 - bitPointer = 0 - blockSize = 0 - blockPointer = 0 - x = 0 - y = 0 - - file = gifdata.file - SEEK file, GifFrameData.addr - - IF GifFrameData.localColorTableFlag THEN - palette$ = SPACE$(3 * 2 ^ GifFrameData.palBPP) - GET file, , palette$ - - FOR i = 0 TO gifdata.numColors - 1 - c& = _RGB32(ASC(palette$, i * 3 + 1), ASC(palette$, i * 3 + 2), ASC(palette$, i * 3 + 3)) - _PALETTECOLOR i, c& - NEXT - END IF - - GET file, , byte ' minimumCodeSize - - loopStart! = TIMER - DO - IF TIMER - loopStart! > 2 THEN EXIT DO - GOSUB GetCode - stackPointer = 0 - IF code = clearCode THEN 'Reset & Draw next color direct - nvc = minCode ' \ - codeSize = startCodeSize ' Preset default codes - maxCode = startMaxCode ' / - - GOSUB GetCode - currentCode = code - - lastColor = code - colorStack(stackPointer) = lastColor - stackPointer = 1 - ELSEIF code <> endCode THEN 'Draw direct color or colors from suffix - currentCode = code - IF currentCode = nvc THEN 'Take last color too - currentCode = oldCode - colorStack(stackPointer) = lastColor - stackPointer = stackPointer + 1 - END IF - - WHILE currentCode >= minCode 'Extract colors from suffix - colorStack(stackPointer) = suffix(currentCode) - stackPointer = stackPointer + 1 - currentCode = prefix(currentCode) 'Next color from suffix is described in - WEND ' the prefix, else prefix is the last col. - - lastColor = currentCode ' Last color is equal to the - colorStack(stackPointer) = lastColor ' last known code (direct, or from - stackPointer = stackPointer + 1 ' Prefix) - suffix(nvc) = lastColor 'Automatically, update suffix - prefix(nvc) = oldCode 'Code from the session before (for extracting from suffix) - nvc = nvc + 1 - - IF nvc > maxCode AND codeSize < 12 THEN - codeSize = codeSize + 1 - maxCode = maxCode * 2 + 1 - END IF - END IF - - FOR i = stackPointer - 1 TO 0 STEP -1 - PSET (x, y), colorStack(i) - x = x + 1 - IF x = GifFrameData.width THEN - x = 0 - IF GifFrameData.interlacedFlag THEN - y = y + interlacedStep - IF y >= GifFrameData.height THEN - SELECT CASE interlacedPass - CASE 0: interlacedPass = 1: y = 4 - CASE 1: interlacedPass = 2: y = 2 - CASE 2: interlacedPass = 3: y = 1 - END SELECT - interlacedStep = 2 * y - END IF - ELSE - y = y + 1 - END IF - END IF - NEXT - - oldCode = code - LOOP UNTIL code = endCode - GET file, , byte - EXIT SUB - - GetCode: - IF bitPointer = 0 THEN GOSUB ReadByteFromBlock: bitPointer = 8 - WorkCode& = LastChar \ (2 ^ (8 - bitPointer)) - WHILE codeSize > bitPointer - GOSUB ReadByteFromBlock - - WorkCode& = WorkCode& OR LastChar * (2 ^ bitPointer) - bitPointer = bitPointer + 8 - WEND - bitPointer = bitPointer - codeSize - code = WorkCode& AND maxCode - RETURN - - ReadByteFromBlock: - IF blockPointer = blockSize THEN - GET file, , byte: blockSize = byte - a$ = SPACE$(blockSize): GET file, , a$ - blockPointer = 0 - END IF - blockPointer = blockPointer + 1 - LastChar = ASC(MID$(a$, blockPointer, 1)) - RETURN -END SUB - -FUNCTION gifOverlayImage$ - DIM A$ - A$ = MKI$(64) + MKI$(64) - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000J000005000`M0000M20004<000`e0000V30008?000Pl0000" - A$ = A$ + "V3000L=000@`0000M2000L70000D0000J000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000003000PQ0000<30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?0000c0000620000300000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "00030000^1000X<000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000:3000h60000300000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000l0000@N0000Q30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000Q3000T7000`30000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000010000\5000`g0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "O3000\5000@0000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "0000000000000000000000000000000000000000R0000X;000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000j2000420" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "0000000000000000A1000D>000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000@i0000A100000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "0000000000000000000000000000000000000000000000@00000520008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000@Q0000100000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "0000000000000000000000P10000M20008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b3000d9000P1000000000000000000000000000000000000" - A$ = A$ + "0000000000000000000000000000000000000000000000000000000000P1" - A$ = A$ + "0000^20008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000^2000H00000000000000000000000000000000000000000000000000" - A$ = A$ + "0000000000000000000000000000000000@00000L20008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0000W00001000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "0000000000000000120008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b300088000000000000000000000" - A$ = A$ + "0000000000000000000000000000000000000000000000000000@10008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000A10000000000000000000000000000000000" - A$ = A$ + "0000000000000000000000000000P0000@>000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b3000@>00008000000000000000000000000000000000000000000000000" - A$ = A$ + "000010000T;000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000i2000400" - A$ = A$ + "000000000000000000000000000000000000000000000\5000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?0000G00000000000000000000" - A$ = A$ + "000000000000000000000l0000Pg0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000N3000l0000000000000000000000000000000000" - A$ = A$ + "00@N0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000@N000000000000000000000000000000`20000Q30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000Q3000`000000" - A$ = A$ + "00000000000000000000^10008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000PK000000000000000000001000" - A$ = A$ + "0l<000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000@30004000000000000000L3000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "000m0000f3000P?000Pn0000j3000X?000Pn0000h3000@?000`l0000b300" - A$ = A$ + "08?000Pl0000b30008?000@m0000h3000X?0000n0000f30008?000`l0000" - A$ = A$ + "g3000T?000Pn0000j3000X?000Pn0000j3000X?000Pn0000j3000X?000Pn" - A$ = A$ + "0000j3000P?000`l0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00`=000000000000000R0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b3000D?0000n0000j3000X?000Pn0000" - A$ = A$ + "j3000X?000Pn0000j3000X?000Pn0000i3000H?000Pl0000b30008?000@m" - A$ = A$ + "0000j3000X?000Pn0000j3000X?000Pm0000g3000X?000Pn0000j3000X?0" - A$ = A$ + "00Pn0000j3000X?000Pn0000j3000X?000Pn0000j3000X?000Pn0000i300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl00009200000000000000" - A$ = A$ + "<30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b3000H?000Pn0000jOb9WX?WLb9oNk]gnooooooooooooooooooooooZ" - A$ = A$ + "[^JoniWOl3000X?000Pn0000h30008?000Pl0000g3000X?^hRKoooooo;]d" - A$ = A$ + "Bk?000Pn0000h3000T?000PnZ[^jnooooooooooooooooooooooooooooooo" - A$ = A$ + "oooooooooooooooooooooooooooo\a6Kk3000X?000@m0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b3000d<000000000K00008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b3000H?000Pn0000j_jZ" - A$ = A$ + "[foooooooooooooooooooooooooooooooooooooooooooooooo_dB;]oWLb9" - A$ = A$ + "j3000X?000Pm0000b3000L?000PnhR;^mooooo_dB;]o0000j3000P?000@n" - A$ = A$ + "0000j[^jZkoooooooooooooooooooooooooooooooooooooooooooooooooo" - A$ = A$ + "oooooooooc6K\]?000Pn0000e30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000L000005000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b3000@?000Pn0000j;]dBkoooooooooooGLa5g_Oni7o" - A$ = A$ + "0000j3000X?000PnIUEFk_jZ[foooooooooook]gNk?000Pn0000j3000@?0" - A$ = A$ + "00`m0000jS;^hfooooooB;]dn3000X?0000n0000i3000X_jZ[^oooooogHS" - A$ = A$ + "=b?000Pn0000j3000X?000Pn0000j3000X?000Pn0000j3000X?000Pn0000" - A$ = A$ + "i30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300085000@O" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "000n0000jc9WLboooooooooooc6K\]?000Pn0000j3000X?000Pn0000j300" - A$ = A$ + "0X?000PnIUEFkoooooooooooLb9Wl3000X?000Pm0000g3000X?^hRKooooo" - A$ = A$ + "o;]dBk?000Pn0000h3000T?000PnZ[^jnoooooOS=f8o0000j3000X?000Pn" - A$ = A$ + "0000j3000X?000Pn0000j3000X?000Pn0000h3000000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b3000X?000Pnooooooooooo@3=dn0000j3000300000000000000920008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?0000m0000h3000X?000Pn0000" - A$ = A$ + "j3000X?000Pn0000j3000X?000Pn0000j3000X?0000n0000e30008?000Pl" - A$ = A$ + "0000e3000X?000Pn0000j3000X?000Pn0000f3000L?000Pn0000j3000X?0" - A$ = A$ + "00Pn0000j300000000000000000@00000@30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?0000d0000100000000000000000000h6000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000^10000000000" - A$ = A$ + "00000000000000030000R30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000R3000`000000000000000000000000000000" - A$ = A$ + "0T7000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b3000T700000000000000000000000000000000000`30000N30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b3000h=000@4000000000000" - A$ = A$ + "00000000000000000000000000000`5000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?0000G000000000000000000000000000000000000" - A$ = A$ + "0000000000@00000j20008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000P^" - A$ = A$ + "000010000000000000000000000000000000000000000000000000000420" - A$ = A$ + "000i0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?0000i0000Q0000000000000000000" - A$ = A$ + "00000000000000000000000000000000000000000000A10008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000A1000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000`P0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl000042000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "00000000000010000`9000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000L2000400000000000000000000000000" - A$ = A$ + "0000000000000000000000000000000000000000000000000000000000P1" - A$ = A$ + "0000^20008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000^2000H00000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000H0000@W0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000M2000H00000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "0000000000000000000000000000000010000D8000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl000052000400000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000A1000D>000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000@i0000A1000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "0000000000P80000j20008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000P^0000Q0000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000400" - A$ = A$ + "000G0000O30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b3000l=0000G" - A$ = A$ + "000010000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "0000000000000000000000000000000000000000000000000l0000@N0000" - A$ = A$ + "Q30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000Q3000X7000`3000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "00000000000000000000000000000000000000000`0000PK0000;30008?0" - A$ = A$ + "00Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b300" - A$ = A$ + "08?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000`b0000" - A$ = A$ + "^1000`000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000<0000920000=000Pl0000" - A$ = A$ + "b30008?000Pl0000b30008?000Pl0000b30008?000Pl0000b30008?000Pl" - A$ = A$ + "0000b30008?000Pl0000@3000T80000<0000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000J000005000@N0000N20008<0" - A$ = A$ + "000f0000Y30008?000@k0000R30008=000P`0000N2000T70000D0000J000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "000000000000000000000000000000000000000000000000000000000000" - A$ = A$ + "0000%%00" - gifOverlayImage$ = A$ -END FUNCTION - -FUNCTION LoadOverlayImage& - DIM MemoryBlock AS _MEM, TempImage AS LONG - DIM NewWidth AS INTEGER, NewHeight AS INTEGER, A$, BASFILE$ - - A$ = gifOverlayImage$ - IF LEN(A$) = 0 THEN EXIT FUNCTION - - NewWidth = CVI(LEFT$(A$, 2)) - NewHeight = CVI(MID$(A$, 3, 2)) - A$ = MID$(A$, 5) - - BASFILE$ = gifUnpack$(A$) - - TempImage = _NEWIMAGE(NewWidth, NewHeight, 32) - MemoryBlock = _MEMIMAGE(TempImage) - - __UI_MemCopy MemoryBlock.OFFSET, _OFFSET(BASFILE$), LEN(BASFILE$) - _MEMFREE MemoryBlock - - LoadOverlayImage& = TempImage -END FUNCTION - -FUNCTION gifUnpack$ (PackedData$) - 'Adapted from Dav's BIN2BAS - 'http://www.qbasicnews.com/dav/qb64.php - DIM A$, i&, B$, C%, F$, C$, t%, B&, X$, btemp$ - - A$ = PackedData$ - - FOR i& = 1 TO LEN(A$) STEP 4 - B$ = MID$(A$, i&, 4) - IF INSTR(1, B$, "%") THEN - FOR C% = 1 TO LEN(B$) - F$ = MID$(B$, C%, 1) - IF F$ <> "%" THEN C$ = C$ + F$ - NEXT - B$ = C$ - END IF - FOR t% = LEN(B$) TO 1 STEP -1 - B& = B& * 64 + ASC(MID$(B$, t%)) - 48 - NEXT - X$ = "" - FOR t% = 1 TO LEN(B$) - 1 - X$ = X$ + CHR$(B& AND 255) - B& = B& \ 256 - NEXT - btemp$ = btemp$ + X$ - NEXT - - gifUnpack$ = btemp$ -END FUNCTION -'############################################################################################ diff --git a/README.md b/README.md index cb67f54..b97ea9d 100644 --- a/README.md +++ b/README.md @@ -75,8 +75,8 @@ InForm/xp.uitheme > Required only when GIF picturebox is used ```text -InForm/extensions/gifplay.bi -InForm/extensions/gifplay.bm +InForm/extensions/GIFPlay.bi +InForm/extensions/GIFPlay.bas ``` > Required only when using legacy InForm MessageBox routines (use [QB64-PE's native common dialog functions](https://qb64phoenix.com/qb64wiki/index.php/Keyword_Reference_-_By_usage#Window_and_Desktop) when writing new code) diff --git a/examples/GIFPlaySample/gifplaySample.bas b/examples/GIFPlaySample/gifplaySample.bas index acd88a1..9b85672 100644 --- a/examples/GIFPlaySample/gifplaySample.bas +++ b/examples/GIFPlaySample/gifplaySample.bas @@ -12,8 +12,8 @@ DIM SHARED PlayBT AS LONG ': External modules: --------------------------------------------------------------- '$INCLUDE:'../../InForm/InForm.bi' -'$INCLUDE:'../../InForm/extensions/gifplay.bi' -'$INCLUDE:'gifplaySample.frm' +'$INCLUDE:'../../InForm/extensions/GIFPlay.bi' +'$INCLUDE:'GIFPlaySample.frm' ': Event procedures: --------------------------------------------------------------- SUB __UI_BeforeInit @@ -96,4 +96,4 @@ END SUB '$INCLUDE:'../../InForm/InForm.ui' '$INCLUDE:'../../InForm/xp.uitheme' -'$INCLUDE:'../../InForm/extensions/gifplay.bm' +'$INCLUDE:'../../InForm/extensions/GIFPlay.bas' diff --git a/examples/GIFPlaySample/gifplaySample.frm b/examples/GIFPlaySample/gifplaySample.frm index 00133d6..277b43a 100644 --- a/examples/GIFPlaySample/gifplaySample.frm +++ b/examples/GIFPlaySample/gifplaySample.frm @@ -10,7 +10,7 @@ SUB __UI_LoadForm __UI_NewID = __UI_NewControl(__UI_Type_Form, "gifplaySample", 300, 281, 0, 0, 0) __UI_RegisterResult = 0 - SetCaption __UI_NewID, "gifplay Sample" + SetCaption __UI_NewID, "GIFPlay Sample" Control(__UI_NewID).Font = SetFont("arial.ttf", 12) Control(__UI_NewID).HasBorder = False diff --git a/examples/ThemePreview/ThemePreview.bas b/examples/ThemePreview/ThemePreview.bas new file mode 100644 index 0000000..84491c5 --- /dev/null +++ b/examples/ThemePreview/ThemePreview.bas @@ -0,0 +1,159 @@ +': This program uses +': InForm - GUI library for QB64 - Beta version 9 +': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor +': https://github.com/FellippeHeitor/InForm +'----------------------------------------------------------- + +': Controls' IDs: ------------------------------------------------------------------ +DIM SHARED ThemeImagePreview AS LONG +DIM SHARED FileLB AS LONG +DIM SHARED DropdownList1 AS LONG +DIM SHARED PictureBox1 AS LONG +DIM SHARED ContextMenu1 AS LONG +DIM SHARED ContextMenu1Copy AS LONG + +': External modules: --------------------------------------------------------------- +'$INCLUDE:'../../InForm/InForm.bi' +'$INCLUDE:'ThemePreview.frm' + +': Event procedures: --------------------------------------------------------------- +SUB __UI_BeforeInit + +END SUB + +SUB __UI_OnLoad + +END SUB + +SUB __UI_BeforeUpdateDisplay + 'This event occurs at approximately 30 frames per second. + 'You can change the update frequency by calling SetFrameRate DesiredRate% + +END SUB + +SUB __UI_BeforeUnload + 'If you set __UI_UnloadSignal = False here you can + 'cancel the user's request to close. + +END SUB + +SUB __UI_Click (id AS LONG) + SELECT CASE id + CASE ThemeImagePreview + + CASE FileLB + + CASE DropdownList1 + + CASE PictureBox1 + + CASE ContextMenu1Copy + _CLIPBOARDIMAGE = Control(PictureBox1).HelperCanvas + END SELECT +END SUB + +SUB __UI_MouseEnter (id AS LONG) + SELECT CASE id + CASE ThemeImagePreview + + CASE FileLB + + CASE DropdownList1 + + CASE PictureBox1 + + CASE ContextMenu1Copy + + END SELECT +END SUB + +SUB __UI_MouseLeave (id AS LONG) + SELECT CASE id + CASE ThemeImagePreview + + CASE FileLB + + CASE DropdownList1 + + CASE PictureBox1 + + CASE ContextMenu1Copy + + END SELECT +END SUB + +SUB __UI_FocusIn (id AS LONG) + SELECT CASE id + CASE DropdownList1 + + END SELECT +END SUB + +SUB __UI_FocusOut (id AS LONG) + 'This event occurs right before a control loses focus. + 'To prevent a control from losing focus, set __UI_KeepFocus = True below. + SELECT CASE id + CASE DropdownList1 + + END SELECT +END SUB + +SUB __UI_MouseDown (id AS LONG) + SELECT CASE id + CASE ThemeImagePreview + + CASE FileLB + + CASE DropdownList1 + + CASE PictureBox1 + + CASE ContextMenu1Copy + + END SELECT +END SUB + +SUB __UI_MouseUp (id AS LONG) + SELECT CASE id + CASE ThemeImagePreview + + CASE FileLB + + CASE DropdownList1 + + CASE PictureBox1 + + CASE ContextMenu1Copy + + END SELECT +END SUB + +SUB __UI_KeyPress (id AS LONG) + 'When this event is fired, __UI_KeyHit will contain the code of the key hit. + 'You can change it and even cancel it by making it = 0 + SELECT CASE id + CASE DropdownList1 + + END SELECT +END SUB + +SUB __UI_TextChanged (id AS LONG) + SELECT CASE id + END SELECT +END SUB + +SUB __UI_ValueChanged (id AS LONG) + SELECT CASE id + CASE DropdownList1 + _FREEIMAGE Control(PictureBox1).HelperCanvas + Control(PictureBox1).HelperCanvas = _COPYIMAGE(__UI_LoadThemeImage(GetItem$(DropdownList1, Control(DropdownList1).Value))) + Control(PictureBox1).Redraw = True + END SELECT +END SUB + +SUB __UI_FormResized + +END SUB + +'$INCLUDE:'../../InForm/InForm.ui' +'$INCLUDE:'../../InForm/xp.uitheme' diff --git a/examples/ThemePreview/ThemePreview.frm b/examples/ThemePreview/ThemePreview.frm new file mode 100644 index 0000000..b280961 --- /dev/null +++ b/examples/ThemePreview/ThemePreview.frm @@ -0,0 +1,71 @@ +': This form was generated by +': InForm - GUI library for QB64 - v1.5 +': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor +': https://github.com/FellippeHeitor/InForm +'----------------------------------------------------------- +SUB __UI_LoadForm + + DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG + + __UI_NewID = __UI_NewControl(__UI_Type_Form, "ThemeImagePreview", 300, 300, 0, 0, 0) + __UI_RegisterResult = 0 + SetCaption __UI_NewID, "Theme image preview" + Control(__UI_NewID).Font = SetFont("arial.ttf", 12) + Control(__UI_NewID).HasBorder = False + + __UI_NewID = __UI_NewControl(__UI_Type_ContextMenu, "ContextMenu1", 22, 22, 10, 268, 0) + __UI_RegisterResult = 0 + + __UI_NewID = __UI_NewControl(__UI_Type_Label, "FileLB", 46, 23, 10, 10, 0) + __UI_RegisterResult = 0 + SetCaption __UI_NewID, "File:" + Control(__UI_NewID).HasBorder = False + Control(__UI_NewID).VAlign = __UI_Middle + + __UI_NewID = __UI_NewControl(__UI_Type_DropdownList, "DropdownList1", 230, 23, 61, 10, 0) + __UI_RegisterResult = 0 + AddItem __UI_NewID, "scrollhbuttons.bmp" + AddItem __UI_NewID, "scrollhthumb.bmp" + AddItem __UI_NewID, "scrollhtrack.bmp" + AddItem __UI_NewID, "menucheckmark.bmp" + AddItem __UI_NewID, "slidertrack.png" + AddItem __UI_NewID, "frame.png" + AddItem __UI_NewID, "arrows.png" + AddItem __UI_NewID, "scrolltrack.png" + AddItem __UI_NewID, "scrollthumb.png" + AddItem __UI_NewID, "scrollbuttons.png" + AddItem __UI_NewID, "radiobutton.png" + AddItem __UI_NewID, "progresstrack.png" + AddItem __UI_NewID, "progresschunk.png" + AddItem __UI_NewID, "button.png" + AddItem __UI_NewID, "checkbox.png" + AddItem __UI_NewID, "notfound.png" + AddItem __UI_NewID, "sliderdown.png" + Control(__UI_NewID).HasBorder = True + Control(__UI_NewID).CanHaveFocus = True + Control(__UI_NewID).BorderSize = 1 + + __UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "PictureBox1", 278, 252, 11, 38, 0) + __UI_RegisterResult = 0 + Control(__UI_NewID).HasBorder = False + Control(__UI_NewID).Align = __UI_Center + Control(__UI_NewID).VAlign = __UI_Middle + Control(__UI_NewID).ContextMenuID = __UI_GetID("ContextMenu1") + Control(__UI_NewID).BorderSize = 1 + + __UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "ContextMenu1Copy", 72, 18, 0, 4, __UI_GetID("ContextMenu1")) + __UI_RegisterResult = 0 + SetCaption __UI_NewID, "&Copy" + Control(__UI_NewID).HasBorder = False + __UI_RegisterResult = RegisterKeyCombo("Ctrl+C", __UI_NewID) + +END SUB + +SUB __UI_AssignIDs + ThemeImagePreview = __UI_GetID("ThemeImagePreview") + ContextMenu1 = __UI_GetID("ContextMenu1") + FileLB = __UI_GetID("FileLB") + DropdownList1 = __UI_GetID("DropdownList1") + PictureBox1 = __UI_GetID("PictureBox1") + ContextMenu1Copy = __UI_GetID("ContextMenu1Copy") +END SUB