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	(* *** 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.