paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 06:16:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Update tutorial "background" to avoid the deprecated background drawing events.

Browse Source 
git-svn-id: trunk@62229 -
This commit is contained in:
wp 2019-11-10 21:58:05 +00:00
parent a10a0ef35d
commit d35e17fbdd
3 changed files with 76 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
components/tachart/tutorials/background/backimage.lpi
View File

@ -1,11 +1,13 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="backimage"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
@ -13,9 +15,6 @@
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="2">
<Item1 Name="Debug" Default="True"/>
<Item2 Name="Release">
@ -49,9 +48,10 @@
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
</RunParams>
<RequiredPackages Count="2">
<Item1>
@ -65,7 +65,6 @@
<Unit0>
<Filename Value="backimage.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="backimage"/>
</Unit0>
<Unit1>
<Filename Value="main.pas"/>
@ -73,7 +72,6 @@
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="main"/>
</Unit1>
</Units>
</ProjectOptions>

11
components/tachart/tutorials/background/main.lfm
View File

@ -8,7 +8,7 @@ object Form1: TForm1
ClientWidth = 400
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.3'
LCLVersion = '2.1.0.0'
object Chart1: TChart
Left = 0
Height = 300
@ -19,6 +19,7 @@ object Form1: TForm1
Grid.Color = clSkyBlue
Grid.Visible = False
Marks.Format = '%.0n'
Marks.LabelBrush.Style = bsClear
Marks.Style = smsCustom
Minors = <>
Title.LabelFont.Height = -16
@ -26,15 +27,18 @@ object Form1: TForm1
Title.LabelFont.Style = [fsBold]
Title.Visible = True
Title.Caption = 'Downloads per year'
Title.LabelBrush.Style = bsClear
end
item
Grid.Visible = False
Alignment = calBottom
Marks.LabelBrush.Style = bsClear
Minors = <>
Title.LabelFont.Height = -16
Title.LabelFont.Style = [fsBold]
Title.Visible = True
Title.Caption = 'Year'
Title.LabelBrush.Style = bsClear
end>
Foot.Brush.Color = clBtnFace
Foot.Font.Color = clBlue
@ -47,10 +51,9 @@ object Form1: TForm1
'Lazarus Downloads'
)
Title.Visible = True
OnBeforeDrawBackground = Chart1BeforeDrawBackground
OnBeforeDrawBackWall = Chart1BeforeDrawBackWall
OnBeforeCustomDrawBackground = Chart1BeforeCustomDrawBackground
OnBeforeCustomDrawBackWall = Chart1BeforeCustomDrawBackWall
Align = alClient
ParentColor = False
object Chart1BarSeries1: TBarSeries
Shadow.Color = clNavy
Shadow.OffsetX = 4

67
components/tachart/tutorials/background/main.pas
View File

@ -5,7 +5,7 @@ interface
uses
Classes, SysUtils, FileUtil, TAGraph, TASeries, TASources, Forms, Controls,
Graphics, Dialogs;
Graphics, Dialogs, TADrawUtils;
type
@ -15,10 +15,12 @@ type
Chart1: TChart;
Chart1BarSeries1: TBarSeries;
ListChartSource1: TListChartSource;
procedure Chart1BeforeDrawBackground(ASender: TChart; ACanvas: TCanvas;
const ARect: TRect; var ADoDefaultDrawing: Boolean);
procedure Chart1BeforeDrawBackWall(ASender: TChart; ACanvas: TCanvas;
const ARect: TRect; var ADoDefaultDrawing: Boolean);
procedure Chart1BeforeCustomDrawBackground(ASender: TChart;
ADrawer: IChartDrawer; const ARect: TRect; var ADoDefaultDrawing: Boolean
);
procedure Chart1BeforeCustomDrawBackWall(ASender: TChart;
ADrawer: IChartDrawer; const ARect: TRect; var ADoDefaultDrawing: Boolean
);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
@ -35,6 +37,9 @@ implementation
{$R *.lfm}
uses
IntfGraphics;
//{$R splash_logo.res}
{ TForm1 }
@ -47,22 +52,72 @@ begin
// or, use resources:
//FBackImage.LoadFromResourceName(HInstance, 'splash_logo');
// Don't forget to active the "{$R" directive above.
// Don't forget to activate the "{$R" directive above.
end;
procedure TForm1.Chart1BeforeCustomDrawBackWall(ASender: TChart;
ADrawer: IChartDrawer; const ARect: TRect; var ADoDefaultDrawing: Boolean);
var
bmp: TBitmap;
img: TLazIntfImage;
begin
img := TLazIntfImage.Create(0, 0);
try
bmp := TBitmap.Create;
try
bmp.SetSize(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top);
bmp.Canvas.StretchDraw(Rect(0, 0, bmp.Width, bmp.Height), FBackImage.Graphic);
img.LoadFromBitmap(bmp.Handle, bmp.MaskHandle);
finally
bmp.Free;
end;
ADrawer.PutImage(ARect.Left, ARect.Top, img);
ADoDefaultDrawing := false;
finally
img.Free;
end;
end;
(* --------------- deprecated, was in use before Laz 2.1 -----------------------
procedure TForm1.Chart1BeforeDrawBackWall(ASender: TChart; ACanvas: TCanvas;
const ARect: TRect; var ADoDefaultDrawing: Boolean);
begin
ACanvas.StretchDraw(ARect, FBackImage.Graphic);
ADoDefaultDrawing := false;
end;
----------------------------------------------------------------------------- *)
procedure TForm1.Chart1BeforeCustomDrawBackground(ASender: TChart;
ADrawer: IChartDrawer; const ARect: TRect; var ADoDefaultDrawing: Boolean);
var
bmp: TBitmap;
img: TLazIntfImage;
begin
img := TLazIntfImage.Create(0, 0);
try
bmp := TBitmap.Create;
try
bmp.SetSize(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top);
bmp.Canvas.GradientFill(Rect(0, 0, bmp.Width, bmp.Height), clSkyBlue, clWhite, gdVertical);
img.LoadFromBitmap(bmp.Handle, bmp.MaskHandle);
finally
bmp.Free;
end;
ADrawer.PutImage(ARect.Left, ARect.Top, img);
ADoDefaultDrawing := false;
finally
img.Free;
end;
end;
(* --------------- deprecated, was in use before Laz 2.1 -----------------------
procedure TForm1.Chart1BeforeDrawBackground(ASender: TChart; ACanvas: TCanvas;
const ARect: TRect; var ADoDefaultDrawing: Boolean);
begin
ACanvas.GradientFill(ARect, clSkyBlue, clWhite, gdVertical);
ADoDefaultDrawing := false;
end;
----------------------------------------------------------------------------- *)
procedure TForm1.FormDestroy(Sender: TObject);
begin