TAChart: Fix saving to bitmap (issue #13685)

* Add SaveToImage and SaveToFile methods.
* Implement SaveToBitmapFile and CopyToClipboardBitmap via SaveToImage/SaveToFile.
* Add demo.

git-svn-id: trunk@19918 -

.gitattributes

@@ -1544,6 +1544,11 @@ components/tachart/demo/func/funcdemo.lpr svneol=native#text/plain
 components/tachart/demo/func/main.lfm svneol=native#text/plain
 components/tachart/demo/func/main.lrs svneol=native#text/plain
 components/tachart/demo/func/main.pas svneol=native#text/plain
+components/tachart/demo/save/main.lfm svneol=native#text/plain
+components/tachart/demo/save/main.lrs svneol=native#text/plain
+components/tachart/demo/save/main.pas svneol=native#text/plain
+components/tachart/demo/save/savedemo.lpi svneol=native#text/plain
+components/tachart/demo/save/savedemo.lpr svneol=native#text/plain
 components/tachart/tachartlazaruspkg.lpk svneol=native#text/plain
 components/tachart/tachartlazaruspkg.pas svneol=native#text/plain
 components/tachart/tachartutils.pas svneol=native#text/plain

components/tachart/demo/save/main.lfm

@@ -0,0 +1,80 @@
+object Form1: TForm1
+  Left = 318
+  Height = 300
+  Top = 151
+  Width = 421
+  Caption = 'Form1'
+  ClientHeight = 300
+  ClientWidth = 421
+  OnCreate = FormCreate
+  LCLVersion = '0.9.27'
+  object Chart1: TChart
+    Left = 0
+    Height = 276
+    Top = 24
+    Width = 421
+    BottomAxis.Grid.Style = psDot
+    BottomAxis.Grid.Visible = True
+    Foot.Brush.Color = clBtnFace
+    Foot.Font.Color = clBlue
+    Frame.Visible = True
+    LeftAxis.Grid.Style = psDot
+    LeftAxis.Grid.Visible = True
+    LeftAxis.Title.Angle = 90
+    Title.Brush.Color = clBtnFace
+    Title.Font.Color = clBlue
+    Title.Text.Strings = (
+      'TAChart'
+    )
+    Align = alClient
+    ParentColor = False
+    object Chart1BarSeries1: TBarSeries
+      BarBrush.Color = clOlive
+      SeriesColor = clOlive
+    end
+    object Chart1FuncSeries1: TFuncSeries
+      Pen.Color = clRed
+      Pen.Width = 2
+      ZPosition = 1
+    end
+  end
+  object ToolBar1: TToolBar
+    Left = 0
+    Height = 24
+    Top = 0
+    Width = 421
+    ButtonWidth = 100
+    Caption = 'ToolBar1'
+    Flat = False
+    ShowCaptions = True
+    TabOrder = 1
+    object tbSaveAsBMP: TToolButton
+      Left = 1
+      Top = 2
+      Caption = 'Save as BMP'
+      OnClick = tbSaveAsBMPClick
+    end
+    object tbSaveAsPNG: TToolButton
+      Left = 101
+      Top = 2
+      Caption = 'Save as PNG'
+      OnClick = tbSaveAsPNGClick
+    end
+    object tbCopyToClipboard: TToolButton
+      Left = 301
+      Top = 2
+      Caption = 'Copy to clipboard'
+      OnClick = tbCopyToClipboardClick
+    end
+    object tbSaveAsJPEG: TToolButton
+      Left = 201
+      Top = 2
+      Caption = 'Save as JPEG'
+      OnClick = tbSaveAsJPEGClick
+    end
+  end
+  object SaveDialog1: TSaveDialog
+    left = 64
+    top = 56
+  end
+end

components/tachart/demo/save/main.lrs

@@ -0,0 +1,26 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TForm1','FORMDATA',[
+  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'>'#1#6'Height'#3','#1#3'Top'#3#151#0#5'Wi'
+  +'dth'#3#165#1#7'Caption'#6#5'Form1'#12'ClientHeight'#3','#1#11'ClientWidth'#3
+  +#165#1#8'OnCreate'#7#10'FormCreate'#10'LCLVersion'#6#6'0.9.27'#0#6'TChart'#6
+  +'Chart1'#4'Left'#2#0#6'Height'#3#20#1#3'Top'#2#24#5'Width'#3#165#1#21'Bottom'
+  +'Axis.Grid.Style'#7#5'psDot'#23'BottomAxis.Grid.Visible'#9#16'Foot.Brush.Col'
+  +'or'#7#9'clBtnFace'#15'Foot.Font.Color'#7#6'clBlue'#13'Frame.Visible'#9#19'L'
+  +'eftAxis.Grid.Style'#7#5'psDot'#21'LeftAxis.Grid.Visible'#9#20'LeftAxis.Titl'
+  +'e.Angle'#2'Z'#17'Title.Brush.Color'#7#9'clBtnFace'#16'Title.Font.Color'#7#6
+  +'clBlue'#18'Title.Text.Strings'#1#6#7'TAChart'#0#5'Align'#7#8'alClient'#11'P'
+  +'arentColor'#8#0#10'TBarSeries'#16'Chart1BarSeries1'#14'BarBrush.Color'#7#7
+  +'clOlive'#11'SeriesColor'#7#7'clOlive'#0#0#11'TFuncSeries'#17'Chart1FuncSeri'
+  +'es1'#9'Pen.Color'#7#5'clRed'#9'Pen.Width'#2#2#9'ZPosition'#2#1#0#0#0#8'TToo'
+  +'lBar'#8'ToolBar1'#4'Left'#2#0#6'Height'#2#24#3'Top'#2#0#5'Width'#3#165#1#11
+  +'ButtonWidth'#2'd'#7'Caption'#6#8'ToolBar1'#4'Flat'#8#12'ShowCaptions'#9#8'T'
+  +'abOrder'#2#1#0#11'TToolButton'#11'tbSaveAsBMP'#4'Left'#2#1#3'Top'#2#2#7'Cap'
+  +'tion'#6#11'Save as BMP'#7'OnClick'#7#16'tbSaveAsBMPClick'#0#0#11'TToolButto'
+  +'n'#11'tbSaveAsPNG'#4'Left'#2'e'#3'Top'#2#2#7'Caption'#6#11'Save as PNG'#7'O'
+  +'nClick'#7#16'tbSaveAsPNGClick'#0#0#11'TToolButton'#17'tbCopyToClipboard'#4
+  +'Left'#3'-'#1#3'Top'#2#2#7'Caption'#6#17'Copy to clipboard'#7'OnClick'#7#22
+  +'tbCopyToClipboardClick'#0#0#11'TToolButton'#12'tbSaveAsJPEG'#4'Left'#3#201#0
+  +#3'Top'#2#2#7'Caption'#6#12'Save as JPEG'#7'OnClick'#7#17'tbSaveAsJPEGClick'
+  +#0#0#0#11'TSaveDialog'#11'SaveDialog1'#4'left'#2'@'#3'top'#2'8'#0#0#0
+]);

