unit GarbageF;
//*******************************************************
// Example program demonstrating a simple resizable
// array-based list with garbage collection.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

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

type
  TGarbageForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Help1: TMenuItem;
    mnuExit: TMenuItem;
    mnuAbout: TMenuItem;
    ItemText: TEdit;
    Label1: TLabel;
    CmdAdd: TButton;
    CmdRemove: TButton;
    Label2: TLabel;
    CollectBtn: TButton;
    procedure FormCreate(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure CmdAddClick(Sender: TObject);
    procedure CmdRemoveClick(Sender: TObject);
    procedure ItemTextChange(Sender: TObject);
    procedure ShowList;
    procedure LabelsOnClick(Sender: TObject);
    procedure SelectLabel(index : Longint);
    procedure Deselect;
    procedure CollectBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  GarbageForm: TGarbageForm;

implementation

type
    TListLabelArray = array[1..100000000] of TLabel;
    PListLabelArray = ^TListLabelArray;

var
    the_list    : TGarbageList;
    list_labels : PListLabelArray;
    num_labels  : Longint;
    selected    : Longint;

{$R *.DFM}

procedure TGarbageForm.FormCreate(Sender: TObject);
begin
    the_list := TGarbageList.Create;
end;

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

procedure TGarbageForm.mnuAboutClick(Sender: TObject);
const
    CRCR = #13#10#13#10;
    CR = #13#10;
begin

    MessageDlg(
        'Program demonstruje funkcjonowanie listy tablicowej wyposażonej' + CR +
        'w mechanizm defragmentacji.' + CRCR +
        'Kliknięcie w przycisk "Dodaj" spowoduje dodanie do listy łańcucha' + CR +
        'wpisanego w kontrolkę edycyjną.' + CRCR +
        'Kliknięcie w przycisk "Usuń" spowoduje usunięcie podświetlonego' + CR +
        'elementu z listy.' + CRCR +
        'Kliknięcie w przycisk "Defragmentuj" powoduje wymuszenie defragmentacji' + CR +
        'listy bez względu na jej stan.'
       , mtInformation, [mbOK], 0);

end;

procedure TGarbageForm.CmdAddClick(Sender: TObject);
begin
    the_list.Add(ItemText.Text);
    ShowList;
    ItemText.Text := '';
    ItemText.SetFocus;
end;

procedure TGarbageForm.CmdRemoveClick(Sender: TObject);
begin
    the_list.Remove(selected);
    Deselect;
    ShowList;
end;

procedure TGarbageForm.ItemTextChange(Sender: TObject);
begin
    CmdAdd.Enabled := (ItemText.Text <> '');
end;

procedure TGarbageForm.ShowList;
var
    new_labels : PListLabelArray;
    i          : Longint;
    t, l, w, h : Integer;
    value      : String10;
begin

    // Make enough labels for the list.
    if (the_list.AllocatedCount > num_labels) then
    begin
        // Allocate space for the labels.
        GetMem(new_labels, the_list.AllocatedCount * SizeOf(TLabel));

        // Copy the old labels.
        for i := 1 to num_labels do
            new_labels^[i] := list_labels^[i];

        // Create the new labels.
        l := Label2.Left;
        w := Label2.Width;
        h := Label2.Height;
        if (num_labels > 0) then
            t := new_labels^[num_labels].Top + h
        else
            t := Label2.Top + h + 3;
        for i := num_labels + 1 to the_list.AllocatedCount do
        begin
            new_labels^[i] := TLabel.Create(Self);
            with new_labels^[i] do
            begin
                Parent := Self;
                Left := l;
                Top := t;
                Width := w;
                Height := h;
                AutoSize := False;
                Alignment := taCenter;
                OnClick := LabelsOnCLick; // Event handler.
            end;
            t := t + h;
        end;

        // Point to the new array.
        list_labels := new_labels;
        num_labels := the_list.AllocatedCount;
    end;

    // Display used entries.
    for i := 1 to the_list.Count do
    begin
        value := the_list.Item(i);
        if (value = GARBAGE_VALUE) then
            value := '<DZIURA>';
        list_labels^[i].Caption := value;
        list_labels^[i].Visible := True;
    end;

    // Display entries allocated but not used.
    for i := the_list.Count + 1 to the_list.AllocatedCount do
    begin
        list_labels^[i].Caption := '<NIE UŻYWANY>';
        list_labels^[i].Visible := True;
    end;

    // Hide the other labels.
    for i := the_list.AllocatedCount + 1 to num_labels do
    begin
        list_labels^[i].Visible := False;
    end;

    Deselect;
    CmdRemove.Enabled := False;
end;

procedure TGarbageForm.LabelsOnClick(Sender: TObject);
var
    i : Longint;
begin
    for i := 1 to num_labels do
        if (list_labels^[i] = Sender) then
        begin
            SelectLabel(i);
            exit;
        end;
end;

procedure TGarbageForm.SelectLabel(index : Longint);
begin
    // Unhighlight the previous selection.
    Deselect;

    // Highlight the label.
    if ((index <= the_list.Count) and
        (the_list.Item(index) <> GARBAGE_VALUE)) then
    begin
        selected := index;
        list_labels^[selected].Color := Label2.Font.Color;
        list_labels^[selected].Font.Color := Label2.Color;
    end;
    CmdRemove.Enabled := (selected > 0);
end;

procedure TGarbageForm.Deselect;
begin
    if (selected > 0) then
    begin
        list_labels^[selected].Color := Label2.Color;
        list_labels^[selected].Font.Color := Label2.Font.Color;
        selected := 0;
    end;
end;

procedure TGarbageForm.CollectBtnClick(Sender: TObject);
begin
  the_list.CollectGarbage;
  ShowList;
end;

end.
