TAChart: Fix event TDbChartSource.OnGetItem not being alterable in designer. Add demo db-barseries.

git-svn-id: trunk@55919 -

.gitattributes

@@ -4463,6 +4463,10 @@ components/tachart/demo/datapointtools/datapointtooldemo.lpi svneol=native#text/
 components/tachart/demo/datapointtools/datapointtooldemo.lpr svneol=native#text/plain
 components/tachart/demo/datapointtools/main.lfm svneol=native#text/plain
 components/tachart/demo/datapointtools/main.pas svneol=native#text/plain
+components/tachart/demo/db-barseries/dbdemo.lpi svneol=native#text/plain
+components/tachart/demo/db-barseries/dbdemo.lpr svneol=native#text/plain
+components/tachart/demo/db-barseries/main.lfm svneol=native#text/plain
+components/tachart/demo/db-barseries/main.pas svneol=native#text/plain
 components/tachart/demo/db/dbdemo.lpi svneol=native#text/plain
 components/tachart/demo/db/dbdemo.lpr svneol=native#text/pascal
 components/tachart/demo/db/main.lfm svneol=native#text/plain

components/tachart/demo/db-barseries/dbdemo.lpi

@@ -0,0 +1,97 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <SaveClosedFiles Value="False"/>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Chart db-aware demo"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="4">
+      <Item1>
+        <PackageName Value="FCL"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="MemDSLaz"/>
+        <MinVersion Major="1" Minor="2" Release="1" Valid="True"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="TAChartLazarusPkg"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item3>
+      <Item4>
+        <PackageName Value="LCL"/>
+      </Item4>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="dbdemo.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </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="\"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

components/tachart/demo/db-barseries/dbdemo.lpr

@@ -0,0 +1,21 @@
+program dbdemo;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, Main, MemDSLaz, TAChartLazarusPkg
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  Application.Title := 'Chart db-aware demo';
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

components/tachart/demo/db-barseries/main.lfm

@@ -0,0 +1,151 @@
+object Form1: TForm1
+  Left = 329
+  Height = 300
+  Top = 190
+  Width = 578
+  Caption = 'Form1'
+  ClientHeight = 300
+  ClientWidth = 578
+  OnCreate = FormCreate
+  Position = poScreenCenter
+  LCLVersion = '1.9.0.0'
+  object Chart1: TChart
+    Left = 0
+    Height = 268
+    Top = 32
+    Width = 303
+    AxisList = <    
+      item
+        Minors = <>
+        Title.LabelFont.Orientation = 900
+      end    
+      item
+        Alignment = calBottom
+        Minors = <>
+      end>
+    AxisVisible = False
+    BackColor = clForm
+    Foot.Brush.Color = clBtnFace
+    Foot.Font.Color = clBlue
+    Frame.Visible = False
+    Legend.Alignment = laBottomCenter
+    Legend.ColumnCount = 3
+    Legend.Visible = True
+    Margins.Left = 8
+    Margins.Top = 8
+    Margins.Right = 8
+    Margins.Bottom = 0
+    Title.Brush.Color = clBtnFace
+    Title.Font.Color = clBlue
+    Title.Text.Strings = (
+      'TAChart'
+    )
+    Align = alClient
+    Color = clForm
+    object Chart1PieSeries1: TPieSeries
+      Legend.Multiplicity = lmPoint
+      Marks.Format = '%2:s'
+      Marks.Style = smsLabel
+      Source = DbChartSource1
+    end
+  end
+  object DBGrid1: TDBGrid
+    Left = 303
+    Height = 268
+    Top = 32
+    Width = 275
+    Align = alRight
+    AutoFillColumns = True
+    Color = clWindow
+    Columns = <>
+    DataSource = Datasource1
+    DefaultDrawing = False
+    Scrollbars = ssAutoBoth
+    TabOrder = 1
+    OnDrawColumnCell = DBGrid1DrawColumnCell
+  end
+  object Panel1: TPanel
+    Left = 0
+    Height = 32
+    Top = 0
+    Width = 578
+    Align = alTop
+    AutoSize = True
+    BevelOuter = bvNone
+    ClientHeight = 32
+    ClientWidth = 578
+    TabOrder = 2
+    object Label1: TLabel
+      AnchorSideLeft.Control = Panel1
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 8
+      Height = 15
+      Top = 9
+      Width = 77
+      BorderSpacing.Left = 8
+      Caption = 'Get color from'
+      ParentColor = False
+    end
+    object ComboBox1: TComboBox
+      AnchorSideLeft.Control = Label1
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 93
+      Height = 23
+      Top = 5
+      Width = 179
+      BorderSpacing.Left = 8
+      BorderSpacing.Top = 4
+      BorderSpacing.Right = 4
+      BorderSpacing.Bottom = 4
+      ItemHeight = 15
+      ItemIndex = 0
+      Items.Strings = (
+        'data field'
+        'OnGetItem event'
+      )
+      OnChange = ComboBox1Change
+      Style = csDropDownList
+      TabOrder = 0
+      Text = 'data field'
+    end
+  end
+  object MemDataset1: TMemDataset
+    Active = True
+    FieldDefs = <    
+      item
+        Name = 'X'
+        DataType = ftFloat
+      end    
+      item
+        Name = 'Y'
+        DataType = ftFloat
+      end    
+      item
+        Name = 'Txt'
+        DataType = ftString
+        Size = 10
+      end    
+      item
+        Name = 'Color'
+        DataType = ftInteger
+      end>
+    left = 144
+    top = 64
+  end
+  object Datasource1: TDataSource
+    DataSet = MemDataset1
+    left = 144
+    top = 128
+  end
+  object DbChartSource1: TDbChartSource
+    DataSource = Datasource1
+    FieldColor = 'Color'
+    FieldText = 'Txt'
+    FieldY = 'Y'
+    left = 144
+    top = 192
+  end
+end

