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 *****                                              *}

{$IF FPC_FullVersion >= 30200}
  {$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
{$IFEND}

{$I vp.inc}

unit VpMonthView;

interface

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

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;

  TVpMonthViewAttr = class(TPersistent)
  private
    FMonthView: TVpMonthView;
    FColor: TColor;
    FFont: TVpFont;
    procedure SetColor(AValue: TColor);
    procedure SetFont(AValue: TVpFont);
  protected
    procedure UpdateMonthView;
  public
    constructor Create(AOwner: TVpMonthView);
    destructor Destroy; override;
    property MonthView: TVpMonthView read FMonthVIew;
  published
    property Font: TVpFont read FFont write SetFont;
    property Color: TColor read FColor write SetColor default DEFAULT_HEADERCOLOR;
  end;

  TVpMvHolidayAttr = class(TVpMonthViewAttr)
  public
    constructor Create(AOwner: TVpMonthView);
  published
    property Color default HOLIDAY_COLOR;
  end;

  TVpMvWeekendAttr = class(TVpMonthViewAttr)
  public
    constructor Create(AOwner: TVpMonthView);
  published
    property Color default WEEKEND_COLOR;
  end;

  (*
  TVpMvHeadAttr = class(TPersistent)
  protected{ private }
    FOwner: TVpMonthView;
    FColor: TColor;
    FFont: TVpFont;
    procedure SetColor(const Value: TColor);
    procedure SetFont(Value: TVpFont);
  public
    constructor Create(AOwner: TVpMonthView);
    destructor Destroy; override;
    property Owner: TVpMonthView read FOwner;
  published
    property Font: TVpFont read FFont write SetFont;
    property Color: TColor read FColor write SetColor;
  end;

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


  { TVpMonthView }

  TVpMonthView = class(TVpLinkableControl)
  private
    FAllowDragAndDrop: Boolean;
    FApplyCategoryInfos: Boolean;
    FColor: TColor;
//    FColumnWidth: Integer;
    FComponentHint: TTranslateString;
    FDate: TDateTime;
    FDateLabelFormat: string;
    FDayHeadAttr: TVpMonthViewAttr;
    FDayNameStyle: TVpMVDayNameStyle;
    FDayNumberFont: TVpFont;
    FDaysMargin: Integer;
    FDefaultPopup: TPopupMenu;
    FDragDropTransparent: Boolean;
    FDrawingStyle: TVpDrawingStyle;
    FEventDayStyle: TFontStyles;
    FEventFont: TVpFont;
    FExternalPopup: TPopupMenu;
    FHeadAttr: TVpMonthViewAttr;
    FHintMode: TVpHintMode;
    FHolidayAttr: TVpMvHolidayAttr;
    FKBNavigate: Boolean;
    FMonthMargin: Integer;
    FLineColor: TColor;
    FMouseDate: TDateTime;
    FOffDayColor: TColor;
    FOffDayFontColor: TColor;
    FRightClickChangeDate: Boolean;
    FSelectedDayColor: TColor;
    FShowEvents: Boolean;
    FShowEventTime: Boolean;
    FTimeFormat: TVpTimeFormat;
    FTodayAttr: TVpMvTodayAttr;
    FWeekendAttr: TVpMvWeekendAttr;
    FWeekStartsOn: TVpDayType;

    // Internal variables
    mvActiveEvent: TVpEvent;
    mvActiveEventRec: TRect;
    mvDragging: Boolean;
    mvLoaded: Boolean;
    mvMouseDown: Boolean;
    mvMouseDownPoint: TPoint;

    // Event variables
    FOnAddEvent: TVpOnAddNewEvent;
    FOnEventClick: TVpOnEventClick;
    FOnEventDblClick: TVpOnEventClick;
    FOnHoliday: TVpHolidayEvent;
    FOnModifyEvent: TVpOnModifyEvent;
    FOwnerDrawCells: TVpOwnerDrawDayEvent;
    FOwnerEditEvent: TVpEditEvent;

    { property methods }
    function IsStoredDateLabelFormat: Boolean;
    procedure SetApplyCategoryInfos(AValue: Boolean);
    procedure SetColor(Value: TColor);  reintroduce;
    procedure SetDate(Value: TDateTime);
    procedure SetDateLabelFormat(Value: string);
    procedure SetDayNameStyle(Value: TVpMVDayNameStyle);
    procedure SetDayNumberFont(Value: TVpFont);
    procedure SetDaysMargin(Value: Integer);
    procedure SetDrawingStyle(Value: TVpDrawingStyle);
    procedure SetEventDayStyle(Value: TFontStyles);
    procedure SetEventFont(Value: TVpFont);
    procedure SetLineColor(Value: TColor);
    procedure SetMonthMargin(Value: Integer);
    procedure SetOffDayColor(Value: TColor);
    procedure SetOffDayFontColor(Value: TColor);
    procedure SetPopupMenu(AValue: TPopupMenu);
    procedure SetRightClickChangeDate(const v: Boolean);
    procedure SetSelectedDayColor(Value: TColor);
    procedure SetShowEvents(Value: Boolean);
    procedure SetShowEventTime(Value: Boolean);
    procedure SetTimeFormat(Value: TVpTimeFormat);
    procedure SetWeekStartsOn(Value: TVpDayType);

  protected{ private }
    // Needed by the drawer
    FPrevYearBtn: TSpeedButton;
    FPrevMonthBtn: TSpeedButton;
    FNextMonthBtn: TSpeedButton;
    FNextYearBtn: TSpeedButton;
    mvHeaderHeight: Integer;
    mvMonthHeadHeight: Integer;
    mvDayHeadHeight: Integer;
    mvEventArray: TVpEventArray;
    mvMonthDayArray: TVpMonthdayArray;

    { internal methods }
    function GetDateAtCoord(APoint: TPoint): TDateTime;
    procedure mvPopulate;
    procedure mvSpawnEventEditDialog(IsNewEvent: Boolean);
    procedure mvSetDateByCoord(APoint: TPoint);
    procedure mvHookUp;
    procedure mvPenChanged(Sender: TObject);
    function SelectEventAtCoord(Point: TPoint): Boolean;
    procedure SpinButtonClick(Sender: TObject);

    { inherited methods }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Loaded; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
    procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;

    { drag and drop }
    procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
    procedure DoStartDrag(var DragObject: TDragObject); override;
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean); override;

    { message handlers }
    {$IFNDEF LCL}
    procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonDblClick(var Msg: TWMLButtonDblClk);message WM_LBUTTONDBLCLK;
    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 WMLButtonDown(var Msg: TLMLButtonDown); message LM_LBUTTONDOWN;
    procedure WMLButtonDblClick(var Msg: TLMLButtonDblClk); message LM_LBUTTONDBLCLK;
    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}

    { Hints }
    procedure ShowHintWindow(APoint: TPoint; ADate: TDateTime);
    procedure HideHintWindow;
    procedure SetHint(const AValue: TTranslateString); override;

    { Popup menu }
    function GetPopupMenu: TPopupMenu; override;
    procedure InitializeDefaultPopup;
    procedure PopupToday(Sender: TObject);
    procedure PopupNextMonth(Sender: TObject);
    procedure PopupPrevMonth(Sender: TObject);
    procedure PopupNextYear(Sender: TObject);
    procedure PopupPrevYear(Sender: TObject);
    procedure PopupCustomDate(Sender: TObject);

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function BuildEventString(AEvent: TVpEvent;
      AShowEventTime, AStartTimeOnly: Boolean): String;
    procedure DragDrop(Source: TObject; X, Y: Integer); override;
    procedure LoadLanguage;
    procedure Invalidate; override;
    function IsHoliday(ADate: TDate; out AHolidayName: String): Boolean;
    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, StopLine: Integer; UseGran: TVpGranularity;
      DisplayOnly: Boolean); override;

    { LCL scaling }
    {$IF VP_LCL_SCALING <> 0}
    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
      const AXProportion, AYProportion: Double); override;
    {$IFEND}
    {$IF VP_LCL_SCALING = 2}
    procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
    procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
    {$ELSEIF VP_LCL_SCALING = 1}
    procedure ScaleFontsPPI(const AProportion: Double); override;
    {$ENDIF}

    property Date: TDateTime read FDate write SetDate;

  published
    { inherited properties }
    property Align;
    property Anchors;
    {$IFDEF LCL}
    property BorderSpacing;
    {$ENDIF}
    property PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu;
    property TabStop default true;
    property TabOrder;
    property AllowDragAndDrop: Boolean read FAllowDragAndDrop write FAllowDragAndDrop default false;
    property ApplyCategoryInfos: Boolean read FApplyCategoryInfos write SetApplyCategoryInfos default false;
    property Color: TColor read FColor write SetColor default DEFAULT_COLOR;
    property DateLabelFormat: string read FDateLabelFormat write SetDateLabelFormat stored IsStoredDateLabelFormat;
    property DayHeadAttributes: TVpMonthviewAttr read FDayHeadAttr write FDayHeadAttr;
    property DayNameStyle: TVpMVDayNameStyle read FDayNameStyle write SetDayNameStyle default dsShort;
    property DayNumberFont: TVpFont read FDayNumberFont write SetDayNumberFont;
    property DaysMargin: Integer read FDaysMargin write SetDaysMargin default 2;
    property DragDropTransparent: Boolean read FDragDropTransparent write FDragDropTransparent default false;
    property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d;
    property EventDayStyle: TFontStyles read FEventDayStyle write SetEventDayStyle default [];
    property EventFont: TVpFont read FEventFont write SetEventFont;
    property HeadAttributes: TVpMonthViewAttr read FHeadAttr write FHeadAttr;
    property HolidayAttributes: TVpMvHolidayAttr read FHolidayAttr write FHolidayAttr;
    property HintMode: TVpHintMode read FHintMode write FHintMode default hmPlannerHint;
    property KBNavigation: Boolean read FKBNavigate write FKBNavigate default true;
    property LineColor: TColor read FLineColor write SetLineColor default DEFAULT_LINECOLOR;
    property MonthMargin: Integer read FMonthMargin write SetMonthMargin default TEXT_MARGIN;
    property OffDayColor: TColor read FOffDayColor write SetOffDayColor default OFF_COLOR;
    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 default clRed;
    property ShowEvents: Boolean read FShowEvents write SetShowEvents default true;
    property ShowEventTime: Boolean read FShowEventTime write SetShowEventTime default false;
    property TimeFormat: TVpTimeFormat read FTimeFormat write SetTimeFormat default tf12Hour;
    property TodayAttributes: TVpMvTodayAttr read FTodayAttr write FTodayAttr;
    property WeekendAttributes: TVpMvWeekendAttr read FWeekendAttr write FWeekendAttr;
    property WeekStartsOn: TVpDayType read FWeekStartsOn write SetWeekStartsOn default dtSunday;
    {events}
    property OnAddEvent: TVpOnAddNewEvent read FOnAddEvent write FOnAddEvent;
    property OnEventClick: TVpOnEventClick read FOnEventClick write FOnEventClick;
    property OnEventDblClick: TVpOnEventClick read FOnEventDblClick write FOnEventDblClick;
    property OnHoliday: TVpHolidayEvent read FOnHoliday write FOnHoliday;
    property OnModifyEvent: TVpOnModifyEvent read FOnModifyEvent write FOnModifyEvent;
    property OnOwnerEditEvent: TVpEditEvent read FOwnerEditEvent write FOwnerEditEvent;
  end;


implementation

uses
 {$IFDEF LCL}
  DateUtils,
 {$ENDIF}
  SysUtils, LazUTF8, Dialogs, StrUtils,
  VpMonthViewPainter, VpEvntEditDlg;

(*****************************************************************************)
{ TVpMonthViewAttr                                                            }
(*****************************************************************************)
constructor TVpMonthViewAttr.Create(AOwner: TVpMonthView);
begin
  inherited Create;
  FMonthView := AOwner;
  FColor := DEFAULT_HEADERCOLOR;
  FFont := TVpFont.Create(AOwner);
end;

destructor TVpMonthViewAttr.Destroy;
begin
  FFont.Free;
  inherited;
end;

procedure TVpMonthViewAttr.SetColor(AValue: TColor);
begin
  if FColor <> AValue then begin
    FColor := AValue;
    UpdateMonthView;
  end;
end;

procedure TVpMonthViewAttr.SetFont(AValue: TVpFont);
begin
  FFont.Assign(AValue);
  FFont.Owner := FMonthView;
  UpdateMonthView;
end;

procedure TVpMonthViewAttr.UpdateMonthView;
begin
  if Assigned(FMonthView) then
    FMonthView.Invalidate;
end;


(*****************************************************************************)
{ TVpMvHolidayAttr                                                            }
(*****************************************************************************)
constructor TVpMvHolidayAttr.Create(AOwner: TVpMonthView);
begin
  inherited Create(AOwner);
  FColor := HOLIDAY_COLOR;
