lazarus-ccr/components/tvplanit/source/vpmonthview.pas

{*********************************************************}
{*                VPMONTHVIEW.PAS 1.03                   *}
{*********************************************************}

{* ***** BEGIN LICENSE BLOCK *****                                            *}
{* Version: MPL 1.1                                                           *}
{*                                                                            *}
{* The contents of this file are subject to the Mozilla Public License        *}
{* Version 1.1 (the "License"); you may not use this file except in           *}
{* compliance with the License. You may obtain a copy of the License at       *}
{* http://www.mozilla.org/MPL/                                                *}
{*                                                                            *}
{* Software distributed under the License is distributed on an "AS IS" basis, *}
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License   *}
{* for the specific language governing rights and limitations under the       *}
{* License.                                                                   *}
{*                                                                            *}
{* The Original Code is TurboPower Visual PlanIt                              *}
{*                                                                            *}
{* The Initial Developer of the Original Code is TurboPower Software          *}
{*                                                                            *}
{* Portions created by TurboPower Software Inc. are Copyright (C) 2002        *}
{* TurboPower Software Inc. All Rights Reserved.                              *}
{*                                                                            *}
{* Contributor(s):                                                            *}
{*                                                                            *}
{* ***** END LICENSE BLOCK *****                                              *}

{$I Vp.INC}

unit VpMonthView;

interface

uses
  {$IFDEF LCL}
  LMessages,LCLProc,LCLType,LCLIntf,FileUtil,
  {$ELSE}
  Windows,Messages,
  {$ENDIF}
  Classes, Graphics, Controls, ComCtrls, ExtCtrls, StdCtrls,
  VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst, VpCanvasUtils, Menus;

type
  TVpMonthdayRec = packed record
    Rec     : TRect;
    Date    : TDateTime;
    OffDay  : Boolean;
  end;

