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

TAChart: Improve visual effects in "bgra" demo. Based on code by "circular".

Browse Source 
git-svn-id: trunk@40095 -
This commit is contained in:
ask 2013-01-31 12:14:26 +00:00
parent 214494a95c
commit 4779a87e62
2 changed files with 40 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/tachart/demo/bgra/Main.lfm
View File

@ -124,7 +124,7 @@ object Form1: TForm1
end end
end end
object tsBarEffects: TTabSheet object tsBarEffects: TTabSheet
Caption = 'Slice scaling' Caption = 'Bar effects'
ClientHeight = 455 ClientHeight = 455
ClientWidth = 708 ClientWidth = 708
object Panel2: TPanel object Panel2: TPanel
@ -328,7 +328,9 @@ object Form1: TForm1
BackColor = clBlack BackColor = clBlack
Foot.Brush.Color = clBtnFace Foot.Brush.Color = clBtnFace
Foot.Font.Color = clBlue Foot.Font.Color = clBlue
Margins.Left = 10
Margins.Top = 40 Margins.Top = 40
Margins.Right = 10
Margins.Bottom = 0 Margins.Bottom = 0
Title.Brush.Color = clBtnFace Title.Brush.Color = clBtnFace
Title.Font.Color = clBlue Title.Font.Color = clBlue

64
components/tachart/demo/bgra/Main.pas
View File