end;


(*****************************************************************************)
{ TVpMvWeekendAttr                                                            }
(*****************************************************************************)
constructor TVpMvWeekendAttr.Create(AOwner: TVpMonthView);
begin
  inherited Create(AOwner);
  FColor := WEEKEND_COLOR;
end;


(*****************************************************************************)
{ TVpMvTodayAttr                                                              }
(*****************************************************************************)
constructor TVpMvTodayAttr.Create(AOwner: TVpMonthView);
begin
  inherited Create(AOwner);
  FBorderPen := TPen.Create;
  FBorderPen.Color := clRed;
  FBorderPen.Width := 3;
  FBorderPen.OnChange := FMonthView.mvPenChanged;
end;

destructor TVpMvTodayAttr.Destroy;
begin
  FBorderPen.Free;
  inherited;
end;

procedure TVpMvTodayAttr.SetBorderPen(Value: TPen);
begin
  if Value <> FBorderPen then begin
    FBorderPen.Assign(Value);
    MonthView.Invalidate;
  end;
end;


(*****************************************************************************)
{ TVpMonthView                                                                }
(*****************************************************************************)
constructor TVpMonthView.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
  HintWindowClass := TVpHintWindow;
  
  { Create internal classes and stuff }
  FHeadAttr := TVpMonthViewAttr.Create(self);
  FDayHeadAttr := TVpMonthViewAttr.Create(self);
  FHolidayAttr := TVpMvHolidayAttr.Create(self);
  FWeekendAttr := TVpMvWeekendAttr.Create(self);
  FTodayAttr := TVpMvTodayAttr.Create(Self);

  FPrevYearBtn := TSpeedButton.Create(self);
  FPrevYearBtn.Hint := RSPrevYear;
  FPrevYearBtn.OnClick := SpinButtonClick;
  FPrevMonthBtn := TSpeedButton.Create(self);
  FPrevMonthBtn.Hint := RSPrevMonth;
  FPrevMonthBtn.OnClick := SpinButtonClick;
  FNextMonthBtn := TSpeedButton.Create(self);
  FNextMonthBtn.Hint := RSNextMonth;
  FNextMonthBtn.OnClick := SpinButtonClick;
  FNextYearBtn := TSpeedButton.Create(self);
  FNextYearBtn.Hint := RSNextYear;
  FNextYearBtn.OnClick := SpinButtonClick;
  
  // Speedbutton glyphs
  {$IFDEF NEW_ICONS}
  LoadGlyphFromRCDATA(FPrevYearBtn.Glyph, 'VpLArrows', 16, 24, 32);
  LoadGlyphFromRCDATA(FPrevMonthBtn.Glyph, 'VpLArrow', 16, 24, 32);
  LoadGlyphFromRCDATA(FNextMonthBtn.Glyph, 'VpRArrow', 16, 24, 32);
  LoadGlyphFromRCDATA(FNextYearBtn.Glyph, 'VpRArrows', 16, 24, 32);
  {$ELSE}
  FPrevYearBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPLEFTARROWS');
  FPrevMonthBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPLEFTARROW');
  FNextMonthBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPRIGHTARROW');
  FNextYearUpBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPRIGHTARROWS');
  {$ENDIF}

   { Set styles and initialize internal variables }
  {$IFDEF VERSION4}
