teecalendar.pas

Delphi TeeChartPro.6.01的源代码

{********************************************}
{    TeeChart Pro Charting Library           }
{    Calendar Series                         }
{  Copyright (c) 1995-2003 by David Berneda  }
{         All Rights Reserved                }
{********************************************}
unit TeeCalendar;
{$I TeeDefs.inc}

interface

Uses {$IFNDEF LINUX}
     Windows, Messages, 
     {$ENDIF}
     {$IFDEF CLX}
     QButtons, QMenus, Types,
     {$ELSE}
     Buttons, Menus,
     {$ENDIF}
     Classes, SysUtils, TeeProcs, TeEngine, TeCanvas;

type
  TCalendarSeries=class;

  TCalendarCell=class(TTeeShape)
  public
    Parent : TCalendarSeries;
  published
    property Brush;
    property Font;
    property Gradient;
    property Pen;
    property Shadow;
    property Transparency;
    property Transparent noDefault;
    property Visible;
  end;

  TCalendarCellUpper=class(TCalendarCell)
  private
    FUpper : Boolean;
    FFormat: String;
    procedure SetUpperCase(const Value: Boolean);
    procedure SetFormat(const Value: String);
  published
    property Format:String read FFormat write SetFormat;
    property UpperCase:Boolean read FUpper write SetUpperCase default False;
  end;

  TCalendarChangeEvent=Procedure(Sender:TCalendarSeries; Var Value:TDateTime) of object;

  TCalendarSeries=class(TChartSeries,ITeeEventListener)
  private
    FDate          : TDateTime;
    FDays          : TCalendarCell;
    FMonths        : TCalendarCellUpper;
    FNextMonth     : TSpeedButton;
    FOnChange      : TCalendarChangeEvent;
    FPopupMenu     : TPopupMenu;
    FPreviousMonth : TSpeedButton;
    FSunday        : TCalendarCell;
    FToday         : TCalendarCell;
    FTrailing      : TCalendarCell;
    FWeekDays      : TCalendarCellUpper;

    IColumns  : Integer;
    IFirstDay : Integer;
    IRows     : Integer;

    procedure ChangeMonthMenu(Sender: TObject);
    Function GetPopupMenu:TPopupMenu;
    procedure MonthClick(Sender: TObject);
    procedure SetDate(Value: TDateTime);
    procedure SetMonths(const Value: TCalendarCellUpper);
    procedure SetToday(const Value: TCalendarCell);
    procedure SetDays(const Value: TCalendarCell);
    procedure SetSunday(const Value: TCalendarCell);
    procedure SetTrailing(const Value: TCalendarCell);
    procedure SetWeekDays(const Value: TCalendarCellUpper);
    function GetNextVisible: Boolean;
    function GetPreviousVisible: Boolean;
    procedure SetNextVisible(const Value: Boolean);
    procedure SetPreviousVisible(const Value: Boolean);
  protected
    procedure DrawCell(Column,Row:Integer; Const Text:String);
    class function GetEditorClass: String; override;
    Procedure PrepareForGallery(IsEnabled:Boolean); override;
    Procedure SetParentChart(Const Value:TCustomAxisPanel); override;
    procedure TeeEvent(Event:TTeeEvent); // ITeeEventListener interface
    Function XCell(Const Column:Double):Integer;
    Function YCell(Const Row:Double):Integer;
  public
    DayOneRow    : Integer;
    DayOneColumn : Integer;

    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    Procedure CheckClick(x,y:Integer);
    Function Clicked(x,y:Integer):Integer; override;
    Procedure DrawAllValues; override;
    Function Month:Word;
    Procedure NextMonth;
    Function NumSampleValues:Integer; override;
    Procedure PreviousMonth;
    Function RectCell(Column,Row:Integer):TRect;
    Function Rows:Integer;
    Function SeriesRect:TRect;
    Function UseAxis:Boolean; override;

    property Columns:Integer read IColumns;
    property NextMonthButton:TSpeedButton read FNextMonth; { 5.02 }
    property PopupMenu:TPopupMenu read GetPopupMenu;
    property PreviousMonthButton:TSpeedButton read FPreviousMonth;

  published
    property Active;
    property Cursor;
    property HorizAxis;
    property ParentChart;
    property Pen;
    property ShowInLegend;
    property Title;
    property VertAxis;

    property Date:TDateTime read FDate write SetDate;
    property Days:TCalendarCell read FDays write SetDays;
    property Months:TCalendarCellUpper read FMonths write SetMonths;
    property NextButtonVisible:Boolean read GetNextVisible write SetNextVisible default True;
    property PreviousButtonVisible:Boolean read GetPreviousVisible write SetPreviousVisible default True;
    property Sunday:TCalendarCell read FSunday write SetSunday;
    property Today:TCalendarCell read FToday write SetToday;
    property Trailing:TCalendarCell read FTrailing write SetTrailing;
    property WeekDays:TCalendarCellUpper read FWeekDays write SetWeekDays;

    { events }
    property AfterDrawValues;
    property BeforeDrawValues;
    property OnChange:TCalendarChangeEvent read FOnChange write FOnChange;
    property OnClick;
    property OnDblClick;
  end;

