unit MyTest;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, Graphics;
type
{ TTestControl }
TTestControl = class(TCustomControl)
private
FLeftVisible: Boolean;
FRightVisible: Boolean;
FLeftRect: TRect;
FRightRect: TRect;
FMouseDown: Boolean;
function GetLeftVisible : Boolean;
procedure SetLeftVisible(Value : Boolean);
function GetRightVisible : Boolean;
procedure SetRightVisible(Value : Boolean);
protected
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
public
procedure Paint; override;
constructor Create(AOwner : TComponent); override;
published
property LeftVisible : Boolean read GetLeftVisible write SetLeftVisible;
property RightVisible : Boolean read GetRightVisible write SetRightVisible;
end;
procedure Register;
implementation
uses
types, Themes;
constructor TTestControl.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
Width := 200;
Height := 50;
FLeftVisible := True;
FRightVisible := True;
FLeftRect := Rect(5, 5, 95, 45);
FRightRect := Rect(105, 5, 195, 45);
end;
function TTestControl.GetLeftVisible: Boolean;
begin
Result := FLeftVisible;
end;
procedure TTestControl.SetLeftVisible(Value: Boolean);
begin
if GetLeftVisible <> Value then
FLeftVisible := Value;
Invalidate;
end;
function TTestControl.GetRightVisible: Boolean;
begin
Result := FRightVisible;
end;
procedure TTestControl.SetRightVisible(Value: Boolean);
begin
if GetRightVisible <> Value then
FRightVisible := Value;
Invalidate;
end;
procedure TTestControl.Paint;
var
state: TThemedButton;
details: TThemedElementDetails;
P: TPoint;
begin
P := ScreenToClient(Mouse.CursorPos);
if FLeftVisible then begin
state := tbPushButtonNormal;
if PtInRect(FLeftRect, P) then
begin
if FMouseDown then
state := tbPushButtonPressed
else
state := tbPushButtonHot;
end;
details := ThemeServices.GetElementDetails(state);
ThemeServices.DrawElement(Canvas.Handle, details, FLeftRect);
end else
begin
state := tbPushButtonNormal;
if PtInRect(FRightRect, P) then
begin
if FMouseDown then
state := tbPushButtonPressed
else
state := tbPushButtonHot;
end;
details := ThemeServices.GetElementDetails(state);
ThemeServices.DrawElement(Canvas.Handle, details, FRightRect);
end;
end;
procedure TTestControl.MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
begin
inherited;
FMouseDown := true;
Invalidate;
end;
procedure TTestControl.MouseMove(Shift: TShiftState; X,Y: Integer);
begin
inherited;
Invalidate;
end;
procedure TTestControl.MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
begin
FMouseDown := false;
Invalidate;
end;
procedure Register;
begin
RegisterComponents('Misc',[TTestControl]);
end;
end.