GIF-Decoder: 26 to 53 times faster than OlePro32.DLL

[Tony Burcham]

Bug fixed in most recent version

Bug fixed in most recent version:
The code in the last post (the one just before this one) has been updated.
All other versions are considered obsolete.

Bug-fix details:
It put a little "garbage" in one image it was tested on. This was because of an
incorrect value for the number of colors ("nColors"). This caused it to skip the
last palette entry.

[Tony Burcham]

42.95 times faster than Olepro32 (even when accounting for its disk activity)

This version is compatible with most GIF's that aren't interlaced.
It's 42.95 times faster than Olepro32 (even when accounting
for its disk activity).
It eliminates the need for the string buffer "OutStr", which was
previously used for images with widths which weren't multiples of
four.
It now stores "detached bytes" in the upper nine bits of the offset
values (byte value plus one bit for a "valid" flag). This limits images
to a maximum of 8,388,608 pixels (2896 x 2896 for example).

Fixed:
It still puts a little garbage in one image it was tested on.

'**************************************
'	"Gif.bas"


'This code is GPL licensed and is free for non-commercial
'use.
'**************************************

#Compile Exe "Gif.exe"

'enable %Debug if you have files which aren't known to be GIFs
'and with less than 8,388,608 pixels (about 2896 x 2896 for example)
%Debug		= 1

'enable %Align if you have images with widths which aren't multiples
'of four
%Align		= 1

'%CodeSize		= 1	'show code size

$Caption	= "TheirCorp's GIF-Decoder Demo"

$InFile			= "Test.gif"
'$OutFile		= "Test.txt"

#Include "Gif.inc"

%Op_Show		= 1
%Op_Init		= 2
%Op_End			= 3
%Op_Prev		= 4
%Op_Next		= 5

%Lbl			= 1000
%Txt			= 1001
%ShowBtn		= 1002

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

'**************************************

'------------------------------------------------------------------------
' 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

'	0x00-0x7F (0-127) are the Graphic Rendering blocks excluding the Trailer (0x3B)
'	0x80-0xF9 (128-249) are the Control blocks;
'	0xFA-0xFF (250-255) are the Special Purpose blocks


%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
Global ctr1		As Dword
Global ctr2		As Dword
Global dat		As Long
Global fDbg		As Long

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 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 pStr()	As Dword
Static nLen()	As Word
Static ppStr	As Dword
Static pnLen	As Dword

Static nPref	As Long
Static pPref	As Byte Ptr
Static nSuff	As Long
Static pSuff	As Byte Ptr

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 %Def(%CodeSize)
	'Show code size
	If fDbg = 0 Then MsgBox Str$(CodePtr(EndFun) - CodePtr(StartFun))
	Incr fDbg
	Exit Function
#EndIf

	StartFun:

	If op = %Op_Show Then
		If fInit = 0 Then ShowGif(cs, %Op_Init)

	'ElseIf op = %Op_Prev Then 'previous frame

	'ElseIf op = %Op_Next Then 'next frame

	ElseIf op = %Op_Init Then 'initialize

		Incr fInit
		ReDim pStr(4095)
		ReDim nLen(4095)
		ppStr = VarPtr(pStr(0))
		pnLen = VarPtr(nLen(0))

#If %Def(%Debug)
		'-------------------------------------------
		'no need to check for files which are already known to be good
		Static ls	As String
		ls = Left$(cs, 6)
		If InStr(",GIF87a,GIF89a,", "," & ls & ",") = 0 Then Exit Function
#EndIf

		'-------------------------------------------
		pIn = StrPtr(cs)
		p = 7
		LSet ScrDsc = Mid$(cs, p)
		'fGlob = (ScrDsc.Packed And &H80)
		'nColors = 2 : Shift Left nColors, ScrDsc.Packed And 7

		'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, eax		;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

		! mov ecx, eax
		! mov nColors, ecx	;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

		! lea eax, [eax + eax * 2]	;eax = eax * 3

		! 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
				! mov vClear, eax
				! inc eax
				! mov vEnd, eax

				'-------------------------------------------
				'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 '2 ^ ((ImgDsc.Packed And 7) + 1)
				BmpInfo.bmiHeader.biClrImportant = 0
				'BmpInfo.bmiColors(255) 'XRGB

