Thomas’ units
for Borland Delphi 7

The following units are freeware and can be used in any free-of-charge applications:
Thomas (10)
ThCoDec (2) (Thomas’ compressor–decompressor)
ThCtrls (1) (Thomas’ controls)
Cards (3)
© 2001–2004 by Thomas Lackó
homepage: www.thomas.sk
e-mail: thomasyeah@hotmail.com

Licence agreement

  LONG OFFICIAL VERSION
This agreement is between Thomas Lackó (the author) and the users of the Thomas, ThCtrls or Cards modules. You are not allowed to use any of the mentioned program units if you do not intend to honor this agreement.
The units described in this document are freeware. Anyone is free to copy and use them for his non-commercial purpose. Applications using any of these modules must include credits stating that the application uses Thomas Lackó’s program units. The source code can be distributed free of charge but the package must include this document without changes (excluding corrections). However, nobody can use or distribute applications that use the mentioned units for any financial or unlawful purpose. The sale of such applications and their copies is strictly forbidden. No payment is allowed to get for using or distributing the modules.
The author is not responsible for any damages whatsoever, including loss of information, interruption of business, personal injury and/or any damage or consequential damage without limitation, incurred before, during or after the use of the units.
The users of the units will indemnify, hold harmless, and defend the author against lawsuits, claims, costs associated with defense or accusations that may result from the use of the described modules.

  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.

Version history

  Thomas
1: 1.0 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)

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

  ThCtrls
    1     Visual components of Thomas unit separated in May 2004 to form a new module.
TUnregularForm class for non-rectangular forms.

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

UnitVersion constant

The UnitVersion constant is declared in all units, having the following format:
const UnitVersion = ((Year mod 100) shr 24) or (Month shr 16) or (Day shr 8) or Version;
where Year, Month, Day is the release date of the unit (some of them may be zero) and Version is the version number.
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;
basic routines

arithmetic functions
bit operations
integer arrays
string functions
integer sets

TIntegerSet
TIntegerMap
TIntegerList
bitfield streams

TBitStream
TDirectBitStream
TSegmentedBitStream
TBufferedBitStream
special classes

TChangingObject
TPriorityQueue
TLexTree
TTaggedLexTree
synchronization

semaphores
critical sections
changing shared integers
class memory Count Include Exclude Member Min/Max
TIntegerMap (direct) Ω(n), Θ(MaxMin) Ω(n), Θ(MaxMin) * O(n) Θ(1) Θ(1)
TIntegerMap (updating) Ω(n), Θ(MaxMin) Ω(n), Θ(MaxMin) * Θ(1) Θ(1) Θ(1)
TIntegerList (unsorted) Θ(n) Θ(1) O(n) O(n) O(n) Θ(n)
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:
TBufferedBitStream
Designed for usual bitfield streaming purposes.
TSegmentedBitStream
Use this class when the bits are not read or written to the stream “as is” but a kind of conversion has to be made. You may want to derive from this class when, for example, implementing the GIF format which requires some leading bytes for the blocks.
TDirectBitStream
Use direct streaming when you need to frequently change standard and bitfield streaming mode without destroying the bitstream object.
TBitStream
Derive your own class if you have special streaming purposes.

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.

TSemaphore type and operations

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.

Example 1

Consider the following program:

Stream.Write(Items[i],ItemSize);
LastWritten:=i;

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;


Example

The following code is unsafe for multi-threaded applications:

Dec(Counter);
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;
Huffman

Huffman_Compress
Huffman_Decompress
THuffmanMaster
LZW

LZW_Compress
LZW_Decompress
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.
The codes are independent of their ordering. For example, it is possible to extract the items in reversed order. It is also possible to extact (or compress) parts of data more times. To decompress a code, you must only ensure that there is a valid code at the current position in the bitstream.
WARNING: Do not use negative values for items.

To compress:
– 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.
To decompress:
– 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;

Usage example

How to use:
Just rewrite class(TForm) to class(TUnregularForm) in the interface section of the form’s unit, set Region as you need and set Transparent to true.
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.