paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-05 00:39:26 +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

76
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,38 +67,26 @@ 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);
if (t.X = 0) and (t.Y = 0) then exit;
phong := TPhongShading.Create;
try try
square := CreateRectangleMap(ATx - 2 * margin, ATy - 2 * margin, ATx div 8); phong.AmbientFactor := 0.5;
try phong.LightPosition := ALightPos - ARect.TopLeft;
map.PutImage(margin, margin, square, dmDrawWithTransparency); phong.DrawRectangle(
BGRAReplace(map, map.FilterBlurRadial(ATx div 40, rbFast)); Result, BoundsSize(0, 0, t), t.X div 8, t.X div 8,
finally GammaCompression(SetIntensity(GammaExpansion(BGRA(86, 41, 38)), 30000)),
square.free; ARoundedCorners, AOptions);
end;
Result := TBGRABitmap.Create(ATx, ATy);
phong := TPhongShading.Create;
try
phong.LightSourceDistanceFactor := 0;
phong.LightDestFactor := 0;
phong.LightSourceIntensity := 200;
phong.AmbientFactor := 0.5;
phong.LightPosition := Point(-50, -100);
phong.LightPositionZ := 80;
phong.Draw(Result, map, 20, 0, 0, BGRA(86, 41, 38));
finally
phong.Free;
end;
finally finally
map.Free; phong.Free;
end; end;
end; end;
@ -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,23 +136,27 @@ 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(
try lightPos, ARect, BGRAPixelTransparent, false, [rmoNoBottomBorder])
temp.FillRect(0, 0, sz.X, sz.Y, chocolate, dmSet); do
temp.Draw(ACanvas, ARect); try
finally Draw(ACanvas, ARect.Left, ARect.Top, false);
temp.Free; finally
chocolate.Free; Free;
end; end;
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;