Examples Delphi

Simple means of making some components data-aware. Alternative data-aware checkboxes (and radiobuttons) that can be arranged more flexibly.
Although more recent versions of Delphi may offer better ways of displaying data-aware collections of checkboxes and radiobuttons, I'm still using D4. I have often wished for a data-aware component that (a) does not include the bevelled box of D4's radio button group, (b) can be made to resemble some paper forms more closely, (c) permits more flexible arrangement of the items in the group, and (d) permits unusual patterns of buttons to be 'on' and 'off' simultaneously.
In short, more flexibility.
I think this recipe does this, and it also illustrates simple means for making some controls that are not data-aware acquire this capability by co-operating with those that are.
The upper and lower rows of checkboxes are represented in the Delphi code below by the classes TCheckboxCollection and TPersonalityCBCollection respectively. Each of these classes is a container for checkbox descriptors and their methods, Click, GetValue and SetValue, establish the behaviour of controls collectively, and arrange to associate their collective value with the associated data-aware control and, hence, with the data store.
The upper set of checkboxes behaves much like a set of radio buttons. In contrast, more than one of the set of lower checkboxes can be checked at once, and the "RESET" checkbox can be used to remove the checks from all at once.
Your comments welcome!
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, StdCtrls, Mask, DBCtrls, DBTables, ExtCtrls;
type
TCheckboxDescriptor = class
// hide the default behaviour of the checkbox in response
// to a click, and simplify manipulation of the encapsulated object
private
preClickedState: TCheckBoxState;
function GetState: TCheckBoxState;
procedure SetState ( State: TCheckBoxState );
public
checkbox: TCheckbox;
property State: TCheckBoxState read GetState write SetState;
constructor Create (theCheckbox: TCheckbox);
end;
TCheckboxCollection = class
// associate a data-aware edit box and its value with a collection
// of checkbox descriptors; default behaviour resembles radio buttons
checkboxDescriptors: TList;
handlingClick: Boolean;
private
function FindSender ( Sender: TObject ): TCheckboxDescriptor;
function GetValue : string;
procedure SetValue ( NewValue: string );
public
associatedDBEdit: TDBEdit;
constructor Create ( DBEdit: TDBEdit; theCheckboxes: array of TCheckbox );
procedure Click ( Sender: TObject );
property Value: string read GetValue write SetValue;
end;
TPersonalityCBCollection = class ( TCheckboxCollection )
// derived class which permits more than one checkbox to be checked at
// a time, and uses one checkbox for resetting the others
private
function GetValue : string;
procedure SetValue ( NewValue: string );
public
property Value: string read GetValue write SetValue;
procedure Click ( Sender: TObject );
end;
TForm1 = class(TForm)
Table1: TTable;
DBEdit1: TDBEdit;
DataSource1: TDataSource;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
CheckBox6: TCheckBox;
CheckBox7: TCheckBox;
CheckBox8: TCheckBox;
CheckBoxNA: TCheckBox;
CheckBox9: TCheckBox;
CheckBox10: TCheckBox;
CheckBox11: TCheckBox;
CheckBox12: TCheckBox;
CheckBox13: TCheckBox;
CheckBox14: TCheckBox;
CheckBox15: TCheckBox;
CheckBox16: TCheckBox;
DBNavigator1: TDBNavigator;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Shape1: TShape;
Label4: TLabel;
DBEdit2: TDBEdit;
procedure FormCreate(Sender: TObject);
procedure CheckBoxNAClick(Sender: TObject);
procedure DBEdit1Change(Sender: TObject);
procedure CheckBox9Click(Sender: TObject);
procedure DBEdit2Change(Sender: TObject);
private
SeverityCBs: TCheckboxCollection;
PersonalityCBs: TPersonalityCBCollection;
public
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
constructor TCheckboxDescriptor.Create (theCheckbox: TCheckbox);
begin
inherited Create;
checkbox:=theCheckbox;
// retain the design state of the checkbox
preClickedState:=theCheckbox.State;
end;
function TCheckboxDescriptor.GetState: TCheckBoxState;
begin
result:=preClickedState;
end;
procedure TCheckboxDescriptor.SetState ( State: TCheckBoxState );
begin
checkbox.State:=State;
preClickedState:=State
end;
constructor TCheckboxCollection.Create ( DBEdit: TDBEdit; theCheckboxes: array of TCheckbox );
var
i: integer;
begin
inherited Create;
associatedDBEdit:=DBEdit;
checkboxDescriptors:=TList.Create;
for i:=0 to high ( theCheckboxes ) do
checkboxDescriptors.Add(TCheckboxDescriptor.Create(theCheckboxes[i]));
handlingClick:=false;
end;
function TCheckboxCollection.FindSender ( Sender: TObject ): TCheckboxDescriptor;
var
c: integer;
checkboxDescriptor: TCheckboxDescriptor;
begin
checkboxDescriptor:=nil;
for c:=0 to checkboxDescriptors.Count - 1 do begin
checkboxDescriptor:=checkboxDescriptors.Items[c];
if checkboxDescriptor.checkbox = Sender then break
end;
result:=checkboxDescriptor
end;
procedure TCheckboxCollection.Click ( Sender: TObject );
var
clickedCBDescriptor, oneCBDescriptor: TCheckboxDescriptor;
c: integer;
begin
if handlingClick then exit;
handlingClick:=true;
clickedCBDescriptor:=FindSender ( Sender );
if clickedCBDescriptor.State = cbChecked then clickedCBDescriptor.State:=cbUnchecked
else begin
clickedCBDescriptor.State:=cbChecked;
for c:=0 to checkboxDescriptors.Count - 1 do begin
oneCBDescriptor:=checkboxDescriptors.Items[c];
if oneCBDescriptor <> clickedCBDescriptor then oneCBDescriptor.State:=cbUnchecked;
end;
end;
associatedDBEdit.DataSource.Edit;
associatedDBEdit.Text:=Value;
handlingClick:=false;
end;
procedure TPersonalityCBCollection.Click ( Sender: TObject );
var
clickedCB: TCheckbox;
clickedCBDescriptor, oneCBDescriptor: TCheckboxDescriptor;
c: integer;
begin
if handlingClick then exit;
handlingClick:=true;
clickedCB:=Sender as TCheckbox;
clickedCBDescriptor:=FindSender ( Sender );
if clickedCB.Name = 'CheckBox16' then
for c:=0 to checkboxDescriptors . Count - 1 do begin
oneCBDescriptor:=checkboxDescriptors.Items[c];
oneCBDescriptor.State:=cbUnchecked;
end
else case clickedCBDescriptor.State of
cbChecked: clickedCBDescriptor.State:=cbUnchecked;
else clickedCBDescriptor.State:=cbChecked;
end;
associatedDBEdit.DataSource.Edit;
associatedDBEdit.Text:=Value;
handlingClick:=false;
end;
function TPersonalityCBCollection.GetValue : string;
var
c, modulo, resultAsInt: integer;
oneCBDescriptor: TCheckboxDescriptor;
begin
resultAsInt:=0;
modulo:=1;
for c:=0 to checkboxDescriptors . Count - 2 do begin
if c > 0 then modulo:=modulo * 2;
oneCBDescriptor:=checkboxDescriptors.Items[c];
if oneCBDescriptor.checkbox.State = cbChecked then
resultAsInt:=resultAsInt + modulo;
end;
result:=IntToStr ( resultAsInt )
end;
function TCheckboxCollection.GetValue : string;
var
c: integer;
oneCBDescriptor: TCheckboxDescriptor;
begin
for c:=0 to checkboxDescriptors . Count - 1 do begin
oneCBDescriptor:=checkboxDescriptors.Items[c];
if oneCBDescriptor.checkbox.State = cbChecked then begin
if oneCBDescriptor.checkbox.Caption = 'N/A' then result:='0'
else result:=oneCBDescriptor.checkbox.Caption;
break
end
end
end;
procedure TPersonalityCBCollection.SetValue ( NewValue: string );
var
c, modulo, pattern: integer;
oneCBDescriptor: TCheckboxDescriptor;
begin
if NewValue = '' then exit;
if handlingClick then exit;
handlingClick:=true;
modulo:=1;
pattern:=StrToInt(NewValue);
for c:=0 to checkboxDescriptors . Count - 1 do begin
if c = 0 then modulo:=1 else modulo:=modulo * 2;
oneCBDescriptor:=checkboxDescriptors.Items[c];
if (pattern and modulo) <> 0 then oneCBDescriptor.State:=cbChecked
else oneCBDescriptor.State:=cbUnchecked;
end;
handlingClick:=false;
end;
procedure TCheckboxCollection.SetValue ( NewValue: string );
var
c: integer;
oneCBDescriptor: TCheckboxDescriptor;
begin
if NewValue = '' then exit;
if handlingClick then exit;
handlingClick:=true;
for c:=0 to checkboxDescriptors . Count - 1 do begin
oneCBDescriptor:=checkboxDescriptors.Items[c];
oneCBDescriptor.State:=cbUnchecked;
end;
c:=StrToInt(NewValue);
oneCBDescriptor:=checkboxDescriptors.Items[c];
oneCBDescriptor.State:=cbChecked;
handlingClick:=false;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SeverityCBs := TCheckboxCollection . Create ( DBEdit1,
[ CheckBoxNA,CheckBox1, CheckBox2, CheckBox3, CheckBox4, CheckBox5, CheckBox6, CheckBox7, CheckBox8 ] );
PersonalityCBs:=TPersonalityCBCollection.Create ( DBEdit2,
[ CheckBox9, CheckBox10, CheckBox11, CheckBox12, CheckBox13, CheckBox14, CheckBox15, CheckBox16 ] );
Table1.Open
end;
procedure TForm1.CheckBoxNAClick(Sender: TObject);
begin
SeverityCBs.Click(Sender);
end;
procedure TForm1.DBEdit1Change(Sender: TObject);
begin
SeverityCBs.SetValue(DBEdit1.Text)
end;
procedure TForm1.CheckBox9Click(Sender: TObject);
begin
PersonalityCBs.Click(Sender);
end;
procedure TForm1.DBEdit2Change(Sender: TObject);
begin
PersonalityCBs.SetValue(DBEdit2.Text)
end;
end.