unit ImageButton;
interface
uses
FMX.Objects, FMX.Controls, FMX.Types, FMX.Layouts, FMX.Effects, System.UITypes, System.SysUtils, System.Classes;
type
TUpDownState = (udsUP, udsDOWN);
TEnableState = (esENABLED, esDISABLED);
TImageButton = class(TLayout)
private
FUpDownState: TUpDownState;
FEnableState: TEnableState;
FAllowAllUp: boolean;
FGroupIndex: integer;
FEnabledUpImage: TImage;
FEnabledDownImage: TImage;
FDisabledUpImage: TImage;
FDisabledDownImage: TImage;
FEnabledUpText: TText;
FEnabledDownText: TText;
FDisabledUpText: TText;
FDisabledDownText: TText;
FShowEnabledUpImage: boolean;
FShowEnabledDownImage: boolean;
FShowEnabledUpText: boolean;
FShowEnabledDownText: boolean;
FShowDisabledUpImage: boolean;
FShowDisabledDownImage: boolean;
FShowDisabledUpText: boolean;
FShowDisabledDownText: boolean;
IsClicked: boolean;
procedure ChangeUpDownState(const Value: TUpDownState); overload;
procedure ChangeEnableState(const Value: TEnableState); overload;
procedure SetAllowAllUp(const Value: boolean);
procedure SetGroupIndex(const Value: integer);
procedure ChangeShowEnabledUpImage(const Value: boolean);
procedure ChangeShowEnabledDownImage(const Value: boolean);
procedure ChangeShowEnabledUpText(const Value: boolean);
procedure ChangeShowEnabledDownText(const Value: boolean);
procedure ChangeShowDisabledUpImage(const Value: boolean);
procedure ChangeShowDisabledDownImage(const Value: boolean);
procedure ChangeShowDisabledUpText(const Value: boolean);
procedure ChangeShowDisabledDownText(const Value: boolean);
procedure Update;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Click; override;
procedure ChangeUpDownState; overload;
procedure ChangeEnableState; overload;
protected
procedure SetName(const Value: TComponentName); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
procedure DoMouseLeave; override;
published
property UpDownState: TUpDownState read FUpDownState write ChangeUpDownState;
property EnableState: TEnableState read FEnableState write ChangeEnableState;
property AllowAllUp: boolean read FAllowAllUp write SetAllowAllUp;
property GroupIndex: integer read FGroupIndex write SetGroupIndex;
property EnabledUpImage: TImage read FEnabledUpImage;
property EnabledDownImage: TImage read FEnabledDownImage;
property EnabledUpText: TText read FEnabledUpText;
property EnabledDownText: TText read FEnabledDownText;
property DisabledUpImage: TImage read FDisabledUpImage;
property DisabledDownImage: TImage read FDisabledDownImage;
property DisabledUpText: TText read FDisabledUpText;
property DisabledDownText: TText read FDisabledDownText;
property ShowEnabledUpImage: boolean read FShowEnabledUpImage write ChangeShowEnabledUpImage;
property ShowEnabledDownImage: boolean read FShowEnabledDownImage write ChangeShowEnabledDownImage;
property ShowEnabledUpText: boolean read FShowEnabledUpText write ChangeShowEnabledUpText;
property ShowEnabledDownText: boolean read FShowEnabledDownText write ChangeShowEnabledDownText;
property ShowDisabledUpImage: boolean read FShowDisabledUpImage write ChangeShowDisabledUpImage;
property ShowDisabledDownImage: boolean read FShowDisabledDownImage write ChangeShowDisabledDownImage;
property ShowDisabledUpText: boolean read FShowDisabledUpText write ChangeShowDisabledUpText;
property ShowDisabledDownText: boolean read FShowDisabledDownText write ChangeShowDisabledDownText;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('My FMX Components', [TImageButton]);
end;
constructor TImageButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// default
HitTest := true;
FUpDownState := udsUP;
fEnableState := esENABLED;
FAllowAllUp := false;
FGroupIndex := 0;
IsClicked := false;
FEnabledUpImage := TImage.Create(Self);
FEnabledUpImage.Parent := Self;
FEnabledUpImage.Name := Self.Name + '_EnabledUpImage';
FEnabledUpImage.Align := TAlignLayout.Center;
FEnabledUpImage.HitTest := false;
FEnabledUpImage.Locked := true;
FEnabledUpImage.Stored := false;
FEnabledUpImage.SetSubComponent(true);
FEnabledDownImage := TImage.Create(Self);
FEnabledDownImage.Parent := Self;
FEnabledDownImage.Name := Self.Name + '_EnabledDownImage';
FEnabledDownImage.Align := TAlignLayout.Center;
FEnabledDownImage.HitTest := false;
FEnabledDownImage.Locked := true;
FEnabledDownImage.Stored := false;
FEnabledDownImage.SetSubComponent(true);
FEnabledUpText := TText.Create(Self);
FEnabledUpText.Parent := Self;
FEnabledUpText.Name := Self.Name + '_EnabledUpText';
FEnabledUpText.HitTest := false;
FEnabledUpText.Locked := true;
FEnabledUpText.Stored := false;
FEnabledUpText.SetSubComponent(true);
FEnabledDownText := TText.Create(Self);
FEnabledDownText.Parent := Self;
FEnabledDownText.Name := Self.Name + '_EnabledDownText';
FEnabledDownText.HitTest := false;
FEnabledDownText.Locked := true;
FEnabledDownText.Stored := false;
FEnabledDownText.SetSubComponent(true);
FDisabledUpImage := TImage.Create(Self);
FDisabledUpImage.Parent := Self;
FDisabledUpImage.Name := Self.Name + '_DisabledUpImage';
FDisabledUpImage.Align := TAlignLayout.Center;
FDisabledUpImage.HitTest := false;
FDisabledUpImage.Locked := true;
FDisabledUpImage.Stored := false;
FDisabledUpImage.SetSubComponent(true);
FDisabledDownImage := TImage.Create(Self);
FDisabledDownImage.Parent := Self;
FDisabledDownImage.Name := Self.Name + '_DisabledDownImage';
FDisabledDownImage.Align := TAlignLayout.Center;
FDisabledDownImage.HitTest := false;
FDisabledDownImage.Locked := true;
FDisabledDownImage.Stored := false;
FDisabledDownImage.SetSubComponent(true);
FDisabledUpText := TText.Create(Self);
FDisabledUpText.Parent := Self;
FDisabledUpText.Name := Self.Name + '_DisabledUpText';
FDisabledUpText.HitTest := false;
FDisabledUpText.Locked := true;
FDisabledUpText.Visible := false;
FDisabledUpText.Stored := false;
FDisabledUpText.SetSubComponent(true);
FDisabledDownText := TText.Create(Self);
FDisabledDownText.Parent := Self;
FDisabledDownText.Name := Self.Name + '_DisabledDownText';
FDisabledDownText.HitTest := false;
FDisabledDownText.Locked := true;
FDisabledDownText.Visible := false;
FDisabledDownText.Stored := false;
FDisabledDownText.SetSubComponent(true);
FShowEnabledUpImage := true;
FShowEnabledDownImage := true;
FShowEnabledUpText := false;
FShowEnabledDownText := false;
FShowDisabledUpImage := true;
FShowDisabledDownImage := true;
FShowDisabledUpText := false;
FShowDisabledDownText := false;
end;
destructor TImageButton.Destroy;
begin
if Assigned(FEnabledUpImage) then FEnabledUpImage.Free;
if Assigned(FEnabledDownImage) then FEnabledDownImage.Free;
if Assigned(FEnabledUpText) then FEnabledUpText.Free;
if Assigned(FEnabledDownText) then FEnabledDownText.Free;
if Assigned(FDisabledUpImage) then FDisabledUpImage.Free;
if Assigned(FDisabledDownImage) then FDisabledDownImage.Free;
if Assigned(FDisabledUpText) then FDisabledUpText.Free;
if Assigned(FDisabledDownText) then FDisabledDownText.Free;
inherited;
end;
procedure TImageButton.SetName(const Value: TComponentName);
begin
inherited SetName(Value);
FEnabledUpImage.Name := Value + '_EnabledUpImage';
FEnabledDownImage.Name := Value + '_EnabledDownImage';
FEnabledUpText.Name := Value + '_EnabledUpText';
FEnabledDownText.Name := Value + '_EnabledDownText';
FDisabledUpImage.Name := Value + '_DisabledUpImage';
FDisabledDownImage.Name := Value + '_DisabledDownImage';
FDisabledUpText.Name := Value + '_DisabledUpText';
FDisabledDownText.Name := Value + '_DisabledDownText';
end;
procedure TImageButton.Click;
begin
if IsClicked then inherited;
IsClicked := false;
end;
procedure TImageButton.ChangeUpDownState;
begin
case FUpDownState of
udsUP: ChangeUpDownState(udsDOWN);
udsDOWN: ChangeUpDownState(udsUP);
end;
end;
procedure TImageButton.ChangeEnableState;
begin
case FEnableState of
esENABLED: ChangeEnableState(esDISABLED);
esDISABLED: ChangeEnableState(esENABLED);
end;
end;
procedure TImageButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
if Button <> TMouseButton.mbLeft then exit;
if FEnableState = esDISABLED then exit;
if (FGroupIndex <> 0) and (FUpDownState = udsDOWN) and not FAllowAllUp then exit;
IsClicked := true;
ChangeUpDownState;
Click;
inherited;
end;
procedure TImageButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
if (FGroupIndex = 0) and (FUpDownState = udsDOWN) then ChangeUpDownState;
inherited;
end;
procedure TImageButton.DoMouseLeave;
begin
if (FGroupIndex = 0) and (FUpDownState = udsDOWN) then ChangeUpDownState;
inherited;
end;
procedure TImageButton.ChangeUpDownState(const Value: TUpDownState);
var
i: integer;
b: boolean;
begin
if FUpDownState = Value then exit;
// pokud jsem jediný down tak nelze jít na up
if (FGroupIndex <> 0) and not FAllowAllUp and (Value = udsUP) then
begin
b := true;
for i := 0 to Parent.ChildrenCount - 1 do
if Parent.Children[i] is TImageButton then
if TImageButton(Parent.Children[i]) <> Self then
if TImageButton(Parent.Children[i]).GroupIndex = FGroupIndex then
if TImageButton(Parent.Children[i]).UpDownState = udsDOWN then
begin
b := false;
break;
end;
if b then exit;
end;
FUpDownState := Value;
// změna stavu u zbylých tlačítek v groupě
if (FGroupIndex <> 0) and (FUpDownState = udsDOWN) then
for i := 0 to Parent.ChildrenCount - 1 do
if Parent.Children[i] is TImageButton then
if TImageButton(Parent.Children[i]) <> Self then
if TImageButton(Parent.Children[i]).GroupIndex = FGroupIndex then
if TImageButton(Parent.Children[i]).UpDownState = udsDOWN then
TImageButton(Parent.Children[i]).ChangeUpDownState;
Update;
end;
procedure TImageButton.ChangeEnableState(const Value: TEnableState);
begin
if FEnableState = Value then exit;
FEnableState := Value;
Update;
end;
procedure TImageButton.SetAllowAllUp(const Value: boolean);
var
i: integer;
begin
if FAllowAllUp = Value then exit;
FAllowAllUp := Value;
// změna AllowAllUp u všech tlačíte v groupě
if FGroupIndex <> 0 then
for i := 0 to Parent.ChildrenCount - 1 do
if Parent.Children[i] is TImageButton then
if TImageButton(Parent.Children[i]) <> Self then
TImageButton(Parent.Children[i]).SetAllowAllUp(FAllowAllUp);
Update;
end;
procedure TImageButton.SetGroupIndex(const Value: integer);
var
i: integer;
begin
if FGroupIndex = Value then exit;
FGroupIndex := Value;
// změna AllowAllUp u všech tlačíte v groupě
if FGroupIndex <> 0 then
for i := 0 to Parent.ChildrenCount - 1 do
if Parent.Children[i] is TImageButton then
if TImageButton(Parent.Children[i]) <> Self then
TImageButton(Parent.Children[i]).SetAllowAllUp(FAllowAllUp);
Update;
end;
procedure TImageButton.ChangeShowEnabledUpImage(const Value: boolean);
begin
if FShowEnabledUpImage = Value then exit;
FShowEnabledUpImage := Value;
Update;
end;
procedure TImageButton.ChangeShowEnabledDownImage(const Value: boolean);
begin
if FShowEnabledDownImage = Value then exit;
FShowEnabledDownImage := Value;
Update;
end;
procedure TImageButton.ChangeShowEnabledUpText(const Value: boolean);
begin
if FShowEnabledUpText = Value then exit;
FShowEnabledUpText := Value;
Update;
end;
procedure TImageButton.ChangeShowEnabledDownText(const Value: boolean);
begin
if FShowEnabledDownText = Value then exit;
FShowEnabledDownText := Value;
Update;
end;
procedure TImageButton.ChangeShowDisabledUpImage(const Value: boolean);
begin
if FShowDisabledUpImage = Value then exit;
FShowDisabledUpImage := Value;
Update;
end;
procedure TImageButton.ChangeShowDisabledDownImage(const Value: boolean);
begin
if FShowDisabledDownImage = Value then exit;
FShowDisabledDownImage := Value;
Update;
end;
procedure TImageButton.ChangeShowDisabledUpText(const Value: boolean);
begin
if FShowDisabledUpText = Value then exit;
FShowDisabledUpText := Value;
Update;
end;
procedure TImageButton.ChangeShowDisabledDownText(const Value: boolean);
begin
if FShowDisabledDownText = Value then exit;
FShowDisabledDownText := Value;
Update;
end;
procedure TImageButton.Update;
begin
case FEnableState of
esENABLED:
case FUpDownState of
udsUP: begin
FDisabledUpImage.Visible := false;
FDisabledDownImage.Visible := false;
FDisabledUpText.Visible := false;
FDisabledDownText.Visible := false;
FEnabledUpImage.Visible := FShowEnabledUpImage;
FEnabledDownImage.Visible := false;
FEnabledUpText.Visible := FShowEnabledUpText;
FEnabledDownText.Visible := false;
FEnabledUpImage.BringToFront;
FEnabledUpText.BringToFront;
end;
udsDOWN: begin
FDisabledUpImage.Visible := false;
FDisabledDownImage.Visible := false;
FDisabledUpText.Visible := false;
FDisabledDownText.Visible := false;
FEnabledUpImage.Visible := false;
FEnabledDownImage.Visible := FShowEnabledDownImage;
FEnabledUpText.Visible := false;
FEnabledDownText.Visible := FShowEnabledDownText;
FEnabledDownImage.BringToFront;
FEnabledDownText.BringToFront;
end;
end;
esDISABLED:
case FUpDownState of
udsUP: begin
FEnabledUpImage.Visible := false;
FEnabledDownImage.Visible := false;
FEnabledUpText.Visible := false;
FEnabledDownText.Visible := false;
FDisabledUpImage.Visible := FShowDisabledUpImage;
FDisabledDownImage.Visible := false;
FDisabledUpText.Visible := FShowDisabledUpText;
FDisabledDownText.Visible := false;
FDisabledUpImage.BringToFront;
FDisabledUpText.BringToFront;
end;
udsDOWN: begin
FEnabledUpImage.Visible := false;
FEnabledDownImage.Visible := false;
FEnabledUpText.Visible := false;
FEnabledDownText.Visible := false;
FDisabledUpImage.Visible := false;
FDisabledDownImage.Visible := FShowDisabledDownImage;
FDisabledUpText.Visible := false;
FDisabledDownText.Visible := FShowDisabledDownText;
FDisabledDownImage.BringToFront;
FDisabledDownText.BringToFront;
end;
end;
end;
inherited;
end;
end.