components/tachart/demo/save/main.pas

@@ -0,0 +1,92 @@
+unit main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
+  ComCtrls, TAGraph, TASeries;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    Chart1: TChart;
+    Chart1BarSeries1: TBarSeries;
+    Chart1FuncSeries1: TFuncSeries;
+    SaveDialog1: TSaveDialog;
+    ToolBar1: TToolBar;
+    tbSaveAsBMP: TToolButton;
+    tbSaveAsPNG: TToolButton;
+    tbCopyToClipboard: TToolButton;
+    tbSaveAsJPEG: TToolButton;
+    procedure Chart1FuncSeries1Calculate(const AX: Double; out AY: Double);
+    procedure FormCreate(Sender: TObject);
+    procedure tbCopyToClipboardClick(Sender: TObject);
+    procedure tbSaveAsBMPClick(Sender: TObject);
+    procedure tbSaveAsJPEGClick(Sender: TObject);
+    procedure tbSaveAsPNGClick(Sender: TObject);
+  private
+    function GetFileName(const AExt: String): String;
+  end;
+
+var
+  Form1: TForm1; 
+
+implementation
+
+{ TForm1 }
+
+procedure TForm1.Chart1FuncSeries1Calculate(const AX: Double; out AY: Double);
+begin
+  AY := AX * AX / 2;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+var
+  i: Integer;
+begin
+  RandSeed := 103489;
+  for i := 1 to 10 do
+    Chart1BarSeries1.AddXY(i, i * i / 2 + Random(6) + 1);
+  Chart1FuncSeries1.OnCalculate := @Chart1FuncSeries1Calculate;
+  SaveDialog1.InitialDir := ExtractFilePath(Application.ExeName);
+end;
+
+function TForm1.GetFileName(const AExt: String): String;
+begin
+  with SaveDialog1 do begin
+    FileName := '';
+    DefaultExt := AExt;
+    if not Execute then Abort;
+    Result := FileName;
+  end;
+end;
+
+procedure TForm1.tbCopyToClipboardClick(Sender: TObject);
+begin
+  Chart1.CopyToClipboardBitmap;
+end;
+
+procedure TForm1.tbSaveAsBMPClick(Sender: TObject);
+begin
+  Chart1.SaveToBitmapFile(GetFileName('bmp'));
+end;
+
+procedure TForm1.tbSaveAsJPEGClick(Sender: TObject);
+begin
+  Chart1.SaveToFile(TJPEGImage, GetFileName('jpg'));
+end;
+
+procedure TForm1.tbSaveAsPNGClick(Sender: TObject);
+begin
+  Chart1.SaveToFile(TPortableNetworkGraphic, GetFileName('png'));
+end;
+
+initialization
+  {$I main.lrs}
+
+end.
+