implementation

Uses TeeProCo, Chart,
     {$IFDEF CLX}
     QGraphics, QControls
     {$ELSE}
     Graphics, Controls
     {$ENDIF}
     ;

{ TCalendarCellUpper }
procedure TCalendarCellUpper.SetFormat(const Value: String);
begin
  Parent.SetStringProperty(FFormat,Value);
end;

procedure TCalendarCellUpper.SetUpperCase(const Value: Boolean);
begin
  Parent.SetBooleanProperty(FUpper,Value);
end;

{ TCalendarSeries }
constructor TCalendarSeries.Create(AOwner: TComponent);
begin
  inherited;
  CalcVisiblePoints:=False;
  ShowInLegend:=False;
  AddNull;
  FDate:=SysUtils.Date;
  IColumns:=7;
  IRows:=8;

  {$IFDEF D6}
  {$WARN SYMBOL_PLATFORM OFF}
  {$ENDIF}

  {$IFDEF LINUX}
  IFirstDay:=0;
  {$ELSE}
  IFirstDay:=StrToIntDef(GetLocaleStr(GetThreadLocale, LOCALE_IFIRSTDAYOFWEEK, '0'), 0);
  {$ENDIF}

  FWeekDays:=TCalendarCellUpper.Create(nil);
  FWeekDays.Parent:=Self;
  FWeekDays.Pen.Visible:=False;
  FWeekDays.Format:='ddd';

  FMonths:=TCalendarCellUpper.Create(nil);
  FMonths.Parent:=Self;
  FMonths.Transparent:=True;
  FMonths.Format:='mmmm, yyyy';

  FDays:=TCalendarCell.Create(nil);
  FDays.Parent:=Self;
  FDays.Transparent:=True;
  FToday:=TCalendarCell.Create(nil);
  FToday.Parent:=Self;
  FToday.Shadow.Size:=0;
  FToday.Font.Color:=clWhite;
  FToday.Color:=clBlue;
  FSunday:=TCalendarCell.Create(nil);
  FSunday.Parent:=Self;
  FSunday.Shadow.Size:=0;
  FSunday.Color:=clRed;
  FSunday.Font.Color:=clWhite;
  FTrailing:=TCalendarCell.Create(nil);
  FTrailing.Parent:=Self;
  FTrailing.Transparent:=True;
  FTrailing.Font.Color:=clDkGray;

  IUseSeriesColor:=False;
end;

Destructor TCalendarSeries.Destroy;
begin
  FWeekDays.Free;
  FMonths.Free;
  FDays.Free;
  FToday.Free;
  FSunday.Free;
  FTrailing.Free;
  FNextMonth.Free;
  FPreviousMonth.Free;
  FPopupMenu.Free;
  inherited;
end;

