Quick Search

Problem/Question/Abstract:

Quick Search string searching

Answer:

procedure TForm1.QuickSearch(const AText, APattern: string);
var
i, k, N, M: integer;
v_found: boolean;
v_Shift: array[0..255] of byte;

procedure InitShift;
var
x: byte;
j, M: integer;
begin
M := Length(APattern);
x := 0;
while x <> 255 do
begin
v_Shift[x] := M + 1;
x := Succ(x);
end;
v_Shift[x] := M + 1;
j := 0;
while j < M do
begin
inc(j);
v_Shift[Ord(APattern[j])] := M + 1 - j;
end;
end;
begin
InitShift;
i := 0;
k := 0;
M := Length(APattern);
N := Length(AText);
while (i <= N - M + 1) and (k < M) do
begin
if AText[i + k] = APattern[1 + k] then
inc(k)
else
begin
i := i + v_Shift[ord(AText[i + M])];
k := 0;
end;
end;
v_found := (k = M);
//  if v_found then
//  begin
//    RichEdit1.SelStart := i - 1;
//    RichEdit1.SelLength := M;
//  end;
end;

Delphi OpenHelp - Unable to view context sensitive help; Delphi displays a blank page

Problem/Question/Abstract:

Pressing F1 when a 3rd-Party Delphi component is selected fails to bring up the help information

Answer:

Start up Delphi. Select Help | Customize. This will start Borland OpenHelp and it should open up D7.ohp. Select the Contents tab. Select Add Files by clicking the add files button or right clicking in the ListView box. You must add the <helpfilename>.cnt file. In order to see this file you must change the Files of Type from *.toc to *.cnt.

You will get a message asking:

Do you want to change the system registry path of <helpfilename>.cnt from C:\<location>\<helpfilename>.cnt to C:\<location>\<helpfilename>.cnt?

Select yes.

Click on the Index tab. Select Add Files. You must add the <helpfilename>.hlp file.

You will get a message asking:

Do you want to change the system registry path of <helpfilename>.HLP from C:\<location>\<helpfilename>.HLP to C:\<location>\<helpfilename>.HLP?

Select yes.

Click on the Link tab. Select Add Files. You must add the <helpfilename>.hlp file.

Save the project inside of OpenHelp. Close OpenHelp. You must now go to the Delphi 7 help directory (using a utility such as Windows Explorer). If you installed to the default location go to:

C:\Program Files\Borland\Delphi7\Help

Erase all .gid files. These are hidden files so make sure you are able to view hidden files. Context Sensitive help should now work with the 3rd-Party components.

THIS FIX WILL ALSO WORK WITH NATIVE DELPHI COMPONENTS WHOSE HELP FILE IS MISSING OR NOT DISPLAYING CORRECTLY

Create columns of equal width in a TStringGrid

Problem/Question/Abstract:

How to create columns of equal width in a TStringGrid

Answer:

The main problem we encounter, it&#8217;s that width of any object is translated to screen pixels, thus - integer value. While we try to divide the TStringGrid columns to fit the grid client area, we might get a non-integer value and a fractional remainder. Therefore, in order to compensate for the insufficient gap we got (if the total columns width is less than the grid client area) or to compensate the exceeding gap (if the total columns width exceed the grid client area), we need to adjust one or more of the columns width.

procedure WidthEqually(AGrid: TStringGrid);
var
  I, GrdWidth: Integer;
  FinalWidth: Double;
  GoOn: Boolean;
