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

LCL: improvements for TArrow. Publish Color, call Invalidate when setting properties.

Browse Source 
git-svn-id: trunk@40975 -
This commit is contained in:
juha 2013-05-01 16:46:35 +00:00
parent 9255f8d208
commit 4f2fb8c377
1 changed files with 16 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
lcl/arrow.pp
View File

@ -44,11 +44,9 @@ type
TArrow = class(TCustomControl) TArrow = class(TCustomControl)
private private
FArrowType : TArrowType; fArrowType : TArrowType;
FShadowType : TShadowType; fShadowType : TShadowType;
function GetShadowType: TShadowType;
procedure SetShadowType(const AValue: TShadowType); procedure SetShadowType(const AValue: TShadowType);
function GetArrowType: TArrowType;
procedure SetArrowType(const AValue: TArrowType); procedure SetArrowType(const AValue: TArrowType);
procedure SetProps; procedure SetProps;
protected protected
@ -60,21 +58,22 @@ type
procedure Loaded; override; procedure Loaded; override;
procedure InitializeWnd; override; procedure InitializeWnd; override;
published published
property ArrowType: TArrowType read fArrowType write SetArrowType default atLeft;
property ShadowType: TShadowType read fShadowType write SetShadowType default stEtchedIn;
property Align; property Align;
property Anchors; property Anchors;
property ArrowType: TArrowType read GetArrowType write SetArrowType default atLeft;
property BorderSpacing; property BorderSpacing;
property ShadowType: TShadowType read fShadowType write SetShadowType default stEtchedIn; property Color;
property OnChangeBounds;
property PopupMenu;
property Visible; property Visible;
property OnClick; property OnClick;
property OnContextPopup;
property OnDblClick; property OnDblClick;
property OnMouseMove; property OnMouseMove;
property OnMouseDown; property OnMouseDown;
property OnMouseUp; property OnMouseUp;
property OnChangeBounds;
property OnResize; property OnResize;
property OnContextPopup;
property PopupMenu;
end; end;
procedure Register; procedure Register;
@ -127,26 +126,26 @@ begin
SetProps; SetProps;
end; end;
function TArrow.GetArrowType: TArrowType;
begin
Result := FArrowType;
end;
procedure TArrow.SetArrowType(const AValue: TArrowType); procedure TArrow.SetArrowType(const AValue: TArrowType);
begin begin
if fArrowType = aValue then Exit;
fArrowType := AValue; fArrowType := AValue;
SetProps; SetProps;
Invalidate;
end; end;
function TArrow.GetShadowType: TShadowType; procedure TArrow.SetShadowType(const AValue: TShadowType);
begin begin
Result := FShadowType; if fShadowType = aValue then Exit;
fShadowType := aValue;
SetProps;
Invalidate;
end; end;
procedure TArrow.SetProps; procedure TArrow.SetProps;
begin begin
if HandleAllocated and (not (csLoading in ComponentState)) then if HandleAllocated and (not (csLoading in ComponentState)) then
TWSArrowClass(WidgetSetClass).SetType(Self, FArrowType, FShadowType); TWSArrowClass(WidgetSetClass).SetType(Self, fArrowType, fShadowType);
end; end;
class procedure TArrow.WSRegisterClass; class procedure TArrow.WSRegisterClass;
@ -155,10 +154,4 @@ begin
RegisterArrow; RegisterArrow;
end; end;
procedure TArrow.SetShadowType(const AValue: TShadowType);
begin
FShadowType := aValue;
SetProps;
end;
end. end.