#If %Def(%Debug)
				'no need to check for files which are already known to be good
				If ImgDsc.nWidth * ImgDsc.nHeight > &H7FFFFF Then
					MsgBox "Image too large for this version"
					Exit Function
				End If
#EndIf

				'-------------------------------------------
				'load the palette
				! pushad

				! mov ecx, nColors	;get number of entries
				! mov esi, pIn		;esi = pointer to palette in file...
				! Add esi, pPalette	;esi gets adjusted below for the one-based offset in pPalette

				! lea edi, BmpInfo	;get address of BmpInfo
				! Add edi, 40		;advance to BmpInfo.bmiColors(0)

				NextPaletteEntry:
				! dec esi	; only three bytes per entry in file's palette
				! lodsd		; load a palette entry from the file

				! shl eax, 8	; swap red and blue values...
				! bswap eax
				! stosd 		;add entry to bitmap's palette

				! Loop NextPaletteEntry

				! popad


				'-------------------------------------------
				'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
				! pushad
				! 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
				! popad

				pImg = p

				'-------------------------------------------
				pIn = StrPtr(cs)
				pOut = pBmp
				pOffs = pBmp

				Exit Do

			ElseIf m = %Trailer Then

			ElseIf m = %ExtIntro Then 'decode extension
				Incr p

				Select Case As Long 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
		If hMemDC Then
			SelectObject(hMemDC, hBmpOld)
			DeleteDC(hMemDC)
		End If
		If hBmp Then DeleteObject(hBmp)
		Exit Function
	Else 'error
		Exit Function
	End If


	'-------------------------------------------
	'reset some variables
	pOffs	= pOut
	pPref	= pOut
	pSuff	= pOut
	p		= pIn + pImg - 1
	iBit	= 0
	iByte	= 0
	nOut	= 1
	nPref	= 0
	nSuff	= 0
	ubStr	= 0
	nShift	= 0
	fAddStr	= 0

	'-------------------------------------------
	! pushad 'save all registers
	! Call GetnBits		;uses: eax, ecx

	'-------------------------------------------
	'Do While iByte <= nData
	NextCode:
	! mov ebx, iByte
	! cmp ebx, nData
	! ja ExitDoLoop		;no more image data...

		'-------------------------------------------
		'get next code
		'Code = CvDwd(cs, p + iByte) 'load 32 bits of data
		! mov edx, p
		! Add edx, ebx		;p + iByte
		! mov edx, [edx]	;Code = CvDwd(cs, p + iByte)

		'iBit = iBit + nBits			 'increment bit index
		! mov ecx, nBits
		! Add iBit, ecx

		'Shift Right Code, nShift	 'shift out extra low bits
		! mov cl, nShift
		! shr edx, cl

		'Code = Code And fMask		 'mask out extra high bits
		! And edx, fMask
		! mov Code, edx

		! Xor ebx, ebx	 ; invalidate detached byte

		'-------------------------------------------
		'Select Case Code

			'Case vClear 'clear the dictionary
			! cmp edx, vClear
			! jne Case_vEnd

				! mov eax, vEnd		;ubStr = vEnd
				! mov ubStr, eax

				! Call GetnBits		;uses: eax, ecx

				! Xor eax, eax
				! mov nPref, eax	;nPref = 0
				! mov nSuff, eax	;nSuff = 0

				! jmp EndSelect

			'Case vEnd 'end of image
			Case_vEnd:
			! cmp edx, 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 edx, 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
					! mov edx, ecx
					! inc ecx
					! mov nSuff, ecx

					' n = (nSuff + 3) \ 4
					! mov ecx, edx
					! mov eax, edx

					! shr ecx, 2
					! And al, 3

					! rep movsd			; move Dwords

					! mov cl, al
					! rep movsb

					! pop esi
					! pop edi
					! Add edi, edx		;add nPref

					! ror bh, 1				;see if there is a detached byte (bh is a flag)
					! jnc short NoDetachedByte1
					! mov [edi - 1], bl			;replace the last byte moved with the detached byte
					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 edx, vClear
				! jae short CodeIfElse

					'----------------------------------
					'Suffix = Chr$(Code)

					! mov nSuff, 1	;nSuff = 1

					! mov al, dl		;al = Code
					! mov edx, pOffs	;pSuff = pOffs
					! mov pSuff, edx	;@pSuff = Code...
					! mov [edx], al

					! inc pOffs			;Incr pOffs

					! jmp CodeEndIf

				'Else							' Code refers to an existing string
				CodeIfElse:

					'----------------------------------
					'Suffix = Mid$(OutStr, pStr(Code), nLen(Code))

					'nSuff = nLen(Code)...
					! mov eax, edx
					! shl eax, 1
					! Add eax, pnLen
					! movzx ecx, Word Ptr [eax]
					! mov nSuff, ecx

					'n = pStr(Code)
					! shl edx, 2		;edx = Code * 4
					! Add edx, ppStr	;edx + pointer to pStr(0)
					! mov ecx, [edx]	;ecx = pStr(Code)

					! push ecx
					! And ecx, &H7FFFFF

					' pSuff = pOffs
					! mov edi, pOffs
					! mov pSuff, edi

					'pDwd2 = pOut + pStr(Code) - 1
					! mov esi, pOut

					! Add esi, ecx
					! dec esi
					! push edi

					' n = (nSuff + 3) \ 4
					! mov edx, nSuff
					! mov eax, edx
					! mov ecx, edx
					! shr ecx, 2

					! rep movsd		; move Dwords

					! And al, 3
					! mov cl, al
					! rep movsb		; move bytes

					! pop edi
					! Add edi, edx
					! mov pOffs, edi

					! pop eax
					! shr eax, 24	;CF = bit 23, the "valid" flag
					! jnc short NoDetachedByte2
					! mov [edi - 1], al
					NoDetachedByte2:

				'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 eax, pSuff	;get detached byte...
					! mov bl, [eax]

					! inc nPref

				'End If
				nSuffIsZero:

				'-------------------------------------------
				'add Prefix to the table

				'If nPref > 1 Then
				! cmp nPref, Byte 2
				! jb short nPrefOverOne

					'Then...
					'If ubStr => fMask Then
					! mov edx, ubStr
					! inc edx			;Incr ubStr
					! mov ubStr, edx	;save ubStr
					! cmp edx, 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
					! Call SetfMask	;uses: eax, ecx
					ubStrLessThanfMask:

					'pStr(ubStr) = nOut - (Len(Prefix) + Len(Suffix) - 1)

					'nLen(ubStr) = nPref
					! mov ecx, nPref
					! shl edx, 1
					! mov edi, pnLen
					! Add edi, edx
					! mov [edi], cx

					'pStr(ubStr) = nOut - (nPref + nSuff - 1)
					! mov edi, ppStr	;edi = VarPtr(pStr(ubStr))...
					! shl edx, 1
					! Add edi, edx

					! mov eax, nOut		; nOut - (Len(Prefix) + Len(Suffix) - 1)...
					! Sub eax, ecx		;eax - nPref
					! Sub eax, nSuff
					! inc eax

					! rol ebx, 1		;ebx = (detached byte * 2) + MSB of ebx : ...0000 000D DDDD DDDF
					! shl ebx, 23		;shift the detached byte and flag into the high nine bits
					! Or eax, ebx		;"add" the offset
					! mov [edi], eax	;save result

				'End If
				nPrefOverOne:

				'-------------------------------------------
				'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:


#If %Def(%Align)
	'-------------------------------------------
	'Extend the lines to Dword-alignment, if needed
	! lea edi, ImgDsc
	! movzx ebx, Word Ptr [edi + 5] ;get width
	! mov eax, ebx
	! And al, Byte 3
	! jz short EndIfAlign

		! std

		! movzx ecx, Word Ptr [edi + 7] ;ecx = height

		! mov ah, 4		;get aligned width...
		! Sub ah, al
		! movzx eax, ah
		! push eax
		! Add eax, ebx
		! mul ecx	 ;eax = width * height = total bytes
		! mov edx, ecx	;edx = height

		! mov edi, pOut
		! Sub edi, Byte 5
		! mov esi, edi
		! Add edi, eax	;edi points to the last dword of the buffer...
		! Add esi, nOut	;esi points to the last dword of image data in the buffer

		! pop eax	; eax = padding bytes

		! Add ebx, Byte 3	;ebx = number of dwords in an aligned line...
		! shr ebx, 2

		! dec edx	;only move (height - 1) lines...
		NextLine:
		! Add esi, eax	;esi = esi + number of padding bytes
		! mov ecx, ebx	;ecx = number of dwords in an aligned line
		! rep movsd
		! dec edx
		! jne short NextLine
		AlignmentDone:

		! cld

	'End If
	EndIfAlign:
#EndIf

	! popad 'restore all registers

	hDC = GetDC(ghDlg)
	BitBlt hDC, 4, 4, ImgDsc.nWidth, ImgDsc.nHeight, hMemDC, 0, 0, %SRCCOPY
	ReleaseDC ghDlg, hDC

	Function = 1

	Exit Function


	'-------------------------------------------
	'get nBits from the ImageDescriptor
	GetnBits:	'uses: eax, ecx
	'nBits = ImgDsc.MinBits + 1
	! lea eax, ImgDsc
	! mov al, [eax + 10]
	! inc eax
	! mov Byte Ptr nBits, al
	! Call SetfMask
	! ret

	'-------------------------------------------
	'get mask value
	SetfMask:
	'fMask = 1 : Shift Left fMask, nBits : Decr fMask
	! mov ecx, nBits
	! mov eax, Byte 1
	! shl eax, cl
	! dec eax
	! mov fMask, eax
	! ret

EndFun:
End Function 'ShowGif

'**************************************

CallBack Function MainProc
Static ff	As Long
Static ls	As String

	Select Case CbMsg

		Case %WM_INITDIALOG

		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

						'test the decoder
						Total = 0
						If ff = 0 Then

							ls = IIf$(Len(Command$), Command$, $InFile)

							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

						End If

						RDTSC(Time1)
						ShowGif(ls, %Op_Show)
						RDTSC(Time2)
						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 10
	RDTSC(Time1)
	RDTSC(Time2)
	'MinTime = Time2 - Time1
	MinTime = 84

	'get CPU frequncy
	'RDTSC(Time1)
	'Sleep 10000
	'RDTSC(Time2)
	'Freq = ((Time2 - Time1) - MinTime)/10

	Open "LogIt.txt" For Append As #1
	Print# 1, "------------------------------"
	'Print# 1, "MinTime = " & Format$(MinTime)
	Print# 1, "Input file: " & $InFile

	' 1200x1024
	'Dialog New 0, $Caption, 0, 0, 800, 630, %WS_POPUP Or %WS_BORDER Or _
	Dialog New 0, $Caption,,, 480, 320, %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", 140, 300, 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 Label, ghDlg, %Lbl, "&Time:", 3, 302, 24, 10
	Control Add TextBox, ghDlg, %Txt, "", 32, 302, 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.0##############")
	Close# 1

	Function = lRslt

End Function

'**************************************

[Tony Burcham]

Hi Tony! Any Gifs have any problem. Source code is compiled by PB9.

The bug you found appears to be due to certain optimizations which
caused incompatibilities. The solution is not likely to be ready for a
few days.
The decoder originally posted was only to demonstrate the potential
speed of GIF decoding and wasn't intended to be a complete and
usable version.

There are two versions of the decoder attached, each of which will
work with only one of your test files. That might not be very useful
to you, but that's the best available for now. The decoder project
goes through many versions as it's developed and some of the
optimizations being tried aren't compatible with all GIF files yet.

GifErrFix.zip contains:

1. Gif-Test2.bas
2. Gif-Test2.exe
3. Gif-Test3.bas
4. Gif-Test3.exe
5. Gif.inc

[Tony Burcham]

TheirCorp's GIF-decoder reaches 48.76 times that of Olepro32.dll

TheirCorp's GIF-decoder reaches 48.76 times that of Olepro32.dll

For "Test.gif" at least, it isn't necessary to check for the
existence of a string to know whether to add it to the string
table. With all the code pertaining to comparing the strings
removed, the speed increased to 48.76 times that of
Olepro32.dll, even after compensating for disk activity.
Previous versions were "only" about 24 times faster.

[B]Times with no string comparisons:[/B]
1187404
1162768
1133552
1156360
1154420
1152336
1155664
1148304
1149988
1146760
N = 10
[B][COLOR="Blue"]Avg = 1154755.6[/COLOR][/B]

[B](Olepro32 - DiskActivity) / ShowGif =
(56495054 - 190654.0) / 1154755.6 = [COLOR="Blue"]48.758716 times faster[/COLOR][/B]

It might be that the very nature of LZW compression eliminates
the need for string comparisons in a decoder. Even if not, perhaps
an encoder could be designed to always make the comparisons
unnecessary and thereby allow faster decoders.