type
  TVpMonthdayArray = array of TVpMonthdayRec;

  { Forward Declarations }
  TVpMonthView = class;

  TVpMVDayNameStyle = (dsLong, dsShort, dsLetter);

  TVpOnEventClick =                                                      
    procedure(Sender: TObject; Event: TVpEvent) of object;               

  TVpDayHeadAttr = class(TPersistent)
  protected{private}
    FMonthView: TVpMonthView;
    FFont: TFont;
    FColor: TColor;
    procedure SetColor (Value: TColor);
    procedure SetFont (Value: TFont);
  public
    constructor Create(AOwner: TVpMonthView);
    destructor Destroy; override;
    property MonthView: TVpMonthView read FMonthView;
  published
    property Color: TColor read FColor write SetColor;
    property Font: TFont read FFont write SetFont;
  end;

  { TVpMonthView }

  TVpMonthView = class(TVpLinkableControl)
  protected{ private }
    FKBNavigate        : Boolean;
    FColumnWidth       : Integer;
    FColor             : TColor;
    FLineColor         : TColor;
    FLineCount         : Integer;
    FVisibleLines      : Integer;
    FDayNameStyle      : TVpMVDayNameStyle;
    FOffDayColor       : TColor;
    FOffDayFontColor   : TColor;
    FSelectedDayColor  : TColor;
    FWeekStartsOn      : TVpDayType;
    FShowEvents        : Boolean;
    FEventDayStyle     : TFontStyles;
    FDateLabelFormat   : string;
    FShowEventTime     : Boolean;
    FTopLine           : Integer;
    FDayHeadAttributes : TVpDayHeadAttr;
    FDayNumberFont     : TFont;
    FEventFont         : TFont;
    FTimeFormat        : TVpTimeFormat;
    FDrawingStyle      : TVpDrawingStyle;
    FDate              : TDateTime;
    FDefaultPopup      : TPopupMenu;
    FRightClickChangeDate : Boolean;                                     
    { event variables }
    FOwnerDrawCells    : TVpOwnerDrawDayEvent;
    FOnEventClick      : TVpOnEventClick;                                
    FOnEventDblClick   : TVpOnEventClick;                                
    { internal variables }
    mvDayNumberHeight  : Integer;
    mvEventTextHeight  : Integer;
    mvLoaded           : Boolean;
    mvInLinkHandler    : Boolean;
    mvRowHeight        : Integer;
    mvLineHeight       : Integer;
    mvColWidth         : Integer;
    mvDayHeadHeight    : Integer;
    mvSpinButtons      : TUpDown;
    mvEventArray       : TVpEventArray;
    mvMonthDayArray    : TVpMonthdayArray;
    mvActiveEvent      : TVpEvent;
    mvActiveEventRec   : TRect;
    mvEventList        : TList;
    mvCreatingEditor   : Boolean;
    mvPainting         : Boolean;
    mvVScrollDelta     : Integer;
    mvHotPoint         : TPoint;
    mvVisibleEvents    : Integer;                                        

    { property methods }
    procedure SetDrawingStyle(Value: TVpDrawingStyle);
    procedure SetColor(Value: TColor);
    procedure SetLineColor(Value: TColor);
    procedure SetOffDayColor(Value: TColor);
    procedure SetOffDayFontColor(Value: TColor);
    procedure SetDateLabelFormat(Value: string);
    procedure SetShowEvents(Value: Boolean);
    procedure SetEventDayStyle(Value: TFontStyles);
    procedure SetDayNameStyle(Value: TVpMVDayNameStyle);
    procedure SetDayNumberFont(Value: TFont);
    procedure SetEventFont(Value: TFont);
    procedure SetSelectedDayColor(Value: TColor);
    procedure SetShowEventTime(Value: Boolean);
    procedure SetTimeFormat(Value: TVpTimeFormat);
    procedure SetDate(Value: TDateTime);
    procedure SetRightClickChangeDate (const v : Boolean);               
    procedure SetWeekStartsOn(Value: TVpDayType);
    { internal methods }
    procedure mvHookUp;
    procedure mvFontChanged(Sender: TObject);

    procedure Paint; override;
    procedure Loaded; override;
    procedure InitializeDefaultPopup;
    procedure mvPopulate;
    procedure mvSpinButtonClick(Sender: TObject; Button: TUDBtnType);
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    {$IFNDEF LCL}
    procedure WMLButtonDown(var Msg : TWMLButtonDown);
      message WM_LBUTTONDOWN;
    procedure WMLButtonDblClick(var Msg: TWMLButtonDblClk);              
      message WM_LBUTTONDBLCLK;                                          
    {$ELSE}
    procedure WMLButtonDown(var Msg : TLMLButtonDown);
      message LM_LBUTTONDOWN;
    procedure WMLButtonDblClick(var Msg: TLMLButtonDblClk);
      message LM_LBUTTONDBLCLK;
    {$ENDIF}
    { - renamed from EditEventAtCoord and re-written}
    function  SelectEventAtCoord(Point: TPoint): Boolean;
    procedure mvSetDateByCoord(Point: TPoint);
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    { message handlers }
    {$IFNDEF LCL}
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
    procedure WMRButtonDown(var Msg : TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey);
      message CM_WANTSPECIALKEY;
    {$ELSE}
    procedure WMSize(var Msg: TLMSize); message LM_SIZE;
    procedure WMSetFocus(var Msg : TLMSetFocus); message LM_SETFOCUS;
    procedure WMRButtonDown(var Msg : TLMRButtonDown); message LM_RBUTTONDOWN;
    {$ENDIF}
    procedure PopupToday (Sender : TObject);
    procedure PopupNextMonth (Sender : TObject);
    procedure PopupPrevMonth (Sender : TObject);
    procedure PopupNextYear (Sender : TObject);
    procedure PopupPrevYear (Sender : TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadLanguage;
    procedure Invalidate; override;
    procedure LinkHandler(Sender: TComponent;
      NotificationType: TVpNotificationType;
      const Value: Variant); override;
    function GetControlType : TVpItemType; override;
    procedure PaintToCanvas (ACanvas : TCanvas;
                             ARect   : TRect;
                             Angle   : TVpRotationAngle;
                             ADate   : TDateTime);
    procedure RenderToCanvas (RenderCanvas : TCanvas;
                              RenderIn     : TRect;
                              Angle        : TVpRotationAngle;
                              Scale        : Extended;
                              RenderDate   : TDateTime;
                              StartLine    : Integer;
                              StopLine     : Integer;
                              UseGran      : TVpGranularity;
                              DisplayOnly  : Boolean); override;

    property Date: TDateTime read FDate write SetDate;
  published
    { inherited properties }
    property Align;
    property Anchors;
    property TabStop;
    property TabOrder;
    property KBNavigation: Boolean
      read FKBNavigate write FKBNavigate;
    property Color: TColor
      read FColor write SetColor;
    property DateLabelFormat:
      string read FDateLabelFormat write SetDateLabelFormat;
    property DayHeadAttributes: TVpDayHeadAttr
      read FDayHeadAttributes write FDayHeadAttributes;
    property DayNameStyle: TVpMVDayNameStyle
      read FDayNameStyle write SetDayNameStyle;
    property DayNumberFont: TFont
      read FDayNumberFont write SetDayNumberFont;
    property DrawingStyle: TVpDrawingStyle
      read FDrawingStyle write SetDrawingStyle stored True;
    property EventDayStyle: TFontStyles
      read FEventDayStyle write SetEventDayStyle;
    property EventFont: TFont
      read FEventFont write SetEventFont;
    property LineColor: TColor
      read FLineColor write SetLineColor;
    property TimeFormat: TVpTimeFormat
      read FTimeFormat write SetTimeFormat;
    property OffDayColor: TColor
      read FOffDayColor write SetOffDayColor;
    property OffDayFontColor: TColor
      read FOffDayFontColor write SetOffDayFontColor default clGray;
    property OwnerDrawCells: TVpOwnerDrawDayEvent
      read FOwnerDrawCells write FOwnerDrawCells;
    property RightClickChangeDate : Boolean                              
             read FRightClickChangeDate write SetRightClickChangeDate    
             default vpDefWVRClickChangeDate;                            
    property SelectedDayColor: TColor
      read FSelectedDayColor write SetSelectedDayColor;
    property ShowEvents: Boolean
      read FShowEvents write SetShowEvents;
    property ShowEventTime: Boolean
      read FShowEventTime write SetShowEventTime;
    property WeekStartsOn : TVpDayType
      read FWeekStartsOn write SetWeekStartsOn;
    {events}
    property OnEventClick: TVpOnEventClick                               
      read FOnEventClick write FOnEventClick;                            
    property OnEventDblClick: TVpOnEventClick                            
      read FOnEventDblClick write FOnEventDblClick;                      
  end;

implementation

uses
  SysUtils, Math, Forms, Dialogs, VpEvntEditDlg;

(*****************************************************************************)
{ TVpContactHeadAttr }
constructor TVpDayHeadAttr.Create(AOwner: TVpMonthView);
begin
  inherited Create;
  FMonthView := AOwner;
  FFont := TFont.Create;
  FFont.Assign(FMonthView.Font);
  FFont.Size := 8;
  FColor := clSilver;
end;
{=====}

destructor TVpDayHeadAttr.Destroy;
begin
  FFont.Free;
end;
{=====}

procedure TVpDayHeadAttr.SetColor(Value: TColor);
begin
  if Value <> FColor then begin
    FColor := Value;
    MonthView.Invalidate;
  end;
end;
{=====}

procedure TVpDayHeadAttr.SetFont(Value: TFont);
begin
  if Value <> FFont then begin
    FFont.Assign(Value);
    MonthView.Invalidate;
  end;
end;
{=====}

(*****************************************************************************)
{ TVpMonthView }

constructor TVpMonthView.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];

  { Create internal classes and stuff }
  FDayHeadAttributes := TVpDayHeadAttr.Create(self);
  mvEventList := TList.Create;
  mvSpinButtons := TUpDown.Create(self);

  { Set styles and initialize internal variables }
  {$IFDEF VERSION4}
  DoubleBuffered := true;
  {$ENDIF}
  FShowEvents := true;
  FEventDayStyle := [];
  FShowEventTime := false;
  FDayNameStyle :=dsShort;
  FKBNavigate := true;
  mvInLinkHandler := false;
  mvSpinButtons.OnClick := mvSpinButtonClick;
  mvSpinButtons.Orientation := udHorizontal;
  mvSpinButtons.Min := -32768;
  mvSpinButtons.Max := 32767;
  mvCreatingEditor := false;
  FSelectedDayColor := clRed;
  FDrawingStyle := ds3d;
  mvPainting := false;
  FColor := clWindow;
  FOffDayColor := clSilver;
  FLineColor := clGray;
  FDate := Trunc(Now);
  FTimeFormat := tf12Hour;
  FDateLabelFormat := 'mmmm yyyy';
  FColumnWidth := 200;
  FRightClickChangeDate := vpDefWVRClickChangeDate;                      
  mvVisibleEvents := 0;                                                  

  { set up fonts and colors }
  FDayHeadAttributes.Font.Name := 'Tahoma';
  FDayHeadAttributes.Font.Size := 10;
  FDayHeadAttributes.Font.Style := [];
  FDayHeadAttributes.Color := clBtnFace;

  { Assign default font to DayNumberFont and EventFont }
  FDayNumberFont := TFont.Create;
  FDayNumberFont.Assign(Font);
  FDayNumberFont.OnChange := mvFontChanged;
  FEventFont := TFont.Create;
  FEventFont.Assign(Font);
  FEventFont.OnChange := mvFontChanged;
  FOffDayFontColor := clGray;

  SetLength(mvEventArray, MaxVisibleEvents);
  SetLength(mvMonthdayArray, 45);

  { size }
  Height := 225;
  Width := 300;

  FDefaultPopup := TPopupMenu.Create (Self);
  Self.PopupMenu := FDefaultPopup;
  LoadLanguage;

  mvHookUp;
end;
{=====}

destructor TVpMonthView.Destroy;
begin
  FDayHeadAttributes.Free;
  FDayNumberFont.Free;
  FEventFont.Free;
  mvSpinButtons.Free;
  mvEventList.Free;
  FDefaultPopup.Free;
  inherited;
end;

procedure TVpMonthView.LoadLanguage;
begin
  FDefaultPopup.Items.Clear;
  InitializeDefaultPopup;
end;

{=====}

procedure TVpMonthView.Invalidate;
begin
  inherited;
end;
{=====}

procedure TVpMonthView.LinkHandler(Sender: TComponent;
  NotificationType: TVpNotificationType; const Value: Variant);
begin
  mvInLinkHandler := true;
  try
    case NotificationType of
      neDateChange: Date := Value;
      neDataStoreChange: Invalidate;
      neInvalidate: Invalidate;
    end;
  finally
    mvInLinkHandler := false;
  end;
end;
{=====}

procedure TVpMonthView.mvHookUp;
var
  I: Integer;
