unit EncodeF;
//*******************************************************
// Example program demonstrating string encoding.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

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

const
    Double_LEN = 10;
    Longint_LEN = 6;
    Integer_LEN = 3;
    STRING_BASE = 27;
    ASC_A = 65; // ASCII code for "A"

type
  TString20 = String[20];
  TStringArray = array [1..1000000] of TString20;
  PStringArray = ^TStringArray;
  TDoubleArray = array [1..1000000] of Double;
  PDoubleArray = ^TDoubleArray;
  TLongintArray = array [1..1000000] of Longint;
  PLongintArray = ^TLongintArray;
  TIntegerArray = array [1..1000000] of Integer;
  PIntegerArray = ^TIntegerArray;

  TEncodeForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    mnuExit: TMenuItem;
    Help1: TMenuItem;
    AboutThisProgram1: TMenuItem;
    Label1: TLabel;
    Label2: TLabel;
    NumStringsText: TEdit;
    StringLengthText: TEdit;
    CmdGo: TButton;
    Label3: TLabel;
    Label4: TLabel;
    StringLabel: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    DoubleLabel: TLabel;
    LongintLabel: TLabel;
    IntegerLabel: TLabel;
    ScrollBox1: TScrollBox;
    ScrollBox2: TScrollBox;
    UnsortedLabel: TLabel;
    SortedLabel: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure AboutThisProgram1Click(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure CmdGoClick(Sender: TObject);
    procedure MakeList;
    procedure SortList;
    procedure ShowList;
    procedure SelectionSortStrings(list : PStringArray; min, max : Longint);
    procedure SelectionSortDoubles(list : PDoubleArray; min, max : Longint);
    procedure SelectionSortLongints(list : PLongintArray; min, max : Longint);
    procedure SelectionSortIntegers(list : PIntegerArray; min, max : Longint);
    function DblToString(value : Double) : String;
    function StringToDbl(txt : String; full_len : Integer) : Double;
  private
    { Private declarations }
    NumStrings       : Longint;
    StringLength     : Integer;
    List, SortedList : PStringArray;
    DoubleList       : PDoubleArray;
    LongintList      : PLongintArray;
    IntegerList      : PIntegerArray;

  public
    { Public declarations }
  end;

var
  EncodeForm: TEncodeForm;

implementation

{$R *.DFM}

procedure TEncodeForm.FormCreate(Sender: TObject);
begin
    Randomize;
end;

procedure TEncodeForm.AboutThisProgram1Click(Sender: TObject);
const
    CR = #13#10;
    CRCR = #13#10#13#10;
begin
    MessageDlg(
        'This program generates a list of random strings. It then encodes those strings as numbers and sorts them.' + CRCR +
        'The program uses different encoding methods depending on the lengths of the strings:' + CRCR +
        '    length <= 10   Double' + CR +
        '    length <= 6    Long' + CR +
        '    length <= 3    Integer'
        , mtInformation, [mbOK], 0);
end;

procedure TEncodeForm.mnuExitClick(Sender: TObject);
begin
    Close;
end;

// Start the sorting.
procedure TEncodeForm.CmdGoClick(Sender: TObject);
begin
    Screen.Cursor := crHourGlass;

    UnsortedLabel.Caption := '';
    SortedLabel.Caption := '';
    StringLabel.Caption := '';
    DoubleLabel.Caption := '';
    LongintLabel.Caption := '';
    IntegerLabel.Caption := '';
    Refresh;

    MakeList;
    SortList;
    ShowList;
    Screen.Cursor := crDefault;
end;

// Make a list of random strings.
procedure TEncodeForm.MakeList;
var
    i : Longint;
    j : Integer;
begin
    // Allocate room for the strings.
    if (NumStrings > 0) then
    begin
        FreeMem(List);
        FreeMem(SortedList);
        FreeMem(DoubleList);
        FreeMem(LongintList);
        FreeMem(IntegerList);
    end;
    NumStrings := StrToInt(NumStringsText.Text);
    StringLength := StrToInt(StringLengthText.Text);
    GetMem(List, NumStrings * Sizeof(TString20));
    GetMem(SortedList, NumStrings * Sizeof(TString20));
    GetMem(DoubleList, NumStrings * Sizeof(Double));
    GetMem(LongintList, NumStrings * Sizeof(Longint));
    GetMem(IntegerList, NumStrings * Sizeof(Integer));

    for i := 1 to NumStrings do
    begin
        List^[i] := '';
        for j := 1 to StringLength do
            List^[i] := List^[i] + Chr(ASC_A + Random(26));
    end;
end;

// Sort the list using whatever encodings are possible.
procedure TEncodeForm.SortList;
var
    start_time, stop_time : TDateTime;
    h, m, s, ms           : Word;
    i                     : Longint;
begin
    // Sort as strings.
    for i := 1 to NumStrings do SortedList^[i] := list^[i];
    start_time := Time;
    SelectionSortStrings(SortedList, 1, NumStrings);
    stop_time := Time;
    DecodeTime(stop_time - start_time, h, m, s, ms);
    StringLabel.Caption := Format('%.2f',
        [ms / 1000.0 + s + 60 * (m + h * 60)]);

    // Sort as doubles.
    if (StringLength <= Double_LEN) then
    begin
        for i := 1 To NumStrings do
            DoubleList^[i] := StringToDbl(list^[i], StringLength);
        start_time := Time;
        SelectionSortDoubles(DoubleList, 1, NumStrings);
        stop_time := Time;
        DecodeTime(stop_time - start_time, h, m, s, ms);
        DoubleLabel.Caption := Format('%.2f',
            [ms / 1000.0 + s + 60 * (m + h * 60)]);
    end else
        DoubleLabel.Caption := '****';

    // Sort as longints.
    if (StringLength <= Longint_LEN) then
    begin
        for i := 1 To NumStrings do
            LongintList^[i] := Round(StringToDbl(list^[i], StringLength));
        start_time := Time;
        SelectionSortLongints(LongintList, 1, NumStrings);
        stop_time := Time;
        DecodeTime(stop_time - start_time, h, m, s, ms);
        LongintLabel.Caption := Format('%0.2f',
            [ms / 1000.0 + s + 60 * (m + h * 60)]);
    end else
        LongintLabel.Caption := '****';

    // Sort as integers.
    if (StringLength <= Integer_LEN) then
    begin
        for i := 1 To NumStrings do
            IntegerList^[i] := Round(StringToDbl(list^[i], StringLength));
        start_time := Time;
        SelectionSortIntegers(IntegerList, 1, NumStrings);
        stop_time := Time;
        DecodeTime(stop_time - start_time, h, m, s, ms);
        IntegerLabel.Caption := Format('%.2f',
            [ms / 1000.0 + s + 60 * (m + h * 60)]);
    end else
        IntegerLabel.Caption := '****';

    // Verify correctness
    for i := 2 to NumStrings do
        if (SortedList^[i - 1] > SortedList^[i]) then
        begin
            Beep;
            ShowMessage('The list was not properly sorted.');
            exit;
        end;
end;

// Display the first 1000 items.
procedure TEncodeForm.ShowList;
const
    CR = #13#10;
var
    i, max : Longint;
    msg    : String;
begin
    if (NumStrings < 1000) then
        max := NumStrings
    else
        max := 1000;

    msg := '';
    for i := 1 to max do
        msg := msg + list^[i] + CR;
    if (NumStrings > 1000) then msg := msg + '<etc.>';
    UnsortedLabel.Caption := msg;

    msg := '';
    if (StringLength <= Double_LEN) then
    begin
        for i := 1 to max do
            msg := msg + SortedList^[i] +
                Format('%16.0f', [DoubleList^[i]]) + CR;
    end else begin
        for i := 1 to max do
            msg := msg + SortedList^[i] + CR;
    end;
    if (NumStrings > 1000) then msg := msg + '<etc.>';
    SortedLabel.Caption := msg;
end;

// Sort a string array using selectionsort.
procedure TEncodeForm.SelectionSortStrings(list : PStringArray; min, max : Longint);
var
    i, j, best_j : Longint;
    best_value   : String;
begin
    for i := min to max - 1 do
    begin
        best_value := list^[i];
        best_j := i;
        for j := i + 1 to max do
            if (list^[j] < best_value) then
            begin
                best_value := list^[j];
                best_j := j;
            end;
        list^[best_j] := list^[i];
        list^[i] := best_value;
    end;
end;

// Sort a double array using selectionsort.
procedure TEncodeForm.SelectionSortDoubles(list : PDoubleArray; min, max : Longint);
var
    i, j, best_j : Longint;
    best_value   : Double;
begin
    for i := min to max - 1 do
    begin
        best_value := list^[i];
        best_j := i;
        for j := i + 1 to max do
            if (list^[j] < best_value) then
            begin
                best_value := list^[j];
                best_j := j;
            end;
        list^[best_j] := list^[i];
        list^[i] := best_value;
    end;
end;

// Sort a long integer array using selectionsort.
procedure TEncodeForm.SelectionSortLongints(list : PLongintArray; min, max : Longint);
var
    i, j, best_j : Longint;
    best_value   : Longint;
begin
    for i := min to max - 1 do
    begin
        best_value := list^[i];
        best_j := i;
        for j := i + 1 to max do
            if (list^[j] < best_value) then
            begin
                best_value := list^[j];
                best_j := j;
            end;
        list^[best_j] := list^[i];
        list^[i] := best_value;
    end;
end;

// Sort an integer array using selectionsort.
procedure TEncodeForm.SelectionSortIntegers(list : PIntegerArray; min, max : Longint);
var
    i, j, best_j : Longint;
    best_value   : Integer;
begin
    for i := min to max - 1 do
    begin
        best_value := list^[i];
        best_j := i;
        for j := i + 1 to max do
            if (list^[j] < best_value) then
            begin
                best_value := list^[j];
                best_j := j;
            end;
        list^[best_j] := list^[i];
        list^[i] := best_value;
    end;
end;

// Turn a double string encoding back into a string.
function TEncodeForm.DblToString(value : Double) : String;
var
    ch        : Integer;
    new_value : Double;
begin
    Result := '';
    while (value > 0) do
    begin
        new_value := Round(value / STRING_BASE);
        ch := Round(value - new_value * STRING_BASE);
        if (ch <> 0) then
            Result := Chr(ch + ASC_A - 1) + Result;
        value := new_value;
    end;
end;

// Convert a string into a double encoding.
//
// full_len gives the full length of the string. For
// example, "AX" as a three character string would have
// full_len = 3.
function TEncodeForm.StringToDbl(txt : String; full_len : Integer) : Double;
var
    len, i : Integer;
    ch     : Char;
begin
    len := Length(txt);
    if (len > full_len) then len := full_len;

    Result := 0.0;
    for i := 1 to len do
    begin
        ch := txt[i];
        Result := Result * STRING_BASE +
            Ord(ch) - ASC_A + 1;
    end;

    for i := len + 1 to full_len do
        Result := Result * STRING_BASE;
end;

end.
