examples/Delphi/ExSortU.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 ExSortU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,

  StConst, StBase, StSort;

type
  SortException = class(Exception);

  TSTDlg = class(TForm)
    LB1: TListBox;
    LB2: TListBox;
    NewBtn: TButton;
    SorterBtn: TButton;
    Btn4: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure FormActivate(Sender: TObject);
    procedure Btn4Click(Sender: TObject);
    procedure SorterBtnClick(Sender: TObject);
    procedure NewBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    DidGet : Boolean;
    MaxElems : Integer;
    ISort  : TStSorter;
    procedure DoRandomStrings;
  end;

var
  STDlg: TSTDlg;

implementation

{$R *.DFM}

type
  S15 = string[15];


function MyCompare(const E1, E2) : Integer; far;
begin
  Result := CompareText(S15(E1),S15(E2));
end;

procedure TSTDlg.FormActivate(Sender: TObject);
var
  OHTU : LongInt;
begin
  MaxElems := 1000;
  Edit1.Text := IntToStr(MaxElems);
  DoRandomStrings;
  OHTU := OptimumHeapToUse(SizeOf(S15),MaxElems);
  ISort := TStSorter.Create(OHTU,SizeOf(S15));
  ISort.Compare := MyCompare;
  DidGet := False;
end;

procedure TSTDlg.Btn4Click(Sender: TObject);
begin
  ISort.Free;
  Close;
end;

procedure TSTDlg.DoRandomStrings;
var
  step, I : Integer;
  AStr : S15;
begin
  LB1.Clear;
  LB1.Perform(WM_SETREDRAW,0,0);
  Randomize;
  for step := 1 to MaxElems do
  begin
    AStr[0] := chr(15);
    for I := 1 to 15 do
      AStr[I] := Chr(Random(26) + Ord('A'));
    LB1.Items.Add(AStr);
  end;
  LB1.Perform(WM_SETREDRAW,1,0);
  LB1.Update;
end;

procedure TSTDlg.SorterBtnClick(Sender: TObject);
var
  I   : integer;
  S   : S15;
begin
  if DidGet then
    ISort.Reset;
  Screen.Cursor := crHourGlass;
  if LB1.Items.Count > 0 then
  begin
    for I := 0 to LB1.Items.Count-1 do
    begin
      S := LB1.Items[I];
      ISort.Put(S);
    end;
  end;
  LB2.Clear;
  LB2.Perform(WM_SETREDRAW,0,0);
  while (ISort.Get(S)) do
    LB2.Items.Add(S);
  LB2.Perform(WM_SETREDRAW,1,0);
  LB2.Update;
  DidGet := True;
  Screen.Cursor := crDefault;
end;

procedure TSTDlg.NewBtnClick(Sender: TObject);
var
  Code : Integer;
begin
  Val(Edit1.Text,MaxElems,Code);
  if (Code <> 0) OR (MaxElems = 0) OR (MaxElems > 5000) then
  begin
    ShowMessage('Invalid entry or value out of range (1..5000)');
    Exit;
  end;
  LB2.Clear;
  DoRandomStrings;
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 ExSortU;
27
28	interface
29
30	uses
31	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
32
33	StConst, StBase, StSort;
34
35	type
36	SortException = class(Exception);
37
38	TSTDlg = class(TForm)
39	LB1: TListBox;
40	LB2: TListBox;
41	NewBtn: TButton;
42	SorterBtn: TButton;
43	Btn4: TButton;
44	Edit1: TEdit;
45	Label1: TLabel;
46	procedure FormActivate(Sender: TObject);
47	procedure Btn4Click(Sender: TObject);
48	procedure SorterBtnClick(Sender: TObject);
49	procedure NewBtnClick(Sender: TObject);
50	private
51	{ Private declarations }
52	public
53	{ Public declarations }
54	DidGet : Boolean;
55	MaxElems : Integer;
56	ISort : TStSorter;
57	procedure DoRandomStrings;
58	end;
59
60	var
61	STDlg: TSTDlg;
62
63	implementation
64
65	{$R *.DFM}
66
67	type
68	S15 = string[15];
69
70
71	function MyCompare(const E1, E2) : Integer; far;
72	begin
73	Result := CompareText(S15(E1),S15(E2));
74	end;
75
76	procedure TSTDlg.FormActivate(Sender: TObject);
77	var
78	OHTU : LongInt;
79	begin
80	MaxElems := 1000;
81	Edit1.Text := IntToStr(MaxElems);
82	DoRandomStrings;
83	OHTU := OptimumHeapToUse(SizeOf(S15),MaxElems);
84	ISort := TStSorter.Create(OHTU,SizeOf(S15));
85	ISort.Compare := MyCompare;
86	DidGet := False;
87	end;
88
89	procedure TSTDlg.Btn4Click(Sender: TObject);
90	begin
91	ISort.Free;
92	Close;
93	end;
94
95	procedure TSTDlg.DoRandomStrings;
96	var
97	step, I : Integer;
98	AStr : S15;
99	begin
100	LB1.Clear;
101	LB1.Perform(WM_SETREDRAW,0,0);
102	Randomize;
103	for step := 1 to MaxElems do
104	begin
105	AStr[0] := chr(15);
106	for I := 1 to 15 do
107	AStr[I] := Chr(Random(26) + Ord('A'));
108	LB1.Items.Add(AStr);
109	end;
110	LB1.Perform(WM_SETREDRAW,1,0);
111	LB1.Update;
112	end;
113
114	procedure TSTDlg.SorterBtnClick(Sender: TObject);
115	var
116	I : integer;
117	S : S15;
118	begin
119	if DidGet then
120	ISort.Reset;
121	Screen.Cursor := crHourGlass;
122	if LB1.Items.Count > 0 then
123	begin
124	for I := 0 to LB1.Items.Count-1 do
125	begin
126	S := LB1.Items[I];
127	ISort.Put(S);
128	end;
129	end;
130	LB2.Clear;
131	LB2.Perform(WM_SETREDRAW,0,0);
132	while (ISort.Get(S)) do
133	LB2.Items.Add(S);
134	LB2.Perform(WM_SETREDRAW,1,0);
135	LB2.Update;
136	DidGet := True;
137	Screen.Cursor := crDefault;
138	end;
139
140	procedure TSTDlg.NewBtnClick(Sender: TObject);
141	var
142	Code : Integer;
143	begin
144	Val(Edit1.Text,MaxElems,Code);
145	if (Code <> 0) OR (MaxElems = 0) OR (MaxElems > 5000) then
146	begin
147	ShowMessage('Invalid entry or value out of range (1..5000)');
148	Exit;
149	end;
150	LB2.Clear;
151	DoRandomStrings;
152	end;
153
154
155	end.