begin
  { If the component is being dropped on a form at designtime, then }
  { automatically hook up to the first datastore component found    }
  if csDesigning in ComponentState then
    for I := 0 to pred(Owner.ComponentCount) do begin
      if (Owner.Components[I] is TVpCustomDataStore) then begin
        DataStore := TVpCustomDataStore(Owner.Components[I]);
        Exit;
      end;
    end;
end;
{=====}

procedure TVpMonthView.mvFontChanged(Sender: TObject);
begin
  Invalidate;
end;
{=====}

procedure TVpMonthView.Loaded;
begin
  inherited;
  mvLoaded := true;
  mvPopulate;
end;
{=====}

function TVpMonthView.GetControlType : TVpItemType;
begin
  Result := itMonthView;
end;

procedure TVpMonthView.Paint;
begin
  RenderToCanvas (Canvas,
                  Rect (0, 0, Width, Height),
                  ra0,
                  1,
                  Self.Date,
                  -1,
                  -1,
                  gr30Min,
                  False);
end;
{=====}
procedure TVpMonthView.PaintToCanvas (ACanvas : TCanvas;
                                       ARect   : TRect;
                                       Angle   : TVpRotationAngle;
                                       ADate   : TDateTime);
begin
  RenderToCanvas (ACanvas, ARect, Angle, 1, ADate,
                  -1, -1, gr30Min, True);
end;
{=====}
procedure TVpMonthView.RenderToCanvas (RenderCanvas : TCanvas;
                                       RenderIn     : TRect;
                                       Angle        : TVpRotationAngle;
                                       Scale        : Extended;
                                       RenderDate   : TDateTime;
                                       StartLine    : Integer;
                                       StopLine     : Integer;
                                       UseGran      : TVpGranularity;
                                       DisplayOnly  : Boolean);
