examples/Delphi/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 ***** *)

unit ExDQueU;

interface

uses
  Windows, Messages, 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 *.DFM}

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.Clear;
  LB1.Perform(WM_SETREDRAW, 0, 0);
  PN := MyDQue.Head;
  while (PN <> nil) do
  begin
    LB1.Items.Add(S10(PN.Data^));
    PN := MyDQue.Next(PN);
  end;
  LB1.Perform(WM_SETREDRAW, 1, 0);
  LB1.Update;
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.
1	torben	2671	(* *** BEGIN LICENSE BLOCK ***
2			* Version: MPL 1.1
3			*
4			* The contents of this file are subject to the Mozilla Public License Version
5			* 1.1 (the "License"); you may not use this file except in compliance with
6			* the License. You may obtain a copy of the License at
7			* http://www.mozilla.org/MPL/
8			*
9			* Software distributed under the License is distributed on an "AS IS" basis,
10			* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11			* for the specific language governing rights and limitations under the
12			* License.
13			*
14			* The Original Code is TurboPower SysTools
15			*
16			* The Initial Developer of the Original Code is
17			* TurboPower Software
18			*
19			* Portions created by the Initial Developer are Copyright (C) 1996-2002
20			* the Initial Developer. All Rights Reserved.
21			*
22			* Contributor(s):
23			*
24			* *** END LICENSE BLOCK *** *)
25
26			unit ExDQueU;
27
28			interface
29
30			uses
31			Windows, Messages, SysUtils, Classes, Graphics, Controls,
32			Forms, Dialogs, StdCtrls, Buttons, ExtCtrls,
33
34			StConst, StBase, StUtils, StList, StDQue;
35
36			type
37			S10 = string[10];
38			TSTDlg = class(TForm)
39			CreateBtn: TButton;
40			Edit1: TEdit;
41			PushHeadBtn: TButton;
42			PopHeadBtn: TButton;
43			HeadBtn: TButton;
44			TailBtn: TButton;
45			LB1: TListBox;
46			LoadBtn: TButton;
47			SaveBtn: TButton;
48			OD1: TOpenDialog;
49			SD1: TSaveDialog;
50			ClearBtn: TButton;
51			PushTailBtn: TButton;
52			PopTailBtn: TButton;
53
54			procedure FormCreate(Sender: TObject);
55			procedure FormClose(Sender: TObject; var Action: TCloseAction);
56
57			procedure CreateBtnClick(Sender: TObject);
58			procedure PushHeadBtnClick(Sender: TObject);
59			procedure PopHeadBtnClick(Sender: TObject);
60			procedure HeadBtnClick(Sender: TObject);
61			procedure TailBtnClick(Sender: TObject);
62			procedure LoadBtnClick(Sender: TObject);
63			procedure SaveBtnClick(Sender: TObject);
64			procedure ClearBtnClick(Sender: TObject);
65			procedure PushTailBtnClick(Sender: TObject);
66			procedure PopTailBtnClick(Sender: TObject);
67			private
68			{ Private declarations }
69			public
70			{ Public declarations }
71			MyDQue : TStDQue;
72
73			procedure FillListBox;
74			procedure UpdateButtons(QueOK : Boolean);
75			end;
76
77			const
78			MaxElem = 100;
79			var
80			STDlg: TSTDlg;
81
82			implementation
83
84			{$R *.DFM}
85
86			procedure MyDelNodeData(Data : pointer); far;
87			{-procedure to delete data pointer in each node
88			during call to TSTList.Destroy}
89			begin
90			FreeMem(Data, SizeOf(S10));
91			end;
92
93			function MyLoadData(Reader : TReader) : Pointer; far;
94			begin
95			GetMem(Result, SizeOf(S10));
96			S10(Result^) := Reader.ReadString;
97			end;
98
99			procedure MyStoreData(Writer : TWriter; Data : Pointer); far;
100			begin
101			Writer.WriteString(S10(Data^));
102			end;
103
104			procedure TSTDlg.FormCreate(Sender: TObject);
105			begin
106			RegisterClasses([TStDQue,TStListNode]);
107			UpdateButtons(False);
108			end;
109
110			procedure TSTDlg.FormClose(Sender: TObject;
111			var Action: TCloseAction);
112			begin
113			MyDQue.Free;
114			end;
115
116			procedure TSTDlg.FillListBox;
117			var
118			PN : TStListNode;
119			begin
120			LB1.Clear;
121			LB1.Perform(WM_SETREDRAW, 0, 0);
122			PN := MyDQue.Head;
123			while (PN <> nil) do
124			begin
125			LB1.Items.Add(S10(PN.Data^));
126			PN := MyDQue.Next(PN);
127			end;
128			LB1.Perform(WM_SETREDRAW, 1, 0);
129			LB1.Update;
130			end;
131
132			procedure TSTDlg.UpdateButtons(QueOK : Boolean);
133			begin
134			ClearBtn.Enabled := QueOK;
135			PushHeadBtn.Enabled := QueOK;
136			PopHeadBtn.Enabled := QueOK;
137			PushTailBtn.Enabled := QueOK;
138			PopTailBtn.Enabled := QueOK;
139			HeadBtn.Enabled := QueOK;
140			TailBtn.Enabled := QueOK;
141			SaveBtn.Enabled := QueOK;
142			end;
143
144			procedure TSTDlg.CreateBtnClick(Sender: TObject);
145			var
146			I : Integer;
147			S : ^S10;
148			begin
149			if Assigned(MyDQue) then
150			MyDQue.Free;
151
152			UpdateButtons(False);
153			MyDQue := TStDQue.Create(TStListNode);
154
155			MyDQue.DisposeData := MyDelNodeData;
156			MyDQue.LoadData := MyLoadData;
157			MyDQue.StoreData := MyStoreData;
158
159			for I := 1 to MaxElem do
160			begin
161			GetMem(S, SizeOf(S10));
162			S^ := 'Item' + IntToStr(I);
163			MyDQue.Append(S);
164			end;
165			FillListBox;
166			UpdateButtons(True);
167			end;
168
169			procedure TSTDlg.ClearBtnClick(Sender: TObject);
170			begin
171			MyDQue.Clear;
172			Edit1.Text := '';
173			FillListBox;
174			UpdateButtons(False);
175			end;
176
177			procedure TSTDlg.PushHeadBtnClick(Sender: TObject);
178			var
179			NewString : ^S10;
180			begin
181			if (Edit1.Text = '') then
182			begin
183			ShowMessage('No value entered');
184			Exit;
185			end;
186			GetMem(NewString,SizeOf(S10));
187			NewString^ := Edit1.Text;
188			MyDQue.PushHead(NewString);
189			FillListBox;
190			end;
191
192			procedure TSTDlg.PopHeadBtnClick(Sender: TObject);
193			begin
194			MyDQue.PopHead;
195			FillListBox;
196			end;
197
198			procedure TSTDlg.PushTailBtnClick(Sender: TObject);
199			var
200			NewString : ^S10;
201			begin
202			if (Edit1.Text = '') then
203			begin
204			ShowMessage('No value entered');
205			Exit;
206			end;
207			GetMem(NewString,SizeOf(S10));
208			NewString^ := Edit1.Text;
209			MyDQue.PushTail(NewString);
210			FillListBox;
211			end;
212
213			procedure TSTDlg.PopTailBtnClick(Sender: TObject);
214			begin
215			MyDQue.PopTail;
216			FillListBox;
217			end;
218
219			procedure TSTDlg.HeadBtnClick(Sender: TObject);
220			var
221			Data : Pointer;
222			begin
223			MyDQue.PeekHead(Data);
224			Edit1.Text := S10(Data^);
225			end;
226
227			procedure TSTDlg.TailBtnClick(Sender: TObject);
228			var
229			Data : Pointer;
230			begin
231			MyDQue.PeekTail(Data);
232			Edit1.Text := S10(Data^);
233			end;
234
235			procedure TSTDlg.LoadBtnClick(Sender: TObject);
236			begin
237			if (OD1.Execute) then
238			begin
239			if (NOT Assigned(MyDQue)) then
240			begin
241			UpdateButtons(False);
242			MyDQue := TStDQue.Create(TStListNode);
243
244			MyDQue.DisposeData := MyDelNodeData;
245			MyDQue.LoadData := MyLoadData;
246			MyDQue.StoreData := MyStoreData;
247			end;
248			MyDQue.LoadFromFile(OD1.FileName);
249			FillListBox;
250			UpdateButtons(True);
251			end;
252			end;
253
254			procedure TSTDlg.SaveBtnClick(Sender: TObject);
255			begin
256			if (SD1.Execute) then
257			MyDQue.StoreToFile(SD1.FileName);
258			end;
259
260			end.