Starts adding more complex region support in lazcanvas

git-svn-id: trunk@33731 -
This commit is contained in:
sekelsenmat 2011-11-23 17:29:12 +00:00
parent 31e5579de6
commit 6966f1da55
2 changed files with 28 additions and 2 deletions

View File

@ -34,7 +34,9 @@ uses
// RTL
Classes, SysUtils,
// FCL-Image
fpimgcanv, fpcanvas, fpimage;
fpimgcanv, fpcanvas, fpimage,
// regions
lazregions;
type
@ -53,17 +55,24 @@ type
private
FAssignedBrush: TFPCustomBrush;
FAssignedPen: TFPCustomPen;
FUseSimpleRectClipping: Boolean;
FLazClipRegion: TLazRegion;
function GetAssignedBrush: TFPCustomBrush;
function GetAssignedPen: TFPCustomPen;
protected
procedure SetColor (x,y:integer; const AValue:TFPColor); override;
public
constructor create (AnImage : TFPCustomImage);
destructor destroy; override;
procedure SetLazClipRegion(ARegion: TLazRegion);
// Utilized by LCLIntf.SelectObject
procedure AssignPenData(APen: TFPCustomPen);
procedure AssignBrushData(ABrush: TFPCustomBrush);
// These properties are utilized to implement LCLIntf.SelectObject
property AssignedPen: TFPCustomPen read GetAssignedPen write FAssignedPen;
property AssignedBrush: TFPCustomBrush read GetAssignedBrush write FAssignedBrush;
//
property UseSimpleRectClipping: Boolean read FUseSimpleRectClipping write FUseSimpleRectClipping;
end;
implementation
@ -86,9 +95,15 @@ begin
Result := FAssignedPen;
end;
procedure TLazCanvas.SetColor(x, y: integer; const AValue: TFPColor);
begin
inherited SetColor(x, y, AValue);
end;
constructor TLazCanvas.create(AnImage: TFPCustomImage);
begin
inherited Create(AnImage);
FUseSimpleRectClipping := True;
end;
destructor TLazCanvas.destroy;
@ -97,6 +112,16 @@ begin
inherited destroy;
end;
procedure TLazCanvas.SetLazClipRegion(ARegion: TLazRegion);
begin
if ARegion.IsSimpleRectRegion then
begin
Clipping := True;
ClipRect := TLazRegionRect(ARegion.Parts.Items[0]).Rect;
FLazClipRegion := ARegion;
end;
end;
procedure TLazCanvas.AssignPenData(APen: TFPCustomPen);
begin
Pen.FPColor := APen.FPColor;

View File

@ -36,6 +36,7 @@ type
// these areas should be removed from all parts of the region
// There is no z-order for the parts, they are all validly inside the region area
Parts: TFPList; // of TLazRegionPart
IsSimpleRectRegion: Boolean; // Indicates whether this region has only 1 rectangular part
constructor Create; virtual;
destructor Destroy; override;
procedure AddRectangle(ARect: TRect);
@ -52,7 +53,7 @@ type
// The order in this list is also the Z-Order of the sub regions inside it
// The element with index zero is the bottom-most one
Childs: TFPList; // of TLazRegionWithChilds
Owner: TObject; // link to for example a owner TWinControl
UserData: TObject; // available link to another object
constructor Create; override;
destructor Destroy; override;
function IsPointInRegion(AX, AY: Integer): TLazRegionWithChilds; virtual;