The following units are freeware and can be used in any free-of-charge applications:
ThCoDec (2) (Thomas’ compressor–decompressor)
ThCtrls (1) (Thomas’ controls)
© 2001–2004 by Thomas Lackó
SHORT UNDERSTANDABLE VERSION
Use them were you want, but do not make money from my work. I wan’t be angry while your are fair. Please include my name in the “thank’s to” section if your program gets successful.
First release in January 2002, based on unit Thomas for Pascal.
Separated bit access for streams (Delphi version of TManualBitStream object implemented in Files unit for Pascal).
|2: 1.1||Some basic procedures added from the Thomas-Pascal unit (Xchg, ByteSwap, spec. IntToStr). (February 2002)|
|3: 1.2||TTransparentForm class for non-rectangular forms. Corrected TManualBitStream bug for odd buffer size. (July 2002)|
|4: 1.2.1||Added the register keyword for assembly functions. (August 2002)|
|5: 1.3||Synchronization procedures (semaphores, thread-safe checking of increased integers). Min and Max functions. TManualBitStream class renamed to TCustomBitStream. Improvements on TTransparentForm: deleting unlinked resources; outhanging transparent objects don’t interrupt the visible border; UpdateRegion method. (August 2003)|
|6: 1.3.1||Type of Mode parameter in TBitStream constructors changed from Integer to TBitStreamMode. Bugfix: TCustomBitStream.EmptyBuffer did not output the buffer if it contained less than 32 bits. Now it does. (September 2003)|
|7||Unit split into “Thomas” and “ThCtrls”. Changed format of version numbers. TTransparentForm renamed and moved to ThCtrls unit. TBitStream class split into better object hierarchy, EmptyBuffer method renamed to ClearBuffer. Functions for bit operations. Integer sets (TNaturalSet, TIntegerSet). (May 2004)|
|8||Bounding functions. Real parameters for Min, Max and Xchg routines. Added the lock code prefix to the critical assembly instructions in synchronization procedures. Some compilational errors corrected. HTML documentation. (May 2004)|
|9||Functions for integer arrays. CommonPrefixLength and CommonSuffixLength functions, Log alias for the BitScanMS function. TChangingObject, TPriorityQueue and TLexTree classes. Bit stream classes renamed for more comfortable references to the base class. Public read-only TBitStream.Mode property. TBitStream.Bound now accepts 1 as parameter and works correctly for 2 (bugfix). Integer sets changed to more useful classes (TIntegerMap, TIntegerList), beta version. (Sep 2004)|
|10||Functions for byte arrays. Pointer parameters for Xchg procedure. Parameters of some versions of Min and Max functions marked as const. TTaggedLexTree class – string counters and indexes are no more confused. Changed method of traversing lexicographic trees (user-defined function instead of virtual method). (Feb 2005)|
First release in September 2004. Huffman and LZW compression and decompression.
LZW stream compression functions, THuffmanMaster class.
|2||Huffman stream compression functions. EOI parameter removed from LZW functions. Argument of TProgressProc changed to real. (Sep 2004)|
Visual components of Thomas unit separated in May 2004 to form a new module.
TUnregularForm class for non-rectangular forms.
|1: 1.0||First release in February 2001, based on unit Cards for Pascal.|
|2: 1.0+||Minor modifications, help file. (August 2001)|
|3: 1.1||Parameters of constructors changed. Protected fields and methods made private. CardsBitmap never remained nil – corrected. (July 2002)|
|3||Changed format of version numbers. HTML documentation. (May 2004)|
uses SysUtils,Thomas,ThCtrls,Cards; function ReleaseDate(v:Integer):TDateTime; begin if v and $FF00=0 then v:=v or $0100; // set day 1 if not specified Result := EncodeDate (2000 + v shr 24, v shr 16 and $FF, v shr 8 and $FF); end; procedure Report(const name:string;ver:Integer); begin WriteLn(name,' (v',IntToStr(ver and $FF),') ',DateTimeToStr(ReleaseDate(ver))); end; begin Report('Thomas', Thomas.UnitVersion); Report('ThCtrls',ThCtrls.UnitVersion); Report('Cards', Cards.UnitVersion); end.– version 10 –
Warning: Documentation is for version 9.
const UnitVersion = $0409090A; INTBSIZE = 8*SizeOf(Integer); tmPreorder=$01; tmInorder=$02; tmPostorder=$04; tmExisting=$10; tmMissing=$20; vtPositive=$01; vtZero=$02; vtNegative=$04; vtAny=$07; // The following two constants are present only for backward compatibility: BitStreamRegSize = INTBSIZE BitStreamRegSize8 = SizeOf(Integer) type TBitStreamMode = (bmRead, bmWrite); TDichCompareFunc = function(A,B:TObject):Boolean; TLexTree_class = class of TLexTree; TLexTree_field = record S:string; L:TLexTree; end; TSemaphore = record Value, MaxValue, Lowered, Raised : Longint; end;
changing shared integers
|TIntegerMap (direct)||Ω(n), Θ(Max−Min)||Ω(n), Θ(Max−Min)||*||O(n)||Θ(1)||Θ(1)|
|TIntegerMap (updating)||Ω(n), Θ(Max−Min)||Ω(n), Θ(Max−Min)||*||Θ(1)||Θ(1)||Θ(1)|
|TIntegerList (sorted)||Θ(n)||Θ(1)||O(n)||O(n)||O(log n)||Θ(1)|
|TIntegerList (sorted, updating)||Θ(n)||Θ(1)||O(n)||O(n)||O(n)||Θ(n)|
Use bitstream objects to read or write separated bits from a data source, starting with the least significant bit. For example, if the data is the string ’CIA’ (01000011 01001001 01000001) and you read a 5-bit and a 7-bit code, you will get codes 3 and 18 (that is, 00011 and 1001010).The Thomas unit offers the following classes for transferring bitfield data:
In multi-threaded applications, accessing a shared variable by several processes at the same time can have dangerous results. If you are interrupted between reading the variable and performing the right action, you have no guarantee that the value has not changed by another process. There are several solutions for this problem; however, synchronization objects and critical sections used by Windows require to hold special structures in memory and have its fields filled properly. The Thomas unit offers an easy way for synchroniation.
Semaphores are integer values used to maintain thread synchronization for objects which can be accessed by only a limited number of processes at the same time. It’s value can be increased or decreased by one. A process is blocked when it’s trying to decrease a semaphore which is zero, or when it’s trying to increase a value which has already reached its maximum. Increasing a zero value will unblock exactly one process (if exists) waiting for positive semaphore, and decreasing a maximal value will unblock exactly one process waiting for a value less than the maximum.Comparing the Thomas unit with the routines used by Windows:
|Pro:||Effective if the presumed number of simultaneously accessing processes is small. The synchronization tests contain minimal number of instructions.|
|Contra:||The order in which the processes arrive can differ from the order in which they enter the critical section. Since the waiting processes are not suspended but execute a loop, this method has worse performance if a process is blocked too long, or if there are too many processes waiting.|
The standard way to manage critical sections is to use TCriticalSection objects
defined in SyncObjs unit. However, critical sections can be also managed using
semaphores. When doing so, each critical section has a corresponding semaphore variable.
Both the semaphore’s actual and maximal value must be initialized to the maximal
number of processes allowed to run in the critical section at the same time.
If the semaphore is initialized to 1 with the same maximal value, zero will indicate that the section is free and nonzero will indicate that the section is in use by a process.
Consider the following program:
If the thread is interrupted between the two lines and another thread executes the same code before the first could finish, the LastWritten variable will finally not reflect the index of the last item in the stream.Solution
var S:TSemaphore; .... InitSemapore(S,1,1); .... SemaphoreDown(S); Stream.Write(Items[i],ItemSize); LastWritten:=i; SemaphoreUp(S);
This time, although the first thread can still be interrupted, the second one will be blocked unless the first leaves the critical section.Example 2
The following code shows how to safely reinitialize the semaphore.
var Allowed:Boolean; // critical section repeat until Allowed; SemaphoreDown(S); .... // critical operations SemaphoreUp(S); // changing the semaphore Allowed:=False; repeat until S.Lowered=S.Raised; InitSemaphore(S,value,newmax); Allowed:=True;
The following code is unsafe for multi-threaded applications:
if Counter=0 then Explode;
Let the counter equal two. If a thread is interrupted between the two lines and a second thread also decreases the counter, both will think they changed the counter to zero. Moreover, if Explode destroys the counter, the first thread (which was interrupted) will try to test a non-existing variable.Solution
if IncSharedInt(Counter,-1)=0 then Explode;
In this case, only one of the threads will get zero result.– version 2 –
const UnitVersion = $04090702; type TProgressProc = procedure(p:Real); THuffmanMaster = class;
procedure ShowProgress(p:Real); begin Form1.Label1.Caption:=IntToStr(Round(100*p))+'%'; end; procedure CompressStream(S1,S2:TStream); begin Huffman_Compress(S1,S2,S1.Size,ShowProgress); end; procedure DecompressStream(S1,S2:TStream); begin Huffman_Decompress(S1,S2,ShowProgress); end;Use THuffmanMaster class to compress customized data instead of pure bytes from the stream, allowing better compression ratio. It is not necessary to dispose and recreate the object to change the compress–decompress mode. However, you must not mix reading and writing codes without performing the necessary initialization procedures.
– count the items in the input,
– create the reference tree,
– write the tree to the stream,
– write the codes to the stream one-by-one.
– read the tree from the stream,
– read the codes from the stream one-by-one.
procedure CompressStream(S1,S2:TStream); var H:THuffmanMaster; B:TBitStream; c:array[Byte] of Integer; i:Integer; x:Byte; begin FillChar(c,SizeOf(c),0); for i:=1 to S1.Size do begin S1.Read(x,1); Inc(c[x]); end; S1.Seek(0,soFromBeginning); i:=S1.Size; S2.Write(i,SizeOf(i)); H:=THuffmanMaster.Create; B:=TBufferedBitStream.Create(S2,bmWrite); try H.CreateTree(c); H.WriteTree(B); for i:=1 to S1.Size do begin S1.Read(x,1); H.WriteCode(B,x); end; finally B.Free; H.Free; end; end; procedure DecompressStream(S1,S2:TStream); var H:THuffmanMaster; B:TBitStream; s:Integer; x:Byte; begin S1.Read(s,SizeOf(s)); H:=THuffmanMaster.Create; B:=TBufferedBitStream.Create(S1,bmRead); try H.ReadTree(B); while s>0 do begin x:=H.ReadCode(B); S2.Write(x,1); Dec(s); end; finally B.Free; H.Free; end; end;
procedure ShowProgress(p:Real); begin Form1.Label1.Caption:=IntToStr(Round(100*p))+'%'; end; procedure CompressStream(S1,S2:TStream); begin LZW_Compress(S1,S2,S1.Size,255,ShowProgress); end; procedure DecompressStream(S1,S2:TStream); begin LZW_Decompress(S1,S2,255,ShowProgress); end;– version 1 –
const UnitVersion = $04051B01; type TFormRegion = set of (frBorders, frControls, frBackground, frCustom); TUnregularForm = class;
class TForm1 = class(TUnregularForm) Button1: TButton; .... procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); .... end; procedure TForm1.FormCreate(Sender: TObject) begin Region:=[frBorders,frControls,frCustom]; CustomRegion:=CreateEllipticRgn(50,50,200,150); end; procedure TForm1.Button1Click(Sender: TObject) begin Transparent:=not Transparent; end;– version 3 –
const UnitVersion = $02070003; CardWidth = 72; CardHeight = 100; NoCard=0; cardA=1; cardJ=11; cardQ=12; cardK=13; Joker=14; type TCard = class; TPack = class; var CardsBitmap : TBitmap;
CardsBitmap is automatically loaded from cards.bmp from the exe file’s directory. If the file doesn’t exist (CardsBitmap remains nil), you must load it yourself.