From 6b7c8e492ac9ee837a84f31332f20599274c9d04 Mon Sep 17 00:00:00 2001 From: ask Date: Sun, 28 Oct 2012 18:51:54 +0000 Subject: [PATCH] TAChart: Add source code for "ColorMapSeries, Zooming" tutorial git-svn-id: trunk@39179 - --- .gitattributes | 4 + .gitignore | 8 + .../tachart/tutorials/mandelbrot/main.lfm | 213 ++++++++++++++++++ .../tachart/tutorials/mandelbrot/main.pas | 178 +++++++++++++++ .../tutorials/mandelbrot/mandelbrot.lpi | 93 ++++++++ .../tutorials/mandelbrot/mandelbrot.lpr | 20 ++ 6 files changed, 516 insertions(+) create mode 100644 components/tachart/tutorials/mandelbrot/main.lfm create mode 100644 components/tachart/tutorials/mandelbrot/main.pas create mode 100644 components/tachart/tutorials/mandelbrot/mandelbrot.lpi create mode 100644 components/tachart/tutorials/mandelbrot/mandelbrot.lpr diff --git a/.gitattributes b/.gitattributes index c99446c198..983c1b71ba 100644 --- a/.gitattributes +++ b/.gitattributes @@ -3108,6 +3108,10 @@ components/tachart/test/SourcesTest.pas svneol=native#text/pascal components/tachart/test/UtilsTest.pas svneol=native#text/pascal components/tachart/test/test.lpi svneol=native#text/plain components/tachart/test/test.lpr svneol=native#text/pascal +components/tachart/tutorials/mandelbrot/main.lfm svneol=native#text/plain +components/tachart/tutorials/mandelbrot/main.pas svneol=native#text/pascal +components/tachart/tutorials/mandelbrot/mandelbrot.lpi svneol=native#text/plain +components/tachart/tutorials/mandelbrot/mandelbrot.lpr svneol=native#text/pascal components/tdbf/Makefile svneol=native#text/plain components/tdbf/Makefile.compiled svneol=native#text/plain components/tdbf/Makefile.fpc svneol=native#text/plain diff --git a/.gitignore b/.gitignore index 007e5ffc27..90905a1a10 100644 --- a/.gitignore +++ b/.gitignore @@ -251,6 +251,14 @@ components/tachart/test/*.exe components/tachart/test/*.lps components/tachart/test/*.res components/tachart/test/lib +components/tachart/tutorials/*.exe +components/tachart/tutorials/*.lps +components/tachart/tutorials/*.res +components/tachart/tutorials/lib +components/tachart/tutorials/mandelbrot/*.exe +components/tachart/tutorials/mandelbrot/*.lps +components/tachart/tutorials/mandelbrot/*.res +components/tachart/tutorials/mandelbrot/lib components/tdbf/*.bak components/tdbf/languages/*.bak components/tdbf/languages/units diff --git a/components/tachart/tutorials/mandelbrot/main.lfm b/components/tachart/tutorials/mandelbrot/main.lfm new file mode 100644 index 0000000000..5981b7aaad --- /dev/null +++ b/components/tachart/tutorials/mandelbrot/main.lfm @@ -0,0 +1,213 @@ +object Form1: TForm1 + Left = 326 + Height = 285 + Top = 155 + Width = 468 + Caption = 'Form1' + ClientHeight = 285 + ClientWidth = 468 + OnCreate = FormCreate + OnDestroy = FormDestroy + LCLVersion = '1.1' + object Chart1: TChart + Left = 4 + Height = 277 + Top = 4 + Width = 288 + AxisList = < + item + Visible = False + Minors = <> + Title.LabelFont.Orientation = 900 + end + item + Visible = False + Alignment = calBottom + Minors = <> + end> + Extent.UseXMax = True + Extent.UseXMin = True + Extent.UseYMax = True + Extent.UseYMin = True + Extent.XMax = 0.8 + Extent.XMin = -2.2 + Extent.YMax = 1.5 + Extent.YMin = -1.5 + Foot.Brush.Color = clBtnFace + Foot.Font.Color = clBlue + Proportional = True + Title.Brush.Color = clBtnFace + Title.Font.Color = clBlue + Title.Text.Strings = ( + 'TAChart' + ) + Toolset = ChartToolset1 + OnExtentChanged = Chart1ExtentChanged + Align = alClient + BorderSpacing.Around = 4 + DoubleBuffered = True + ParentColor = False + object Chart1ColorMapSeries1: TColorMapSeries + ColorSource = ColorSource + Interpolate = True + OnCalculate = Chart1ColorMapSeries1Calculate + StepX = 1 + StepY = 1 + end + end + object Panel1: TPanel + Left = 296 + Height = 285 + Top = 0 + Width = 172 + Align = alRight + BevelOuter = bvNone + ClientHeight = 285 + ClientWidth = 172 + TabOrder = 1 + object Panel2: TPanel + Left = 0 + Height = 213 + Top = 72 + Width = 172 + Align = alClient + BevelOuter = bvNone + ClientHeight = 213 + ClientWidth = 172 + TabOrder = 0 + object Label2: TLabel + Left = 6 + Height = 13 + Top = 8 + Width = 69 + Caption = 'Instructions' + Font.Style = [fsBold] + ParentColor = False + ParentFont = False + end + object Label1: TLabel + Left = 6 + Height = 13 + Top = 37 + Width = 45 + Caption = 'Left-drag' + Font.Style = [fsItalic] + ParentColor = False + ParentFont = False + end + object Label3: TLabel + Left = 6 + Height = 13 + Top = 80 + Width = 53 + Caption = 'Middle-click' + Font.Style = [fsItalic] + ParentColor = False + ParentFont = False + end + object Label4: TLabel + Left = 6 + Height = 13 + Top = 120 + Width = 97 + Caption = 'Middle-click w/SHIFT' + Font.Style = [fsItalic] + ParentColor = False + ParentFont = False + end + object Label5: TLabel + Left = 6 + Height = 13 + Top = 161 + Width = 51 + Caption = 'Right-drag' + Font.Style = [fsItalic] + ParentColor = False + ParentFont = False + end + object Label6: TLabel + Left = 19 + Height = 13 + Top = 56 + Width = 25 + Caption = 'zoom' + ParentColor = False + end + object Label7: TLabel + Left = 22 + Height = 13 + Top = 96 + Width = 81 + Caption = 'unzoom (history)' + ParentColor = False + end + object Label8: TLabel + Left = 19 + Height = 13 + Top = 136 + Width = 54 + Caption = 'full unzoom' + ParentColor = False + end + object Label9: TLabel + Left = 19 + Height = 13 + Top = 177 + Width = 18 + Caption = 'pan' + ParentColor = False + end + end + object Panel3: TPanel + Left = 0 + Height = 72 + Top = 0 + Width = 172 + Align = alTop + BevelOuter = bvNone + ClientHeight = 72 + ClientWidth = 172 + TabOrder = 1 + object LblMagnification: TLabel + Left = 6 + Height = 13 + Top = 8 + Width = 67 + Caption = 'Magnification:' + ParentColor = False + end + object LblHistoryCount: TLabel + Left = 6 + Height = 13 + Top = 29 + Width = 68 + Caption = 'History count:' + ParentColor = False + end + end + end + object ColorSource: TListChartSource + left = 115 + top = 57 + end + object ChartToolset1: TChartToolset + left = 115 + top = 120 + object ChartToolset1ZoomDragTool1: TZoomDragTool + Shift = [ssLeft] + OnAfterMouseUp = ChartToolset1ZoomDragTool1AfterMouseUp + end + object ChartToolset1PanDragTool1: TPanDragTool + Shift = [ssRight] + OnAfterMouseDown = ChartToolset1PanDragTool1AfterMouseDown + end + object ChartToolset1UserDefinedTool1: TUserDefinedTool + Shift = [ssMiddle] + OnAfterMouseUp = ChartToolset1UserDefinedTool1AfterMouseUp + end + object ChartToolset1UserDefinedTool2: TUserDefinedTool + Shift = [ssShift, ssMiddle] + OnAfterMouseUp = ChartToolset1UserDefinedTool2AfterMouseUp + end + end +end diff --git a/components/tachart/tutorials/mandelbrot/main.pas b/components/tachart/tutorials/mandelbrot/main.pas new file mode 100644 index 0000000000..ac278ecddd --- /dev/null +++ b/components/tachart/tutorials/mandelbrot/main.pas @@ -0,0 +1,178 @@ +unit main; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, ExtCtrls, StdCtrls, SysUtils, TAGraph, TAFuncSeries, + TASources, Forms, Controls, Graphics, Dialogs, TATypes, TATools, types; + +type + + { TForm1 } + + TForm1 = class(TForm) + Chart1: TChart; + Chart1ColorMapSeries1: TColorMapSeries; + ChartToolset1: TChartToolset; + ChartToolset1PanDragTool1: TPanDragTool; + ChartToolset1UserDefinedTool1: TUserDefinedTool; + ChartToolset1UserDefinedTool2: TUserDefinedTool; + ChartToolset1ZoomDragTool1: TZoomDragTool; + ColorSource: TListChartSource; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + Label7: TLabel; + Label8: TLabel; + Label9: TLabel; + LblMagnification: TLabel; + LblHistoryCount: TLabel; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + procedure Chart1ColorMapSeries1Calculate(const AX, AY: Double; + out AZ: Double); + procedure Chart1ExtentChanged(ASender: TChart); + procedure ChartToolset1PanDragTool1AfterMouseDown(ATool: TChartTool; + APoint: TPoint); + procedure ChartToolset1UserDefinedTool1AfterMouseUp(ATool: TChartTool; + APoint: TPoint); + procedure ChartToolset1UserDefinedTool2AfterMouseUp(ATool: TChartTool; + APoint: TPoint); + procedure ChartToolset1ZoomDragTool1AfterMouseUp(ATool: TChartTool; + APoint: TPoint); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + private + { private declarations } + ZoomHistory: TChartExtentHistory; + procedure PopulateColorSource; + public + { public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +uses + TAChartUtils, TAGeometry; + +const + MANDELBROT_NUM_ITERATIONS = 100; + MANDELBROT_ESCAPE_RADIUS = 2.0; + MANDELBROT_LIMIT = sqr(MANDELBROT_ESCAPE_RADIUS); + +function InMandelBrotSet(c: TDoublePoint; out Iterations: Integer; + out z: TDoublePoint): Boolean; +var + j: Integer; +begin + Iterations := 0; + z := DoublePoint(0.0, 0.0); + for j:=0 to MANDELBROT_NUM_ITERATIONS-1 do begin + z := DoublePoint( + sqr(z.X) - sqr(z.Y) + c.X, + 2 * z.X * z.Y + c.Y + ); + if sqr(z.X) + sqr(z.Y) > MANDELBROT_LIMIT then + // point did escape --> c is not in Mandelbrot set + exit(false); + Inc(Iterations); + end; + Result := true; +end; + +{ TForm1 } + +procedure TForm1.FormCreate(Sender:TObject); +begin + PopulateColorSource; + ZoomHistory := TChartExtentHistory.Create; + ZoomHistory.Capacity := 100; +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + ZoomHistory.Free; +end; + +procedure TForm1.Chart1ColorMapSeries1Calculate(const AX, AY: Double; + out AZ: Double); +var + iterations: Integer; + z: TDoublePoint; +begin + if InMandelBrotSet(DoublePoint(AX, AY), iterations, z) then + AZ := -1 + // or - as a solution to the "homework" exercise: + // AZ := sqrt(sqr(z.x) + sqr(z.y)) / MANDELBROT_ESCAPE_RADIUS + else + AZ := iterations / MANDELBROT_NUM_ITERATIONS; +end; + +procedure TForm1.Chart1ExtentChanged(ASender: TChart); +var + cex, fex: TDoubleRect; + factor: double; +begin + cex := Chart1.CurrentExtent; + fex := Chart1.GetFullExtent; + if cex.b.x = cex.a.x then exit; + + factor := (fex.b.x - fex.a.x) / (cex.b.x - cex.a.x); + if factor > 1e6 then + LblMagnification.Caption := Format('Magnification: %.0e', [factor]) + else + LblMagnification.Caption := Format('Magnification: %0.n', [factor]); + + LblHistoryCount.Caption := Format('History count: %d', [ZoomHistory.Count]); +end; + +procedure TForm1.ChartToolset1PanDragTool1AfterMouseDown(ATool: TChartTool; + APoint: TPoint); +begin + ZoomHistory.Add(Chart1.PrevLogicalExtent); +end; + +procedure TForm1.ChartToolset1UserDefinedTool1AfterMouseUp(ATool: TChartTool; + APoint: TPoint); +begin + if ZoomHistory.Count > 0 then + Chart1.LogicalExtent := ZoomHistory.Pop; +end; + +procedure TForm1.ChartToolset1UserDefinedTool2AfterMouseUp(ATool: TChartTool; + APoint: TPoint); +begin + Chart1.ZoomFull; +end; + +procedure TForm1.ChartToolset1ZoomDragTool1AfterMouseUp(ATool: TChartTool; + APoint: TPoint); +begin + ZoomHistory.Add(Chart1.PrevLogicalExtent); +end; + +procedure TForm1.PopulateColorSource; +const + DUMMY = 0.0; +begin + with ColorSource do begin + Clear; + Add(-1.0, DUMMY, '', clBlack); + Add( 0.0, DUMMY, '', clBlue); + Add( 0.3, DUMMY, '', clRed); + Add( 1.0, DUMMY, '', clYellow); + end; +end; + +end. diff --git a/components/tachart/tutorials/mandelbrot/mandelbrot.lpi b/components/tachart/tutorials/mandelbrot/mandelbrot.lpi new file mode 100644 index 0000000000..0ab0e70fcf --- /dev/null +++ b/components/tachart/tutorials/mandelbrot/mandelbrot.lpi @@ -0,0 +1,93 @@ + + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="TAChartLazarusPkg"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="mandelbrot.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="mandelbrot"/> + </Unit0> + <Unit1> + <Filename Value="main.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="main"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="mandelbrot"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/tachart/tutorials/mandelbrot/mandelbrot.lpr b/components/tachart/tutorials/mandelbrot/mandelbrot.lpr new file mode 100644 index 0000000000..36c9b1da07 --- /dev/null +++ b/components/tachart/tutorials/mandelbrot/mandelbrot.lpr @@ -0,0 +1,20 @@ +program mandelbrot; + +{$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 }; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end.