diff --git a/bananatime.gif b/bananatime.gif new file mode 100644 index 0000000..0b4ebcb Binary files /dev/null and b/bananatime.gif differ diff --git a/mDefs.twin b/mDefs.twin new file mode 100644 index 0000000..382d1b9 --- /dev/null +++ b/mDefs.twin @@ -0,0 +1,197 @@ +'Extracted from WinDevLib - Windows Development Library for twinBASIC +'It's recommended you use that package in normal projects as it will +'avoid copying all these definitions, but I wanted to conserve file +'size in this case. + +[InterfaceId("0c733a30-2a1c-11ce-ade5-00aa0044773d")] +[OleAutomation(False)] +Interface ISequentialStream Extends stdole.IUnknown + Function Read(pv As Any, ByVal cb As Long) As Long + Function Write(pv As Any, ByVal cb As Long) As Long +End Interface +[InterfaceId("0000000c-0000-0000-C000-000000000046")] +[OleAutomation(False)] +Interface IStream Extends ISequentialStream + Function Seek(ByVal dlibMove As LongLong, ByVal dwOrigin As STREAM_SEEK) As LongLong + Sub SetSize(ByVal libNewSize As LongLong) + Sub CopyTo(ByVal pStm As IStream, ByVal cb As LongLong, pcbRead As LongLong, pcbWritten As LongLong) + Sub Commit(ByVal grfCommitFlags As STGC) + Sub Revert() + Sub LockRegion(ByVal libOffset As LongLong, ByVal cb As LongLong, ByVal dwLockType As LOCKTYPE) + Sub UnlockRegion(ByVal libOffset As LongLong, ByVal cb As LongLong, ByVal dwLockType As LOCKTYPE) + Sub Stat(pstatstg As STATSTG, ByVal grfStatFlag As STATFLAG) + Function Clone() As IStream +End Interface + +[InterfaceId("3127CA40-446E-11CE-8135-00AA004BB851")] +[OleAutomation(False)] +Interface IErrorLog Extends stdole.IUnknown + Sub AddError(ByVal pszPropName As String, pExcepInfo As Any) +End Interface + +[InterfaceId("55272A00-42CB-11CE-8135-00AA004BB851")] +[OleAutomation(False)] +Interface IPropertyBag Extends stdole.IUnknown + Sub Read(ByVal pszPropName As LongPtr, pVar As Variant, ByVal pErrorLog As IErrorLog) + Sub Write(ByVal pszPropName As LongPtr, pVar As Variant) +End Interface + +[InterfaceId("9be8ed5c-edab-4d75-90f3-bd5bdbb21c82")] +[OleAutomation(False)] +Interface IShellImageDataFactory Extends stdole.IUnknown + Sub CreateIShellImageData(ppshimg As IShellImageData) + Sub CreateImageFromFile(ByVal pszPath As LongPtr, ppshimg As IShellImageData) + Sub CreateImageFromStream(ByVal pStream As IStream, ppshimg As IShellImageData) + Sub GetDataFormatFromPath(ByVal pszPath As LongPtr, pDataFormat As UUID) +End Interface +[InterfaceId("bfdeec12-8040-4403-a5ea-9e07dafcf530")] +[OleAutomation(False)] +Interface IShellImageData Extends stdole.IUnknown + [PreserveSig] Function Decode(ByVal dwFlags As SHIMGDEC, ByVal cxDesired As Long, ByVal cyDesired As Long) As Long + [PreserveSig] Function Draw(ByVal hDC As LongPtr, prcDest As RECT, prcSource As RECT) As Long + [PreserveSig] Function NextFrame() As Long + [PreserveSig] Function NextPage() As Long + [PreserveSig] Function PrevPage() As Long + [PreserveSig] Function IsTransparent() As Long + [PreserveSig] Function IsAnimated() As Long + [PreserveSig] Function IsVector() As Long + [PreserveSig] Function IsMultipage() As Long + [PreserveSig] Function IsEditable() As Long + [PreserveSig] Function IsPrintable() As Long + [PreserveSig] Function IsDecoded() As Long + [PreserveSig] Function GetCurrentPage(pnPage As Long) As Long + [PreserveSig] Function GetPageCount(pcPages As Long) As Long + [PreserveSig] Function SelectPage(ByVal iPage As Long) As Long + [PreserveSig] Function GetSize(pSize As SIZE) As Long + [PreserveSig] Function GetRawDataFormat(pDataFormat As UUID) As Long + [PreserveSig] Function GetPixelFormat(pFormat As Long) As Long + [PreserveSig] Function GetDelay(pdwDelay As Long) As Long + [PreserveSig] Function GetProperties(ByVal dwMode As Long, ppPropSet As IUnknown) As Long + [PreserveSig] Function Rotate(ByVal dwAngle As Long) As Long + [PreserveSig] Function Scale(ByVal cx As Long, ByVal cy As Long, ByVal hints As InterpolationMode) As Long + [PreserveSig] Function DiscardEdit() As Long + [PreserveSig] Function SetEncoderParams(ByVal pbagEnc As IPropertyBag) As Long + [PreserveSig] Function DisplayName(ByVal wszName As String, ByVal cch As Long) As Long + [PreserveSig] Function GetResolution(puResolutionX As Long, puResolutionY As Long) As Long + [PreserveSig] Function GetEncoderParams(pguidFmt As UUID, ppEncParams As LongPtr) As Long + [PreserveSig] Function RegisterAbort(ByVal pAbort As IShellImageDataAbort, ppAbortPrev As IShellImageDataAbort) As Long + [PreserveSig] Function CloneFrame(ppImg As LongPtr) As Long + [PreserveSig] Function ReplaceFrame(ByVal pImg As LongPtr) As Long +End Interface +[InterfaceId("53fb8e58-50c0-4003-b4aa-0c8df28e7f3a")] +[OleAutomation(False)] +Interface IShellImageDataAbort Extends stdole.IUnknown + Sub QueryAbort() +End Interface + +[Description("CLSID_ShellImageDataFactory")] +[CoClassId("66e4e4fb-f385-4dd0-8d74-a2efd1bc6178")] +CoClass ShellImageDataFactory + [Default] Interface IShellImageDataFactory +End CoClass +Module mDefs + Public Const S_OK = 0 + Public Type UUID + Data1 As Long + Data2 As Integer + Data3 As Integer + Data4(0 To 7) As Byte + End Type + Public Type RECT + Left As Long + Top As Long + Right As Long + Bottom As Long + End Type + Public Type SIZE + cx As Long + cy As Long + End Type + Public Enum SHIMGDEC + SHIMGDEC_DEFAULT = &H00000000 ' creates a full Image + SHIMGDEC_THUMBNAIL = &H00000001 ' decodes only thumbnail image + SHIMGDEC_LOADFULL = &H00000002 ' load the whole file into memory + End Enum + Public Enum QualityMode + QualityModeInvalid = -1 + QualityModeDefault = 0 + QualityModeLow = 1 ' Best performance + QualityModeHigh = 2 ' Best rendering quality + End Enum + Public Enum InterpolationMode + InterpolationModeInvalid = QualityModeInvalid + InterpolationModeDefault = QualityModeDefault + InterpolationModeLowQuality = QualityModeLow + InterpolationModeHighQuality = QualityModeHigh + InterpolationModeBilinear = 0 + InterpolationModeBicubic = 1 + InterpolationModeNearestNeighbor = 2 + InterpolationModeHighQualityBilinear = 3 + InterpolationModeHighQualityBicubic = 4 + End Enum + Public Enum STREAM_SEEK + STREAM_SEEK_SET = 0 + STREAM_SEEK_CUR = 1 + STREAM_SEEK_END = 2 + End Enum + Public Enum LOCKTYPE + LOCK_WRITE = 1 + LOCK_EXCLUSIVE = 2 + LOCK_ONLYONCE = 4 + End Enum + Public Enum STGTY + STGTY_STORAGE = 1 + STGTY_STREAM = 2 + STGTY_LOCKBYTES = 3 + STGTY_PROPERTY = 4 + End Enum + Public Enum STGC + STGC_DEFAULT = 0 + STGC_OVERWRITE = 1 + STGC_ONLYIFCURRENT = 2 + STGC_DANGEROUSLYCOMMITMERELYTODISKCACHE = 4 + STGC_CONSOLIDATE = 8 + End Enum + Public Enum STATFLAG + STATFLAG_DEFAULT = 0 + STATFLAG_NONAME = 1 + STATFLAG_NOOPEN = 2 + End Enum + Public Type STATSTG + pwcsName As LongPtr + type As STGTY + cbSize As LongLong + mtime As LongLong + ctime As LongLong + atime As LongLong + grfMode As STGM + grfLocksSupported As LOCKTYPE + clsid As UUID + grfStateBits As Long + reserved As Long + End Type + Public Enum STGM + STGM_DIRECT = &H00000000 + STGM_TRANSACTED = &H00010000 + STGM_SIMPLE = &H08000000 + STGM_READ = &H00000000 + STGM_WRITE = &H00000001 + STGM_READWRITE = &H00000002 + STGM_SHARE_DENY_NONE = &H00000040 + STGM_SHARE_DENY_READ = &H00000030 + STGM_SHARE_DENY_WRITE = &H00000020 + STGM_SHARE_EXCLUSIVE = &H00000010 + STGM_PRIORITY = &H00040000 + STGM_DELETEONRELEASE = &H04000000 + STGM_NOSCRATCH = &H00100000 + STGM_CREATE = &H00001000 + STGM_CONVERT = &H00020000 + STGM_FAILIFTHERE = &H00000000 + STGM_NOSNAPSHOT = &H00200000 + STGM_DIRECT_SWMR = &H00400000 + End Enum + [Description("Indicates whether an HRESULT value represents a successful operation (>= 0)")] + Public Function SUCCEEDED(hr As Long) As Boolean + Return hr >= 0 + End Function +End Module \ No newline at end of file diff --git a/ucAniGif.tbcontrol b/ucAniGif.tbcontrol new file mode 100644 index 0000000..9740424 --- /dev/null +++ b/ucAniGif.tbcontrol @@ -0,0 +1,127 @@ +[ + { + "AccessKeys": null, + "Alignable": false, + "Appearance": "vbAppear3d", + "AutoRedraw": false, + "BackColor": 16777215, + "BackStyle": "vbBFOpaque", + "BorderStyle": "vbNoBorder", + "CanGetFocus": true, + "ClipBehavior": "vbClipUseRegion", + "ClipControls": true, + "ControlContainer": false, + "DataBindingBehavior": "vbDataBindingNone", + "DataSourceBehavior": "vbDataSourceNone", + "DefaultCancel": false, + "DrawMode": "vbCopyPen", + "DrawStyle": "vbSolid", + "DrawWidth": 1, + "EditAtDesignTime": false, + "Enabled": true, + "FillColor": 0, + "FillStyle": "vbFSTransparent", + "FontBold": false, + "FontItalic": false, + "FontName": "Segoe UI", + "FontSize": 8, + "FontStrikethru": false, + "FontTransparent": true, + "FontUnderline": false, + "ForceResizeToContainer": false, + "ForeColor": -2147483630, + "FormDesignerId": "{FDA9D3C8-4FA5-4989-BC1E-5D62EDE140E2}", + "ForwardFocus": false, + "HasDC": true, + "Height": 90, + "HitBehavior": "vbHitTestUseRegion", + "Index": -1, + "InvisibleAtRuntime": false, + "KeyPreview": false, + "Left": 0, + "MaskColor": -2147483633, + "MaskPicture": "", + "MouseIcon": "", + "MousePointer": "vbDefault", + "Name": "ucAniGif", + "OLEDropMode": "vbOLEDropNone", + "Palette": "", + "PaletteMode": "vbPaletteModeContainer", + "Picture": "", + "PictureDpiScaling": true, + "Public": true, + "RightToLeft": false, + "ScaleHeight": 135, + "ScaleLeft": 0, + "ScaleMode": "vbPixels", + "ScaleTop": 0, + "ScaleWidth": 169.5, + "Tag": null, + "ToolboxBitmap": "R0lGODlhIAAgAHcAACH5BAEAANkALAAAAAAgACAAh15hy2JlyGVqxmZqyWlvw2hqyW92wFKDLlOEL1SEMF2KNF2LN1yMOF2NOV6NOl+OO2CPPGaVQ2eWRGiWRmmXR2uWRWqYSGuYSWyZSnGeTnKfT3SeUHOgUXSgUnWhU3aiVHeiVXijV3mkWHyoWn2pW36pXH+qXXqzTXu0T3+4TnyxU36yVH+zVny0UH61UnyBy3uA08pTFcpUFNJAC9JCCtNFCtRGCtVMCdZOCNdQCNdRCNhTB9lVB9lWB9lYB9paBtteBtxfBtNXG9xgBd1kBd1mBd5sBN5vBM1qNc5oNdFvNNtqNuB5A+F+A81tRtB1RN52QZ6FPIOjUYCqX4OqX4quXoCxWYKyW4OzXYG0WIK1WoO2XIGrYIKsYYOsYoStZIWuZYavZoWyYoaxZoexZ4azZIW0YIa1Yoi0Zoi2ZIq3ZoiyaImzaYqzaoq1aIu0bIy2aoy0bYy1bY23bYu4aI64bo+4b4uzcY63dJK1Z5ezYpe1ZJu1Y5m8b5C5cKKJQb2Vf6O+b6PGbqfKbaHCeKvCcazPdK3Je7LIe7LNerTWeeGDAuKKAdSiXpebvKWlpbSvrLK6obG2u4GFz4KJz4SJyYOI0YSI1YmL2Y2P346U1I+S35CS15ab3Zad2aCm3rCyxbi5z6y04q235K/OoKLLs6PMs5rT9azE6qXZ967R8a7c8LHG67LV6rPW6bbV87Hf+bzl+8/WjM7ZitPbjtPbj9DcjNDejdLfj9Xej9PekNbfkNbYvNfgktnhktvjldvklt7ll/PNi+DnmeXrnujtoOruouvvo+/zqPDzp/X3rPf5rvr7sPz8s/z9s/7+tf//tcPm88jr/c7u/t3z59ry7NTw9eP13ur41f//8P///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAj/ALMJHEiwoMGDCBMqXMiwocOHECMmfESxosWLGDMSfKSto8ePIEOCfLRR26mTKFOqXIlSG8mBHFPJhARIksybOHPidFkSlislQIb4SNJq1SpYSJGqQoVKVVKkPGFqi/VkCJMmRXY4MVUqlldWo0SJFTWK1SuvUQVylJaDyCJGRnjEwHMnmjRpmzp9GivKE6W7abNxxHbjh5EjQXL8eROGFLVqmTBdsqQJxgABBKZNC8zxmBAcPHrokCFGDhgqyJhFvjTpBYAAmDVz1rar0YwaNmhEKSPni4hAu1a3fo35mrXZzKAJg7IEiRU0cryE2NBLuGvYBJo9mz2se3dBV9zE4ekCAgOiUJxYXxdgQJax2bt2dcelAgucN1w+XKgALBkvUJUU4Egk8e0yGzQIQmPICmbM0cYUHlgAgR67+HJMgsv8Et9sxGhoywksnFEHGyZ0QMEDC8wSXzEJMuOLgS+pRVt8g6CQRRp2rFECBxM4kAAfBSYIzTAwlkRMMLuk0IIWavhBBgkaSNAAAgrQkguLCLpYpFQJKuLCFnT4McYIGUTAwAFS1GJMgspouKWM8f0yzC2JHEJIH3lUsUchuiTjDILKEFPgm4KJZOihHcUoWEaMNlqRRJBGKumklFZq6aQBAQA7", + "Top": 0, + "Width": 113, + "Windowless": false, + "__IDEOptions": { + "alignToGrid": false, + "gridHeight": 10, + "gridWidth": 10, + "lockedControls": [], + "multiColoredGrabbers": false, + "showGrid": true, + "showOutlines": false + }, + "__lastUpdateMarker": 215028140, + "_children": [ + { + "BorderColor": -2147483640, + "BorderStyle": "vbBSSolid", + "BorderWidth": 1, + "DrawMode": "vbCopyPen", + "Index": -1, + "Name": "Line1", + "Tag": null, + "Visible": true, + "X1": 3, + "X2": 113.239562988281, + "Y1": 0, + "Y2": 88, + "_className": "Line", + "_clsid": "{33AD4F88-6699-11CF-B70C-00AA0060D393}", + "_paintedByParent": true + }, + { + "BorderColor": -2147483640, + "BorderStyle": "vbBSSolid", + "BorderWidth": 1, + "DrawMode": "vbCopyPen", + "Index": -1, + "Name": "Line2", + "Tag": null, + "Visible": true, + "X1": 0, + "X2": 106.239562988281, + "Y1": 88, + "Y2": -3, + "_className": "Line", + "_clsid": "{33AD4F88-6699-11CF-B70C-00AA0060D393}", + "_paintedByParent": true + }, + { + "Enabled": true, + "Height": 27, + "Index": -1, + "Interval": 0, + "Left": 6, + "Name": "Timer1", + "Tag": null, + "Top": 29, + "Width": 27, + "_className": "Timer", + "_clsid": "{33AD4F28-6699-11CF-B70C-00AA0060D393}", + "_isInvisible": true + } + ], + "_className": "UserControl", + "_clsid": "{33AD5010-6699-11CF-B70C-00AA0060D393}" + } +] \ No newline at end of file diff --git a/ucAniGif.twin b/ucAniGif.twin new file mode 100644 index 0000000..f464340 --- /dev/null +++ b/ucAniGif.twin @@ -0,0 +1,212 @@ +[FormDesignerId("FDA9D3C8-4FA5-4989-BC1E-5D62EDE140E2")] +[ClassId("15524887-6F82-4DD0-934E-4FB2D46A7FDC")] +[InterfaceId("B2621ACA-C44B-4FA1-829C-AF27E78211AA")] +[EventInterfaceId("A4CDB57A-8E60-456B-BD52-D05CCBD1D9E2")] +[COMControl] +[Description("${ProjectName}.${ComponentName}")] +Class ucAniGif + +Option Explicit + +Private pFactory As IShellImageDataFactory +Private pImage As IShellImageData + +Private mInit As Boolean + +Private mLoop As Boolean 'Unimplemented +Private Const mDefLoop As Boolean = True + +Private mFile As String + +Private mBk As Long +Private Const mDefBk As Long = &HFFFFFF + +Private mAuto As Boolean +Private Const mDefAuto As Boolean = False + +Private mSize As Boolean +Private Const mDefSize As Boolean = False + +Private mPlaying As Boolean +Private mLoaded As Boolean + + +Private mAnim As Boolean 'IsAnimated; if not, don't try playing it. +Private mDelay As Long 'Frame delay + +Private mCXY As SIZE + +Private Sub UserControl_Initialize() Handles UserControl.Initialize + Set pFactory = New ShellImageDataFactory +End Sub + +Private Sub UserControl_ReadProperties(PropBag As PropertyBag) Handles UserControl.ReadProperties + mFile = PropBag.ReadProperty("File", "") + 'mLoop = PropBag.ReadProperty("Loop", mDefLoop) + mAuto = PropBag.ReadProperty("Autoplay", mDefAuto) + mSize = PropBag.ReadProperty("SizeToFit", mDefSize) + If mInit = False Then + Init + End If +End Sub + +Private Sub UserControl_WriteProperties(PropBag As PropertyBag) Handles UserControl.WriteProperties + PropBag.WriteProperty "File", mFile, "" + 'PropBag.WriteProperty "Loop", mLoop, mDefLoop + PropBag.WriteProperty "Autoplay", mAuto, mDefAuto + PropBag.WriteProperty "SizeToFit", mSize, mDefSize +End Sub + +Private Sub UserControl_InitProperties() Handles UserControl.InitProperties + mLoop = mDefLoop + mAuto = mDefAuto + mSize = mDefSize +End Sub + +Private Sub UserControl_Show() Handles UserControl.Show + If mInit = False Then Init +End Sub + +Private Sub Init() + mInit = True + If mFile <> "" Then + If LoadImageFromFile(mFile) Then + Line1.Visible = False + Line2.Visible = False + sidRedraw + If Ambient.UserMode Then + If mAuto Then Play + Exit Sub + End If + End If + End If + Line1.X1 = 0 + Line1.X2 = UserControl.Width + Line1.Y1 = 0 + Line1.Y2 = UserControl.Height + Line2.X1 = 0 + Line2.X2 = UserControl.Width + Line2.Y1 = UserControl.Height + Line2.Y2 = 0 +End Sub + +Private Sub UserControl_Resize() Handles UserControl.Resize + If mLoaded Then + sidRedraw + Else + Line1.X1 = 0 + Line1.Y1 = 0 + Line1.X2 = UserControl.ScaleWidth + Line1.Y2 = UserControl.ScaleHeight + + Line2.X1 = 0 + Line2.Y1 = UserControl.ScaleHeight + Line2.X2 = UserControl.ScaleWidth + Line2.Y2 = 0 + End If +End Sub + +Public Property Get BackColor() As OLE_COLOR: BackColor = mBk: End Property +Public Property Let BackColor(ByVal clr As OLE_COLOR) + mBk = clr + UserControl.BackColor = mBk + If mLoaded Then + sidRedraw + End If +End Property + +Public Property Get Autoplay() As Boolean: Autoplay = mAuto: End Property +Public Property Let Autoplay(ByVal bValue As Boolean): mAuto = bValue: End Property + +Public Property Get SizeToFit() As Boolean: SizeToFit = mSize: End Property +Public Property Let SizeToFit(ByVal bValue As Boolean) + If bValue <> mSize Then + mSize = bValue + If mLoaded Then sidRedraw + End If +End Property +Public Property Get File() As String: File = mFile: End Property +Public Property Let File(ByVal sPath As String) + mFile = sPath + If LoadImageFromFile(mFile) Then + Line1.Visible = False + Line2.Visible = False + sidRedraw + End If +End Property + +Public Sub Play() + If mLoaded = False Then + If LoadImageFromFile(mFile) Then + Line1.Visible = False + Line2.Visible = False + Timer1.Interval = mDelay + Timer1.Enabled = True + End If + Else + Timer1.Interval = mDelay + Timer1.Enabled = True + End If +End Sub +Public Sub Pause() + Timer1.Enabled = False +End Sub +Public Sub Stop() + Timer1.Enabled = False + UserControl.Clear + UserControl.Cls + UserControl.Refresh +End Sub + +Private Function LoadImageFromFile(sPath As String) As Boolean + On Error GoTo e0 + Debug.Print "LoadImageFromFile->Entry, mFile=" & mFile & ", sPath=" & sPath + Dim hr As Long + mLoaded = False + pFactory.CreateImageFromFile StrPtr(sPath), pImage + If (pImage Is Nothing) = False Then + hr = pImage.Decode(SHIMGDEC_DEFAULT, UserControl.ScaleWidth, UserControl.ScaleHeight) + If SUCCEEDED(hr) Then + Debug.Print "Loaded and decoded image..." + If pImage.IsAnimated() = S_OK Then + Debug.Print "Recognized animated gif..." + mAnim = True + pImage.GetDelay mDelay + End If + pImage.GetSize mCXY + Debug.Print "LoadImageFromFile cx=" & mCXY.cx & ",cy=" & mCXY.cy + mLoaded = True + LoadImageFromFile = True + Else + Debug.Print "Failed to decode file, hr=" & hr ' & ": " & GetSystemErrorString(hr) + End If + Else + Debug.Print "Failed to open file." + End If + + Exit Function + e0: + Debug.Print "Error loading file, " & Err.Number & ": " & Err.Description +End Function + +Private Sub Timer1_Timer() Handles Timer1.Timer + pImage.NextFrame + sidRedraw +End Sub +Private Sub sidRedraw() + UserControl.Cls + Dim rcS As RECT, rcD As RECT + rcS.Right = mCXY.cx + rcS.Bottom = mCXY.cy + If mSize Then + rcD.Right = UserControl.ScaleWidth + rcD.Bottom = UserControl.ScaleHeight + Else + rcD = rcS + End If + pImage.Draw UserControl.hDC, rcD, rcS +End Sub + + + +End Class \ No newline at end of file diff --git a/ucAniGif.twinproj b/ucAniGif.twinproj new file mode 100644 index 0000000..1219e59 Binary files /dev/null and b/ucAniGif.twinproj differ diff --git a/ucAniGifTest.twinproj b/ucAniGifTest.twinproj new file mode 100644 index 0000000..35c5ef6 Binary files /dev/null and b/ucAniGifTest.twinproj differ