//  DoubleBuffered := true;
  {$ENDIF}
  FShowEvents := true;
  FEventDayStyle := [];
  FShowEventTime := false;
  FDayNameStyle :=dsShort;
  FKBNavigate := true;

  mvDragging := false;
  mvMouseDownPoint := Point(0, 0);
  mvMouseDown := false;
  DragMode := dmManual;

  //  mvCreatingEditor := false;
  FSelectedDayColor := clRed;
  FDrawingStyle := ds3d;
  FColor := DEFAULT_COLOR;
  FLineColor := DEFAULT_LINECOLOR;
  FDate := Trunc(Now);
  FTimeFormat := tf12Hour;
  FDateLabelFormat := 'mmmm yyyy';
  FRightClickChangeDate := vpDefWVRClickChangeDate;
  FDaysMargin := 2;
  FMonthMargin := TEXT_MARGIN;

  { set up fonts and colors }
  FDayHeadAttr.Color := clBtnFace;

  { Assign default font to DayNumberFont and EventFont }
  FDayNumberFont := TVpFont.Create(AOwner);
  FDayNumberFont.Assign(Font);

  FEventFont := TVpFont.Create(AOwner);
  FEventFont.Assign(Font);

  FOffDayFontColor := clGray;
  FOffDayColor := OFF_COLOR;

  FHolidayAttr.Font.Assign(FDayNumberFont);

  FWeekendAttr.Font.Assign(FHolidayAttr.Font);

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

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

  { Popup menu }
  FDefaultPopup := TPopupMenu.Create(Self);
  FDefaultPopup.Name := 'default';
  InitializeDefaultPopup;
  Self.PopupMenu := FDefaultPopup;

  LoadLanguage;

  mvHookUp;
end;

destructor TVpMonthView.Destroy;
begin
  FHeadAttr.Free;
  FHolidayAttr.Free;
  FTodayAttr.Free;
  FDayHeadAttr.Free;
  FWeekendAttr.Free;
  FDayNumberFont.Free;
  FEventFont.Free;
  inherited;
end;

function TVpMonthView.BuildEventString(AEvent: TVpEvent;
  AShowEventTime, AStartTimeOnly: Boolean): String;
var
  timefmt: String;
  timeStr: String;
  descrStr: String;
  grp: TVpResourceGroup;
  res: TVpResource;
begin
  Result := '';
  if (AEvent = nil) or (Datastore = nil) or (Datastore.Resource = nil) then
    exit;

  timeStr := '';
  descrStr := '';
  if AShowEventTime then
  begin
    if AEvent.AllDayEvent then
      timeStr := RSAllDay
    else begin
      timeFmt := GetTimeFormatStr(TimeFormat);
      timeStr := FormatDateTime(timefmt, AEvent.StartTime);
      if not AStartTimeOnly then
        timeStr := timeStr + ' - ' + FormatDateTime(timeFmt, AEvent.EndTime);
    end;
  end;

  if AEvent.IsOverlayed then
  begin
    res := Datastore.Resources.GetResource(AEvent.ResourceID);
    grp := Datastore.Resource.Group;
    if (grp <> nil) then
      descrStr := Format('[%s]%s', [
        IfThen(odResource in grp.ShowDetails, res.Description, res.Description),
        IfThen(odEventDescription in grp.ShowDetails, ' ' + AEvent.Description)
      ]);
  end else
    descrStr := AEvent.Description;

  if (timeStr <> '') and (descrStr <> '') then
    Result := timeStr + ': ' + descrStr
  else if (timeStr <> '') then
    Result := timeStr
  else
    Result := descrStr;
end;

procedure TVpMonthView.LoadLanguage;
var
  item: TMenuItem;
begin
  for item in FDefaultPopup.Items do
    if item is TVpMenuItem then
      TVpMenuItem(item).Translate;
end;

procedure TVpMonthView.Invalidate;
begin
  inherited;
end;

function TVpMonthView.IsHoliday(ADate: TDate; out AHolidayName: String): Boolean;
begin
  AHolidayName := '';
  if Assigned(FOnHoliday) then
    FOnHoliday(Self, ADate, AHolidayName);
  Result := AHolidayName <> '';
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.mvPenChanged(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, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean);
var
  painter: TVpMonthViewPainter;
begin
//  mvPainting := true;
  painter := TVpMonthViewPainter.Create(Self, RenderCanvas);
  try
    painter.RenderToCanvas(RenderIn, Angle, Scale, RenderDate, StartLine,
      StopLine, UseGran, DisplayOnly);
  finally
    painter.Free;
//    mvPainting := false;
  end;
end;

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

procedure TVpMonthView.mvSpawnEventEditDialog(IsNewEvent: Boolean);
var
  AllowIt: Boolean;
  EventDlg : TVpEventEditDialog;
