unit TriangC;
//*******************************************************
// Triangular array class.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
    Dialogs, SysUtils, Classes,
    ExtCtrls, Windows, Graphics;

type
    String10 = String[10];
    TStringArray = array[0..100000000] of String10;
    PStringArray = ^TStringArray;
    TTriangularArray = class(TObject)
        private
            Items       : PStringArray; // The array of items.
            Rows        : Longint;      // The number of rows.
            UseDiagonal : Boolean;      // True if the array includes the diagonal.
            function AtoB(i, j : Integer) : Integer;

        public
            constructor Create(num_rows : Integer; include_diagonal : Boolean);
            destructor Destroy; override;
            procedure SetValue(r, c : Integer; new_value : String10);
            function GetValue(r, c : Integer) : String10;
    end;

implementation

// Create the proper kind of triangular array.
constructor TTriangularArray.Create(num_rows : Integer; include_diagonal : Boolean);
begin
    if (num_rows < 1) then
        raise EInvalidOperation.Create(
            'Array must have at least one row.');

    // Allocate memory and perform inherited initialization.
    inherited Create;

    UseDiagonal := include_diagonal;

    // Allocate room for the entries.
    Rows := num_rows;

    if (UseDiagonal) then
        GetMem(Items, Round((Rows * (Rows + 1) / 2)) * SizeOf(String10))
    else
        GetMem(Items, Round((Rows * (Rows - 1) / 2)) * SizeOf(String10));
end;

// Free the array memory.
destructor TTriangularArray.Destroy;
begin
    FreeMem(Items);
    inherited Destroy;
end;

// Set an item's value.
procedure TTriangularArray.SetValue(r, c : Integer; new_value : String10);
var
    x : Integer;
begin
    x := AtoB(r, c);
    Items^[x] := new_value;
end;

// Get an item's value.
function TTriangularArray.GetValue(r, c : Integer) : String10;
var
    x : Integer;
begin
    x := AtoB(r, c);
    GetValue := Items^[x];
end;

// Convert the i and j indexes in two-dimensional array A
// into the x index in one-dimensional array B.
function TTriangularArray.AtoB(i, j : Integer) : Integer;
var
    tmp : Integer;
begin
    if ((i < 0) or (i >= Rows) or
        (j < 0) or (j >= Rows))
    then
        raise EInvalidOperation.CreateFmt(
            'Indices %d and %d are not between %d and %d.',
            [i, j, 0, Rows - 1]);

    if ((not UseDiagonal) and (i = j)) then
        raise EInvalidOperation.Create(
            'This array does not contain diagonal values.');

    // Make i bigger than j.
    if (i < j) then
    begin
        tmp := i;
        i := j;
        j := tmp;
    end;

    if (UseDiagonal) then i := i + 1;
    AtoB := Round(i * (i - 1) / 2) + j;
end;

end.
