home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 25: Programming / pc_actual_25.iso / Delphi / TeeChartPro / TeeChart5Delphi5Eval.exe / %MAINDIR% / Examples / Features / TeeCompressOHLC.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-09-10  |  3.8 KB  |  128 lines
  1. {*************************************}
  2. { TeeChart OHLC Compression Function  }
  3. { Copyright (c) 2000 by David Berneda }
  4. {    All Rights Reserved              }
  5. {*************************************}
  6. {$I teedefs.inc}
  7. unit TeeCompressOHLC;
  8.  
  9. interface
  10.  
  11. Uses Classes, TeEngine, OHLChart;
  12.  
  13. type
  14.   TOHLCCompression=(ocDay,ocWeek,ocMonth,ocBiMonth,ocQuarter,ocYear);
  15.  
  16.   TOHLCCompressGetDate=procedure(Sender:TTeeFunction; Source:TOHLCSeries;
  17.                                  ValueIndex:Integer; Var Date:TDateTime) of object;
  18.  
  19.   TCompressOHLCFunction=class(TTeeFunction)
  20.   private
  21.     FCompress: TOHLCCompression;
  22.     FOnGetDate: TOHLCCompressGetDate;
  23.     procedure SetCompress(const Value: TOHLCCompression);
  24.   public
  25.     Constructor Create(AOwner: TComponent); override;
  26.     procedure AddPoints(Source: TChartSeries); override;
  27.     Procedure CompressSeries(OHLC,DestOHLC:TOHLCSeries;
  28.                              Volume,DestVolume:TChartSeries);
  29.   published
  30.     property Compress:TOHLCCompression read FCompress write SetCompress default ocWeek;
  31.     property OnGetDate:TOHLCCompressGetDate read FOnGetDate write FOnGetDate;
  32.   end;
  33.  
  34. implementation
  35.  
  36. Uses SysUtils;
  37.  
  38. { TCompressOHLCFunction }
  39. constructor TCompressOHLCFunction.Create(AOwner: TComponent);
  40. begin
  41.   inherited;
  42.   CanUsePeriod:=False;
  43.   FCompress:=ocWeek;
  44. end;
  45.  
  46. procedure TCompressOHLCFunction.AddPoints(Source: TChartSeries);
  47. begin
  48.   CompressSeries(Source as TOHLCSeries,ParentSeries as TOHLCSeries,nil,nil);
  49. end;
  50.  
  51. Procedure TCompressOHLCFunction.CompressSeries(OHLC,DestOHLC:TOHLCSeries;
  52.                                                Volume,DestVolume:TChartSeries);
  53. var t        : Integer;
  54.     tmpDay   : Integer;
  55.     OldDay   : Integer;
  56.     tmp      : Integer;
  57.     Year     : Word;
  58.     Month    : Word;
  59.     Day      : Word;
  60.     DoIt     : Boolean;
  61.     tmpDate  : TDateTime;
  62. begin
  63.   DestOHLC.Clear;
  64.   if Assigned(DestVolume) then DestVolume.Clear;
  65.   OldDay:=0;
  66.   for t:=0 to OHLC.Count-1 do
  67.   begin
  68.     tmpDate:=OHLC.DateValues[t];
  69.     if Assigned(FOnGetDate) then FOnGetDate(Self,OHLC,t,tmpDate);
  70.     DecodeDate(tmpDate,Year,Month,Day);
  71.  
  72.     Case Compress of
  73.        ocDay: tmpDay:=Trunc(tmpDate);
  74.       ocWeek: begin
  75.                 tmpDay:=DayOfWeek(tmpDate)-1;
  76.                 if tmpDay=0 then tmpDay:=7;
  77.               end;
  78.      ocMonth: tmpDay:=Month;
  79.    ocBiMonth: tmpDay:=(Month-1) div 2;
  80.    ocQuarter: tmpDay:=(Month-1) div 3;
  81.     else      tmpDay:=Year;
  82.     end;
  83.  
  84.     if Compress=ocWeek then DoIt:=tmpDay<OldDay else DoIt:=tmpDay<>OldDay;
  85.  
  86.     if (t=0) or DoIt then
  87.     begin
  88.       With OHLC do
  89.       begin
  90.         tmp:=DestOHLC.AddOHLC(DateValues[t],
  91.                          OpenValues[t],HighValues[t],LowValues[t],CloseValues[t]);
  92.         DestOHLC.XLabel[tmp]:=OHLC.XLabel[t];
  93.         if Assigned(DestVolume) then
  94.            DestVolume.AddXY(DateValues[t],Volume.YValues[t]);
  95.       end;
  96.     end
  97.     else
  98.     begin
  99.       tmp:=DestOHLC.Count-1;
  100.       DestOHLC.CloseValues.Value[tmp]:=OHLC.CloseValues.Value[t];
  101.       DestOHLC.DateValues.Value[tmp] :=OHLC.DateValues.Value[t];
  102.       if OHLC.HighValues[t]>DestOHLC.HighValues[tmp] then
  103.          DestOHLC.HighValues[tmp]:=OHLC.HighValues[t];
  104.       if OHLC.LowValues[t]<DestOHLC.LowValues[tmp] then
  105.          DestOHLC.LowValues[tmp]:=OHLC.LowValues[t];
  106.       DestOHLC.XLabel[tmp]:=OHLC.XLabel[t];
  107.       if Assigned(DestVolume) then
  108.       begin
  109.         With DestVolume.YValues do
  110.            Value[tmp]:=Value[tmp]+Volume.YValues.Value[t];
  111.         DestVolume.XValues.Value[tmp] :=Volume.XValues.Value[t];
  112.       end;
  113.     end;
  114.     OldDay:=tmpDay;
  115.   end;
  116. end;
  117.  
  118. procedure TCompressOHLCFunction.SetCompress(const Value: TOHLCCompression);
  119. begin
  120.   if FCompress<>Value then
  121.   begin
  122.     FCompress:=Value;
  123.     ReCalculate;
  124.   end;
  125. end;
  126.  
  127. end.
  128.