type
TOnSwitch = procedure(Sender: TObject; ID : integer) of object; (* *** *)
TMySwitch = class
type
CountryOrientation = (OnIsUp, OnIsDown);
var
{private}
parentForm : TForm;
num : integer;
imgUp : TImage;
imgDown : TImage;
Up : boolean;
Onn : boolean;
Orientation : CountryOrientation;
FOnSwitch: TOnSwitch; (* *** *)
procedure SwitchClick(Sender:TObject);
{public}
constructor Init(useForm:TForm);
destructor Zero;
property OnSwitch: TOnSwitch read FOnSwitch write FOnSwitch; (* *** *)
procedure flip;
procedure turnUp;
procedure turnDown;
procedure hideBothSwitches;
procedure Play;
procedure setPos(L,T:integer);
procedure setSize(W,H:integer);
procedure setOrientation(input:CountryOrientation);
end;
{ TfrmSwitches }
TfrmSwitches = class(TForm)
{GUI routines}
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ private declarations }
{GUI routines}
procedure initialiseSwitches;
{Switch operating routines}
procedure DoOnSwitch(Sender: TObject;ID : Integer); (* *** *)
procedure flipSwitch(swNum:integer);
public
{ public declarations }
end;
var
frmSwitches: TfrmSwitches;
Sw : array [1..4] of TMySwitch; // holds the 4 switch objects
implementation
{$R *.lfm}
(* ... Switch handling ..................................... *)
{TMySwitch}
constructor TMySwitch.Init(useForm:TForm);
procedure setVariables(var thisImage:TImage);
begin
with thisImage do
begin
parent := ParentForm;
stretch := true;
onClick := @SwitchClick; (* *** *)
end;
end;
begin
inherited;
ParentForm := useForm;
imgUp := TImage.create (ParentForm);
imgDown := TImage.create (ParentForm);
imgUp.picture.LoadFromFile('Brown_switch_up.jpg');
setVariables(imgUp);
imgDown.picture.LoadFromFile('Brown_switch_down.jpg');
setVariables(imgDown);
Up := false;
end;
destructor TMySwitch.Zero;
begin
inherited;
imgUp.free;
imgDown.free;
end;
procedure TMySwitch.setPos(L,T:integer);
begin
imgUp.left := L;
imgUp.top := T;
imgDown.left := imgUp.left;
imgDown.top := imgUp.top;
end;
procedure TMySwitch.setSize(W,H:integer);
begin
imgUp.width := W;
imgUp.height := H;
imgDown.width := imgUp.width;
imgDown.Height := imgUp.height;
end;
Procedure TMySwitch.flip;
begin
Up := not Up;
if Up then
begin
imgUp.show;
imgDown.hide;
onn := (orientation = OnIsUp);
end
else
begin
imgUp.hide;
imgDown.show;
onn := (orientation = OnIsDown);
end;
end;
procedure TMySwitch.Play;
begin
PlaySound('light-switch-click.wav',0,SND_ASYNC);
end;
procedure TMySwitch.SwitchClick(Sender:TObject);
{reverses the switch position and activates the test to see if the light bulb's
lit status should be changed}
begin
Play;
flip;
if Assigned(FOnSwitch) then (* *** *)
FOnSwitch(Self,num); (* *** *)
end;
procedure TMySwitch.turnUp;
{forces the switch to the up position}
begin
imgUp.Show;
imgDown.Hide;
Up := true;
onn := (orientation = OnIsUp);
end;
procedure TMySwitch.turnDown;
{forces the switch to the down position}
begin
imgUp.Hide;
imgDown.Show;
Up := false;
onn := (orientation = OnIsDown);
end;
procedure TMySwitch.hideBothSwitches;
begin
imgUp.Hide;
imgDown.Hide;
end;
procedure TMySwitch.setOrientation(input:CountryOrientation);
{input is provided via the OnClick event of a two-button
radio group on the parent form}
begin
orientation := input;
end;
{ TfrmSwitches }
(* ... GUI ROUTINES ........................................................ *)
procedure TfrmSwitches.FormCreate(Sender: TObject);
{initialises the variables used}
begin
initialiseSwitches;
...
end;
procedure TfrmSwitches.initialiseSwitches;
{create the 4 switch objects and locate their up and down images across the
form}
var i, lft : integer;
begin
for i := 1 to 4 do
begin
Sw[i] := TMySwitch.init(Self);
with Sw[i] do
begin
case i of
1 : lft := 49;
2 : lft := 97;
3 : lft := 145;
4 : lft := 193;
end;
setPos(lft,143);
setSize(33,66);
num := i;
OnSwitch := @DoOnSwitch; (* *** *)
flip;
end;
end;
end;
procedure TfrmSwitches.FormDestroy(Sender: TObject);
var i : integer;
begin
for i := 1 to 4 do Sw[i].Zero;
end;
(* ... SWITCH OPERATING ROUTINES ............................................ *)
procedure TfrmSwitches.DoOnSwitch(Sender:TObject;ID:integer); (* *** *)
begin
flipSwitch(ID);
end;
procedure TfrmSwitches.flipSwitch(swNum:integer);
begin
...
end;