Peter Kiers
asked on
Add data to a x-axis of a tchart
Hi,
I have a listview with 5 columns and the third columns
contains dates. How can I convert these dates to a day-number.
(A few days ago I found a procedure to do that, but I can't find it anymore)
and displayed these numbers in the x-axis of a tchart.
Peter
I have a listview with 5 columns and the third columns
contains dates. How can I convert these dates to a day-number.
(A few days ago I found a procedure to do that, but I can't find it anymore)
and displayed these numbers in the x-axis of a tchart.
Peter
Get the day number in its year
function FirstDayOfYear(D:TDate):TDate;
var Year, Month, Day: Word;
begin
DecodeDate(Date, Year, Month, Day);
Result:=EncodeDate(Year,1,1);
end;
function NumDayOfYear(D:TDate):Integer;
begin
Result:=Trunc(D-FirstDayOfYear(D))+1;
end
ASKER
I am trying but I really don't understand.
this is the code for what you want (in your other post) modified with the date requirement
procedure TForm1.AddListViewValuesToSerie(NumSerie:Integer;lv:TListView;
SubColVal,SubColDat:Integer);
procedure AddToSerie(StrVal,StrDat:String);
Var
Val:Double;
Dat:TDate;
begin
TryStrToFloat(StrVal,Val);
TryStrToDate(StrDat,Dat);
With Chart.Series[NumSerie] do AddXY(NumDayOfYear(Dat),Val);
end;
Var
i:integer;
begin
Chart.Series[NumSerie].Clear;
for i:=0 to lv.Items.Count-1 do With lv.Items[i] do
begin
AddToSerie(SubItems[SubColDat],SubItems[SubColVal]);
end;
end;
Note : I simplified the code here compared to other question, because here I assume that both the value and the date are in the SubItems of each LV items, not in the caption.
ASKER
I just don't understand what it isn't working. I understand everthing you said.
But it still doesn't work.
So, I have put the code in the code section.
And I get an error-message in this procedure:
procedure TForm1.AddListViewValuesTo Serie(NumS erie: Integer; lv: TListView;
SubColVal, SubColDat: Integer);
procedure AddToSerie(StrVal,StrDat:S tring);
Var
Val:Double;
Dat:TDate;
begin
TryStrToFloat(StrVal,Val);
// TryStrToDate(StrDat,Dat); <=============
Error: E2250 There is no overloaded version of 'TryStrToDate' that can be called with these arguments
Peter
But it still doesn't work.
So, I have put the code in the code section.
And I get an error-message in this procedure:
procedure TForm1.AddListViewValuesTo
SubColVal, SubColDat: Integer);
procedure AddToSerie(StrVal,StrDat:S
Var
Val:Double;
Dat:TDate;
begin
TryStrToFloat(StrVal,Val);
// TryStrToDate(StrDat,Dat); <=============
Error: E2250 There is no overloaded version of 'TryStrToDate' that can be called with these arguments
Peter
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, TeeProcs, TeEngine, Chart, StdCtrls, Series, ComCtrls,
xmldom, XMLIntf, msxmldom, XMLDoc;
type
TForm1 = class(TForm)
Chart1: TChart;
lstvGlucose: TListView;
XMLDoc: TXMLDocument;
Series1: TLineSeries;
Series2: TLineSeries;
Series3: TLineSeries;
Button2: TButton;
Button1: TButton;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure AddToSerie(NumSerie:Integer;Str:String);
public
{ Public declarations }
procedure AddListViewValuesToSerie(NumSerie:Integer;lv:TListView;
SubColVal,SubColDat:Integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function FirstDayOfYear(D:TDate):TDate;
var Year, Month, Day: Word;
begin
DecodeDate(Date, Year, Month, Day);
Result:=EncodeDate(Year,1,1);
end;
(*---------------------------------------------*)
function NumDayOfYear(D:TDate):Integer;
begin
Result:=Trunc(D-FirstDayOfYear(D))+1;
end;
(*---------------------------------------------*)
procedure TForm1.AddListViewValuesToSerie(NumSerie: Integer; lv: TListView;
SubColVal, SubColDat: Integer);
procedure AddToSerie(StrVal,StrDat:String);
Var
Val:Double;
Dat:TDate;
begin
TryStrToFloat(StrVal,Val);
// TryStrToDate(StrDat,Dat);
With Chart1.Series[NumSerie] do AddXY(NumDayOfYear(Dat),Val);
end;
Var
i:integer;
begin
Chart1.Series[NumSerie].Clear;
for i:=0 to lv.Items.Count-1 do With lv.Items[i] do
begin
AddToSerie(SubItems[SubColDat],SubItems[SubColVal]);
end;
end;
(*---------------------------------------------*)
procedure TForm1.AddToSerie(NumSerie: Integer; Str: String);
Var Val:Double;
begin
TryStrToFloat(Str,Val);
With Chart1.Series[NumSerie] do Add(Val);
end;
(*---------------------------------------------*)
procedure TForm1.Button1Click(Sender: TObject);
Const
MinX=0;
MaxX=30;
begin
With Chart1.Series[0] do
begin
AddXY(MinX,4);
AddXY(MaxX,4);
end;
With Chart1.Series[1] do
begin
AddXY(MinX,10);
AddXY(MaxX,10);
end;
With Chart1.Series[2] do
begin
AddListViewValuesToSerie(3,lstvGlucose,0,3);
end;
end;
(*---------------------------------------------*)
end.
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 600
ClientWidth = 800
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Chart1: TChart
Left = 0
Top = 215
Width = 800
Height = 385
BackWall.Brush.Color = clWhite
BackWall.Brush.Style = bsClear
LeftWall.Color = clWhite
Title.Text.Strings = (
'TChart')
BottomAxis.Automatic = False
BottomAxis.AutomaticMaximum = False
BottomAxis.AutomaticMinimum = False
BottomAxis.ExactDateTime = False
BottomAxis.Increment = 1.000000000000000000
BottomAxis.Maximum = 25.000000000000000000
LeftAxis.Automatic = False
LeftAxis.AutomaticMaximum = False
LeftAxis.AutomaticMinimum = False
LeftAxis.ExactDateTime = False
LeftAxis.Increment = 2.000000000000000000
LeftAxis.Maximum = 35.000000000000000000
LeftAxis.Title.Caption = 'Glucose'
View3D = False
Align = alBottom
TabOrder = 0
object Series1: TLineSeries
Marks.ArrowLength = 8
Marks.Visible = False
SeriesColor = clBlack
ShowInLegend = False
Title = 'Top baseline'
Dark3D = False
LinePen.Width = 2
Pointer.InflateMargins = True
Pointer.Style = psRectangle
Pointer.Visible = False
XValues.DateTime = False
XValues.Name = 'X'
XValues.Multiplier = 1.000000000000000000
XValues.Order = loAscending
YValues.DateTime = False
YValues.Name = 'Y'
YValues.Multiplier = 1.000000000000000000
YValues.Order = loNone
end
object Series2: TLineSeries
Marks.ArrowLength = 8
Marks.Visible = False
SeriesColor = clBlack
ShowInLegend = False
Title = 'Bottom baseline'
LinePen.Width = 2
Pointer.InflateMargins = True
Pointer.Style = psRectangle
Pointer.Visible = False
XValues.DateTime = False
XValues.Name = 'X'
XValues.Multiplier = 1.000000000000000000
XValues.Order = loAscending
YValues.DateTime = False
YValues.Name = 'Y'
YValues.Multiplier = 1.000000000000000000
YValues.Order = loNone
end
object Series3: TLineSeries
Marks.ArrowLength = 8
Marks.Visible = False
SeriesColor = clRed
Title = 'Glucose'
Pointer.InflateMargins = True
Pointer.Style = psRectangle
Pointer.Visible = False
XValues.DateTime = False
XValues.Name = 'X'
XValues.Multiplier = 1.000000000000000000
XValues.Order = loAscending
YValues.DateTime = False
YValues.Name = 'Y'
YValues.Multiplier = 1.000000000000000000
YValues.Order = loNone
end
end
object lstvGlucose: TListView
Left = 296
Top = 8
Width = 409
Height = 185
Columns = <
item
Width = 75
end
item
Width = 75
end
item
Width = 75
end
item
Width = 75
end
item
Width = 75
end>
GridLines = True
TabOrder = 1
ViewStyle = vsReport
end
object Button2: TButton
Left = 24
Top = 8
Width = 75
Height = 25
Caption = 'List'
TabOrder = 2
OnClick = Button2Click
end
object Button1: TButton
Left = 24
Top = 39
Width = 75
Height = 25
Caption = 'Graph'
TabOrder = 3
OnClick = Button1Click
end
object XMLDoc: TXMLDocument
Left = 712
Top = 560
DOMVendorDesc = 'MSXML'
end
end
Naamloos.jpg
StrToDate needs a TDateTime parameter. That's a bit stupid as TDateTime = TDate, but declare Dat as TDateTime
Var
Val:Double;
Dat:TDateTime; <=============
begin
TryStrToFloat(StrVal,Val);
TryStrToDate(StrDat,Dat); <=============
I cant test to see what's wrong on your code, I don't have values in the list. probably that is what's behind the List button ?
ASKER
This is what I got in my listbutton, its reads an xml-document:
Rename the G1839366.txt to G1839366.XML
and put the xml-file in the examples folder.
p.
Rename the G1839366.txt to G1839366.XML
and put the xml-file in the examples folder.
p.
procedure TForm1.Button2Click(Sender: TObject);
const
FormatFrom: TFormatSettings = (DateSeparator: '-'; ShortDateFormat: 'yyyy-mm-dd');
FormatTo: TFormatSettings = (DateSeparator: '-'; ShortDateFormat: 'dd-mm-yyyy');
DoubleFormat: TFormatSettings = (DecimalSeparator: '.');
Days : array[1..7] of string
= ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday');
var
LoopNodes : IDOMNodeList;
i: Integer;
DateTime: TDateTime;
Val: Extended;
strVal, strValText: string;
begin
XMLDoc.FileName := '.\G1839366.XML';
XMLDoc.Active := True;
try
LoopNodes:= XMLDoc.DOMDocument.getElementsByTagName( 'BG' );
lstvGlucose.Items.BeginUpdate;
try
lstvGlucose.Items.Clear;
for i:= 0 to LoopNodes.length -1 do
with lstvGlucose.Items.add do
begin
if TryStrToDate(LoopNodes[i].attributes.getNamedItem('Dt').nodeValue, DateTime, FormatFrom) then
begin
Caption:= Days[ DayOfWeek(DateTime) ];
SubItems.Add( DateToStr( DateTime, FormatTo ) );
end
else
begin
Caption:= 'can''t convert date';
SubItems.Add( LoopNodes[i].attributes.getNamedItem('Dt').nodeValue );
end;
SubItems.Add( LoopNodes[i].attributes.getNamedItem('Tm').nodeValue );
SubItems.Add( LoopNodes[i].attributes.getNamedItem('Val').nodeValue );
strVal:= StringReplace(LoopNodes[i].attributes.getNamedItem('Val').NodeValue, ',', '.', []);
strValText:= '';
if TryStrToFloat( strVal, Val, DoubleFormat ) then
if Val < 4 then
strValText:= 'HYPO'
else if Val > 10 then
strValText:= 'HYPER';
SubItems.Add( strValText );
end;
finally
lstvGlucose.Items.EndUpdate;
end;
finally
XMLDoc.Active := False;
end;
end;
G1839366.txt
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks for you help.
Greetings, Peter kiers
Greetings, Peter kiers
ASKER
I have tried your example but I don't get it like that.
Could you please look at it once more what I forgot.
Even thou I allready gave the points.
Or send me your example.
Please
peter
Could you please look at it once more what I forgot.
Even thou I allready gave the points.
Or send me your example.
Please
peter
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, xmldom, XMLIntf, msxmldom, XMLDoc, StdCtrls, ComCtrls, ExtCtrls,
TeeProcs, TeEngine, Chart, Series;
type
TMainForm = class(TForm)
lstvGlucose: TListView;
btnList: TButton;
btnGraph: TButton;
XMLDoc: TXMLDocument;
Chart1: TChart;
Series1: TLineSeries;
Series2: TLineSeries;
Series3: TLineSeries;
procedure btnGraphClick(Sender: TObject);
procedure btnListClick(Sender: TObject);
private
{ Private declarations }
procedure AddToSerie(NumSerie:Integer;Str:String);
public
{ Public declarations }
procedure AddListViewValuesToSerie(NumSerie:Integer;lv:TListView;
SubColVal,SubColDat:Integer);
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
function FirstDayOfYear(D:TDate):TDate;
var Year, Month, Day: Word;
begin
DecodeDate(Date, Year, Month, Day);
Result:=EncodeDate(Year,1,1);
end;
(*---------------------------------------------*)
function NumDayOfYear(D:TDate):Integer;
begin
Result:=Trunc(D-FirstDayOfYear(D))+1;
end;
(*---------------------------------------------*)
procedure TMainForm.AddListViewValuesToSerie(NumSerie: Integer; lv: TListView;
SubColVal, SubColDat: Integer);
procedure AddToSerie(StrVal,StrDat:String);
Var
Val:Double;
Dat:TDateTime;
begin
StrVal:=StringReplace(StrVal,'.',',',[rfReplaceAll]);
TryStrToFloat(StrVal,Val);
StrDat:=StringReplace(StrDat,'-','/',[rfReplaceAll]);
TryStrToDate(StrDat,Dat);
With Chart1.Series[NumSerie] do AddXY(NumDayOfYear(Dat),Val);
end;
Var
i:integer;
begin
Chart1.Series[NumSerie].Clear;
for i:=0 to lv.Items.Count-1 do With lv.Items[i] do
begin
AddToSerie(SubItems[SubColVal],SubItems[SubColDat]);
end;
end;
(*---------------------------------------------*)
procedure TMainForm.AddToSerie(NumSerie: Integer; Str: String);
Var Val:Double;
begin
TryStrToFloat(Str,Val);
With Chart1.Series[NumSerie] do Add(Val);
end;
(*---------------------------------------------*)
procedure TMainForm.btnGraphClick(Sender: TObject);
Var
MinX,MaxX:Integer;
begin
Chart1.Series[0].Clear;
Chart1.Series[1].Clear;
AddListViewValuesToSerie(2,lstvGlucose,2,0);
MinX:=Round(Chart1.Series[2].MinXValue)-1;
MaxX:=Round(Chart1.Series[2].MaxXValue)+1;
With Chart1.Series[0] do
begin
AddXY(MinX,4);
AddXY(MaxX,4);
end;
With Chart1.Series[1] do
begin
AddXY(MinX,10);
AddXY(MaxX,10);
end;
end;
(*---------------------------------------------*)
procedure TMainForm.btnListClick(Sender: TObject);
const
FormatFrom: TFormatSettings = (DateSeparator: '-'; ShortDateFormat: 'yyyy-mm-dd');
FormatTo: TFormatSettings = (DateSeparator: '-'; ShortDateFormat: 'dd-mm-yyyy');
DoubleFormat: TFormatSettings = (DecimalSeparator: '.');
Days : array[1..7] of string
= ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday');
var
LoopNodes : IDOMNodeList;
i: Integer;
DateTime: TDateTime;
Val: Extended;
strVal, strValText: string;
begin
XMLDoc.FileName := '.\G1839366.XML';
XMLDoc.Active := True;
try
LoopNodes:= XMLDoc.DOMDocument.getElementsByTagName( 'BG' );
lstvGlucose.Items.BeginUpdate;
try
lstvGlucose.Items.Clear;
for i:= 0 to LoopNodes.length -1 do
with lstvGlucose.Items.add do
begin
if TryStrToDate(LoopNodes[i].attributes.getNamedItem('Dt').nodeValue, DateTime, FormatFrom) then
begin
Caption:= Days[ DayOfWeek(DateTime) ];
SubItems.Add( DateToStr( DateTime, FormatTo ) );
end
else
begin
Caption:= 'can''t convert date';
SubItems.Add( LoopNodes[i].attributes.getNamedItem('Dt').nodeValue );
end;
SubItems.Add( LoopNodes[i].attributes.getNamedItem('Tm').nodeValue );
SubItems.Add( LoopNodes[i].attributes.getNamedItem('Val').nodeValue );
strVal:= StringReplace(LoopNodes[i].attributes.getNamedItem('Val').NodeValue, ',', '.', []);
strValText:= '';
if TryStrToFloat( strVal, Val, DoubleFormat ) then
if Val < 4 then
strValText:= 'HYPO'
else if Val > 10 then
strValText:= 'HYPER';
SubItems.Add( strValText );
end;
finally
lstvGlucose.Items.EndUpdate;
end;
finally
XMLDoc.Active := False;
end;
end;
(*---------------------------------------------*)
end.
object MainForm: TMainForm
Left = 0
Top = 0
Caption = 'TChart Sample'
ClientHeight = 600
ClientWidth = 800
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object lstvGlucose: TListView
Left = 248
Top = 8
Width = 529
Height = 225
Columns = <
item
Caption = 'Day'
Width = 70
end
item
Caption = 'Date'
Width = 70
end
item
Caption = 'Time'
Width = 70
end
item
Caption = 'Value'
Width = 70
end
item
Caption = 'Hypo/Hyper'
Width = 70
end>
GridLines = True
TabOrder = 0
ViewStyle = vsReport
end
object btnList: TButton
Left = 24
Top = 16
Width = 75
Height = 25
Caption = 'List'
TabOrder = 1
OnClick = btnListClick
end
object btnGraph: TButton
Left = 24
Top = 47
Width = 75
Height = 25
Caption = 'Graph'
TabOrder = 2
OnClick = btnGraphClick
end
object Chart1: TChart
Left = 176
Top = 264
Width = 601
Height = 328
BackWall.Brush.Color = clWhite
BackWall.Brush.Style = bsClear
Title.Text.Strings = (
'TChart')
LeftAxis.Automatic = False
LeftAxis.AutomaticMaximum = False
LeftAxis.AutomaticMinimum = False
LeftAxis.ExactDateTime = False
LeftAxis.Increment = 2.000000000000000000
LeftAxis.Maximum = 35.000000000000000000
View3D = False
TabOrder = 3
object Series1: TLineSeries
Marks.ArrowLength = 8
Marks.Visible = False
SeriesColor = clBlack
Pointer.InflateMargins = True
Pointer.Style = psRectangle
Pointer.Visible = False
XValues.DateTime = False
XValues.Name = 'X'
XValues.Multiplier = 1.000000000000000000
XValues.Order = loAscending
YValues.DateTime = False
YValues.Name = 'Y'
YValues.Multiplier = 1.000000000000000000
YValues.Order = loNone
end
object Series2: TLineSeries
Marks.ArrowLength = 8
Marks.Visible = False
SeriesColor = clBlack
Pointer.InflateMargins = True
Pointer.Style = psRectangle
Pointer.Visible = False
XValues.DateTime = False
XValues.Name = 'X'
XValues.Multiplier = 1.000000000000000000
XValues.Order = loAscending
YValues.DateTime = False
YValues.Name = 'Y'
YValues.Multiplier = 1.000000000000000000
YValues.Order = loNone
end
object Series3: TLineSeries
Marks.ArrowLength = 8
Marks.Visible = False
SeriesColor = clRed
Pointer.InflateMargins = True
Pointer.Style = psRectangle
Pointer.Visible = False
XValues.DateTime = False
XValues.Name = 'X'
XValues.Multiplier = 1.000000000000000000
XValues.Order = loAscending
YValues.DateTime = False
YValues.Name = 'Y'
YValues.Multiplier = 1.000000000000000000
YValues.Order = loNone
end
end
object XMLDoc: TXMLDocument
Left = 24
Top = 80
DOMVendorDesc = 'MSXML'
end
end
mmmmmm.jpg
You have all the code AND dfm of my solution. I guess you have a problem with the strings formats for float/date, I made modifications to make it work in my system, but it's possible you don't need those.
It's in :
procedure AddToSerie(StrVal,StrDat:S tring);
try without the StringReplace code lines, and debug to see if that is working properly
It's in :
procedure AddToSerie(StrVal,StrDat:S
try without the StringReplace code lines, and debug to see if that is working properly
all you have to do then is to set X values for each serie data (so use AddXY() instead of Add(Y) method, where X is your date number.