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

TArrow: cleanup, added AntiAliasingMode property, published ParentColor, Hint and ShowHint.

Browse Source 
git-svn-id: trunk@41226 -
This commit is contained in:
zeljko 2013-05-16 15:59:41 +00:00
parent f76ef23ed9
commit 0923bb8e5e
1 changed files with 15 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
lcl/arrow.pp
View File

@ -39,6 +39,7 @@ type
TArrow = class(TGraphicControl) TArrow = class(TGraphicControl)
private private
FAntiAliasingMode: TAntialiasingMode;
FArrowColor: TColor; FArrowColor: TColor;
FArrowType: TArrowType; FArrowType: TArrowType;
FR: TRect; FR: TRect;
@ -46,6 +47,7 @@ type
FT: TTrianglePoints; FT: TTrianglePoints;
procedure CalcTrianglePoints; procedure CalcTrianglePoints;
procedure GraphicChanged(Sender: TObject); procedure GraphicChanged(Sender: TObject);
procedure SetAntiAliasingMode(AValue: TAntialiasingMode);
procedure SetArrowColor(AValue: TColor); procedure SetArrowColor(AValue: TColor);
procedure SetArrowType(AValue: TArrowType); procedure SetArrowType(AValue: TArrowType);
procedure SetShadowType(AValue: TShadowType); procedure SetShadowType(AValue: TShadowType);
@ -57,11 +59,13 @@ type
published published
property Align; property Align;
property Anchors; property Anchors;
property AntiAliasingMode: TAntialiasingMode read FAntiAliasingMode write SetAntiAliasingMode default amDontCare;
property ArrowColor: TColor read FArrowColor write SetArrowColor default clBlack; property ArrowColor: TColor read FArrowColor write SetArrowColor default clBlack;
property ArrowType: TArrowType read FArrowType write SetArrowType default atLeft; property ArrowType: TArrowType read FArrowType write SetArrowType default atLeft;
property BorderSpacing; property BorderSpacing;
property Color; property Color;
property Constraints; property Constraints;
property Hint;
property OnChangeBounds; property OnChangeBounds;
property OnClick; property OnClick;
property OnContextPopup; property OnContextPopup;
@ -75,9 +79,11 @@ type
property OnPaint; property OnPaint;
property OnResize; property OnResize;
//property OnStartDrag; //property OnStartDrag;
property ParentColor;
property ParentShowHint; property ParentShowHint;
property PopupMenu; property PopupMenu;
property ShadowType: TShadowType read FShadowType write SetShadowType default stEtchedIn; property ShadowType: TShadowType read FShadowType write SetShadowType default stEtchedIn;
property ShowHint;
property Visible; property Visible;
end; end;
@ -145,6 +151,13 @@ begin
then Invalidate; then Invalidate;
end; end;
procedure TArrow.SetAntiAliasingMode(AValue: TAntialiasingMode);
begin
if FAntiAliasingMode=AValue then Exit;
FAntiAliasingMode:=AValue;
GraphicChanged(nil);
end;
procedure TArrow.SetArrowColor(AValue: TColor); procedure TArrow.SetArrowColor(AValue: TColor);
begin begin
if FArrowColor=AValue then Exit; if FArrowColor=AValue then Exit;
@ -205,6 +218,7 @@ const
end; end;
begin begin
Canvas.AntialiasingMode := FAntiAliasingMode;
Canvas.Brush.Color := Color; Canvas.Brush.Color := Color;
Canvas.FillRect(ClientRect); Canvas.FillRect(ClientRect);
@ -222,6 +236,7 @@ end;
constructor TArrow.Create(aOwner: TComponent); constructor TArrow.Create(aOwner: TComponent);
begin begin
inherited Create(aOwner); inherited Create(aOwner);
FAntiAliasingMode := amDontCare;
Constraints.MinHeight:= ArrowMinHeight; Constraints.MinHeight:= ArrowMinHeight;
Constraints.MinWidth:= ArrowMinHeight; Constraints.MinWidth:= ArrowMinHeight;
with GetControlClassDefaultSize do with GetControlClassDefaultSize do
@ -230,11 +245,6 @@ begin
FArrowType:= atLeft; // set defaults to match TArrow component FArrowType:= atLeft; // set defaults to match TArrow component
FShadowType:= stEtchedIn; FShadowType:= stEtchedIn;
FArrowColor:= clBlack; FArrowColor:= clBlack;
Canvas.Pen.Color := clBlack;
if Assigned(Parent)
then Color:= Parent.Color
else Color:= clBtnFace;
Canvas.Brush.Color := Color;
end; end;
end. end.