'**************************************
'	"Gif-48x.bas"

' TheirCorp's GIF-Decoder/Viewer Optimization Demo


'Average times are computed and printed to "LogIt.txt". The
'times of all first runs are discarded.

'This code is GPL licensed and is free for non-commercial
'use.
'**************************************

#Compile Exe "Gif-48x.exe"

$Caption	= "TheirCorp's GIF-Decoder Demo"

$InFile			= "Test.gif"
'$OutFile		= "Test.txt"


%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

' 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 PAINTSTRUCT
	hDC					  As Dword
	fErase				  As Long
	rcPaint				  As Rect
	fRestore			  As Long
	fIncUpdate			  As Long
	rgbReserved(0 To 31)  As Byte
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

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 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 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 GetDC Lib "USER32.DLL" Alias "GetDC" (ByVal hWnd As Dword) As Dword
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


'%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
%Op_Prev		= 4
%Op_Next		= 5

%Lbl			= 1000
%Txt			= 1001
%ShowBtn		= 1002

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 fo = 10

Macro hh = MsgBox "Got here"

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

'**************************************

'------------------------------------------------------------------------
' 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 pStr()	As Dword
Static nLen()	As Word
Static ppStr	As Dword
Static pnLen	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_Prev Then 'previous frame

	'ElseIf op = %Op_Next Then 'next frame

	ElseIf op = %Op_Init Then 'initialize

		Incr fInit
		ReDim pStr(4095)
		ReDim nLen(4095)
		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

				'-------------------------------------------
				'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
		If hMemDC Then
			SelectObject(hMemDC, hBmpOld)
			DeleteDC(hMemDC)
		End If
		If hBmp Then DeleteObject(hBmp)
		Exit Function
	Else 'error
		Exit Function
	End If


	'-------------------------------------------
	'reset some variables
	pOffs = pOut
	pPref = pOut
	p = pIn + pImg - 1
	nBits = ImgDsc.MinBits + 1
	iBit = 0
	iByte = 0
	nShift = 0
	nOut = 1
	! Call GetnBits		;uses: eax, ecx

	'-------------------------------------------
	! pushad 'save all registers

	'-------------------------------------------
	'Do While iByte <= nData
	NextCode:
	! mov ebx, iByte
	! cmp ebx, nData
	! ja ExitDoLoop		;no more image data...

		'-------------------------------------------
		'get next code
		'Code = CvDwd(cs, p + iByte) 'load 32 bits of data
		! mov edx, p
		! Add edx, ebx		;iByte
		! mov edx, [edx]

		'iBit = iBit + nBits			 'increment bit index
		! mov ecx, nBits
		! Add iBit, ecx

		'Shift Right Code, nShift	 'shift out extra low bits
		! mov cl, nShift
		! shr edx, cl

		'Code = Code And fMask		 'mask out extra high bits
		! And edx, fMask
		! mov Code, edx

		! Xor ebx, ebx	 ; invalidate detached byte


		'-------------------------------------------
		'Select Case Code

			'Case vClear 'clear the dictionary
			! cmp edx, vClear
			! jne short Case_vEnd

				! mov eax, vEnd		;ubStr = vEnd
				! mov ubStr, eax

				! Call GetnBits		;uses: eax, ecx

				! Xor eax, eax
				! mov nPref, eax	;nPref = 0
				! mov nSuff, eax	;nSuff = 0

				! jmp EndSelect


			'Case vEnd 'end of image
			Case_vEnd:
			! cmp edx, 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 edx, 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
					! mov edx, ecx
					! 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, edx		;add 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 short CodeEndIf

				'ElseIf Code < vClear Then		'Code refers to a single symbol
				IsCodeLessThanvClear:
				! cmp edx, 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 eax, edx
					! shl eax, 1
					! Add eax, pnLen
					! movzx ecx, Word Ptr [eax]
					! mov nSuff, ecx

					'n = pStr(Code)
					! shl edx, 2
					! Add edx, ppStr
					! mov ecx, [edx]
					'! mov n, ecx

					' nSuff = pOffs
					! mov edi, pOffs
					! push edi
					! pop pSuff

					'pDwd2 = pOut + pStr(Code) - 1
					! mov esi, pOut
					! Add esi, ecx
					! dec esi

					! push edi

					' n = (nSuff + 3) \ 4
					! mov ecx, Byte 3
					! mov edx, nSuff
					! Add ecx, edx
					! shr ecx, 2

					! rep movsd		; move n Dwords

					! pop edi
					! Add edi, edx
					! 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:

				'-------------------------------------------
				'add Prefix to the table

				'If nPref > 1 Then
				! cmp nPref, Byte 2
				! jb short fAddStrZero

					'Then...
					'If ubStr => fMask Then
					! mov edx, ubStr
					! inc edx			;Incr ubStr
					! mov ubStr, edx	;save ubStr
					! mov edi, edx		;copy ubStr
					! mov ecx, fMask
					! cmp edx, ecx		; 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
					! Call SetfMask	;uses: eax, ecx
					ubStrLessThanfMask:

					'pStr(ubStr) = nOut - (Len(Prefix) + Len(Suffix) - 1)

					'nLen(ubStr) = nPref
					! mov ecx, nPref
					! shl edx, 1
					! mov edi, pnLen
					! Add edi, edx
					! mov [edi], cx

					'pStr(ubStr) = nOut - (nPref + nSuff - 1)
					! mov edi, ppStr	;edi = VarPtr(pStr(ubStr))...
					! shl edx, 1
					! Add edi, edx

					! mov eax, nOut		; nOut - (Len(Prefix) + Len(Suffix) - 1)...
					! Sub eax, ecx		;eax - nPref
					! Sub eax, nSuff
					! inc eax
					! mov [edi], eax	;save offset

				'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

	Exit Function


	'-------------------------------------------
	'get nBits from the ImageDescriptor
	GetnBits:	'uses: eax, ecx
	'nBits = ImgDsc.MinBits + 1
	! lea eax, ImgDsc
	! mov al, [eax + 10]
	! inc eax
	! mov Byte Ptr nBits, al
	! Call SetfMask
	! ret

	'-------------------------------------------
	'get mask value
	SetfMask:
	'fMask = 1 : Shift Left fMask, nBits : Decr fMask
	! mov ecx, nBits
	! mov eax, Byte 1
	! shl eax, cl
	! dec eax
	! mov fMask, eax
	! ret

