home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / TEECHART / Delphi1_And_Delphi2 / EXAMPLES / OTHER / MONTHLY / TEEMONTH.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1998-10-24  |  4.8 KB  |  172 lines
  1. {****************************************}
  2. {       TeeChart Charting Library        }
  3. { Copyright (c) 1996-97 by David Berneda }
  4. {          All Rights Reserved           }
  5. {****************************************}
  6. unit TeeMonth;
  7.  
  8. interface
  9.  
  10. Uses Teengine,DB,
  11.      {$IFNDEF VER100}
  12.      DBTables,
  13.      {$ENDIF}
  14.      TeeProcs;
  15.  
  16. { This unit fills a Series with points.
  17.  
  18.   The points are obtained calculating a COUNT 
  19.   or SUM of a Field in a Database Table or Query.
  20.  
  21.   The COUNT or SUM is performed BY MONTH or BY WEEK
  22.   over a DateTime field in the database.
  23.  
  24.   The parameters are as follows:
  25.  
  26.   ASeries          The Series to add the points.
  27.   ATable           The Database to scan.
  28.   DateFieldName    The name of the DateTime field in the table.
  29.   ValueFieldName   The name of the field in the table to SUM. (if Count = False)
  30.   DatePeriod       It can be:  dtOneMonth or dtOneWeek
  31.   Count            Is TRUE if we want to COUNT records. FALSE if we want to SUM.
  32.  
  33. }
  34. procedure DBMonthlySeries( ASeries:TChartSeries;
  35.                            ATable:TDataSet;
  36.                            Const DateFieldName,
  37.                                  ValueFieldName:String;
  38.                            DatePeriod:TDateTimeStep;
  39.                            Count:Boolean);
  40.  
  41. { Returns the number of the week, from 1 to 52.
  42.   It also returns the Year, which can be the same year, the
  43.   year before or the year after, depending on which day of the week
  44.   the year starts.
  45.   The "FirstDay" constant sets weeks to start at Monday.
  46. }
  47. Function DateToWeek(Const ADate:TDateTime; Var Year:Word):Integer;
  48.  
  49. implementation
  50.  
  51. Uses SysUtils;
  52.  
  53. { returns the DateTime of the January 1st of the Year }
  54. function YearBegin(Const ADate:TDateTime):TDateTime;
  55. var Year,Month,Day:Word;
  56. begin
  57.   DecodeDate(ADate,Year,Month,Day);
  58.   result:=EncodeDate(Year,1,1);
  59. end;
  60.  
  61. { returns the Day number inside the Year }
  62. function YearDay(Const ADate:TDateTime):Longint;
  63. begin
  64.   result:=1+Trunc(ADate-YearBegin(ADate));
  65. end;
  66.  
  67. { returns the DateTime of December 31st of the Year }
  68. function YearEnd(Const ADate:TDateTime):TDateTime;
  69. var Year,Month,Day:Word;
  70. begin
  71.   DecodeDate(ADate,Year,Month,Day);
  72.   result:=EncodeDate(Year,12,31);
  73. end;
  74.  
  75. { Returns the number of the week, from 1 to 52.
  76.   It also returns the Year, which can be the same year, the
  77.   year before or the year after, depending on which day of the week
  78.   the year starts.
  79.   The "FirstDay" constant sets weeks to start at Monday.
  80. }
  81. Function DateToWeek(Const ADate:TDateTime; Var Year:Word):Integer;
  82. Const FirstDay=0; { Monday }
  83. Var d,m,y,j,j0,j1,week:Word;
  84. begin
  85.   DecodeDate(ADate,y,m,d);
  86.   If (m < 3) then
  87.     j := 1461*(y-1) DIV 4 + (153*(m+9)+2) DIV 5 + d
  88.   Else
  89.     j := 1461*y DIV 4 + (153*(m-3)+2) DIV 5 + d;
  90.  
  91.   j0:=1461*(y-1) DIV 4 + 310;
  92.   j0:=j0-(j0-firstday) MOD 7;
  93.  
  94.   If (j<j0) then
  95.   begin
  96.     j0 := 1461*(y-2) DIV 4 + 310;
  97.     j0 := j0 - (j0-firstday) MOD 7;
  98.     week := 1 + (j-j0) DIV 7;
  99.     year := y-1;
  100.   end
  101.   else
  102.   begin
  103.     j1 := 1461*y DIV 4 + 310;
  104.     j1 := j1 - (j1-firstday) MOD 7;
  105.     If j<j1 then
  106.     begin
  107.       week := 1 + (j-j0) DIV 7;
  108.       year := y;
  109.     end
  110.     Else
  111.     begin
  112.       week := 1;
  113.       year := y+1;
  114.     End;
  115.   End;
  116.   result:=week;
  117. End;
  118.  
  119. { clears all points in ASeries and adds new points }
  120. procedure DBMonthlySeries( ASeries:TChartSeries;
  121.                            ATable:TDataSet;
  122.                            Const DateFieldName,
  123.                                  ValueFieldName:String;
  124.                            DatePeriod:TDateTimeStep;
  125.                            Count:Boolean);
  126. Var tmpXPos:TDateTime;
  127.     tmpWeek,
  128.     tmp:Integer;
  129.     Year,Month,Day:Word;
  130.     tmpQuantity:Double;
  131.     tmpLabel:String;
  132.     DateField:TDateTimeField;
  133. begin
  134.   With ATable do
  135.   begin
  136.     DateField:=FieldByName(DateFieldName) as TDateTimeField;
  137.     ASeries.Clear;
  138.     DisableControls;
  139.     First;
  140.     While not eof do
  141.     begin
  142.       tmpXPos:=0;
  143.       tmpWeek:=0;
  144.       DecodeDate(DateField.Value,Year,Month,Day);
  145.       Case DatePeriod of
  146.         dtOneMonth: tmpXPos:=EncodeDate(Year,Month,1);
  147.         dtOneWeek : begin
  148.                       tmpWeek:=DateToWeek(DateField.Value,Year);
  149.                       tmpXPos:=tmpWeek+Year*52;
  150.                     end;
  151.       end;
  152.       if Count then tmpQuantity:=1
  153.                else tmpQuantity:=FieldByName(ValueFieldName).AsFloat;
  154.       tmp:=ASeries.XValues.Locate(tmpXPos);
  155.       if tmp=-1 then
  156.       begin
  157.         Case DatePeriod of
  158.           dtOneMonth: tmpLabel:=FormatDateTime('MMM/yy',tmpXPos);
  159.           dtOneWeek: tmpLabel:=IntToStr(tmpWeek)+'/'+IntToStr(Year);
  160.         end;
  161.         ASeries.AddXY(tmpXPos,tmpQuantity,tmpLabel,clTeeColor);
  162.       end
  163.       else
  164.       With ASeries do YValues[tmp]:=YValues[tmp]+tmpQuantity;
  165.       Next;
  166.     end;
  167.     EnableControls;
  168.   end;
  169. end;
  170.  
  171. end.
  172.