diff --git a/InForm/InForm.bi b/InForm/InForm.bi index 3265119..f2d6258 100644 --- a/InForm/InForm.bi +++ b/InForm/InForm.bi @@ -10,7 +10,7 @@ $END IF $LET INFORM_BI = TRUE DECLARE LIBRARY - FUNCTION __UI_GetPID ALIAS getpid () + FUNCTION __UI_GetPID ALIAS getpid END DECLARE DECLARE CUSTOMTYPE LIBRARY diff --git a/InForm/UiEditorPreview.bas b/InForm/UiEditorPreview.bas index bd3bdcd..8afcd4d 100644 --- a/InForm/UiEditorPreview.bas +++ b/InForm/UiEditorPreview.bas @@ -91,8 +91,8 @@ $END IF ContextMenuIcon = LoadEditorImage("contextmenu.bmp") __UI_ClearColor ContextMenuIcon, 0, 0 -'$INCLUDE:'InForm.bi' '$INCLUDE:'extensions/GIFPlay.bi' +'$INCLUDE:'InForm.bi' '$INCLUDE:'xp.uitheme' '$INCLUDE:'UiEditorPreview.frm' @@ -165,7 +165,7 @@ SUB __UI_BeforeUpdateDisplay END IF FOR i = 1 TO UBOUND(AutoPlayGif) - IF AutoPlayGif(i) THEN GIF_Draw i + IF AutoPlayGif(i) THEN GIF_Draw i, True NEXT STATIC prevDefaultButton AS LONG, prevMenuPanelActive AS INTEGER @@ -2218,7 +2218,7 @@ SUB DeleteSelectedControls IF __UI_TotalActiveMenus > 0 AND __UI_ParentMenu(__UI_TotalActiveMenus) = Control(i).ID THEN __UI_CloseAllMenus END IF - GIF_Close i + GIF_Free i __UI_DestroyControl Control(i) IF MustRefreshMenuBar THEN __UI_RefreshMenuBar IF MustRefreshContextMenus THEN RefreshContextMenus @@ -2388,7 +2388,7 @@ SUB LoadPreview (Destination AS _BYTE) IF Disk THEN FOR i = UBOUND(Control) TO 1 STEP -1 IF LEFT$(Control(i).Name, 5) <> "__UI_" THEN - GIF_Close i + GIF_Free i __UI_DestroyControl Control(i) END IF NEXT @@ -2407,7 +2407,7 @@ SUB LoadPreview (Destination AS _BYTE) ELSEIF UndoBuffer THEN FOR i = UBOUND(Control) TO 1 STEP -1 IF LEFT$(Control(i).Name, 5) <> "__UI_" THEN - GIF_Close i + GIF_Free i __UI_DestroyControl Control(i) END IF NEXT @@ -2764,7 +2764,7 @@ SUB LoadPreview (Destination AS _BYTE) IF NOT CorruptedData THEN __UI_FirstSelectedID = FirstToBeSelected ELSE - GIF_Close TempValue + GIF_Free TempValue __UI_DestroyControl Control(TempValue) __UI_TotalSelectedControls = __UI_TotalSelectedControls - 1 END IF @@ -2810,7 +2810,7 @@ SUB LoadPreviewText __UI_AutoRefresh = False FOR i = UBOUND(Control) TO 1 STEP -1 IF LEFT$(Control(i).Name, 5) <> "__UI_" THEN - GIF_Close i + GIF_Free i __UI_DestroyControl Control(i) END IF NEXT @@ -3062,7 +3062,7 @@ SUB LoadPreviewText DIM RegisterResult AS _BYTE DummyText$ = nextParameter(b$) 'discard first parameter DummyText$ = nextParameter(b$) - RegisterResult = GIF_OpenFile(TempValue, DummyText$) + RegisterResult = GIF_LoadFromFile(TempValue, DummyText$) IF RegisterResult THEN IF LogFileLoad THEN PRINT #LogFileNum, "LOAD SUCCESSFUL" Text(TempValue) = DummyText$ 'indicates image loaded successfully @@ -3070,7 +3070,7 @@ SUB LoadPreviewText _FREEIMAGE Control(TempValue).HelperCanvas END IF Control(TempValue).HelperCanvas = _NEWIMAGE(GIF_GetWidth(TempValue), GIF_GetHeight(TempValue), 32) - GIF_Draw TempValue + GIF_Draw TempValue, True END IF ELSEIF b$ = "IF __UI_RegisterResult THEN PlayGif __UI_NewID" OR LEFT$(b$, 8) = "PlayGif " THEN IF LogFileLoad THEN PRINT #LogFileNum, "AUTOPLAY GIF" @@ -3159,11 +3159,11 @@ END SUB SUB PreviewLoadImage (This AS __UI_ControlTYPE, fileName$) IF LCASE$(RIGHT$(fileName$, 4)) = ".gif" THEN DIM tryGif AS _BYTE - GIF_Close This.ID - tryGif = GIF_OpenFile(This.ID, fileName$) + GIF_Free This.ID + tryGif = GIF_LoadFromFile(This.ID, fileName$) IF tryGif THEN IF GIF_GetTotalFrames(This.ID) = 1 THEN - GIF_Close This.ID + GIF_Free This.ID ELSE Text(This.ID) = fileName$ 'indicates image loaded successfully IF This.HelperCanvas < -1 THEN @@ -3171,12 +3171,12 @@ SUB PreviewLoadImage (This AS __UI_ControlTYPE, fileName$) END IF This.HelperCanvas = _NEWIMAGE(GIF_GetWidth(This.ID), GIF_GetHeight(This.ID), 32) AutoPlayGif(This.ID) = False - GIF_Draw This.ID + GIF_Draw This.ID, True EXIT SUB END IF END IF END IF - GIF_Close This.ID + GIF_Free This.ID LoadImage This, fileName$ END SUB @@ -3581,7 +3581,7 @@ SUB SavePreview (Destination AS _BYTE) b$ = MKI$(-44) + MKI$(LEN(RTRIM$(__UI_KeyCombo(Control(i).KeyCombo).FriendlyCombo))) + RTRIM$(__UI_KeyCombo(Control(i).KeyCombo).FriendlyCombo) IF Disk THEN PUT #BinFileNum, , b$ ELSE Clip$ = Clip$ + b$ END IF - IF GIF_GetIndex(i) > 0 THEN + IF GIF_IsLoaded(i) THEN 'PictureBox has an animated GIF loaded b$ = MKI$(-45) IF Disk THEN diff --git a/InForm/extensions/GIFPlay.bas b/InForm/extensions/GIFPlay.bas index e0a3eea..c3e4a8d 100644 --- a/InForm/extensions/GIFPlay.bas +++ b/InForm/extensions/GIFPlay.bas @@ -8,77 +8,393 @@ $IF GIFPLAY_BAS = UNDEFINED THEN '$INCLUDE:'GIFPlay.bi' - FUNCTION GIF_OpenFile%% (Id AS LONG, fileName AS STRING) + ' This is an internal loading function common for both memory and file loaders + FUNCTION __GIF_Load%% (Id AS LONG, sf AS StringFileType) + END FUNCTION + + ' Opens a GIF file from a buffer in memory + FUNCTION GIF_LoadFromMemory%% (Id AS LONG, buffer AS STRING) + _MESSAGEBOX , "GIF_LoadFromMemory%%" + + DIM sf AS StringFileType + + StringFile_Create sf, buffer + + GIF_LoadFromMemory = __GIF_Load(Id, sf) END FUNCTION - FUNCTION GIF_OpenMemory%% (Id AS LONG, buffer AS STRING) + ' Opens a GIF file from a file on disk + FUNCTION GIF_LoadFromFile%% (Id AS LONG, fileName AS STRING) + _MESSAGEBOX STR$(Id), "GIF_LoadFromFile%%" + + DIM sf AS StringFileType + + IF StringFile_Load(sf, fileName) THEN + GIF_LoadFromFile = __GIF_Load(Id, sf) + END IF END FUNCTION - SUB GIF_Close (Id AS LONG) + ' Free a GIF and all associated resources + SUB GIF_Free (Id AS LONG) + _MESSAGEBOX STR$(Id), "GIF_Free" END SUB - FUNCTION GIF_GetHeight~% (Id AS LONG) - END FUNCTION - - + ' Returns the width of the animation in pixels FUNCTION GIF_GetWidth~% (Id AS LONG) + _MESSAGEBOX STR$(Id), "GIF_LoadFromFile%%" + + SHARED __GIFPlayHashTable() AS HashTableType + SHARED __GIFPlay() AS __GIFPlayType + + GIF_GetWidth = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).W END FUNCTION + ' Returns the height of the animation in pixels + FUNCTION GIF_GetHeight~% (Id AS LONG) + _MESSAGEBOX STR$(Id), "GIF_GetHeight~%" + + SHARED __GIFPlayHashTable() AS HashTableType + SHARED __GIFPlay() AS __GIFPlayType + + GIF_GetHeight = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).H + END FUNCTION + + + ' Returns the number of currently playing frame FUNCTION GIF_GetCurrentFrame~& (Id AS LONG) + _MESSAGEBOX STR$(Id), "GIF_GetCurrentFrame~&" + + SHARED __GIFPlayHashTable() AS HashTableType + SHARED __GIFPlay() AS __GIFPlayType + + GIF_GetCurrentFrame = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).currentFrameNumber END FUNCTION + ' Returns the total frames in the GIF. If this is 1 then it is a static image FUNCTION GIF_GetTotalFrames~& (Id AS LONG) + _MESSAGEBOX STR$(Id), "GIF_GetTotalFrames~&" + + SHARED __GIFPlayHashTable() AS HashTableType + SHARED __GIFPlay() AS __GIFPlayType + + GIF_GetTotalFrames = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).totalFrames END FUNCTION + ' Sets the playback direction. direction should be -1 or 1 SUB GIF_SetPlaybackDirection (Id AS LONG, direction AS _BYTE) + _MESSAGEBOX STR$(Id), "GIF_SetPlaybackDirection" + + SHARED __GIFPlayHashTable() AS HashTableType + SHARED __GIFPlay() AS __GIFPlayType + + IF direction <> 0 THEN __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).direction = SGN(direction) END SUB + ' Gets the current playback direction. This can be -1 or 1 FUNCTION GIF_GetPlaybackDirection%% (Id AS LONG) + _MESSAGEBOX STR$(Id), "GIF_GetPlaybackDirection%%" + + SHARED __GIFPlayHashTable() AS HashTableType + SHARED __GIFPlay() AS __GIFPlayType + + GIF_GetPlaybackDirection = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).direction END FUNCTION + ' Resume or starts playback SUB GIF_Play (Id AS LONG) + _MESSAGEBOX STR$(Id), "GIF_Play" + + SHARED __GIFPlayHashTable() AS HashTableType + SHARED __GIFPlay() AS __GIFPlayType + + __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isPlaying = TRUE END SUB + ' Pauses playback. That same frame is served as long as playback is paused SUB GIF_Pause (Id AS LONG) + _MESSAGEBOX STR$(Id), "GIF_Pause" + + SHARED __GIFPlayHashTable() AS HashTableType + SHARED __GIFPlay() AS __GIFPlayType + + __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isPlaying = FALSE END SUB + ' Stops playing the GIF and resets the cursor to the first frame SUB GIF_Stop (Id AS LONG) + _MESSAGEBOX STR$(Id), "GIF_Stop" + + SHARED __GIFPlayHashTable() AS HashTableType + SHARED __GIFPlay() AS __GIFPlayType + + DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id) + + __GIFPlay(idx).isPlaying = FALSE + __GIFPlay(idx).currentFrame = __GIFPlay(idx).firstFrame END SUB + ' Return True if GIF is currently playing FUNCTION GIF_IsPlaying%% (Id AS LONG) + _MESSAGEBOX STR$(Id), "GIF_IsPlaying%%" + + SHARED __GIFPlayHashTable() AS HashTableType + SHARED __GIFPlay() AS __GIFPlayType + + GIF_IsPlaying = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isPlaying END FUNCTION - SUB GIF_Draw (Id AS LONG) + ' This draws the current frame on the destination surface @ (0, 0) (stretching the frame if needed) + ' This will also draw the overlay if the playback is stopped / paused + SUB GIF_Draw (Id AS LONG, shouldStretch AS _BYTE) + ' TODO END SUB - SUB GIF_DrawPro (Id AS LONG, x AS LONG, y AS LONG) + ' This draws the current frame at the specified x, y location on the destination surface (preserving aspect ratio) + ' This will also draw the overlay if the playback is stopped / paused + SUB GIF_DrawAt (Id AS LONG, x AS LONG, y AS LONG) + _MESSAGEBOX STR$(Id), "GIF_DrawAt" END SUB + ' This returns the current frame (QB64 image) to be played + ' Playback is time sensitive so frames may be skipped or the last frame maybe returned + ' Only use this if you want to do your own rendering + ' Also do not free the image. The library will do that when it is no longer needed FUNCTION GIF_GetFrame& (Id AS LONG) + _MESSAGEBOX STR$(Id), "GIF_GetFrame&" END FUNCTION + ' Sets the GIF overlay to enable / disable SUB GIF_EnableOverlay (Id AS LONG, isEnabled AS _BYTE) + _MESSAGEBOX STR$(Id), "GIF_EnableOverlay" + + SHARED __GIFPlayHashTable() AS HashTableType + SHARED __GIFPlay() AS __GIFPlayType + + __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).overlayEnabled = isEnabled END SUB - ' Returns the __GIFPlay index of a loaded GIF using it's ID - ' TODO: Fix line in UiEditorPreview: IF GIF_GetIndex(i) > 0 THEN - FUNCTION GIF_GetIndex~& (Id AS LONG) + ' Returns TRUE if a GIF with Id is loaded + FUNCTION GIF_IsLoaded%% (Id AS LONG) + SHARED __GIFPlayHashTable() AS HashTableType + + GIF_IsLoaded = HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) + END FUNCTION + + + SUB __GIF_CreateBitmap (bmp AS __GIFBitmapType, w AS LONG, h AS LONG) + bmp.W = w + bmp.H = h + bmp.pixels = STRING$(w * h, 0) + END SUB + + + SUB __GIF_BlitBitmap (src AS __GIFBitmapType, dst AS __GIFBitmapType, srcX AS LONG, srcY AS LONG, dstX AS LONG, dstY AS LONG, bW AS LONG, bH AS LONG) + IF bW <= 0 OR bH <= 0 THEN EXIT SUB + + DIM AS LONG w, xs, xd: w = bW: xs = srcX: xd = dstX + DIM AS LONG h, ys, yd: h = bH: ys = srcY: yd = dstY + + IF xs < 0 THEN + w = w + xs + xd = xd - xs + xs = 0 + END IF + IF ys < 0 THEN + h = h + ys + yd = yd - ys + ys = 0 + END IF + + IF xs + w > src.W THEN w = src.W - xs + IF ys + h > src.H THEN h = src.H - ys + + IF xd < 0 THEN + w = w + xd + xs = xs - xd + xd = 0 + END IF + IF yd < 0 THEN + h = h + yd + ys = ys - yd + yd = 0 + END IF + + IF xd + w > dst.W THEN w = dst.W - xd + IF yd + h > dst.H THEN h = dst.H - yd + + IF w <= 0 OR h <= 0 THEN EXIT SUB + + DIM ps AS LONG: ps = 1 + ys * src.W + DIM pd AS LONG: pd = 1 + yd * dst.W + DIM i AS LONG: FOR i = 1 TO h + MID$(dst.pixels, pd + xd, w) = MID$(src.pixels, ps + xs, w) + ps = ps + src.W + pd = pd + dst.W + NEXT i + END SUB + + + FUNCTION __GIF_ReadLZWCode& (sf AS StringFileType, buffer AS STRING, bitPos AS LONG, bitSize AS LONG) + DIM code AS LONG, p AS LONG: p = 1 + + DIM i AS LONG: FOR i = 1 TO bitSize + DIM bytePos AS LONG: bytePos = _SHR(bitPos, 3) AND 255 + + IF bytePos = 0 THEN + DIM dataLen AS LONG: dataLen = StringFile_ReadByte(sf) + + IF dataLen = 0 THEN + __GIF_ReadLZWCode = -1 + EXIT FUNCTION + END IF + + MID$(buffer, 257 - dataLen) = StringFile_ReadString(sf, dataLen) + + bytePos = 256 - dataLen + bitPos = _SHL(bytePos, 3) + END IF + + IF ASC(buffer, 1 + bytePos) AND _SHL(1, (bitPos AND 7)) THEN code = code + p + + p = p + p + bitPos = bitPos + 1 + NEXT i + + __GIF_ReadLZWCode = code + END FUNCTION + + + FUNCTION __GIF_DecodeLZW& (sf AS StringFileType, bmp AS __GIFBitmapType) + TYPE __LZWCodeType + prefix AS LONG + c AS LONG + ln AS LONG + END TYPE + + DIM codes(0 TO 4095) AS __LZWCodeType + + DIM origBitSize AS LONG: origBitSize = StringFile_ReadByte(sf) + DIM n AS LONG: n = 2 + _SHL(1, origBitSize) + + DIM i AS LONG: WHILE i < n + codes(i).c = i + codes(i).ln = 0 + i = i + 1 + WEND + + DIM clearMarker AS LONG: clearMarker = n - 2 + DIM endMarker AS LONG: endMarker = n - 1 + + DIM buffer AS STRING: buffer = SPACE$(256) + DIM bitSize AS LONG: bitSize = origBitSize + 1 + DIM bitPos AS LONG + + DIM prev AS LONG: prev = __GIF_ReadLZWCode(sf, buffer, bitPos, bitSize) + IF prev = -1 THEN + __GIF_DecodeLZW = -1 + EXIT FUNCTION + END IF + + DO + DIM code AS LONG: code = __GIF_ReadLZWCode(sf, buffer, bitPos, bitSize) + IF code = -1 THEN + __GIF_DecodeLZW = -1 + EXIT FUNCTION + END IF + + IF code = clearMarker THEN + bitSize = origBitSize + n = _SHL(1, bitSize) + n = n + 2 + bitSize = bitSize + 1 + prev = code + _CONTINUE + END IF + + IF code = endMarker THEN EXIT DO + + DIM c AS LONG: IF code < n THEN c = code ELSE c = prev + + DIM outPos AS LONG: outPos = outPos + codes(c).ln + i = 0 + + DO + ASC(bmp.pixels, 1 + outPos - i) = codes(c).c + + IF codes(c).ln THEN + c = codes(c).prefix + ELSE + EXIT DO + END IF + + i = i + 1 + LOOP + + outPos = outPos + 1 + + IF code >= n THEN + ASC(bmp.pixels, 1 + outPos) = codes(c).c + outPos = outPos + 1 + END IF + + IF prev <> clearMarker THEN + codes(n).prefix = prev + codes(n).ln = codes(prev).ln + 1 + codes(n).c = codes(c).c + n = n + 1 + END IF + + IF _SHL(1, bitSize) = n THEN + IF bitSize < 12 THEN bitSize = bitSize + 1 + END IF + + prev = code + LOOP + END FUNCTION + + + ' This load the GIF overload image + FUNCTION __GIF_LoadOverlayImage& + CONST SIZE_GIFOVERLAYIMAGE_BMP_16506 = 16506 + CONST COMP_GIFOVERLAYIMAGE_BMP_16506 = -1 + CONST DATA_GIFOVERLAYIMAGE_BMP_16506 = _ + "eNpy8q1yYACDKiDOAWIHKGZkUGBgZsAF/kMQjDM4gRSgfbsGjt+I4jgexj+2YU57nd27H0Nl6htD6wkzJ31hqFyFWkMVZmZm5rzjMyjfzcwLvEKj" + _ + "tXTnFbyZjxn0O60WBBjDdVjDU/gAP0LwK77CW3gKa7gOY+B3c1k13Ic3ICm9gftQQ8h1BIt4GdInL2MRRxBKHcd1+BIyIF/iehzHYdWpmMXnkEPy" + _ + "OWZxKgZZV2AbEohtXI5B1Di+hQTmW4z3ub3fBQncXX04Hs7CKiQnVnFWhtkfh+TM4zgrgza/AsmplZTHwh2QnLszRT8vheA/LlyObyAF8Q0u9zjm" + _ + "tyEFs52wL5iFFNRsgrXMZ5CC+gwnY/JfBym462LW719BCu4rHIGtRUhJLNo+H29ASuINMxYMQ1JooIUOekYHLTQgFpromJ8V1NFGV7+HOiQjw9C6" + _ + "L0VumzlOB02TvWehhTZ6VoavwX3QehXixWz7ysrK7rPPPrsXmXJfc98zGdqoa8bNzc2/f++tt97a19dJ9/tPP/20H1EPPfSQ/o0mJAOvwdVFabK7" + _ + "bFHCeuSRR/ZMWxh4fuMiTBygzff+u9267XY/X3vttT33Nc3gyn08NTW1474fQP4J3ATx0LH7/eabbzbt24D7mUajEWmWQPLfhHXffT8yMrJjs6Nr" + _ + "+3k00LZZAsq/jqcgCbX+u+8/++yzfc2OOgR1bSNWgPmfwoe+bd/ljig93tGCOLrd/ctvwM4dPLyL7yAJ9Rxt+/Pz8ztmnzTRc1+PYirT/Ibna/AF" + _ + "5KD56Qc0f72v+ROU+V1J6JeM89v2Hy+A/Inav8mm45ht/7b/i9FBPZD2n0X/107ye0YnhP4vzfjnti3BuqShc0FdC7iPQxn/fOc/msX2ZTr/Qd2u" + _ + "be2cIaD5/3oW81/tByzl5vsRZecM2R//3ucJbsLYQdc/bnv/u8616wCX2635Isrse6eRYX6r67H+uRDiqYWeo/mSjE8cN6aPzm78i5mTxbkIrl5J" + _ + "8xroOlfHBbvmN+2iAwkg/6vQuhfixfRvCWj/KN7nv/x1Pc9/DfX5/GcD9ZTnP5Fp/zdkzn+/Xsrz39X1D63z8SWk4L7Eker6Z2mvfx9HXM2U+P4H" + _ + "HQu2IAVDJrIlq8uKd/8TmfxqrMT3v2ndBsm526v7X6v7n6v736vnH6rnX6rnnzI+HmYCeP5tBqeW8PnH63A8wOdfX4L0yUvm+ddQq4a78QokpVdw" + _ + "N2rIY+nz70tYxZN431x3/g7v40msYmlQz7//BcxY2A4=" + + STATIC overlayImage AS LONG + + ' Only do this once + IF overlayImage = 0 THEN + overlayImage = _LOADIMAGE(Base64_LoadResourceString(DATA_GIFOVERLAYIMAGE_BMP_16506, SIZE_GIFOVERLAYIMAGE_BMP_16506, COMP_GIFOVERLAYIMAGE_BMP_16506), 32, "memory") + END IF + + __GIF_LoadOverlayImage = overlayImage END FUNCTION '$INCLUDE:'HashTable.bas' diff --git a/InForm/extensions/GIFPlay.bi b/InForm/extensions/GIFPlay.bi index 64ec128..0ea2b4e 100644 --- a/InForm/extensions/GIFPlay.bi +++ b/InForm/extensions/GIFPlay.bi @@ -6,41 +6,55 @@ $IF GIFPLAY_BI = UNDEFINED THEN $LET GIFPLAY_BI = TRUE - $IF INFORM_BI = UNDEFINED THEN - DEFLNG A-Z - OPTION _EXPLICIT + ' TODO: remove this once done + '$IF INFORM_BI = UNDEFINED THEN + ' DEFLNG A-Z + ' OPTION _EXPLICIT - CONST FALSE = 0, TRUE = NOT FALSE - $END IF + ' CONST FALSE = 0, TRUE = NOT FALSE + '$END IF '$INCLUDE:'HashTable.bi' '$INCLUDE:'StringFile.bi' + ' This is the master GIF type that holds info about a single GIF file TYPE __GIFPlayType - id AS LONG ' handle supplied by the user (do we need this?) W AS _UNSIGNED INTEGER ' GIF global width (this needs to be 16-bit) H AS _UNSIGNED INTEGER ' GIF global height (this needs to be 16-bit) bgColor AS _UNSIGNED _BYTE ' background color + colors AS _UNSIGNED INTEGER ' total colors in the global palette pal AS STRING * 768 ' global palette - 256 colors * 3 components - frame AS LONG ' index of the first frame in the frame data array - frames AS LONG ' total frames in the animation - hideOverlay AS _BYTE ' should the "GIF" overlay be hidden when it is not playing + firstFrame AS LONG ' index of the first frame in the frame data array + currentFrame AS LONG ' index of the current frame being played + totalFrames AS LONG ' total number of frames counted while loading + currentFrameNumber AS LONG ' this is simply the number of current frame since playback (re)started + isPlaying AS _BYTE ' set to true if the GIF is currently playing + direction AS _BYTE ' playback direction (-1 or +1) + overlayEnabled AS _BYTE ' should the "GIF" overlay be shown / hidden when it is not playing END TYPE + ' This is the a GIF frame type that holds info about an individual GIF frame TYPE __GIFPlayFrameType - id AS LONG ' which GIF handle does this belong to? + id AS LONG ' index to __GIFPlay that this frame belongs to (do we really need this?) image AS LONG ' QB64 image handle L AS _UNSIGNED INTEGER ' frame left (this needs to be 16-bit) (do we need these?) T AS _UNSIGNED INTEGER ' frame top (this needs to be 16-bit) W AS _UNSIGNED INTEGER ' frame width (this needs to be 16-bit) H AS _UNSIGNED INTEGER ' frame height (this needs to be 16-bit) - pre AS LONG ' previous frame (this will link back to the last frame if this is the first one) - nxt AS LONG ' next frame (this will link back to the first frame if this is the last one) - delayMs AS SINGLE ' frame delay time - direction AS _BYTE ' playback direction + prevFrame AS LONG ' previous frame (this will link back to the last frame if this is the first one) + nextFrame AS LONG ' next frame (this will link back to the first frame if this is the last one) + timeMs AS SINGLE ' frame time END TYPE - REDIM __GIFPlayHashTable(0 TO 0) AS HashTableType - REDIM __GIFPlay(0 TO 0) AS __GIFPlayType - REDIM __GIFPlayFrame(0 TO 0) AS __GIFPlayFrameType + ' This is used by temporary variables during the decoding step to store the raw data for a single frame + TYPE __GIFBitmapType + W AS LONG + H AS LONG + pixels AS STRING + END TYPE + + REDIM __GIFPlayHashTable(0 TO 0) AS HashTableType ' shared hash table to keep user supplied IDs (the values here points to indexes in __GIFPlay) + REDIM __GIFPlay(0 TO 0) AS __GIFPlayType ' main GIFPlay array - each array element is for a single GIF + REDIM __GIFPlayFrame(0 TO 0) AS __GIFPlayFrameType ' shared GIF frame array - this holds GIF frame and frame information for all loaded GIFs + $END IF diff --git a/InForm/extensions/HashTable.bas b/InForm/extensions/HashTable.bas index e17572e..b33c17e 100644 --- a/InForm/extensions/HashTable.bas +++ b/InForm/extensions/HashTable.bas @@ -90,25 +90,33 @@ $IF HASHTABLE_BAS = UNDEFINED THEN 'PRINT "Value for key 7:"; HashTable_LookupLong(MyHashTable(), 7) 'PRINT "Value for key 21:"; HashTable_LookupLong(MyHashTable(), 21) + 'PRINT HashTable_IsKeyPresent(MyHashTable(), 100) + 'END '------------------------------------------------------------------------------------------------------------------- ' Simple hash function: k is the 32-bit key and l is the upper bound of the array FUNCTION __HashTable_GetHash~& (k AS _UNSIGNED LONG, l AS _UNSIGNED LONG) - __HashTable_GetHash = k MOD (l + 1) ' + 1 is needed for 0 based arrays + $CHECKING:OFF + ' Actually this should be k MOD (l + 1) + ' However, we can get away using AND because our arrays size always doubles in multiples of 2 + ' So, if l = 255, then (k MOD (l + 1)) = (k AND l) + ' Another nice thing here is that we do not need to do the addition :) + __HashTable_GetHash = k AND l + $CHECKING:ON END FUNCTION ' Subroutine to resize and rehash the elements in a hash table SUB __HashTable_ResizeAndRehash (hashTable() AS HashTableType) - DIM UB AS _UNSIGNED LONG: UB = UBOUND(hashTable) + DIM uB AS _UNSIGNED LONG: uB = UBOUND(hashTable) ' Resize the array to double its size while preserving contents - DIM newUB AS _UNSIGNED LONG: newUB = _SHL(UB + 1, 1) - 1 + DIM newUB AS _UNSIGNED LONG: newUB = _SHL(uB + 1, 1) - 1 REDIM _PRESERVE hashTable(0 TO newUB) AS HashTableType ' Rehash and swap all the elements - DIM i AS _UNSIGNED LONG: FOR i = 0 TO UB + DIM i AS _UNSIGNED LONG: FOR i = 0 TO uB IF hashTable(i).U THEN SWAP hashTable(i), hashTable(__HashTable_GetHash(hashTable(i).K, newUB)) NEXT i END SUB @@ -117,8 +125,8 @@ $IF HASHTABLE_BAS = UNDEFINED THEN ' This returns an array index in hashTable where k can be inserted ' If there is a collision it will grow the array, re-hash and copy all elements FUNCTION __HashTable_GetInsertIndex& (hashTable() AS HashTableType, k AS _UNSIGNED LONG) - DIM ub AS _UNSIGNED LONG: ub = UBOUND(hashTable) - DIM idx AS _UNSIGNED LONG: idx = __HashTable_GetHash(k, ub) + DIM uB AS _UNSIGNED LONG: uB = UBOUND(hashTable) + DIM idx AS _UNSIGNED LONG: idx = __HashTable_GetHash(k, uB) IF hashTable(idx).U THEN ' Used slot @@ -139,8 +147,8 @@ $IF HASHTABLE_BAS = UNDEFINED THEN ' This function returns the index from hashTable for the key k if k is in use FUNCTION __HashTable_GetLookupIndex& (hashTable() AS HashTableType, k AS _UNSIGNED LONG) - DIM ub AS _UNSIGNED LONG: ub = UBOUND(hashTable) - DIM idx AS _UNSIGNED LONG: idx = __HashTable_GetHash(k, ub) + DIM uB AS _UNSIGNED LONG: uB = UBOUND(hashTable) + DIM idx AS _UNSIGNED LONG: idx = __HashTable_GetHash(k, uB) IF hashTable(idx).U THEN ' Used slot @@ -158,6 +166,12 @@ $IF HASHTABLE_BAS = UNDEFINED THEN END FUNCTION + ' Return TRUE if k is available in the hash table + FUNCTION HashTable_IsKeyPresent%% (hashTable() AS HashTableType, k AS _UNSIGNED LONG) + HashTable_IsKeyPresent = (__HashTable_GetLookupIndex(hashTable(), k) >= 0) + END FUNCTION + + ' Remove an element from the hash table SUB HashTable_Remove (hashTable() AS HashTableType, k AS _UNSIGNED LONG) DIM idx AS LONG: idx = __HashTable_GetLookupIndex(hashTable(), k) diff --git a/InForm/extensions/HashTable.bi b/InForm/extensions/HashTable.bi index 3cf1f46..52bedf9 100644 --- a/InForm/extensions/HashTable.bi +++ b/InForm/extensions/HashTable.bi @@ -6,23 +6,16 @@ $IF HASHTABLE_BI = UNDEFINED THEN $LET HASHTABLE_BI = TRUE - $IF INFORM_BI = UNDEFINED THEN - DEFLNG A-Z - OPTION _EXPLICIT - - CONST FALSE = 0, TRUE = NOT FALSE - $END IF - CONST __HASHTABLE_KEY_EXISTS = -1 CONST __HASHTABLE_KEY_UNAVAILABLE = -2 ' Hash table entry type + ' To extended supported data types, add other value types after V and then write + ' wrappers around __HashTable_GetInsertIndex() & __HashTable_GetLookupIndex() TYPE HashTableType U AS _BYTE ' used? K AS _UNSIGNED LONG ' key V AS LONG ' value - ' <- add other value types here and then write wrappers - ' around __HashTable_GetInsertIndex() & __HashTable_GetLookupIndex() END TYPE $END IF diff --git a/InForm/extensions/Ini.bi b/InForm/extensions/Ini.bi index 64fe2c4..cc74f1f 100644 --- a/InForm/extensions/Ini.bi +++ b/InForm/extensions/Ini.bi @@ -7,13 +7,6 @@ $IF INI_BI = UNDEFINED THEN $LET INI_BI = TRUE - $IF INFORM_BI = UNDEFINED THEN - DEFLNG A-Z - OPTION _EXPLICIT - - CONST FALSE = 0, TRUE = NOT FALSE - $END IF - ' TODO: ' We should put all of this stuff into a single state type and then have just a single global to avoid possible name collisions. ' INI routines without namespace like prefix should also be prefixed with the "Ini_" prefix diff --git a/InForm/extensions/MessageBox.bi b/InForm/extensions/MessageBox.bi index 54d0c63..b75325f 100644 --- a/InForm/extensions/MessageBox.bi +++ b/InForm/extensions/MessageBox.bi @@ -6,13 +6,6 @@ $IF MESSAGEBOX_BI = UNDEFINED THEN $LET MESSAGEBOX_BI = TRUE - $IF INFORM_BI = UNDEFINED THEN - DEFLNG A-Z - OPTION _EXPLICIT - - CONST FALSE = 0, TRUE = NOT FALSE - $END IF - 'Messagebox constants CONST MsgBox_OkOnly = 1 CONST MsgBox_OkCancel = 2 diff --git a/InForm/extensions/StringFile.bi b/InForm/extensions/StringFile.bi index 0c09342..084566b 100644 --- a/InForm/extensions/StringFile.bi +++ b/InForm/extensions/StringFile.bi @@ -6,13 +6,6 @@ $IF STRINGFILE_BI = UNDEFINED THEN $LET STRINGFILE_BI = TRUE - $IF INFORM_BI = UNDEFINED THEN - DEFLNG A-Z - OPTION _EXPLICIT - - CONST FALSE = 0, TRUE = NOT FALSE - $END IF - ' Simplified QB64-only memory-file TYPE StringFileType buffer AS STRING diff --git a/examples/GIFPlaySample/GIFPlaySample.bas b/examples/GIFPlaySample/GIFPlaySample.bas index 8aaf8ae..cc19f77 100644 --- a/examples/GIFPlaySample/GIFPlaySample.bas +++ b/examples/GIFPlaySample/GIFPlaySample.bas @@ -14,8 +14,8 @@ DIM SHARED LoadBT AS LONG DIM SHARED PlayBT AS LONG ': External modules: --------------------------------------------------------------- -'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/extensions/GIFPlay.bi' +'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/extensions/MessageBox.bi' '$INCLUDE:'GIFPlaySample.frm' @@ -28,7 +28,7 @@ SUB __UI_OnLoad END SUB SUB __UI_BeforeUpdateDisplay - GIF_Update PictureBox1 + GIF_Draw PictureBox1, True END SUB SUB __UI_BeforeUnload @@ -42,7 +42,7 @@ SUB __UI_Click (id AS LONG) DIM fileName AS STRING: fileName = _OPENFILEDIALOG$(Caption(gifplaySample), , "*.gif|*.GIF|*.Gif", "GIF Files") IF LEN(fileName) > 0 THEN - IF GIF_Open(PictureBox1, fileName) THEN + IF GIF_LoadFromFile(PictureBox1, fileName) THEN Control(PlayBT).Disabled = False @@ -67,7 +67,7 @@ SUB __UI_Click (id AS LONG) END IF CASE PictureBox1 - GIF_HideOverlay PictureBox1 + GIF_EnableOverlay PictureBox1, False END SELECT END SUB