End Function 'ShowGif

'**************************************

CallBack Function MainProc
Static ff	As Long
Static ls	As String

	Select Case CbMsg

		Case %WM_INITDIALOG
			'RDTSC(Time1)
			'RDTSC(Time2)
			'MinTime = Time2 - Time1
			'
			'RDTSC(Time1)
			'RDTSC(Time2)
			'Total = Total + (Time2 - Time1) - MinTime
			'Total = (Time2 - Time1) - MinTime

		Case %WM_NCACTIVATE
			Static hWndSaveFocus As Dword
			If IsFalse CbWParam Then
				hWndSaveFocus = GetFocus()
			ElseIf hWndSaveFocus Then
				SetFocus(hWndSaveFocus)
				hWndSaveFocus = 0
			End If

		'Case %WM_TIMER
			'ShowGif ls, %Op_Next
			'ShowGif ls, %Op_Show, 

		Case %WM_COMMAND

			Select Case As Long CbCtl

				Case %ShowBtn

					If CbCtlMsg = %BN_CLICKED Or CbCtlMsg = 1 Then
						Total = 0

						'test the decoder
						If ff = 0 Then

							ls = IIf$(Len(Command$), Command$, $InFile)
	
							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

						End If

						RDTSC(Time1)
						ShowGif(ls, %Op_Show)
						RDTSC(Time2)
						Total = (Time2 - Time1) - MinTime
						'Sum = Sum + (Time2 - Time1) - MinTime
						'Sum = (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 10
	'RDTSC(Time1)
	'RDTSC(Time2)
	'MinTime = Time2 - Time1
	MinTime = 84

	'get CPU frequncy	
	'RDTSC(Time1)
	'Sleep 10000
	'RDTSC(Time2)
	'Freq = ((Time2 - Time1) - MinTime)/10

	Open "LogIt.txt" For Append As #1
	Print# 1, "------------------------------"
	'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 Label, ghDlg, %Lbl, "&Time:", 3, 283, 24, 10
	Control Add TextBox, ghDlg, %Txt, "", 32, 280, 100, 12

	Dialog Show Modal ghDlg, Call MainProc To lRslt

	Decr ctr 'ignore the first run
	If ctr Then
		Print# 1, "N = " & Format$(ctr)
		Print# 1, "Avg = " & Format$(Sum/ctr, "0.0##############")
	End If
	Close# 1

	Function = lRslt

