TheirCorp's GIF-Decoder/Viewer Optimization Demo
Decode and display GIFs from 28.1 times faster than with OlePro32.DLL. This is the relative time to:
Notes:
(Only the first frame of any animated GIF is shown.)
Optimizations
Notes on (and Apologies for) the Code
Note:
This is code has been modified to support a pre-initialization call to ShowGif,
which makes it an unfair, but useful comparison to Olepro32.dll. This is about
the fastest version so far. The original versions were removed.
For those using compiler versions later than PBWin7, read the posts below by
Dominique Bodin about the (minor) changes you'll need to make.
TheirCorp's SourceForge project includes:
PowerBASIC article in Wikipedia
The attachment (updated 11-10-2008) contains the source code, two test programs and the test image.
Decode and display GIFs from 28.1 times faster than with OlePro32.DLL. This is the relative time to:
- Create a memory DC
- Create a bitmap (and DIBSection if needed)
- Decode the (pre-loaded) GIF file
- BitBlt the decoded image to the window DC
- Clean up: release/delete DCs, delete the bitmap...
Code:
[B][COLOR="Blue"] This GIF decoder displays images an average of 28.1 times faster than OlePro32.DLL[/COLOR][/B]. [B] ------------------------------ Testing TheirCorp's Decoder[/B] 2464660 2353608 2349708 2444884 2412384 2398976 2356004 2347884 2347564 2370328 [B]Avg = 2384600[/B] [B] ------------------------------ Testing OlePro32.Dll[/B] 63757640 62886748 63409388 62755176 63641132 96778800 67562204 63140324 63254816 62977660 [B]Avg = 67016388.8[/B] [B][COLOR="Blue"]Results (Olepro / TheirCorp): 67016388.8 / 2384600 = 28.1038282311499 TheirCorp's decoder is 28 times faster.[/COLOR][/B] The tests were conducted on a Pentium4 processor. The test file was 4451 bytes, containing a 16-color, 380x400 screenshot of some PowerBASIC code in Jelly- fish Pro. The time data collected was for decoding a test file which was already loaded, calling BitBlt to transfer it to the window, everything done in between, plus cleanup code. The comparison isn't perfect, but is close enough for deciding between which code to use.
(Only the first frame of any animated GIF is shown.)
Optimizations
- It sends the output data directly to the DIBSection from which it's
BitBlt-ed to the window. - Rather than maintaining a separate string table, it merely saves the
string lengths and the offsets to where they occur in the output data.
This eliminates a lot of data transfers. - It uses a bit array to keep track of what string lengths already exist
in the string table.
It actually only tracks a limited number of string lengths. Currently it
uses a 256 bit array (32 bytes). It wraps out-of-range length values around,
resulting in: StringLength Mod 256.
So, if a string 20 bytes long is put into the string table, then the decoder
sets bit number 20 of the array for its future reference.
This method obviously won't help for times when the bit for a string length
is already set. Plus, bit 20 for example could be set any one of many
different string lengths --- any length where: StringLength Mod BitArraySize
= 20
What's important, is that it can be certain that some string lengths have
never been encountered. Still, this method eliminates many full searches:
In one test, it eliminated all but 190 (6.67%) of 2848 searches it would
otherwise have had to do.
The speed advantage though, has a complex dependency on the number of
eliminated searches. It depends on such factors as:- The length of the string
- The number of strings of that length already in the table
- The total number strings in the table at the time
- It provides for initialization of data structures (DIBSection, bitmap,
memory DC,...) prior to later calls which can bypass these steps and invoke
the decoder immediately. If the first run seems slow, it's because it
determined that it wasn't initialized and called itself with the "%Init"
option. - No MMX nor SIMD instructions have been used yet.
Notes on (and Apologies for) the Code
- There is BASIC code in comments scattered about that are usually
approximate equivalents to the code following them. - The code is cluttered and inconsistently commented.
- It is optimized for images with widths which are multiples of four.
This is because a bitmap in a DIBSection expects the end of each line to
be DWord-aligned. Using this decoder's design requires that the image data
be rearranged after it's decoded which slows it down slightly.
Furthermore, this code is designed for high-performance applications where
it's expected one would take the time to adjust the images by a few pixels
when helpful.
Note:
This is code has been modified to support a pre-initialization call to ShowGif,
which makes it an unfair, but useful comparison to Olepro32.dll. This is about
the fastest version so far. The original versions were removed.
For those using compiler versions later than PBWin7, read the posts below by
Dominique Bodin about the (minor) changes you'll need to make.
Code:
'************************************** ' "GifTtest.bas" ' TheirCorp's GIF-Decoder/Viewer 'Optimization Demo 'This code is GPL licensed and is free for non- 'commercial use. '------------------------------------------- ' Introduction '------------------------------------------- ' This GIF decoder displays images an average 'of 28.1 times faster than OlePro32.DLL. ' ------------------------------ ' Testing TheirCorp's Decoder ' 2464660 ' 2353608 ' 2349708 ' 2444884 ' 2412384 ' 2398976 ' 2356004 ' 2347884 ' 2347564 ' 2370328 ' N = 10 ' Avg = 2384600 ' ------------------------------ ' Testing OlePro32.Dll ' 63757640 ' 62886748 ' 63409388 ' 62755176 ' 63641132 ' 96778800 ' 67562204 ' 63140324 ' 63254816 ' 62977660 ' N = 10 ' Avg = 67016388.8 ' Results (Olepro / TheirCorp): ' 67016388.8 / 2384600 = 28.1038282311499 ' TheirCorp's decoder is 28 times faster. 'The tests were conducted on a Pentium4 processor. 'The test file was 4451 bytes, containing a 16-color, '380x400 screenshot of some PowerBASIC code in Jelly- 'fish Pro. 'The time data collected was for decoding a test file 'which was already loaded, calling BitBlt to transfer 'it to the window, everything done in between, plus 'cleanup code. 'The comparison isn't perfect, but is close enough for 'deciding between which code to use. '------------------------------------------- ' Partial Description of Operation '------------------------------------------- '* Sends the output data directly to a DIBSection ' from where it's BitBlt-ed to the window. '* Rather than a separate string table, it saves ' offset/length pairs refering to the output data. ' This eliminates a lot of data transfering. '* Uses a bit array to keep track of what string ' lengths have been added to the string table. ' This eliminates many full searches. '------------------------------------------- ' Notes on the Code '------------------------------------------- 'There is BASIC code in comments scattered 'about that are usually approximate equivalents 'to the code immediately following them. 'It is optimized for images with widths which are 'multiples of four. This is because a bitmap in a 'DIBSection expects the end of each line to be DWord- 'aligned. Using this decoder's design requires that 'the image data be rearranged after it's decoded. 'Furthermore, this code is designed for high-perform- 'ance applications where it's expected one would take 'the time to adjust the images by a few pixels. 'The first time seems to be a little slower than 'later runs, so it shouldn't be regarded as typical. '************************************** #Compile Exe "GifTest.exe" %Debug = 0 '%Debug = 1 '%Their = 0 %Their = 1 #If %Debug Global ctr As Dword Global ctr1 As Dword Global ctr2 As Dword Global dbg As Dword Global dbs As String #EndIf #If %Their $Caption = "Testing TheirCorp's Decoder" #Else $Caption = "Testing OlePro32.DLL" #EndIf $InFile = "Test.gif" '$OutFile = "Test.txt" '%LenBitsBits = 128 ' Average = 0.001295 %LenBitsBits = 256 ' Average = 0.001267 (* best) '%LenBitsBits = 512 ' Average = 0.003033 %UbLenBits = (%LenBitsBits \ 8) \ 4 ' = (%LenBitsBits \ 8 bits per Byte) \ 4 bytes per Dword %Op_Show = 1 %Op_Init = 2 %Op_End = 3 %Txt = 1000 %ShowBtn = 1001 Global ghDlg As Long Global Freq As Quad Global MinTime As Quad Global Total As Quad Global Time1 As Quad Global Time2 As Quad Macro RDTSC(qd) ! push eax ! push edx ! db &H0F, &H31 ;Read time-stamp counter into EDX:EAX ! mov qd, eax ! lea eax, qd ! mov [eax + 4], edx ! pop edx ! pop eax End Macro %WINAPI = 1 %WM_USER = &H400 %BI_RGB = 0& %DIB_RGB_COLORS = 0 ' color table in RGBs %WM_PAINT = &HF %WM_NCDESTROY = &H82 %WM_NCACTIVATE = &H86 %WM_INITDIALOG = &H110 %WM_COMMAND = &H111 %WM_TIMER = &H113 %WM_DESTROY = &H2 %WS_POPUP = &H80000000 %WS_CHILD = &H40000000 %WS_VISIBLE = &H10000000 %WS_CLIPSIBLINGS = &H04000000 %WS_CAPTION = &H00C00000 ' WS_BORDER OR WS_DLGFRAME %WS_BORDER = &H00800000 %WS_DLGFRAME = &H00400000 %WS_SYSMENU = &H00080000 %WS_TABSTOP = &H00010000 %WS_EX_LEFT = &H00000000 %WS_EX_LTRREADING = &H00000000 %WS_EX_RIGHTSCROLLBAR = &H00000000 %WS_EX_CONTROLPARENT = &H00010000 %MB_TASKMODAL = &H00002000& %BS_TEXT = &H0& %BS_PUSHBUTTON = &H0& %BS_DEFPUSHBUTTON = &H1& %BS_CENTER = &H300& %BS_VCENTER = &HC00& %BN_CLICKED = 0 %DS_3DLOOK = &H0004& %DS_NOFAILCREATE = &H0010& %DS_SETFONT = &H0040& ' User specified font for Dlg controls %DS_MODALFRAME = &H0080& ' Can be combined with WS_CAPTION %DM_SETDEFID = %WM_USER + 1 %LOGPIXELSX = 88 ' Logical pixels/inch in X %LOGPIXELSY = 90 ' Logical pixels/inch in Y %GENERIC_READ = &H80000000& %FILE_SHARE_READ = &H00000001 %FILE_SHARE_WRITE = &H00000002 %FILE_ATTRIBUTE_NORMAL = &H00000080 %OPEN_EXISTING = 3 %GMEM_MOVEABLE = &H2 ' Binary raster ops %R2_BLACK = 1 ' 0 %R2_NOTMERGEPEN = 2 ' DPon %R2_MASKNOTPEN = 3 ' DPna %R2_NOTCOPYPEN = 4 ' PN %R2_MASKPENNOT = 5 ' PDna %R2_NOT = 6 ' Dn %R2_XORPEN = 7 ' DPx %R2_NOTMASKPEN = 8 ' DPan %R2_MASKPEN = 9 ' DPa %R2_NOTXORPEN = 10 ' DPxn %R2_NOP = 11 ' D %R2_MERGENOTPEN = 12 ' DPno %R2_COPYPEN = 13 ' P %R2_MERGEPENNOT = 14 ' PDno %R2_MERGEPEN = 15 ' DPo %R2_WHITE = 16 ' 1 %R2_LAST = 16 ' Ternary raster operations %SRCCOPY = &H00CC0020 ' dest = source %SRCPAINT = &H00EE0086 ' dest = source OR dest %SRCAND = &H008800C6 ' dest = source AND dest %SRCINVERT = &H00660046 ' dest = source XOR dest %SRCERASE = &H00440328 ' dest = source AND (NOT dest ) %NOTSRCCOPY = &H00330008 ' dest = (NOT source) %NOTSRCERASE = &H001100A6 ' dest = (NOT src) AND (NOT dest) %MERGECOPY = &H00C000CA ' dest = (source AND pattern) %MERGEPAINT = &H00BB0226 ' dest = (NOT source) OR dest %PATCOPY = &H00F00021 ' dest = pattern %PATPAINT = &H00FB0A09 ' dest = DPSnoo %PATINVERT = &H005A0049 ' dest = pattern XOR dest %DSTINVERT = &H00550009 ' dest = (NOT dest) %BLACKNESS = &H00000042 ' dest = BLACK %WHITENESS = &H00FF0062 ' dest = WHITE '----------------------------------------------------------------- ' TYPE and UNION structures: 5 '----------------------------------------------------------------- Type Rect nLeft As Long nTop As Long nRight As Long nBottom As Long End Type Type Bitmap bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Word bmBitsPixel As Word bmBits As Byte Ptr End Type Type BITMAPINFOHEADER biSize As Dword biWidth As Long biHeight As Long biPlanes As Word biBitCount As Word biCompression As Dword biSizeImage As Dword biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Dword biClrImportant As Dword End Type Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors(255) As Dword End Type Type OVERLAPPED Internal As Dword InternalHigh As Dword offset As Dword OffsetHigh As Dword hEvent As Dword End Type Type SECURITY_ATTRIBUTES nLength As Dword lpSecurityDescriptor As Long bInheritHandle As Long End Type '----------------------------------------------------------------- ' Declared Functions: 10 '----------------------------------------------------------------- Declare Function BitBlt Lib "GDI32.DLL" Alias "BitBlt" (ByVal hDestDC As Dword, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Dword, ByVal xSrc As Long, ByVal ySrc As Long, _ ByVal dwRop As Dword) As Long Declare Function CloseHandle Lib "KERNEL32.DLL" Alias "CloseHandle" (ByVal hObject As Dword) As Long Declare Function CreateCompatibleBitmap Lib "GDI32.DLL" Alias "CreateCompatibleBitmap" (ByVal hdc As Dword, ByVal nWidth As Long, ByVal nHeight As Long) As Dword Declare Function CreateCompatibleDC Lib "GDI32.DLL" Alias "CreateCompatibleDC" (ByVal hdc As Dword) As Dword Declare Function CreateDIBSection Lib "GDI32.DLL" Alias "CreateDIBSection" (ByVal hdc As Dword, pbmi As BITMAPINFO, ByVal dwUsage As Dword, ByVal ppvBits As Dword, ByVal hSection As Dword, ByVal dwOffset As Dword) As Dword Declare Function CreateFile Lib "KERNEL32.DLL" Alias "CreateFileA" (lpFileName As Asciiz, ByVal dwDesiredAccess As Dword, ByVal dwShareMode As Dword, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Dword, _ ByVal dwFlagsAndAttributes As Dword, ByVal hTemplateFile As Dword) As Dword Declare Function DeleteDC Lib "GDI32.DLL" Alias "DeleteDC" (ByVal hdc As Dword) As Long Declare Function DeleteObject Lib "GDI32.DLL" Alias "DeleteObject" (ByVal hObject As Dword) As Long Declare Function GetClientRect Lib "USER32.DLL" Alias "GetClientRect" (ByVal hwnd As Dword, lpRect As Rect) As Long Declare Function GetDC Lib "USER32.DLL" Alias "GetDC" (ByVal hWnd As Dword) As Dword Declare Function GetDeviceCaps Lib "GDI32.DLL" Alias "GetDeviceCaps" (ByVal hdc As Dword, ByVal nIndex As Long) As Long Declare Function GetFileSize Lib "KERNEL32.DLL" Alias "GetFileSize" (ByVal hFile As Dword, lpFileSizeHigh As Long) As Long Declare Function GlobalAlloc Lib "KERNEL32.DLL" Alias "GlobalAlloc" (ByVal wFlags As Dword, ByVal dwBytes As Dword) As Long Declare Function GlobalLock Lib "KERNEL32.DLL" Alias "GlobalLock" (ByVal hMem As Dword) As Dword Declare Function GlobalUnlock Lib "KERNEL32.DLL" Alias "GlobalUnlock" (ByVal hMem As Dword) As Long Declare Function ReadFile Lib "KERNEL32.DLL" Alias "ReadFile" (ByVal hFile As Dword, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long Declare Function ReleaseDC Lib "USER32.DLL" Alias "ReleaseDC" (ByVal hWnd As Dword, ByVal hDC As Dword) As Long Declare Function SelectObject Lib "GDI32.DLL" Alias "SelectObject" (ByVal hdc As Dword, ByVal hObject As Dword) As Dword Declare Function GetFocus Lib "USER32.DLL" Alias "GetFocus" () As Dword Declare Function SetFocus Lib "USER32.DLL" Alias "SetFocus" (ByVal hWnd As Dword) As Long '************************************** ' Types for the COM interfaces '************************************** Type IPicture Dword QueryInterface As Dword AddRef As Dword Release As Dword get_Handle As Dword get_Hpal As Dword get_Type As Dword get_Width As Dword get_Height As Dword Render As Dword set_Hpal As Dword get_CurDC As Dword SelectPicture As Dword get_KeepOriginal As Dword put_KeepOriginal As Dword PictureChanged As Dword SaveAsFile As Dword get_Attributes As Dword End Type 'IPicture Type IStream Dword QueryInterface As Dword AddRef As Dword Release As Dword SRead As Dword SWrite As Dword SSeek As Dword SetSize As Dword CopyTo As Dword Commit As Dword Revert As Dword LockRegion As Dword UnlockRegion As Dword Stat As Dword Clone As Dword End Type 'IStream '************************************** ' Variables '************************************** Global hInst As Long Global GhWnd As Dword Global hDC As Dword Global rct As Rect Global s As String Global t As String $PicID = Chr$(&H80, &H09, &HF8, &H7B, &H32, &HBF, &H1A, _ &H10, &H8B, &HBB, &H00, &HAA, &H00, &H30, &H0C, &HAB) Global pIStrmPtr As IStream Ptr 'ptr to IStream interface ptr Global pIPicPtr As IPicture Ptr 'ptr to IPicture interface ptr '************************************** ' Declares '************************************** Declare Sub LoadPic(PicName As String, ByVal hDlg As Long) '************************************** ' "Call Dword" Prototypes '************************************** Declare Function RelCall( pStrm As Dword ) As Dword Declare Function RendCall( hDC As Dword, x As Dword, y As Dword, cx As Dword, _ cy As Dword, nul As Dword, pic_height As Dword, pic_width _ As Dword, pic_height As Dword, nul As Dword, rct As Any ) As Dword Declare Function DimenCall( pIStrmPtr As Dword, PicDimen As Dword ) As Dword Declare Function GetCurDC( hCurDC As Dword ) As Dword Declare Function GetIPic( hMemDC As Dword, hCurDC As Dword, hIPic As Dword ) As Dword '************************************** ' Win32 API imports '************************************** Declare Function OleInitialize Lib "Ole32.dll" Alias "OleInitialize" (ByVal Dword) As Dword Declare Sub OleUninitialize Lib "Ole32.dll" Alias "OleUninitialize" () Declare Function CreateStreamOnHGlobal Lib "Ole32.dll" Alias "CreateStreamOnHGlobal" _ (hGlobalMem As Dword, DelOnRel As Dword, pStrm As Dword) As Dword Declare Function OleLoadPicture Lib "Olepro32.dll" Alias "OleLoadPicture" _ (ByVal pStream As Dword, ByVal PicSz As Dword, ByVal fRunmode As Dword, _ pPicID As Asciz * 17, ppvObj As Dword) As Dword '************************************** 'Load image file and gets its dimensions 'Calling with a valid file name will load and display 'the picture (it calls itself with a null string) 'Calling with a string of less than 5 characters 'will refresh any previously loaded picture. Sub LoadPic(PicName As String, ByVal hDlg As Long) Local hFile As Dword 'picture's file handle Local hMem As Dword 'handle to globally alocated memory Local pMem As Dword 'pointer to globally alocated memory Local n As Dword 'Local pIStrmPtr As IStream Ptr 'ptr to IStream interface ptr 'Local pIPicPtr As IPicture Ptr 'ptr to IPicture interface ptr Static PicWd As Dword 'picture's HIMETRIC width Static PicHt As Dword 'picture's HIMETRIC height Static PicWdPix As Dword 'picture's width in pixels Static PicHtPix As Dword 'picture's height in pixels Static PicSz As Dword 'size of picture file in bytes Local hDC As Long Static hBmp As Long Local hMemDC As Long Static hBmpOld As Long If Len(PicName) < 5 Then If PicSz Then 'refresh the previously loaded picture hDC = GetDC(hDlg) hMemDC = CreateCompatibleDC(hDC) hBmp = CreateCompatibleBitmap(hDC, rct.nRight, rct.nBottom) hBmpOld = SelectObject(hMemDC, hBmp) Call Dword @@pIPicPtr.Render Using RendCall(ByVal pIPicPtr, ByVal hMemDC, _ ByVal 0, ByVal 0, _ ByVal PicWdPix,ByVal PicHtPix, ByVal 0&, ByVal PicHt, ByVal PicWd, _ ByVal - PicHt, ByVal VarPtr(rct)) BitBlt hDC, 4, 4, PicWdPix, PicHtPix, hMemDC, 0, 0, %SRCCOPY SelectObject(hMemDC, hBmpOld) DeleteObject(hBmp) DeleteDC(hMemDC) ReleaseDC hDlg, hDC End If RDTSC(Time2) Exit Sub End If '------------------------------------------------------------------- hFile = CreateFile(ByVal StrPtr(PicName), %GENERIC_READ, %FILE_SHARE_READ Or _ %FILE_SHARE_WRITE, ByVal 0, %OPEN_EXISTING, %FILE_ATTRIBUTE_NORMAL, 0) If hFile Then PicSz = GetFileSize(hFile, n) 'allocate global memory and return a handle to it If PicSz Then hMem = GlobalAlloc(%GMEM_MOVEABLE, PicSz) 'Lock the allocated memory and return a pointer to it If hMem Then pMem = GlobalLock(hMem) If (pMem) And (ReadFile(hFile, ByVal pMem, ByVal PicSz, ByRef n, ByVal 0)) Then RDTSC(Time1) 'Create an IStream object If (CreateStreamOnHGlobal(ByVal hMem,ByVal 1&, ByRef pIStrmPtr)) Then Exit If 'transfer the picture data from the globally allocated memory to the IStream If (OleLoadPicture(pIStrmPtr, PicSz, 0&, ByRef $PicID, pIPicPtr)) Then Exit If 'release the IStream Call Dword @@pIStrmPtr.Release Using RelCall(ByVal pIStrmPtr) 'get the image's measurements in "HIMETRIC" units Call Dword @@pIPicPtr.Get_Width Using DimenCall(ByVal pIPicPtr,ByRef PicWd) Call Dword @@pIPicPtr.Get_Height Using DimenCall(ByVal pIPicPtr,ByRef PicHt) 'convert HIMETRIC measurements to pixel units hDC = GetDC(hDlg) PicWdPix = CDbl((PicWd * GetDeviceCaps(hDC, %LOGPIXELSX)) / 2540) PicHtPix = CDbl((PicHt * GetDeviceCaps(hDC, %LOGPIXELSY)) / 2540) ReleaseDC hDlg, hDC End If If pMem Then GlobalUnlock(hMem) 'unlock the allocated memory - returns reference CloseHandle hFile LoadPic "", hDlg End If 'hFile End Sub 'LoadPic '************************************** '------------------------------------------------------------------------ ' Block Name Required Label Ext. Vers. '------------------------------------------------------------------------ ' Header Req. (1) none no N/A ' Logical Screen Descriptor Req. (1) none no 87a (89a) ' Global Color Table Opt. (1) none no 87a ' Local Color Table Opt. (*) none no 87a ' Image Descriptor Opt. (*) 0x2C (044) no 87a (89a) ' Trailer Req. (1) 0x3B (059) no 87a ' Application Extension Opt. (*) 0xFF (255) yes 89a ' Comment Extension Opt. (*) 0xFE (254) yes 89a ' Graphic Control Extension Opt. (*) 0xF9 (249) yes 89a ' Plain Text Extension Opt. (*) 0x01 (001) yes 89a ' legend: (1) if present, at most one occurrence ' (*) zero or more occurrences ' (+) one or more occurrences %ExtIntro = &H21 'extension intro %AppExt = &HFF %Comment = &HFE %GraphCtrl = &HF9 %ImgDesc = &H2C %PlainText = &H01 %Trailer = &H3B Type GifHeader sSig As String * 3 sVer As String * 3 End Type 'GifHeader Type ScreenDescriptor nWidth As Word nHght As Word ' global color table flag 1 bit ' color resolution 3 bits ' sort flag 1 bit ' size of global color table 3 bits Packed As Byte iBkGnd As Byte Aspect As Byte 'dRgb(768) As Byte 'RGB triplets End Type Type ImageDescriptor nSep As Byte nLeft As Word nTop As Word nWidth As Word nHeight As Word Packed As Byte MinBits As Byte 'minimum bits per value 'nData As Byte 'bytes of data in block 'Data(nData) As Byte End Type Type GraphicExtension nIntro As Byte nLabel As Byte nSize As Byte Packed As Byte Delay As Word iTrans As Byte nTerm As Byte End Type '************************************** Global Sum As Double Global ctr As Dword Sub LogIt(ByVal d As Quad) If ctr > 10 Then Exit Sub Incr ctr If ctr > 1 Then 'ignore the first run Sum = Sum + d Print# 1, Format$(d) End If End Sub '************************************** Function ShowGif(cs As String, ByVal op As Long) As Long #Register None Static m As Long Static i As Long Static n As Long Static p As Long Static v As Long Static iBit As Long Static iByte As Long Static nShift As Long Static nData As Long Static nBits As Long Static vClear As Long Static vEnd As Long Static Code As Dword 'messes up if not Dword Static fMask As Dword Static fAddStr As Long Static ubStr As Long Static fInit As Long Static pIn As Byte Ptr 'StrPtr(cs) Static pImg As Byte Ptr 'string offset to image data Static nOut As Long 'offset Static pOut As Byte Ptr 'StrPtr(OutStr) Static pOffs As Byte Ptr 'offset into OutStr Static fGlob As Long Static nColors As Long Static pPalette As Dword Static vColor() As Dword Static pStr() As Dword Static nLen() As Word 'messes up if Byte Static ppStr As Dword Static pnLen As Dword Static LenBits() As Dword 'needs to be cleared before use Static pLenBits As Dword Static nPref As Long Static pPref As Byte Ptr Static nSuff As Long Static pSuff As Byte Ptr Static pStrg As Byte Ptr Static pDwd1 As Dword Ptr Static pDwd2 As Dword Ptr Static dwd1 As Dword Static dwd2 As Dword Static OutStr As String 'output Static ls As String Static ScrDsc As ScreenDescriptor Static ImgDsc As ImageDescriptor Static hDC As Long Static hBmp As Long Static pBmp As Dword Static BmpInfo As BitmapInfo Static hMemDC As Long Static hBmpOld As Long If op = %Op_Show Then If fInit = 0 Then ShowGif(cs, %Op_Init) ElseIf op = %Op_Init Then 'initialize Incr fInit ReDim vColor(255) ReDim pStr(4095) ReDim nLen(4095) ReDim LenBits(%UbLenBits) pLenBits = VarPtr(LenBits(0)) ppStr = VarPtr(pStr(0)) pnLen = VarPtr(nLen(0)) '------------------------------------------- ls = Left$(cs, 6) If InStr(",GIF87a,GIF89a,", "," & ls & ",") = 0 Then Exit Function '------------------------------------------- pIn = StrPtr(cs) p = 7 LSet ScrDsc = Mid$(cs, p) 'fGlob = (ScrDsc.Packed And &H80) 'nColors = 2 : Shift Left nColors, ScrDsc.Packed And 7 'Decr nColors 'p = p + SizeOf(ScreenDescriptor) 'advance to palette 'pPalette = p 'save offset to palette 'p = p + (nColors * 3) 'advance past the palette ! lea edx, ScrDsc ;get address of ScrDsc ! Add edx, Byte 4 ;add offset to ScrDsc.Packed ! movzx eax, Byte [edx] ;get ScrDsc.Packed ! mov cl, al ;make a copy ! And al, &H80 ;al = (ScrDsc.Packed And &H80) ! mov fGlob, al ;save fGlob ! And cl, 7 ;cl = ScrDsc.Packed And 7 ! mov al, 2 ;nColors = 2 ! shl eax, cl ;Shift Left nColors, ScrDsc.Packed And 7 ! dec eax ;Decr nColors ! mov nColors, eax ;save nColors ! mov ecx, p ;get p (advance to palette) ! Add ecx, Byte 7 ;add SizeOf(ScreenDescriptor) ! mov pPalette, ecx ;pPalette = p 'save offset to palette ! mov edx, eax ;save a copy ! shl eax, 1 ;multiply by 2 (eax still equals nColors) ! Add eax, edx ;add the copy ! Add eax, ecx ;add p ! mov p, eax ;save p '------------------------------------------- 'decode blocks Do While p < Len(cs) m = Asc(cs, p) If m = %ImgDesc Then LSet ImgDsc = Mid$(cs, p) nBits = ImgDsc.MinBits + 1 p = p + SizeOf(ImageDescriptor) '------------------------------------------- 'decode image data 'vClear = nColors + 1 'vEnd = vClear + 1 ! mov eax, nColors ! inc eax ! mov vClear, eax ! inc eax ! mov vEnd, eax '------------------------------------------- 'initialize the string table with single-symbol values 'ubStr = vEnd 'For n = 0 To ubStr ' pStr(ubStr) = n ' nLen(ubStr) = 1 'don't need this... 'Next n ' eax still equals vEnd, so... ! mov ubStr, eax ;ubStr = vEnd ! mov edx, ppStr ;get pointer to pStr(0) NextStrTblIndex: ! mov [edx + eax * 4], eax ;put eax at element number eax ! dec eax ;next element (counting downward) ! jne short NextStrTblIndex '------------------------------------------- 'fill in BitmapInfo structure BmpInfo.bmiHeader.biSize = SizeOf(BitmapInfoHeader) BmpInfo.bmiHeader.biWidth = ImgDsc.nWidth BmpInfo.bmiHeader.biHeight = -ImgDsc.nHeight BmpInfo.bmiHeader.biPlanes = 1 BmpInfo.bmiHeader.biBitCount = 8 BmpInfo.bmiHeader.biCompression = %BI_RGB BmpInfo.bmiHeader.biSizeImage = ImgDsc.nWidth * ImgDsc.nHeight BmpInfo.bmiHeader.biXPelsPerMeter = 2835 ' = 72 dpi BmpInfo.bmiHeader.biYPelsPerMeter = 2835 ' = 72 dpi BmpInfo.bmiHeader.biClrUsed = nColors + 1 '2 ^ ((ImgDsc.Packed And 7) + 1) BmpInfo.bmiHeader.biClrImportant = 0 'BmpInfo.bmiColors(255) 'XRGB '------------------------------------------- 'load the palette ! push edi ! push esi ! mov ecx, nColors ;get number of entries - 1 ! mov esi, pIn ;esi = pointer to palette in file... ! Add esi, pPalette ! dec esi ! lea edi, BmpInfo ;get address of BmpInfo ! Add edi, 40 ;advance to BmpInfo.bmiColors(0) NextPaletteEntry: ! mov edx, [esi] ; load a palette entry from the file ! shl edx, 8 ; swap red and blue values... ! bswap edx ! mov [edi], edx ;add entry to bitmap's palette ! Add edi, Byte 4 ;advance to next palette addresses... ! Add esi, Byte 3 ! dec ecx ;check index range ! jne short NextPaletteEntry ! pop esi ! pop edi '------------------------------------------- 'prepare DC's and DIBSection hDC = GetDC(ghDlg) hMemDC = CreateCompatibleDC(hDC) ReleaseDC(ghDlg, hDC) hBmp = CreateDIBSection(hMemDC, BmpInfo, %DIB_RGB_COLORS, VarPtr(pBmp), ByVal 0, 0) hBmpOld = SelectObject(hMemDC, hBmp) '------------------------------------------- 'remove all the block-length bytes 'Do While p + nData < Len(cs) ' n = Asc(cs, p + nData) ' If n = 0 Then Exit Do ' If n = &H3B Then Exit Do ' cs = StrDelete$(cs, p + nData, 1) ' nData = nData + n 'Loop nData = 0 n = Len(cs) - p ! mov edx, n ! Xor ecx, ecx ! Xor eax, eax ! push edi ! push esi ! mov esi, pIn ! Add esi, p ! dec esi ; p is a one-based offset... ! mov edi, esi 'Do While p + nData < Len(cs) NextSegment: 'n = Asc(cs, p + nData) ! mov cl, [esi] 'If n = 0 Then Exit Do ! jecxz short ExitDoSegment 'this doesn't seem to be needed... 'If n = &H3B Then Exit Do '! cmp cl, &H3B '! je short ExitDoSegment 'nData = nData + n ! Add eax, ecx ; update nData's value 'cs = StrDelete$(cs, p + nData, 1) ! inc esi ;advance esi past the length byte ! rep movsb ;shift the segment down a byte 'Loop ! cmp eax, edx ! jb short NextSegment ExitDoSegment: ! mov nData, eax ! pop esi ! pop edi pImg = p '------------------------------------------- pIn = StrPtr(cs) v = ((ImgDsc.nWidth + 3) And &HFFFFFFFC) - ImgDsc.nWidth If v Then 'the width is not a multiple of four 'pre-create output string OutStr = String$(BmpInfo.bmiHeader.biSizeImage, 255) 'OutStr = String$(ImgDsc.nWidth * ImgDsc.nHeight, 255) pOut = StrPtr(OutStr) pOffs = pOut Else 'the width is a multiple of four pOut = pBmp pOffs = pBmp End If Exit Do ElseIf m = %Trailer Then ElseIf m = %ExtIntro Then 'decode extension Incr p Select Case Asc(cs, p) Case %AppExt Case %Comment Case %GraphCtrl Case %PlainText Case Else End Select p = p + Asc(cs, p + 1) + 1 'advance past the extension If Asc(cs, p) = 0 Then Incr p 'skip terminator byte Else Incr p End If Loop ExitMainDoLoop: Exit Function ElseIf %Op_End Then 'clean up fInit = 0 SelectObject(hMemDC, hBmpOld) DeleteObject(hBmp) DeleteDC(hMemDC) Exit Function Else 'error Exit Function End If '------------------------------------------- 'reset some variables pOffs = pOut pPref = pOut p = pImg nBits = ImgDsc.MinBits + 1 iBit = 0 iByte = 0 nShift = 0 nOut = 1 '------------------------------------------- ! pushad 'save all registers '------------------------------------------- 'reset LenBits() 'For i = 0 To %UbLenBits ' LenBits(i) = 0 'Next i ! Xor eax, eax ! mov edi, pLenBits ;get pointer to LenBits(0) ! mov ecx, %UbLenBits ;get count of elements ! rep stosd ;LenBits(i) = 0 '------------------------------------------- 'Do While iByte <= nData NextCode: ! mov eax, iByte ! cmp eax, nData ! ja ExitDoLoop ! Xor ebx, ebx ; invalidate detached byte '------------------------------------------- 'get mask value 'fMask = 1 : Shift Left fMask, nBits : Decr fMask ! Xor eax, eax ! inc eax ! mov ecx, nBits ! shl eax, cl ! dec eax ! mov fMask, eax '------------------------------------------- 'get next code 'Code = CvDwd(cs, p + iByte) 'load 32 bits of data ! mov edx, pIn ! Add edx, p ! dec edx ; p is 1 - based ! Add edx, iByte ! mov edx, [edx] 'Shift Right Code, nShift 'shift out extra low bits ! mov ecx, nShift ! shr edx, cl 'Code = Code And fMask 'mask out extra high bits ! And edx, eax ! mov Code, edx 'iBit = iBit + nBits 'increment bit index ! mov eax, nBits ! Add iBit, eax '------------------------------------------- 'Select Case Code ! mov eax, Code 'Case vClear 'clear the dictionary ! cmp eax, vClear ! jne short Case_vEnd ! mov eax, vEnd ;ubStr = vEnd ! mov ubStr, eax 'nBits = ImgDsc.MinBits + 1 ! lea eax, ImgDsc ! mov al, [eax + 10] ! inc eax ! mov Byte Ptr nBits, al ! Xor eax, eax ! mov nPref, eax ;nPref = 0 ! mov nSuff, eax ;nSuff = 0 ! jmp EndSelect 'Case vEnd 'end of image Case_vEnd: ! cmp eax, vEnd ! jne short CaseElse ! jmp ExitDoLoop 'Case Else 'it's data CaseElse: 'fAddStr = 0 ! mov fAddStr, 0 'If Code > ubStr Then 'Code refers to a string that's not there yet ! cmp eax, ubStr ! jbe short IsCodeLessThanvClear '---------------------------------- 'Suffix = Prefix & Left$(Prefix, 1) ! mov edi, pOffs ! mov pSuff, edi ! mov esi, pPref ! push edi ! push esi ' nSuff = nPref + 1 ! mov ecx, nPref ! inc ecx ! mov nSuff, ecx ' n = (nSuff + 3) \ 4 ! Add ecx, Byte 3 ! shr ecx, 2 ! rep movsd ; move n Dwords ! pop esi ! pop edi ! Add edi, nPref ! cmp bh, 0 ;see if there is a detached byte (bh is a flag) ! je short NoDetachedByte1 ! mov [edi], bl ;append the detached byte ! inc edi NoDetachedByte1: ! movsb ; ... & Left$(Prefix, 1) ! mov pOffs, edi ! inc fAddStr ;set flag to add the string to the table ! jmp CodeEndIf 'ElseIf Code < vClear Then 'Code refers to a single symbol IsCodeLessThanvClear: ! cmp eax, vClear ! jae short CodeIfElse '---------------------------------- 'Suffix = Chr$(Code) ! mov nSuff, 1 ;nSuff = 1 ! mov edx, pOffs ;pSuff = pOffs ! mov pSuff, edx ! mov al, Code ;@pSuff = Code ! mov [edx], al ! inc pOffs ;Incr pOffs ! jmp short CodeEndIf 'Else ' Code refers to an existing string CodeIfElse: '---------------------------------- 'Suffix = Mid$(OutStr, pStr(Code), nLen(Code)) 'nSuff = nLen(Code)... ! mov ecx, Code ! shl ecx, 1 ! Add ecx, pnLen ! movzx ecx, Word Ptr [ecx] ! mov nSuff, ecx 'n = pStr(Code) ! mov ecx, Code ! shl ecx, 2 ! Add ecx, ppStr ! mov ecx, [ecx] ! mov n, ecx ' nSuff = pOffs ! mov edi, pOffs ! mov pSuff, edi 'pDwd2 = pOut + pStr(Code) - 1 ! mov esi, pOut ! Add esi, n ! dec esi ! push edi ' n = (nSuff + 3) \ 4 ! mov ecx, nSuff ! Add ecx, Byte 3 ! shr ecx, 2 ! rep movsd ; move n Dwords ! pop edi ! Add edi, nSuff ! mov pOffs, edi 'End If CodeEndIf: '------------------------------------------- 'Mid$(OutStr, nOut) = Suffix 'this was taken care of above '------------------------------------------- 'nOut = nOut + Len(Suffix) ! mov eax, nSuff ;nOut = nOut + nSuff ! Add nOut, eax '------------------------------------------- 'If nSuff Then Prefix = Prefix & Left$(Suffix, 1) 'If nSuff Then ! cmp nSuff, 0 ! je short nSuffIsZero ! dec ebx ;set "valid" flag for detached byte ! mov bl, Byte Ptr pSuff ;get detached byte ! inc nPref 'End If nSuffIsZero: '------------------------------------------- 'see if we need to add Prefix to the table 'If fAddStr = 0 And nPref > 1 Then ' fAddStr = 0 ? ! Xor eax, eax ! cmp eax, fAddStr ! jne EndIf_fAddStr ' nPref > 1 ? ! inc eax ! cmp eax, nPref ! jae EndIf_fAddStr '...Then ... ! inc fAddStr 'This code checks to see if a bit has been set indicating that a string 'the length of Prefix already exists. This can eliminate many complete 'searches. ! mov edx, pLenBits #If %LenBitsBits = 128 ! movzx eax, Byte Ptr nPref ;get the lower eight bits of the string's length... ! And al, 127 #ElseIf %LenBitsBits = 256 '256 bits ! movzx eax, Byte Ptr nPref ;get the lower eight bits of the string's length... #ElseIf %LenBitsBits = 512 '512 bits ! mov eax, nPref ! And eax, 511 #EndIf ! bts [edx], eax ;test and set the bit for this string's length for future reference ! jc EndIf_fAddStr ;yes, so skip the search and add it 'Do While i <= ubStr 'i = vEnd ! mov eax, vEnd ! mov i, eax 'ecx = VarPtr(nLen(ubStr)) 'get offset to the last element ! mov ecx, ubStr ! shl ecx, 1 ! Add ecx, pnLen NextScan: 'prepare for another scan 'edx = VarPtr(nLen(i)) 'get offset to the first element to check ! mov edx, i ! shl edx, 1 ! Add edx, pnLen ! mov eax, nPref ;eax = length of Prefix NextString: 'find another string of the same length 'If nPref <> nLen(i) Then ' Iterate For ! inc i ! inc edx ;advance to next (Word) element ! inc edx ; ... ! cmp edx, ecx ; is it past nLen(ubStr) ? ! ja short ExitDo ; exit the loop if so ! cmp ax, Word Ptr [edx] ; is this element equal to nPref ? ! jne short NextString ;the string has a different length FoundOne: 'found a string of the same length 'If Left$(Prefix, nPref) = Mid$(OutStr, pStr(i), nPref) Then 'n = pStr(i) 'get string offset to string ! mov eax, i ! shl eax, 2 ! Add eax, ppStr ! mov eax, [eax] ! mov n, eax ;n = offset of the string in the table 'get address of string ! mov esi, pPref ! mov edi, pOut ! Add edi, n ! mov eax, nPref ! cmp bh, 0 ;see if there is a detached byte ! sbb eax, Byte 0 ;adjust the byte count as needed ! mov ecx, eax ! shr ecx, 2 ;get number of Dwords in string ! And al, 3 ;get number of leftover bytes in string ! repe cmpsd ;compare as many Dwords as possible ! jne short NotFound ! movzx ecx, al ! repe cmpsb ! jne short NotFound ! cmp bh, 0 ;see if there is a detached byte (ch is a flag) ! je short NoDetachedByte2 ! cmp bl, [edi] ;see if the detached byte is a match ! jne short NotFound NoDetachedByte2: 'found it ! dec fAddStr ; fAddStr = 0, so Prefix doesn't get added to the string table ! stc ;...so we'll exit the loop 'End If ... Left$(Prefix, nPref) = Mid$(OutStr, pStr(i), nPref) NotFound: 'Prefix wasn't in the string table 'Loop ! jnc NextScan ExitDo: EndIf_fAddStr: '------------------------------------------- 'add Prefix to the table 'If fAddStr Then ! cmp fAddStr, 0 ! je short fAddStrZero 'Then... 'If ubStr => fMask Then ! mov eax, ubStr ! inc eax ;Incr ubStr ! mov ubStr, eax ;save ubStr ! cmp eax, fMask ; is ubStr => fMask ? ! jb short ubStrLessThanfMask ; if not, then leave nBits as it is 'nBits = Min&(nBits + 1, 12) ! cmp nBits, Byte 12 ! adc nBits, Byte 0 ubStrLessThanfMask: 'pStr(ubStr) = nOut - (Len(Prefix) + Len(Suffix) - 1) 'pStr(ubStr) = nOut - (nPref + nSuff - 1) ! mov edx, ubStr ;edx = VarPtr(pStr(ubStr))... ! shl edx, 2 ! Add edx, ppStr ! mov eax, nOut ; nOut - (Len(Prefix) + Len(Suffix) - 1)... ! Sub eax, nPref ! Sub eax, nSuff ! inc eax ! mov [edx], eax ;save value 'nLen(ubStr) = nPref ! mov edx, ubStr ! shl edx, 1 ! Add edx, pnLen ! mov eax, npref ! mov Word Ptr [edx], ax 'End If fAddStrZero: '------------------------------------------- 'Prefix = Suffix ! mov eax, pSuff ! mov pPref, eax ! mov eax, nSuff ! mov nPref, eax 'End Select EndSelect: '------------------------------------------- 'iByte = iBit \ 8 'get the next byte's offset 'nShift = iBit And 7 'get the number of low bits to shift out ! mov eax, iBit ! mov ecx, eax ! shr eax, 3 ;iByte = iBit \ 8 get the next byte's offset ! mov iByte, eax ! And cl, 7 ; nShift = iBit And 7 get the number of low bits to shift out ! mov nShift, cl 'Loop ! jmp NextCode ExitDoLoop: ! popad 'restore all registers 'v = ((ImgDsc.nWidth + 3) And &HFFFFFFFC) - ImgDsc.nWidth If v Then 'the width is not a multiple of four, so... Dwd1 = pBmp For n = 1 To Len(OutStr) Step ImgDsc.nWidth Poke$ Dwd1, Mid$(OutStr, n, ImgDsc.nWidth) Dwd1 = Dwd1 + ImgDsc.nWidth + v Next n OutStr = "" End If hDC = GetDC(ghDlg) BitBlt hDC, 4, 4, ImgDsc.nWidth, ImgDsc.nHeight, hMemDC, 0, 0, %SRCCOPY ReleaseDC ghDlg, hDC 'Function = v End Function 'ShowGif '************************************** CallBack Function MainProc Local ff As Long Local ls As String Select Case CbMsg Case %WM_INITDIALOG OleInitialize 0& GetClientRect ghDlg, rct Case %WM_NCACTIVATE Static hWndSaveFocus As Dword If IsFalse CbWParam Then hWndSaveFocus = GetFocus() ElseIf hWndSaveFocus Then SetFocus(hWndSaveFocus) hWndSaveFocus = 0 End If Case %WM_COMMAND Select Case As Long CbCtl Case %ShowBtn If CbCtlMsg = %BN_CLICKED Or CbCtlMsg = 1 Then ls = IIf$(Len(Command$), Command$, $InFile) #If %Their 'test TheirCorp's code If Len(Dir$(ls)) Then Try ff = FreeFile Open ls For Binary As #ff Get$ #ff, Lof(ff), ls Close# ff Catch Exit Function End Try End If RDTSC(Time1) ShowGif(ls, %Op_Show) RDTSC(Time2) #Else 'test OlePro32 If pIPicPtr Then 'pIPicPtr will be non-zero if valid Call Dword @@pIPicPtr.Release Using RelCall(ByVal pIPicPtr) pIPicPtr = 0 'prevent repeated releases End If LoadPic(ls, ghDlg) #EndIf Total = (Time2 - Time1) - MinTime LogIt Total Control Set Text CbHndl, %Txt, Format$(Total) End If End Select Case %WM_DESTROY ShowGif("", %Op_End) 'clean-up call End Select End Function '************************************** Function PBMain Local lRslt As Long 'get the time to read the time stamp counter Sleep 1 RDTSC(Time1) RDTSC(Time2) MinTime = Time2 - Time1 Open "LogIt.txt" For Append As #1 Print# 1, "------------------------------" Print# 1, $Caption Print# 1, "MinTime = " & Format$(MinTime) Dialog New 0, $Caption,,, 427, 296, %WS_POPUP Or %WS_BORDER Or _ %WS_DLGFRAME Or %WS_CAPTION Or %WS_SYSMENU Or %WS_CLIPSIBLINGS Or %WS_VISIBLE Or _ %DS_MODALFRAME Or %DS_3DLOOK Or %DS_NOFAILCREATE Or %DS_SETFONT, %WS_EX_CONTROLPARENT Or _ %WS_EX_LEFT Or %WS_EX_LTRREADING Or %WS_EX_RIGHTSCROLLBAR, To ghDlg Control Add Button, ghDlg, %ShowBtn, "Show", 383, 278, 42, 15, %WS_CHILD Or %WS_VISIBLE Or _ %WS_TABSTOP Or %BS_TEXT Or %BS_DEFPUSHBUTTON Or %BS_PUSHBUTTON Or %BS_CENTER Or _ %BS_VCENTER, %WS_EX_LEFT Or %WS_EX_LTRREADING Dialog Send ghDlg, %DM_SETDEFID, %ShowBtn, 0 Control Add TextBox, ghDlg, %Txt, "", 2, 280, 100, 12 Dialog Show Modal ghDlg, Call MainProc To lRslt Decr ctr 'ignore the first run Print# 1, "N = " & Format$(ctr) If ctr Then Print# 1, "Avg = " & Format$(Sum/ctr, "0.###############") Close# 1 Function = lRslt End Function '**************************************
TheirCorp's SourceForge project includes:
- API Helper --- a code generator for the Win32 API
- BinEditPlus --- a decompiler and more
- ComHelper --- a code generator for the COM programming
- "Flex" --- an editor with novel features
- GDI Debug --- catches programming errors that could lead
to resource leaks - Import Monitor --- (an API hook) Intercepts and monitors
calls to imported functions - Intricately Mergeable Templates
- Jellyfish Pro enhancer plugin (adds drag-and-drop and more..)
- TheirEdit --- an editor for PowerBASIC code
- TheirNote --- a KeyNote clone
- TheirSheet --- a spreadsheet
- SrcFrmt --- a source code formatter
- Tooltipper --- a tooltip code generator
PowerBASIC article in Wikipedia
The attachment (updated 11-10-2008) contains the source code, two test programs and the test image.
Comment