paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-04 04:50:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

Adds support to join style and endcap in TFPCustomPen in fcl-image

Browse Source 
git-svn-id: trunk@23297 -
This commit is contained in:
sekelsenmat 2013-01-02 14:28:09 +00:00
parent 21d62277ce
commit b0980b342d
2 changed files with 30 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
packages/fcl-image/src/fpcanvas.pp
View File

@ -114,6 +114,18 @@ type
pmMergePenNot, pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge, pmMergePenNot, pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge,
pmNotMerge, pmMask, pmNotMask, pmXor, pmNotXor); pmNotMerge, pmMask, pmNotMask, pmXor, pmNotXor);
TPenPattern = Longword; TPenPattern = Longword;
TFPPenEndCap = (
pecRound,
pecSquare,
pecFlat
);
TFPPenJoinStyle = (
pjsRound,
pjsBevel,
pjsMiter
);
{ TFPCustomPen }
TFPCustomPen = class (TFPCanvasHelper) TFPCustomPen = class (TFPCanvasHelper)
private private
@ -121,12 +133,16 @@ type
FWidth : Integer; FWidth : Integer;
FMode : TFPPenMode; FMode : TFPPenMode;
FPattern : longword; FPattern : longword;
FEndCap: TFPPenEndCap;
FJoinStyle: TFPPenJoinStyle;
protected protected
procedure DoCopyProps (From:TFPCanvasHelper); override; procedure DoCopyProps (From:TFPCanvasHelper); override;
procedure SetMode (AValue : TFPPenMode); virtual; procedure SetMode (AValue : TFPPenMode); virtual;
procedure SetWidth (AValue : Integer); virtual; procedure SetWidth (AValue : Integer); virtual;
procedure SetStyle (AValue : TFPPenStyle); virtual; procedure SetStyle (AValue : TFPPenStyle); virtual;
procedure SetPattern (AValue : longword); virtual; procedure SetPattern (AValue : longword); virtual;
procedure SetEndCap(AValue: TFPPenEndCap); virtual;
procedure SetJoinStyle(AValue: TFPPenJoinStyle); virtual;
public public
function CopyPen : TFPCustomPen; function CopyPen : TFPCustomPen;
// Creates a copy of the pen with all properties the same, but not allocated // Creates a copy of the pen with all properties the same, but not allocated
@ -134,6 +150,8 @@ type
property Width : Integer read FWidth write SetWidth; property Width : Integer read FWidth write SetWidth;
property Mode : TFPPenMode read FMode write SetMode; property Mode : TFPPenMode read FMode write SetMode;
property Pattern : longword read FPattern write SetPattern; property Pattern : longword read FPattern write SetPattern;
property EndCap : TFPPenEndCap read FEndCap write SetEndCap;
property JoinStyle : TFPPenJoinStyle read FJoinStyle write SetJoinStyle;
end; end;
TFPCustomPenClass = class of TFPCustomPen; TFPCustomPenClass = class of TFPCustomPen;

12
packages/fcl-image/src/fppen.inc
View File

@ -37,6 +37,18 @@ begin
FPattern := AValue; FPattern := AValue;
end; end;
procedure TFPCustomPen.SetEndCap(AValue: TFPPenEndCap);
begin
if FEndCap=AValue then Exit;
FEndCap:=AValue;
end;
procedure TFPCustomPen.SetJoinStyle(AValue: TFPPenJoinStyle);
begin
if FJoinStyle=AValue then Exit;
FJoinStyle:=AValue;
end;
procedure TFPCustomPen.DoCopyProps (From:TFPCanvasHelper); procedure TFPCustomPen.DoCopyProps (From:TFPCanvasHelper);
begin begin
with From as TFPCustomPen do with From as TFPCustomPen do