begin
  with AGrid do
  begin
    {Avoiding StringGrid to be repainted }
    Perform(WM_SETREDRAW, 0, 0);
    if FAutoWidth then
      FAutoWidth := False;
    try
      GrdWidth := Width;
      {Taking into consideration our vertical scrollbar width, if any ...}
      if IsScrollBar(AGrid, WS_VSCROLL) then
        Dec(GrdWidth, GetSystemMetrics(SM_CXVSCROLL));
      {Here we subtract additional pixels for our GridLines width}
      FinalWidth := (GrdWidth / ColCount) - (ColCount * GridLineWidth);
      {The first sizing session}
      for I := 0 to ColCount - 1 do
      begin
        Application.ProcessMessages;
        ColWidths[I] := Trunc(FinalWidth);
      end;
      {Now we need to check where we ended. Either we are right on spot,
                        meaning columns could be divided equally to fit our FinalWidth.
                        If so, we should not have any horizontal scrollbar
      or a gap between our last columns to the grid edge.}
      GoOn := True;
      {If we exceeded our FinalWidth, we start reducing widths starting
                        from our last columns.}
      if IsScrollBar(AGrid, WS_HSCROLL) then
      begin
        while GoOn do
        begin
          Application.ProcessMessages;
          for I := ColCount - 1 downto 0 do
          begin
            Application.ProcessMessages;
            ColWidths[I] := ColWidths[I] - 1;
            {We are Ok now, time to leave...}
            if not IsScrollBar(AGrid, WS_HSCROLL) then
            begin
              GoOn := False;
              Break;
            end;
          end;
        end;
      end
      else
      begin
        {If we still have a gap, we increase our ColWidths}
        while GoOn do
        begin
          Application.ProcessMessages;
          for I := ColCount - 1 downto 0 do
          begin
            Application.ProcessMessages;
            ColWidths[I] := ColWidths[I] + 1;
            {We are Ok now, time to leave...}
            if IsScrollBar(AGrid, WS_HSCROLL) then
            begin
              {We resize this column back. We don't want any horizontal scrollbar.}
              ColWidths[I] := ColWidths[I] - 1;
              GoOn := False;
              Break;
            end;
          end;
        end;
      end;
    finally
      {Unlocking our grid and repainting}
      Perform(WM_SETREDRAW, 1, 0);
      Repaint;
    end;
  end;
end;

function IsScrollBar(AGrid: TStringGrid; nFlag: Cardinal): Boolean;
begin
  Result := (GetWindowLong(AGrid.Handle, GWL_STYLE) and nFlag) <> 0;
end;

How to stream components to a TBlobField

Problem/Question/Abstract:

How to stream components to a TBlobField

Answer:

unit CompToBlobField;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, DBTables, DB, DBCtrls, FileCtrl;

type
  TFrmCompToBlobField = class(TForm)
    Table1: TTable;
    Table1TheShortInt: TSmallintField;
    Table1ZeroByteField: TBlobField;
    Table1B32_1: TBlobField;
    Table1B32_2: TBytesField;
    LbxView: TListBox;
    DataSource1: TDataSource;
    DBNavigator1: TDBNavigator;
    Table1ABlobField: TBlobField;
    Panel1: TPanel;
    BtnWrite: TButton;
    BtnRead: TButton;
    RadioGroup1: TRadioGroup;
    procedure BtnWriteClick(Sender: TObject);
    procedure BtnReadClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmCompToBlobField: TFrmCompToBlobField;

implementation

{$R *.DFM}

procedure GetHexDisplay(AData: Pointer; ASize: integer; AList: TStrings);
var
  i: Integer;
  recLen: Integer;
  tBuf: PChar;
  tLng: Integer;
  theStream: TMemoryStream;
  tStr: string;
  tStrEnd: string;
begin
  recLen := ASize;
  AList.Add(EmptyStr);
  theStream := TMemoryStream.Create;
  try
    theStream.Write(AData^, ASize);
    theStream.Seek(0, soFromBeginning);
    while (theStream.Position < theStream.Size) do
    begin
      if (recLen > (theStream.Size - theStream.Position)) then
        recLen := theStream.Size - theStream.Position;
      tBuf := AllocMem(recLen);
      try
        theStream.Read(tBuf[0], recLen);
        tStrEnd := EmptyStr;
        tStr := EmptyStr;
        for i := 0 to recLen - 1 do
        begin
          if ((i = 0) or ((i mod 16) = 0)) then
          begin
            if (i <> 0) then
            begin
              AList.Add(tStr + '|' + tStrEnd + '|');
              tStrEnd := EmptyStr;
            end;
            tStr := Format('%5X', [i]);
            tStr := tStr + ': ';
          end;
          tStr := tStr + Format('%.02X ', [Byte(tBuf[i])]);
          if (tBuf[i] < char($20)) or (tBuf[i] > char($7F)) then
            tBuf[i] := '.';
          tStrEnd := tStrEnd + tBuf[i];
        end;
      finally
        FreeMem(tBuf);
      end;
      if (tStrEnd <> EmptyStr) then
      begin
        if (Length(tStrEnd) < 16) then
        begin
          tLng := 16 - Length(tStrEnd);
          while (tLng > 0) do
          begin
            tStr := tStr + '   ';
            tStrEnd := tStrEnd + ' ';
            Dec(tLng, 1);
          end;
        end;
        AList.Add(tStr + '|' + tStrEnd + '|');
        tStrEnd := EmptyStr;
      end;
    end;
  finally
    theStream.Free;
  end;
  if (tStrEnd <> EmptyStr) then
  begin
    if (Length(tStrEnd) < 16) then
    begin
      tLng := 16 - Length(tStrEnd);
      while (tLng > 0) do
      begin
        tStr := tStr + '   ';
        tStrEnd := tStrEnd + ' ';
        Dec(tLng, 1);
      end;
    end;
    AList.Add(tStr + '|' + tStrEnd + '|');
  end;
end;

procedure TFrmCompToBlobField.BtnWriteClick(Sender: TObject);
const
  count: integer = 0;
var
  theBStream: TBlobStream;
begin
  if Sender is TComponent then
  begin
    Table1.Edit;
    theBStream := TBlobStream.Create(Table1ABlobField, bmReadWrite);
    try
      theBStream.Truncate;
      theBStream.WriteComponentRes(Components[count].Name, Components[count]);
      Inc(count);
      if count = ComponentCount then
        count := 0;
    finally
      theBStream.Free;
    end;
    Table1.Post;
  end;
end;

procedure TFrmCompToBlobField.BtnReadClick(Sender: TObject);
var
  buffer: PChar;
  lng: longint;
  theBStream: TBlobStream;
  theMStream: TMemoryStream;
begin
  LbxView.Clear;
  theBStream := TBlobStream.Create(Table1ABlobField, bmRead);
  try
    if RadioGroup1.ItemIndex = 1 then
    begin
      lng := theBStream.Size;
      buffer := AllocMem(lng);
      try
        theBStream.Read(buffer[0], lng);
        GetHexDisplay(buffer, lng, LbxView.Items);
      finally
        FreeMem(buffer)
      end;
    end
    else
    begin
      theMStream := TMemoryStream.Create;
      try
        theBStream.Seek(0, soFromBeginning);
        ObjectResourceToText(theBStream, theMStream);
        theMStream.Seek(0, soFromBeginning);
        LbxView.Items.LoadFromStream(theMStream);
      finally
        theMStream.Free;
      end;
    end;
  finally
    theBStream.Free;
  end;
end;

procedure TFrmCompToBlobField.FormCreate(Sender: TObject);
begin
  Table1.Open;
  Randomize;
end;

procedure TFrmCompToBlobField.FormDestroy(Sender: TObject);
begin
  Table1.Close;
end;

procedure TFrmCompToBlobField.DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
begin
  case Button of
    nbFirst, nbPrior, nbNext, nbLast: BtnRead.Click;
  end;
end;

procedure TFrmCompToBlobField.FormResize(Sender: TObject);
begin
  LbxView.Left := 12;
  LbxView.Width := ClientWidth - 24;
end;

end.

Create a subform control

Problem/Question/Abstract:

How to create a subform control

Answer:

Those programmers who use the Win API in their programs know that Win32 allows you to insert one dialog box into another one and you'll can deal with subdialog's controls as them were in parent dialog. The good example of it is PropertySheet. I don't know why Borland hided this ability from us and why didn't it insert 'subforming' ability in TForm control. Here I can tell how to use a form as control (subform) in other one and how to create subform controls. It will work in D2, D3 and may be D4 (unfortunatelly, I have not it and can't check). The next steps shows how to make subform component:

First, we have to make the form to be a child. For this we need to override the method CreateParams.

type
  TSubForm = class(TForm)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  end;

procedure TSubForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := WS_CHILD or WS_DLGFRAME or WS_VISIBLE or DS_CONTROL;
end;

It's enough if you will not register this control into Delphi IDE. Now you can insert TSubForm control into a form at run time as shown below:

{ ... }
with TSubForm.Create(YourForm) do
begin
  Parent := YourForm;
  Left := 8;
  Top := 8;
end;
{ ... }

Unfortunately, it's not enough if you want insert this control into Delphi IDE. You have to do next two important things for it. Override TSubForm's destructor for prevent Delphi from break when subform will be deleted at design time (by user or Delphi). It can be fixed with next code:

destructor TSubForm.Destroy;
begin
  SetDesigning(False);
  inherited Destroy;
end;

Now your subform (sure inserted into form) looks like gray rectangle. The good deal is to make subform to show it's components at design time:

constructor TSubForm.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  if csDesigning in ComponentState then
    ReadComponentRes(Self.ClassName, Self);
end;

Now you have a nice subform control which can be used at run time or design time. You can do it with any form which you wish see as subform.

Note: You can define events handler for subform and them will work. In case subform already has some event handler defined and you try redefine it, only subform's event handler will work at run time!

Full source code of the subform control:

unit SubForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus, Dialogs,
    StdCtrls;

type
  TSubForm = class(TForm)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
  end;

procedure Register;

implementation

{$R *.DFM}

procedure Register;
begin
  RegisterComponents('SubForms', [TSubForm]);
end;

constructor TSubForm.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  if (csDesigning in ComponentState) then
    ReadComponentRes(Self.ClassName, Self);
end;

destructor TSubForm.Destroy;
begin
  SetDesigning(False);
  inherited Destroy;
end;

procedure TSubForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := WS_CHILD or WS_DLGFRAME or WS_VISIBLE or DS_CONTROL;
end;

end.

Calculate the size of a record

Problem/Question/Abstract:

How to calculate the size of a record

Answer:

Here's some code where StrucGrid is a StringGrid holding the table structure in DBD-like single char indentifiers in Col1 and, if applicable, field size in Col2. SpinEdit2 holds the blocksize in byte.

procedure TMainFrm.CalculateRecordSizeClick(Sender: TObject);
var
  MaxRecs, RecSize, RecsPerBlock, FreeSpace: Longint;
  i: Integer;
begin
  RecSize := 0;
  with StrucGrid do
  begin
    for i := 0 to pred(RowCount) do
    begin
      case Cells[1, i][1] of
        'A': RecSize := RecSize + StrToInt(Cells[2, i]);
        'D', 'T', 'I', '+': RecSize := RecSize + 4;
        'N', '$', 'Y', '@': RecSize := RecSize + 8;
        'M', 'B', 'F', 'O', 'G': RecSize := RecSize + 10 + StrToInt(Cells[2, i]);
        'S': RecSize := RecSize + 2;
        'L': RecSize := RecSize + 1;
      end;
    end;
  end;
  RecsPerBlock := (SpinEdit2.Value - 6) div RecSize;
  FreeSpace := (SpinEdit2.Value - 6) - (RecSize * RecsPerBlock);
  MaxRecs := 65536 * RecsPerBlock;
  ShowMessage('Record Size is: ' + IntToStr(RecSize) + ' bytes' + #13#10
    + 'Records per Block: ' + IntToStr(RecsPerBlock) + #13#10
    + 'Unused Space per Block: ' + IntToStr(FreeSpace) + ' bytes' + #13#10
    + 'Max No of Records in Table: ' + FormatFloat('###############,', MaxRecs));
end;

How to copy a polygon region from one bitmap to another

Problem/Question/Abstract:

I have 3 Bitmaps. I copy BM2 on BM1. Then the problem: Copy a defined polygon from BM3 (or BM2) into BM1. I only want to map the defined polygon into BM1 without destroying any pixels outside the poly (within the rectangle).

Answer:

Here is one way you can try. It defines a polygon shaped clip region for the destination bitmap, then copies the origin bitmap:

{ ... }
var
  pts: array of TPoint;
  rgn: HRgn;
begin
  SetLength(pts, 4);
  pts[0] := Point(0, 0);
  pts[1] := Point(50, 20);
  pts[2] := Point(20, 50);
  pts[3] := pts[0];
  rgn := CreatePolygonRgn(pts[0], 4, Winding);
  SelectClipRgn(bm1.Canvas.Handle, rgn);
  bm1.Canvas.Copyrect(rect(0, 0, bm2.width, bm2.height),
    bm2.canvas, rect(0, 0, bm2.width, bm2.height);
    DeleteObject(rgn);
end;
{ ... }

Kwow if a date is end of month

Problem/Question/Abstract:

Kwow if a date is end of month

Answer:

It's to say: know if a date is the last day of its month.

procedure TForm1.Button1Click(Sender: TObject);

  {Devuelve TRUE si la fecha dada es el ultimo dia del mes
  Returns TRUE if the date is the last day of the month}
  function IsMonthEnd( const Day: TDateTime ): boolean;
  var
    Nada, ElDia: word;
  begin
    {Hallamos el dia del mes de la fecha +1}
    {Day of month of date+1}
    DecodeDate ( Day+ 1, Nada, Nada, ElDia );
    {Si es 1, entonces es fin de mes}
    {If is 1 then is end of month}
    Result:=( ElDia=1 );
  end;

begin
  {Ejemplo de llamada:}
  {A call Example:}
  if IsMonthEnd(Now) then ShowMessage( 'Hoy es fin de mes!+
       #10+
                                       'Today is end of the month!');
end;

The operation is as simple as to make a DecodeDate of the date + 1, this way we will obtain the following day to which we are inspecting; if it is day 1... it means that the day in question is month end.
Let us don't forget that the format TDateTime that Delphi uses uses the whole part to score the days lapsed from 12/30/1899, so if we added him a 1to the date... we will obtain the following day.

How to capture the image in a TWebBrowser

Problem/Question/Abstract:

How to capture the image in a TWebBrowser

Answer:

Here's how: It involves grabbing the Internet Explorer_Server window handle, then getting the device context of that window, then assigning the DC to a new TCanvas, and finally, calling the appropriate VCL methods.

procedure TForm1.Button1Click(Sender: TObject);
var
  ShellDocObjectView: HWND;
  InternetExplorerServer: HWND;
  WebCanvas: TCanvas;
begin
  ShellDocObjectView := FindWindowEx(WebBrowser1.Handle, 0, 'Shell DocObject View', nil);
  InternetExplorerServer := FindWindowEx(ShellDocObjectView, 0, 'Internet Explorer_Server', nil);
  WebCanvas := TCanvas.Create;
  WebCanvas.Handle := GetDC(InternetExplorerServer);
  InvalidateRect(InternetExplorerServer, nil, True);
  WebCanvas.Lock;
  Image1.Canvas.Lock;
  try
    Image1.Canvas.CopyRect(Rect(0, 0, Image1.Width, Image1.Height), WebCanvas,
      Rect(0, 0, WebBrowser1.Width, WebBrowser1.Height));
  finally
    Image1.Canvas.Unlock;
    WebCanvas.Unlock;
    ReleaseDC(InternetExplorerServer, WebCanvas.Handle);
    WebCanvas.Handle := 0;
    WebCanvas.Free;
  end;
end;

Likewise, you can call  Image1.Picture.Bitmap.SaveToFile('C:\My.bmp') to save the bitmap image
to a file.

How to use the Photoshop COM interface with Delphi

Problem/Question/Abstract:

How to use the Photoshop COM interface with Delphi

Answer:

uses
  ComObj, ActiveX, PhotoShopTypeLibrary_TLB;

var
  PS: IPhotoShopApplication;
  Unknown: IUnknown;
begin
  Result := GetActiveObject(CLASS_PhotoshopApplication, nil, Unknown);
  if (Result = MK_E_UNAVAILABLE) then
    PS := CoPhotoshopApplication.Create
  else
  begin
    { make sure no other error occurred }
    OleCheck(Result);
    OleCheck(Unknown.QueryInterface(IPhotoShopApplication, PS));
  end;
  PS.Visible := True;
end;

Accept mouse clicks only on non-transparent pixels of an image

Problem/Question/Abstract:

How to accept mouse clicks only on non-transparent pixels of an image

Answer:

Use a TImage descendant where you replace

procedure TMouseImage.CMHitTest(var Msg: TWMMouse);
begin
  inherited;
  if Assigned(PicUp) and Assigned(PicUp.Bitmap) and Transparent and
    (Msg.XPos < PicUp.Bitmap.Width) and (Msg.YPos < PicUp.Bitmap.Height) and
    (PicUp.Bitmap.Canvas.Pixels[Msg.XPos, Msg.YPos] =
    (Picture.Bitmap.TransparentColor and $FFFFFF)) then
    Msg.Result := 0;
end;

Now clicks on the control only work for non-transparent pixels even for holes in the picture.

GetDocumentation for Type Library

Problem/Question/Abstract:

Recently I developed Automation Server for reports in Word and was surprised with failure trying to get Help String for TypeLibrary

Answer:

Recently I developed Automation Server for reports in Word and was surprised with failure trying to get Help String for TypeLibrary by following code

var
  k, InfoCount: Integer;
  TypeLib: ITypeLib;
  TypeLibGUID: TGUID;
  ErrorStr: string;
  HRes: HResult;
  pbstrDocString, pbstrName: WideString;
begin
  Memo1.Lines.Clear;
  // InputGUIDString is given input string value
  TypeLibGUID := StringToGUID(InputGUIDString);
  // loads Type Library from registry
  HRes := LoadRegTypeLib(TypeLibGUID, 1, 0, 0, TypeLib);
  if Failed(HRes) then
    Exit;

  // believing in mind, that so it is in practice!
  InfoCount := TypeLib.GetTypeInfoCount;
  for k := 0 to kInfoCount - 1 do
  begin
    HRes := TypeLib.GetDocumentation(k, @pbstrName, @pbstrDocString, nil, nil);
    if Failed(HRes) then
      Continue;
    Memo1.Lines.Add(pbstrName + ': ' + pbstrDocString);
  end;

Here was no errors!
But the thing is that help string for Type Library resides beyond the range [0..kInfoCount-1] so TypeLib.GetTypeInfoCount reports about ITypeInfo count, excluding ITypeInfo for himself. Did you know about it?
To get Help String for self Type Library one must implement

TypeLib.GetDocumentation(-1, @pbstrName, @pbstrDocString, nil, nil);

Isn't it unexpectedly for Delphi programmers? I didn't found anything about it in Delphi help!

COM/OLE Object Name Utility Procedure

Problem/Question/Abstract:

COM/OLE Object Name Utility Procedure

Answer:

This procedure enables you to browse a list of Registered GUID classes from HKEY_LOCAL_MACHINE\Software\Classes\CLSID. The object name is the name as used by the Delphi function "CreateOleObject('Outlook.Application')" etc. The procedure sets a TStrings object (eg. TListBox.Items or TMemo.Lines) to the Description of the GUID (if any), the Separator (Default is "@") and the OLE object name (eg. Outlook.Application.9).

There are numerous objects in this portion of the registry, I was only interested in entries that had a "ProgID" key within. Another key of interest is "VersionIndependantProgID" which exists for certain entries. eg. Microsft Outlook has for instance ..

ProgID = Outlook.Application.9
VersionIndependantProgID = Outlook.Application

You may wish to return the version independant key instead of the actual key (up to you).

An example of use could be ....

LoadCLSID(ListBox1.Items);
ListBox1.Sorted := true;

The output looks something like
...
...
Microsoft OLE DB Service Component Data Links@DataLinks
Microsoft Organization Extension@MSExtOrganization
Microsoft OrganizationUnit Extension@MSExtOrganizationUnit
Microsoft Outlook@Outlook.Application.9
Microsoft Photo Editor 3.0 Photo@MSPhotoEd.3
Microsoft Photo Editor 3.0 Scan@MSPhotoEdScan.3
Microsoft Powerpoint Application@PowerPoint.Application.9
Microsoft PowerPoint Presentation@PowerPoint.Show.8
Microsoft PowerPoint Slide@PowerPoint.Slide.8
Microsoft PptNsRex Control@PptNsRex.PptNsRex.1
Microsoft PrintQueue Extension@MSExtPrintQueue
Microsoft Repository Class Definition@ReposClassDef.0
etc
...
...

The listing contains many interesting and unexplored possibilities.
Happy Hunting.

uses Registry;

procedure LoadCLSID(StringList: TStrings; Separator: char = '@');
const
  REGKEY = 'Software\Classes\CLSID';
var
  WinReg: TRegistry;
  KeyNames, SubKeyNames: TStringList;
  i: integer;
  KeyDesc: string;
begin
  StringList.Clear;
  KeyNames := TStringList.Create;
  SubKeyNames := TStringList.Create;
  WinReg := TRegistry.Create;
  WinReg.RootKey := HKEY_LOCAL_MACHINE;

  if WinReg.OpenKey(REGKEY, false) then
  begin
    WinReg.GetKeyNames(KeyNames);
    WinReg.CloseKey;

    // Traverse list of GUID numbers eg. {00000106-0000-0010-8000-00AA006D2EA4}
    for i := 1 to KeyNames.Count - 1 do
    begin
      // Check if key "ProgID" exists in open key ?
      if WinReg.OpenKey(REGKEY + '\' + KeyNames[i], false) then
      begin
        if WinReg.KeyExists('ProgID') then
        begin
          KeyDesc := WinReg.ReadString(''); // Read (Default) value
          WinReg.CloseKey;

          if WinReg.OpenKey(REGKEY + '\' + KeyNames[i] +
            '\ProgID', false) then
          begin
            // Add description of GUID and OLE object name to passed list
            StringList.Add(KeyDesc + Separator + WinReg.ReadString(''));
            WinReg.CloseKey;
          end;
        end
        else
          WinReg.CloseKey;
      end;
    end;
  end;

  WinReg.Free;
  SubKeyNames.Free;
  KeyNames.Free;
end;

Multi Column ListBox with Column Sorting and Resizing

Problem/Question/Abstract:

How to make Multi Column ListBox with Column Sorting and Resizing

Answer:

This is a VCL that allows multiple columns in a list box. The columns may be sorted (if the AllowSorting property is set to true) by clicking on the column header title. The column headers are set up in the Sections property. They are of type THeaderSections from the THeader component and thus may also display images from an associated image list. The items in the ListBox are semi-colon delimited fields. The fields are lined up in accordance to the Section headers and may be resized by the user at run-time.

eg.
MultiColListBox.Items.Add('John Smith;jsmith@eoh.co.za');

The fields within the item line may be retrieved individually using overloaded methods GetField() and the field index required (0 based) or the Item Index. The fields within the item line can also be set via the SetField() method.

eg.
MultiColListBox.GetField(MultiColListBox.Items[1],1) or
MultiColListBox.GetField(12,3)

Section Headers may be added and deleted programatically at run time. Use the Invalidate or Update method to realign the columns and reset the Section Event triggers afterwards.

eg.
MultiColListBox.Sections.Delete(1);
MultiColListBox.Invalidate;  // Realign columns

I have one problem at design time in that I cannot find a way to call FListBox.Invalidate after the Sections property has been modified to realign the columns. There is no problem at run-time though. If anyone has a solution I would be grateful.

(I have tried to apply a SetFSections method as in
property Sections : THeaderSections read FSections write SetFSections;
but the write call does not seem to get called at all)

unit MultiColListbox;
interface

uses Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, ComCtrls,
  StdCtrls, Graphicsl;

type
  TOnContextPopup = procedure(Sender: TObject; MousePos: TPoint;
    var Handled: boolean) of object;

  TOnKeyDownUp = procedure(Sender: TObject; var Key: word;
    Shift: TShiftState) of object;

  TOnMouseDownUp = procedure(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: integer) of object;

  TOnMouseMove = procedure(Sender: TObject; Shift: TShiftState;
    X, Y: integer) of object;

  TOnKeyPress = procedure(Sender: TObject; var Key: char) of object;

  TMultiColListbox = class(TCustomPanel)
  private
    // Event Hooks
    FDelimiter: char;
    FOnMouseMove: TOnMouseMove;
    FOnMouseDown,
      FOnMouseUp: TOnMouseDownUp;
    FOnKeyPress: TOnKeyPress;
    FOnKeyUp,
      FOnKeyDown: TOnKeyDownUp;
    FOnContextPopup: TOnContextPopup;
    FOnEnter,
      FOnExit,
      FOnDblClick,
      FOnClick: TNotifyEvent;
    // Property Fields
    FCurrCol: integer;
    FAllowSorting: boolean;
    FHeaderFont,
      FFont: TFont;
    FItems: TStrings;
    FSections: THeaderSections;
    FHeader: THeaderControl;
    FListBox: TListBox;

    // Get-Set Property Methods
    procedure SetFItems(Value: TStrings);
    procedure SetFFont(Value: TFont);
    procedure SetFHeaderFont(Value: TFont);
    procedure SetFColor(Value: TColor);
    function GetFColor: TColor;
    procedure SetFExtendedSelect(Value: boolean);
    function GetFExtendedSelect: boolean;
    procedure SetFIntegralHeight(Value: boolean);
    function GetFIntegralHeight: boolean;
    procedure SetFMultiSelect(Value: boolean);
    function GetFMultiSelect: boolean;
    function GetFColCount: integer;
    function GetFSelCount: integer;
    function GetFSelected(Index: integer): boolean;
    procedure SetFSelected(Index: integer; Value: boolean);
    function GetFItemIndex: integer;
    procedure SetFItemIndex(Value: integer);
    procedure SetFHeaderHeight(Value: integer);
    function GetFHeaderHeight: integer;
    procedure SetFHeaderImages(Value: TImageList);
    function GetFHeaderImages: TImageList;
    procedure SetFAllowSorting(Value: boolean);
    procedure SetSectionEvents;

    // FListBox Event Hook Mapping
    procedure PDoClick(Sender: TObject);
    procedure PDoDblClick(Sender: TObject);
    procedure PDoEnter(Sender: TObject);
    procedure PDoExit(Sender: TObject);
    procedure PDoContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: boolean);
    procedure PDoKeyDown(Sender: TObject; var Key: word;
      Shift: TShiftState);
    procedure PDoKeyUp(Sender: TObject; var Key: word;
      Shift: TShiftState);
    procedure PDoKeyPress(Sender: TObject; var Key: char);
    procedure PDoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure PDoMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure PDoMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: integer);
  protected
    // Internal Calls
    procedure ListBoxDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure SectionResize(HeaderControl: THeaderControl;
      Section: THeaderSection);
    procedure HeaderResize(Sender: TObject);
    procedure SectionClick(HeaderControl: THeaderControl;
      Section: THeaderSection);
    function XtractField(var Source: string): string;
    procedure QuickSort(Lo, Hi: integer; CC: TStrings);
    procedure Loaded; override;
  public
    { Public declarations }
    // TCustomPanel Virtual Method Overrides
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Invalidate; override;
    procedure Update; override;
    procedure SetFocus; override;

    procedure Sort;
    function GetField(const Line: string; FieldIndex: integer): string; overload;
    function GetField(LineIndex, FieldIndex: integer): string; overload;
    procedure SetField(const NewValue: string;
      LineIndex, FieldIndex: integer);
    property ColCount: integer read GetFColCount;
    property SelCount: integer read GetFSelCount;
    property Selected[Index: integer]: boolean read GetFSelected
    write SetFSelected;
    property ItemIndex: integer read GetFItemIndex write SetFItemIndex;
  published
    // THeader Properties
    property Sections: THeaderSections read FSections write FSections;
    property HeaderFont: TFont read FHeaderFont write SetFHeaderFont;
    property HeaderHeight: integer read GetFHeaderHeight
      write SetFHeaderHeight;
    property HeaderImages: TImageList read GetFHeaderImages
      write SetFHeaderImages;

    // TListBox Properties
    property Delimiter: char read FDelimiter write FDelimiter;
    property Items: TStrings read FItems write SetFItems;
    property Font: TFont read FFont write SetFFont;
    property Color: TColor read GetFColor write SetFColor;
    property ExtendedSelect: boolean read GetFExtendedSelect
      write SetFExtendedSelect;
    property IntegralHeight: boolean read GetFIntegralHeight
      write SetFIntegralHeight;
    property MultiSelect: boolean read GetFMultiSelect
      write SetFMultiSelect;
    property AllowSorting: boolean read FAllowSorting
      write SetFAllowSorting;

    // TListBox Events
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnContextPopup: TOnContextPopup read FOnContextPopup
      write FOnContextPopup;
    property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
    property OnExit: TNotifyEvent read FOnExit write FOnExit;
    property OnKeyDown: TOnKeyDownUp read FOnKeyDown write FOnKeyDown;
    property OnKeyUp: TOnKeyDownUp read FOnKeyUp write FOnKeyUp;
    property OnKeyPress: TOnKeyPress read FOnKeyPress write FOnKeyPress;
    property OnMouseDown: TOnMouseDownUp read FOnMouseDown
      write FOnMouseDown;
    property OnMouseUp: TOnMouseDownUp read FOnMouseUp write FOnMouseUp;
    property OnMouseMove: TOnMouseMove read FOnMouseMove write FOnMouseMove;

    // Expose required parent properties
    property Align;
    property Anchors;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BorderStyle;
    property BorderWidth;
    property Constraints;
    property Enabled;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
  end;

procedure Register;

// -------------------------------------------------------------------------
implementation

procedure Register;
begin
  RegisterComponents('MahExtra', [TMultiColListbox]);
end;

// ===================================
// Return Count of a char in a string
// ===================================

function CharCount(SearchChar: char; Buffer: string): integer;
var
  C, i: integer;
begin
  C := 0;
  if length(Buffer) > 0 then
    for i := 1 to length(Buffer) do
      if Buffer[i] = SearchChar then
        inc(C);
  Result := C;
end;

constructor TMultiColListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 200;
  Height := 110;
  Caption := '';
  BevelOuter := bvNone;
  FAllowSorting := false;
  FCurrCol := 0;
  FDelimiter := ';';

  // THeaderSection
  FHeader := THeaderControl.Create(self);
  FHeader.Parent := self;
  FSections := FHeader.Sections;
  FHeaderFont := FHeader.Font;

  // TListBox
  FListBox := TListBox.Create(self);
  FListBox.Parent := self;
  FListBox.Align := alClient;
  FListBox.Style := lbOwnerDrawFixed;
  FListBox.OnDrawItem := ListBoxDrawItem;
  FListBox.OnClick := PDoClick;
  FListBox.OnDblClick := PDoDblClick;
  FListBox.OnContextPopup := PDoContextPopup;
  FListBox.OnEnter := PDoEnter;
  FListBox.OnExit := PDoExit;
  FListBox.OnKeyDown := PDoKeyDown;
  FListBox.OnKeyUp := PDoKeyUp;
  FListBox.OnKeyPress := PDoKeyPress;
  FListBox.OnMouseDown := PDoMouseDown;
  FListBox.OnMouseUp := PDoMouseUp;
  FListBox.OnMouseMove := PDoMouseMove;
  FItems := FListBox.Items;
  FFont := FListBox.Font;
end;

destructor TMultiColListBox.Destroy;
begin
  FHeader.Free;
  FListBox.Free;
  inherited Destroy;
end;

procedure TMultiColListBox.Loaded;
begin
  inherited Loaded;
  SetSectionEvents;
  if FAllowSorting and
    (FListBox.Items.Count > 0) then
    QuickSort(0, FListBox.Items.Count - 1, FListBox.Items);
end;

procedure TMultiColListBox.SetFocus;
begin
  inherited SetFocus;
  FListBox.SetFocus;
end;

// =================================================================
// If Component Invalidate or Update methods are called
// then reassign any THeaderSections events and repaint ListBox
// =================================================================

procedure TMultiColListBox.Invalidate;
begin
  inherited Invalidate;
  if not (csDesigning in ComponentState) and
    (FListBox <> nil) then
  begin
    SetSectionEvents;
    FListBox.Invalidate;
  end;
end;

procedure TMultiColListBox.Update;
begin
  inherited Update;
  if not (csDesigning in ComponentState) and
    (FListBox <> nil) then
  begin
    SetSectionEvents;
    FListBox.Invalidate;
  end;
end;

// =====================================================================
// Assign OnClick etc. Event Handlers to ALL created THeaderSections
// =====================================================================

procedure TMultiColListBox.SetSectionEvents;
var
  i: integer;
begin
  if not (csDesigning in ComponentState) then
  begin
    FHeader.OnSectionResize := SectionResize;
    FHeader.OnResize := HeaderResize;
    FHeader.OnSectionClick := SectionClick;
    for i := 0 to FHeader.Sections.Count - 1 do
      FHeader.Sections.Items[i].AllowClick := FAllowSorting;
  end;
end;

// =========================================================================
// Return the field denoted by Index from line of ";" delimited item string
// =========================================================================

function TMultiColListBox.GetField(const Line: string;
  FieldIndex: integer): string;
var
  i: integer;
  S, L: string;
begin
  L := Line;
  for i := 0 to FieldIndex do
    S := XTractField(L);
  Result := S;
end;

function TMultiColListBox.GetField(LineIndex, FieldIndex: integer): string;
var
  Retvar: string;
begin
  Retvar := '';
  LineIndex := abs(LineIndex);

  if (Items.Count > 0) and (LineIndex <= Items.Count - 1) then
  begin
    Retvar := GetField(Items[LineIndex], FieldIndex);
  end;

  Result := Retvar;
end;

// =========================================================================
// Set the field denoted by Index to new value
// =========================================================================

procedure TMultiColListBox.SetField(const NewValue: string;
  LineIndex, FieldIndex: integer);
var
  i, DCount: integer;
  S, L: string;
begin
  LineIndex := abs(LineIndex);

  if (Items.Count > 0) and (LineIndex <= Items.Count - 1) then
  begin
    S := '';
    L := Items[LineIndex];
    DCount := CharCount(FDelimiter, L);

    for i := 0 to DCount do
    begin
      if i = FieldIndex then
        S := S + NewValue
      else
        S := S + XTractField(L);

      if i < DCount then
        S := S + FDelimiter;
    end;

    Items[LineIndex] := S;
  end;
end;

// ==============================================
// INTERNAL CALL
// General Recursive quick sort routine.
// ==============================================

procedure TMultiColListBox.QuickSort(Lo, Hi: integer; CC: TStrings);

  procedure sort(l, r: integer);
  var
    i, j: integer;
    x, Tmp: string;
  begin
    i := l;
    j := r;
    x := GetField(CC[(l + r) div 2], FCurrCol);
    repeat
      while GetField(CC[i], FCurrCol) < x do
        inc(i);
      while x < GetField(CC[j], FCurrCol) do
        dec(j);
      if i <= j then
      begin
        Tmp := CC[j];
        CC[j] := CC[i];
        CC[i] := Tmp;
        inc(i);
        dec(j);
      end;
    until i > j;
    if l < j then
      sort(l, j);
    if i < r then
      sort(i, r);
  end;

begin
  CC.BeginUpdate;
  sort(Lo, Hi);
  CC.EndUpdate;
end;

// =============================================================
// INTERNAL CALL
// Extracts a field from a string delimited by ";"
// The source string is returned with the field and ";" removed
// =============================================================

function TMultiColListBox.XtractField(var Source: string): string;
var
  Retvar: string;
  L, P: integer;
begin
  P := pos(FDelimiter, Source);

  if P = 0 then
  begin
    RetVar := Source;
    Source := '';
  end
  else
  begin
    RetVar := '';
    L := length(Source);
    RetVar := copy(Source, 1, P - 1);
    L := L - (length(RetVar) + 1);
    Source := copy(Source, P + 1, L);
  end;

  Result := Retvar;
end;

// =====================================================
// ListBox OWNERDRAW routine.
// Draw the columns lined up with header control
// =====================================================

procedure TMultiColListBox.ListBoxDrawItem(Control: TWinControl;
  Index: Integer;
  Rect: TRect;
  State: TOwnerDrawState);
var
  Line: string;
  LB: TListBox;
  i: integer;
begin
  LB := (Control as TListBox);
  Line := LB.Items[Index];
  LB.Canvas.FillRect(Rect);

  if FHeader.Sections.Count = 0 then
  begin
    // No Header Sections Defined - Display raw ";" delimited
    for i := 1 to length(Line) do
      if Line[i] = FDelimiter then
        Line[i] := ' ';
    LB.Canvas.TextOut(Rect.Left + 2, Rect.Top, Line);
  end
  else
  begin
    // Align ";" delimited fields to Header Sections
    for i := 0 to FHeader.Sections.Count - 1 do
    begin
      LB.Canvas.TextOut(Rect.Left + FHeader.Sections.Items[i].Left + 2,
        Rect.Top, XTractField(Line));
    end;
  end;
end;

// ================================
// Sort the items on column 0
// ================================

procedure TMultiColListBox.Sort;
begin
  FListBox.Sorted := true;
  FListBox.Sorted := false;
end;

// ===============================
// THeaderSections Events
// ===============================

procedure TMultiColListBox.SectionResize(HeaderControl: THeaderControl;
  Section: THeaderSection);
begin
  HeaderResize(nil);
end;

procedure TMultiColListBox.HeaderResize(Sender: TObject);
begin
  FListBox.InValidate;
end;

procedure TMultiColListBox.SectionClick(HeaderControl: THeaderControl;
  Section: THeaderSection);
begin
  FCurrCol := Section.Index;
  QuickSort(0, FListBox.Items.Count - 1, FListBox.Items);
  FListBox.SetFocus;
end;

// =============================================================================
// TListBox user Event Handlers - call user action if assigned
// =============================================================================

procedure TMultiColListBox.PDoClick(Sender: TObject);
begin
  if Assigned(FOnClick) then
    FOnClick(self);
end;

procedure TMultiColListBox.PDoDblClick(Sender: TObject);
begin
  if Assigned(FOnDblClick) then
    FOnDblClick(self);
end;

procedure TMultiColListBox.PDoContextPopup(Sender: TObject;
  MousePos: TPoint;
  var Handled: Boolean);
begin
  if Assigned(FOnContextPopup) then
    FOnContextPopup(self, MousePos, Handled);
end;

procedure TMultiColListBox.PDoEnter(Sender: TObject);
begin
  if Assigned(FOnEnter) then
    FOnEnter(self);
end;

procedure TMultiColListBox.PDoExit(Sender: TObject);
begin
  if Assigned(FOnExit) then
    FOnExit(self);
end;

procedure TMultiColListBox.PDoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Assigned(FOnKeyDown) then
    FOnKeyDown(self, Key, Shift);
end;

procedure TMultiColListBox.PDoKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Assigned(FOnKeyUp) then
    FOnKeyUp(self, Key, Shift);
end;

procedure TMultiColListBox.PDoKeyPress(Sender: TObject; var Key: char);
begin
  if Assigned(FOnKeyPress) then
    FOnKeyPress(self, Key);
end;

procedure TMultiColListBox.PDoMouseDown(Sender: TObject;
  Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
begin
  if Assigned(FOnMouseDown) then
    FOnMouseDown(self, Button, Shift, X, Y);
end;

procedure TMultiColListBox.PDoMouseUp(Sender: TObject;
  Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
begin
  if Assigned(FOnMouseUp) then
    FOnMouseUp(self, Button, Shift, X, Y);
end;

procedure TMultiColListBox.PDoMouseMove(Sender: TObject;
  Shift: TShiftState;
  X, Y: integer);
begin
  if Assigned(FOnMouseMove) then
    FOnMouseMove(self, Shift, X, Y);
end;

// =========================================================================
// GET/SET Property Methods
// =========================================================================

procedure TMultiColListBox.SetFItems(Value: TStrings);
begin
  FItems.Assign(Value);
end;

procedure TMultiColListBox.SetFFont(Value: TFont);
begin
  FFont.Assign(Value);
end;

procedure TMultiColListBox.SetFHeaderFont(Value: TFont);
begin
  FHeaderFont.Assign(Value);
end;

procedure TMultiColListBox.SetFColor(Value: TColor);
begin
  FListBox.Color := Value;
end;

function TMultiColListBox.GetFColor: TColor;
begin
  Result := FListBox.Color;
end;

procedure TMultiColListBox.SetFExtendedSelect(Value: boolean);
begin
  FListBox.ExtendedSelect := Value;
end;

function TMultiColListBox.GetFExtendedSelect: boolean;
begin
  Result := FListBox.ExtendedSelect;
end;

procedure TMultiColListBox.SetFIntegralHeight(Value: boolean);
begin
  FListBox.IntegralHeight := Value;
end;

function TMultiColListBox.GetFIntegralHeight: boolean;
begin
  Result := FListBox.IntegralHeight;
end;

procedure TMultiColListBox.SetFMultiSelect(Value: boolean);
begin
  FListBox.MultiSelect := Value;
end;

function TMultiColListBox.GetFMultiSelect: boolean;
begin
  Result := FListBox.MultiSelect;
end;

function TMultiColListBox.GetFColCount: integer;
begin
  Result := FHeader.Sections.Count;
end;

function TMultiColListBox.GetFSelCount: integer;
begin
  Result := FListBox.SelCount;
end;

function TMultiColListBox.GetFSelected(Index: integer): boolean;
begin
  Result := FListBox.Selected[Index];
end;

procedure TMultiColListBox.SetFSelected(Index: integer; Value: boolean);
begin
  FListBox.Selected[Index] := Value;
end;

function TMultiColListBox.GetFItemIndex: integer;
begin
  Result := FListBox.ItemIndex;
end;

procedure TMultiColListBox.SetFItemIndex(Value: integer);
begin
  FListBox.ItemIndex := Value;
end;

procedure TMultiColListBox.SetFAllowSorting(Value: boolean);
begin
  FAllowSorting := Value;
  if not (csDesigning in ComponentState) then
    SetSectionEvents;
  if FAllowSorting and
    (FListBox.Items.Count > 0) then
    QuickSort(0, FListBox.Items.Count - 1, FListBox.Items);
end;

procedure TMultiColListBox.SetFHeaderHeight(Value: integer);
begin
  FHeader.Height := Value;
end;

function TMultiColListBox.GetFHeaderHeight: integer;
begin
  Result := FHeader.Height;
end;

procedure TMultiColListBox.SetFHeaderImages(Value: TImageList);
begin
  FHeader.Images := Value;
end;

function TMultiColListBox.GetFHeaderImages: TImageList;
begin
  Result := TImageList(FHeader.Images);
end;

{EOF}
end.

Set the Desktop as the initial directory

Problem/Question/Abstract:

In a TOpenDialog, you can set the initial directory. How do I set it as the desktop? I could set it as c:\windows\desktop, but then what if Windows is not on the user's c drive?

Answer:

There is a shell function that can be used to inquire about the location of several shell-related folders. You need to add ShlObj to the uses clause for this, plus ActiveX for the CoTaskMemFree.

procedure FreePidl(pidl: PItemIDList);
begin
  CoTaskMemFree(pidl);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  pidl: PItemIDList;
  buf: array[0..MAX_PATH] of Char;
begin
  if Succeeded(ShGetSpecialFolderLocation(Handle, CSIDL_DESKTOP, pidl)) then
  begin
    if ShGetPathfromIDList(pidl, buf) then
      ShowMessage(buf);
    FreePIDL(pidl);
  end;
end;

See win32.hlp (or better msdn.microsoft.com, the list has been extended for Win98/2000) for a list of CSIDL values. There is also a newer ShGetSpecialFolderPath API that directly returns the path, but it is not available on older Win95 and NT installations.

Insert text at a Bookmark

Problem/Question/Abstract:

How to insert text at a Bookmark

Answer:

uses
  ComObj;

procedure TForm1.Button1Click(Sender: TObject);
const
  // Word Document to open
  YourWordDocument = 'c:\test\worddoc.doc';
var
  BookmarkName, Doc, R: OleVariant;
begin
  // Start a Word instance
  try
    WordApp := CreateOleObject('Word.Application');
  except
    ShowMessage('Could not start MS Word!');
  end;
  // Open your Word document
  WordApp.Documents.Open(YourWordDocument);
  Doc := WordApp.ActiveDocument;

  // name of your bookmark
  BookmarkName := 'MyBookMark';

  // Check if bookmark exists
  if Doc.Bookmarks.Exists(BookmarkName) then
  begin
    R := Doc.Bookmarks.Item(BookmarkName).Range;
    // Add text at our bookmark
    R.InsertAfter('Text in bookmark');
    // You make a text formatting like changing its color
    R.Font.Color := clRed;
  end;

  // Save your document and quit Word
  if not VarIsEmpty(WordApp) then
  begin
    WordApp.DisplayAlerts := 0;
    WordApp.Documents.Item(1).Save;
    WordApp.Quit;
    BookmarkName := Unassigned;
    R := Unassigned;
    WordApp := Unassigned;
  end;
end;

How to position a TRichEdit control to a specific top index

Problem/Question/Abstract:

How does one position a Rich Edit control to a specific top index (e.g. Sendmessage(lbhandle, LB_SETTOPINDEX, 100, 0 works for list boxes, but is ignored by rich edits)?

Answer:

var
  firstline: Integer = 0;

procedure TForm1.Button2Click(Sender: TObject);
begin
  {record current first line}
  firstline := richedit1.perform(EM_GETFIRSTVISIBLELINE, 0, 0);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  {Scroll back to recorded position}
  with richedit1 do
    perform(em_linescroll, 0, firstline - perform(EM_GETFIRSTVISIBLELINE, 0, 0));
end;

.Net, Java or Delphi

Problem/Question/Abstract:

.Net, Java or Delphi?

Answer:

This is a response I gave to Mr. Angel Rosario, Jr. on borland.public.delphi.non-technical in regards of his concerns about the "best tool for the job". I wanted to include it in here for further reference.

"I will give you my personal point of view on the matter based on my history and the things I have seen around me. It is a difficult time but is possible to make technological decisions *today*, that may turn good regardless of what is gonna happen. I made mine and I will try to explain the whats and whys.

It's not easy to decide where to go and which boat to jump on. Neither one of the two parties, Microsoft or Linux (let's put the others aside for a second) are sure winners and I am not sure we should even attempt to predict
who will be the one at this point.

On this newsgroup the merits and the pitfalls of both have been discussed to the extreme. Stability, scalability, speed, cost, etc etc etc have been the heart of discussions for months in the non-tech. Problem is that where the market will go is not about the most scalable or stable system. It is about the perception the community has about that and the services that it offers. The one that will dominate in this two matters, will probably be the real winner but this won't mean the other will disappear.

The first concept (perception) is the heart of publicity and propaganda and is the most important. The second (services) backs the first up but is not a lead factor.

Consider what happened around us in our field in the past few years, and then look at history. Windows 95 has taken the desktop, Office has become the fact the business application suite everybody uses and finally Internet Explorer has won the browser war with the 85% of installed and used browsers. Has those products been an example of quality? I wouldn't say so, definitely at the beginning. But even if they weren't, they had something to offer and for sure they are not as bad as today's arguments make them appear. At least they delivered a service and in order to do that, they took advantage of a favorable perception that Microsoft generated around them.

There are many reasons behind what happened but the dominant is the perception users have. AOL has become what it is for the same reasons. Napster is not a real piece of art either but still, through perception and services has became so strong to deserve to be world wide news when things started to go bad. History is made by 2000 years of examples of this pattern that drove masses to any kind of things, good and bad.

This really took more lines than what I was originally thinking and I probably have gone tangents... Why I said what I said? Because at the end, no tool is gonna be so unique and revolutionary to be the one and only one. Is not like the movie Highlander. At the end, there will be more than one <G>

You mentioned Design Patterns and UML... That made me smile, because the selling reasons behind VB, .Net and Delphi are everything but things like that. The promise is about a RAD tool trough which you can develop your applications in less than 15 minutes, not a tool that allows you to apply design patterns, object oriented architectures and things like that. Is all about the perception of faster time to market, which is wrongfully associated with OnClicks.

Now, having RAD environments is a great thing. No questions about it. The problem is that this allowed the spread of all kind of bad results around us. This is not Delphi's fault but the user's. In the case of VB is a little different but still the concept applies to some degree. Many people wouldn't have that much of a problem moving their code if they would have followed the rules.

A few months ago we had to decide if we wanted to use Delphi or Visual Basic for our development. The main reason behind this question was that since we are almost 90% Microsoft based, then why shouldn't we go all the way? Well, I tell you what: at the time .Net was one of the decisional points of sticking to Delphi.
VB changed a lot in version 7. The kind of changes that have been made are more important than abandoning a set of components or introducing new ones. The changes affected the language in itself: things that are today present in every OO language such as real inheritance and OO capabilities, were not present in VB6 and would have led to a corrupted design. Code is easy to change, if things are done properly. Architectures are not.

In an ideal world, design would probably take 70% of the time while implementation is just a mundane and repetitive task. Changing the second should be easy, changing the first, most likely leads to disasters.

So we choose to Delphi because everything we do today (architecture wise) are portable to .Net, Java or whatever in the future, in case we need to. I will probably embrace .Net in the future. It has a lot to offer and I can guarantee that I'd love to do that having Delphi as underlying language. But this really doesn't matter much. Doesn't matter if it is called ADO, JDBC, ODBC or BDE... The principles behind them are the same.

I use SOAP today. I have webservices regardless of Microsoft (although I use their SOAP toolkit since mine is not finished yet <G>). We are developing a system that is scalable, well designed and efficient in Delphi using Microsoft technologies and I can assure you that the majority of the things we are doing, are gonna stay the same even if we move to .Net. The architecture is what really matters, not the tool you use to achieve the result (take out from this VB6 and previous, PowerBuilder and a few other languages).

Don't get fooled by perception, in either way. There's a lot of good stuff in .Net as well in Delphi or Java and there are things that should be done better in all of them. Focus on the services they offer. See how you can improve on what they offer if you need to. Borrow ideas from the others because even if they are very similar, they are not the same.

Good luck"

A simple class to implement multiple files "in a file"

Problem/Question/Abstract:

How do I store multiple files within one compound file?

Answer:

Microsoft have been doing this for years with the OLE compound files (used in Excel etc) and there is Delphi code to work with them available at http://www.rmarshsj.fsnet.co.uk but I wanted to reinvent this particular wheel- in particular I wanted compression and encryption (albeit fairly lightweight). I also know about Abbrevia 3 from TurboPower which is a compression toolkit that includes something similar.

The result is TcompoundVolume. It uses Bzip2, a freeware Delphi compression library by Edison Mera Men�ndez from Ecuador. I highly recommend Bzip2 which can be found on www.torry.net and in the zip file accompanying this article. It is small and fast. As the Class code for TcompoundVolume is about 1,000 lines long, I&#8217;ve not listed it but instead given examples of its use.

The intention of TcompoundVolume was to provide a convenient &#8220;sub-database&#8221; way of storing data and dynamically updating it or retrieving it. I made my life slightly more interesting by having one file rather than say an index and a data file. A simple directory structure is kept at the end of the file and rewritten after changes.

Each instance of the class  is associated with a file, and the constructor creates a blank file if the file doesn&#8217;t exits. I tend to uses two instances, one for large static data, the other for dynamic data.  

Creating an instance of the class

Comp := TCompoundVolume.Create('test.dat');

This opens or creates the volume file test.dat

To add a file &#8211; either

AddFile(Filename, Stream) or AddFileFromDisk(FileName)

Comp.AddFileFromDisk('SAMPLE\1.txt');
Comp.AddFile('names', NameStream);

Stream is any Tstream descendant so A String Stream or Memory Stream can be used.

Both Methods can have an extra parameter GroupNum which defaults to 0. GroupNum is a crude way of implementing a &#8216;directory&#8217; structure. You can add files to a group (0-255).  Two functions CVFindFirst and CVFindNext retrieve filenames from the Volume just like the FindFirst and FindNext functions for traversing folders.

var
  Er: integer;
  sg: string;

begin
  sg := '';

  Er := CVFindFirst(Group, sg, details);

  while er = 0 do
  begin
    ShowMessage(Sg);
    er := CvFindNext(Sg);
  end;

To retrieve any stored file, you need a TmemoryStream component. The object is created for you, but don&#8217;t forget to free it.

ms := comp.files['test'];
if assigned(ms) then
begin
  ShowMessage('File test is ' + inttostr(ms.size) + ' bytes long');
  ms.free;
end;

Comp. FilesString[ filename ] doers the same but returns a tstringlist,

That&#8217;s about it. There are a couple of other features worth mentioning. PackVolume() compresses the Volume by copying valid data into another file. There is also the Prefs method which lets you store string variables in the Volume. Eg Comp.Prefs[&#8216;login&#8217;] := &#8216;xxx&#8217;; This creates a file called prefs and stores the values as Name, Value pairs.

Encryption (lightweight xor) is on by default but can be disabled if the Encryption method is set false. This uses &#8220;security by obscurity&#8221; which means its not really secure! Add your own encryption if that is an issue.

Architecturally, the directory (of offsets to the start of each file) is kept at the end of the file and updated when the object is freed. So if you add a file but the object isn&#8217;t terminated correctly, perhaps due to an exception, it can corrupt the volume as the updated directory isn&#8217;t written back.

Each offset is an integer file pointer to the start of the file block which holds details about the file. These are loaded into a sorted string/object list in memory when the object is created.

This class should be considered a bit rough and ready at the beta level.  I&#8217;ve tested it with Delphi 4 & 5, but not 6 though it should work with that. It might even work with D3!

I&#8217;m sure it could be rewritten to be better. If anyone improves it, all I ask is that you email a copy to me. dhbolton@hotmail.com You are free to use it as you wish, without any licensing conditions whatsoever. It is freeware and is given to the Delphi community.  Use it freely but any risk is your risk alone. I give no warranties as to its fitness of purpose.


Component Download: cvolume.zip

Another easter egg in Delphi

Problem/Question/Abstract:

It�s always funny to find an easter egg!

Answer:

Well, it�s been a while since my last post, and since I had been missing playing around with Delphi, I found another secret on it.

I know this isn�t a high technical article, but I hope you enjoy it.

Press and hold Ctrl+Shift before starting Delphi 7, the usual splash screen will be replaced with a cool one of the Borland Team!

Convert from DateTime to RFC822 date

Problem/Question/Abstract:

I was trying to convert a DateTime value to a RFC822 style date, so I asked to Paolo, a friend of mine, if he did know how it works. He found that on the Net. It's not perfect... someone as a better one?

Answer:

function DateTimeToRFC822(DTTime: TDateTime): string;
var
  IdX: Integer;
  SaveShortDayNames: array[1..7] of string;
  SaveShortMonthNames: array[1..12] of string;
const
  MyShortDayNames: array[1..7] of string = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri',
    'Sat');
  MyShortMonthNames: array[1..12] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May',
    'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
begin
  if (ShortDayNames[1] = MyShortDayNames[1]) then
    Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', DTTime)
  else
  begin
    for IdX := Low(ShortDayNames) to High(ShortDayNames) do
    begin
      SaveShortDayNames[IdX] := ShortDayNames[IdX];
      ShortDayNames[IdX] := MyShortDayNames[IdX];
    end;
    for IdX := Low(ShortMonthNames) to High(ShortMonthNames) do
    begin
      SaveShortMonthNames[IdX] := ShortMonthNames[IdX];
      ShortMonthNames[IdX] := MyShortMonthNames[IdX];
    end;
    Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', DTTime);
    for IdX := Low(ShortDayNames) to High(ShortDayNames) do
      ShortDayNames[IdX] := SaveShortDayNames[IdX];
    for IdX := Low(ShortMonthNames) to High(ShortMonthNames) do
      ShortMonthNames[IdX] := SaveShortMonthNames[IdX];
  end;
end;

How many colors can the graphic card display?

Problem/Question/Abstract:

How many colors can the graphic card display?

Answer:

You can use WIN API function GetDeviceCaps() to calculate the number of colors supported by the current video mode. This function will return the number of maximum simultaneous colors current video device can handle. The var parameter will be set to the the number of bits per pixel or 0 in case of an error.


function GetColorsCount(var bitsperpixel: integer): longint;
var
  h: hDC;
begin
  Result := 0;
  bitsperpixel := 0;
  try
    h := GetDC(0);
    bitsperpixel := GetDeviceCaps(h, PLANES) *
      GetDeviceCaps(h, BITSPIXEL);
    Result := 1 shl bitsperpixel;
  finally
    ReleaseDC(0, h);
  end;
end;


Look at the ChangeDisplaySettings routine (in the Win32 API help) to change the mode at runtime

A flashing form

Problem/Question/Abstract:

Change the appearance of a forms caption bar from active to inactive (flashing)

Answer:

Flashes the window only once; for repeated flashing you should use e.g. a TTimer

uses
  Windows;

procedure TForm1.Button1Click(Sender: TObject);
begin
  { Handle identifies the window to be flashed }
  FlashWindow(Handle, true);
end;

After changing the registry...

Problem/Question/Abstract:

After changing the registry...

Answer:

If you change a registry entry that is being used by another application, it's a good idea to let that application know what you did so that it's able to update / refresh itself.

Just notify all running applications by sending a message to all the windows about your action as follows:

SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(PChar('RegistrySection')));

"RegistrySection" is of course the registry section which you changed.

If you're using Windows 95, you may have to use "WM_SETTINGCHANGE" message instead of "WM_WININICHANGE."

Also, it's possible to use Win32 API function "SystemParametersInfo()" to send out more specific notices about registry and/or system parameter changes you make.

Globally get rid of that annoying docking-feature

Problem/Question/Abstract:

Is it possible to globally get rid of that annoying docking-feature within the Delphi IDE ?

Answer:

Keep the Ctrl (Strg) key pressed while dragging windows.

or:

You can only turn it off on a window by window basis. Right click on the window and uncheck the Docking option.

How to display a 'Don't ask again' checkbox in a dialog box

Problem/Question/Abstract:

I was just wondering if there is a way, either with Windows API or Delphi's VCL, to get the 'Don't ask again' checkbox in a dialog box, other than creating one from scratch.

Answer:

You have to create a form, this is not a stock windows dialog. Take a look at the following unit, especially the MessageDlgWithNoMorebox function.

{
MyDialogs: Collects modified dialog functions
Author: Dr. Peter Below
Description: Version 1.01 created 4 Juli 2001, added translation of button captions.
Last modified: 4 Juli 2001
}

unit MyDialogs;

interface

uses
  Dialogs;

function DefMessageDlg(const aCaption: string; const Msg: string; DlgType:
  TMsgDlgType;
  Buttons: TMsgDlgButtons; DefButton: Integer; HelpCtx: Longint): Integer;

function MessageDlgWithNoMorebox(const aCaption: string; const Msg: string;
  DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; DefButton: Integer;
  HelpCtx: Longint; var askNoMore: Boolean): Integer;

implementation

uses
  Windows, Classes, Controls, stdctrls, sysutils, forms;

const {Copied from Dialogs}
  ModalResults: array[TMsgDlgBtn] of Integer = (mrYes, mrNo, mrOk, mrCancel, mrAbort,
    mrRetry, mrIgnore, mrAll, mrNoToAll, mrYesToAll, 0);

var {Filled during unit initialization}
  ButtonCaptions: array[TMsgDlgBtn] of string;

  {Convert a modal result to a TMsgDlgBtn code}

function ModalResultToBtn(res: TModalResult): TMsgDlgBtn;
begin
  for Result := Low(Result) to High(Result) do
  begin
    if ModalResults[Result] = res then
      exit;
  end;
  Result := mbHelp; {to remove warning only }
  Assert(False, 'ModalResultToBtn: unknown modalresult ' + IntToStr(res));
end;

{When the button captions on the message form are translated the button size and as a
consequence the button positions need to be adjusted.}

procedure AdjustButtons(aForm: TForm);
var
  buttons: TList;
  btnWidth: Integer;
  btnGap: Integer;

  procedure CollectButtons;
  var
    i: Integer;
  begin
    for i := 0 to aForm.Controlcount - 1 do
      if aForm.Controls[i] is TButton then
        buttons.Add(aForm.Controls[i]);
  end;

  procedure MeasureButtons;
  var
    i: Integer;
    textrect: TRect;
    w: Integer;
  begin
    btnWidth := TButton(buttons[0]).Width;
    aForm.Canvas.Font := aForm.Font;
    for i := 0 to buttons.count - 1 do
    begin
      TextRect := Rect(0, 0, 0, 0);
      Windows.DrawText(aform.canvas.handle, PChar(TButton(buttons[i]).Caption), -1,
        TextRect,
        DT_CALCRECT or DT_LEFT or DT_SINGLELINE);
      with TextRect do
        w := Right - Left + 16;
      if w > btnWidth then
        btnWidth := w;
    end;
    if buttons.count > 1 then
      btnGap := TButton(buttons[1]).Left - TButton(buttons[0]).Left -
        TButton(buttons[0]).Width
    else
      btnGap := 0;
  end;

  procedure SizeButtons;
  var
    i: Integer;
  begin
    for i := 0 to buttons.count - 1 do
      TButton(buttons[i]).Width := btnWidth;
  end;

  procedure ArrangeButtons;
  var
    i: Integer;
    total, left: Integer;
  begin
    total := (buttons.count - 1) * btnGap;
    for i := 0 to buttons.count - 1 do
      Inc(total, TButton(buttons[i]).Width);
    left := (aForm.ClientWidth - total) div 2;
    if left < 0 then
    begin
      aForm.Width := aForm.Width + 2 * Abs(left) + 16;
      left := 8;
    end;
    for i := 0 to buttons.count - 1 do
    begin
      TButton(buttons[i]).Left := left;
      Inc(left, btnWidth + btnGap);
    end;
  end;

begin
  buttons := TList.Create;
  try
    CollectButtons;
    if buttons.Count = 0 then
      exit;
    MeasureButtons;
    SizeButtons;
    ArrangeButtons;
  finally
    buttons.Free;
  end;
end;

procedure InitMsgForm(aForm: TForm; const aCaption: string;
  helpCtx: LongInt; DefButton: Integer);
var
  i: Integer;
  btn: TButton;
begin
  with aForm do
  begin
    if Length(aCaption) > 0 then
      Caption := aCaption;
    HelpContext := HelpCtx;
    for i := 0 to ComponentCount - 1 do
    begin
      if Components[i] is TButton then
      begin
        btn := TButton(Components[i]);
        btn.Default := btn.ModalResult = DefButton;
        if btn.Default then
          ActiveControl := Btn;
{$IFNDEF STANDARDCAPTIONS}
        btn.Caption := ButtonCaptions[ModalResultToBtn(btn.Modalresult)];
{$ENDIF}
      end;
    end;
{$IFNDEF STANDARDCAPTIONS}
    AdjustButtons(aForm);
{$ENDIF}
  end;
end;

{
DefMessageDlg:
Creates a MessageDlg with translated button captions and configurable default button and caption

Parameters:
aCaption: Caption to use for the dialog. If empty the default is used.
Msg: Message to display
DlgType: Type of dialog, see MessageDlg online help
Buttons: Buttons to display, see MessageDlg online help
DefButton: ModalResult of the button that should be the default.
HelpCtx: Help context (optional)

Returns the ModalResult of the dialog

Created 07.06.1998 by P. Below, modified 04.07.2001
}

function DefMessageDlg(const aCaption: string; const Msg: string; DlgType:
  TMsgDlgType;
  Buttons: TMsgDlgButtons; DefButton: Integer; HelpCtx: Longint): Integer;
var
  aForm: TForm;
begin
  aForm := CreateMessageDialog(Msg, DlgType, Buttons);
  try
    InitMsgForm(aForm, aCaption, helpCtx, DefButton);
    Result := aForm.ShowModal;
  finally
    aForm.Free;
  end;
end;

resourcestring
{$IFDEF GERMAN}
  AskNoMoreCaption = 'Diesen Dialog nicht mehr anzeigen';
{$ELSE}
  AskNoMoreCaption = 'Don''t show this dialog again';
{$ENDIF}

  {
  MessageDlgWithNoMorebox:
  Creates a MessageDlg with translated button captions and configurable
                default button and caption

  Parameters:
  aCaption: Caption to use for the dialog. If empty the default is used.
  Msg: Message to display
  DlgType: Type of dialog, see MessageDlg online help
  Buttons: Buttons to display, see MessageDlg online help
  DefButton: ModalResult of the button that should be the default.
  HelpCtx: Help context (optional)
  askNoMore: If this is passed in as True the function will directly return
        the DefButton result.
  Otherwise a checkbox is shown beneath the buttons which the user can check to
  not have this dialog show up in the future. Its checked state is returned in
        the parameter.

  Returns the ModalResult of the dialog

  Created 4.7.2001 by P. Below
  }

function MessageDlgWithNoMorebox(const aCaption: string; const Msg: string; DlgType:
  TMsgDlgType;
  Buttons: TMsgDlgButtons; DefButton: Integer; HelpCtx: Longint; var askNoMore:
    Boolean): Integer;
var
  aForm: TForm;
  chk: TCheckbox;
begin
  if askNoMore then
    Result := DefButton
  else
  begin
    aForm := CreateMessageDialog(Msg, DlgType, Buttons);
    try
      InitMsgForm(aForm, aCaption, helpCtx, DefButton);
      chk := TCheckbox.Create(aForm);
      chk.Parent := aForm;
      chk.SetBounds(16, aForm.ClientHeight, aForm.Clientwidth - 32, chk.Height);
      chk.Checked := False;
      chk.Caption := AskNoMoreCaption;
      AForm.Height := aForm.Height + chk.Height + 8;
      Result := aForm.ShowModal;
      askNoMore := chk.Checked;
    finally
      aForm.Free;
    end;
  end;
end;

resourcestring
{$IFDEF GERMAN}
  cmbYes = '&Ja';
  cmbNo = '&Nein';
  cmbOK = 'OK';
  cmbCancel = 'Abbrechen';
  cmbHelp = '&Hilfe';
  cmbAbort = '&Abbrechen';
  cmbRetry = '&Wiederholen';
  cmbIgnore = '&Ignorieren';
  cmbAll = '&Alle';
  cmbNoToAll = 'N&ein f�r alle';
  cmbYesToAll = 'Ja f�r &alle';
{$ELSE}
  cmbYes = '&Yes';
  cmbNo = '&No';
  cmbOK = 'OK';
  cmbCancel = 'Cancel';
  cmbHelp = '&Help';
  cmbAbort = '&Abort';
  cmbRetry = '&Retry';
  cmbIgnore = '&Ignore';
  cmbAll = '&All';
  cmbNoToAll = 'N&o to All';
  cmbYesToAll = 'Yes to &All';
{$ENDIF}

procedure InitButtonCaptions;
begin
  ButtonCaptions[mbYes] := cmbYes;
  ButtonCaptions[mbNo] := cmbNo;
  ButtonCaptions[mbOK] := cmbOK;
  ButtonCaptions[mbCancel] := cmbCancel;
  ButtonCaptions[mbAbort] := cmbAbort;
  ButtonCaptions[mbRetry] := cmbRetry;
  ButtonCaptions[mbIgnore] := cmbIgnore;
  ButtonCaptions[mbAll] := cmbAll;
  ButtonCaptions[mbNoToAll] := cmbNoToAll;
  ButtonCaptions[mbYesToAll] := cmbYesToAll;
  ButtonCaptions[mbHelp] := cmbHelp;
end;

initialization
  InitButtonCaptions;
end.

How to sort a TStringList using the Quicksort algorithm

Problem/Question/Abstract:

How to sort a TStringList using the Quicksort algorithm

Answer:

Here is a complete example, which uses a rather tricky type case to gain access to some private data of the TStringList. It does provide a method for you to use as many custom sort routines as you like in one descendant class. One thing to note is that only swaps pointers and not data so it is extremely fast even with 10000 entrys.

unit sslistu;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TStringListCompare = function(var X, Y: TStringItem): integer;
  TStringListCracker = class(TStrings)
  private
    FList: PStringItemList;
    FCount: Integer;
    FCapacity: Integer;
    FSorted: Boolean;
  end;

  TcStringList = class(TStringList)
  private
    FListptr: PStringItemList;
    procedure ExchangeItems(Index1, Index2: Integer);
    procedure QuickSort(L, R: Integer; Compare: TStringListCompare);
    procedure SetSorted(Value: Boolean);
  public
    procedure Sort(Compare: TStringListCompare); {Hide not Override}
  end;

procedure TcStringList.SetSorted(Value: Boolean);
begin
  if Sorted <> Value then
    TStringListCracker(Self).FSorted := value;
end;

procedure TcStringList.ExchangeItems(Index1, Index2: Integer);
var
  Temp: Integer;
  Item1, Item2: PStringItem;
begin
  Item1 := @FListPtr^[Index1];
  Item2 := @FListPtr^[Index2];
  Temp := Integer(Item1^.FString);
  Integer(Item1^.FString) := Integer(Item2^.FString);
  Integer(Item2^.FString) := Temp;
  Temp := Integer(Item1^.FObject);
  Integer(Item1^.FObject) := Integer(Item2^.FObject);
  Integer(Item2^.FObject) := Temp;
end;

procedure TcStringList.QuickSort(L, R: Integer; Compare: TStringListCompare);
var
  I, J: Integer;
  P: TStringItem;
begin
  repeat
    I := L;
    J := R;
    P := FListPtr^[(L + R) shr 1];
    repeat
      while Compare(FListPtr^[I], P) < 0 do
        Inc(I);
      while Compare(FListPtr^[J], P) > 0 do
        Dec(J);
      if I <= J then
      begin
        ExchangeItems(I, J);
        Inc(I);
        Dec(J);
      end;
    until
      I > J;
    if L < J then
      QuickSort(L, J, Compare);
    L := I;
  until
    I >= R;
end;

procedure TcStringList.Sort(Compare: TStringListCompare);
begin
  {trick to gain access to private data}
  FListptr := TStringListCracker(Self).FList;
  QuickSort(0, Count - 1, Compare);
end;

function Example1(var X, Y: TStringItem): integer;
begin
  Result := CompareStr(X.FString, Y.FString);
end;

function Example2(var X, Y: TStringItem): integer;
begin
  Result := CompareStr(copy(X.FString, 2, 5), copy(Y.FString, 2, 5));
end;

function Example3(var X, Y: TStringItem): integer;
begin
  if integer(X.FObject) > integer(Y.FObject) then
    result := 1
  else if integer(X.FObject) < integer(Y.FObject) then
    result := -1
  else
    result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  fSList: TcStringList;
  I, J, K, L: integer;
  s: string;
begin
  fSList := TcStringList.create;
  for I := 0 to 10000 do
  begin
    s := '';
    for K := 10 to Random(20) + 10 do
      s := s + char(random(26) + 65);
    L := random(20000);
    fSList.addobject(s, pointer(L));
  end;
  listbox1.items.add('Sorting');
  application.processmessages;
  fSList.addobject('Dennis', pointer(10000));
  fSList.Sorted := false; {disable default Sort}
  fSList.Sort(Example1); {replacement Alpha sort}
  fSList.Sorted := true; {enable Binary searching}
  listbox1.items.add('Done');
  application.processmessages;
  {if ByStringPosdata then
    fSList.Sort(Example2);
  if ByObjectValue then
    fSList.Sort(Example3);}
  listbox1.items.assign(fSList);
  showmessage('Dennis is at line number #' + inttostr(fSList.Indexof('Dennis')));
  fSList.free;
end;

end.

A detailed description of the WinHelp file format

Problem/Question/Abstract:

A detailed description of the WinHelp file format

Answer:

Windows Help File Format / Annotation File Format / SHG and MRB File Format

This documentation describes the file format parsed by HELPDECO, because
Microsoft did not publish the file formats used by WinHelp and MultiMedia
Viewers, and created by HC30, HC31, HCP, HCRTF, HCW, MVC, MMVC and WMVC.
This way it is not an official reference, but the result of many weekends
of work dumping 500+ help files and trying to understand what all the bytes
may mean.
I would like to thank Pete Davis, who first tried to describe 'The Windows
Help File Format' in Dr. Dobbs Journal, Sep/Oct 1993, and Holger Haase, who
did a lot of work on picture file formats and Bent Lynggaard for the infor-
mation on free lists in help files and unused bytes in B+ trees.

Revision 1: Fixed hash value calculation and |FONT, minor additions
Revision 2: Transparent bitmaps, {button}, and {mci} commands
Revision 3: Unknown in Paragraphinfo changed, minor additions
Revision 4: CTXOMAP corrected, bitmap dimensions dpi - not PelsPerMeter
Revision 5: MacroData in HotspotInfo added, Annotation file format added
Revision 6: [MACROS] section / internal file |Rose added, MVB font structure
Revision 7: [GROUPS] section *.GRP and [CHARTAB] section *.tbl file format
Revision 8: free list, clarified TOPICPOS/TOPICOFFSET
Revision 9: B+ tree unused bytes and what I found out about GID files

A help file starts with a header, the only structure at a fixed place

long Magic                   0x00035F3F
long DirectoryStart           offset of FILEHEADER of internal directory
long FirstFreeBlock           offset of FREEHEADER or -1L if no free list
long EntireFileSize           size of entire help file in bytes
----
char HelpFileContent[EntireFileSize-16]   the remainder of the help file

At offset DirectoryStart the FILEHEADER of the internal directory is located

long ReservedSpace             size reserved including FILEHEADER
long UsedSpace                     size of internal file in bytes
unsigned char FileFlags      normally 4
----
char FileContent[UsedSpace]  the bytes contained in the internal file
char FreeSpace[ReservedSpace-UsedSpace-9]

The FILEHEADER of the internal directory is followed by UsedSpace bytes
containing the internal directory which is used to associate FileNames and
FileOffsets. The directory is structured as a B+ tree.
A B+ tree is made from leaf-pages and index-pages of fixed size, one of which
is the root-page. All entries are contained in leaf-pages. If more entries
are required than fit into a single leaf-page, index-pages are used to locate
the leaf-page which contains the required entry.
A B+ tree starts with a BTREEHEADER telling you the size of the B+ tree pages,
the root-page, the number of levels, and the number of all entries in this
B+ tree. You must follow (NLevels-1) index-pages before you reach a leaf-page.

unsigned short Magic                0x293B
unsigned short Flags                bit 0x0002 always 1, bit 0x0400 1 if directory
unsigned short PageSize         0x0400=1k if directory, 0x0800=2k else, or 4k
char Structure[16]                string describing format of data
                                'L' = long (indexed)
                                'F' = NUL-terminated string (indexed)
                                'i' = NUL-terminated string (indexed)
                                '2' = short
                                '4' = long
                                'z' = NUL-terminated string
                                '!' = long count value, count/8 * record
                                        long filenumber
                                        long TopicOffset
short MustBeZero                0
short PageSplits                number of page splits B+ tree has suffered
short RootPage                        page number of B+ tree root page
short MustBeNegOne                0xFFFF
short TotalPages                number of B+ tree pages
short NLevels                        number of levels of B+ tree
long TotalBtreeEntries                number of entries in B+ tree
----
char Page[TotalPages][PageSize] the pages the B+ tree is made of

If NLevel is greater than 1, RootPage is the page number of an index-page.
Index-pages start with a BTREEINDEXHEADER and are followed by an array of
BTREEINDEX structures, in case of the internal directory containing pairs
of FileNames and PageNumbers.
(STRINGZ is a NUL-terminated string, sizeof(STRINGZ) is strlen(string)+1).
PageNumber gets you to the next page containing entries lexically starting
at FileName, but less than the next FileName. PreviousPage gets you to the
next page if the desired FileName is lexically before the first FileName.

unsigned short Unused         number of free bytes at end of this page
short NEntries                 number of entries in this index-page
short PreviousPage         page number of previous page
----
struct                         and this is the structure of directory index-pages
{
    STRINGZ FileName         varying length NUL-terminated string
    short PageNumber         page number of page dealing with FileName and above
}
DIRECTORYINDEXENTRY[NEntries]

After NLevels-1 of index-pages you will reach a leaf-page starting with a
BTREENODEHEADER followed by an array of BTREELEAF structures, in case of the
internal directory containing pairs of FileNames and FileOffsets.
You may follow the PreviousPage entry in all NLevels-1 index-pages to reach
the first leaf-page, then iterate thru all entries and use NextPage to
follow the double linked list of leaf-pages until NextPage is -1 to retrieve
a sorted list of all TotalBtreeEntries entries contained in the B+ tree.

unsigned short Unused         number of free bytes at end of this page
short NEntries                 number of entries in this leaf-page
short PreviousPage         page number of previous leaf-page or -1 if first
short NextPage                 page number of next leaf-page or -1 if last
----
struct                         and this is the structure of directory leaf-pages
{
    STRINGZ FileName         varying length NUL-terminated string
    long FileOffset         offset of FILEHEADER of internal file FileName
                         relative to beginning of help file
}
DIRECTORYLEAFENTRY[NEntries]

At offset FreeListBlock the first FREEHEADER is located. It contains

long FreeSpace                 number of bytes unused, including this header
long NextFreeBlock         offset of next FREEHEADER or -1L if end of list
----
char Unused[FreeSpace-8] unused bytes

All unused portions of the help file are linked together using FREEHEADERs.

Now that you are able to locate the position of an internal file in the
help file, let's describe what they contain. Remember that each FileOffset
first takes you to the FILEHEADER of the internal file. The structures
described next are located just behind this FILEHEADER.

|SYSTEM

The first one to start with is the |SYSTEM file. This is the SYSTEMHEADER,
the structure of the first bytes of this internal file:

short Magic                 0x036C
short Minor                 help file format version number
                         15 = HC30 Windows 3.0 help file
                         21 = HC31 Windows 3.1 help file
                         27 = WMVC/MMVC media view file
                         33 = MVC or HCW 4.00 Windows 95
short Major                 1
time_t GenDate                 help file created seconds after 1.1.1980, or 0
unsigned short Flags         see below

Use Minor and Flags to find out how the help file was compressed:
Minor <= 16                 not compressed, TopicBlockSize 2k
Minor > 16                 Flags=0: not compressed,  TopicBlockSize 4k
                         Flags=4: LZ77 compressed, TopicBlockSize 4k
                         Flags=8: LZ77 compressed, TopicBlockSize 2k
Additionally the help file may use phrase compression (oldstyle or Hall).

If Minor is 16 or less, the help file title follows the SYSTEMHEADER:

STRINGZ HelpFileTitle

If Minor is above 16, one or more SYSTEMREC records follow instead up to the
internal end of the |SYSTEM file:

struct
{
    unsigned short RecordType               type of data in record
    unsigned short DataSize               size of data
    ----
    char Data[DataSize]                dependent on RecordType
}
SYSTEMREC[]

There are different RecordTypes defined, each storing different Data.
They mainly contain what was specified in the help project file.

RecordType  Data
1 TITLE     STRINGZ Title               help file title
2 COPYRIGHT STRINGZ Copyright               copyright notice shown in AboutBox
3 CONTENTS  TOPICOFFSET Contents       topic offset of starting topic
4 CONFIG    STRINGZ Macro               all macros executed on opening
5 ICON            Windows *.ICO file               See WIN31WH on icon file format
6 WINDOW    struct                       Windows defined in the HPJ-file
            {
                struct
                {
                    unsigned short TypeIsValid:1
                    unsigned short NameIsValid:1
                    unsigned short CaptionIsValid:1
                    unsigned short XIsValid:1
                    unsigned short YIsValid:1
                    unsigned short WithIsValid:1
                    unsigned short HeigthIsValid:1
                    unsigned short MaximizeWindow:1
                    unsigned short RGBIsValid:1
                    unsigned short RGBNSRIsValid:1
                    unsigned short WindowsAlwaysOnTop:1
                    unsigned short AutoSizeHeight:1
                }
                Flags
                char Type[10]               type of window
                char Name[9]               window name
                char Caption[51]       caption of window
                short X                x coordinate of window (0..1000)
                short Y                y coordinate of window (0..1000)
                short Width               width of window (0..1000)
                short Height               height of window (0..1000)
                short Maximize               maximize flag and window styles
                COLORREF Rgb               color of scrollable region
                COLORREF RgbNsr        color of non scrollable region
            }
            Window
6 WINDOW    typedef struct               Viewer 2.0 Windows defined in MVP-file
            {
                unsigned short Flags
                char Type[10]                 /* type of window */
                char Name[9]                 /* window name */
                char Caption[51]         /* caption for window */
                unsigned char MoreFlags
                short X                  /* x coordinate of window (0..1000) */
                short Y                  /* y coordinate of window (0..1000) */
                short Width                 /* width of window (0..1000) */
                short Height                 /* height of window (0..1000) */
                short Maximize                 /* maximize flag and window styles */
                COLORREF Rgb1
                char Unknown
                COLORREG Rgb2
                COLORREF Rgb3
                short X2
                short Y2
                short Width2
                short Height2
                short X3
                short Y3
            }
            Window;
8 CITATION  STRINGZ Citation               the Citation printed
9 LCID            short LCID[4]               language ID, Windows 95 (HCW 4.00)
10 CNT            STRINGZ ContentFileName    CNT file name, Windows 95 (HCW 4.00)
11 CHARSET  unsigned short Charset     charset, Windows 95 (HCW 4.00)
12 DEFFONT  struct                       default dialog font, Windows 95 (HCW 4.00)
            {
                unsigned char HeightInPoints
                unsigned char Charset
                STRINGZ FontName
            }
            DefFont
12 FTINDEX  STRINGZ dtype               Multimedia Help Files dtypes
13 GROUPS   STRINGZ Group               defined GROUPs, Multimedia Help File
14 INDEX_S. STRINGZ IndexSeparators    separators, Windows 95 (HCW 4.00)
14 KEYINDEX struct                       Multimedia Help Files
            {
                char btreename[10];    btreename[1] is footnote character
                char mapname[10];
                char dataname[10];
                char title[80];
            }
            KeyIndex
18 LANGUAGE STRINGZ language               defined language, Multimedia Help Files
19 DLLMAPS  struct                       defined DLLMAPS, Multimedia Help Files
            {
                STRINGZ Win16RetailDLL
                STRINGZ Win16DebugDLL
                STRINGZ Win32RetailDLL
                STRINGZ Win32DebugDLL
            }
            DLLNames

|Phrase

If the help file is phrase compressed, it contains an internal file named
|Phrases. Windows 3.0 help files generated with HC30 use the following
uncompressed structure to store phrases. A phrase is not NUL-terminated,
instead use the next PhraseOffset to locate the end of the phrase string
(there is one more phrase offset stored than phrases are defined to allow
for this).

unsigned short NumPhrases         number of phrases in table
unsigned short OneHundred         0x0100
unsigned short PhraseOffset[NumPhrases+1] PhraseOffset[0]==2*(NumPhrases+1)
char Phrase[NumPhrases][PhraseOffset[PhraseNum+1]-PhraseOffset[PhraseNum]]

Windows 3.1 help files generated using HC31 and later always LZ77 compress
the Phrase character array. Read NumPhrases, OneHundred, DecompressedSize,
and NumPhrases+1 PhraseOffset values. Allocate DecompressedSize bytes for
the Phrase character array and decompress the UsedSpace-2*NumPhrases-10
remaining bytes into the allocated space to retrieve the phrase strings.

unsigned short NumPhrases         number of phrases in table
unsigned short OneHundred         0x0100
long DecompressedSize
unsigned short PhraseOffset[NumPhrases+1] PhraseOffset[0]==2*(NumPhrases+1)
----                                 the remaining part is LZ77 compressed
char Phrase[NumPhrases][PhraseOffset[PhraseNum+1]-PhraseOffset[PhraseNum]]

The LZ77 decompression algorithm can best be described like this:
  Take the next byte
    Start at the least significant bit
    If the bit is cleared
      Copy 1 byte from source to destination
    Else
      Get the next WORD into the struct { unsigned pos:12; unsigned len:4; }
      Copy len+3 bytes from destination-pos-1 to destination
    Loop until all bits are done
  Loop until all bytes are consumed
See end of this file for a detailed algorithm.

Some MVBs use a slightly different layout of internal |Phrases file:

unsigned short EightHundred         0x0800
unsigned short NumPhrases         number of phrases in table
unsigned short OneHundred         0x0100
long DecompressedSize
char unused[30]
unsigned short PhraseOffset[NumPhrases+1] PhraseOffset[0]==2*(NumPhrases+1)
----                                 the remaining part is LZ77 compressed
char Phrase[NumPhrases][PhraseOffset[PhraseNum+1]-PhraseOffset[PhraseNum]]

|PhrIndex

Windows 95 (HCW 4.00) may use Hall compression and the internal files
|PhrIndex and |PhrImage to store phrases. Both must be used to build a
table of phrases and PhraseOffsets. |PhrIndex starts with this header:

long Magic                         1L
long NEntries
long CompressedSize
long PhrImageSize
long PhrImageCompressedSize
long Always0                         0L
unsigned short BitCount:4
unsigned short UnknownBits:12
unsigned short Always4A00         not really always

The remaining data is bitcompressed. Use this algorithm to build a table
of PhraseOffsets:

short n,i; long mask=0,*ptr=(long *)(&always4A00+1);
int GetBit(void)
{
    ptr+=(mask<0);
    mask=mask*2+(mask<=0);
    return (*ptr&mask)!=0;
}
PhaseOffset[0]=0;
for(i=0;i<NEntries;i++)
{
    for(n=1;GetBit();n+=1<<BitCount) ;
    if(GetBit()) n+=1;
    if(BitCount>1) if(GetBit()) n+=2;
    if(BitCount>2) if(GetBit()) n+=4;
    if(BitCount>3) if(GetBit()) n+=8;
    if(BitCount>4) if(GetBit()) n+=16;
    PhraseOffset[i+1]=PhraseOffset[i]+n;
}

Just behind the bitcompressed phrase length information (on a 32-bit boundary,
that's why GetBit consumed longs) follow NumPhrases bits (one bit for each
phrase). It is assumed that this information is used for the full text search
capability to exclude certain phrases.

|PhrImage

The |PhrImage file stores the phrases. A phrase is not NUL-terminated. Use
PhraseOffset[NumPhrase] and PhraseOffset[NumPhrase+1] to locate beginning
and end of the phrase string. We generated one more PhraseOffset to allow
for this. |PhrImage is LZ77 compressed if PhrImageCompressedSize is not
equal to PhrImageSize. Otherwise you may take it as stored.

|FONT

The next internal file described is the |FONT file, which uses this header:

unsigned short NumFacenames              number of face names
unsigned short NumDescriptors              number of font descriptors
unsigned short FacenamesOffset              start of array of face names
                                      relative to &NumFacenames
unsigned short DescriptorsOffset      start of array of font descriptors
                                      relative to &NumFacenames
---                                      only if FacenamesOffset >= 12
unsigned short NumStyles              number of style descriptors
unsigned short StyleOffset              start of array of style descriptors
                                      relative to &NumFacenames
---                                      only if FacenamesOffset >= 16
unsigned short NumCharMapTables       number of character mapping tables
unsigned short CharMapTableOffset     start of array of character mapping
                                      table names relative to &NumFacenames

The face name array is located at FacenamesOffset and contains strings, which
are Windows font names or in case of multimedia files a Windows font name
concatenated with ',' and the character mapping table number. Short strings
are NUL-terminated, but a string may use all bytes for characters.

char FaceName[NumFacenames][(DescriptorsOffset-FacenamesOffset)/NumFacenames]

At DescriptorsOffset is an array located describing all fonts used in the help
file. If this kind of descriptor appears in a help file, any metric value is
given in HalfPoints.

struct oldfont
{
    struct
    {
        unsigned char Bold:1
        unsigned char Italic:1
        unsigned char Underline:1
        unsigned char StrikeOut:1
        unsigned char DoubleUnderline:1
        unsigned char SmallCaps:1
    }
    Attributes
    unsigned char HalfPoints                      PointSize * 2
    unsigned char FontFamily                      font family. See values below
    unsigned short FacenameIndex              index into FaceName array
    unsigned char FGRGB[3]                      RGB values of foreground
    unsigned char BGRGB[3]                      unused background RGB Values
}
FontDescriptor[NumDescriptors]

#define FAM_MODERN 0x01                       This is a different order than
#define FAM_ROMAN  0x02                       FF_ROMAN, FF_SWISS, etc. of
#define FAM_SWISS  0x03                       windows !
#define FAM_TECH   0x03
#define FAM_NIL    0x03
#define FAM_SCRIPT 0x04
#define FAM_DECOR  0x05

Multimedia MVB files use different structures to store font descriptors.
Assume this structure for descriptors if FacenamesOffset is at least 12.
If this kind of descriptor is used, any metric is given in twips.

struct newfont
{
    unsigned char unknown1
    short FacenameIndex
    unsigned char FGRGB[3]
    unsigned char BGRGB[3]
    unsigned char unknown5
    unsigned char unknown6
    unsigned char unknown7
    unsigned char unknown8
    unsigned char unknown9
    long Height
    unsigned char mostlyzero[12]
    short Weight
    unsigned char unknown10
    unsigned char unknown11
    unsigned char Italic
    unsigned char Underline
    unsigned char StrikeOut
    unsigned char DoubleUnderline
    unsigned char SmallCaps
    unsigned char unknown17
    unsigned char unknown18
    unsigned char PitchAndFamily      Same values as windows LOGFONT
}
FontDescriptor[NumDescriptors]

Assume this structure for descriptors if FacenamesOffset is at least 16.
If this kind of descriptor is used, any metric is given in twips.

struct mvbfont
{
    short FacenameIndex               index into Facename array
    short StyleNumber                      0 if not used
    unsigned char unknown3
    unsigned char unknown4
    unsigned char FGRGB[3]
    unsigned char BGRGB[3]
    long Height                       negative (incl. external leading)
    unsigned char mostlyzero[12]
    short Weight
    unsigned char unknown10
    unsigned char unknown11
    unsigned char Italic
    unsigned char Underline
    unsigned char StrikeOut
    unsigned char DoubleUnderline
    unsigned char SmallCaps
    unsigned char unknown17
    unsigned char unknown18
    unsigned char PitchAndFamily      Same values as windows LOGFONT
    unsigned char unknown20
    unsigned char unknown21
}
FontDescriptor[NumDescriptors]

If FacenamesOffset is at least 12, the |FONT file supports character styles.
StyleNumber-1 of the FontDescriptor indexes into this array located at
StyleOffset in |FONT.

struct
{
    short StyleNum
    short BasedOnStyleNum               0 if not used
    struct Font                        struct newfont or struct mvbfont
    char unknown[35]
    char StyleName[65]
}
Style[NumStyles]

If FacenamesOffset is at least 16, the |FONT file supports character mapping
tables.

The array of character mapping table file names is located in |FONT at
CharMapTableOffset and contains strings of the internal filename of the
character mapping table concatenated with ',' and the character mapping table
number. The entries are not sorted by character mapping table numbers. Short
strings are NUL-terminated, but a string may use up all bytes.

char CharMapTableName[NumCharMapTables][32]

|TOMAP

Windows 3.0 (HC30) uses topic numbers that start at 16 for the first topic
to identify topics. To retrieve the location of the TOPICLINK for the TOPIC-
HEADER of a certain topic (in |TOPIC explained later), use the |TOMAP file.
It contains an array of topic positions. Index with TopicNumber (do not
subtract 16). TopicPos[0] points to the topic specified as INDEX in the help
project.

TOPICPOS TopicPos[UsedSpace/4]

|CONTEXT

Windows 3.1 (HC31) uses hash values of context names to identify topics.
To get the location of the topic, search the B+ tree of the internal file
|CONTEXT:

Structure of |CONTEXT index-page entries:
struct
{
    long HashValue
    short PageNumber
}
CONTEXTINDEXENTRY[NEntries]

Structure of |CONTEXT leaf-page entries:
struct
{
    long HashValue               hash value of context id
    TOPICOFFSET TopicOffset    position
}
CONTEXTLEAFENTRY[NEntries]

To calculate the HashValue hash from a context id ptr do this:

signed char table[256]=
{
    '\x00', '\xD1', '\xD2', '\xD3', '\xD4', '\xD5', '\xD6', '\xD7',
    '\xD8', '\xD9', '\xDA', '\xDB', '\xDC', '\xDD', '\xDE', '\xDF',
    '\xE0', '\xE1', '\xE2', '\xE3', '\xE4', '\xE5', '\xE6', '\xE7',
    '\xE8', '\xE9', '\xEA', '\xEB', '\xEC', '\xED', '\xEE', '\xEF',
    '\xF0', '\x0B', '\xF2', '\xF3', '\xF4', '\xF5', '\xF6', '\xF7',
    '\xF8', '\xF9', '\xFA', '\xFB', '\xFC', '\xFD', '\x0C', '\xFF',
    '\x0A', '\x01', '\x02', '\x03', '\x04', '\x05', '\x06', '\x07',
    '\x08', '\x09', '\x0A', '\x0B', '\x0C', '\x0D', '\x0E', '\x0F',
    '\x10', '\x11', '\x12', '\x13', '\x14', '\x15', '\x16', '\x17',
    '\x18', '\x19', '\x1A', '\x1B', '\x1C', '\x1D', '\x1E', '\x1F',
    '\x20', '\x21', '\x22', '\x23', '\x24', '\x25', '\x26', '\x27',
    '\x28', '\x29', '\x2A', '\x0B', '\x0C', '\x0D', '\x0E', '\x0D',
    '\x10', '\x11', '\x12', '\x13', '\x14', '\x15', '\x16', '\x17',
    '\x18', '\x19', '\x1A', '\x1B', '\x1C', '\x1D', '\x1E', '\x1F',
    '\x20', '\x21', '\x22', '\x23', '\x24', '\x25', '\x26', '\x27',
    '\x28', '\x29', '\x2A', '\x2B', '\x2C', '\x2D', '\x2E', '\x2F',
    '\x50', '\x51', '\x52', '\x53', '\x54', '\x55', '\x56', '\x57',
    '\x58', '\x59', '\x5A', '\x5B', '\x5C', '\x5D', '\x5E', '\x5F',
    '\x60', '\x61', '\x62', '\x63', '\x64', '\x65', '\x66', '\x67',
    '\x68', '\x69', '\x6A', '\x6B', '\x6C', '\x6D', '\x6E', '\x6F',
    '\x70', '\x71', '\x72', '\x73', '\x74', '\x75', '\x76', '\x77',
    '\x78', '\x79', '\x7A', '\x7B', '\x7C', '\x7D', '\x7E', '\x7F',
    '\x80', '\x81', '\x82', '\x83', '\x0B', '\x85', '\x86', '\x87',
    '\x88', '\x89', '\x8A', '\x8B', '\x8C', '\x8D', '\x8E', '\x8F',
    '\x90', '\x91', '\x92', '\x93', '\x94', '\x95', '\x96', '\x97',
    '\x98', '\x99', '\x9A', '\x9B', '\x9C', '\x9D', '\x9E', '\x9F',
    '\xA0', '\xA1', '\xA2', '\xA3', '\xA4', '\xA5', '\xA6', '\xA7',
    '\xA8', '\xA9', '\xAA', '\xAB', '\xAC', '\xAD', '\xAE', '\xAF',
    '\xB0', '\xB1', '\xB2', '\xB3', '\xB4', '\xB5', '\xB6', '\xB7',
    '\xB8', '\xB9', '\xBA', '\xBB', '\xBC', '\xBD', '\xBE', '\xBF',
    '\xC0', '\xC1', '\xC2', '\xC3', '\xC4', '\xC5', '\xC6', '\xC7',
    '\xC8', '\xC9', '\xCA', '\xCB', '\xCC', '\xCD', '\xCE', '\xCF'
}
for(hash=0L;*ptr;ptr++) hash=(hash*43)+table[(unsigned char)*ptr];

Remember that only 0-9, A-Z, a-z, _ and . are legal characters for context ids
in Win 3.1 (HC31). Only Windows 95 (HCRTF) allows nearly all characters.
The hash value for an empty string is 1.

|CTXOMAP

If your help project file had a [MAP] section, the internal file |CTXOMAP
contains an array to assign map ids to topic offsets.

short NEntries
struct
{
    long MapID
    TOPICOFFSET TopicOffset
}
CTXOMAPENRTY[NEntries]

|xWBTREE, |xWDATA, |xWMAP, |xKWBTREE, |xKWDATA, |xKWMAP

To locate a keyword assigned using a x-footnote (x may be A-Z, a-z), use the
|xWDATA, |xWBTREE and |xWMAP internal files. |xWBTREE tells you how often a
certain Keyword is defined in the help file.

Structure of |xWBTREE index page entries:
struct
{
    STRINGZ Keyword
    short PageNumber
}
xWBTREEINDEXENTRY[NEntries]

Structure of |xWBTREE leaf page entries:
struct
{
    STRINGZ Keyword
    short Count             number of times keyword is referenced
    long KWDataOffset            this is the offset into |xWDATA
}
xWBTREELEAFENTRY[NEntries]

KWBTREE files in WinHlp32 GID files are structured differently (they have
a different description in the structure field of the BTREEHEADER) and pack
former KWBTREE and KWDATA files into one:

Structure of |xWBTREE leaf page entries in Win95 GID files:

struct
{
    STRINGZ Keyword
    long Size                    size of following record
    struct
    {
        long FileNumber     ?
        long TopicOffset    this is the offset into |xWDATA
    }
    record[Size/8]
}
xWBTREELEAFENTRY[NEntries]

The |xWDATA contains an array of topic offsets. The KWDataOffset from the
|xWBTREE tells you where to seek to in the |xWDATA file to read Count topic
offsets.

TOPICOFFSET KeywordTopicOffset[UsedSpace/4]

And the topic offset retrieved tells you which location the Keyword was
assigned to. It is -1L if the Keyword is assigned to a macro using the [MACROS]
section of HCRTF 4.0 (see description of |Rose file).

The |xWMAP contains an array that tells you where to find the n-th keyword in
the |xWBTREE. You don't need to use this file but it allows for faster
scrolling lists of alphabetically ordered Keywords. (WinHelp search dialog).

struct
{
    long KeywordNumber              number of first keyword on leaf-page
    unsigned short PageNum    B+ tree page number
}
xWMAP[UsedSpace/6]

Similarily |xKWBTREE B+ tree and |xKWDATA, |xKWMAP files (where x may be 0-9,
A-Z, a-z) are built from K-x:footnotes and [KEYINDEX] declarations of multi
media files.

|TTLBTREE

If you want to know the topic title assigned using the $-footnote, take a look
into the |TTLBTREE internal file, which contains topic titles ordered by topic
offsets in a B+ tree. (It is used by WinHelp to display the topic titles in
the search dialog).

Structure of |TTLBTREE index page entries:
struct
{
    TOPICOFFSET TopicOffset
    short PageNumber
}
TTLBTREEINDEXENTRY[NEntries]

Structure of |TTLBTREE leaf page entries:
struct
{
    TOPICOFFSET TopicOffset
    STRINGZ TopicTitle
}
TTLBTREELEAFENTRY[NEntries]

|CFn

The |CFn (where n is integer) internal file lists the macros defined in
[CONFIG:n] sections of the help project file (HCW 4.00). The file contains as
many macro strings as were specified one after another:

STRINGZ Macro[]

|Rose

The |Rose internal file contains all definitions from the [MACROS] section of a
Windows 95 (HCW 4.00) help project file. It is build using a B+ tree. Keywords
only appear using hash values but are listed in the |KWBTREE with a TopicPos in
the associated |KWDATA array of -1L.

Structure of |Rose index page entries:
struct
{
    long KeywordHash
    short PageNumber
}
RoseINDEXENTRY[NEntries]

Structure of |Rose leaf page entries:
struct
{
    long KeywordHash
    STRINGZ Macro
    STRINGZ TopicTitle                 not a real topic title but the string
                                 displayed in the search dialog where
                                 normally topic titles are listed
}
RoseLEAFENTRY[NEntries]

|TopicId

The |TopicId internal file lists the ContextName assigned to a specific topic
offset if the help file was created using the /a option of HCRTF and is build
using a B+ tree.

Structure of |TopicId index-page entries:
struct
{
    TOPICOFFSET TopicOffset
    short PageNumber
}
TopicIdINDEXENTRY[NEntries]

Structure of |TopicId leaf-page entries:
struct
{
    TOPICOFFSET TopicOffset
    STRINGZ ContextName
}
TopicIdLEAFENTRY[NEntries]

|Petra

The |Petra internal file contains a B+ tree mentioning the names of the RTF
source files the help file was build from for each topic if the help file was
created using the /a option of HCRTF.

Structure of |Petra index-page entries:
struct
{
    TOPICOFFSET TopicOffset
    short PageNumber
}
PetraINDEXENTRY[NEntries]

Structure of |Petra leaf-page entries:
struct
{
    TOPICOFFSET TopicOffset
    STRINGZ RTFSourceFileName
}
PetraLEAFENTRY[NEntries]

|Viola

The |Viola internal file contains a B+ tree specifying the default Windows
assigned to topics using the > footnote available in HCRTF 4.00.

Structure of |VIOLA index-page entries:
struct
{
    TOPICOFFSET TopicOffset
    short PageNumber
}
VIOLAINDEXENTRY[NEntries]

Structure of |VIOLA leaf-page entries:
struct
{
    TOPICOFFSET TopicOffset
    long DefaultWindowNumber
}
VIOLALEAFENTRY[NEntries]

*.GID
I have not investigated GID files, as they are created by WinHlp32 and are not
needed for help file reconstruction. But they are based on the same file format
as Windows help files, so HELPDECO may be used to display their content. Notice
the difference between |xWBTREE files stored in *.GID files and regular files.

|WinPos
This file has been seen in WinHlp32 GID files, but always contained an empty
Btree (with an unknown 'a' in the BTREEHEADER structure).

|Pete
This file has been seen in WinHlp32 GID files but is currently not understood.

|Flags
This file has been seen in WinHlp32 GID files but is currently not understood.

|CntJump
This B+ tree stored in WinHlp32 GID files contains the jump references of
the *.CNT file.

|CntText
This B+ tree stored in WinHlp32 GID files contains the topic titles of the
jumps from the *.CNT file.

*.GRP
MediaView compilers create *.GRP internal files from group + footnotes
assigned to topics. All *.GRP files follow this structure:

struct
{
    unsigned long Magic      /* 0x000A3333 */
    unsigned long BitmapSize /* max. 64000 equalling 512000 topics */
    unsigned long LastTopic  /* first topic in help file has topic number 0 */
    unsigned long FirstTopic /* first topic in help file has topic number 0 */
    unsigned long TopicsUsed /* in this group */
    unsigned long TopicCount /* in whole help file */
    unsigned long GroupType  /* 1 or 2, see below */
    unsigned long Unknown[3]
    unsigned char Bitmap[BitmapSize] /* only if GroupType equals 2 */
}
GROUP

Starting with the first topic of the help file using TopicNumber 0, a topic is
included in a group if TopicNumber is in the range of FirstTopic to LastTopic.
If GroupType equals 2 it is additionally required that the corresponding bit
starting with lsb of Bitmap[0] is set in the Bitmap.
(Bitmap[TopicNumber>>3]&(1<<(TopicNumber&7))!=0).

*.tbl

MediaView compilers store character mapping tables listed in the [CHARTAB]
section in internal *.tbl files using the following binary structure:

struct
{
    unsigned short Magic /* 0x5555 */
    unsigned short Size
    unsigned short Unknown1[2]
    unsigned short Entries
    unsigned short Ligatures
    unsigned short LigLen
    unsigned short Unknown2[13]
    struct
    {
        unsigned short class
        unsigned short order
        unsigned char normal
        unsigned char clipboard
        unsigned char mac
        unsigned char macclipboard
        unsigned short unused
    }
    charentry[Entries]
    unsigned char Ligature[Ligatures][LigLen]
}
CHARTAB

A character mapping table is assigned to a font by appending ,x (where x is a
decimal number) to the font name and the same ,x to the character mapping table
name (in the CHARMAP section of the internal |FONT file).

|TOPIC

And now to the interesting part, the internal file named |TOPIC. It's divided
into blocks of TopicBlockSize bytes, each beginning with a TOPICBLOCKHEADER:

TOPICPOS LastTopicLink          points to last topic link in previous block or -1L
TOPICPOS FirstTopicLink   points to first topic link in this block
TOPICPOS LastTopicHeader  points to topic link of last topic header or 0L, -1L
----
char PlainOrCompressedData[TopicBlockSize-12]

Read the first 12 bytes into a TOPICBLOCKHEADER structure. The remaining
TopicBlockSize-12 bytes of each topic block may be compressed using the LZ77
algorithm described above.
Decompress them into a buffer of DecompressSize bytes size if the Flags value
contained in the internal |SYSTEM file is 4 or 8 and Minor is greater than 16
(DecompressSize is 16k this way), else they are not compressed and you should
copy them as delivered (DecompressSize=TopicBlockSize-12).
Do not decompress to more than DecompressSize bytes. As this would cause
ambiguos values for TOPICPOS, the help compilers will not compress more, but
fill the remaining topic block with 0es. Data will continue in the next
topic block.

TOPICPOS

A TOPICPOS is used to locate the position of TOPICLINKs in |TOPIC and contains
the TopicBlockNumber in it's higher bits and an offset into the decompression
buffer in it's lower bits.
How many bits are used for TopicBlockNumber and TopicBlockOffset depends on
the compression method used and the TopicBlockSize:

(TOPICPOS-sizeof(TOPICBLOCKHEADER))%DecompressSize = TopicBlockOffset
(TOPICPOS-sizeof(TOPICBLOCKHEADER))/DecompressSize = TopicBlockNumber

A TOPICPOS below sizeof(TOPICBLOCKHEADER) is invalid.

TOPICLINK

A TOPICLINK (located inside the buffer after decompression, the first of it
pointed to by TOPICBLOCKHEADERs FirstTopicLink field) looks like this:

long BlockSize                  Size of TOPICLINK + LinkData1 + compressed LinkData2
long DataLen2                  length of decompressed LinkData2
TOPICPOS PrevBlock          Windows 3.0 (HC30): Number of bytes previous
                          TOPICLINK is located before this TOPICLINC,
                          including eventually skipped TOPICBLOCKHEADER and
                          unused bytes.
                          Windows 3.1 (HC31): TOPICPOS of previous TOPICLINK
TOPICPOS NextBlock          Windows 3.0 (HC30): Number of bytes next TOPICLINK
                          is located behind this TOPICLINK, incl. eventually
                          skipped TOPICBLOCKHEADER and unused bytes.
                          Windows 3.1 (HC31): TOPICPOS of next TOPICLINK
long DataLen1                  includes size of TOPICLINK
unsigned char RecordType  See below
----
char LinkData1[DataLen1-11]
char LinkData2[BlockSize-DataLen1]

LinkData2 may be compressed using Phrase compression. If you find
DataLen2>BlockSize-DataLen1 use the following algorithm to decompress
if your help file contains a |Phrases internal file:

  Take the next character. If it's value is 0 or above 15 emit it. Else
  multiply it with 256, subtract 256 and add the value of the next character.
  Divide by 2 to get the phrase number. Emit the phrase from the |Phrase file
  and append a space if the division had a remainder (the number was odd).

If the help file doesn't contain a |Phrases file but instead a |PhrIndex
and |PhrImage, it uses Hall compression and the decompression of LinkData2
is a bit more difficult:

  Take the next character (ch). If ch is even emit the phrase number ch/2.
  Else if the least two bits are 01 multiply by 64, add 64 and the value of
  the next character. Emit the Phrase using this number. If the least three
  bits are 011 copy the next ch/8+1 characters. If the least four bits are
  0111 emit ch/16+1 spaces. If the least four bits are 1111 emit ch/16+1 NUL's.

If DataLen2<=BlockSize-DataLen1 the DataLen2 bytes of LinkData2 are stored
uncompressed (makes a difference for Hall compression only).
If DataLen2<BlockSize-DataLen1 the remaining BlockSize-DataLen1-DataLen2 bytes
are unused, but must be read from the |TOPIC file (this can only happen in Hall
compressed help files).

Now that you know how to decompress the topic data, let's see what you get.
If the TOPICLINK RecordType is 2 you got a topic header in LinkData1.
In Windows 3.0 (HC30) the TOPICHEADER is structured like this:

long BlockSize                  size of topic, including internal topic links
long PrevTopicNumber          -1L or 0xFFFF at the beginning of a browse sequence
long NextTopicNumber          -1L or 0xFFFF at the end of a browse sequence

In Windows Version 3.1 (HC31) and later it looks like this:

long BlockSize                  size of topic, including internal topic links
TOPICOFFSET BrowseBck          topic offset for prev topic in browse sequence
TOPICOFFSET BrowseFor          topic offset for next topic in browse sequence
long TopicNum                  topic number
TOPICPOS NonScroll          start of non-scrolling region (topic offset) or -1L
TOPICPOS Scroll           start of scrolling region (topic offset)
TOPICPOS NextTopic          start of next type 2 record

The LinkData2 of Topic RecordType 2 contains NUL terminated strings. The
first string is the topic title, the next strings contain all macros to be
executed on opening this topic (specified using the ! footnote).

If the TOPICLINK RecordType is 1, you have a Windows 3.0 displayable text
record, a RecordType of 0x20 is Windows 3.1 displayable text and 0x23 is
a Windows 3.1 table record. A displayable text record may contain multiple
paragraphs, but all have the same paragraph formatting. A table record
stores all rows and columns of a table and may contain multiple paragraphs
of different formatting.

Data inside LinkData1 is sometimes stored as compressed shorts or longs:
  A compressed unsigned short is made of a single byte. Divide by two to get
  the value if it's even. Divide by two and add 128 times the value of the
  next byte if it's odd.
  A compressed signed short is made of a single byte. Divide by two and sub-
  tract 64 to get the value if it's even. Divide by two, add 128 times the
  value of the next byte and subtract 16384 if it's odd.
  A compressed unsigned long is made of a 2 byte value. Divide by two to get
  it's value if it's even. Divide by two and add 32768 times the value of the
  next 2 bytes if it's odd.
  A compressed signed long is made of a 2 byte value. Divide by two and sub-
  tract 16384 to get it's value if it's even. Divide by two, add 32768 times
  the value of the next 2 bytes and subtract 67108864 if it's odd.

The structure of LinkData1 in RecordType 1, 0x20, and 0x23 is difficult to
describe, as some values are only stored if a certain condition is met and
is therefore of variable size. I try to describe them as a C-structure and
note which fields are not present under certain circumstances. Don't
declare this structure. Write a parser which reads a value only if it's
condition is met.

The metric used (GapWidth, LeftIndent, etc.) is dependend upon the Font-
Descriptor used (See |FONT file). It may be HalfPoints or Twips.

compressed long TopicSize
struct                                        only in records type 0x20 and 0x23
{
    compressed unsigned short TopicLength
    struct                                only in records type 0x23
    {
        unsigned char NumberOfColumns
        unsigned char TableType         0,2=variable width, 1,3=normal
        struct                                only for TableType 0 and 2
        {
            short MinTableWidth
        }
        ForTableType0or2only
        struct
        {
            short GapWidth                LeftMargin if first column
            short ColWidth                relative in variable width tables
                                        Sum of all GapWidth/ColWidth values
                                        is 32767 in variable width tables
        }
        Column[NumberOfColumns]
    }
    RecordType0x23only
}
RecordType0x20or0x23only
struct
{
    struct                                only in RecordType 0x23
    {
        short column                        -1 if end of topic, don't continue
        short unknown
        char always0
    }
    RecordType0x23only
    unsigned char unknownUnsignedChar
    char unknownBiasedChar
    unsigned short id
    struct
    {
        unsigned short UnknownFollows:1
        unsigned short SpacingAboveFollows:1
        unsigned short SpacingBelowFollows:1
        unsigned short SpacingLinesFollows:1
        unsigned short LeftIndentFollows:1
        unsigned short RightIndentFollows:1
        unsigned short FirstlineIndentFollows:1
        unsigned short unused:1
        unsigned short BorderinfoFollows:1
        unsigned short TabinfoFollows:1
        unsigned short RightAlignedParagraph:1
        unsigned short CenterAlignedParagraph:1
    }
    bits
    compressed long  Unknown                only if UnknownFollows set
    compressed short SpacingAbove        only if SpacingAboveFollows set
    compressed short SpacingBelow        only if SpacingBelowFollows set
    compressed short SpacingLines        only if SpacingLinesFollows set
    compressed short LeftIndent         only if LeftIndentFollows set
    compressed short RightIndent        only if RightIndentFollows set
    compressed short FirstlineIndent        only if FirstlineIndentFollows set
    struct                                only if BorderinfoFollows set
    {
        unsigned char BorderBox:1
        unsigned char BorderTop:1
        unsigned char BorderLeft:1
        unsigned char BorderBottom:1
        unsigned char BorderRight:1
        unsigned char BorderThick:1
        unsigned char BorderDouble:1
        unsigned char BorderUnknown:1
        short BorderWidth
    }
    Borderinfo
    struct                                only if TabinfoFollows set
    {
        compressed short NumberOfTabStops
        struct
        {
            compressed unsigned short TabStop  position is lower 14 bits
            struct                               only if TabStop bit 0x4000 set
            {
                compressed unsigned short TabType          1=right, 2=center
            }
            onlyIfTabStopBit0x4000set
        }
        Tab[NumberOfTabStops]
    }
    Tabinfo
}
Paragraphinfo

Behind this structure LinkData1 contains character formatting information.
Always output the next string (NUL terminated) from LinkData2 (use Phrase
decompression if required), than read the next formatting command, set up
the required font, color or position before displaying the next string.
Sometimes the string is of zero length, as multiple formatting commands are
required before output.

0xFF: end of character formatting. Proceed with next Paragraphinfo if
      RecordType is 0x23, else you are done.

0x20: long vfldNumber          0 = {vfld}   n = {vfld n}

0x21: short dtypeNumber   0 = {dtype}  n = {dtype n}

0x80: short FontNumber          index into Descriptor array of internal |FONT file

0x81: line break          no firstlineindent/spacingabove on next paragraph

0x82: end of paragraph          next paragraph has same Paragraphinfo as this one

0x83: TAB                  jump to next tab stop

0x86: ewc or bmc or bmcwd or bmct or button or mci
0x87: ewl or bml or bmlwd or bmlt or button or mci_left
0x88: ewr or bmr or bmrwd or bmrt or button or mci_right
      unsigned char Type                5=embedded, 3 or 0x22=picture
      compressed long PictureSize        size of union
      struct                                only if Type = 0x22
      {
          compressed word NumberOfHotspots        Add to TopicPos if counting
      }
      OnlyIfTypeIs0x22
      union
      {
          struct
          {
              short PictureIsEmbedded        0=bmc/bmr/bml or 1=bmcwd/bmlwd/bmrwd
              short PictureNumber        only if PictureIsEmbedded = 0
              char EmbeddedPicture[PictureSize-4]
                                        only if PictureIsEmbedded = 1
                                        See 'Format of Pictures' section
          }
          Type3or0x22
          struct
          {
              short unknown1
              short unknown2
              short unknown3
              STRINGZ Embedded                Format of string depends on statement
                      DLLName,WindowClass,Param     if ewc/ewr/ewl
                      !Label,Macro                    if button
                      *n,m,[helpfilename+]filename  if mci/mci_left/mci_right
                      n=0x8400
                      n+=2 if NOPLAYBAR specified
                      n+=8 if NOMENU specified
                      m=0
                      m+=1 if PLAY specified
                      n+=2 if REPEAT specified
                      [helpfilename+] if not EXTERNAL
          }
          Type5only
      }
      PictureData                        size of union is PictureSize

0x89: end of hotspot          switch back from underlined green

0x8B: non-break-space          the blank does not appear in LinkData2

0x8C: non-break-hyphen          the hyphen itself is stored in LinkData2

0xC8: macro                  start with underlined green
0xCC: macro without font change
      short Length
      char MacroString[Length-3]

0xE0: popup jump          start with underlined green
0xE1: topic jump          start with underlined green
      TOPICOFFSET TopicOffset

0xE2: popup jump          start with underlined green
0xE3: topic jump          start with underlined green
0xE3: topic jump          start with underlined green
0xE6: popup jump without font change
0xE7: topic jump without font change
      TOPICOFFSET TopicOffset

0xEA: popup jump into external file                           start with underlined green
0xEB: popup jump into external file without font change
0xEE: topic jump into external file / secondary window           start with underlined green
0xEF: topic jump into external file / secondary window without font change
      short SizeOfFollowingStruct
      struct
      {
          unsigned char Type                0, 1, 4 or 6
          TOPICOFFSET TopicOffset
          unsigned char WindowNumber        only if Type = 1
          STRINGZ NameOfExternalFile        only if Type = 4 or 6
          STRINGZ WindowName                only if Type = 6
      }

Continue outputting strings from LinkData2 and parsing formatting commands
from LinkData1 until the 'end of character formatting' command is found.

TOPICOFFSET

A TOPICOFFSET is used since WinHelp 3.1 to locate a cursor-like position, even
in the middle of a topic. The position must be unique for hotspots (tabbing).
And it needs to be unique for every scrollable position (going 'Back' to a
topic that was scrolled). And it needs to quickly give you the topic block
to read from the help file.

Like a TOPICPOS, a TOPICOFFSET is divided into a TopicBlockNumber in it's
17 higher bits (TOPICPOS/32768) and a CharacterCount in it's 15 lower bits
(TOPICPOS%32768) counting all characters and the number of hotspots in
pictures appearing in all TOPICLINKs in the topic block before this position.
If you got a TopicOffset, seek to the TopicBlock in |TOPIC as told by the
TopicBlockNumber, read in and decompress the whole block. Use FirstTopicLink
to locate the first TOPICLINK in this decompressed block (CharacterCount is
0 at this place) and follow the list of TOPICLINKs up to the desired
position, adding TopicLength of every RecordType 0x20 and 0x23 you come
across, until adding TopicLength would exceed the desired CharacterPosition.
Your position is located in this TL_DISPLAY or TL_TABLE TOPICLINK. Expand
LinkData2 if phrase compressed and follow the formatting procedure described
above incrementing CharacterCount on every character (and NUL-terminator)
passed. Add the NumberOfHotspots if a picture is included.
If a TOPICLINK crosses a topic block, this has no effect on the TopicBlock-
Number for this TOPICLINK (i.e. a TOPICOFFSET pointing into the second part
has the TopicBlockNumber of the beginning of the TOPICLINK).
If you didn't come across a TOPICHEADER (TOPICLINK RecordType 2) in this
process, the beginning of the topic is located in a previous block. The
LastTopicHeader field of the TOPICBLOCKHEADER of the current block tells
you where to find it.

WALKING TOPICS

To follow all topics contained in the help file, set the current TOPICPOS
to 12 (that's FirstTopicLink of the first TOPICBLOCKHEADER at offset 0 in
|TOPIC) and load it's TopicBlock ((12-12)/DecompressSize = 0) and decompress.
The TOPICLINK is located at TopicBlockOffset ((12-12)%DecompressSize = 0)
in the decompression buffer. The first TOPICLINK contains the TOPICHEADER
of the first topic.
In Windows 3.0 (HC30) help files you move from one TOPICLINK to the next
by adding NextBlock to the current TOPICPOS. If the next TOPICLINK is
located in the next topic block, the value of NextBlock handles the jump
over the intervening TOPICBLOCKHEADER and possibly unused bytes nicely.
In Windows 3.1 (HC31) and later you move from one TOPICLINK to the next
by setting the current position to NextBlock, which also handles the jump
from one topic block to the other nicely.
The last TOPICLINK has NextBlock set to 0 or -1L. The last TOPICLINK does
not contain any usable data.

Format of Pictures

Inside help files Bitmaps and Metafiles are stored in lP- or lp-format. This
is the format of SHG/MRB files that SHED/MRBC produce and may contain multiple
pictures at different resolutions, each with optional additional hotspot data.
Pictures may be embedded in LinkData2 of |TOPIC or appear as |bm<x> files
(or bm<x> in case of Windows 3.0 HC30). Each picture starts with this header
data. The PictureOffset tells you where to look for the desired picture.

short Magic                                  0x506C (SHG,lP) or 0x706C (MRB,lp)
short NumberOfPictures                          >1 if multi-resolution-bitmap
long PictureOffset[NumberOfPictures]          relative to &Magic

You shouldn't depend on Magic lP/lp upon reading, as there are some MRBs
flagged like SHG, but please write correct values.

Seek to PictureOffset and you will find this:

char PictureType           5=DDB 6=DIB 8=metafile
char PackingMethod           0=uncompressed 1=RunLen 2=LZ77 3=both

If PictureType is 5 or 6 the picture is a bitmap described by:

compressed unsigned long Xdpi                    resolution in dpi, not PelsPerMeter
compressed unsigned long Ydpi                    resolution in dpi, not PelsPerMeter
compressed unsigned short Planes
compressed unsigned short BitCount
compressed unsigned long Width
compressed unsigned long Height
compressed unsigned long ColorsUsed
compressed unsigned long ColorsImportant    1 if bitmap is transparent
compressed unsigned long CompressedSize
compressed unsigned long HotspotSize            0 if none are defined
unsigned long CompressedOffset                    relative to &PictureType
unsigned long HotspotOffset                    relative to &PictureType

If PictureType is 6 a color palette follows immediatly

COLORREF palette[ColorsUsed]                    or 1<<BitCount if ColorsUsed=0

If PackingMethod is 0 copy CompressedSize bytes starting at CompressedOffset
to retrieve the bitmap data. If PackingMethod is 1 seek to CompressedOffset,
and decode CompressedSize bytes using the RunLen algorithm:
  n=getc(f); if(n&0x80) copy n&0x7F bytes, else copy next byte n times.
If PackingMethod is 2 use the LZ77 algorithm described above and if Packing-
Method is 3 first use LZ77, then RunLen to decompress.

If PictureType is 8 the picture is a metafile described by:

compressed unsigned short MappingMode
unsigned short Width
unsigned short Height
compressed unsigned long DecompressedSize   can be used to allocate buffer
compressed unsigned long CompressedSize
compressed unsigned long HotspotSize            0 if none are defined
unsigned long CompressedOffset                    relative to &PictureType
unsigned long HotspotOffset                    relative to &PictureType

Seek to CompressedOffset and decompress CompressedSize bytes as described
above to retrieve metafile data.

If HotspotSize or HotspotOffset is 0, no hotspots are defined. Otherwise
seek to HotspotOffset and retrieve HotspotSize bytes of hotspot definition
as declared below. Each macro hotspot contributes data to MacroData in a
way not fully understood at this moment.

unsigned char Always1
unsigned short NumberOfHotspots
unsigned long SizeOfMacroData
struct
{
    unsigned char id0,id1,id2;
    unsigned short x,y,w,h;
    unsigned long hash;
}
Hotspot[NumberOfHotspots]
char MacroData[SizeOfMacroData]       if SizeOfMacroData>0 the first byte
                                      of MacroData is always 2.
struct
{
    STRINGZ HotspotName
    STRINGZ ContextNameOrMacro
}
StringData[NumberOfHotspots]

Possible values of id0,id1,id2 are:
0xC8 0x00 0x00        macro visible
0xCC 0x04 0x00        macro invisible
0xE2 0x00 0x00        popup jump visible
0xE3 0x00 0x00        topic jump visible
0xE6 0x04 0x00        popup jump invisible
0xE7 0x04 0x00        topic jump invisible
0xEA 0x00 0x00        popup jump into external file visible
0xEB 0x00 0x00        topic jump into external file / secondary window visible
0xEE 0x04 0x00        popup jump into external file invisible
0xEF 0x04 0x00        topic jump into external file / secondary window invisible

The hash field is only used if id0 = 0xE2, 0xE3, 0xE6, 0xE7. It is 1 if
id0 = 0xC8 or 0xCC.
The ContextNameOrMacro contains a macro if id0 = 0xC8 or 0xCC, otherwise
it contains a ContextName (id0 = 0xE2, 0xE3, 0xE6, 0xE7) or the complete
reference ContextName>Window@File (id0 = 0xEA, 0xEB, 0xEE, 0xEF) (@File
may be missing if target is in same file).

Annotation file format

An annotation file created by WinHelp uses the same basic file format as
a Windows help file. The first 16 bytes contain the same header as a help
file, with same Magic. DirectoryStart points to a FILEHEADER of an internal
directory formatted the same way as a help file internal directory. There
are just internal files of different name and format used to collect the
annotations.

@VERSION

The first internal file described contains (after the usual FILEHEADER) 6
bytes of version info:
0x08 0x62 0x6D 0x66 0x01 0x00               (I've never seen other values)

@LINK

The @LINK internal file contains (after the usual FILEHEADER) the number of
annotations and the TOPICOFFSET of every annotation. The TopicOffset separates
into a TopicBlockNumber in it's upper bits and TopicBlockOffset pointing into
the decompression buffer in it's lower bits as explained above in the
description of the |TOPIC format and points the the first TOPICLINK following
the TOPICHEADER of the topic where the annotation belongs to.

unsigned short NumberOfAnnotations
struct
{
    unsigned long TopicOffset
    unsigned long Unknown1          // always 0
    unsigned long Unknown2          // always 0
}
AnnotationTopicRef[NumberOfAnnotations]

n!0

For each annotation the ANN file also carrys an internal file with a name like
12345!0, where 12345 is the decimal representation of the TopicOffset (as
listed in the @LINK array) where the annotation belongs to. These files
contain the annotation text as unformatted, uncompressed plain ANSI characters,
and are not NUL terminated.

That's all what I've seen in an annotation file.

*.CAC, *.AUX

Multimedia files using extensions *.CAC or *.AUX are formatted like helpfiles,
but contain only auxillary files, no |SYSTEM or |TOPIC.
Investigate them yourself. HELPDECO may be used to display or extract files
contained in them.

LZ77

You want to handle LZ77 compressed data in HLPs, MRBs, and SHGs yourself ?
Here is an algorithm to do it:

// LZ77 compression / decompression algorithm
// this is the compression Microsoft used in Windows *.HLP and *.MRB files

// so it works like Microsoft COMPRESS.EXE/EXPAND.EXE/LZEXPAND.DLL
//#define MSEXPAND

#include <stdio.h>
#include <stdlib.h>

#define N 4096
#define F 16
#define THRESHOLD 3

#define dad (node+1)
#define lson (node+1+N)
#define rson (node+1+N+N)
#define root (node+1+N+N+N)
#define NIL -1

char *buffer;
int *node;
int pos;

int insert(int i,int run)
{
    int c,j,k,l,n,match;
    int *p;

    k=l=1;
    match=THRESHOLD-1;
    p=&root[(unsigned char)buffer[i]];
    lson[i]=rson[i]=NIL;
    while((j=*p)!=NIL)
    {
        for(n=min(k,l);n<run&&(c=(buffer[j+n]-buffer[i+n]))==0;n++) ;
        if(n>match)
        {
            match=n;
            pos=j;
        }
        if(c<0)
        {
            p=&lson[j];
            k=n;
        }
        else if(c>0)
        {
            p=&rson[j];
            l=n;
        }
        else
        {
            dad[j]=NIL;
            dad[lson[j]]=lson+i-node;
            dad[rson[j]]=rson+i-node;
            lson[i]=lson[j];
            rson[i]=rson[j];
            break;
        }
    }
    dad[i]=p-node;
    *p=i;
    return match;
}

void delete(int z)
{
    int j;

    if(dad[z]!=NIL)
    {
        if(rson[z]==NIL)
        {
            j=lson[z];
        }
        else if(lson[z]==NIL)
        {
            j=rson[z];
        }
        else
        {
            j=lson[z];
            if(rson[j]!=NIL)
            {
                do
                {
                    j=rson[j];
                }
                while(rson[j]!=NIL);
                node[dad[j]]=lson[j];
                dad[lson[j]]=dad[j];
                lson[j]=lson[z];
                dad[lson[z]]=lson+j-node;
            }
            rson[j]=rson[z];
            dad[rson[z]]=rson+j-node;
        }
        dad[j]=dad[z];
        node[dad[z]]=j;
        dad[z]=NIL;
    }
}

void compress(FILE *f,FILE *out)
{
    int ch,i,run,len,match,size,mask;
    char buf[17];

    buffer=malloc(N+F+(N+1+N+N+256)*sizeof(int)); // 28.5 k !
    if(buffer)
    {
#ifdef MSEXPAND
        struct { long magic, magic2; int magic3; long filesize; } header;

        header.magic=0x44445A53L; // SZDD
        header.magic2=0x3327F088L;
        header.magic3=0x0041;
        header.filesize=filelength(fileno(f));
        fwrite(&header,sizeof(header),1,out);
#endif
        node=(int *)(buffer+N+F);
        for(i=0;i<256;i++) root[i]=NIL;
        for(i=NIL;i<N;i++) dad[i]=NIL;
        size=mask=1;
        buf[0]=0;
        i=N-F-F;
        for(len=0;len<F&&(ch=getc(f))!=-1;len++)
        {
            buffer[i+F]=ch;
            i=(i+1)&(N-1);
        }
        run=len;
        do
        {
            ch=getc(f);
            if(i>=N-F)
            {
                delete(i+F-N);
                buffer[i+F]=buffer[i+F-N]=ch;
            }
            else
            {
                delete(i+F);
                buffer[i+F]=ch;
            }
            match=insert(i,run);
            if(ch==-1)
            {
                run--;
                len--;
            }
            if(len++>=run)
            {
                if(match>=THRESHOLD)
                {
#ifdef MSEXPAND
                    buf[size++]=pos;
                    buf[size++]=((pos>>4)&0xF0)+(match-3);
#else
                    buf[0]|=mask;
                    *(int *)(buf+size)=((match-3)<<12)|((i-pos-1)&(N-1));
                    size+=2;
#endif
                    len-=match;
                }
                else
                {
#ifdef MSEXPAND
                    buf[0]|=mask;
#endif
                    buf[size++]=buffer[i];
                    len--;
                }
                if(!((mask+=mask)&0xFF))
                {
                    fwrite(buf,size,1,out);
                    size=mask=1;
                    buf[0]=0;
                }
            }
            i=(i+1)&(N-1);
        }
        while(len>0);
        if(size>1) fwrite(buf,size,1,out);
        free(buffer);
    }
}

void expand(FILE *f,FILE *out)
{
    int bits,ch,i,j,len,mask;
    char *buffer;

#ifdef MSEXPAND
    struct { long magic, magic2; int magic3; long filesize; } header;

    i=fread(&header,1,sizeof(header),f);
    if(i!=sizeof(header)||header.magic!=0x44445A53L||header.magic2!=0x3327F088L||header.magic3!=0x0041)
    {
        fwrite(&header,1,i,out);
        while((ch=getc(f))!=-1) putc(ch,out);
        return;
    }
#endif
    buffer=malloc(N);
    if(buffer)
    {
        i=N-F;
        while((bits=getc(f))!=-1)
        {
            for(mask=0x01;mask&0xFF;mask<<=1)
            {
#ifdef MSEXPAND
                if(!(bits&mask))
                {
                    j=getc(f);
                    if(j==-1) break;
                    len=getc(f);
                    j+=(len&0xF0)<<4;
                    len=(len&15)+3;
#else
                if(bits&mask)
                {
                    j=getw(f);
                    len=((j>>12)&15)+3;
                    j=(i-j-1)&(N-1);
#endif
                    while(len--)
                    {
                        putc(buffer[i]=buffer[j],out);
                        j=(j+1)&(N-1);
                        i=(i+1)&(N-1);
                    }
                }
                else
                {
                    ch=getc(f);
#ifndef MSEXPAND
                    if(ch==-1) break;
#endif
                    putc(buffer[i]=ch,out);
                    i=(i+1)&(N-1);
                }
            }
        }
        free(buffer);
    }
}

That's all I can tell you about the format of Windows 3.x/95 help files.
If you found out more, please let me know.

M. Winterhoff
100326.2776@compuserve.com