paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-05 07:00:27 +01:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: fix wmf drawer crashing due to missing canvas in TADrawerWMF

Browse Source 
git-svn-id: trunk@44559 -
This commit is contained in:
wp 2014-03-30 19:51:14 +00:00
parent 7a5bfb6e30
commit 1e97dab2e1
2 changed files with 11 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/tachart/tadrawercanvas.pas
View File

@ -48,7 +48,7 @@ type
procedure Ellipse(AX1, AY1, AX2, AY2: Integer); procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
procedure FillRect(AX1, AY1, AX2, AY2: Integer); procedure FillRect(AX1, AY1, AX2, AY2: Integer);
function GetBrushColor: TChartColor; function GetBrushColor: TChartColor;
function GetCanvas: TCanvas; function GetCanvas: TCanvas; virtual;
procedure Line(AX1, AY1, AX2, AY2: Integer); procedure Line(AX1, AY1, AX2, AY2: Integer);
procedure Line(const AP1, AP2: TPoint); procedure Line(const AP1, AP2: TPoint);
procedure LineTo(AX, AY: Integer); override; procedure LineTo(AX, AY: Integer); override;

12
components/tachart/tadrawerwmf.pas
View File

@ -86,13 +86,13 @@ type
strict private strict private
FFileName: String; FFileName: String;
FMetafile: TMetafile; FMetafile: TMetafile;
FMetafileCanvas: TMetafileCanvas;
public public
constructor Create(const AFileName: String); reintroduce; constructor Create(const AFileName: String); reintroduce;
destructor Destroy; override; destructor Destroy; override;
public public
procedure DrawingBegin(const ABoundingBox: TRect); override; procedure DrawingBegin(const ABoundingBox: TRect); override;
procedure DrawingEnd; override; procedure DrawingEnd; override;
function GetCanvas: TCanvas; override;
end; end;
implementation implementation
@ -119,7 +119,8 @@ end;
procedure TWindowsMetafileDrawer.DrawingBegin(const ABoundingBox: TRect); procedure TWindowsMetafileDrawer.DrawingBegin(const ABoundingBox: TRect);
begin begin
inherited DrawingBegin(ABoundingBox); inherited DrawingBegin(ABoundingBox);
FCanvas := TMetafileCanvas.Create(FMetafile, 0); if FCanvas = nil then
FCanvas := TMetafileCanvas.Create(FMetafile, 0);
end; end;
procedure TWindowsMetafileDrawer.DrawingEnd; procedure TWindowsMetafileDrawer.DrawingEnd;
@ -128,6 +129,13 @@ begin
FMetafile.SaveToFile(FFileName); FMetafile.SaveToFile(FFileName);
end; end;
function TWindowsMetafileDrawer.GetCanvas: TCanvas;
begin
if FCanvas = nil then
FCanvas := TMetafileCanvas.Create(FMetafile, 0);
Result := FCanvas;
end;
{ TMetafile } { TMetafile }
procedure TMetafile.DeleteImage; procedure TMetafile.DeleteImage;