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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls;

type
  TSTDlg = class(TForm)
    CreateBtn: TButton;
    NumElemsValue: TEdit;
    Label2: TLabel;
    ClearAllBtn: TButton;
    SetAllBtn: TButton;
    InvertAllBtn: TButton;
    Label1: TLabel;
    SetBitBtn: TButton;
    SetBitValue: TEdit;
    ClearBitBtn: TButton;
    ClearBitValue: TEdit;
    IsBitSetBtn: TButton;
    IsBitSetValue: TEdit;
    ControlBitBtn: TButton;
    ControlBitValue: TEdit;
    BitOnCB: TCheckBox;
    ToggleBitBtn: TButton;
    ToggleBitValue: TEdit;
    Msg1: TMemo;
    LoadBtn: TButton;
    SaveBtn: TButton;
    OD1: TOpenDialog;
    SD1: TSaveDialog;
    procedure CreateBtnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ClearAllBtnClick(Sender: TObject);
    procedure SetAllBtnClick(Sender: TObject);
    procedure InvertAllBtnClick(Sender: TObject);
    procedure SetBitBtnClick(Sender: TObject);
    procedure ControlBitBtnClick(Sender: TObject);

    procedure ClearBitBtnClick(Sender: TObject);
    procedure IsBitSetBtnClick(Sender: TObject);
    procedure ToggleBitBtnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure LoadBtnClick(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure UpdateButtons(BitsOK : Boolean);
    function CheckValue(S : string; var N : longint) : Boolean;
    function GetTFString(N : LongInt) : string;
  end;

var
  STDlg: TSTDlg;

implementation

{$R *.DFM}

uses
  StConst,
  StBase,
  StBits;

var
  MyBits : TStBits;


procedure TSTDlg.FormCreate(Sender: TObject);
begin
  RegisterClass(TStBits);
  UpdateButtons(False);
end;


procedure TSTDlg.UpdateButtons(BitsOK : Boolean);
begin
  IsBitSetBtn.Enabled   := BitsOK;
  ControlBitBtn.Enabled := BitsOK;
  SetAllBtn.Enabled     := BitsOK;
  InvertAllBtn.Enabled  := BitsOK;
  ClearAllBtn.Enabled   := BitsOK;
  ToggleBitBtn.Enabled  := BitsOK;
  SetBitBtn.Enabled     := BitsOK;
  ClearBitBtn.Enabled   := BitsOK;
  SaveBtn.Enabled       := BitsOK;
end;


procedure TSTDlg.FormActivate(Sender: TObject);
begin
  IsBitSetValue.Text := '-1';
  ToggleBitValue.Text := '-1';
  SetBitValue.Text := '-1';
  ControlBitValue.Text := '-1';
  ClearBitValue.Text := '-1';

  Msg1.Lines.Clear;
  Msg1.Lines.Add('BitSet not created');
end;


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

procedure TSTDlg.CreateBtnClick(Sender: TObject);
var
  MaxBits : longint;
begin
  Msg1.Lines.Clear;

  if (NumElemsValue.Text = '') then
    NumElemsValue.Text := '50';

  MaxBits := StrToInt(NumElemsValue.Text);
  if (MaxBits < 1) OR (MaxBits > 9999) then
  begin
    ShowMessage('Value out of range (1 - 9999)');
    Exit;
  end;

  Msg1.Lines.Clear;

  if Assigned(MyBits) then
    MyBits.Free;

  UpdateButtons(False);
  MyBits := TStBits.Create(MaxBits);

  Label1.Caption := 'In entry fields below, enter a value from 0 to '
                  + IntToStr(MaxBits);
  Label2.Caption := 'Elements in BitSet: ' + IntToStr(MyBits.Max+1);

  IsBitSetValue.Text := '0';
  ToggleBitValue.Text := '0';
  SetBitValue.Text := '0';
  ControlBitValue.Text := '0';
  ClearBitValue.Text := '0';

  Msg1.Lines.Add('BitSet created');
  Msg1.Lines.Add(IntToStr(MyBits.Count));
  UpdateButtons(True);
end;

procedure TSTDlg.ClearAllBtnClick(Sender: TObject);
begin
  Msg1.Lines.Clear;
  MyBits.Clear;
  Msg1.Lines.Add('Bits Cleared');
end;

procedure TSTDlg.SetAllBtnClick(Sender: TObject);
begin
  Msg1.Lines.Clear;
  MyBits.SetBits;
  Msg1.Lines.Add('Bits Set');
end;

procedure TSTDlg.InvertAllBtnClick(Sender: TObject);
begin
  Msg1.Lines.Clear;
  MyBits.InvertBits;
  Msg1.Lines.Add('Bits Inverted');
end;

function TSTDlg.CheckValue(S : String; var N : longint) : Boolean;
begin
  Result := FALSE;
  if (S = '') then
  begin
    ShowMessage('No value entered');
    Exit;
  end;

  N := StrToInt(S);
  if (N < 0) or (N > MyBits.Max) then
  begin
    ShowMessage('Number out of range');
    Exit;
  end;
  Result := TRUE;
end;

function TSTDlg.GetTFString(N : LongInt) : string;
begin
  if MyBits.BitIsSet(N) then
    Result := 'TRUE'
  else
    Result := 'FALSE';
end;

procedure TSTDlg.SetBitBtnClick(Sender: TObject);
var
  BitNum : longint;
  WasStr,
  NowStr  : string[5];
begin
  if NOT CheckValue(SetBitValue.Text,BitNum) then
    Exit;

  WasStr := GetTFString(BitNum);
  MyBits.SetBit(BitNum);
  NowStr := GetTFString(BitNum);

  Msg1.Lines.Clear;
  Msg1.Lines.Add('Bit was: ' + WasStr);
  Msg1.Lines.Add('Bit is now: ' + NowStr);
end;

procedure TSTDlg.ControlBitBtnClick(Sender: TObject);
var
  BitNum  : longint;
  WasStr,
  NowStr  : string[5];
begin
  if NOT CheckValue(ControlBitValue.Text,BitNum) then
    Exit;

  WasStr := GetTFString(BitNum);
  MyBits.ControlBit(BitNum,BitOnCB.Checked);
  NowStr := GetTFString(BitNum);

  Msg1.Lines.Clear;
  Msg1.Lines.Add('Bit was: ' + WasStr);
  Msg1.Lines.Add('Bit is now: ' + NowStr);
end;

procedure TSTDlg.ClearBitBtnClick(Sender: TObject);
var
  BitNum : longint;
  WasStr,
  NowStr : string;
begin
  if NOT CheckValue(ClearBitValue.Text,BitNum) then
    Exit;

  WasStr := GetTFString(BitNum);
  MyBits.ClearBit(BitNum);
  NowStr := GetTFString(BitNum);

  Msg1.Lines.Clear;
  Msg1.Lines.Add('Bit was: ' + WasStr);
  Msg1.Lines.Add('Bit is now: ' + NowStr);
end;

procedure TSTDlg.IsBitSetBtnClick(Sender: TObject);
var
  BitNum  : longint;
begin
  if NOT CheckValue(IsBitSetValue.Text,BitNum) then
    Exit;

  Msg1.Lines.Clear;
  if (MyBits.BitIsSet(BitNum)) then
    Msg1.Lines.Add('Bit is set')
  else
    Msg1.Lines.Add( 'Bit not set');
end;

procedure TSTDlg.ToggleBitBtnClick(Sender: TObject);
var
  BitNum : longint;
  WasStr,
  NowStr : string;
begin
  if NOT CheckValue(ToggleBitValue.Text,BitNum) then
    Exit;

  WasStr := GetTFString(BitNum);
  MyBits.ToggleBit(BitNum);
  NowStr := GetTFString(BitNum);

  Msg1.Lines.Clear;
  Msg1.Lines.Add('Bit was: ' + WasStr);
  Msg1.Lines.Add('Bit is now: ' + NowStr);
end;


procedure TSTDlg.LoadBtnClick(Sender: TObject);
begin
  if (OD1.Execute) then
  begin
    if (NOT Assigned(MyBits)) then
    begin
      {create a minimum sized bitset - load will resize it}
      MyBits := TStBits.Create(1);

      if NOT (Assigned(MyBits)) then
      begin
        Msg1.Lines.Add('BitSet Create Failed');
        UpdateButtons(False);
        Exit;
      end;
    end;

    MyBits.Clear;
    MyBits.LoadFromFile(OD1.FileName);

    Label1.Caption := 'In entry fields below, enter a value from 0 to '
                    + IntToStr(MyBits.Max);
    Label2.Caption := 'Elements in BitSet: ' + IntToStr(MyBits.Max+1);

    IsBitSetValue.Text := '0';
    ToggleBitValue.Text := '0';
    SetBitValue.Text := '0';
    ControlBitValue.Text := '0';
    ClearBitValue.Text := '0';

    Msg1.Clear;
    Msg1.Lines.Add('BitSet loaded');
    UpdateButtons(True);
  end;
end;

procedure TSTDlg.SaveBtnClick(Sender: TObject);
begin
  if (SD1.Execute) then
  begin
    MyBits.StoreToFile(SD1.FileName);
    Msg1.Clear;
    Msg1.Lines.Add('BitSet saved');
  end;
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 ExBitsU;
27
28	interface
29
30	uses
31	Windows, Messages, SysUtils, Classes, Graphics, Controls,
32	Forms, Dialogs, StdCtrls, Buttons, ExtCtrls;
33
34	type
35	TSTDlg = class(TForm)
36	CreateBtn: TButton;
37	NumElemsValue: TEdit;
38	Label2: TLabel;
39	ClearAllBtn: TButton;
40	SetAllBtn: TButton;
41	InvertAllBtn: TButton;
42	Label1: TLabel;
43	SetBitBtn: TButton;
44	SetBitValue: TEdit;
45	ClearBitBtn: TButton;
46	ClearBitValue: TEdit;
47	IsBitSetBtn: TButton;
48	IsBitSetValue: TEdit;
49	ControlBitBtn: TButton;
50	ControlBitValue: TEdit;
51	BitOnCB: TCheckBox;
52	ToggleBitBtn: TButton;
53	ToggleBitValue: TEdit;
54	Msg1: TMemo;
55	LoadBtn: TButton;
56	SaveBtn: TButton;
57	OD1: TOpenDialog;
58	SD1: TSaveDialog;
59	procedure CreateBtnClick(Sender: TObject);
60	procedure FormClose(Sender: TObject; var Action: TCloseAction);
61	procedure ClearAllBtnClick(Sender: TObject);
62	procedure SetAllBtnClick(Sender: TObject);
63	procedure InvertAllBtnClick(Sender: TObject);
64	procedure SetBitBtnClick(Sender: TObject);
65	procedure ControlBitBtnClick(Sender: TObject);
66
67	procedure ClearBitBtnClick(Sender: TObject);
68	procedure IsBitSetBtnClick(Sender: TObject);
69	procedure ToggleBitBtnClick(Sender: TObject);
70	procedure FormActivate(Sender: TObject);
71	procedure LoadBtnClick(Sender: TObject);
72	procedure SaveBtnClick(Sender: TObject);
73	procedure FormCreate(Sender: TObject);
74	private
75	{ Private declarations }
76	public
77	{ Public declarations }
78	procedure UpdateButtons(BitsOK : Boolean);
79	function CheckValue(S : string; var N : longint) : Boolean;
80	function GetTFString(N : LongInt) : string;
81	end;
82
83	var
84	STDlg: TSTDlg;
85
86	implementation
87
88	{$R *.DFM}
89
90	uses
91	StConst,
92	StBase,
93	StBits;
94
95	var
96	MyBits : TStBits;
97
98
99	procedure TSTDlg.FormCreate(Sender: TObject);
100	begin
101	RegisterClass(TStBits);
102	UpdateButtons(False);
103	end;
104
105
106	procedure TSTDlg.UpdateButtons(BitsOK : Boolean);
107	begin
108	IsBitSetBtn.Enabled := BitsOK;
109	ControlBitBtn.Enabled := BitsOK;
110	SetAllBtn.Enabled := BitsOK;
111	InvertAllBtn.Enabled := BitsOK;
112	ClearAllBtn.Enabled := BitsOK;
113	ToggleBitBtn.Enabled := BitsOK;
114	SetBitBtn.Enabled := BitsOK;
115	ClearBitBtn.Enabled := BitsOK;
116	SaveBtn.Enabled := BitsOK;
117	end;
118
119
120	procedure TSTDlg.FormActivate(Sender: TObject);
121	begin
122	IsBitSetValue.Text := '-1';
123	ToggleBitValue.Text := '-1';
124	SetBitValue.Text := '-1';
125	ControlBitValue.Text := '-1';
126	ClearBitValue.Text := '-1';
127
128	Msg1.Lines.Clear;
129	Msg1.Lines.Add('BitSet not created');
130	end;
131
132
133	procedure TSTDlg.FormClose(Sender: TObject;
134	var Action: TCloseAction);
135	begin
136	MyBits.Free;
137	end;
138
139	procedure TSTDlg.CreateBtnClick(Sender: TObject);
140	var
141	MaxBits : longint;
142	begin
143	Msg1.Lines.Clear;
144
145	if (NumElemsValue.Text = '') then
146	NumElemsValue.Text := '50';
147
148	MaxBits := StrToInt(NumElemsValue.Text);
149	if (MaxBits < 1) OR (MaxBits > 9999) then
150	begin
151	ShowMessage('Value out of range (1 - 9999)');
152	Exit;
153	end;
154
155	Msg1.Lines.Clear;
156
157	if Assigned(MyBits) then
158	MyBits.Free;
159
160	UpdateButtons(False);
161	MyBits := TStBits.Create(MaxBits);
162
163	Label1.Caption := 'In entry fields below, enter a value from 0 to '
164	+ IntToStr(MaxBits);
165	Label2.Caption := 'Elements in BitSet: ' + IntToStr(MyBits.Max+1);
166
167	IsBitSetValue.Text := '0';
168	ToggleBitValue.Text := '0';
169	SetBitValue.Text := '0';
170	ControlBitValue.Text := '0';
171	ClearBitValue.Text := '0';
172
173	Msg1.Lines.Add('BitSet created');
174	Msg1.Lines.Add(IntToStr(MyBits.Count));
175	UpdateButtons(True);
176	end;
177
178	procedure TSTDlg.ClearAllBtnClick(Sender: TObject);
179	begin
180	Msg1.Lines.Clear;
181	MyBits.Clear;
182	Msg1.Lines.Add('Bits Cleared');
183	end;
184
185	procedure TSTDlg.SetAllBtnClick(Sender: TObject);
186	begin
187	Msg1.Lines.Clear;
188	MyBits.SetBits;
189	Msg1.Lines.Add('Bits Set');
190	end;
191
192	procedure TSTDlg.InvertAllBtnClick(Sender: TObject);
193	begin
194	Msg1.Lines.Clear;
195	MyBits.InvertBits;
196	Msg1.Lines.Add('Bits Inverted');
197	end;
198
199	function TSTDlg.CheckValue(S : String; var N : longint) : Boolean;
200	begin
201	Result := FALSE;
202	if (S = '') then
203	begin
204	ShowMessage('No value entered');
205	Exit;
206	end;
207
208	N := StrToInt(S);
209	if (N < 0) or (N > MyBits.Max) then
210	begin
211	ShowMessage('Number out of range');
212	Exit;
213	end;
214	Result := TRUE;
215	end;
216
217	function TSTDlg.GetTFString(N : LongInt) : string;
218	begin
219	if MyBits.BitIsSet(N) then
220	Result := 'TRUE'
221	else
222	Result := 'FALSE';
223	end;
224
225	procedure TSTDlg.SetBitBtnClick(Sender: TObject);
226	var
227	BitNum : longint;
228	WasStr,
229	NowStr : string[5];
230	begin
231	if NOT CheckValue(SetBitValue.Text,BitNum) then
232	Exit;
233
234	WasStr := GetTFString(BitNum);
235	MyBits.SetBit(BitNum);
236	NowStr := GetTFString(BitNum);
237
238	Msg1.Lines.Clear;
239	Msg1.Lines.Add('Bit was: ' + WasStr);
240	Msg1.Lines.Add('Bit is now: ' + NowStr);
241	end;
242
243	procedure TSTDlg.ControlBitBtnClick(Sender: TObject);
244	var
245	BitNum : longint;
246	WasStr,
247	NowStr : string[5];
248	begin
249	if NOT CheckValue(ControlBitValue.Text,BitNum) then
250	Exit;
251
252	WasStr := GetTFString(BitNum);
253	MyBits.ControlBit(BitNum,BitOnCB.Checked);
254	NowStr := GetTFString(BitNum);
255
256	Msg1.Lines.Clear;
257	Msg1.Lines.Add('Bit was: ' + WasStr);
258	Msg1.Lines.Add('Bit is now: ' + NowStr);
259	end;
260
261	procedure TSTDlg.ClearBitBtnClick(Sender: TObject);
262	var
263	BitNum : longint;
264	WasStr,
265	NowStr : string;
266	begin
267	if NOT CheckValue(ClearBitValue.Text,BitNum) then
268	Exit;
269
270	WasStr := GetTFString(BitNum);
271	MyBits.ClearBit(BitNum);
272	NowStr := GetTFString(BitNum);
273
274	Msg1.Lines.Clear;
275	Msg1.Lines.Add('Bit was: ' + WasStr);
276	Msg1.Lines.Add('Bit is now: ' + NowStr);
277	end;
278
279	procedure TSTDlg.IsBitSetBtnClick(Sender: TObject);
280	var
281	BitNum : longint;
282	begin
283	if NOT CheckValue(IsBitSetValue.Text,BitNum) then
284	Exit;
285
286	Msg1.Lines.Clear;
287	if (MyBits.BitIsSet(BitNum)) then
288	Msg1.Lines.Add('Bit is set')
289	else
290	Msg1.Lines.Add( 'Bit not set');
291	end;
292
293	procedure TSTDlg.ToggleBitBtnClick(Sender: TObject);
294	var
295	BitNum : longint;
296	WasStr,
297	NowStr : string;
298	begin
299	if NOT CheckValue(ToggleBitValue.Text,BitNum) then
300	Exit;
301
302	WasStr := GetTFString(BitNum);
303	MyBits.ToggleBit(BitNum);
304	NowStr := GetTFString(BitNum);
305
306	Msg1.Lines.Clear;
307	Msg1.Lines.Add('Bit was: ' + WasStr);
308	Msg1.Lines.Add('Bit is now: ' + NowStr);
309	end;
310
311
312	procedure TSTDlg.LoadBtnClick(Sender: TObject);
313	begin
314	if (OD1.Execute) then
315	begin
316	if (NOT Assigned(MyBits)) then
317	begin
318	{create a minimum sized bitset - load will resize it}
319	MyBits := TStBits.Create(1);
320
321	if NOT (Assigned(MyBits)) then
322	begin
323	Msg1.Lines.Add('BitSet Create Failed');
324	UpdateButtons(False);
325	Exit;
326	end;
327	end;
328
329	MyBits.Clear;
330	MyBits.LoadFromFile(OD1.FileName);
331
332	Label1.Caption := 'In entry fields below, enter a value from 0 to '
333	+ IntToStr(MyBits.Max);
334	Label2.Caption := 'Elements in BitSet: ' + IntToStr(MyBits.Max+1);
335
336	IsBitSetValue.Text := '0';
337	ToggleBitValue.Text := '0';
338	SetBitValue.Text := '0';
339	ControlBitValue.Text := '0';
340	ClearBitValue.Text := '0';
341
342	Msg1.Clear;
343	Msg1.Lines.Add('BitSet loaded');
344	UpdateButtons(True);
345	end;
346	end;
347
348	procedure TSTDlg.SaveBtnClick(Sender: TObject);
349	begin
350	if (SD1.Execute) then
351	begin
352	MyBits.StoreToFile(SD1.FileName);
353	Msg1.Clear;
354	Msg1.Lines.Add('BitSet saved');
355	end;
356	end;
357
358	end.