var
  HeadRect       : TRect;
  SaveBrushColor : TColor;
  SavePenStyle   : TPenStyle;
  SavePenColor   : TColor;
  DisplayDate    : TDateTime;

  RealWidth      : Integer;
  RealHeight     : Integer;
  RealLeft       : Integer;
  RealRight      : Integer;
  RealTop        : Integer;
  RealBottom     : Integer;
  Rgn            : HRGN;

  RealColor        : TColor;
  BevelHighlight   : TColor;
  BevelShadow      : TColor;
  BevelDarkShadow  : TColor;
  BevelFace        : TColor;
  DayHeadAttrColor : TColor;
  RealLineColor    : TColor;
  RealOffDayColor  : TColor;
  RealSelDayColor  : TColor;
  EventFontColor   : TColor;
  DotDotDotColor   : TColor;

  procedure Clear;
  begin
    RenderCanvas.Brush.Color := RealColor;
    RenderCanvas.FillRect(RenderIn);
  end;
  {-}

  procedure SetMeasurements;
  begin
    RealWidth  := TPSViewportWidth (Angle, RenderIn);
    RealHeight := TPSViewportHeight (Angle, RenderIn);
    RealLeft   := TPSViewportLeft (Angle, RenderIn);
    RealRight  := TPSViewportRight (Angle, RenderIn);
    RealTop    := TPSViewportTop (Angle, RenderIn);
    RealBottom := TPSViewportBottom (Angle, RenderIn);

    if RenderDate = 0 then
      DisplayDate := Date
    else
      DisplayDate := RenderDate;

    { we use the VpProductName because is is a good representation of some }
    { generic text }
    RenderCanvas.Font.Assign(FDayHeadAttributes.Font);
    mvDayHeadHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + 2;
    RenderCanvas.Font.Assign(FDayNumberFont);
    mvDayNumberHeight := RenderCanvas.TextHeight('00');
    RenderCanvas.Font.Assign(FEventFont);
    mvEventTextHeight := RenderCanvas.TextHeight(VpProductName);
    RenderCanvas.Font.Assign(Font);
    mvLineHeight := RenderCanvas.TextHeight(VpProductName) + 2;
    mvColWidth   := (RealWidth - 4) div 7;
  end;
  {-}

  procedure DrawHeader;
  var
    HeadTextRect: TRect;
    HeadStr: string;
    HeadStrLen : Integer;
  begin
    RenderCanvas.Brush.Color := DayHeadAttrColor;
    { draw the header cell and borders }

    if FDrawingStyle = dsFlat then begin
      { draw an outer and inner bevel }
      HeadRect.Left := RealLeft + 1;
      HeadRect.Top := RealTop + 1;
      HeadRect.Right := RealRight - 1;
      HeadRect.Bottom := RealTop + mvDayHeadHeight;
      TPSFillRect (RenderCanvas, Angle, RenderIn, HeadRect);
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle, RenderIn, HeadRect),
                     BevelHighlight, BevelShadow);
    end else if FDrawingStyle = ds3d then begin
      { draw a 3d bevel }
      HeadRect.Left := RealLeft + 2;
      HeadRect.Top := RealTop + 2;
      HeadRect.Right := RealRight - 3;
      HeadRect.Bottom := RealTop + mvDayHeadHeight;
      TPSFillRect (RenderCanvas, Angle, RenderIn, HeadRect);
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle, RenderIn, HeadRect),
                     BevelHighlight, BevelDarkShadow);
    end
    else begin
      HeadRect.Left := RealLeft + 1;
      HeadRect.Top := RealTop + 1;
      HeadRect.Right := RealRight - 1;
      HeadRect.Bottom := RealTop + mvDayHeadHeight;
    end;

    { Acquire startdate and end date }
    {$IF FPC_FULLVERSION >= 30000}
    HeadStr := FormatDateTime(DateLabelFormat, DisplayDate);
    {$ELSE}
    HeadStr := SysToUTF8(FormatDateTime(DateLabelFormat, DisplayDate));
    {$ENDIF}

    { draw the text }
    if (DisplayOnly) and
       (RenderCanvas.TextWidth (HeadStr) >= RealWidth) then
      HeadTextRect.TopLeft:= Point (RealLeft + TextMargin * 2,
                                    HeadRect.Top)
    else if DisplayOnly then
      HeadTextRect.TopLeft := Point (RealLeft +
                                     (RealWidth -
                                     RenderCanvas.TextWidth (HeadStr)) div 2,
                                     HeadRect.Top)
    else
      HeadTextRect.TopLeft := Point (RealLeft + 30 + TextMargin * 2,
                                     HeadRect.Top);
    HeadTextRect.BottomRight := HeadRect.BottomRight;

    { Fix Header String }
    HeadStrLen := RenderCanvas.TextWidth(HeadStr);

    if HeadStrLen > HeadTextRect.Right - HeadTextRect.Left then begin
      HeadStr := GetDisplayString(RenderCanvas, HeadStr, 0,
        HeadTextRect.Right - HeadTextRect.Left - TextMargin);
    end;

    { position the spinner }
    mvSpinButtons.Height := Trunc(mvDayHeadHeight * 0.8);
    mvSpinButtons.Width := mvSpinButtons.Height * 2;
    mvSpinButtons.Left := TextMargin;
    mvSpinButtons.Top := (mvDayHeadHeight - mvSpinButtons.Height) div 2 + 2;

    RenderCanvas.Font.Assign (FDayHeadAttributes.Font);
    TPSTextOut (RenderCanvas, Angle, RenderIn,
                RealLeft + mvSpinButtons.Width + TextMargin * 2,
                HeadTextRect.Top + TextMargin, HeadStr);
  end;
  {-}

  procedure DrawDayHead;
  var
    dhRect : TRect;
    I      : Integer;
    DayTag : Integer;
    Str    : string;
    StrL   : Integer;
  begin
    { clear day head area }
    RenderCanvas.Font.Assign(DayHeadAttributes.Font);
    RenderCanvas.Brush.Color := DayHeadAttrColor;

    { build rect }
    if DrawingStyle = ds3D then begin
      dhRect.Left := RealLeft + 1;
      dhRect.Top := RealTop + mvDayHeadHeight + 3;
      dhRect.Right := RealRight - 3;
      dhRect.Bottom := dhRect.Top + mvDayHeadHeight;
      TPSFillRect (RenderCanvas, Angle, RenderIn, dhRect);
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle, RenderIn, dhRect),
                     BevelHighlight, BevelDarkShadow);
    end else begin
      dhRect.Left := RealLeft + 1;
      dhRect.Top := RealTop + mvDayHeadHeight + 2;
      dhRect.Right := RealRight - 1;
      dhRect.Bottom := dhRect.Top + mvDayHeadHeight;
      TPSFillRect (RenderCanvas, Angle, RenderIn, dhRect);
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle, RenderIn, dhRect),
                     BevelHighlight, BevelShadow);
    end;

    DayTag := Ord(WeekStartsOn);
    dhRect.Right := dhRect.Left + mvColWidth;
    for I := 0 to 6 do begin
      { draw the little vertical lines between each day }
      if I < 6 then
        DrawBevelRect (RenderCanvas,
                       TPSRotateRectangle (Angle, RenderIn,
                                           Rect (dhRect.Right,
                                                 dhRect.Top + 3,
                                                 dhRect.Right + 1,
                                                 dhRect.Bottom - 3)),
                       BevelShadow, BevelHighlight);

      if FDayNameStyle = dsLong then
        { Draw each day's full caption... }
       {$IFDEF LCL}
        str := FormatSettings.LongDayNames[DayTag+1]
       {$ELSE}
        case DayTag of
          0: str := RSSunday;
          1: str := RSMonday;
          2: str := RSTuesday;
          3: str := RSWednesday;
          4: str := RSThursday;
          5: str := RSFriday;
          6: str := RSSaturday;
        end
       {$ENDIF }
      else if FDayNameStyle = dsShort then
        { Draw each day's abbreviated caption... }
       {$IFDEF LCL}
        str := FormatSettings.ShortDayNames[DayTag+1]
       {$ELSE}
        case DayTag of
          0: str := RSASunday;
          1: str := RSAMonday;
          2: str := RSATuesday;
          3: str := RSAWednesday;
          4: str := RSAThursday;
          5: str := RSAFriday;
          6: str := RSASaturday;
        end
       {$ENDIF}
      else if FDayNameStyle = dsLetter then
        { Draw each day's first letter only }
       {$IFDEF LCL}
        str := FormatSettings.ShortDayNames[DayTag+1, 1];
       {$ELSE}
        case DayTag of
          0: str := RSLSunday;
          1: str := RSLMonday;
          2: str := RSLTuesday;
          3: str := RSLWednesday;
          4: str := RSLThursday;
          5: str := RSLFriday;
          6: str := RSLSaturday;
        end;
       {$ENDIF}

      { Fix Header String }
      StrL := RenderCanvas.TextWidth(Str);
      if (StrL > mvColWidth - (TextMargin * 2)) then begin
        Str := GetDisplayString (RenderCanvas, Str, 0,
                                 mvColWidth - (TextMargin * 2));
      end;
      StrL := RenderCanvas.TextWidth(Str);

      TPSTextOut (RenderCanvas, Angle, RenderIn,
                  dhRect.Left + (dhRect.Right - dhRect.Left) div 2 -
                  (Strl div 2), dhRect.Top + TextMargin - 1, Str);

      if DayTag = 6 then
        DayTag := 0
      else
        Inc(DayTag);
      dhRect.Left := dhRect.Right;
      dhRect.Right := dhRect.Left + mvColWidth;
    end;

  end;
  {-}

  procedure DrawDays;
  var
    TextRect      : TRect;
    Col, Row      : Integer;
    DayNumber     : Integer;
    M, D, Y, Tmp  : Word;
    MonthStartsOn : Integer;
    DayTag        : Integer;
    DayOffset     : Integer;
    StartingDate  : TDateTime;
    ThisDate      : TDateTime;
    Str           : string;
    StrLn         : Integer;
    I, J          : Integer;
    EventList     : TList;
    Drawn         : Boolean;
    TextAdjust    : Integer;
    FontStyle     : TFontStyles;
    OldBrush      : TBrush;
    OldPen        : TPen;
    OldFont       : TFont;
  begin
    { initialize the MonthDayArray }
    for I := 0 to Pred(Length(mvMonthDayArray)) do begin
      mvMonthDayArray[I].Rec     := Rect(-1, -1, -1, -1);
      mvMonthDayArray[I].Date    := 0.0;
    end;

    RenderCanvas.Pen.Color := RealLineColor;
    RenderCanvas.Brush.Color := RealColor;
    mvRowHeight := (RealHeight - (mvDayHeadHeight * 2) - 4) div 6;
    TextRect.TopLeft := Point (RealLeft + 1,
                               RealTop + (mvDayHeadHeight * 2) + 4);
    TextRect.BottomRight := Point (TextRect.Left +  mvColWidth,
                                   TextRect.Top + mvRowHeight);

    { Determine the starting date and offset }
    DecodeDate(DisplayDate, Y, M, D);
    StartingDate := EncodeDate(Y, M, 1);
    MonthStartsOn := DayOfWeek(StartingDate);
    DayTag := Ord(WeekStartsOn);
    DayOffset := DayTag - MonthStartsOn;

    I := 0;
    DayNumber := DayOffset + 1;

    { iterate through each column, row by row, drawing each day in numerical }
    { order.                                                                 }

    OldBrush := TBrush.Create;
    try
      OldPen := TPen.Create;
      try
        OldFont := TFont.Create;
        try
          for Row := 0 to 5 do begin
            for Col := 0 to 6 do begin
              if (Col = 6) then begin
                { draws the far right day for this week }
                ThisDate := trunc(StartingDate + DayNumber);
                DecodeDate(ThisDate, Y, Tmp, D);

                { Allow the user to draw the day }
                Drawn  := false;
                if Assigned(FOwnerDrawCells) then begin
                  OldBrush.Assign (Canvas.Brush);
                  OldPen.Assign (Canvas.Pen);
                  OldFont.Assign (Canvas.Font);
                  try
                    FOwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn);
                    if Drawn then continue;
                  finally
                    Canvas.Brush.Assign (OldBrush);
                    Canvas.Pen.Assign (OldPen);
                    Canvas.Font.Assign (OldFont);
                  end;
                end;

                TextRect.Right := TextRect.Right + 8;
                if Tmp <> M then begin
                  RenderCanvas.Brush.Color := RealOffDayColor;
                  if TextRect.Bottom > RealBottom then
                    TPSFillRect (RenderCanvas, Angle, RenderIn,
                                 Rect (TextRect.Left, TextRect.Top,
                                       RealRight, RealBottom))
                  else
                    TPSFillRect (RenderCanvas, Angle, RenderIn,
                                 Rect (TextRect.Left, TextRect.Top,
                                       RealRight, TextRect.Bottom));
                end else
                  RenderCanvas.Brush.Color := RealColor;
                { draw bottom line }
                TPSMoveTo (RenderCanvas, Angle, RenderIn,
                           TextRect.Left, TextRect.Bottom);
                TPSLineTo (RenderCanvas, Angle, RenderIn, RealRight - 2,
                           TextRect.Bottom);
                { Paint the day number }
                Str := FormatDateTime('d', ThisDate);

                { set the proper font and style }
                RenderCanvas.Font.Assign(FDayNumberFont);
                if (DisplayDate = ThisDate) then begin
                  if Focused then begin
                    TPSDrawFocusRect (RenderCanvas, Angle, RenderIn,
                                      Rect (TextRect.Left - 2,
                                            TextRect.Top - 2,
                                            TextRect.Right + 2,
                                            TextRect.Bottom + 2));
                    TPSDrawFocusRect (RenderCanvas, Angle, RenderIn,
                                      Rect (TextRect.Left + 2,
                                            TextRect.Top + 2,
                                            TextRect.Right - 2,
                                            TextRect.Bottom - 2));
                  end;
                  RenderCanvas.Font.Color := RealSelDayColor;
                  RenderCanvas.Font.Style := FDayNumberFont.Style + [fsBold];
                  if (FEventDayStyle <> []) and (DataStore.Resource <> nil)
                  and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0)
                  then
                    RenderCanvas.Font.Style := RenderCanvas.Font.Style
                      + FEventDayStyle;
                end else begin
                  { Set the font style for days which have events. }
                  if (FEventDayStyle <> []) and (DataStore.Resource <> nil)
                  and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0)
                  then
                    RenderCanvas.Font.Style := RenderCanvas.Font.Style
                      + FEventDayStyle
                  else begin
                    RenderCanvas.Font.Color := EventFontColor;
                    RenderCanvas.Font.Style := FDayNumberFont.Style;
                  end;
                end;

                FontStyle := RenderCanvas.Font.Style;
                RenderCanvas.Font.Style := [fsBold, fsItalic];
                TextAdjust := RenderCanvas.TextWidth (Str);
                RenderCanvas.Font.Style := FontStyle;
                if Tmp <> M then
                  RenderCanvas.Font.Color := FOffDayFontColor;

                { write the day number at the top of the square. }
                if fsItalic in RenderCanvas.Font.Style then
                  TPSTextOut (RenderCanvas, Angle, RenderIn,
                              TextRect.Left + mvColWidth - TextAdjust -
                              TextMargin - 2,
                              TextRect.Top + (TextMargin div 2), Str)
                else
                  TPSTextOut (RenderCanvas, Angle, RenderIn,
                              TextRect.Left + mvColWidth - TextAdjust
                                - TextMargin, TextRect.Top + (TextMargin div 2),
                                Str);


                { Update MonthDayArray }
                mvMonthDayArray[I].Rec := TextRect;
                mvMonthDayArray[I].Date := ThisDate;
                mvMonthDayArray[I].OffDay := Tmp <> M;
                Inc(DayNumber);
                Inc(I);

                { drop rect down one row and all the way to the left }
                TextRect.TopLeft := Point(RealLeft + 1, TextRect.Bottom + 1);
                TextRect.BottomRight := Point(TextRect.Left + mvColWidth,
                  TextRect.Top + mvRowHeight);
              end else begin
                { draws all days for the week, except the far right one }
                ThisDate := Trunc(StartingDate + DayNumber);
                DecodeDate(ThisDate, Y, Tmp, D);

                { Allow the user to draw the day }
                Drawn  := false;
                if Assigned(FOwnerDrawCells) then begin
                  OldBrush.Assign (Canvas.Brush);
                  OldPen.Assign (Canvas.Pen);
                  OldFont.Assign (Canvas.Font);
                  try
                    FOwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn);
                    if Drawn then continue;
                  finally
                    Canvas.Brush.Assign (OldBrush);
                    Canvas.Pen.Assign (OldPen);
                    Canvas.Font.Assign (OldFont);
                  end;
                end;

                if Tmp <> M then begin
                  RenderCanvas.Brush.Color := RealOffDayColor;
                  TPSFillRect (RenderCanvas, Angle, RenderIn, TextRect);
                end else
                  RenderCanvas.Brush.Color := RealColor;
                { draw right side and bottom lines }
                TPSMoveTo (RenderCanvas, Angle, RenderIn, TextRect.Right,
                  TextRect.top);
                if TextRect.Bottom > RealBottom then begin
                  TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Right,
                    RealBottom);
                  TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Left - 1,
                    RealBottom);
                end else begin
                  TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Right,
                    TextRect.Bottom);
                  TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Left - 1,
                    TextRect.Bottom);
                end;
                { paint the day number }
                Str := FormatDateTime('d', ThisDate);

                { set the proper font and style }
                RenderCanvas.Font.Assign(FDayNumberFont);
                if (DisplayDate = ThisDate) then begin
                  if Focused then begin
                    TPSDrawFocusRect (RenderCanvas, Angle, RenderIn,
                                      Rect (TextRect.Left - 2,
                                            TextRect.Top - 2,
                                            TextRect.Right + 2,
                                            TextRect.Bottom + 2));
                    TPSDrawFocusRect (RenderCanvas, Angle, RenderIn,
                                      Rect (TextRect.Left + 2,
                                            TextRect.Top + 2,
                                            TextRect.Right - 2,
                                            TextRect.Bottom - 2));
                  end;
                  RenderCanvas.Font.Color := RealSelDayColor;
                  RenderCanvas.Font.Style := FDayNumberFont.Style + [fsBold];
                  if (FEventDayStyle <> []) and (DataStore.Resource <> nil)
                  and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0)
                  then
                    RenderCanvas.Font.Style := RenderCanvas.Font.Style
                      + FEventDayStyle;
                end else begin
                  { Set the font style for days which have events. }
                  if (FEventDayStyle <> []) and (DataStore.Resource <> nil)
                  and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0)
                  then
                    RenderCanvas.Font.Style := RenderCanvas.Font.Style
                      + FEventDayStyle
                  else begin
                    RenderCanvas.Font.Color := EventFontColor;
                    RenderCanvas.Font.Style := FDayNumberFont.Style;
                  end;
                end;

                FontStyle := RenderCanvas.Font.Style;
                RenderCanvas.Font.Style := [fsBold, fsItalic];
                TextAdjust := RenderCanvas.TextWidth (Str);
                RenderCanvas.Font.Style := FontStyle;
                if Tmp <> M then
                  RenderCanvas.Font.Color := FOffdayFontColor;

                if fsItalic in RenderCanvas.Font.Style then
                  TPSTextOut (RenderCanvas, Angle, RenderIn,
                              TextRect.Right - TextAdjust - TextMargin - 2,
                              TextRect.Top + (TextMargin div 2), Str)
                else
                  TPSTextOut (RenderCanvas, Angle, RenderIn,
                              TextRect.Right - TextAdjust - TextMargin,
                              TextRect.Top + (TextMargin div 2), Str);

                { Update Array }
                mvMonthDayArray[I].Rec := TextRect;
                mvMonthDayArray[I].Date := ThisDate;
                mvMonthDayArray[I].OffDay := Tmp <> M;
                Inc(DayNumber);
                Inc(I);
                { slide rect one column to the right }
                TextRect.Left := TextRect.Right + 1;
                TextRect.Right := TextRect.Right + mvColWidth;
              end;
            end;
          end;

        finally
          OldFont.Free;
        end;
      finally
        OldPen.Free;
      end;
    finally
      OldBrush.Free;
    end;

    RenderCanvas.Pen.Color := RealLineColor;
    RenderCanvas.Pen.Style := psSolid;
    RenderCanvas.Brush.Color := RealColor;

    { write the events }
    if (DataStore <> nil) and FShowEvents and (DataStore.Resource <> nil)
    and (DataStore.Resource.Schedule.EventCount <> 0) then begin
      EventList := TList.Create;
      try
        for I := 0 to 43 do begin
          EventList.Clear;
          DataStore.Resource.Schedule.EventsByDate(mvMonthDayArray[I].Date, EventList);
          if EventList.Count > 0 then begin
            { there are events scheduled for this day }

            { initialize TextRect for this day }
            TextRect.TopLeft := Point(mvMonthDayArray[I].Rec.Left,
              mvMonthDayArray[I].Rec.Top);
            TextRect.BottomRight := Point(TextRect.Left + mvColWidth,
              TextRect.Top + mvEventTextHeight + (TextMargin div 2));

            { set canvas color }
            if mvMonthDayArray[I].OffDay
            then RenderCanvas.Brush.Color := RealOffDayColor
            else RenderCanvas.Brush.Color := RealColor;

            { spin through the events and paint them }
            for J := 0 to Pred(EventList.Count) do begin

              if (TextRect.Bottom > mvMonthDayArray[I].Rec.Bottom)
              and (J <= Pred(EventList.Count))
              then begin
                { draw a little red square with a (...) at the bottom right }
                { corner of the day to indicate that there are more events  }
                { than can be listed in the available space.                }
                RenderCanvas.Brush.Color := DotDotDotColor;
                { draw dot dot dot }
                TPSFillRect (RenderCanvas, Angle, RenderIn,
                             Rect(mvMonthDayArray[I].Rec.Right - 20,
                                     mvMonthDayArray[I].Rec.Bottom - 7,
                                     mvMonthDayArray[I].Rec.Right - 17,
                                     mvMonthDayArray[I].Rec.Bottom - 4));
                TPSFillRect (RenderCanvas, Angle, RenderIn,
                             Rect(mvMonthDayArray[I].Rec.Right - 13,
                                     mvMonthDayArray[I].Rec.Bottom - 7,
                                     mvMonthDayArray[I].Rec.Right - 10,
                                     mvMonthDayArray[I].Rec.Bottom - 4));
                TPSFillRect (RenderCanvas, Angle, RenderIn,
                             Rect(mvMonthDayArray[I].Rec.Right -  6,
                                     mvMonthDayArray[I].Rec.Bottom - 7,
                                     mvMonthDayArray[I].Rec.Right -  3,
                                     mvMonthDayArray[I].Rec.Bottom - 4));
                Break;
              end;

              { shorten events that are next to the day number, in order }
              { to give the day number enough room }
              if (TextRect.Top < mvMonthDayArray[I].Rec.Top
                + mvDayNumberHeight + (TextMargin div 2))
              then
                TextRect.Right := TextRect.Left + mvColWidth
                  - mvDayNumberHeight - TextMargin
              else
                TextRect.Right := TextRect.Left + mvColWidth;

              { format the display text }
              if ShowEventTime then begin
                if (TimeFormat = tf24Hour) then
                  Str := FormatDateTime('hh:mm',
                    TVpEvent(EventList.List^[j]).StartTime)
                else
                  Str := FormatDateTime('hh:mm AM/PM',
                    TVpEvent(EventList.List^[j]).StartTime);
                Str := Str + ' - ' + TVpEvent(EventList.List^[j]).Description;
              end else
                Str := TVpEvent(EventList.List^[j]).Description;

              { set the event font }
              RenderCanvas.Font.Assign(FEventFont);
              if mvMonthDayArray[I].OffDay then
                RenderCanvas.Font.Color := FOffDayFontColor;

              StrLn := RenderCanvas.TextWidth(Str);
              if (StrLn > TextRect.Right - TextRect.Left - (TextMargin * 2)) then
              begin
                Str := GetDisplayString(RenderCanvas, Str, 0, TextRect.Right -
                  TextRect.Left - (TextMargin * 2));
              end;

              { write the event text }
              TPSTextOut (RenderCanvas, Angle, RenderIn, TextRect.Left + (TextMargin div 2),
                TextRect.Top + (TextMargin div 2), Str);

              { - begin block}
              Inc(mvVisibleEvents);
              mvEventArray[mvVisibleEvents - 1].Rec := TextRect;
              mvEventArray[mvVisibleEvents - 1].Event := TVpEvent(EventList.List^[j]);
              { - end block}

              { Move TextRect down one line for the next item... }
              TextRect.Top := TextRect.Bottom + 1;
              TextRect.Bottom := TextRect.Top + mvLineHeight;
            end;
          end;
        end;
      finally
        EventList.Free;
      end;
    end;
  end;
  {-}


  procedure DrawBorders;
  begin
    if FDrawingStyle = dsFlat then begin
      { draw an outer and inner bevel }
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle,
                                         RenderIn,
                                         Rect (RealLeft,
                                               RealTop,
                                               RealRight - 1,
                                               RealBottom - 1)),
                     BevelShadow,
                     BevelShadow);
    end else if FDrawingStyle = ds3d then begin
    { draw a 3d bevel }
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle,
                                         RenderIn,
                                         Rect (RealLeft,
                                               RealTop,
                                               RealRight - 1,
                                               RealBottom - 1)),
                     BevelShadow,
                     BevelHighlight);
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle,
                                         RenderIn,
                                         Rect (RealLeft + 1,
                                               RealTop +  1,
                                               RealRight - 2,
                                               RealBottom - 2)),
                     BevelDarkShadow,
                     BevelFace);
    end;
  end;
  {-}