begin
  if DataStore = nil then 
    Exit;

  if (not IsNewEvent) and (not mvActiveEvent.CanEdit) then begin
    MessageDlg(RSCannotEditOverlayedEvent, mtInformation, [mbOk], 0);
    exit;
  end;

  AllowIt := false;
  if Assigned(FOwnerEditEvent) then
    FOwnerEditEvent(self, mvActiveEvent, IsNewEvent, DataStore.Resource, AllowIt)
  else begin
    EventDlg := TVpEventEditDialog.Create(nil);
    try
      EventDlg.DataStore := DataStore;
      EventDlg.TimeFormat := FTimeFormat;
      AllowIt := EventDlg.Execute(mvActiveEvent);
    finally
      EventDlg.Free;
    end;
  end;
  
  if AllowIt then begin
    mvActiveEvent.Changed := true;
    DataStore.PostEvents;
    if IsNewEvent and Assigned(FOnAddEvent) then
      FOnAddEvent(self, mvActiveEvent);
    if not IsNewEvent and Assigned(FOnModifyEvent) then
      FOnModifyEvent(self, mvActiveEvent);
  end else begin
    if IsNewEvent then begin
      DataStore.Resource.Schedule.DeleteEvent(mvActiveEvent);
      mvActiveEvent := nil;
    end;
    DataStore.PostEvents;
  end;
  Invalidate;
end;

procedure TVpMonthView.SpinButtonClick(Sender: TObject);
begin
  if Sender = FPrevYearBtn then
    Date := IncYear(Date, -1)
  else if Sender = FNextYearBtn then
    Date := IncYear(Date, +1)
  else if Sender = FPrevMonthBtn then
    Date := IncMonth(Date, -1)
  else if Sender = FNextMonthBtn then
    Date := IncMonth(Date, +1);
end;

procedure TVpMonthView.SetApplyCategoryInfos(AValue: Boolean);
begin
  if FApplyCategoryInfos <> AValue then
  begin
    FApplyCategoryInfos := AValue;
    Invalidate;
  end;
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;
    Invalidate;
  end;
end;

procedure TVpMonthView.SetLineColor(Value: TColor);
begin
  if FLineColor <> Value then begin
    FLineColor := Value;
    Invalidate
  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;

function TVpMonthView.IsStoredDateLabelFormat: Boolean;
begin
  Result := FDateLabelFormat <> 'mmmm yyyy';
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: TVpFont);
begin
  FDayNumberFont.Assign(Value);
  Invalidate;
end;

procedure TVpMonthView.SetDaysMargin(Value: Integer);
begin
  if Value <> FDaysMargin then
  begin
    FDaysMargin := Value;
    Invalidate;
  end;
end;

procedure TVpMonthView.SetEventFont(Value: TVpFont);
begin
  FEventFont.Assign(Value);
  Invalidate;
end;

procedure TVpMonthView.SetMonthMargin(Value: Integer);
begin
  if Value <> FMonthMargin then
  begin
    FMonthMargin := Value;
    Invalidate;
  end;
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;
  FPrevYearBtn.Parent := self;
  FPrevMonthBtn.Parent := self;
  FNextMonthBtn.Parent := self;
  FNextYearBtn.Parent := self;
end;

procedure TVpMonthView.DoEndDrag(Target: TObject; X, Y: Integer);
begin
  Unused(Target, X, Y);

  if ReadOnly or (not FAllowDragAndDrop) then
    Exit;
 {$IFNDEF LCL}
  TVpEventDragObject(Target).Free;
 {$ENDIF}
 // not needed for LCL: we use DragObjectEx !!
end;

procedure TVpMonthView.DoStartDrag(var DragObject: TDragObject);
{$IFDEF LCL}
var
  P, HotSpot: TPoint;
  EventName: string;
{$ENDIF}
begin
  if ReadOnly or not FAllowDragAndDrop then
    Exit;

  if mvActiveEvent <> nil then begin
    {$IFDEF LCL}
    GetCursorPos(P{%H-});
    P := TVpMonthView(Self).ScreenToClient(P);
    EventName := mvActiveEvent.Description;
    HotSpot := Point(P.X - Self.mvActiveEventRec.Left, P.Y - Self.mvActiveEventRec.Top);
    DragObject := TVpEventDragObject.CreateWithDragImages(Self as TControl,
      HotSpot, Self.mvActiveEventRec, EventName, FDragDropTransparent);
   {$ELSE}
    DragObject := DragObject := TVpEventDragObject.Create(Self);
   {$ENDIF}
    TVpEventDragObject(DragObject).Event := mvActiveEvent;
  end
  else
   {$IFDEF LCL}
    CancelDrag;
   {$ELSE}
    DragObject.Free;
   {$ENDIF}
end;

procedure TVpMonthView.DragDrop(Source: TObject; X, Y: Integer);
var
  Event: TVpEvent;
  i: Integer;
  P: TPoint;
  newDate, dateDiff: TDate;
