Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 624
  • Last Modified:

Event Not Working

I am using Delphi 2005 VCL. I wrote the code below to create a custom component that draws DBCharts on a TScrollBox. The scrollbox can have multiple DBCharts. The code does fine at creating the scrollbox and the DBCharts but the event GetText is not firing. The event ChartTool.OnChange is working.  

I need to be able to get the series name and the X and Y value when the user clicks on the DBChart.  Also I want to add the ability for the user to magnify a selected area of the DBChart. So can some suggest some code? Thanks


unit MultiDBChart;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, DBChart, Forms,
nxDB, Series, TeeProcs, TeEngine, Chart, DBCtrls, StdCtrls,
TeeTools, Math, Graphics, Dialogs;

type
TMultiDBChart = class(TScrollBox)
Series1: TLineSeries;
ChartTool1: TMarksTipTool;
ChartTool2: TMarksTipTool;
procedure ChartTool1GetText(Sender: TMarksTipTool; var Text: string);
procedure ChartTool1Change(Sender: TCursorTool; x, y: Integer;
const XValue, YValue: Double; Series: TChartSeries; ValueIndex: Integer);
function Series1GetPointerStyle(Sender: TChartSeries;
ValueIndex: Integer): TSeriesPointerStyle;
private
nOnClickChart : TNotifyevent;
procedure DoOnClick(Sender : TObject);
public
DBCharts : array of TDBChart;
Labels: array of TLabel;
function Add(intPositionCharts:integer;strTableName:String;strTitle:String;strSeriesName:String;intSubModel:integer;aDatabase:TNXDatabase;strCountry:String;intTitlePosition:integer): integer;
published
property OnClickChart: TNotifyEvent read nOnClickChart write nOnClickChart;
end;
procedure Register;

Var
l: integer;

implementation

procedure Register;
begin
RegisterComponents('Additional', [TMultiDBChart]);
end;

procedure TMultiDBChart.DoOnClick(Sender : TObject);
var
strValue: String;
begin

end;

function TMultiDBChart.Add(intPositionCharts:integer;strTableName:String;strTitle:String;strSeriesName:String;intSubModel:integer;aDatabase:TNXDatabase;strCountry:String;intTitlePosition:integer): integer;
Var
strSubject: String;
tmpPointSeries: TPointSeries;
tmpLineSeries: TLineSeries;
intList: integer;
strChartTitle: String;
Subject_Query1: TNXQuery;
ChartQuery1: TNXQuery;
intSubjectID: integer;

begin
l:=Length(DBCharts);
l:=Length(Labels);
SetLength(Labels,l+1);
SetLength(DBCharts,l+1);
DBCharts[l]:=TDBChart.create(self);
Labels[l] := TLabel.Create(self);
Labels[l].parent := self;
Labels[l].Top := intTitlePosition;
Labels[l].Left := 650;
Labels[l].Caption := strCountry;
Labels[l].AutoSize := True;
//Labels[l].Color := $00EAFFEA;
Labels[l].Font.Name := 'Times New Roman';
Labels[l].Font.Color := clGreen;
Labels[l].Font.Size := 10;
DBCharts[l].Title.Caption := 'Status';
with DBCharts[l] do
begin
//OnGetPointerStyle:=Series1GetPointerStyle;
parent := self;
Onclick := DoOnClick;
Top := intPositionCharts + 10;
Height := 175;
Width := 641;
DBCharts[l].BottomAxis.Visible := True;
DBCharts[l].Legend.Visible := True;
DBCharts[l].Title.Visible := False;
DBCharts[l].Color := $00EAFFEA;
DBCharts[l].Tools.Add(TCursorTool.Create(self));
(DBCharts[l].Tools.Items[0] as TCursorTool).FollowMouse:=true;
(DBCharts[l].Tools.Items[0] as TCursorTool).OnChange:=ChartTool1Change;
(DBCharts[l].Tools.Items[0] as TCursorTool).Style:=cssVertical;

//set width height and posittion of DBChart here.
end;
Subject_Query1 := TNXQuery.Create(Self);
Subject_Query1.Database := aDatabase;
Subject_Query1.SQL.Clear;
Subject_Query1.SQL.Add('Select Distinct Subject, SubjectID From ProfileSubModelSubject ');
Subject_Query1.SQL.Add(' Where SubModelID=:intSubModel;');
Subject_Query1.ParamByName('intSubModel').AsInteger := intSubModel;
Subject_Query1.ActiveRuntime := True;