begin
  if DisplayOnly then begin
    BevelHighlight   := clBlack;
    BevelShadow      := clBlack;
    BevelDarkShadow  := clBlack;
    BevelFace        := clBlack;
    RealColor        := clWhite;
    DayHeadAttrColor := clSilver;
    RealLineColor    := clBlack;
    RealOffDayColor  := clSilver;
    RealSelDayColor  := clWhite;
    EventFontColor   := clBlack;
  end else begin
    BevelHighlight   := clBtnHighlight;
    BevelShadow      := clBtnShadow;
    BevelDarkShadow  := cl3DDkShadow;
    BevelFace        := clBtnFace;
    RealColor        := Color;
    DayHeadAttrColor := DayHeadAttributes.Color;
    RealLineColor    := LineColor;
    RealOffDayColor  := OffDayColor;
    RealSelDayColor  := FSelectedDayColor;
    EventFontColor   := FDayNumberFont.Color;
  end;
  DotDotDotColor := clBlack;

  mvPainting := true;
  SavePenStyle := RenderCanvas.Pen.Style;
  SaveBrushColor := RenderCanvas.Brush.Color;
  SavePenColor := RenderCanvas.Pen.Color;

  RenderCanvas.Pen.Style   := psSolid;
  RenderCanvas.Pen.Width   := 1;
  RenderCanvas.Pen.Mode    := pmCopy;
  RenderCanvas.Brush.Style := bsSolid;

  Rgn := CreateRectRgn (RenderIn.Left, RenderIn.Top,
                        RenderIn.Right, RenderIn.Bottom);
  try
    SelectClipRgn (RenderCanvas.Handle, Rgn);

    { clear client area }
    Clear;

    { measure the row heights }
    SetMeasurements;

    { draw headers }
    DrawHeader;
    DrawDayHead;

    { draw days }
    mvVisibleEvents := 0;                                                
    DrawDays;

    { draw the borders }
    DrawBorders;

  finally
    SelectClipRgn (RenderCanvas.Handle, 0);
    DeleteObject (Rgn);
  end;

  { reinstate canvas settings}
  RenderCanvas.Pen.Style := SavePenStyle;
  RenderCanvas.Brush.Color := SaveBrushColor;
  RenderCanvas.Pen.Color := SavePenColor;
  mvPainting := false; 