End Function

'**************************************

Please note:
Current versions of TheirCorps GIF decoder do not parse some GIF
files correctly and can crash your computer. There should be no
problem when using the provided test file: "Test.gif".

The zip file contains the source code, EXE and test file.

[Tony Burcham]

Added 11-10-2008 --- Why Olepro32.dll is so much slower:
Olepro32.DLL loads C:\Windows\System\ASYCFILT.DLL, which is 143 KB
It remains loaded between calls from Test-Olepro32.exe, so that would only
affect the first call, which is ignored during testing anyway.
Either Olepro32.dll or ASYCFILT.DLL creates a file such as:
"C:\WINDOWS\TEMP\~DF94D3.TMP" (6144 bytes for Test.gif) each time it's
invoked.
If you make a copy of it (by Ctrl+dragging) and view the copy in a hex
editor you can see the GIF header about 1536 bytes from the top.

(added 11-11-2008...)

Results of Further Research
To determine the speed of the code in Olepro32.dll, its disk activities
were monitored for a second call (first calls are always much slower and
therefore ignored). Using FileMon, the following disk activities by "Test-
Olepro32.exe" were observed for the second pressing of the "Show" button:

1. Seek Beginning Offset: 6144 / New offset: 6144
2. Seek Beginning Offset: 6144 / New offset: 6144
3. Write Offset: 6144 Length: 0
4. Seek End Offset: 0 / New offset: 0
5. Seek Beginning Offset: 5987 / New offset: 5987
6. Write Offset: 5987 Length: 157
7. Seek Beginning Offset: 1536 / New offset: 1536
8. Write Offset: 1536 Length: 4451

It was emulated using the following code:

	ls = ""
	Seek# ff, 6145
	Seek# ff, 6145
	Put$ #ff, ls	'Write	Offset: 6144 Length: 0
	Seek# ff, 1
	Seek# ff, 5988
	ls = String$(157, 0)
	Put$ #ff, ls	 'Write	Offset: 5987 Length: 157
	Seek# ff, 1537
	ls = String$(4451, 0)
	Put$ #ff, ls

The results:
200296
191648
190020
192768
188960
188372
188224
187648
188492
190112
N = 10
Avg = 190654.0


Analysis:
Olepro32 Total = 56495054
Disk activity = 190654.0
ShowGif Total = 2308744.73

(Olepro32 - DiskAct) / ShowGif =
(56495054 - 190654.0) / 2308744.73 = 24.387451

ShowGif is still 24.387451 times faster than Olepro32.dll.

[Tony Burcham]

Note
The original claims for a relative speed of TheirCorp's decoder compared to
Olepro32.dll were based on values from QueryPerformanceCounter.
This function's results don't seem to be reliable, so from now on, testing
will always use the (Pentium) instruction RDTSC (Read Time Stamp Counter).
Using RDTSC the times are (Olepro32 / TheirCorp):
67016388.8 / 2384600 = 28.1038282311499

It's not expected to see results as high as "53 times faster than
Olepro32.dll" which were previously stated. All previous test results
should be ignored and only the newer ones based on RDTSC should be
viewed as credible.

	------------------------------
	[COLOR="Blue"]Testing TheirCorp's Decoder[/COLOR]
	2464660
	2353608
	2349708
	2444884
	2412384
	2398976
	2356004
	2347884
	2347564
	2370328
	[B]Avg = 2384600[/B]

	------------------------------
	[COLOR="Blue"]Testing OlePro32.Dll[/COLOR]
	63757640
	62886748
	63409388
	62755176
	63641132
	96778800
	67562204
	63140324
	63254816
	62977660
	[B]Avg = 67016388.8[/B]

The code and zip file posted at the start of this thread have been updated.

[Dominique Bodin]

i got it !

There is a mistake in the OleLoadPicture declaration :

Your's:
'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

MSDN's:
DECLARE FUNCTION OleLoadPicture LIB "Olepro32.dll" ALIAS "OleLoadPicture" _
(BYVAL pStream AS DWORD, BYVAL PicSz AS DWORD, BYVAL fRunmode AS DWORD, _
pPicID AS GUID, ppvObj AS DWORD) AS DWORD

