unit ActionsLib;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Graphics, StdCtrls, ExtCtrls;
procedure ButtonClickSwapColor(Button: TButton; Shape1, Shape2: TShape);
procedure ButtonClickSwapShape(Button: TButton; Shape1, Shape2: TShape);
implementation
const
ID_Length = 30; // not sure but 30 should be more than enough
type
IDstring = string[ID_Length];
TLink = record
ID: IDstring;
Item1: TShape;
Item2: TShape;
end;
{ TTmpShape }
TTmpShape = class(TShape)
public
procedure SwapColor(Sender: TObject);
procedure SwapShape(Sender: TObject);
end;
var
TmpShape: TTmpShape;
Links: array of TLink;
procedure SaveLink(const ID: IDstring; Shape1, Shape2: TShape);
var
i: Integer;
begin
i := Length(Links);
SetLength(Links, i+1);
Links[i].ID := ID;
Links[i].Item1 := Shape1;
Links[i].Item2 := Shape2;
end;
procedure GetLink(const ID: IDstring; out Shape1, Shape2: TShape);
var
i: Integer;
begin
Shape1 := nil;
Shape2 := nil;
for i := 0 to Length(Links)-1 do
if Links[i].ID = ID then
begin
Shape1 := Links[i].Item1;
Shape2 := Links[i].Item2;
Exit;
end;
end;
procedure ButtonClickSwapColor(Button: TButton; Shape1, Shape2: TShape);
var
S: string;
begin
S := PtrInt(Button).ToString + 'Click';
SaveLink(S, Shape1, Shape2);
Button.OnClick := @TmpShape.SwapColor;
end;
procedure ButtonClickSwapShape(Button: TButton; Shape1, Shape2: TShape);
var
S: string;
begin
S := PtrInt(Button).ToString + 'Click';
SaveLink(S, Shape1, Shape2);
Button.OnClick := @TmpShape.SwapShape;
end;
{ TTmpShape }
procedure TTmpShape.SwapColor(Sender: TObject);
var
Shape1, Shape2: TShape;
Temp: TColor;
S: string;
begin
if not(Sender is TButton) then Exit;
S := PtrInt(Sender).ToString + 'Click';
GetLink(S, Shape1, Shape2);
if (Shape1 = nil) or (Shape2 = nil) then Exit;
Temp := Shape1.Brush.Color;
Shape1.Brush.Color := Shape2.Brush.Color;
Shape2.Brush.Color := Temp;
end;
procedure TTmpShape.SwapShape(Sender: TObject);
var
Shape1, Shape2: TShape;
Temp: TShapeType;
S: string;
begin
if not(Sender is TButton) then Exit;
S := PtrInt(Sender).ToString + 'Click';
GetLink(S, Shape1, Shape2);
if (Shape1 = nil) or (Shape2 = nil) then Exit;
Temp := Shape1.Shape;
Shape1.Shape := Shape2.Shape;
Shape2.Shape := Temp;
end;
initialization
SetLength(Links, 0);
finalization
SetLength(Links, 0);
end.