begin
  if ReadOnly or (not FAllowDragAndDrop) then
    Exit;

  P := Point(X, Y);
  newDate := -1;
  for i := 0 to pred(Length(mvMonthdayArray)) do
    if PointInRect(P, mvMonthdayArray[i].Rec) then begin
      newDate := mvMonthdayArray[i].Date;
      break;
    end;
  if newDate = -1 then
    exit;

  Event := TVpEventDragObject(Source).Event;
  if Event <> nil then begin
    dateDiff := trunc(newDate) - trunc(Event.StartTime);
    Event.StartTime := newDate + frac(Event.StartTime);
    Event.EndTime := Event.EndTime + dateDiff;
    DataStore.PostEvents;
    Repaint;
  end;
end;

procedure TVpMonthView.DragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Unused(Source, X, State);

  Accept := false;
  if ReadOnly or (not FAllowDragAndDrop) then
    Exit;

  if (Y > mvDayHeadHeight) then
    Accept := true;
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)) then
      if (Assigned(FOnEventClick)) then
        FOnEventClick(self, mvActiveEvent);
  end;
end;

{$IFNDEF LCL}
procedure TVpMonthView.WMLButtonDblClick(var Msg: TWMLButtonDblClk);
{$ELSE}
procedure TVpMonthView.WMLButtonDblClick(var Msg: TLMLButtonDblClk);
{$ENDIF}
var
  startTime, endTime: TDateTime;
  newevent: Boolean;
begin
  inherited;

  mvMouseDownPoint := Point(0, 0);
  mvMouseDown := false;
  mvDragging := false;

  // 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));
    newEvent := not SelectEventAtCoord(Point(Msg.XPos, Msg.YPos));
    if newEvent then mvActiveEvent := nil;

    { Did the mouse click land on an event? }
    if Assigned(FOnEventDblClick) then begin
      if SelectEventAtCoord(Point(Msg.XPos, Msg.YPos)) then
        FOnEventDblClick(self, mvActiveEvent);
    end else
    if mvActiveEvent <> nil then begin
      mvSpawnEventEditDialog(newevent);
    end else
    if (DataStore.Resource <> nil) then begin
      { otherwise, we must want to create a new event }
      startTime := trunc(Date) + 0.5; { default to 12:00 noon }
      endTime := startTime + 30 / MinutesInDay; { StartTime + 30 minutes }
      mvActiveEvent := DataStore.Resource.Schedule.AddEvent(
        DataStore.GetNextID('Events'),
        startTime,
        endTime
      );
      { edit this new event }
      mvSpawnEventEditDialog(True);  // true = new event
    end;
  end;
end;

{$IFNDEF LCL}
procedure TVpMonthView.WMSetFocus(var Msg: TWMSetFocus);
{$ELSE}
procedure TVpMonthView.WMSetFocus(var Msg: TLMSetFocus);
{$ENDIF}
begin
  Unused(Msg);
  // 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}
begin
  inherited;
  if (PopupMenu = FDefaultPopup) then begin
    if not Focused then
      SetFocus;
    if FRightClickChangeDate then
      mvSetDateByCoord (Point (Msg.XPos, Msg.YPos));
  end;
end;


{ Hint support }

procedure TVpMonthView.ShowHintWindow(APoint: TPoint; ADate: TDateTime);
var
  txt, s: String;
  i: Integer;
  event: TVpEvent;
  list: TList;
  holiday: String = '';
  todayDate: TDate;
begin
  HideHintWindow;

  if (csDesigning in ComponentState) then
    exit;

  case FHintMode of
    hmPlannerHint:
      begin
        if (ADate = 0) or (Datastore = nil) or (Datastore.Resource = nil) then
          exit;
        txt := '';
        // If the date is a holiday we put the holidayname at the top
        IsHoliday(ADate, holiday);
        // Collect all events of this day and add them separated by line feeds to
        // the hint string (txt).
        list := TList.Create;
        try
          Datastore.Resource.Schedule.EventsByDate(ADate, List);
          for i:=0 to list.Count-1 do begin
            event := TVpEvent(list[i]);
            s := BuildEventString(event, true, false);
            txt := IfThen(txt = '', s, txt + LineEnding  + s);
          end;
        finally
          list.Free;
        end;
        // If we have any events then we put the current date at the top.
        todayDate := SysUtils.Date();
        if (txt = '') and (holiday = '') and (ADate = todayDate) then
          txt := RSToday + LineEnding + FormatDateTime('ddddd', ADate)
        else
        if (txt <> '') or (holiday <> '') then begin
          if (txt = '') and (holiday <> '') then
            txt := FormatDateTime('ddddd', ADate) + LineEnding + holiday
          else begin
            txt := LineEnding + txt;
            if holiday <> '' then
              txt := holiday + LineEnding + txt;
            txt := FormatDateTime('ddddd', ADate) + LineEnding + txt;
            if ADate = todayDate then
              txt := RSToday + LineEnding + txt;
          end;
        end;
      end;
    hmComponentHint:
      txt :=  FComponentHint;
  end;
  if (txt <> '') then begin
    Hint := txt;
    Application.Hint := txt;
    Application.ActivateHint(ScreenToClient(APoint), true);
  end else
  if FHintMode = hmPlannerHint then begin
    Hint := '';
    Application.Hint := '';
  end;
end;

procedure TVpMonthView.HideHintWindow;
begin
  Application.CancelHint;
end;

procedure TVpMonthView.SetHint(const AValue: TTranslateString);
begin
  inherited;
  if FHintMode = hmComponentHint then
    FComponentHint := AValue;