end;

procedure TVpMonthView.mvPopulate;
begin
  if DataStore <> nil then
    DataStore.Date := FDate;
end;
{=====}

procedure TVpMonthView.mvSpinButtonClick(Sender: TObject; Button: TUDBtnType);
var
  M, D, Y : Word;
begin
  DecodeDate(Date, Y, M, D);
  if Button = btNext then begin
    if M = 12 then begin
      M := 1;
      Y := Y + 1;
    end else
      M := M + 1;
  end else begin
    if M = 1 then begin
      M := 12;
      Y := Y - 1;
    end else
      M := M - 1;
  end;
  if (D > DaysInMonth(Y, M)) then
    D := DaysInMonth(Y, M);

  Date := EncodeDate(Y, M, D);
end;
{=====}

procedure TVpMonthView.SetColor(Value: TColor);
begin
  if FColor <> Value then begin
    FColor := Value;
    Invalidate;
  end;
end;
{=====}

procedure TVpMonthView.SetDrawingStyle(Value: TVpDrawingStyle);
begin
  if FDrawingStyle <> Value then begin
    FDrawingStyle := Value;
    Repaint;
  end;
end;
{=====}

procedure TVpMonthView.SetLineColor(Value: TColor);
begin
  if FLineColor <> Value then begin
    FLineColor := Value;
    Repaint;
  end;
