mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-03 11:19:25 +01:00
TAChart: Add initial fpvectorial drawing back-end
git-svn-id: trunk@30398 -
This commit is contained in:
ask
parent
179e5fcd40
commit
b328af41a7
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -2454,6 +2454,8 @@ components/tachart/tachartaggpas.pas svneol=native#text/pascal
|
||||
components/tachart/tachartaxis.pas svneol=native#text/pascal
|
||||
components/tachart/tachartbgra.lpk svneol=native#text/pascal
|
||||
components/tachart/tachartbgra.pas svneol=native#text/pascal
|
||||
components/tachart/tachartfpvectorial.lpk svneol=native#text/plain
|
||||
components/tachart/tachartfpvectorial.pas svneol=native#text/pascal
|
||||
components/tachart/tachartlazaruspkg.lpk svneol=native#text/plain
|
||||
components/tachart/tachartlazaruspkg.pas svneol=native#text/plain
|
||||
components/tachart/tachartutils.pas svneol=native#text/plain
|
||||
@ -2466,6 +2468,7 @@ components/tachart/tadraweraggpas.pas svneol=native#text/pascal
|
||||
components/tachart/tadrawerbgra.pas svneol=native#text/pascal
|
||||
components/tachart/tadrawercanvas.pas svneol=native#text/pascal
|
||||
components/tachart/tadrawerfpcanvas.pas svneol=native#text/pascal
|
||||
components/tachart/tadrawerfpvectorial.pas svneol=native#text/pascal
|
||||
components/tachart/tadraweropengl.pas svneol=native#text/pascal
|
||||
components/tachart/tadrawersvg.pas svneol=native#text/pascal
|
||||
components/tachart/tadrawerwmf.pas svneol=native#text/pascal
|
||||
|
||||
48
components/tachart/tachartfpvectorial.lpk
Normal file
48
components/tachart/tachartfpvectorial.lpk
Normal file
@ -0,0 +1,48 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<Package Version="3">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="TAChartFPVectorial"/>
|
||||
<Author Value="Alexander Klenin"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="10"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\$(LCLWidgetType)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<UseMsgFile Value="True"/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Description Value="FPVectorial drawing back-end for TAChart"/>
|
||||
<Version Major="1"/>
|
||||
<Files Count="1">
|
||||
<Item1>
|
||||
<Filename Value="tadrawerfpvectorial.pas"/>
|
||||
<UnitName Value="TADrawerFPVectorial"/>
|
||||
</Item1>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="3">
|
||||
<Item1>
|
||||
<PackageName Value="TAChartLazarusPkg"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="fpvectorialpkg"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="FCL"/>
|
||||
<MinVersion Major="1" Release="1" Valid="True"/>
|
||||
</Item3>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
20
components/tachart/tachartfpvectorial.pas
Normal file
20
components/tachart/tachartfpvectorial.pas
Normal file
@ -0,0 +1,20 @@
|
||||
{ This file was automatically created by Lazarus. Do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit TAChartFPVectorial;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
TADrawerFPVectorial, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('TAChartFPVectorial', @Register);
|
||||
end.
|
||||
250
components/tachart/tadrawerfpvectorial.pas
Normal file
250
components/tachart/tadrawerfpvectorial.pas
Normal file
@ -0,0 +1,250 @@
|
||||
{
|
||||
*****************************************************************************
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program is distributed in the hope that it will be useful, *
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
|
||||
Authors: Alexander Klenin
|
||||
|
||||
}
|
||||
unit TADrawerFPVectorial;
|
||||
|
||||
{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, FPCanvas, FPVectorial, TADrawUtils;
|
||||
|
||||
type
|
||||
|
||||
{ TFPVectorialDrawer }
|
||||
|
||||
TFPVectorialDrawer = class(TBasicDrawer, IChartDrawer)
|
||||
strict private
|
||||
FBrushColor: TvColor;
|
||||
FCanvas: TvVectorialDocument;
|
||||
FPenColor: TvColor;
|
||||
strict protected
|
||||
function GetFontAngle: Double; override;
|
||||
procedure SetBrush(ABrush: TFPCustomBrush);
|
||||
procedure SetFont(AFont: TFPCustomFont);
|
||||
procedure SetPen(APen: TFPCustomPen);
|
||||
function SimpleTextExtent(const AText: String): TPoint; override;
|
||||
procedure SimpleTextOut(AX, AY: Integer; const AText: String); override;
|
||||
public
|
||||
constructor Create(ACanvas: TvVectorialDocument);
|
||||
public
|
||||
procedure AddToFontOrientation(ADelta: Integer);
|
||||
procedure ClippingStart;
|
||||
procedure ClippingStart(const AClipRect: TRect);
|
||||
procedure ClippingStop;
|
||||
procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
|
||||
procedure FillRect(AX1, AY1, AX2, AY2: Integer);
|
||||
function GetBrushColor: TChartColor;
|
||||
procedure Line(AX1, AY1, AX2, AY2: Integer);
|
||||
procedure Line(const AP1, AP2: TPoint); overload;
|
||||
procedure LineTo(AX, AY: Integer); override;
|
||||
procedure MoveTo(AX, AY: Integer); override; overload;
|
||||
procedure Polygon(
|
||||
const APoints: array of TPoint; AStartIndex, ANumPts: Integer); override;
|
||||
procedure Polyline(
|
||||
const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
|
||||
procedure PrepareSimplePen(AColor: TChartColor);
|
||||
procedure RadialPie(
|
||||
AX1, AY1, AX2, AY2: Integer;
|
||||
AStartAngle16Deg, AAngleLength16Deg: Integer);
|
||||
procedure Rectangle(const ARect: TRect);
|
||||
procedure Rectangle(AX1, AY1, AX2, AY2: Integer);
|
||||
procedure SetBrushColor(AColor: TChartColor);
|
||||
procedure SetBrushParams(AStyle: TFPBrushStyle; AColor: TChartColor);
|
||||
procedure SetPenParams(AStyle: TFPPenStyle; AColor: TChartColor);
|
||||
end experimental;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
TAChartUtils, TAGeometry;
|
||||
|
||||
function ChartColorToVColor(AColor: TChartColor): TvColor;
|
||||
begin
|
||||
Result.Alpha := 255;
|
||||
Result.Red := AColor;
|
||||
Result.Green := AColor shr 8;
|
||||
Result.Blue := AColor shr 16;
|
||||
end;
|
||||
|
||||
function VColorToChartColor(AColor: TvColor): TChartColor;
|
||||
begin
|
||||
with AColor do
|
||||
Result := Red + (Green shl 8) + (Blue shl 16);
|
||||
end;
|
||||
|
||||
{ TFPVectorialDrawer }
|
||||
|
||||
procedure TFPVectorialDrawer.AddToFontOrientation(ADelta: Integer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.ClippingStart(const AClipRect: TRect);
|
||||
begin
|
||||
Unused(AClipRect); // Not implemented.
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.ClippingStart;
|
||||
begin
|
||||
// Not implemented.
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.ClippingStop;
|
||||
begin
|
||||
// Not implemented.
|
||||
end;
|
||||
|
||||
constructor TFPVectorialDrawer.Create(ACanvas: TvVectorialDocument);
|
||||
begin
|
||||
inherited Create;
|
||||
FCanvas := ACanvas;
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.Ellipse(AX1, AY1, AX2, AY2: Integer);
|
||||
var
|
||||
cx, cy, rx, ry: Integer;
|
||||
begin
|
||||
BoundingBoxToCenterAndHalfRadius(AX1, AY1, AX2, AY2, cx, cy, rx, ry);
|
||||
FCanvas.AddEllipse(cx, cy, 0, rx, ry, 0.0);
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.FillRect(AX1, AY1, AX2, AY2: Integer);
|
||||
begin
|
||||
// Not implemented.
|
||||
end;
|
||||
|
||||
function TFPVectorialDrawer.GetBrushColor: TChartColor;
|
||||
begin
|
||||
Result := VColorToChartColor(FBrushColor);
|
||||
end;
|
||||
|
||||
function TFPVectorialDrawer.GetFontAngle: Double;
|
||||
begin
|
||||
Result := 0.0;
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.Line(AX1, AY1, AX2, AY2: Integer);
|
||||
begin
|
||||
FCanvas.StartPath(AX1, AY1);
|
||||
FCanvas.AddLineToPath(AX2, AY2, FPenColor);
|
||||
FCanvas.EndPath();
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.Line(const AP1, AP2: TPoint);
|
||||
begin
|
||||
Line(AP1.X, AP1.Y, AP2.Y, AP2.Y);
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.LineTo(AX, AY: Integer);
|
||||
begin
|
||||
FCanvas.AddLineToPath(AX, AY, FPenColor);
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.MoveTo(AX, AY: Integer);
|
||||
begin
|
||||
FCanvas.EndPath();
|
||||
FCanvas.StartPath(AX, AY);
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.Polygon(
|
||||
const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
|
||||
begin
|
||||
// Not implemented.
|
||||
Polyline(APoints, AStartIndex, ANumPts);
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.Polyline(
|
||||
const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
MoveTo(APoints[AStartIndex]);
|
||||
for i := 1 to ANumPts - 1 do
|
||||
with APoints[i + AStartIndex] do
|
||||
FCanvas.AddLineToPath(X, Y, FPenColor);
|
||||
FCanvas.EndPath();
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.PrepareSimplePen(AColor: TChartColor);
|
||||
begin
|
||||
FPenColor := ChartColorToVColor(AColor);
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.RadialPie(
|
||||
AX1, AY1, AX2, AY2: Integer; AStartAngle16Deg, AAngleLength16Deg: Integer);
|
||||
begin
|
||||
// Not implemented.
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.Rectangle(AX1, AY1, AX2, AY2: Integer);
|
||||
begin
|
||||
// Not implemented.
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.Rectangle(const ARect: TRect);
|
||||
begin
|
||||
// Not implemented.
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.SetBrush(ABrush: TFPCustomBrush);
|
||||
begin
|
||||
FBrushColor := ChartColorToVColor(FPColorToChartColor(ABrush.FPColor));
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.SetBrushColor(AColor: TChartColor);
|
||||
begin
|
||||
FBrushColor := ChartColorToVColor(AColor);
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.SetBrushParams(
|
||||
AStyle: TFPBrushStyle; AColor: TChartColor);
|
||||
begin
|
||||
Unused(AStyle);
|
||||
SetBrushColor(AColor);
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.SetFont(AFont: TFPCustomFont);
|
||||
begin
|
||||
// Not implemented.
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.SetPen(APen: TFPCustomPen);
|
||||
begin
|
||||
FPenColor := ChartColorToVColor(FPColorToChartColor(APen.FPColor));
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.SetPenParams(
|
||||
AStyle: TFPPenStyle; AColor: TChartColor);
|
||||
begin
|
||||
Unused(AStyle);
|
||||
FPenColor := ChartColorToVColor(AColor);
|
||||
end;
|
||||
|
||||
function TFPVectorialDrawer.SimpleTextExtent(const AText: String): TPoint;
|
||||
begin
|
||||
Result.X := Length(AText) * 8;
|
||||
Result.Y := 8;
|
||||
end;
|
||||
|
||||
procedure TFPVectorialDrawer.SimpleTextOut(
|
||||
AX, AY: Integer; const AText: String);
|
||||
begin
|
||||
FCanvas.AddText(AX, AY, 0, AText);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user