Function TCalendarSeries.XCell(Const Column:Double):Integer;
begin
  result:=GetHorizAxis.IStartPos+Round(Column*GetHorizAxis.IAxisSize/IColumns);
end;

Function TCalendarSeries.YCell(Const Row:Double):Integer;
begin
  result:=GetVertAxis.IStartPos+Round(Row*GetVertAxis.IAxisSize/Rows);
end;

Function TCalendarSeries.UseAxis:Boolean;
begin
  result:=False;
end;

Function TCalendarSeries.NumSampleValues:Integer;
begin
  result:=1;
end;

procedure TCalendarSeries.DrawAllValues;

  Procedure DrawGrid;
  var r,c,
      MinRowLines : Integer;
  begin
    if Pen.Visible then
    With ParentChart.Canvas do
    begin
      if WeekDays.Visible then MinRowLines:=1 else MinRowLines:=0;
      if Months.Visible then Inc(MinRowLines);
      AssignVisiblePen(Self.Pen);
      for c:=0 to IColumns do
          VertLine3D(XCell(c),YCell(MinRowLines),GetVertAxis.IEndPos,StartZ);
      for r:=MinRowLines to Rows do
          HorizLine3D(GetHorizAxis.IStartPos,GetHorizAxis.IEndPos,YCell(r),StartZ);
    end;
  end;

  Procedure DrawBack(ACell:TCalendarCell; Rect:TRect);
  begin
    Inc(Rect.Bottom);
    Dec(Rect.Bottom,ACell.Shadow.VertSize);
    Dec(Rect.Right,ACell.Shadow.HorizSize-1);
    ACell.DrawRectRotated(Rect,0,StartZ);
    ACell.ShapeBounds:=Rect; { 5.02 }
  end;

  Procedure DrawDay(ACell:TCalendarCell; c,r,d:Integer);
  begin
    if ACell.Visible then
    begin
      DrawBack(ACell,RectCell(c,r));
      ParentChart.Canvas.AssignFont(ACell.Font);
      With ParentChart.Canvas do
      begin
        TextAlign:=ta_Center;
        BackMode:=cbmTransparent;
      end;
      DrawCell(c,r,TeeStr(d));
    end;
  end;

var r,
    c,
    t,
    tmpPrevDays,
    tmpDays  : Integer;
    tmpToday,
    y,y2,
    m,m2,
    d        : Word;
    tmpSt    : String;

  Procedure NextDay;
  begin
    Inc(d);
    Inc(c);
    if c>IColumns then
    begin
      c:=1;
      Inc(r);
    end;
  end;

var Rect : TRect;
begin
  inherited;

  DecodeDate(Date,y,m,tmpToday);

  if WeekDays.Visible then
  begin
    With ParentChart.Canvas do
    begin
      AssignFont(WeekDays.Font);
      TextAlign:=ta_Center;
    end;
    r:=1;
    if Months.Visible then Inc(r);
    for c:=1 to IColumns do
    begin
      DrawBack(WeekDays,RectCell(c,r));
      ParentChart.Canvas.BackMode:=cbmTransparent;
      tmpSt:=FormatDateTime(WeekDays.Format,EncodeDate(1899,1,1+c+IFirstDay));
      if WeekDays.UpperCase then tmpSt:=UpperCase(tmpSt);
      DrawCell(c,r,tmpSt);
    end;
  end;

  if Months.Visible then
  begin
    With ParentChart.Canvas do
    begin
      AssignFont(Months.Font);
      TextAlign:=ta_Center;
    end;
    Rect:=SeriesRect;
    Rect.Bottom:=RectCell(4,1).Bottom;
    Rect.Top:=RectCell(4,0).Bottom;
    DrawBack(Months,Rect);
    ParentChart.Canvas.BackMode:=cbmTransparent;
    tmpSt:=FormatDateTime(Months.Format,Date);
    if Months.UpperCase then tmpSt:=UpperCase(tmpSt);
    DrawCell(4,1,tmpSt);
  end;

  DecodeDate(Date,y,m,tmpToday);

  d:=1;