end;
{=====}

procedure TVpMonthView.SetOffDayColor(Value: TColor);
begin
  if Value <> FOffDayColor then begin
    FOffDayColor := Value;
    Invalidate;
  end;
end;
{=====}

procedure TVpMonthView.SetOffDayFontColor(Value: TColor);
begin
  FOffDayFontColor := Value;
  Invalidate;
end;
{=====}

procedure TVpMonthView.SetDateLabelFormat(Value: string);
begin
  if Value <> FDateLabelFormat then begin
    FDateLabelFormat := Value;
    Invalidate;
  end;
end;
{=====}

procedure TVpMonthView.SetShowEvents(Value: Boolean);
begin
  if FShowEvents <> Value then begin
    FShowEvents := Value;
    Invalidate;
  end;
end;
{=====}

procedure TVpMonthView.SetEventDayStyle(Value: TFontStyles);
begin
  if FEventDayStyle <> Value then begin
    FEventDayStyle := Value;
    Invalidate;
  end;
end;
{=====}

procedure TVpMonthView.SetDayNameStyle(Value: TVpMVDayNameStyle);
begin
  if FDayNameStyle <> Value then begin
    FDayNameStyle := Value;
    Invalidate;
  end;
end;
{=====}

procedure TVpMonthView.SetDayNumberFont(Value: TFont);
begin
  FDayNumberFont.Assign(Value);
  Invalidate;
end;
{=====}

procedure TVpMonthView.SetEventFont(Value: TFont);
begin
  FEventFont.Assign(Value);
  Invalidate;
end;
{=====}

procedure TVpMonthView.SetSelectedDayColor(Value: TColor);
begin
  if Value <> FSelectedDayColor then begin
    FSelectedDayColor := Value;
    Invalidate;
  end;
end;
{=====}

procedure TVpMonthView.SetShowEventTime(Value: Boolean);
begin
  if Value <> FShowEventTime then begin
    FShowEventTime := Value;
    Invalidate;
  end;
end;
{=====}

procedure TVpMonthView.SetTimeFormat(Value: TVpTimeFormat);
begin
  if Value <> FTimeFormat then begin
    FTimeFormat := Value;
    Invalidate;
  end;
end;
{=====}

procedure TVpMonthView.SetDate(Value: TDateTime);
begin
  if FDate <> Trunc(Value) then begin
    FDate := Trunc(Value);

    if DataStore <> nil then
      DataStore.Date := FDate;

    if mvLoaded then
      mvPopulate;
    Invalidate;

    if ControlLink <> nil then
      ControlLink.Notify(self, neDateChange, FDate);
  end;
end;
{=====}

{$IFNDEF LCL}
procedure TVpMonthView.WMSize(var Msg: TWMSize);
{$ELSE}
procedure TVpMonthView.WMSize(var Msg: TLMSize);
{$ENDIF}
begin
  inherited;
  { force a repaint on resize }
  Invalidate;
end;
{=====}

procedure TVpMonthView.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or WS_TABSTOP;
{$IFNDEF LCL}
    WindowClass.style := CS_DBLCLKS;
{$ENDIF}
  end;
end;
{=====}

procedure TVpMonthView.CreateWnd;
begin
  inherited;
  mvSpinButtons.Parent := self;
end;
{=====}

{$IFNDEF LCL}
procedure TVpMonthView.WMLButtonDown(var Msg : TWMLButtonDown);
{$ELSE}
procedure TVpMonthView.WMLButtonDown(var Msg : TLMLButtonDown);
{$ENDIF}
begin
  inherited;
  // if the mouse was pressed down in the client area, then select the cell.
  if not focused then SetFocus;

  if (Msg.YPos > mvDayHeadHeight) then
  begin
    { The mouse click landed inside the client area }
    MvSetDateByCoord(Point(Msg.XPos, Msg.YPos));
    { Did the mouse click land on an event? }
    if SelectEventAtCoord(Point(Msg.XPos, Msg.YPos))                     
    and (Assigned(FOnEventClick)) then                                   
        FOnEventClick(self, mvActiveEvent);                              
  end;
end;
{=====}

{$IFNDEF LCL}
procedure TVpMonthView.WMLButtonDblClick(var Msg: TWMLButtonDblClk);
{$ELSE}
procedure TVpMonthView.WMLButtonDblClick(var Msg: TLMLButtonDblClk);
{$ENDIF}
begin                                                                    
  inherited;                                                             
  // if the mouse was pressed down in the client area, then select the   
  // cell.                                                               
  if not focused then SetFocus;                                          
                                                                         
  if (Msg.YPos > mvDayHeadHeight) then                                   
  begin                                                                  
    { The mouse click landed inside the client area }                    
    MvSetDateByCoord(Point(Msg.XPos, Msg.YPos));                         
    { Did the mouse click land on an event? }                            
    if SelectEventAtCoord(Point(Msg.XPos, Msg.YPos))                     
    and (Assigned(FOnEventDblClick)) then                                
      FOnEventDblClick(self, mvActiveEvent);                             
  end;                                                                   
end;                                                                     
{=====}                                                                  

{$IFNDEF LCL}
procedure TVpMonthView.WMSetFocus(var Msg : TWMSetFocus);
{$ELSE}
procedure TVpMonthView.WMSetFocus(var Msg : TLMSetFocus);
{$ENDIF}
begin
  // if active event is nil then set active event to the first diaplsyed one.
end;
{=====}

{$IFNDEF LCL}
procedure TVpMonthView.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin
  inherited;
  Msg.Result := 1;
