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