components/tachart/demo/db-barseries/main.pas

@@ -0,0 +1,115 @@
+unit Main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, Classes, ComCtrls, db, DBGrids, memds, Forms, ExtCtrls, StdCtrls,
+  TADbSource, TAGraph, TASeries, TACustomSource, Grids;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    Chart1: TChart;
+    Chart1PieSeries1: TPieSeries;
+    ComboBox1: TComboBox;
+    Datasource1: TDatasource;
+    DbChartSource1: TDbChartSource;
+    DBGrid1: TDBGrid;
+    Label1: TLabel;
+    MemDataset1: TMemDataset;
+    Panel1: TPanel;
+    procedure ComboBox1Change(Sender: TObject);
+    procedure DbChartSource1GetItem(ASender: TDbChartSource;
+      var AItem: TChartDataItem);
+    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
+      DataCol: Integer; Column: TColumn; State: TGridDrawState);
+    procedure FormCreate(Sender: TObject);
+  end;
+
+var
+  Form1: TForm1; 
+
+implementation
+
+{$R *.lfm}
+
+uses
+  Graphics;
+
+{ TForm1 }
+
+procedure TForm1.ComboBox1Change(Sender: TObject);
+begin
+  case Combobox1.ItemIndex of
+    0:  // Get color from data field
+      begin
+        DbChartSource1.OnGetItem := nil;
+        DbChartSource1.FieldColor := 'Color';
+      end;
+    1: // Get color from OnGetItem event
+      begin
+        DbChartSource1.FieldColor := '';
+        DbChartSource1.OnGetItem := @DbChartSource1GetItem;
+      end;
+  end;
+end;
+
+procedure TForm1.DbChartSource1GetItem(ASender: TDbChartSource;
+  var AItem: TChartDataItem);
+const
+  COLORS: array[1..3] of TColor = (clNavy, clBlue, clSkyBlue);
+var
+  s: String;
+  i: integer;
+begin
+  DbChartSource1.DefaultGetItem(AItem);
+  s := '';
+  i := Length(AItem.Text);
+  while (i > 0) and (AItem.Text[i] in ['0'..'9']) do begin
+    s := AItem.Text[i] + s;
+    dec(i);
+  end;
+  AItem.Color := COLORS[StrToInt(s)];
+end;
+
+procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
+  DataCol: Integer; Column: TColumn; State: TGridDrawState);
+begin
+  if Column.Field.FieldName = 'Color' then begin
+    DBGrid1.Canvas.Brush.Color := Column.Field.AsInteger;
+    DBGrid1.Canvas.Rectangle(Rect.Left + 2, Rect.Top+2, Rect.Right-2, Rect.Bottom-2);
+  end else
+    DBGrid1.Canvas.TextOut(Rect.Left+2, Rect.Top+2, Column.Field.DisplayText);
+end;
+
+{ Add dummy data to start with }
+procedure TForm1.FormCreate(Sender: TObject);
+const
+  N = 3;
+var
+  i: Integer;
+  Fx, Fy, Ftxt, Fcolor: TField;
+begin
+  MemDataset1.Open;
+
+  Fx := MemDataset1.FieldByName('X');
+  Fy := MemDataset1.FieldByName('Y');
+  Ftxt := MemDataset1.FieldByName('Txt');
+  Fcolor := MemDataset1.FieldByName('Color');
+  for i:= 1 to N do begin
+    MemDataset1.Append;
+    //Fx.AsInteger := i;    // Note: in an un-exploded pie series, x is not needed.
+    if i=1 then Fx.AsFloat := 0.1 else Fx.AsFloat := 0;
+    Fy.AsFloat := Random * (i+1);
+    Ftxt.AsString := 'Item ' + IntToStr(i);
+    FColor.AsInteger := RgbToColor(Random(255), Random(255), Random(255));
+    MemDataset1.Post;
+  end;
+end;
+
+end.
+

components/tachart/tadbsource.pas

@@ -310,7 +310,7 @@ end;
 
 procedure TDbChartSource.SetOnGetItem(AValue: TDbChartSourceGetItemEvent);
 begin
-  if FOnGetItem = AValue then exit;
+  if TMethod(FOnGetItem) = TMethod(AValue) then exit;
   FOnGetItem := AValue;
   Reset;
 end;