diff --git a/.gitattributes b/.gitattributes index ebeb7df93f..bf752e9a63 100644 --- a/.gitattributes +++ b/.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 diff --git a/components/tachart/demo/db-barseries/dbdemo.lpi b/components/tachart/demo/db-barseries/dbdemo.lpi new file mode 100644 index 0000000000..11d8e51387 --- /dev/null +++ b/components/tachart/demo/db-barseries/dbdemo.lpi @@ -0,0 +1,97 @@ + + + + + + + + + + + + + + <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> diff --git a/components/tachart/demo/db-barseries/dbdemo.lpr b/components/tachart/demo/db-barseries/dbdemo.lpr new file mode 100644 index 0000000000..90850269f3 --- /dev/null +++ b/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. + diff --git a/components/tachart/demo/db-barseries/main.lfm b/components/tachart/demo/db-barseries/main.lfm new file mode 100644 index 0000000000..fbb04c935b --- /dev/null +++ b/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 diff --git a/components/tachart/demo/db-barseries/main.pas b/components/tachart/demo/db-barseries/main.pas new file mode 100644 index 0000000000..9e4b14c7de --- /dev/null +++ b/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. + diff --git a/components/tachart/tadbsource.pas b/components/tachart/tadbsource.pas index 33130c6f19..3cf80407b1 100644 --- a/components/tachart/tadbsource.pas +++ b/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;