paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-30 00:11:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: use the new TIndustrialBase class for TArrow.

Browse Source 
git-svn-id: trunk@41235 -
This commit is contained in:
juha 2013-05-17 13:27:19 +00:00
parent b284755d19
commit e3b6cb9315
1 changed files with 10 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
lcl/arrow.pp
View File

@ -28,10 +28,7 @@ unit Arrow;
interface
uses
Classes, Controls, Graphics, types;
const Default_Height_Width = 10;
ArrowMinHeight = 8;
Classes, Controls, Graphics, types, IndustrialBase;
type
@ -42,17 +39,14 @@ type
{ TArrow }
TArrow = class(TGraphicControl)
TArrow = class(TIndustrialBase)
private
FAntiAliasingMode: TAntialiasingMode;
FArrowColor: TColor;
FArrowType: TArrowType;
FR: TRect;
FShadowType: TShadowType;
FT: TTrianglePoints;
procedure CalcTrianglePoints;
procedure GraphicChanged;
procedure SetAntiAliasingMode(AValue: TAntialiasingMode);
procedure SetArrowColor(AValue: TColor);
procedure SetArrowType(AValue: TArrowType);
procedure SetShadowType(AValue: TShadowType);
@ -64,7 +58,6 @@ type
published
property Align;
property Anchors;
property AntiAliasingMode: TAntialiasingMode read FAntiAliasingMode write SetAntiAliasingMode default amDontCare;
property ArrowColor: TColor read FArrowColor write SetArrowColor default clBlack;
property ArrowType: TArrowType read FArrowType write SetArrowType default atLeft;
property BorderSpacing;
@ -94,8 +87,14 @@ type
procedure Register;
implementation
const
Default_Height_Width = 10;
ArrowMinHeight = 8;
procedure Register;
begin
RegisterComponents('Industrial',[TArrow]);
@ -149,19 +148,6 @@ begin
end;
end;
procedure TArrow.GraphicChanged;
begin
if Assigned(Parent) and (Visible or (csDesigning in ComponentState))
then Invalidate;
end;
procedure TArrow.SetAntiAliasingMode(AValue: TAntialiasingMode);
begin
if FAntiAliasingMode=AValue then Exit;
FAntiAliasingMode:=AValue;
GraphicChanged;
end;
procedure TArrow.SetArrowColor(AValue: TColor);
begin
if FArrowColor=AValue then Exit;
@ -222,10 +208,10 @@ const
end;
begin
Canvas.AntialiasingMode := FAntiAliasingMode;
// Paint background
Canvas.Brush.Color := Color;
Canvas.FillRect(ClientRect);
// Paint arrow
Canvas.Pen.Color:= FArrowColor;
Canvas.Brush.Color:= FArrowColor;
CalcTrianglePoints;
@ -240,12 +226,8 @@ end;
constructor TArrow.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
FAntiAliasingMode := amDontCare;
Constraints.MinHeight:= ArrowMinHeight;
Constraints.MinWidth:= ArrowMinHeight;
with GetControlClassDefaultSize do
SetInitialBounds(0, 0, cx, cy);
ControlStyle := ControlStyle - [csSetCaption];
FArrowType:= atLeft; // set defaults to match TArrow component
FShadowType:= stEtchedIn;
FArrowColor:= clBlack;