the MSDN is like this:
STDAPI OleLoadPicture(
IStream * pStream,
//Pointer to the stream that contains picture's data
LONG lSize, //Number of bytes read from the stream
BOOL fRunmode,
//The opposite of the initial value of the picture's
// property
REFIID riid, //Reference to the identifier of the interface
// describing the type of interface pointer to return
VOID ppvObj //Address of output variable that receives interface
// pointer requested in riid
);


and:
typedef IID* REFIID;

and:
The IID structure is a GUID structure used to describe an identifier for a MAPI interface.

With this modification, the code runs ok.

Thank's

Dominique

[Tony Burcham]

Dominique,

Here's what you should get in LogIt.txt:
13
14
15
16
17
18
19
20
21
22
23
24
25
1
2
3
4
5
6
7
8
9
10
11
12

Sounds like it must be due to a difference in the way PB9 interprets function declarations.
You could post the EXE, or decompile it with bep (BinEditPlus) and post the file "Gen.asm". It
should only be around 15KB zipped.

...and yes, the minus sign is supposed to be there.

[Dominique Bodin]

news

Yes i remed the lines in showpic.bas

here is what i get in logit.txt:
OlePro32
13
14
15
16
25
1
2
3
4
5

each time it crash there !

is the minus sign wanted ( ByVal - PicHt) or is this an error ?

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))

i tried without it but same crash !

I also noticed a member in "Type IPicture Dword" declaration called "Render" this is a reserved word in v9 (colored in blue) !
Renaming it doesn't prevent the crash !

I replaced the gif.inc and used the win32api.inc, same crash . . .


Thanks

Dominique

[Tony Burcham]

Did you REM out the ones in "ShowPic.bas" too? That's where the calls are for
the testing of OlePro32.DLL. That's the test that's compiled by default.

If that doesn't do it, then it's likely a difference in the way version 9 compiles
API calls. You could try using the includes that came with your compiler. As
for the calls to Olepro32.dll, they might need to be modified for your compiler.
It was difficult to get those parameters passed properly. Try substituting the
following replacement for "ShowPic.bas". It will log all the "LogIt2 n" lines that
it reaches to "LogIt.txt".

[Dominique Bodin]

hello

no, even if i rem all these call the .exe crash too !

For info i use pb9

Dominique

[Tony Burcham]

Dominique,

I believe I read somewhere that some compiler versions require different
means of calling QueryPerformanceCounter. If you're using version 8 or later
change "Call QueryPerformanceCounter" to "QueryPerformanceCounter" at all
locations. Do the same with QueryPerformanceFrequency.
You could just temporarily REM out all "QueryPerformance..." lines to see if
that prevents the crashes.

The "fixup overflow" often occurs when using the debugger because of the
extra instructions it compiles between the asm instructions in the source code.
This causes short jumps to be too far from their targets.

[Dominique Bodin]

Crash

Hello,

i use Vista and i've problem with your code "Test.bas":

the compiled .exe in the zip runs ok on my computer.

If i compile the source code, it compiles ok, i get the window on running it but if i click on the button i got a crash !

If i debug the code from the ide i got directly an error 515 :

PowerBASIC for Windows
PB/Win Version 9.00
Copyright (c) 1996-2008 PowerBasic Inc.
Venice, Florida USA
All Rights Reserved

Error 515 in (0:000): Fixup overflow
==============================
Compile failed at 15:58:39 on 08/11/2008


Any idea ?

I also note you use a variable called "Code" that became a reserved word, but changing it's name doesn't correct the crash.

ps: the other code source "gif.bas" compiles and runs ok for me !

Dominique

[Tony Burcham]

Fixed some non-critical errors in Gif.bas

Some non-critical errors in Gif.bas have been fixed.

Its timing code was changed from using QueryPerformanceCounter to RDTSC for
higher accuracy. RDTSC requires a Pentium (or equivalent) CPU.

The zip file has been updated.

[Tony Burcham]

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:

1. Create a memory DC
2. Create a bitmap (and DIBSection if needed)
3. Decode the (pre-loaded) GIF file
4. BitBlt the decoded image to the window DC
5. Clean up: release/delete DCs, delete the bitmap...

[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.

Notes:

(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:
  1. The length of the string
  2. The number of strings of that length already in the table
  3. 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.

'**************************************
'	"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.