end;


{ PopupMenu }

function TVpMonthView.GetPopupMenu: TPopupMenu;
begin
  if FExternalPopup = nil then
    Result := FDefaultPopup
  else
    Result := FExternalPopup;
end;

procedure TVpMonthView.SetPopupMenu(AValue: TPopupMenu);
begin
  if (AValue = nil) or (AValue = FDefaultPopup) then
    FExternalPopup := nil
  else
    FExternalPopup := AValue;
end;

procedure TVpMonthView.InitializeDefaultPopup;
var
  NewItem: TVpMenuItem;
begin
  FDefaultPopup.Items.Clear;
  
  if RSToday <> '' then begin
    NewItem := TVpMenuItem.Create(Self);
    NewItem.Kind := mikToday;
    NewItem.OnClick := PopupToday;
    FDefaultPopup.Items.Add(NewItem);
  end;

  NewItem := TVpMenuItem.Create(Self);
  NewItem.Kind := mikSeparator;
  FDefaultPopup.Items.Add(NewItem);

  if RSNextMonth <> '' then begin
    NewItem := TVpMenuItem.Create(Self);
    NewItem.Kind := mikNextMonth;
    NewItem.OnClick := PopupNextMonth;
    FDefaultPopup.Items.Add(NewItem);
  end;

  if RSPrevMonth <> '' then begin
    NewItem := TVpMenuItem.Create(Self);
    NewItem.Kind := mikPrevMonth;
    NewItem.OnClick := PopupPrevMonth;
    FDefaultPopup.Items.Add(NewItem);
  end;

  NewItem := TVpMenuItem.Create(Self);
  NewItem.Kind := mikSeparator;
  FDefaultPopup.Items.Add(NewItem);

  if RSNextYear <> '' then begin
    NewItem := TVpMenuItem.Create(Self);
    NewItem.Kind := mikNextYear;
    NewItem.OnClick := PopupNextYear;
    FDefaultPopup.Items.Add(NewItem);
  end;

  if RSPrevYear <> '' then begin
    NewItem := TVpMenuItem.Create(Self);
    NewItem.Kind := mikPrevYear;
    NewItem.OnClick := PopupPrevYear;
    FDefaultPopup.Items.Add(NewItem);
  end;
  
  NewItem := TVpMenuItem.Create(Self);     
  NewItem.Kind := mikSeparator;
  FDefaultPopup.Items.Add(NewItem);
  
  if RSCustomDate <> '' then begin          
    NewItem := TVpMenuItem.Create(Self);
    NewItem.Kind := mikCustomDate;
    NewItem.OnClick := PopupCustomDate;
    NewItem.Tag := 0;
    FDefaultPopup.Items.Add(NewItem);
  end;      
end;

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

procedure TVpMonthView.PopupNextMonth(Sender: TObject);
begin
  Date := IncMonth(Date, +1);
end;

procedure TVpMonthView.PopupPrevMonth(Sender: TObject);
begin
  Date := IncMonth(Date, -1);
end;

procedure TVpMonthView.PopupNextYear(Sender: TObject);
begin
  Date := IncYear(Date, +1);
end;

procedure TVpMonthView.PopupPrevYear(Sender: TObject);
begin
  Date := IncYear(Date, -1);
end;

procedure TVpMonthView.PopupCustomDate(Sender: TObject);
var
  d: TDate;
begin
  d := Date;
  if DateDialog(RSSelectCustomDate, d) then
    Date := d;
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(APoint: TPoint);
var
  I: Integer;
begin
  for I := 0 to pred(Length(mvMonthdayArray)) do
    if PointInRect(APoint, mvMonthdayArray[I].Rec) then 
    begin
      Date := mvMonthdayArray[I].Date;
      break;
    end;
end;

function TVpMonthView.GetDateAtCoord(APoint: TPoint): TDateTime;
var
  i: Integer;
