mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-17 03:29:28 +02:00
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 -
This commit is contained in:
parent
aec9fbec6e
commit
b4331da20a
5
.gitattributes
vendored
5
.gitattributes
vendored
@ -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.lfm svneol=native#text/plain
|
||||||
components/tachart/demo/func/main.lrs 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/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.lpk svneol=native#text/plain
|
||||||
components/tachart/tachartlazaruspkg.pas svneol=native#text/plain
|
components/tachart/tachartlazaruspkg.pas svneol=native#text/plain
|
||||||
components/tachart/tachartutils.pas svneol=native#text/plain
|
components/tachart/tachartutils.pas svneol=native#text/plain
|
||||||
|
80
components/tachart/demo/save/main.lfm
Normal file
80
components/tachart/demo/save/main.lfm
Normal file
@ -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
|
26
components/tachart/demo/save/main.lrs
Normal file
26
components/tachart/demo/save/main.lrs
Normal file
@ -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
|
||||||
|
]);
|
92
components/tachart/demo/save/main.pas
Normal file
92
components/tachart/demo/save/main.pas
Normal file
@ -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.
|
||||||
|
|
73
components/tachart/demo/save/savedemo.lpi
Normal file
73
components/tachart/demo/save/savedemo.lpi
Normal file
@ -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>
|
21
components/tachart/demo/save/savedemo.lpr
Normal file
21
components/tachart/demo/save/savedemo.lpr
Normal file
@ -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.
|
||||||
|
|
@ -220,7 +220,9 @@ type
|
|||||||
procedure DrawLineVert(ACanvas: TCanvas; AX: Integer);
|
procedure DrawLineVert(ACanvas: TCanvas; AX: Integer);
|
||||||
procedure DrawOnCanvas(Rect: TRect; ACanvas: TCanvas);
|
procedure DrawOnCanvas(Rect: TRect; ACanvas: TCanvas);
|
||||||
procedure PaintOnCanvas(ACanvas: TCanvas; ARect: TRect);
|
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;
|
procedure ZoomFull;
|
||||||
|
|
||||||
public // Coordinate conversion
|
public // Coordinate conversion
|
||||||
@ -1007,20 +1009,31 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TChart.SaveToBitmapFile(const FileName: String);
|
procedure TChart.SaveToBitmapFile(const AFileName: String);
|
||||||
var
|
|
||||||
tmpR: TRect;
|
|
||||||
tmpBitmap: TBitmap;
|
|
||||||
begin
|
begin
|
||||||
|
SaveToFile(TBitmap, AFileName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TChart.SaveToFile(AClass: TRasterImageClass; const AFileName: String);
|
||||||
|
begin
|
||||||
|
with SaveToImage(AClass) do
|
||||||
|
try
|
||||||
|
SaveToFile(AFileName);
|
||||||
|
finally
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TChart.SaveToImage(AClass: TRasterImageClass): TRasterImage;
|
||||||
|
begin
|
||||||
|
Result := AClass.Create;
|
||||||
try
|
try
|
||||||
tmpBitmap := TBitmap.Create;
|
Result.Width := Width;
|
||||||
tmpR := GetRectangle;
|
Result.Height := Height;
|
||||||
tmpBitmap.Width := tmpR.Right - tmpR.Left;
|
PaintOnCanvas(Result.Canvas, GetRectangle);
|
||||||
tmpBitmap.Height:= tmpR.Bottom - tmpR.Top;
|
except
|
||||||
tmpBitmap.Canvas.CopyRect(tmpR, Canvas, tmpR);
|
Result.Free;
|
||||||
tmpBitmap.SaveToFile(FileName);
|
raise;
|
||||||
finally
|
|
||||||
tmpBitmap.Free;
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1032,20 +1045,13 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TChart.CopyToClipboardBitmap;
|
procedure TChart.CopyToClipboardBitmap;
|
||||||
var
|
|
||||||
tmpBitmap: TBitmap;
|
|
||||||
tmpR: TRect;
|
|
||||||
begin
|
begin
|
||||||
try
|
with SaveToImage(TBitmap) do
|
||||||
tmpBitmap := TBitmap.Create;
|
try
|
||||||
tmpR := GetRectangle;
|
SaveToClipboardFormat(RegisterClipboardFormat(MimeType));
|
||||||
tmpBitmap.Width := tmpR.Right - tmpR.Left;
|
finally
|
||||||
tmpBitmap.Height:= tmpR.Bottom - tmpR.Top;
|
Free;
|
||||||
tmpBitmap.Canvas.CopyRect(tmpR, Canvas, tmpR);
|
end;
|
||||||
ClipBoard.Assign(tmpBitmap);
|
|
||||||
finally
|
|
||||||
tmpBitmap.Free;
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TChart.DrawOnCanvas(Rect: TRect; ACanvas: TCanvas);
|
procedure TChart.DrawOnCanvas(Rect: TRect; ACanvas: TCanvas);
|
||||||
|
Loading…
Reference in New Issue
Block a user