components/tachart/demo/save/savedemo.lpi

@@ -0,0 +1,73 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="7"/>
+    <General>
+      <Flags>
+        <SaveClosedFiles Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=".exe"/>
+      <Title Value="Saving chart as image demo"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="TAChartLazarusPkg"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="savedemo.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="savedemo"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="main.pas"/>
+        <ComponentName Value="Form1"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="main"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="8"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)\"/>
+      <LCLWidgetType Value="win32"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

components/tachart/demo/save/savedemo.lpr

@@ -0,0 +1,21 @@
+program savedemo;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, main, TAChartLazarusPkg
+  { you can add units after this };
+
+{$IFDEF WINDOWS}{$R savedemo.rc}{$ENDIF}
+
+begin
+  Application.Title := 'Saving chart as image demo';
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

components/tachart/tagraph.pas

@@ -220,7 +220,9 @@ type
     procedure DrawLineVert(ACanvas: TCanvas; AX: Integer);
     procedure DrawOnCanvas(Rect: TRect; ACanvas: TCanvas);
     procedure PaintOnCanvas(ACanvas: TCanvas; ARect: TRect);
-    procedure SaveToBitmapFile(const FileName: String);
+    procedure SaveToBitmapFile(const AFileName: String); inline;
+    procedure SaveToFile(AClass: TRasterImageClass; const AFileName: String);
+    function SaveToImage(AClass: TRasterImageClass): TRasterImage;
     procedure ZoomFull;
 
   public // Coordinate conversion
@@ -1007,20 +1009,31 @@ begin
   end;
 end;
 
-procedure TChart.SaveToBitmapFile(const FileName: String);
-var
-  tmpR: TRect;
-  tmpBitmap: TBitmap;
+procedure TChart.SaveToBitmapFile(const AFileName: String);
 begin
+  SaveToFile(TBitmap, AFileName);
+end;
+
+procedure TChart.SaveToFile(AClass: TRasterImageClass; const AFileName: String);
+begin
+  with SaveToImage(AClass) do
     try
-    tmpBitmap := TBitmap.Create;
-    tmpR := GetRectangle;
-    tmpBitmap.Width := tmpR.Right - tmpR.Left;
-    tmpBitmap.Height:= tmpR.Bottom - tmpR.Top;
-    tmpBitmap.Canvas.CopyRect(tmpR, Canvas, tmpR);
-    tmpBitmap.SaveToFile(FileName);
+      SaveToFile(AFileName);
     finally
-    tmpBitmap.Free;
+      Free;
+    end;
+end;
+
+function TChart.SaveToImage(AClass: TRasterImageClass): TRasterImage;
+begin
+  Result := AClass.Create;
+  try
+    Result.Width := Width;
+    Result.Height := Height;
+    PaintOnCanvas(Result.Canvas, GetRectangle);
+  except
+    Result.Free;
+    raise;
   end;
 end;
 
@@ -1032,19 +1045,12 @@ begin
 end;
 
 procedure TChart.CopyToClipboardBitmap;
-var
-  tmpBitmap: TBitmap;
-  tmpR: TRect;
 begin
+  with SaveToImage(TBitmap) do
     try
-    tmpBitmap := TBitmap.Create;
-    tmpR := GetRectangle;
-    tmpBitmap.Width := tmpR.Right - tmpR.Left;
-    tmpBitmap.Height:= tmpR.Bottom - tmpR.Top;
-    tmpBitmap.Canvas.CopyRect(tmpR, Canvas, tmpR);
-    ClipBoard.Assign(tmpBitmap);
+      SaveToClipboardFormat(RegisterClipboardFormat(MimeType));
     finally
-    tmpBitmap.Free;
+      Free;
     end;
 end;