begin
  for i:=0 to High(mvMonthDayArray) do
    if PointInRect(APoint, mvMonthDayArray[i].Rec) then begin
      Result := mvMonthDayArray[i].Date;
      exit;
    end;
  Result := 0;
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:
        SpinButtonClick(FNextMonthBtn);
      VK_PRIOR:
        SpinButtonClick(FPrevMonthBtn);
      VK_LEFT:
        if ssCtrl in Shift then
          SpinButtonClick(FPrevMonthBtn)
        else
          Date := Date - 1;
      VK_RIGHT:
        if ssCtrl in Shift then
          SpinButtonClick(FNextMonthBtn)
        else
          Date := Date + 1;
      VK_HOME:
        begin
          DecodeDate(Date, Y, M, D);
          if D = 1 then
            SpinButtonClick(FPrevMonthBtn)
          else
            Date := EncodeDate(Y, M, 1);
        end;
      VK_END:
        begin
          DecodeDate(Date, Y, M, D);
          if D = DaysInAMonth(Y, M) then begin
            if M = 12 then begin
              M := 1;
              Inc(Y);
            end else
              Inc(M);
          end;
          Date := EncodeDate(Y, M, DaysInAMonth(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.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X,Y: Integer);
begin
  inherited;

  if not Focused then SetFocus;

  { Left button }
  if Button = mbLeft then
  begin
    mvMouseDown := true;
    mvMouseDownPoint := Point(X, Y);

    if (Y > mvDayHeadHeight) then
    begin
      { The mouse click landed inside the client area }
//      oldDate := FDate;
      mvSetDateByCoord(mvMouseDownPoint);
  (*
      { We must repaint the control here, before evaluation of the click on the
        events, because if the day has changed by wvSetDateByCoord then events
        will have different indexes in the event array; and index positions are
        evaluated during painting. }
      if oldDate <> FDate then
        Paint;

      { If an active event was clicked, then enable the click timer.  If the
        item is double clicked before the click timer fires, then the edit
        dialog will appear, otherwise the in-place editor will appear. }
      if EventAtCoord(wvMouseDownPoint) then
        wvClickTimer.Enabled := true;
        *)
    end;
  end;
                 (*
  { Right button }
  if Button = mbRight then
  begin
    if not Assigned(PopupMenu) then
      exit;

    { The mouse click landed inside the client area }
    wvSetDateByCoord(Point(X, Y));
    EventAtCoord(Point(X, Y));
    wvClickTimer.Enabled := false;

    if not Assigned(ActiveEvent) then begin
      for i := 0 to FDefaultPopup.Items.Count - 1 do
        if (FDefaultPopup.Items[i].Tag = 1) or (ReadOnly) then
          FDefaultPopup.Items[i].Enabled := False;
    end else begin
      for i := 0 to FDefaultPopup.Items.Count - 1 do
        FDefaultPopup.Items[i].Enabled := True;
    end;
  end;
  *)
end;

procedure TVpMonthView.MouseEnter;
begin
  FMouseDate := 0;
end;

procedure TVpMonthView.MouseLeave;
begin
  HideHintWindow;
end;

procedure TVpMonthView.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  day: TDateTime;
begin
  inherited MouseMove(Shift, X, Y);

  if (mvActiveEvent <> nil) and (not ReadOnly) then begin
    if (not mvDragging) and mvMouseDown and
       ((mvMouseDownPoint.x <> x) or (mvMouseDownPoint.y <> y)) and
       mvActiveEvent.CanEdit
    then begin
      mvDragging := true;
      //mvClickTimer.Enabled := false;
      BeginDrag(true);
    end;
  end;

  if ShowHint then
  begin
    day := GetDateAtCoord(Point(X, Y));
    if day = 0 then
      HideHintWindow
    else if FMouseDate <> day then begin
      FMouseDate := day;
      ShowHintWindow(Point(X, Y), day);
    end;
  end;
end;

procedure TVpMonthView.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if Button = mbLeft then begin
    mvMouseDownPoint := Point(0, 0);
    mvMouseDown := false;
    mvDragging := false;
  end;
end;

procedure TVpMonthView.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FExternalPopup) then
    FExternalPopup := nil;
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;

{$IF VP_LCL_SCALING <> 0}
procedure TVpMonthView.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
  const AXProportion, AYProportion: Double);
begin
  inherited;
  if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
  begin
    FDaysMargin := round(FDaysMargin * AXProportion);
    FMonthMargin := round(FMonthMargin * AXProportion);
  end;
end;
{$IFEND}

{$IF VP_LCL_SCALING = 2}
procedure TVpMonthView.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin
  inherited;
  DoFixDesignFontPPI(DayHeadAttributes.Font, ADesignTimePPI);
  DoFixDesignFontPPI(DayNumberFont, ADesignTimePPI);
  DoFixDesignFontPPI(EventFont, ADesignTimePPI);
  DoFixDesignFontPPI(HeadAttributes.Font, ADesignTimePPI);
  DoFixDesignFontPPI(HolidayAttributes.Font, ADesignTimePPI);
  DoFixDesignFontPPI(TodayAttributes.Font, ADesignTimePPI);
  DoFixDesignFontPPI(WeekendAttributes.Font, ADesignTimePPI);
end;

procedure TVpMonthView.ScaleFontsPPI(const AToPPI: Integer;
  const AProportion: Double);
begin
  inherited;
  DoScaleFontPPI(DayHeadAttributes.Font, AToPPI, AProportion);
  DoScaleFontPPI(DayNumberFont, AToPPI, AProportion);
  DoScaleFontPPI(EventFont, AToPPI, AProportion);
  DoScaleFontPPI(HeadAttributes.Font, AToPPI, AProportion);
  DoScaleFontPPI(HolidayAttributes.Font, AToPPI, AProportion);
  DoScaleFontPPI(TodayAttributes.Font, AToPPI, AProportion);
  DoScaleFontPPI(WeekendAttributes.Font, AToPPI, AProportion);
end;
{$ELSEIF VP_LCL_SCALING = 1}
procedure TVpMonthView.ScaleFontsPPI(const AProportion: Double);
begin
  inherited;
  DoScaleFontPPI(DayHeadAttributes.Font, AProportion);
  DoScaleFontPPI(DayNumberFont, AProportion);
  DoScaleFontPPI(EventFont, Aproportion);
  DoScaleFontPPI(HeadAttributes.Font, AProportion);
  DoScaleFontPPI(HolidayAttributes.Font, AProportion);
  DoScaleFontPPI(TodayAttributes.Font, AProportion);
  DoScaleFontPPI(WeekendAttributes.Font, AProportion);
end;
{$ENDIF}

end.