Thomas’ units
for Borland Delphi 7

Licence agreement

  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.

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.

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;

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

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.

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.

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.

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.

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:

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.

if IncSharedInt(Counter,-1)=0 then Explode;

In this case, only one of the threads will get zero result.

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;

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;

const
  UnitVersion = $04051B01;

type
  TFormRegion = set of (frBorders, frControls, frBackground, frCustom);
  TUnregularForm = class;

Usage example

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;

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.