lazarus-ccr/components/systools/examples/double_ended_queue/exdqueu.pas

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{$IFDEF FPC}
  {$mode DELPHI}
{$ENDIF}

unit ExDQueU;

interface

uses
  {$IFNDEF FPC}
  Windows, Messages, 
  {$ENDIF}
  SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls,

  StConst, StBase, StUtils, StList, StDQue;

type
  S10 = string[10];
  TSTDlg = class(TForm)
    CreateBtn: TButton;
    Edit1: TEdit;
    PushHeadBtn: TButton;
    PopHeadBtn: TButton;
    HeadBtn: TButton;
    TailBtn: TButton;
    LB1: TListBox;
    LoadBtn: TButton;
    SaveBtn: TButton;
    OD1: TOpenDialog;
    SD1: TSaveDialog;
    ClearBtn: TButton;
    PushTailBtn: TButton;
    PopTailBtn: TButton;

    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure CreateBtnClick(Sender: TObject);
    procedure PushHeadBtnClick(Sender: TObject);
    procedure PopHeadBtnClick(Sender: TObject);
    procedure HeadBtnClick(Sender: TObject);
    procedure TailBtnClick(Sender: TObject);
    procedure LoadBtnClick(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure ClearBtnClick(Sender: TObject);
    procedure PushTailBtnClick(Sender: TObject);
    procedure PopTailBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    MyDQue  : TStDQue;

    procedure FillListBox;
    procedure UpdateButtons(QueOK : Boolean);
  end;

const
  MaxElem = 100;
var
  STDlg: TSTDlg;

implementation

{$R *.lfm}

procedure MyDelNodeData(Data : pointer); far;
 {-procedure to delete data pointer in each node
   during call to TSTList.Destroy}
begin
  FreeMem(Data, SizeOf(S10));
end;

function MyLoadData(Reader : TReader) : Pointer; far;
begin
  GetMem(Result, SizeOf(S10));
  S10(Result^) := Reader.ReadString;
end;

procedure MyStoreData(Writer : TWriter; Data : Pointer); far;
begin
  Writer.WriteString(S10(Data^));
end;

procedure TSTDlg.FormCreate(Sender: TObject);
begin
  RegisterClasses([TStDQue,TStListNode]);
  UpdateButtons(False);
end;

procedure TSTDlg.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  MyDQue.Free;
end;

procedure TSTDlg.FillListBox;
var
  PN : TStListNode;
begin
  LB1.Items.BeginUpdate;
  try
    PN := MyDQue.Head;
    while (PN <> nil) do
    begin
      LB1.Items.Add(S10(PN.Data^));
      PN := MyDQue.Next(PN);
    end;
  finally
    LB1.Items.EndUpdate;
  end;
end;

procedure TSTDlg.UpdateButtons(QueOK : Boolean);
begin
  ClearBtn.Enabled := QueOK;
  PushHeadBtn.Enabled  := QueOK;
  PopHeadBtn.Enabled  := QueOK;
  PushTailBtn.Enabled  := QueOK;
  PopTailBtn.Enabled  := QueOK;
  HeadBtn.Enabled  := QueOK;
  TailBtn.Enabled  := QueOK;
  SaveBtn.Enabled  := QueOK;
end;

procedure TSTDlg.CreateBtnClick(Sender: TObject);
var
  I : Integer;
  S : ^S10;
begin
  if Assigned(MyDQue) then
    MyDQue.Free;

  UpdateButtons(False);
  MyDQue := TStDQue.Create(TStListNode);

  MyDQue.DisposeData := MyDelNodeData;
  MyDQue.LoadData := MyLoadData;
  MyDQue.StoreData := MyStoreData;

  for I := 1 to MaxElem do
  begin
    GetMem(S, SizeOf(S10));
    S^ := 'Item' + IntToStr(I);
    MyDQue.Append(S);
  end;
  FillListBox;
  UpdateButtons(True);
end;

procedure TSTDlg.ClearBtnClick(Sender: TObject);
begin
  MyDQue.Clear;
  Edit1.Text := '';
  FillListBox;
  UpdateButtons(False);
end;

procedure TSTDlg.PushHeadBtnClick(Sender: TObject);
var
  NewString : ^S10;
begin
  if (Edit1.Text = '') then
  begin
    ShowMessage('No value entered');
    Exit;
  end;
  GetMem(NewString,SizeOf(S10));
  NewString^ := Edit1.Text;
  MyDQue.PushHead(NewString);
  FillListBox;
end;

procedure TSTDlg.PopHeadBtnClick(Sender: TObject);
begin
  MyDQue.PopHead;
  FillListBox;
end;

procedure TSTDlg.PushTailBtnClick(Sender: TObject);
var
  NewString : ^S10;
begin
  if (Edit1.Text = '') then
  begin
    ShowMessage('No value entered');
    Exit;
  end;
  GetMem(NewString,SizeOf(S10));
  NewString^ := Edit1.Text;
  MyDQue.PushTail(NewString);
  FillListBox;
end;

procedure TSTDlg.PopTailBtnClick(Sender: TObject);
begin
  MyDQue.PopTail;
  FillListBox;
end;

procedure TSTDlg.HeadBtnClick(Sender: TObject);
var
  Data : Pointer;
begin
  MyDQue.PeekHead(Data);
  Edit1.Text := S10(Data^);
end;

procedure TSTDlg.TailBtnClick(Sender: TObject);
var
  Data : Pointer;
begin
  MyDQue.PeekTail(Data);
  Edit1.Text := S10(Data^);
end;

procedure TSTDlg.LoadBtnClick(Sender: TObject);
begin
  if (OD1.Execute) then
  begin
    if (NOT Assigned(MyDQue)) then
    begin
      UpdateButtons(False);
      MyDQue := TStDQue.Create(TStListNode);

      MyDQue.DisposeData := MyDelNodeData;
      MyDQue.LoadData := MyLoadData;
      MyDQue.StoreData := MyStoreData;
    end;
    MyDQue.LoadFromFile(OD1.FileName);
    FillListBox;
    UpdateButtons(True);
  end;
end;

procedure TSTDlg.SaveBtnClick(Sender: TObject);
begin
  if (SD1.Execute) then
    MyDQue.StoreToFile(SD1.FileName);
end;

end.