mcmahling
asked on
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(Sen der: TChartSeries;
ValueIndex: Integer): TSeriesPointerStyle;
private
nOnClickChart : TNotifyevent;
procedure DoOnClick(Sender : TObject);
public
DBCharts : array of TDBChart;
Labels: array of TLabel;
function Add(intPositionCharts:inte ger;strTab leName:Str ing;strTit le:String; strSeriesN ame:String ;intSubMod el:integer ;aDatabase :TNXDataba se;strCoun try:String ;intTitleP osition:in teger): integer;
published
property OnClickChart: TNotifyEvent read nOnClickChart write nOnClickChart;
end;
procedure Register;
Var
l: integer;
implementation
procedure Register;
begin
RegisterComponents('Additi onal', [TMultiDBChart]);
end;
procedure TMultiDBChart.DoOnClick(Se nder : TObject);
var
strValue: String;
begin
end;
function TMultiDBChart.Add(intPosit ionCharts: integer;st rTableName :String;st rTitle:Str ing;strSer iesName:St ring;intSu bModel:int eger;aData base:TNXDa tabase;str Country:St ring;intTi tlePositio n: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.crea te(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:=Serie s1GetPoint erStyle;
parent := self;
Onclick := DoOnClick;
Top := intPositionCharts + 10;
Height := 175;
Width := 641;
DBCharts[l].BottomAxis.Vis ible := True;
DBCharts[l].Legend.Visible := True;
DBCharts[l].Title.Visible := False;
DBCharts[l].Color := $00EAFFEA;
DBCharts[l].Tools.Add(TCur sorTool.Cr eate(self) );
(DBCharts[l].Tools.Items[0 ] as TCursorTool).FollowMouse:= true;
(DBCharts[l].Tools.Items[0 ] as TCursorTool).OnChange:=Cha rtTool1Cha nge;
(DBCharts[l].Tools.Items[0 ] as TCursorTool).Style:=cssVer tical;
//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('Se lect Distinct Subject, SubjectID From ProfileSubModelSubject ');
Subject_Query1.SQL.Add(' Where SubModelID=:intSubModel;') ;
Subject_Query1.ParamByName ('intSubMo del').AsIn teger := intSubModel;
Subject_Query1.ActiveRunti me := True;
For intList := 1 to Subject_Query1.RecordCount do
begin
intSubjectID := Subject_Query1.FieldByName ('SubjectI D').asInte ger;
strSubject := Subject_Query1.FieldByName (strSeries Name).asSt ring;
ChartQuery1 := TNXQuery.Create(Self);
ChartQuery1.Database := aDatabase;
ChartQuery1.SQL.Clear;
ChartQuery1.SQL.Add('Selec t * 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('i ntSubModel ID').asInt eger := intSubModel;
ChartQuery1.ParamByName('i ntSubjectI D').asInte ger := intSubjectID;
ChartQuery1.ParamByName('s trValue'). asString := strCountry;
ChartQuery1.ActiveRuntime := True;
strChartTitle := ChartQuery1.FieldByName(st rTitle).as String;
//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(tmpP ointSeries );
With tmpPointSeries do
Begin
DataSource:= ChartQuery1;
YValues.ValueSource := 'Score';
XLabelsSource := 'PublicationDate';
tmpPointSeries.Color := $00408080;
Pointer.Visible := True;
Title := strSubject;
CheckDataSource;
OnGetPointerStyle:=Series1 GetPointer Style;
DBCharts[l].Draw;
end;
end
else
begin
tmpLineSeries := TLineSeries.Create(self);
DBCharts[l].AddSeries(tmpL ineSeries) ;
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:=Series1 GetPointer Style;
DBCharts[l].Draw;
end;
end;
result := l;
Subject_Query1.Next;
end;
end;
function TMultiDBChart.Series1GetPo interStyle (
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.YV alue[Value Index]);
intValue := Trunc(Sender.XValue[ValueI ndex]);
strValue := Sender.XLabel[ValueIndex];
except
end;
end;
procedure TMultiDBChart.ChartTool1Ge tText(
Sender: TMarksTipTool; var Text: string);
begin
ShowMessage(Text);
end;
procedure TMultiDBChart.ChartTool1Ch ange(Sende r: 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[V alueIndex] );
if strValue <> '' then
begin
strValue := FloatToStr(Series.XValue[V alueIndex] );
end;
end;
except
end;
try
for intList := 0 to l do
begin
DBCharts[intList].Draw;
end;
except
end;
end;
end;
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(Sen
ValueIndex: Integer): TSeriesPointerStyle;
private
nOnClickChart : TNotifyevent;
procedure DoOnClick(Sender : TObject);
public
DBCharts : array of TDBChart;
Labels: array of TLabel;
function Add(intPositionCharts:inte
published
property OnClickChart: TNotifyEvent read nOnClickChart write nOnClickChart;
end;
procedure Register;
Var
l: integer;
implementation
procedure Register;
begin
RegisterComponents('Additi
end;
procedure TMultiDBChart.DoOnClick(Se
var
strValue: String;
begin
end;
function TMultiDBChart.Add(intPosit
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.crea
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:=Serie
parent := self;
Onclick := DoOnClick;
Top := intPositionCharts + 10;
Height := 175;
Width := 641;
DBCharts[l].BottomAxis.Vis
DBCharts[l].Legend.Visible
DBCharts[l].Title.Visible := False;
DBCharts[l].Color := $00EAFFEA;
DBCharts[l].Tools.Add(TCur
(DBCharts[l].Tools.Items[0
(DBCharts[l].Tools.Items[0
(DBCharts[l].Tools.Items[0
//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('Se
Subject_Query1.SQL.Add(' Where SubModelID=:intSubModel;')
Subject_Query1.ParamByName
Subject_Query1.ActiveRunti
For intList := 1 to Subject_Query1.RecordCount
begin
intSubjectID := Subject_Query1.FieldByName
strSubject := Subject_Query1.FieldByName
ChartQuery1 := TNXQuery.Create(Self);
ChartQuery1.Database := aDatabase;
ChartQuery1.SQL.Clear;
ChartQuery1.SQL.Add('Selec
ChartQuery1.Sql.Add(' Where SubModelID =:intSubModelID and Exported = True ');
ChartQuery1.Sql.Add(' and SubjectID=:intSubjectID and Country=:strValue Order By PublicationDate;');
ChartQuery1.ParamByName('i
ChartQuery1.ParamByName('i
ChartQuery1.ParamByName('s
ChartQuery1.ActiveRuntime := True;
strChartTitle := ChartQuery1.FieldByName(st
//Labels[l].Caption := strChartTitle;
DBCharts[l].Title.Caption := strChartTitle;
DBCharts[l].LeftAxis.Title
DBCharts[l].LeftAxis.Title
DBCharts[l].Title.Visible := True;
if ChartQuery1.RecordCount = 1 then
begin
tmpPointSeries := TPointSeries.Create(self);
DBCharts[l].AddSeries(tmpP
With tmpPointSeries do
Begin
DataSource:= ChartQuery1;
YValues.ValueSource := 'Score';
XLabelsSource := 'PublicationDate';
tmpPointSeries.Color := $00408080;
Pointer.Visible := True;
Title := strSubject;
CheckDataSource;
OnGetPointerStyle:=Series1
DBCharts[l].Draw;
end;
end
else
begin
tmpLineSeries := TLineSeries.Create(self);
DBCharts[l].AddSeries(tmpL
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:=Series1
DBCharts[l].Draw;
end;
end;
result := l;
Subject_Query1.Next;
end;
end;
function TMultiDBChart.Series1GetPo
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
intValue := Trunc(Sender.XValue[ValueI
strValue := Sender.XLabel[ValueIndex];
except
end;
end;
procedure TMultiDBChart.ChartTool1Ge
Sender: TMarksTipTool; var Text: string);
begin
ShowMessage(Text);
end;
procedure TMultiDBChart.ChartTool1Ch
const XValue, YValue: Double; Series: TChartSeries; ValueIndex: Integer);
Var
strValue: String;
intList: integer;
begin
try
if ValueIndex > -1 then
begin
strValue := FloatToStr(Series.XValue[V
if strValue <> '' then
begin
strValue := FloatToStr(Series.XValue[V
end;
end;
except
end;
try
for intList := 0 to l do
begin
DBCharts[intList].Draw;
end;
except
end;
end;
end;
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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.