For intList := 1 to Subject_Query1.RecordCount do
begin
intSubjectID := Subject_Query1.FieldByName('SubjectID').asInteger;
strSubject := Subject_Query1.FieldByName(strSeriesName).asString;
ChartQuery1 := TNXQuery.Create(Self);
ChartQuery1.Database := aDatabase;
ChartQuery1.SQL.Clear;
ChartQuery1.SQL.Add('Select * from ' + strTableName );
ChartQuery1.Sql.Add(' Where SubModelID =:intSubModelID and Exported = True ');
ChartQuery1.Sql.Add(' and SubjectID=:intSubjectID and Country=:strValue Order By PublicationDate;');
ChartQuery1.ParamByName('intSubModelID').asInteger := intSubModel;
ChartQuery1.ParamByName('intSubjectID').asInteger := intSubjectID;
ChartQuery1.ParamByName('strValue').asString := strCountry;
ChartQuery1.ActiveRuntime := True;
strChartTitle := ChartQuery1.FieldByName(strTitle).asString;
//Labels[l].Caption := strChartTitle;
DBCharts[l].Title.Caption := strChartTitle;
DBCharts[l].LeftAxis.Title.Caption := strChartTitle;
DBCharts[l].LeftAxis.Title.Visible := True;
DBCharts[l].Title.Visible := True;
if ChartQuery1.RecordCount = 1 then
begin
tmpPointSeries := TPointSeries.Create(self);
DBCharts[l].AddSeries(tmpPointSeries);
With tmpPointSeries do
Begin
DataSource:= ChartQuery1;
YValues.ValueSource := 'Score';
XLabelsSource := 'PublicationDate';
tmpPointSeries.Color := $00408080;
Pointer.Visible := True;
Title := strSubject;
CheckDataSource;
OnGetPointerStyle:=Series1GetPointerStyle;
DBCharts[l].Draw;
end;
end
else
begin
tmpLineSeries := TLineSeries.Create(self);
DBCharts[l].AddSeries(tmpLineSeries);
With tmpLineSeries do
Begin
DataSource:= ChartQuery1;
YValues.ValueSource := 'Score';
XLabelsSource := 'PublicationDate';
Pointer.Visible := False;
Title := strSubject;
case intList of
1 :Begin
tmpLineSeries.Color := $00408080;
end;
2 :Begin
tmpLineSeries.Color := $00A4C7A3;
end;
3 :Begin
tmpLineSeries.Color := $00804000;
end;
4 :Begin
tmpLineSeries.Color := $004080FF;
end;
5 :Begin
tmpLineSeries.Color := $00400080;
end;
6 :Begin
tmpLineSeries.Color := $00C08080;
end;
7 :Begin
tmpLineSeries.Color := $00B3FFFF;
end;
8 :Begin
tmpLineSeries.Color := clAqua;
end;
9 :Begin
tmpLineSeries.Color := $00FF8000;
end;
10:Begin
tmpLineSeries.Color := $00A4C7A3;
end;
end;
CheckDataSource;
OnGetPointerStyle:=Series1GetPointerStyle;
DBCharts[l].Draw;
end;
end;
result := l;
Subject_Query1.Next;
end;


end;

function TMultiDBChart.Series1GetPointerStyle(
Sender: TChartSeries; ValueIndex: Integer): TSeriesPointerStyle;
var
tmp: integer;
dbValue: Double;
strSeriesName: String;
intValue: Variant;
strValue: String;
begin
try
strSeriesName := Sender.Title;
tmp:=Sender.YValues.Locate(Sender.YValue[ValueIndex]);
intValue := Trunc(Sender.XValue[ValueIndex]);
strValue := Sender.XLabel[ValueIndex];
except
end;
end;


procedure TMultiDBChart.ChartTool1GetText(
Sender: TMarksTipTool; var Text: string);
begin
ShowMessage(Text);
end;

procedure TMultiDBChart.ChartTool1Change(Sender: TCursorTool; x, y: Integer;
const XValue, YValue: Double; Series: TChartSeries; ValueIndex: Integer);
Var
strValue: String;
intList: integer;

begin

try
if ValueIndex > -1 then
begin
strValue := FloatToStr(Series.XValue[ValueIndex]);
if strValue <> '' then
begin
strValue := FloatToStr(Series.XValue[ValueIndex]);
end;
end;
except
end;

try
for intList := 0 to l do
begin
DBCharts[intList].Draw;
end;
except
end;
end;

end;
0
mcmahling
Asked:
mcmahling
  • 2
1 Solution
 
serraultCommented:
I did not spend much time seeing if the following issue would correct your specfic problem, but it seems that it might:

Towards the top of your code you use an Integer variable of I where you have:
l:=Length(DBCharts);
l:=Length(Labels);
SetLength(Labels,l+1);
SetLength(DBCharts,l+1);

Unless Length(DBCharts) is always equal to Length(Labels), which I assume it is not, it would seem you need 2 seperate variables for both computing size(length) and assigning values later.
0
 
serraultCommented:
mcmahling,

I was curious if the above took care of your problem.  If not I can look further if you can indicate what effect, if anything, resolving the above issue had on the results obtained.
0

Featured Post

Prep for the ITIL® Foundation Certification Exam

December’s Course of the Month is now available! Enroll to learn ITIL® Foundation best practices for delivering IT services effectively and efficiently.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now