teecalendar.pas

Delphi TeeChartPro.6.01的源代码

  c:=DayOfWeek(EncodeDate(y,m,d))-1;
  if c=0 then c:=7;
  c:=1+((c+(7-IFirstDay)-1) mod IColumns);
  r:=3;
  if not WeekDays.Visible then Dec(r);
  if not Months.Visible then Dec(r);

  DayOneRow:=r;
  DayOneColumn:=c;

  tmpDays:=DaysInMonth(y,m);

  if Trailing.Visible and (c>1) then
  begin
    m2:=m-1;
    y2:=y;
    if m2=0 then
    begin
      m2:=12;
      Dec(y2);
    end;
    tmpPrevDays:=DaysInMonth(y2,m2);
    for t:=1 to c-1 do DrawDay(Trailing,t,r,tmpPrevDays-(c-t)+1);
  end;

  Repeat
    if (d=tmpToday) and Today.Visible then DrawDay(Today,c,r,d)
    else
    if DayOfWeek(EncodeDate(y,m,d))=1 then DrawDay(Sunday,c,r,d)
    else
      DrawDay(Days,c,r,d);

    NextDay;
  Until d>tmpDays;

  if Trailing.Visible and ((c<=IColumns) or (r<Rows)) then
  begin
    Inc(m);
    d:=1;
    While (c<=IColumns) and (r<=Rows) do
    begin
      DrawDay(Trailing,c,r,d);
      NextDay;
    end;
  end;

  if Pen.Visible then DrawGrid;
end;

type TCustomTeePanelAccess=class(TCustomTeePanel);

Procedure TCalendarSeries.SetParentChart(Const Value:TCustomAxisPanel);

  Function CreateButton(Const ACaption:String; ALeftPos:Integer):TSpeedButton;
  begin
    result:=TSpeedButton.Create(Self);
    with result do
    begin
      Caption:=ACaption;
      Flat:=True;
      Parent:=ParentChart;
      Top:=6;
      Left:=ALeftPos;
      OnClick:=MonthClick;
    end;
  end;

begin
  if Assigned(ParentChart) then
        TCustomTeePanelAccess(ParentChart).RemoveListener(Self);

  inherited;

  if not (csDestroying in ComponentState) then
  begin
    FMonths.ParentChart:=ParentChart;
    FDays.ParentChart:=ParentChart;
    FSunday.ParentChart:=ParentChart;
    FToday.ParentChart:=ParentChart;
    FTrailing.ParentChart:=ParentChart;
    FWeekDays.ParentChart:=ParentChart;

    FreeAndNil(FNextMonth);
    FreeAndNil(FPreviousMonth);

    if Assigned(ParentChart) then
    begin
      TCustomTeePanelAccess(ParentChart).Listeners.Add(Self);

      FNextMonth:=CreateButton('>',30);
      FPreviousMonth:=CreateButton('<',6);
    end;
  end;
end;

procedure TCalendarSeries.DrawCell(Column,Row:Integer; Const Text:String);
begin
  With ParentChart.Canvas do
       TextOut(XCell(Column-0.5),YCell(Row-0.5)-(TextHeight('W') div 2),Text);
end;

procedure TCalendarSeries.SetDate(Value: TDateTime);
begin
  if Assigned(FOnChange) and (Value<>Date) then FOnChange(Self,Value);

  if Value<>FDate then
  begin
    FDate:=Value;
    Repaint;
  end;
end;

procedure TCalendarSeries.SetDays(const Value: TCalendarCell);
begin
  FDays.Assign(Value);
end;

procedure TCalendarSeries.SetMonths(const Value: TCalendarCellUpper);
begin
  FMonths.Assign(Value);
end;

procedure TCalendarSeries.SetWeekDays(const Value: TCalendarCellUpper);
begin
  FWeekDays.Assign(Value);
end;

Function TCalendarSeries.RectCell(Column,Row:Integer):TRect;
begin
  with result do
  begin
    Left:=XCell(Column-1)+1;
    Right:=XCell(Column)-1;
    Top:=YCell(Row-1)+1;
    Bottom:=YCell(Row)-1;
  end;
end;

procedure TCalendarSeries.SetSunday(const Value: TCalendarCell);
begin
  FSunday.Assign(Value);
end;

procedure TCalendarSeries.SetToday(const Value: TCalendarCell);
begin
  FToday.Assign(Value);
end;

procedure TCalendarSeries.SetTrailing(const Value: TCalendarCell);
begin
  FTrailing.Assign(Value);
end;

procedure TCalendarSeries.NextMonth;
begin
  Date:=IncMonth(Date,1);
end;

procedure TCalendarSeries.PreviousMonth;
begin
  Date:=IncMonth(Date,-1);
end;

Function TCalendarSeries.Month:Word;
var y,d:Word;
begin
  DecodeDate(Date,y,result,d);
end;

procedure TCalendarSeries.PrepareForGallery(IsEnabled: Boolean);
begin
  inherited;
  Pen.Visible:=False;
  Days.Font.Size:=6;
  Months.Visible:=False;
  WeekDays.Font.Size:=5;
  WeekDays.Shadow.Size:=0;
  Sunday.Font.Size:=6;
  Today.Font.Size:=6;
  Trailing.Visible:=False;
  NextMonthButton.Visible:=False;
  PreviousMonthButton.Visible:=False;
end;

class function TCalendarSeries.GetEditorClass: String;
begin
  result:='TCalendarSeriesEditor';
end;

function TCalendarSeries.Rows: Integer;
begin
  result:=IRows;
  if not WeekDays.Visible then Dec(result);
  if not Months.Visible then Dec(result);
end;

function TCalendarSeries.Clicked(x,y: Integer): Integer;
begin
  if Active and { 5.01 }
     PointInRect(SeriesRect,x,y) then result:=0 else result:=-1;
end;

Function TCalendarSeries.SeriesRect:TRect;
var tmpRowSize : Integer;
begin
  With GetHorizAxis do
  begin
    Result.Left:=IStartPos;
    Result.Right:=IEndPos;
  end;
  With GetVertAxis do
  begin
    Result.Top:=IStartPos;
    Result.Bottom:=IEndPos;
  end;
  tmpRowSize:=Round(GetVertAxis.IAxisSize/IRows);
  if WeekDays.Visible then Inc(Result.Top,tmpRowSize);
  if Months.Visible then Inc(Result.Top,tmpRowSize);
end;

Procedure TCalendarSeries.CheckClick(x,y:Integer);

 Function CellDate(ACol,ARow:Integer):TDateTime;
 var y,
     m,
     d,
     tmpD : Word;
 begin
   result:=Date;
   DecodeDate(Date,y,m,d);
   if ARow=DayOneRow then
   begin
     if ACol>=DayOneColumn then
        result:=EncodeDate(y,m,ACol-DayOneColumn+1)
     else
     if Trailing.Visible then
     begin
       { previous month }
       Dec(m);
       if m=0 then
       begin
         m:=12;
         Dec(y);
       end;
       tmpD:=1+DaysInMonth(y,m)-DayOneColumn+ACol;
       result:=EncodeDate(y,m,tmpD);
     end;
   end
   else
   if ARow>DayOneRow then
   begin
     tmpD:=(7*(ARow-DayOneRow))+ACol-DayOneColumn+1;
     if tmpD>DaysInMonth(y,m) then
     begin
       { next month... }
       if Trailing.Visible then
       begin
         Dec(tmpD,DaysInMonth(y,m));
         Inc(m);
         if m>12 then
         begin
           m:=1;
           Inc(y);
         end;
       end
       else exit;
     end;
     result:=EncodeDate(y,m,tmpD);
   end;
 end;

var tmpC : Integer;
    tmpR : Integer;
begin
  if PointInRect(Months.ShapeBounds,X,Y) then
     with ParentChart.ClientToScreen(TeePoint(X,Y)) do
          PopupMenu.Popup(x,y) { 5.02 }
  else
  if Clicked(x,y)=0 then
  begin
    tmpC:=1+Trunc((x-GetHorizAxis.IStartPos)/(GetHorizAxis.IAxisSize/Columns));
    tmpR:=1+Trunc((y-GetVertAxis.IStartPos)/(GetVertAxis.IAxisSize/Rows));
    Date:=CellDate(tmpC,tmpR);
  end;
end;

procedure TCalendarSeries.TeeEvent(Event: TTeeEvent);
begin
  if (Event is TTeeMouseEvent) then
  With TTeeMouseEvent(Event) do
       if (Event=meDown) and (Button=mbLeft) then
          Self.CheckClick(x,y);
end;

procedure TCalendarSeries.MonthClick(Sender: TObject); { 5.02 }
begin
  if Sender=FNextMonth then NextMonth
                       else PreviousMonth;
end;

procedure TCalendarSeries.ChangeMonthMenu(Sender: TObject); { 5.02 }
var tmp     : Integer;
    tmpDays : Integer;
    y,
    m,
    d       : Word;
begin
  tmp:=TMenuItem(Sender).MenuIndex;
  DecodeDate(Date,y,m,d);
  m:=tmp+1;
  tmpDays:=DaysInMonth(y,m);
  if d>tmpDays then d:=tmpDays;
  Date:=EncodeDate(y,m,d);
end;

Function TCalendarSeries.GetPopupMenu:TPopupMenu;
var tmp : TMenuItem;
   t   : Integer;
begin
 if not Assigned(FPopupMenu) then
 begin { first time, do creation }
   result:=TPopupMenu.Create({$IFDEF TEEOCX}ParentChart{$ELSE}nil{$ENDIF});
   { add 12 months }
   for t:=1 to 12 do
   begin
     tmp:=TMenuItem.Create(nil);
     tmp.Caption:=LongMonthNames[t];
     tmp.OnClick:=ChangeMonthMenu;
     result.Items.Add(tmp);
   end;
 end
 else result:=FPopupMenu; { already existing popup }
end;

function TCalendarSeries.GetNextVisible: Boolean;
begin
  result:=NextMonthButton.Visible;
end;

function TCalendarSeries.GetPreviousVisible: Boolean;
begin
  result:=PreviousMonthButton.Visible;
end;

procedure TCalendarSeries.SetNextVisible(const Value: Boolean);
begin
  NextMonthButton.Visible:=Value;
end;

procedure TCalendarSeries.SetPreviousVisible(const Value: Boolean);
begin
  PreviousMonthButton.Visible:=Value;
end;

initialization
  RegisterTeeSeries( TCalendarSeries, @TeeMsg_CalendarSeries, @TeeMsg_GallerySamples, 1 );
finalization
  UnRegisterTeeSeries([TCalendarSeries]);
end.