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
    INT64_LEN  = 13; 
    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;
  TSmallintArray = array [1..1000000] of SmallInt;
  PSmallintArray = ^TSmallintArray;
  TInt64Array = array [1..1000000] of INT64;
  PInt64Array = ^TInt64Array;


  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;
    INT64label: TLabel;
    Label5: 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 SelectionSortINT64s(list : PINT64Array; min, max : Longint);
    procedure SelectionSortIntegers(list : PSmallIntArray; min, max : Longint);
    function DblToString(value : Double) : String;
    function StringToDbl(txt : String; full_len : Integer) : Double;
    Function DoubleLongintToString(Value:INT64):String;
    Function StringToDoubleLongint(txt:string; FullLen: Integer):INT64;
  private
    { Private declarations }
    NumStrings       : Longint;
    StringLength     : Integer;
    List, SortedList : PStringArray;
    DoubleList       : PDoubleArray;
    LongintList      : PLongintArray;
    IntegerList      : PSmallIntArray;
    INT64List        : PInt64Array;

  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(
        'Niniejszy program ilustruje sortowanie zakodowanych łańcuchów.' + CRCR +
        'Zależnie od długości łańcuchy kodowane są do następujących typów: ' + CRCR +
        '    długość <= 13  -  INT64' + CR +
        '    długość <= 10  -  Double' + CR +
        '    długość <=  6  -  Longint' + CR +
        '    długość <=  3  -  SmallInt'
        , 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 := '';
    INT64Label.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);
        FreeMem(INT64List);
    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));
    GetMem(INT64List, NumStrings * Sizeof(Int64));

    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 := '****';

    // Sort as INT64s.
    if (StringLength <= INT64_LEN) then
    begin
        for i := 1 To NumStrings do
            INT64List^[i] := StringToDoubleLongint(list^[i], StringLength);
        start_time := Time;
        SelectionSortInt64s(INT64List, 1, NumStrings);
        stop_time := Time;
        DecodeTime(stop_time - start_time, h, m, s, ms);
        Int64Label.Caption := Format('%.2f',
            [ms / 1000.0 + s + 60 * (m + h * 60)]);
    end
    else
      INT64Label.Caption := '****';






    // Verify correctness
    for i := 2 to NumStrings do
        if (SortedList^[i - 1] > SortedList^[i]) then
        begin
            Beep;
            ShowMessage('Lista NIE została posortowana poprawnie.');
            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 + '<itd.>';

  UnsortedLabel.Caption := msg;

  msg := '';


  if StringLength <= INT64_Len then
  begin
    for i := 1 to max do
      msg := msg + SortedList^[i] +
        Format('%24d', [INT64List^[i]]) + CR;
  end;


  for i := 1 to max do
     msg := msg + SortedList^[i] + CR;


  if (NumStrings > 1000)
  then
    msg := msg + '<itd.>';

  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 : PSmallIntArray; min, max : Longint);
var
    i, j, best_j : Longint;
    best_value   : SmallInt;
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;


procedure TEncodeForm.SelectionSortINT64s(list : PINT64Array; min, max : Longint);
var
    i, j, best_j : Longint;
    best_value   : INT64;
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;


Function TEncodeForm.StringToDoubleLongint(txt:string; FullLen: Integer):INT64;
// (C) A.Grażyński
const
  MAXLEN=13;
Var
  i: integer;
  c: Char;
begin
  Result := 0;

  For i := 1 to Length(txt) do
  begin
    c := txt[i];
    if c in ['A'..'Z'] then
    begin
      Result := STRING_BASE*Result + Ord(c)-Ord('A')+1;
      if Result < 0
      then
        Raise ERangeError.Create('Zbyt długi łańcuch wejściowy');
    end
    else
      Raise ERangeError.Create('Dozwolone są tylko duże litery ''A''..''Z''');
  end;


  For i := Length(txt)+1 to fullLen do
    Result := Result*STRING_BASE;

end;



Function TEncodeForm.DoubleLongintToString(Value:INT64):String;
// (C) A.Grażyński
var
  S: ShortString;
  C: Char;
begin
  S := '';

  while Value > 0 do
  begin
    C := Chr(Value mod STRING_BASE);
    if C <> #0
    then
      Inc(C,Ord('A')-1)
    else
      C := ' ';

    S := C + S;
    Value := Value div STRING_BASE;
  end;
  Result := S;
end;



end.