end;
{$ENDIF}
{=====}

{$IFNDEF LCL}
procedure TVpMonthView.WMRButtonDown(var Msg : TWMRButtonDown);
{$ELSE}
procedure TVpMonthView.WMRButtonDown(var Msg : TLMRButtonDown);
{$ENDIF}
var
  ClientOrigin : TPoint;
begin
  inherited;

  if not Assigned (PopupMenu) then begin
    if not focused then
      SetFocus;
    if FRightClickChangeDate then                                        
      mvSetDateByCoord (Point (Msg.XPos, Msg.YPos));                     
    ClientOrigin := GetClientOrigin;
  end;
end;
{=====}

procedure TVpMonthView.InitializeDefaultPopup;
var
  NewItem : TMenuItem;

begin
  if RSMonthPopupToday <> '' then begin
    NewItem := TMenuItem.Create (Self);
    NewItem.Caption := RSMonthPopupToday;
    NewItem.OnClick := PopupToday;
    FDefaultPopup.Items.Add (NewItem);
  end;

  if RSMonthPopupNextMonth <> '' then begin
    NewItem := TMenuItem.Create (Self);
    NewItem.Caption := RSMonthPopupNextMonth;
    NewItem.OnClick := PopupNextMonth;
    FDefaultPopup.Items.Add (NewItem);
  end;

  if RSMonthPopupPrevMonth <> '' then begin
    NewItem := TMenuItem.Create (Self);
    NewItem.Caption := RSMonthPopupPrevMonth;
    NewItem.OnClick := PopupPrevMonth;
    FDefaultPopup.Items.Add (NewItem);
  end;

  if RSMonthPopupNextYear <> '' then begin
    NewItem := TMenuItem.Create (Self);
    NewItem.Caption := RSMonthPopupNextYear;
    NewItem.OnClick := PopupNextYear;
    FDefaultPopup.Items.Add (NewItem);
  end;

  if RSMonthPopupPrevYear <> '' then begin
    NewItem := TMenuItem.Create (Self);
    NewItem.Caption := RSMonthPopupPrevYear;
    NewItem.OnClick := PopupPrevYear;
    FDefaultPopup.Items.Add (NewItem);
  end;
end;
{=====}

procedure TVpMonthView.PopupToday (Sender : TObject);
begin
  Date := Now;
end;
{=====}

procedure TVpMonthView.PopupNextMonth (Sender : TObject);
begin
  mvSpinButtonClick (self, btNext);
end;
{=====}

procedure TVpMonthView.PopupPrevMonth (Sender : TObject);
begin
  mvSpinButtonClick (self, btPrev);
end;
{=====}

procedure TVpMonthView.PopupNextYear (Sender : TObject);
var
  M, D, Y : Word;

begin
  DecodeDate (Date, Y, M, D);
  Date := EncodeDate (Y + 1, M, 1);
end;
{=====}

procedure TVpMonthView.PopupPrevYear (Sender : TObject);
var
  M, D, Y : Word;

begin
  DecodeDate (Date, Y, M, D);
  Date := EncodeDate (Y - 1, M, 1);
end;
{=====}

{ - renamed from EditEventAtCoord and re-written}
function TVpMonthView.SelectEventAtCoord(Point: TPoint): Boolean;        
var
  I: Integer;
begin
  result := false;
  I := 0;
  while I < Length(mvEventArray) do begin
    if mvEventArray[I].Event = nil then begin
      Inc(I);
      Break;
    end else begin
      if (Point.X > mvEventArray[I].Rec.Left)
      and (Point.X < mvEventArray[I].Rec.Right)
      and (Point.Y > mvEventArray[I].Rec.Top)
      and (Point.Y < mvEventArray[I].Rec.Bottom) then begin
        result := true;
        Break;
      end else
        Inc(I);
    end;
  end;

  if result then begin
    mvActiveEvent := TVpEvent(mvEventArray[I].Event);
    mvActiveEventRec := mvEventArray[I].Rec;
  end;
end;
{=====}

procedure TVpMonthView.mvSetDateByCoord(Point: TPoint);
var
  I: Integer;
begin
  for I := 0 to pred(Length(mvMonthdayArray)) do begin
    if (Point.X >= mvMonthdayArray[I].Rec.Left)
    and (Point.X <= mvMonthdayArray[I].Rec.Right)
    and (Point.Y >= mvMonthdayArray[I].Rec.Top)
    and (Point.Y <= mvMonthdayArray[I].Rec.Bottom) then
      Date := mvMonthdayArray[I].Date;
  end;
end;
{=====}

procedure TVpMonthView.KeyDown(var Key: Word; Shift: TShiftState);
var
  M, D, Y    : Word;
  PopupPoint : TPoint;

begin
  if FKBNavigate then
    case Key of
      VK_UP    :
        if ssCtrl in Shift then begin
          DecodeDate(Date, Y, M, D);
          Date := EncodeDate(Y - 1, M, 1);
        end else
          Date := Date - 7;
      VK_DOWN  :
        if ssCtrl in Shift then begin
          DecodeDate(Date, Y, M, D);
          Date := EncodeDate(Y + 1, M, 1);
        end else
          Date := Date + 7;
      VK_NEXT  : mvSpinButtonClick(self, btNext);
      VK_PRIOR : mvSpinButtonClick(self, btPrev);
      VK_LEFT  :
        if ssCtrl in Shift then
          mvSpinButtonClick(self, btPrev)
        else
          Date := Date - 1;
      VK_RIGHT :
        if ssCtrl in Shift then
          mvSpinButtonClick(self, btNext)
        else
          Date := Date + 1;
      VK_HOME  : begin
        DecodeDate(Date, Y, M, D);
        if D = 1 then
          mvSpinButtonClick(self, btPrev)
        else
          Date := EncodeDate(Y, M, 1);
      end;
      VK_END   : begin
        DecodeDate(Date, Y, M, D);
        if D = DaysInMonth(Y, M) then begin
          if M = 12 then begin
            M := 1;
            Inc(Y);
          end else
            Inc(M);
        end;
        Date := EncodeDate(Y, M, DaysInMonth(Y, M));
      end;
{$IFNDEF LCL}
      VK_TAB   :
        if ssShift in Shift then
          Windows.SetFocus (GetNextDlgTabItem (GetParent (Handle), Handle, False))
        else
          Windows.SetFocus (GetNextDlgTabItem (GetParent (Handle), Handle, True));
{$ENDIF}
      VK_F10   :
        if (ssShift in Shift) and not (Assigned (PopupMenu)) then begin
          PopupPoint := GetClientOrigin;
          FDefaultPopup.Popup (PopupPoint.x + 10,
                               PopupPoint.y + 10);
        end;
      VK_APPS  :
        if not Assigned (PopupMenu) then begin
          PopupPoint := GetClientOrigin;
          FDefaultPopup.Popup (PopupPoint.x + 10,
                               PopupPoint.y + 10);
        end;
    end;
end;
{=====}
procedure TVpMonthView.SetRightClickChangeDate (const v : Boolean);      
begin                                                                    
  if v <> FRightClickChangeDate then                                     
    FRightClickChangeDate := v;                                          
end;                                                                     
{=====}
procedure TVpMonthView.SetWeekStartsOn(Value: TVpDayType);
begin
  if Value <> FWeekStartsOn then begin
    FWeekStartsOn := Value;
    Invalidate;
  end;
end;
{=====}

end.