I'm writing a custom switch object to be used in Firemonkey's TListView
control per item. Everything works as expected, except for one strange glitch. When the user clicks on one of the items, but not on the particular switch object, it toggles the switch anyway. I'm assuming the MouseDown
event is triggered when the user clicks on the list item, and not necessarily my particular "control" drawn on it.
How do I restrict the click event to only apply when the user clicks the actual switch?
JD.ListViewObjects.pas
unit JD.ListViewObjects;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base,
FMX.ListView;
type
TLISwitchThumbStyle = (tsRect, tsRoundRect, tsElipse);
TListItemSwitch = class(TListItemSimpleControl)
private
FIsChecked: Boolean;
FOnSwitch: TNotifyEvent;
FThumbStyle: TLISwitchThumbStyle;
FThumbWidth: Single;
FThumbHeight: Single;
FThumbRound: Single;
procedure SetIsChecked(const AValue: Boolean);
procedure SetThumbStyle(const Value: TLISwitchThumbStyle);
procedure SetThumbWidth(const Value: Single);
procedure SetThumbHeight(const Value: Single);
procedure SetThumbRound(const Value: Single);
protected
function MouseDown(const Button: TMouseButton; const Shift: TShiftState; const MousePos: TPointF): Boolean;
override;
procedure DoSwitch; virtual;
procedure Render(const Canvas: TCanvas; const DrawItemIndex: Integer; const DrawStates: TListItemDrawStates;
const SubPassNo: Integer = 0); override;
public
constructor Create(const AOwner: TListItem); override;
destructor Destroy; override;
public
property IsChecked: Boolean read FIsChecked write SetIsChecked;
property ThumbWidth: Single read FThumbWidth write SetThumbWidth;
property ThumbHeight: Single read FThumbHeight write SetThumbHeight;
property ThumbStyle: TLISwitchThumbStyle read FThumbStyle write SetThumbStyle;
property ThumbRound: Single read FThumbRound write SetThumbRound;
property OnSwitch: TNotifyEvent read FOnSwitch write FOnSwitch;
end;
implementation
{ TListItemSwitch }
constructor TListItemSwitch.Create(const AOwner: TListItem);
begin
inherited;
Width:= 50;
Height:= 20;
FIsChecked:= False;
FThumbWidth:= 15;
FThumbHeight:= 15;
FThumbRound:= 3;
end;
destructor TListItemSwitch.Destroy;
begin
inherited;
end;
function TListItemSwitch.MouseDown(const Button: TMouseButton;
const Shift: TShiftState; const MousePos: TPointF): Boolean;
begin
if (Button = TMouseButton.mbLeft) and Enabled then begin
DoSwitch;
end;
inherited;
end;
procedure TListItemSwitch.DoSwitch;
begin
FIsChecked:= not FIsChecked;
if Assigned(OnSwitch) then
OnSwitch(Self);
Invalidate;
end;
procedure TListItemSwitch.SetIsChecked(const AValue: Boolean);
begin
FIsChecked:= AValue;
Invalidate;
end;
procedure TListItemSwitch.SetThumbWidth(const Value: Single);
begin
FThumbWidth := Value;
Invalidate;
end;
procedure TListItemSwitch.SetThumbHeight(const Value: Single);
begin
FThumbHeight := Value;
Invalidate;
end;
procedure TListItemSwitch.SetThumbRound(const Value: Single);
begin
FThumbRound := Value;
Invalidate;
end;
procedure TListItemSwitch.SetThumbStyle(const Value: TLISwitchThumbStyle);
begin
FThumbStyle := Value;
Invalidate;
end;
procedure TListItemSwitch.Render(const Canvas: TCanvas;
const DrawItemIndex: Integer; const DrawStates: TListItemDrawStates;
const SubPassNo: Integer);
var
R, R2: TRectF;
D: Single;
begin
inherited;
R:= Self.LocalRect;
R2:= R;
Canvas.BeginScene;
try
Canvas.Stroke.Kind:= TBrushKind.None;
Canvas.Fill.Kind:= TBrushKind.Solid;
Canvas.Fill.Color:= TAlphaColorRec.Skyblue;
Canvas.FillRect(R, FThumbRound, FThumbRound,
[TCorner.TopLeft, TCorner.TopRight, TCorner.BottomLeft, TCorner.BottomRight],
1.0, TCornerType.Round);
R2.Top:= R.Top + (R.Height / 2) - (FThumbHeight / 2);
R2.Height:= FThumbHeight;
D:= R2.Top - R.Top;
if IsChecked then begin
R2.Left:= R.Right - FThumbWidth - D;
end else begin
R2.Left:= R.Left + D;
end;
R2.Width:= FThumbWidth;
Canvas.Fill.Color:= TAlphaColorRec.Black;
Canvas.FillRect(R2, FThumbRound, FThumbRound,
[TCorner.TopLeft, TCorner.TopRight, TCorner.BottomLeft, TCorner.BottomRight],
1.0, TCornerType.Round);
finally
Canvas.EndScene;
end;
end;
end.
uListViewSwitchTest.pas
unit uListViewSwitchTest;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base,
FMX.ListView, FMX.Controls.Presentation, FMX.StdCtrls,
JD.ListViewObjects;
type
TForm1 = class(TForm)
ListView1: TListView;
procedure ListView1UpdateObjects(const Sender: TObject;
const AItem: TListViewItem);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
X: Integer;
function A: TListViewItem;
begin
Result:= ListView1.Items.Add;
end;
begin
ListView1.Align:= TAlignLayout.Client;
for X := 1 to 50 do
A;
end;
procedure TForm1.ListView1UpdateObjects(const Sender: TObject;
const AItem: TListViewItem);
var
S: TListItemSwitch;
begin
S:= AItem.Objects.FindObject('Switch') as TListItemSwitch;
if S = nil then begin
S:= TListItemSwitch.Create(AItem);
S.Name:= 'Switch';
S.Align:= TListItemAlign.Trailing;
S.VertAlign:= TListItemAlign.Center;
end;
end;
end.
It should look something like this: