mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 11:09:42 +02:00
fpvectorial: Implements support for clipping regions, specially for PostScript
git-svn-id: trunk@18036 -
This commit is contained in:
parent
0976115115
commit
9fe7e691b0
@ -71,6 +71,8 @@ type
|
||||
public
|
||||
Color: TFPColor;
|
||||
TranslateX, TranslateY: Double;
|
||||
ClipPath: TPath;
|
||||
ClipMode: TvClipMode;
|
||||
function Duplicate: TGraphicState;
|
||||
end;
|
||||
|
||||
@ -144,6 +146,7 @@ begin
|
||||
Result.Color := Color;
|
||||
Result.TranslateX := TranslateX;
|
||||
Result.TranslateY := TranslateY;
|
||||
Result.ClipPath := ClipPath;
|
||||
end;
|
||||
|
||||
{ TPSToken }
|
||||
@ -1467,6 +1470,7 @@ begin
|
||||
{$ifdef FPVECTORIALDEBUG_PATHS}
|
||||
WriteLn('[TvEPSVectorialReader.ExecutePathConstructionOperator] newpath');
|
||||
{$endif}
|
||||
AData.SetClipPath(CurrentGraphicState.ClipPath, CurrentGraphicState.ClipMode);
|
||||
AData.EndPath();
|
||||
AData.StartPath();
|
||||
|
||||
@ -1611,6 +1615,10 @@ begin
|
||||
// – eoclip – Clip using even-odd rule
|
||||
if AToken.StrValue = 'eoclip' then
|
||||
begin
|
||||
AData.SetPenStyle(psClear);
|
||||
AData.EndPath();
|
||||
CurrentGraphicState.ClipPath := AData.GetPath(AData.GetPathCount()-1);
|
||||
CurrentGraphicState.ClipMode := vcmEvenOddRule;
|
||||
Exit(True);
|
||||
end
|
||||
end;
|
||||
|
@ -157,11 +157,15 @@ type
|
||||
constructor Create; virtual;
|
||||
end;
|
||||
|
||||
TvClipMode = (vcmNonzeroWindingRule, vcmEvenOddRule);
|
||||
|
||||
TPath = class(TvEntity)
|
||||
Len: Integer;
|
||||
Points: TPathSegment; // Beginning of the double-linked list
|
||||
PointsEnd: TPathSegment; // End of the double-linked list
|
||||
Points: TPathSegment; // Beginning of the double-linked list
|
||||
PointsEnd: TPathSegment;// End of the double-linked list
|
||||
CurPoint: TPathSegment; // Used in PrepareForSequentialReading and Next
|
||||
ClipPath: TPath;
|
||||
ClipMode: TvClipMode;
|
||||
procedure Assign(ASource: TPath);
|
||||
procedure PrepareForSequentialReading;
|
||||
function Next(): TPathSegment;
|
||||
@ -303,6 +307,7 @@ type
|
||||
procedure SetPenColor(AColor: TFPColor);
|
||||
procedure SetPenStyle(AStyle: TFPPenStyle);
|
||||
procedure SetPenWidth(AWidth: Integer);
|
||||
procedure SetClipPath(AClipPath: TPath; AClipMode: TvClipMode);
|
||||
procedure EndPath();
|
||||
procedure AddText(AX, AY, AZ: Double; FontName: string; FontSize: integer; AText: utf8string); overload;
|
||||
procedure AddText(AX, AY, AZ: Double; AStr: utf8string); overload;
|
||||
@ -737,6 +742,13 @@ begin
|
||||
FTmPPath.Pen.Width := AWidth;
|
||||
end;
|
||||
|
||||
procedure TvVectorialDocument.SetClipPath(AClipPath: TPath;
|
||||
AClipMode: TvClipMode);
|
||||
begin
|
||||
FTmPPath.ClipPath := AClipPath;
|
||||
FTmPPath.ClipMode := AClipMode;
|
||||
end;
|
||||
|
||||
{@@
|
||||
Finishes writing a Path, which was created in multiple
|
||||
steps using StartPath and AddPointToPath,
|
||||
@ -885,15 +897,6 @@ procedure TvVectorialDocument.ClearTmpPath();
|
||||
var
|
||||
segment, oldsegment: TPathSegment;
|
||||
begin
|
||||
// segment := FTmpPath.Points;
|
||||
// Don't free segments, because they are used when the path is added
|
||||
// while segment <> nil do
|
||||
// begin
|
||||
// oldsegment := segment;
|
||||
// segment := segment^.Next;
|
||||
// oldsegment^.Free;
|
||||
// end;
|
||||
|
||||
FTmpPath.Points := nil;
|
||||
FTmpPath.PointsEnd := nil;
|
||||
FTmpPath.Len := 0;
|
||||
@ -1240,6 +1243,8 @@ begin
|
||||
CurPoint := ASource.CurPoint;
|
||||
Pen := ASource.Pen;
|
||||
Brush := ASource.Brush;
|
||||
ClipPath := ASource.ClipPath;
|
||||
ClipMode := ASource.ClipMode;
|
||||
end;
|
||||
|
||||
procedure TPath.PrepareForSequentialReading;
|
||||
|
@ -9,11 +9,11 @@ interface
|
||||
uses
|
||||
Classes, SysUtils, Math,
|
||||
{$ifdef USE_LCL_CANVAS}
|
||||
Graphics, LCLIntf,
|
||||
Graphics, LCLIntf, LCLType,
|
||||
{$endif}
|
||||
fpcanvas,
|
||||
fpimage,
|
||||
fpvectorial;
|
||||
fpvectorial, fpvutils;
|
||||
|
||||
procedure DrawFPVectorialToCanvas(ASource: TvVectorialDocument;
|
||||
ADest: TFPCustomCanvas;
|
||||
@ -155,6 +155,11 @@ var
|
||||
t: Double;
|
||||
// For polygons
|
||||
Points: array of TPoint;
|
||||
// Clipping Region
|
||||
{$ifdef USE_LCL_CANVAS}
|
||||
ClipRegion, OldClipRegion: HRGN;
|
||||
ACanvas: TCanvas absolute ADest;
|
||||
{$endif}
|
||||
begin
|
||||
PosX := 0;
|
||||
PosY := 0;
|
||||
@ -162,17 +167,29 @@ begin
|
||||
|
||||
ADest.MoveTo(ADestX, ADestY);
|
||||
|
||||
CurPath.PrepareForSequentialReading;
|
||||
|
||||
// Set the path Pen and Brush options
|
||||
ADest.Pen.Style := CurPath.Pen.Style;
|
||||
ADest.Pen.Width := CurPath.Pen.Width;
|
||||
ADest.Pen.FPColor := CurPath.Pen.Color;
|
||||
ADest.Brush.FPColor := CurPath.Brush.Color;
|
||||
|
||||
// Prepare the Clipping Region, if any
|
||||
{$ifdef USE_LCL_CANVAS}
|
||||
if CurPath.ClipPath <> nil then
|
||||
begin
|
||||
OldClipRegion := LCLIntf.CreateEmptyRegion();
|
||||
GetClipRgn(ACanvas.Handle, OldClipRegion);
|
||||
ClipRegion := ConvertPathToRegion(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY);
|
||||
SelectClipRgn(ACanvas.Handle, ClipRegion);
|
||||
DeleteObject(ClipRegion);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
//
|
||||
// For solid paths, draw a polygon instead
|
||||
//
|
||||
CurPath.PrepareForSequentialReading;
|
||||
|
||||
if CurPath.Brush.Style = bsSolid then
|
||||
begin
|
||||
ADest.Brush.Style := CurPath.Brush.Style;
|
||||
@ -281,6 +298,14 @@ begin
|
||||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||||
WriteLn('');
|
||||
{$endif}
|
||||
|
||||
// Restores the previous Clip Region
|
||||
{$ifdef USE_LCL_CANVAS}
|
||||
if CurPath.ClipPath <> nil then
|
||||
begin
|
||||
SelectClipRgn(ACanvas.Handle, OldClipRegion); //Using OldClipRegion crashes in Qt
|
||||
end;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure DrawFPVEntityToCanvas(ASource: TvVectorialDocument; CurEntity: TvEntity;
|
||||
|
@ -11,6 +11,8 @@ AUTHORS: Felipe Monteiro de Carvalho
|
||||
}
|
||||
unit fpvutils;
|
||||
|
||||
{.$define USE_LCL_CANVAS}
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
@ -19,6 +21,9 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Math,
|
||||
{$ifdef USE_LCL_CANVAS}
|
||||
Graphics, LCLIntf, LCLType,
|
||||
{$endif}
|
||||
fpvectorial, fpimage;
|
||||
|
||||
type
|
||||
@ -27,13 +32,20 @@ type
|
||||
// Color Conversion routines
|
||||
function FPColorToRGBHexString(AColor: TFPColor): string;
|
||||
function RGBToFPColor(AR, AG, AB: byte): TFPColor; inline;
|
||||
// Other routine
|
||||
// Coordinate Conversion routines
|
||||
function CanvasCoordsToFPVectorial(AY: Integer; AHeight: Integer): Integer; inline;
|
||||
function CanvasTextPosToFPVectorial(AY: Integer; ACanvasHeight, ATextHeight: Integer): Integer;
|
||||
function CoordToCanvasX(ACoord: Double; ADestX: Integer; AMulX: Double): Integer; inline;
|
||||
function CoordToCanvasY(ACoord: Double; ADestY: Integer; AMulY: Double): Integer; inline;
|
||||
// Other routines
|
||||
function SeparateString(AString: string; ASeparator: char): T10Strings;
|
||||
// Mathematical routines
|
||||
procedure EllipticalArcToBezier(Xc, Yc, Rx, Ry, startAngle, endAngle: Double; var P1, P2, P3, P4: T3DPoint);
|
||||
procedure CircularArcToBezier(Xc, Yc, R, startAngle, endAngle: Double; var P1, P2, P3, P4: T3DPoint);
|
||||
// LCL-related routines
|
||||
{$ifdef USE_LCL_CANVAS}
|
||||
function ConvertPathToRegion(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double): HRGN;
|
||||
{$endif}
|
||||
|
||||
implementation
|
||||
|
||||
@ -78,6 +90,16 @@ begin
|
||||
Result := CanvasCoordsToFPVectorial(AY, ACanvasHeight) - ATextHeight;
|
||||
end;
|
||||
|
||||
function CoordToCanvasX(ACoord: Double; ADestX: Integer; AMulX: Double): Integer;
|
||||
begin
|
||||
Result := Round(ADestX + AmulX * ACoord);
|
||||
end;
|
||||
|
||||
function CoordToCanvasY(ACoord: Double; ADestY: Integer; AMulY: Double): Integer;
|
||||
begin
|
||||
Result := Round(ADestY + AmulY * ACoord);
|
||||
end;
|
||||
|
||||
{@@
|
||||
Reads a string and separates it in substring
|
||||
using ASeparator to delimite them.
|
||||
@ -164,5 +186,38 @@ begin
|
||||
EllipticalArcToBezier(Xc, Yc, R, R, startAngle, endAngle, P1, P2, P3, P4);
|
||||
end;
|
||||
|
||||
{$ifdef USE_LCL_CANVAS}
|
||||
function ConvertPathToRegion(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double): HRGN;
|
||||
var
|
||||
i: Integer;
|
||||
WindingMode: Integer;
|
||||
Points: array of TPoint;
|
||||
CoordX, CoordY: Integer;
|
||||
// Segments
|
||||
CurSegment: TPathSegment;
|
||||
Cur2DSegment: T2DSegment absolute CurSegment;
|
||||
begin
|
||||
APath.PrepareForSequentialReading;
|
||||
|
||||
SetLength(Points, APath.Len);
|
||||
|
||||
for i := 0 to APath.Len - 1 do
|
||||
begin
|
||||
CurSegment := TPathSegment(APath.Next());
|
||||
|
||||
CoordX := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
|
||||
CoordY := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
|
||||
|
||||
Points[i].X := CoordX;
|
||||
Points[i].Y := CoordY;
|
||||
end;
|
||||
|
||||
if APath.ClipMode = vcmEvenOddRule then WindingMode := LCLType.ALTERNATE
|
||||
else WindingMode := LCLType.WINDING;
|
||||
|
||||
Result := LCLIntf.CreatePolygonRgn(@Points[0], APath.Len, WindingMode);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
end.
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user