@ -5,7 +5,7 @@ unit Main;
interface interface
uses uses
Classes, ComCtrls, ExtCtrls, Spin, StdCtrls, SysUtils, FileUtil, Forms, Classes, ComCtrls, ExtCtrls, StdCtrls, SysUtils, FileUtil, Forms,
Controls, Graphics, Dialogs, Controls, Graphics, Dialogs,
TAGraph, TASeries, TASources, TAAnimatedSource, TACustomSource, TAGraph, TASeries, TASources, TAAnimatedSource, TACustomSource,
BGRASliceScaling; BGRASliceScaling;
@ -67,39 +67,27 @@ uses
Math, BGRABitmap, BGRABitmapTypes, BGRAGradients, Math, BGRABitmap, BGRABitmapTypes, BGRAGradients,
TAChartUtils, TADrawerBGRA, TADrawerCanvas, TADrawUtils, TAGeometry; TAChartUtils, TADrawerBGRA, TADrawerCanvas, TADrawUtils, TAGeometry;
function CreateChocolateTexture(ATx, ATy: integer): TBGRABitmap; function CreateChocolateBar(
ALightPos: TPoint; ARect: TRect; ABackColor: TBGRAPixel;
ARoundedCorners: Boolean; AOptions: TRectangleMapOptions): TBGRABitmap;
var var
square, map: TBGRABitmap;
phong: TPhongShading; phong: TPhongShading;
margin: Integer; t: TPoint;
begin begin
margin := ATx div 20; t := MaxPoint(ARect.BottomRight - ARect.TopLeft, Point(0, 0));
map := TBGRABitmap.Create(ATx, ATy, BGRABlack); Result := TBGRABitmap.Create(t.X, t.Y, ABackColor);
try if (t.X = 0) and (t.Y = 0) then exit;
square := CreateRectangleMap(ATx - 2 * margin, ATy - 2 * margin, ATx div 8);
try
map.PutImage(margin, margin, square, dmDrawWithTransparency);
BGRAReplace(map, map.FilterBlurRadial(ATx div 40, rbFast));
finally
square.free;
end;
Result := TBGRABitmap.Create(ATx, ATy);
phong := TPhongShading.Create; phong := TPhongShading.Create;
try try
phong.LightSourceDistanceFactor := 0;
phong.LightDestFactor := 0;
phong.LightSourceIntensity := 200;
phong.AmbientFactor := 0.5; phong.AmbientFactor := 0.5;
phong.LightPosition := Point(-50, -100); phong.LightPosition := ALightPos - ARect.TopLeft;
phong.LightPositionZ := 80; phong.DrawRectangle(
phong.Draw(Result, map, 20, 0, 0, BGRA(86, 41, 38)); Result, BoundsSize(0, 0, t), t.X div 8, t.X div 8,
GammaCompression(SetIntensity(GammaExpansion(BGRA(86, 41, 38)), 30000)),
ARoundedCorners, AOptions);
finally finally
phong.Free; phong.Free;
end; end;
finally
map.Free;
end;
end; end;
{ TForm1 } { TForm1 }
@ -135,8 +123,9 @@ procedure TForm1.chBarEffectsBarSeries1BeforeDrawBar(ASender: TBarSeries;
ACanvas: TCanvas; const ARect: TRect; APointIndex, AStackIndex: Integer; ACanvas: TCanvas; const ARect: TRect; APointIndex, AStackIndex: Integer;
var ADoDefaultDrawing: Boolean); var ADoDefaultDrawing: Boolean);
var var
temp, chocolate: TBGRABitmap; temp, stretched: TBGRABitmap;
sz: TPoint; sz: TPoint;
lightPos: TPoint;
begin begin
Unused(ASender); Unused(ASender);
Unused(APointIndex, AStackIndex); Unused(APointIndex, AStackIndex);
@ -147,22 +136,26 @@ begin
temp := TBGRABitmap.Create( temp := TBGRABitmap.Create(
FSliceScaling.BitmapWidth, FSliceScaling.BitmapWidth,
Round(FSliceScaling.BitmapWidth * sz.Y / sz.X)); Round(FSliceScaling.BitmapWidth * sz.Y / sz.X));
stretched := nil;
try try
FSliceScaling.Draw(temp, 0, 0, temp.Width, temp.Height); FSliceScaling.Draw(temp, 0, 0, temp.Width, temp.Height);
temp.Draw(ACanvas, ARect); temp.ResampleFilter := rfLinear;
stretched := temp.Resample(sz.x, sz.Y, rmFineResample) as TBGRABitmap;
stretched.Draw(ACanvas, ARect, False);
finally finally
temp.Free; temp.Free;
stretched.Free;
end; end;
end; end;
1: begin 1: begin
chocolate := CreateChocolateTexture(sz.X, sz.X); lightPos := Point(chBarEffects.ClientWidth div 2, 0);
temp := TBGRABitmap.Create(sz.X, sz.Y); with CreateChocolateBar(
lightPos, ARect, BGRAPixelTransparent, false, [rmoNoBottomBorder])
do
try try
temp.FillRect(0, 0, sz.X, sz.Y, chocolate, dmSet); Draw(ACanvas, ARect.Left, ARect.Top, false);
temp.Draw(ACanvas, ARect);
finally finally
temp.Free; Free;
chocolate.Free;
end; end;
end; end;
end; end;
@ -175,7 +168,12 @@ begin
FAnimatedSource.AnimationInterval := 30; FAnimatedSource.AnimationInterval := 30;
FAnimatedSource.AnimationTime := 1000; FAnimatedSource.AnimationTime := 1000;
FAnimatedSource.OnGetItem := @OnGetItem; FAnimatedSource.OnGetItem := @OnGetItem;
chBarEffectsBarSeries1.Source := FAnimatedSource; chBarEffectsBarSeries1.Source := FAnimatedSource;
chBarEffects.BackColor:= BGRAToColor(CSSDarkSlateBlue);
chSimple.BackColor:= BGRAToColor(CSSYellowGreen);
chSimple.Color:= BGRAToColor(CSSYellowGreen);
chSimple.BackColor := BGRAToColor(CSSBeige);
FSliceScaling := TBGRASliceScaling.Create(Image1.Picture.Bitmap, 70, 0, 35, 0); FSliceScaling := TBGRASliceScaling.Create(Image1.Picture.Bitmap, 70, 0, 35, 0);
FSliceScaling.AutodetectRepeat; FSliceScaling.AutodetectRepeat;