mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-02 19:43:47 +02:00
111 lines
2.4 KiB
ObjectPascal
111 lines
2.4 KiB
ObjectPascal
unit main;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Forms, Graphics, Dialogs, ComCtrls, TAGraph, TASeries, TAFuncSeries, Classes;
|
|
|
|
type
|
|
|
|
{ TForm1 }
|
|
|
|
TForm1 = class(TForm)
|
|
Chart1: TChart;
|
|
Chart1BarSeries1: TBarSeries;
|
|
Chart1FuncSeries1: TFuncSeries;
|
|
SaveDialog1: TSaveDialog;
|
|
ToolBar1: TToolBar;
|
|
tbSaveAsBMP: TToolButton;
|
|
tbSaveAsPNG: TToolButton;
|
|
tbCopyToClipboard: TToolButton;
|
|
tbSaveAsJPEG: TToolButton;
|
|
tbSaveAsSVG: 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);
|
|
procedure tbSaveAsSVGClick(Sender: TObject);
|
|
private
|
|
function GetFileName(const AExt: String): String;
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
uses
|
|
TADrawerSVG, TADrawUtils, TADrawerCanvas;
|
|
|
|
{ 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 + Random);
|
|
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;
|
|
|
|
procedure TForm1.tbSaveAsSVGClick(Sender: TObject);
|
|
var
|
|
fs: TFileStream;
|
|
id: IChartDrawer;
|
|
begin
|
|
fs := TFileStream.Create(GetFileName('svg'), fmCreate);
|
|
try
|
|
id := TSVGDrawer.Create(fs, true);
|
|
id.DoChartColorToFPColor := @ChartColorSysToFPColor;
|
|
with Chart1 do
|
|
Draw(id, Rect(0, 0, Width, Height));
|
|
finally
|
|
fs.Free;
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|