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

{*********************************************************}
{*                 VPDAYVIEW.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 *****                                              *}

{
  This unit contains everything needed for the TVpDayView component (including
  the inline editor).

  The rendering of Visual PlanIt components is a bit involved.  The component's
  Paint method calls RenderToCanvas.  The RenderToCanvas method of each of
  the visual VisualPlanIt controls is repsonsible both for drawing to the
  screen (both design and run time) as well as printing.  In the case of
  printing, the component needs to render itself to an arbitrary rectangle
  and possibly rotated (for the screen the rectangle is the ClientRect
  and the rotation angle is always zero).  To achieve that goal, the
  functions in VpCanvasUtils are used to go between the rendering of the
  control and the TCanvas that it needs to render to.

  The rendering of the DayView is complex.  Look at the other components
  (MonthView and TaskList are probably the best places to start) before making
  changes to the DayView rendering.

  The in place editor is currently based off the TCustomEdit class.  This can
  probably be changed to use a TCustomMemo as its base class.  This will
  provide multi-line editing capabilities.
}

{$I vp.inc}

{.$DEFINE DEBUGDV} { Causes the DayView to operate in debug mode }

unit VpDayView;

interface

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

type
  TVpLineRec = packed record
    Hour: TVpHours;
    Minute: Integer;
    Time: TDateTime;
    Rec: TRect;
  end;

  TVpColRec = packed record
    Rec: TRect;
    Date: TDateTime;
  end;

type
  TVpLineArray = array of TVpLineRec;

type
  TVpLineMatrix = array of TVpLineArray;
  TVpColRectArray = array of TVpColRec;

  TVpDVIconData = record                                                 
    Show: Boolean;
    Bitmap: TBitmap;
  end;

  TVpDVIconTypes = (itAlarm, itRecurring, itCategory, itCustom);

  TVpDVIcons = array [itAlarm..itCustom] of TVpDVIconData;

  TVpOnDVBeforeDrawEvent = procedure (Sender: TObject; Event: TVpEvent;
    AActive: Boolean; ACanvas: TCanvas; AGutterRect, AEventRect, AIconRect: TRect) of object;

  TVpOnDVAfterDrawEvent = procedure (Sender: TObject; Event: TVpEvent;
    AActive: Boolean; ACanvas: TCanvas; AGutterRect, AEventRect, AIconRect: TRect) of object;

  TVpOnDVDrawIcons = procedure (Sender: TObject; Event: TVpEvent;
    var Icons: TVpDVIcons) of object;

  TVpDVWrapStyle = (wsNone, wsIconFlow, wsNoFlow);

  { Forward Declarations }
  TVpDayView = class;

  TVpDvInplaceEdit = class(TCustomEdit)
  protected{private}
    procedure CreateParams(var Params: TCreateParams); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    {$IFNDEF LCL}
    procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
    {$ELSE}
    procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS;
    {$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TVpRHAttributes = class(TPersistent)
  protected{ private }
    FOwner: TVpDayView;
    FColor: TColor;
    FHourFont: TVpFont;
    FMinuteFont: TVpFont;
    procedure SetColor(const Value: TColor);
    procedure SetHourFont(Value: TVpFont);
    procedure SetMinuteFont(Value: TVpFont);
  public
    constructor Create(AOwner: TVpDayView);
    destructor Destroy; override;
    property Owner: TVpDayView read FOwner;
  published
    property HourFont: TVpFont read FHourFont write SetHourFont;
    property MinuteFont: TVpFont read FMinuteFont write SetMinuteFont;
    property Color: TColor read FColor write SetColor;
  end;

  TVpAllDayEventAttributes = class(TPersistent)
  protected {Private}
    FOwner: TWinControl;
    FBackgroundColor: TColor;
    FEventBackgroundColor: TColor;
    FEventBorderColor: TColor;
    FFont: TVpFont;
  public
    constructor Create(AOwner: TWinControl);
    destructor Destroy; override;
    procedure SetBackGroundColor(Value: TColor);
    procedure SetEventBackgroundColor(Value: TColor);
    procedure SetFont(Value: TVpFont);
    procedure SetEventBorderColor(Value: TColor);
  published
    property BackgroundColor: TColor
      read FBackgroundColor write SetBackGroundColor;
    property EventBorderColor: TColor
      read FEventBorderColor write SetEventBorderColor;
    property EventBackgroundColor: TColor
      read FEventBackgroundColor write SetEventBackgroundColor;
    property Font: TVpFont
      read FFont write SetFont;
  end;

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

  TVpDayViewIconAttributes = class(TPersistent)
    private
      FShowAlarmBitmap: Boolean;
      FShowCategoryBitmap: Boolean;
      FShowRecurringBitmap: Boolean;
      FAlarmBitmap: TBitmap;
      FRecurringBitmap: TBitmap;
      FAlarmImageIndex: TImageIndex;
      FRecurringImageIndex: TImageIndex;
      FShowInPrint: Boolean;
      FOwner: TVpLinkableControl;

    protected
      procedure SetAlarmBitmap(v: TBitmap);
      procedure SetAlarmImageIndex(v: TImageIndex);
      procedure SetRecurringBitmap(v: TBitmap);
      procedure SetRecurringImageIndex(v: TImageIndex);
      procedure SetShowAlarmBitmap(const v: Boolean);
      procedure SetShowCategoryBitmap(const v: Boolean);
      procedure SetShowRecurringBitmap(const v: Boolean);

    public
      constructor Create(AOwner: TVpLinkableControl);
      destructor Destroy; override;

    published
      property AlarmBitmap: TBitmap
        read FAlarmBitmap write SetAlarmBitmap;
      property AlarmImageIndex: TImageIndex
        read FAlarmImageIndex write SetAlarmImageIndex default -1;
      property RecurringBitmap: TBitmap
        read FRecurringBitmap write SetRecurringBitmap;
      property RecurringImageIndex: TImageIndex
        read FRecurringImageIndex write SetRecurringImageIndex default -1;
      property ShowAlarmBitmap: Boolean
        read FShowAlarmBitmap write SetShowAlarmBitmap default True;
      property ShowCategoryBitmap : Boolean
        read FShowCategoryBitmap write SetShowCategoryBitmap default True;
      property ShowRecurringBitmap : Boolean
        read FShowRecurringBitmap write SetShowRecurringBitmap default True;
      property ShowInPrint: Boolean
        read FShowInPrint write FShowInPrint default True;
  end;

  { TVpDayView }

  TVpDayView = class(TVpLinkableControl)
  private
    FComponentHint: TTranslateString;
    FHintMode: TVpHintMode;
    FMouseEvent: TVpEvent;
    FOnHoliday: TVpHolidayEvent;

  protected{ private }
    FGranularity: TVpGranularity;
    FColumnWidth: Integer;
    FColor: TColor;
    FLineColor: TColor;
    FDefTopHour: TVpHours;
    FTopHour: TVpHours;
    FDateLabelFormat: string;
    FShowResourceName: Boolean;
    FTopLine: Integer;
    FActiveRow: Integer;
    FActiveCol: Integer;
    FActiveEvent: TVpEvent;
    FGutterWidth: Integer;
    FDefaultPopup: TPopupMenu;
    FLineCount: Integer;
    FVisibleLines: Integer;
    FTimeFormat: TVpTimeFormat;
    FDrawingStyle: TVpDrawingStyle;
    FTimeSlotColors: TVpTimeSlotColor;
    FRowHeadAttr: TVpRHAttributes;
    FHeadAttr: TVpCHAttributes;
    FAllDayEventAttr: TVpAllDayEventAttributes;
    FDisplayDate: TDateTime;
    FScrollBars: TScrollStyle;
    FIconAttributes: TVpDayViewIconAttributes;
    FWrapStyle: TVpDVWrapStyle;
    FDotDotDotColor: TColor;
    FShowEventTimes: Boolean;
    FAllowInplaceEdit: Boolean;
    FDragDropTransparent: Boolean;
    FAllowDragAndDrop: Boolean;
    FNumDays: Integer;
    FIncludeWeekends: Boolean;
    FRowLinesStep: Integer;
    FShowNavButtons: Boolean;
    FFixedDate: Boolean;
    FCustomRowHeight: Integer;
    FSimpleRowTime: Boolean;
    { event variables }
    FOwnerDrawRowHead: TVpOwnerDrawRowEvent;
    FOwnerDrawCells: TVpOwnerDrawRowEvent;
    FOwnerDrawColHead: TVpOwnerDrawEvent;
    FBeforeEdit: TVpBeforeEditEvent;
    FAfterEdit: TVpAfterEditEvent;
    FOwnerEditEvent: TVpEditEvent;
    FOnDrawIcons: TVpOnDVDrawIcons;
    FOnBeforeDrawEvent: TVpOnDVBeforeDrawEvent;
    FOnAfterDrawEvent: TVpOnDVAfterDrawEvent;
    FOnAddEvent: TVpOnAddNewEvent;
    { internal variables }
    dvClickTimer: TTimer;
    dvLoaded: Boolean;
    dvInLinkHandler: Boolean;
    dvRowHeight: Integer;
    dvColHeadHeight: Integer;
    dvRowHeadWidth: Integer;
    dvClientVArea: Integer;
    dvMouseDownPoint: TPoint;
    dvMouseDown: Boolean;
    dvEndingEditing: Boolean;
    dvDragging: Boolean;
    dvDragStartTime: TDateTime;

    { Nav Buttons }
    dvDayUpBtn: TSpeedButton;
    dvDayDownBtn: TSpeedButton;
    dvTodayBtn: TSpeedButton;
    dvWeekUpBtn: TSpeedButton;
    dvWeekDownBtn: TSpeedButton;

    dvLineMatrix: TVpLineMatrix;
    dvColRectArray: TVpColRectArray;
    dvEventArray: TVpEventArray;
    dvActiveEventRec: TRect;
    dvActiveIconRec: TRect;
    dvInPlaceEditor: TVpDvInPlaceEdit;
    dvCreatingEditor: Boolean;
    { the granularity based time increment for each row }
    dvTimeIncSize: double;
    dvPainting: Boolean;
    dvVScrollDelta: Integer;
    dvHotPoint: TPoint;

    { property methods }
    function GetLastVisibleDate: TDateTime;
    function GetRealNumDays(WorkDate: TDateTime) : Integer;
    procedure SetDrawingStyle(Value: TVpDrawingStyle);
    procedure SetColor(Value: TColor);
    procedure SetLineColor(Value: TColor);
    procedure SetTopHour(Value: TVpHours);
    procedure SetTopLine(Value: Integer);
    procedure SetDateLabelFormat(Value: string);
    procedure SetGutterWidth(Value: Integer);
    procedure SetDefTopHour(Value: TVpHours);
    procedure SetGranularity(Value: TVpGranularity);
    procedure SetTimeFormat(Value: TVpTimeFormat);
    procedure SetNumDays(Value: Integer);
    procedure SetIncludeWeekends(Value: Boolean);
    procedure SetDisplayDate(Value: TDateTime);
    procedure SetVScrollPos;
    procedure SetCustomRowHeight(Value: Integer);
    procedure SetRowLinesStep(Value: Integer);
    procedure SetShowNavButtons(Value: Boolean);
    procedure SetShowResourceName(Value: Boolean);
    procedure SetSimpleRowTime(Value: Boolean);
    procedure SetActiveRow(Value: Integer);
    procedure SetActiveCol(Value: Integer);
    procedure SetWrapStyle(const v: TVpDVWrapStyle);
    procedure SetDotDotDotColor(const v: TColor);
    procedure SetShowEventTimes(Value: Boolean);

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

    { Hints }
    procedure ShowHintWindow(APoint: TPoint; AEvent: TVpEvent);
    procedure HideHintWindow;
    procedure SetHint(const AValue: TTranslateString); override;
    procedure SetHintMode(const AValue: TVpHintMode);

    { Popup }
    procedure PopupAddEvent(Sender: TObject);
    procedure PopupAddFromICalFile(Sender: TObject);
    procedure PopupDeleteEvent(Sender: TObject);
    procedure PopupEditEvent(Sender: TObject);
    procedure PopupToday(Sender: TObject);
    procedure PopupTomorrow(Sender: TObject);
    procedure PopupYesterday(Sender: TObject);
    procedure PopupNextDay(Sender: TObject);
    procedure PopupPrevDay(Sender: TObject);
    procedure PopupNextWeek(Sender: TObject);
    procedure PopupPrevWeek(Sender: TObject);
    procedure PopupNextMonth(Sender: TObject);
    procedure PopupPrevMonth(Sender: TObject);
    procedure PopupNextYear(Sender: TObject);
    procedure PopupPrevYear(Sender: TObject);
    procedure PopupPickResourceGroupEvent(Sender: TObject);
    procedure PopupDropdownEvent(Sender: TObject);
    procedure InitializeDefaultPopup;

    { internal methods }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    function dvCalcRowHeight(Scale: Extended; UseGran: TVpGranularity): Integer;
    function dvCalcVisibleLines(RenderHeight, ColHeadHeight, ARowHeight: Integer;
      Scale: Extended; StartLine, StopLine: Integer): Integer;
    function dvCalcColHeadHeight(Scale: Extended): Integer;
    procedure dvEditInPlace(Sender: TObject);
    procedure dvHookUp;
    procedure dvNavButtonsClick(Sender: TObject);
    procedure dvPopulate;
    procedure dvScrollVertical(Lines: Integer);
    procedure dvSpawnEventEditDialog(IsNewEvent: Boolean);
    procedure dvSetActiveRowByCoord(Pnt: TPoint; Sloppy: Boolean);
    procedure dvSetActiveColByCoord(Pnt: TPoint);
    procedure EditEvent;
    function EditEventAtCoord(APoint: TPoint): Boolean;
    procedure EndEdit(Sender: TObject);
    function GetEventAtCoord(APoint: TPoint): TVpEvent;
    function GetEventRect(AEvent: TVpEvent): TRect;
    procedure SetActiveEventByCoord(APoint: TPoint);
    procedure SetTimeIntervals(UseGran: TVpGranularity);

    { inherited methods }
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Loaded; 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 Paint; override;

    { message handlers }
    procedure VpDayViewInit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); message Vp_DayViewInit;
    {$IFNDEF LCL}
    procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
    procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
    procedure WMEraseBackground (var Msg : TWMERASEBKGND);   // ??? wp: missing "message WM_ERASEBKGND"?
    procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
    {$ELSE}
    function  DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
    function  DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function  DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    procedure WMSize(var Msg: TLMSize); message LM_SIZE;
    procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL;
    procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS;
    procedure WMEraseBackground(var Msg: TLMERASEBKGND);  message LM_ERASEBKGND;
    procedure WMLButtonDblClk(var Msg: TLMLButtonDblClk); message LM_LBUTTONDBLCLK;
    {$ENDIF}

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function BuildEventString(AEvent: TVpEvent; UseAsHint: Boolean): String;
    procedure DeleteActiveEvent(Verify: Boolean);
    procedure DragDrop(Source: TObject; X, Y: Integer); override;
    procedure Invalidate; override;
    function IsHoliday(ADate: TDate; out AHolidayName: String): Boolean;
    procedure LoadLanguage;
    procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType;
      const Value: Variant); override;
    procedure EditSelectedEvent(IsNewEvent: Boolean = false);

    function GetControlType: TVpItemType; override;
    procedure AutoScaledPaintToCanvas(PaintCanvas: TCanvas; PaintTo: TRect;
      Angle: TVpRotationAngle; RenderDate: TDateTime; StartLine, StopLine: Integer;
      UseGran: TVpGranularity);
    procedure PaintToCanvas (ACanvas: TCanvas; ARect: TRect; Angle: TVpRotationAngle;
      ADate: TDateTime; StartHour, EndHour: TVpHours; UseGran: TVpGranularity);
    procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
      Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
      StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); override;

    {$IF VP_LCL_SCALING = 2}
    procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
    {$ELSE}
    {$IF VP_LCL_SCALING = 1}
    procedure ScaleFontsPPI(const AProportion: Double); override;
    {$ENDIF}
    {$ENDIF}

    property ActiveEvent: TVpEvent read FActiveEvent write FActiveEvent;
    property TopHour: TVpHours read FTopHour write SetTopHour;
    property TopLine: Integer read FTopLine write SetTopLine;
    property LineCount: Integer read FLineCount;
    property ActiveRow: Integer read FActiveRow write SetActiveRow;
    property ActiveCol: Integer read FActiveCol write SetActiveCol;
    property Date: TDateTime read FDisplayDate write SetDisplayDate;
    property LastVisibleDate: TDateTime read GetLastVisibleDate;
    property VisibleLines: Integer read FVisibleLines;

  published
    property Align;
    property Anchors;
   {$IFDEF LCL}
    property BorderSpacing;
   {$ENDIF}
    property Constraints;
    property ReadOnly;
    property TabStop;
    property TabOrder;
    property Font;
    property AllDayEventAttributes: TVpAllDayEventAttributes read FAllDayEventAttr write FAllDayEventAttr;
    property AllowDragAndDrop: Boolean read FAllowDragAndDrop write FAllowDragAndDrop default false;
    property AllowInplaceEditing: Boolean read FAllowInplaceEdit write FAllowInplaceEdit default true;
    property DotDotDotColor: TColor read FDotDotDotColor write SetDotDotDotColor default clBlack;
    property ShowEventTimes: Boolean read FShowEventTimes write SetShowEventTimes default true;
    property DragDropTransparent: Boolean read FDragDropTransparent write FDragDropTransparent default false;
    property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle stored True;
    property TimeSlotColors: TVpTimeSlotColor read FTimeSlotColors write FTimeSlotColors;
    property HeadAttributes: TVpCHAttributes read FHeadAttr write FHeadAttr;
    property RowHeadAttributes: TVpRHAttributes read FRowHeadAttr write FRowHeadAttr;
    property IconAttributes: TVpDayViewIconAttributes read FIconAttributes write FIconAttributes;
    property Color: TColor read FColor write SetColor;
    property OwnerDrawRowHeader: TVpOwnerDrawRowEvent read FOwnerDrawRowHead write FOwnerDrawRowHead;
    property OwnerDrawColHeader: TVpOwnerDrawEvent read FOwnerDrawColHead write FOwnerDrawColHead;
    property OwnerDrawCells: TVpOwnerDrawRowEvent read FOwnerDrawCells write FOwnerDrawCells;
    property ShowResourceName: Boolean read FShowResourceName write SetShowResourceName;
    property LineColor: TColor read FLineColor write SetLineColor;
    property GutterWidth: Integer read FGutterWidth write SetGutterWidth;
    property DateLabelFormat: string read FDateLabelFormat write SetDateLabelFormat;
    Property Granularity: TVpGranularity read FGranularity write SetGranularity;
    property DefaultTopHour: TVpHours read FDefTopHour write SetDefTopHour;
    property TimeFormat: TVpTimeFormat read FTimeFormat write SetTimeFormat;
    property IncludeWeekends: Boolean read FIncludeWeekends write SetIncludeWeekends default True;
    property NumDays: Integer read FNumDays write SetNumDays default 1;
    property WrapStyle: TVpDVWrapStyle read FWrapStyle Write SetWrapStyle default wsIconFlow;
    property HintMode: TVpHintMode read FHintMode write SetHintMode default hmPlannerHint;
    property ShowNavButtons: Boolean read FShowNavButtons write SetShowNavButtons default true;
    property FixedDate: Boolean read FFixedDate write FFixedDate default false;
    property RowHeight: Integer read FCustomRowHeight write SetCustomRowHeight default 0;
    property RowLinesStep: Integer read FRowLinesStep write SetRowLinesStep default 1;
    property SimpleRowTime: Boolean read FSimpleRowTime write SetSimpleRowTime default false;
    {events}
    property AfterEdit: TVpAfterEditEvent read FAfterEdit write FAfterEdit;
    property BeforeEdit: TVpBeforeEditEvent read FBeforeEdit write FBeforeEdit;
    property OnAddEvent: TVpOnAddNewEvent read FOnAddEvent write FOnAddEvent;
    property OnAfterDrawEvent: TVpOnDVAfterDrawEvent read FOnAfterDrawEvent write FOnAfterDrawEvent;
    property OnBeforeDrawEvent: TVpOnDVBeforeDrawEvent read FOnBeforeDrawEvent write FOnBeforeDrawEvent;
    property OnDrawIcons: TVpOnDVDrawIcons read FOnDrawIcons Write FOnDrawIcons;
    property OnHoliday: TVpHolidayEvent read FOnHoliday write FOnHoliday;
    property OnOwnerEditEvent: TVpEditEvent read FOwnerEditEvent write FOwnerEditEvent;
    property OnClick;
  end;

implementation

uses
 {$IFDEF LCL}
  DateUtils,
 {$ENDIF}
  SysUtils, StrUtils, Math, Dialogs,
  VpEvntEditDlg, VpDayViewPainter, VpICal;

(*****************************************************************************)
{ TVpTGInPlaceEdit }

constructor TVpDvInPlaceEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  TabStop := False;
  BorderStyle := bsNone;
//  DoubleBuffered := False;
end;
{=====}

procedure TVpDvInPlaceEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style{$IFNDEF LCL} or ES_MULTILINE{$ENDIF};
end;
{=====}

procedure TVpDvInPlaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// !!!! WARNING
// !!!!
// !!!! Experimental change below.  Verify this change before releasing
// !!!! VP 1.03
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
begin
  case Key of
    VK_RETURN:
      begin
        Key := 0;
        TVpDayView(Owner).EndEdit(Self);
      end;

    VK_UP:
      begin
        Key := 0;
        TVpDayView(Owner).ActiveRow := TVpDayView(Owner).ActiveRow - 1;
// !!!! TVpDayView(Owner).EndEdit(Self); !!!!  !!!!!!!!!!!!!!!!!!!!!!!!!
      end;

    VK_DOWN:
      begin
        Key := 0;
        TVpDayView(Owner).ActiveRow := TVpDayView(Owner).ActiveRow + 1;
// !!!! TVpDayView(Owner).EndEdit(Self); !!!!  !!!!!!!!!!!!!!!!!!!!!!!!!
      end;

    VK_ESCAPE:
      begin
        Key := 0;
        Hide;
        TVpDayView(Owner).SetFocus;
      end;

    else
      inherited;
  end;
end;
{=====}

{$IFNDEF LCL}
procedure TVpDvInPlaceEdit.WMKillFocus(var Msg: TWMKillFocus);
{$ELSE}
procedure TVpDvInPlaceEdit.WMKillFocus(var Msg: TLMKillFocus);
{$ENDIF}
begin
  Unused(Msg);
  TVpDayView(Owner).EndEdit(self);
end;
{=====}


{ TVpAllDayEventAttributes }

constructor TVpAllDayEventAttributes.Create(AOwner: TWinControl);
begin
  FOwner:= AOwner;
  FFont := TVpFont.Create(AOwner);
  FBackgroundColor := clBtnShadow;
  FEventBackgroundColor := clBtnFace;
  FEventBorderColor := cl3dDkShadow;
end;
{=====}

destructor TVpAllDayEventAttributes.Destroy;
begin
  inherited;
  FFont.Free;
end;
{=====}

procedure TVpAllDayEventAttributes.SetBackGroundColor(Value: TColor);
begin
  FBackgroundColor := Value;
  FOwner.Invalidate;
end;
{=====}

procedure TVpAllDayEventAttributes.SetEventBackgroundColor(Value: TColor);
begin
  FEventBackgroundColor := Value;
  FOwner.Invalidate;
end;
{=====}

procedure TVpAllDayEventAttributes.SetEventBorderColor(Value: TColor);
begin
  FEventBorderColor := Value;
  FOwner.Invalidate;
end;

procedure TVpAllDayEventAttributes.SetFont(Value: TVpFont);
begin
  FFont.Assign(Value);
  FFont.Owner := FOwner;
end;
{=====}

(*****************************************************************************)
{ TVpDayViewIconAttributes }

constructor TVpDayViewIconAttributes.Create(AOwner: TVpLinkableControl);
begin
  inherited Create;
  FOwner := AOwner;
  FAlarmBitmap := TBitmap.Create;
  FRecurringBitmap := TBitmap.Create;
  FAlarmImageIndex := -1;
  FRecurringImageIndex := -1;
  FShowAlarmBitmap := True;
  FShowCategoryBitmap := True;
  FShowRecurringBitmap := True;
  FShowInPrint := True;
end;

destructor TVpDayViewIconAttributes.Destroy;
begin
  FAlarmBitmap.Free;
  FRecurringBitmap.Free;
  inherited Destroy;
end;

procedure TVpDayViewIconAttributes.SetAlarmBitmap(v: TBitmap);
begin
  FAlarmBitmap.Assign(v);
  if Assigned(FOwner) then
    FOwner.Invalidate;
end;

procedure TVpDayViewIconAttributes.SetAlarmImageIndex(v: TImageIndex);
begin
  if FAlarmImageIndex <> v then
  begin
    FAlarmImageIndex := v;
    if Assigned(FOwner) then
      FOwner.Invalidate;
  end;
end;

procedure TVpDayViewIconAttributes.SetRecurringBitmap(v: TBitmap);
begin
  FRecurringBitmap.Assign(v);
  if Assigned(FOwner) then
    FOwner.Invalidate;
end;

procedure TVpDayViewIconAttributes.SetRecurringImageIndex(v: TImageIndex);
begin
  if FRecurringImageIndex <> v then
  begin
    FRecurringImageIndex := v;
    if Assigned(FOwner) then
      FOwner.Invalidate;
  end;
end;

procedure TVpDayViewIconAttributes.SetShowAlarmBitmap(const v: Boolean);
begin
  if FShowAlarmBitmap <> v then begin
    FShowAlarmBitmap := v;
    if Assigned(FOwner) then
      FOwner.Invalidate
  end;
end;

procedure TVpDayViewIconAttributes.SetShowCategoryBitmap(const v: Boolean);
begin
  if FShowCategoryBitmap <> v then begin
    FShowCategoryBitmap := v;
    if Assigned(FOwner) then
      FOwner.Invalidate;
  end;
end;

procedure TVpDayViewIconAttributes.SetShowRecurringBitmap(const v: Boolean);
begin
  if FShowRecurringBitmap <> v then begin
    FShowRecurringBitmap := v;
    if Assigned(FOwner) then
      FOwner.Invalidate
  end;
end;

(*****************************************************************************)
{ TVpDayView }

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

  { Create internal classes and stuff }
  FTimeSlotColors := TVpTimeSlotColor.Create(self);
  FHeadAttr := TVpCHAttributes.Create(self);
  FRowHeadAttr := TVpRHAttributes.Create(self);
  FAllDayEventAttr := TVpAllDayEventAttributes.Create(self);
  dvClickTimer := TTimer.Create(self);
  FIconAttributes := TVpDayViewIconAttributes.Create(Self);

  { create Nav buttons }
  dvDayUpBtn := TSpeedButton.Create(self);
  dvDayUpBtn.Parent := self;
  dvDayDownBtn := TSpeedButton.Create(self);
  dvDayDownBtn.Parent := self;
  dvTodayBtn := TSpeedButton.Create(self);
  dvTodayBtn.Parent := self;
  dvWeekDownBtn := TSpeedButton.Create(self);
  dvWeekDownBtn.Parent := self;
  dvWeekUpBtn := TSpeedButton.Create(self);
  dvWeekUpBtn.Parent := self;
  { flat }
  dvTodayBtn.Flat := true;
  dvWeekDownBtn.Flat := true;
  dvDayDownBtn.Flat := true;
  dvDayUpBtn.Flat := true;
  dvWeekUpBtn.Flat := true;
  { transparent }
  dvTodayBtn.Transparent := true;
  dvWeekDownBtn.Transparent := true;
  dvDayDownBtn.Transparent := true;
  dvDayUpBtn.Transparent := true;
  dvWeekUpBtn.Transparent := true;
  { load their images }
  {$IFDEF NEW_ICONS}
  LoadGlyphFromRCDATA(dvDayUpBtn.Glyph, 'VpRArrow', 16, 24, 32);
  LoadGlyphFromRCDATA(dvDayDownBtn.Glyph, 'VpLArrow', 16, 24, 32);
  LoadGlyphFromRCDATA(dvTodayBtn.Glyph, 'VpToday', 16, 24, 32);
  LoadGlyphFromRCDATA(dvWeekUpBtn.Glyph, 'VpRArrows', 16, 24, 32);
  LoadGlyphFromRCDATA(dvWeekDownBtn.Glyph, 'VpLArrows', 16, 24, 32);
  {$ELSE}
  dvDayUpBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPRIGHTARROW');
  dvDayDownBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPLEFTARROW');
  dvTodayBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPTODAY');
  dvWeekUpBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPRIGHTARROWS');
  dvWeekDownBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPLEFTARROWS');
  {$ENDIF}
  { set their OnClick handler }
  dvDayUpBtn.OnClick := dvNavButtonsClick;
  dvDayDownBtn.OnClick := dvNavButtonsClick;
  dvTodayBtn.OnClick := dvNavButtonsClick;
  dvWeekUpBtn.OnClick := dvNavButtonsClick;
  dvWeekDownBtn.OnClick := dvNavButtonsClick;
  { Set up the hints }
  dvDayUpBtn.ShowHint := True;
  dvDayDownBtn.ShowHint := True;
  dvTodayBtn.ShowHint := True;
  dvWeekUpBtn.ShowHint := True;
  dvWeekDownBtn.ShowHint := True;

  { Set styles and initialize internal variables }
  {$IFDEF VERSION4}
//  DoubleBuffered := true;
  {$ENDIF}
  NumDays := 1;
  dvInLinkHandler := false;
  dvClickTimer.Enabled := false;
  dvClickTimer.Interval := ClickDelay;
  dvClickTimer.OnTimer := dvEditInPlace;

  dvCreatingEditor := false;
  FDrawingStyle := ds3d;
  dvPainting := false;
  FShowNavButtons := true;
  FShowResourceName := true;
  FColor := clWindow;
  FLineColor := clGray;
  Granularity := gr30min;
  FDefTopHour := h_07;
  FDisplayDate := Now;
  FFixedDate := false;
  FCustomRowHeight := 0;
  FRowLinesStep := 1;
  FSimpleRowTime := false;
  TopHour := FDefTopHour;
  FTimeFormat := tf12Hour;
  FDateLabelFormat := 'dddddd'; //'dddd, mmmm dd, yyyy';
  FColumnWidth := 200;
  FScrollBars := ssVertical;
  FActiveRow := -1;
  FGutterWidth := 7;
  dvEndingEditing := False;
  FWrapStyle := wsIconFlow;
  FDotDotDotColor := clBlack;
  FIncludeWeekends := True;
  FAllowInplaceEdit := true;
  FShowEventTimes := true;

  { set up fonts and colors }
  FHeadAttr.Font.Size := 10;
  FHeadAttr.Font.Style := [];
  FHeadAttr.Color := clBtnFace;

  FRowHeadAttr.FHourFont.Size := 18;
  FRowHeadAttr.FHourFont.Style := [];
  FRowHeadAttr.FMinuteFont.Size := 9;
  FRowHeadAttr.FMinuteFont.Style := [];
  FRowHeadAttr.Color := clBtnFace;
 {$IFNDEF LCL}
  FHeadAttr.Font.Name := 'Tahoma';
  FRowHeadAttr.FHourFont.Name := 'Tahoma';
  FRowHeadAttr.FMinuteFont.Name := 'Tahoma';
 {$ENDIF}

  SetLength(dvEventArray, MaxVisibleEvents);

  DragMode := dmManual;
  dvDragging := false;

  dvMouseDownPoint := Point(0, 0);
  dvMouseDown := false;

  // Size
  Height := 225;
  Width := 265;

  // popup menu
  FDefaultPopup := TPopupMenu.Create(Self);
  Self.PopupMenu := FDefaultPopup;
  FDefaultPopup.OnPopup := PopupDropDownEvent;

  LoadLanguage;

  dvHookUp;
end;
{=====}

destructor TVpDayView.Destroy;
begin
  FreeAndNil(dvInplaceEditor);

  FTimeSlotColors.Free;
  FHeadAttr.Free;
  FRowHeadAttr.Free;
  FAllDayEventAttr.Free;
  dvClickTimer.Free;
  FDefaultPopup.Free;
  FIconAttributes.Free;

  dvDayUpBtn.Free;
  dvDayDownBtn.Free;
  dvTodayBtn.Free;
  dvWeekUpBtn.Free;
  dvWeekDownBtn.Free;

  inherited;
end;

function TVpDayView.BuildEventString(AEvent: TVpEvent;
  UseAsHint: Boolean): String;
var
  timeFmt: String;
  timeStr: String;
  s: String;
  res: TVpResource;
  grp: TVpResourceGroup;
  isOverlayed: Boolean;
  showDetails: Boolean;
begin
  Result := '';

  if (AEvent = nil) or (Datastore = nil) or (Datastore.Resource = nil) then
    exit;

  grp := Datastore.Resource.Group;
  showDetails := (grp <> nil) and (odEventDescription in grp.ShowDetails);
  isOverlayed := AEvent.IsOverlayed;
  timefmt := GetTimeFormatStr(TimeFormat);

  if UseAsHint then begin
    { Usage as hint }
    if isOverlayed then begin
      grp := Datastore.Resource.Group;
      if (odResource in grp.ShowDetails) then begin
        res := Datastore.Resources.GetResource(AEvent.ResourceID);
        Result := RSOverlayed + ': ' + res.Description;
      end else
        Result := RSOverlayed;
    end else
      showDetails := true;

    timeStr := IfThen(AEvent.AllDayEvent,
      RSAllDay,
      FormatDateTime(timeFmt, AEvent.StartTime) + ' - ' + FormatDateTime(timeFmt, AEvent.EndTime)
    );

    Result := IfThen(Result = '',
      timeStr,
      Result + LineEnding + timeStr
    );

    if showDetails then begin
      // Event description
      Result := Result + LineEnding + LineEnding +
        RSEvent + ':' + LineEnding + AEvent.Description;

      // Event notes
      if (AEvent.Notes <> '') then begin
        s := WrapText(AEvent.Notes, MAX_HINT_WIDTH);
        s := StripLastLineEnding(s);
        Result := Result + LineEnding + LineEnding +
          RSNotes + ':' + LineEnding + s;
      end;

      // Event location
      if (AEvent.Location <> '') then
        Result := Result + LineEnding + LineEnding +
          RSLocation + ':' + LineEnding + AEvent.Location;
    end;
  end
  else
  begin
    { Usage as cell text }
    if isOverlayed then begin
      Result := '[' + RSOverlayedEvent + '] ';
      if showDetails then begin
        res := Datastore.Resources.GetResource(AEvent.ResourceID);
        if res <> nil then
          Result := '[' + res.Description + '] '
      end;
    end else
      showDetails := true;

    timeStr := IfThen(ShowEventTimes, Format('%s - %s: ', [
      FormatDateTime(timeFmt, AEvent.StartTime),
      FormatDateTime(timeFmt, AEvent.EndTime)
    ]));

    if showDetails then
      Result := IfThen(Result = '',
        timeStr + AEvent.Description,
        Result + timeStr + AEvent.Description)
    else
      Result := IfThen(Result = '',
        timeStr,
        Result + timeStr);
  end;
end;

procedure TVpDayView.LoadLanguage;
begin
  dvDayUpBtn.Hint := RSNextDay;
  dvDayDownBtn.Hint := RSPrevDay;
  dvTodayBtn.Hint := RSToday;
  dvWeekUpBtn.Hint := RSNextWeek;
  dvWeekDownBtn.Hint := RSPrevWeek;
  FDefaultPopup.Items.Clear;
  InitializeDefaultPopup;
end;

{=====}

procedure TVpDayView.DeleteActiveEvent(Verify: Boolean);
var
  DoIt: Boolean;
begin
  if ReadOnly then
    Exit;
  if (FActiveEvent <> nil) and (not FActiveEvent.CanEdit) then
    exit;

  dvClickTimer.Enabled := false;
  EndEdit(self);

  DoIt := not Verify;

  if FActiveEvent <> nil then begin
    if Verify then
      DoIt := (MessageDlg(RSConfirmDeleteEvent + #13#10#10 + RSPermanent,
        mtConfirmation, [mbYes, mbNo], 0) = mrYes);

    if DoIt then begin
      FActiveEvent.Deleted := true;
      DataStore.PostEvents;
      Invalidate;
    end;
  end;
end;
{=====}

procedure TVpDayView.Invalidate;
begin
  inherited;
end;

function TVpDayView.IsHoliday(ADate: TDate; out AHolidayName: String): Boolean;
begin
  AHolidayName := '';
  if Assigned(FOnHoliday) then
    FOnHoliday(Self, ADate, AHolidayName);
  Result := AHolidayName <> '';
end;

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

procedure TVpDayView.dvHookUp;
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;

{ Hint support }
procedure TVpDayView.ShowHintWindow(APoint: TPoint; AEvent: TVpEvent);
var
  txt: String;
begin
  HideHintWindow;
  case FHintMode of
    hmPlannerHint:
      begin
        if (AEvent = nil) or (Datastore = nil) or (Datastore.Resource = nil) then
          exit;
        txt := BuildEventString(AEvent, true);
      end;
    hmComponentHint:
      txt := FComponentHint;
  end;
  if (txt <> '') and not (csDesigning in ComponentState) and
     not ((dvInplaceEditor <> nil) and dvInplaceEditor.Visible) then
  begin
    Hint := txt;
    Application.Hint := Hint;
    Application.ActivateHint(ClientToScreen(APoint), true);
  end;
end;

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


{ Popup menu }

procedure TVpDayView.InitializeDefaultPopup;
var
  NewItem: TMenuItem;
  NewSubItem: TMenuItem;
  canEdit: Boolean;
begin
  canEdit := (FActiveEvent <> nil) and FActiveEvent.CanEdit;
  FDefaultPopup.Items.Clear;

  if RSPopupAddEvent <> '' then begin               // Add
    NewItem := TMenuItem.Create(Self);
    NewItem.Caption := RSPopupAddEvent;
    NewItem.OnClick := PopupAddEvent;
    NewItem.Tag := 0;
    FDefaultPopup.Items.Add(NewItem);
  end;

  if RSPopupAddEventFromICal <> '' then begin
    NewItem := TMenuItem.Create(Self);
    NewItem.Caption := RSPopupAddEventFromICal;    // Import from iCal
    NewItem.OnClick := PopupAddFromICalFile;
    NewItem.Tag := 0;
    FDefaultPopup.Items.Add(NewItem);
  end;

  if RSPopupEditEvent <> '' then begin            // Edit
    NewItem := TMenuItem.Create(Self);
    NewItem.Caption := RSPopupEditEvent;
    NewItem.Enabled := canEdit;
    NewItem.OnClick := PopupEditEvent;
    NewItem.Tag := 1;
    FDefaultPopup.Items.Add(NewItem);
  end;

  if RSPopupDeleteEvent <> '' then begin          // Delete
    NewItem := TMenuItem.Create(Self);
    NewItem.Caption := RSPopupDeleteEvent;
    NewItem.Enabled := canEdit;
    NewItem.OnClick := PopupDeleteEvent;
    NewItem.Tag := 1;
    FDefaultPopup.Items.Add(NewItem);
  end;

  NewItem := TMenuItem.Create(Self);            // ----
  NewItem.Caption := '-';
  FDefaultPopup.Items.Add(NewItem);

  if RSPopupChangeDate <> '' then begin         // Change date  >
    NewItem := TMenuItem.Create(Self);
    NewItem.Caption := RSPopupChangeDate;
    NewItem.Tag := 0;
    FDefaultPopup.Items.Add(NewItem);

    if RSToday <> '' then begin                // Today
      NewSubItem := TMenuItem.Create(Self);
      NewSubItem.Caption := RSToday;
      NewSubItem.OnClick := PopupToday;
      NewSubItem.Tag := 0;
      NewItem.Add(NewSubItem);
    end;

    NewSubItem := TMenuItem.Create(Self);       // ---
    NewSubItem.Caption := '-';
    NewItem.Add(NewSubItem);

    if RSYesterday <> '' then begin             // Yesterday
      NewSubItem := TMenuItem.Create(Self);
      NewSubItem.Caption := RSYesterday;
      NewSubItem.OnClick := PopupYesterday;
      NewSubItem.Tag := 0;
      NewItem.Add(NewSubItem);
    end;

    if RSTomorrow <> '' then begin               // Tomorrow
      NewSubItem := TMenuItem.Create(Self);
      NewSubItem.Caption := RSTomorrow;
      NewSubItem.OnClick := PopupTomorrow;
      NewSubItem.Tag := 0;
      NewItem.Add(NewSubItem);
    end;

    NewSubItem := TMenuItem.Create(Self);       // --
    NewSubItem.Caption := '-';
    NewItem.Add(NewSubItem);

    if RSNextDay <> '' then begin               // Next day
      NewSubItem := TMenuItem.Create(Self);
      NewSubItem.Caption := RSNextDay;
      NewSubItem.OnClick := PopupNextDay;
      NewSubItem.Tag := 0;
      NewItem.Add(NewSubItem);
    end;

    if RSPrevDay <> '' then begin              // Prev day
      NewSubItem := TMenuItem.Create(Self);
      NewSubItem.Caption := RSPrevDay;
      NewSubItem.OnClick := PopupPrevDay;
      NewSubItem.Tag := 0;
      NewItem.Add(NewSubItem);
    end;

    NewSubItem := TMenuItem.Create(Self);      // ---
    NewSubItem.Caption := '-';
    NewItem.Add(NewSubItem);

    if RSNextWeek <> '' then begin              // Next week
      NewSubItem := TMenuItem.Create(Self);
      NewSubItem.Caption := RSNextWeek;
      NewSubItem.OnClick := PopupNextWeek;
      NewSubItem.Tag := 0;
      NewItem.Add(NewSubItem);
    end;

    if RSPrevWeek <> '' then begin               // Prev week
      NewSubItem := TMenuItem.Create(Self);
      NewSubItem.Caption := RSPrevWeek;
      NewSubItem.OnClick := PopupPrevWeek;
      NewSubItem.Tag := 0;
      NewItem.Add(NewSubItem);
    end;

    NewSubItem := TMenuItem.Create(Self);         // ---
    NewSubItem.Caption := '-';
    NewItem.Add(NewSubItem);

    if RSNextMonth <> '' then begin              // Next month
      NewSubItem := TMenuItem.Create(Self);
      NewSubItem.Caption := RSNextMonth;
      NewSubItem.OnClick := PopupNextMonth;
      NewSubItem.Tag := 0;
      NewItem.Add(NewSubItem);
    end;

    if RSPrevMonth <> '' then begin           // Prev Month
      NewSubItem := TMenuItem.Create(Self);
      NewSubItem.Caption := RSPrevMonth;
      NewSubItem.OnClick := PopupPrevMonth;
      NewSubItem.Tag := 0;
      NewItem.Add(NewSubItem);
    end;

    NewSubItem := TMenuItem.Create(Self);         // ---
    NewSubItem.Caption := '-';
    NewItem.Add(NewSubItem);

    if RSNextYear <> '' then begin               // Next year
      NewSubItem := TMenuItem.Create(Self);
      NewSubItem.Caption := RSNextYear;
      NewSubItem.OnClick := PopupNextYear;
      NewSubItem.Tag := 0;
      NewItem.Add(NewSubItem);
    end;

    if RSPrevYear <> '' then begin              // Prev year
      NewSubItem := TMenuItem.Create(Self);
      NewSubItem.Caption := RSPrevYear;
      NewSubItem.OnClick := PopupPrevYear;
      NewSubItem.Tag := 0;
      NewItem.Add(NewSubItem);
    end;
  end;

  if (Datastore <> nil) and (Datastore.Resource <> nil) then
    AddResourceGroupMenu(FDefaultPopup.Items, Datastore.Resource, PopupPickResourceGroupEvent);
end;
{=====}

procedure TVpDayView.PopupAddEvent(Sender: TObject);
var
  StartTime: TDateTime;
  EndTime: TDateTime;
begin
  if ReadOnly or (not CheckCreateResource) or
     (not Assigned(DataStore)) or (not Assigned(DataStore.Resource))
  then
    Exit;

  StartTime := trunc(FDisplayDate + ActiveCol) + dvLineMatrix[ActiveCol, ActiveRow].Time;
  EndTime := StartTime + dvTimeIncSize * FRowLinesStep;
  FActiveEvent := DataStore.Resource.Schedule.AddEvent(
    DataStore.GetNextID(EventsTableName),
    StartTime,
    EndTime
  );
  Repaint;

  { edit this new event }
  dvSpawnEventEditDialog(True);
end;

procedure TVpDayView.PopupAddFromICalFile(Sender: TObject);
var
  dlg: TOpenDialog;
  ical: TVpICalendar;
  fn: String;
  i: Integer;
  id: Integer;
  startTime, endTime: TDateTime;
begin
  if ReadOnly or (not CheckCreateResource) or
     (not Assigned(DataStore)) or (not Assigned(DataStore.Resource))
  then
    Exit;

  dlg := TOpenDialog.Create(nil);
  try
    dlg.Title := RSLoadICalTitle;
    dlg.Filter := RSICalFilter;
    dlg.FileName := '';
    dlg.Options := dlg.Options + [ofAllowMultiSelect, ofFileMustExist];
    if dlg.Execute then begin
      Screen.Cursor := crHourGlass;
      Application.ProcessMessages;
      ical := TVpICalendar.Create;
      try
        for fn in dlg.Files do begin
          ical.LoadFromFile(fn);
          for i := 0 to ical.Count-1 do begin
            if not (ical[i] is TVpICalEvent) then
              Continue;
            startTime := TVpICalEvent(ical[i]).StartTime[false];  // use local times
            endTime := TVpICalEvent(ical[i]).EndTime[false];
            if (startTime = 0) and (endTime = 0) then
              continue;
            id := DataStore.GetNextID(EventsTableName);
            FActiveEvent := Datastore.Resource.Schedule.AddEvent(id, starttime, endtime);
            FActiveEvent.Changed := true;
            FActiveEvent.LoadFromICalendar(TVpICalEvent(ical[i]));
            Datastore.PostEvents;
            Datastore.NotifyDependents;
          end;
        end;
        Invalidate;
      finally
        ical.Free;
        Screen.Cursor := crDefault;
      end;
    end;
  finally
    dlg.Free;
  end;
end;

procedure TVpDayView.PopupDeleteEvent(Sender: TObject);
begin
  if ReadOnly then
    Exit;
  Repaint;
  if FActiveEvent <> nil then
    DeleteActiveEvent (True);
end;
{=====}

procedure TVpDayView.PopupEditEvent(Sender: TObject);
begin
  if ReadOnly then
    Exit;
  Repaint;
  if FActiveEvent <> nil then
    { edit this Event }
    dvSpawnEventEditDialog(False);
end;
{=====}

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

procedure TVpDayView.PopupTomorrow(Sender: TObject);
begin
  Date := Now + 1;
end;
{=====}

procedure TVpDayView.PopupYesterday(Sender: TObject);
begin
  Date := Now - 1;
end;
{=====}

procedure TVpDayView.PopupNextDay(Sender: TObject);
begin
  Date := Date + 1;
end;
{=====}

procedure TVpDayView.PopupPrevDay(Sender: TObject);
begin
  Date := Date - 1;
end;
{=====}

procedure TVpDayView.PopupNextWeek(Sender: TObject);
begin
  Date := Date + 7;
end;
{=====}

procedure TVpDayView.PopupPrevWeek(Sender: TObject);
begin
  Date := Date - 7;
end;
{=====}

procedure TVpDayView.PopupNextMonth(Sender: TObject);
var
  M, D, Y: Word;
begin
  DecodeDate(Date, Y, M, D);
  if M = 12 then begin
    M := 1;
    Y := Y + 1;
  end else
    M := M + 1;
  if (D > DaysInAMonth(Y, M)) then
    D := DaysInAMonth(Y, M);

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

procedure TVpDayView.PopupPrevMonth(Sender: TObject);
var
  M, D, Y: Word;
begin
  DecodeDate(Date, Y, M, D);
  if M = 1 then begin
    M := 12;
    Y := Y - 1;
  end else
    M := M - 1;
  if (D > DaysInAMonth(Y, M)) then
    D := DaysInAMonth(Y, M);

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

procedure TVpDayView.PopupNextYear(Sender: TObject);
var
  M, D, Y : Word;
begin
  DecodeDate(Date, Y, M, D);
  Date := EncodeDate(Y + 1, M, 1);
end;
{=====}

procedure TVpDayView.PopupPrevYear(Sender: TObject);
var
  M, D, Y: Word;
begin
  DecodeDate(Date, Y, M, D);
  Date := EncodeDate(Y - 1, M, 1);
end;
{=====}

procedure TVpDayView.PopupPickResourceGroupEvent(Sender: TObject);
begin
  Datastore.Resource.Group := TVpResourceGroup(TMenuItem(Sender).Tag);
  Datastore.UpdateGroupEvents;
end;

procedure TVpDayView.PopupDropDownEvent(Sender: TObject);
begin
  InitializeDefaultPopup;
end;

procedure TVpDayView.Loaded;
begin
  inherited;
  TopHour := DefaultTopHour;
  dvLoaded := true;
  dvPopulate;
end;
{=====}

procedure TVpDayView.Paint;
begin
  RenderToCanvas(Canvas, Rect(0, 0, Width, Height), ra0, 1, FDisplayDate,
    TopLine, -1, FGranularity, False);
  SetVScrollPos; 
end;
{=====}

procedure TVpDayView.dvPopulate;
begin
  if DataStore <> nil then
    DataStore.Date := FDisplayDate; 
end;
{=====}

procedure TVpDayView.dvNavButtonsClick(Sender: TObject);
begin
  { set the value of Date based on which button was pressed. }
  if Sender = dvDayUpBtn then
    Date := Date + 1
  else if Sender = dvDayDownBtn then
    Date := Date - 1
  else if Sender = dvTodayBtn then
    Date := trunc(Now)
  else if Sender = dvWeekUpBtn then
    Date := Date + 7
  else if Sender = dvWeekDownBtn then
    Date := Date - 7;
end;
{=====}

function TVpDayView.dvCalcVisibleLines(RenderHeight, ColHeadHeight, ARowHeight: Integer;
  Scale: Extended; StartLine, StopLine: Integer): Integer;
var
  vertical: integer;
  d: Integer = 0;        // d = result of "div"
  m: Integer = 0;        // m = result of "mod"
begin
  if StartLine < 0 then
    StartLine := TopLine;

  { take into account the number lines that are allowed! }
//  vertical := Round(RenderHeight - ColHeadHeight * Scale - 2);
  vertical := Round(RenderHeight - ColHeadHeight * Scale);
  DivMod(Vertical, ARowHeight, d, m);
  Result := d + ord(m <> 0);
  {
  if Vertical mod ARowHeight = 0 then
    Result :=
  Result := Vertical div ARowHeight + 1; // - 4; //+2;
  }
  if Result > FLineCount then
    Result := FLineCount;

  if (StopLine > 0) and (StopLine > StartLine) and (Result > Stopline-StartLine) then
    Result := StopLine - StartLine + 1;
   {
  if (StopLine > 0) and (StopLine > StartLine) then
    if Result > StopLine - StartLine then
      Result := StopLine - StartLine + 2;
  }
  FVisibleLines := Result;
end;
{=====}

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

function TVpDayView.dvCalcColHeadHeight(Scale: Extended): Integer;
var
  TextHeight: Integer;
  glyphHeights: Integer;
begin
  Canvas.Font.Assign(FHeadAttr.Font);
  Canvas.Font.Size := ScaleY(Canvas.Font.Size, DesignTimeDPI);

  if FShowResourceName and (DataStore <> nil) and (DataStore.Resource <> nil) then
    TextHeight := Canvas.TextHeight(TallShortChars) * 2 + TextMargin * 3
  else
    TextHeight := Canvas.TextHeight(TallShortChars) + TextMargin * 2;
  Result := Round(TextHeight * Scale);

  if Assigned(dvTodayBtn.Glyph) then begin
    glyphHeights := dvDayUpBtn.Glyph.Height + dvTodayBtn.Glyph.Height + 6;
    if Result < glyphHeights then Result := glyphHeights;
  end;

  dvColHeadHeight := Result; 
end;
{=====}

procedure TVpDayView.DoStartDrag(var DragObject: TDragObject);
{$IFDEF LCL}
var
  P, HotSpot: TPoint;
  EventName: string;
{$ENDIF}
begin
  DvDragStartTime := 0.0;
  if ReadOnly or not FAllowDragAndDrop then
    Exit;
  if FActiveEvent <> nil then begin
    // Set the time from which this event was dragged

    DvDragStartTime := trunc(Date + ActiveCol) + dvLineMatrix[ActiveCol, ActiveRow].Time;

   {$IFDEF LCL}
    EventName := FActiveEvent.Description;
    GetCursorPos(P{%H-});
    P := TVpDayView(Self).ScreenToClient(P);
    HotSpot := Point(P.X - Self.dvActiveEventRec.Left, P.Y - Self.dvActiveEventRec.Top);

    DragObject := TVpEventDragObject.CreateWithDragImages(Self as TControl,
      HotSpot, Self.dvActiveEventRec, EventName, FDragDropTransparent);
   {$ELSE}
    DragObject := DragObject := TVpEventDragObject.Create(Self);
   {$ENDIF}

    TVpEventDragObject(DragObject).Event := FActiveEvent;
  end
  else
   {$IFDEF LCL}
    CancelDrag;
   {$ELSE}
    DragObject.Free;//EndDrag(false);
   {$ENDIF}
end;
{=====}

procedure TVpDayView.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 TVpDayView.DragOver(Source: TObject; X, Y: Integer; State: TDragState;
  var Accept: Boolean);
begin
  Unused(Source, State);

  if ReadOnly or (not FAllowDragAndDrop) then begin
    Accept := False;
    Exit;
  end;
  if (X > dvRowHeadWidth + GutterWidth) and (Y > dvColHeadHeight) then begin
    { The mouse is dragging over the client area }
    dvSetActiveColByCoord(Point(X, Y));
    dvSetActiveRowByCoord(Point(X, Y), False);                           
    Accept := true;
  end else
    Accept := false;
end;
{=====}

procedure TVpDayView.DragDrop(Source: TObject; X, Y: Integer);
var
  Event: TVpEvent;
  Duration: TDateTime;
  DragToTime: TDateTime;
  i: Integer;
begin
  Unused(X, Y);

  if ReadOnly or (not FAllowDragAndDrop) then
    Exit;

  Event := TVpEventDragObject(Source).Event;
  if Event <> nil then begin
    Duration := Event.EndTime - Event.StartTime;
    DragToTime := trunc(Date + ActiveCol) + dvLineMatrix[ActiveCol, ActiveRow].Time;

    if Ord(Event.RepeatCode) = 0 then
      { if this is not a recurring event then just drop it here }
      Event.StartTime := DragToTime
    else
      { if this is a recurring event, then modify the event's start time
        according to how far the event was dragged }
      Event.StartTime := Event.StartTime + (DragToTime - DvDragStartTime);
    Event.EndTime := Event.StartTime + Duration;
    DataStore.PostEvents;

    { Force a repaint. This will update the rectangles for the event }
    Repaint;

    { Reset the active event rectangle }
    for I := 0 to pred(Length(dvEventArray)) do begin
      if dvEventArray[I].Event = nil then
        Break;

      if dvEventArray[i].Event = Event then begin
        dvActiveEventRec := dvEventArray[I].Rec;
        dvActiveIconRec  := dvEventArray[I].IconRect;
        Break;
      end;
    end;

    { Invalidate; }
  end;
//  TVpEventDragObject(Source).EndDrag(False);
end;
{=====}

function TVpDayView.dvCalcRowHeight(Scale: Extended;
  UseGran: TVpGranularity): Integer;
var
  SaveFont: TFont;
  Temp: Integer;
begin
  { Calculates row height based on the largest of the RowHead's Minute }
  { font, the standard client font, and a sample character string.     }
  SaveFont := Canvas.Font;
  Canvas.Font.Assign(FRowHeadAttr.FMinuteFont);
  Canvas.Font.Size := ScaleY(Canvas.Font.Size, DesignTimeDPI);
  Canvas.Font.Height := GetRealFontHeight(Canvas.Font);
  Result := Canvas.TextHeight(TallShortChars);
  Canvas.Font.Assign(SaveFont);
  Temp := Canvas.TextHeight(TallShortChars);
  if Temp > Result then
    Result := Temp;
  if FCustomRowHeight = 0 then
    Result := Result + TextMargin * 2
  else
    Result := FCustomRowHeight;

  Result := Round(Result * Scale);
  dvClientVArea := Result * MinutesInDay div GranularityMinutes[UseGran];
  dvRowHeight := Result;
end;
{=====}

function TVpDayView.GetLastVisibleDate: TDateTime;
begin
  Result := Date + GetRealNumDays(Date);
end;
{=====}

function TVpDayView.GetRealNumDays(WorkDate: TDateTime) : Integer;
var
  i: Integer;
begin
  if not FIncludeWeekends then begin
    Result := 0;
    i := 0;
    while i < FNumDays do begin
      if (DayOfWeek(WorkDate) <> 1) and (DayOfWeek(WorkDate) <> 7) then
        Inc(i);
      WorkDate := WorkDate + 1;
      Inc(Result);
    end;
  end else
    Result := FNumDays;
end;
{=====}

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

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

procedure TVpDayView.SetTopHour(Value: TVpHours);
begin
  if FTopHour <> Value then begin
    FTopHour := Value;
    TopLine := HourToLine(FTopHour, FGranularity);
  end;
end;
{=====}

procedure TVpDayView.SetTopLine(Value: Integer);
begin
  if Value <> FTopLine then begin
    if Value + VisibleLines >= pred(LineCount) then begin
//      FTopLine := pred(LineCount) - VisibleLines + 2;    // why +2?
      FTopLine := pred(LineCount) - VisibleLines;
      if FTopLine < 0 then FTopLine := 0;
      { prevent the control from hanging at the bottom }
      if (Value < FTopLine) and (Value > 0) then
        FTopLine := Value;
    end
    else if Value < 0 then
      FTopLine := 0
    else
      FTopLine := Value;
    Invalidate;
    SetVScrollPos;
  end;
end;
{=====}

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

procedure TVpDayView.SetGutterWidth(Value: Integer);
begin
  if (Value <> FGutterWidth) and (Value > -1) and (Value < Width div 10) then
  begin
    FGutterWidth := Value;
    Invalidate;
  end;
end;
{=====}

procedure TVpDayView.SetDefTopHour(Value: TVpHours);
begin
  if Value <> FDefTopHour then begin
    FDefTopHour := Value;
    if csDesigning in ComponentState then
    TopHour := Value;
  end;
end;
{=====}

procedure TVpDayView.SetTimeIntervals(UseGran: TVpGranularity);
var
  I, J: Integer;
  grPerHour: Integer;
begin
  FLineCount := MinutesInDay div GranularityMinutes[UseGran];
  dvTimeIncSize := GranularityMinutes[UseGran] / MinutesInDay;
  grPerHour := 60 div GranularityMinutes[UseGran];

  SetLength(dvLineMatrix, NumDays);
  for I := 0 to pred(NumDays) do begin
    SetLength(dvLineMatrix[I], LineCount + 1);    // was +1. Why? Without it, the IDE crashes! - there is an upper loop index of LineCount in DrawCells. After correcting that, the crash is gone.
      // wp: the additional line is needed to fully display the last line of the day.
    for J := 0 to pred(LineCount) do begin
      dvLineMatrix[I,J].Hour := TVpHours(J div grPerHour);
      dvLineMatrix[I,J].Minute := (J mod grPerHour) * GranularityMinutes[UseGran];
      dvLineMatrix[I,J].Time := ord(dvLineMatrix[I,J].Hour) / 24 + dvTimeIncSize * (J mod grPerHour);
    end;
  end;

  if FLineCount <= FVisibleLines then
    FTopLine := HourToLine(h_00, FGranularity);

  SetVScrollPos;
end;

procedure TVpDayView.SetGranularity(Value: TVpGranularity);
begin
  FGranularity := Value;
  SetTimeIntervals(FGranularity);
  FTopLine := HourToLine(FTopHour, FGranularity);
  if dvRowHeight <> 0 then
    dvCalcVisibleLines(Height, dvColHeadHeight, dvRowHeight, 1, FTopLine, -1);
  if (FGranularity = gr60Min) and (FVisibleLines = LineCount) then
    FTopLine := 0;
  Invalidate;
end;
{=====}

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

procedure TVpDayView.SetDisplayDate(Value: TDateTime);
begin
  if (not FFixedDate) and (FDisplayDate <> Value) then begin
    EndEdit(self);
    FDisplayDate := Value;
    if dvLoaded then
      dvPopulate;
    Invalidate;

    if (not dvInLinkHandler) and (ControlLink <> nil) then
      ControlLink.Notify(self, neDateChange, Date);
  end;
end;
{=====}

{$IFNDEF LCL}
procedure TVpDayView.WMSize(var Msg: TWMSize);
{$ELSE}
procedure TVpDayView.WMSize(var Msg: TLMSize);
{$ENDIF}
var
  MaxLinesToDraw: Integer;
  EmptyLines: Integer;
begin
  inherited;

  { How many lines are there between TopLine and the last line of the day. }
  MaxLinesToDraw := Length(dvLineMatrix[0]) - TopLine;
  EmptyLines := FVisibleLines - MaxLinesToDraw;

  if EmptyLines > 0 then
    TopLine := TopLine - EmptyLines
  else
    Invalidate; 
end;
{=====}

procedure TVpDayView.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  with Params do
  begin
    Style := Style or WS_TABSTOP;
    if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL;
    if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL;
{$IFNDEF LCL}
    WindowClass.style := CS_DBLCLKS;
{$ENDIF}
  end; 
end;
{=====}

procedure TVpDayView.CreateWnd;
begin
  inherited;
  PostMessage (Handle, Vp_DayViewInit, 0, 0);
end;


procedure TVpDayView.MouseEnter;
begin
  FMouseEvent := nil;
end;

procedure TVpDayView.MouseLeave;
begin
  HideHintWindow;
end;

procedure TVpDayView.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if Button = mbLeft then
    begin
      dvMouseDownPoint := Point(0, 0);
      dvMouseDown := false;
      dvDragging := false;
    end
  else
    begin
    end;
end;

procedure TVpDayView.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  event: TVpEvent;
begin
  inherited MouseMove(Shift, X, Y);
  if (FActiveEvent <> nil) and (not ReadOnly) then begin
    if (not dvDragging) and dvMouseDown and
       ((dvMouseDownPoint.x <> x) or (dvMouseDownPoint.y <> y)) and
       FActiveEvent.CanEdit
    then begin
      dvDragging := true;
      dvClickTimer.Enabled := false;
      BeginDrag(true);
    end;
  end;

  if ShowHint then
  begin
    event := GetEventAtCoord(Point(X, Y));
    if event = nil then
      HideHintWindow
    else
    if FMouseEvent <> event then begin
//      HideHintWindow;
      ShowHintWindow(Point(X, Y), event);
      FMouseEvent := event;
    end;
  end;
end;

procedure TVpDayView.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  i: Integer;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Button = mbLeft then
  begin
    dvMouseDownPoint := Point(x, y);
    dvMouseDown := true;

    { if the mouse was pressed down in the client area, then select the cell. }
    if not focused then SetFocus;

    if (x > dvRowHeadWidth - 9) and (y > dvColHeadHeight) then
    begin
      { The mouse click landed inside the client area }
      dvSetActiveColByCoord(Point(x, y));
      dvSetActiveRowByCoord(Point(x, y), True);
      if not ReadOnly then
        EditEventAtCoord(Point(x, y));
    end else
    if y > dvColHeadHeight then
      dvSetActiveRowByCoord(Point (x, y), True);

    if Assigned(OnClick) then
      OnClick(self);
  end
  else begin
    if not Focused then
      SetFocus;

    if (x > dvRowHeadWidth - 9) and (y > dvColHeadHeight) then
    begin
      { The mouse click landed inside the client area }
      dvSetActiveColByCoord(Point(x, y));
      dvSetActiveRowByCoord(Point(x, y), True);
    end;

    EditEventAtCoord(Point (x, y));
    dvClickTimer.Enabled := false;

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

{=====}

{$IFNDEF LCL}
procedure TVpDayView.WMLButtonDblClk(var Msg: TWMLButtonDblClk);
{$ELSE}
procedure TVpDayView.WMLButtonDblClk(var Msg: TLMLButtonDblClk);
{$ENDIF}
var
  StartTime, EndTime: TDateTime;
begin
  inherited;
  dvClickTimer.Enabled := false;
  dvMouseDownPoint := Point(0, 0);
  dvMouseDown := false;
  dvDragging := false;

  { if the mouse was pressed down in the client area, then select the cell. }
  if not focused then SetFocus;

  if (Msg.XPos > dvRowHeadWidth - 9) and (Msg.YPos > dvColHeadHeight) then
  begin
    { The mouse click landed inside the client area }
    dvSetActiveRowByCoord(Point(Msg.XPos, Msg.YPos), True);
    { See if we hit an active event }
    if (FActiveEvent <> nil) and (not ReadOnly) then begin
      { edit this event }
      dvSpawnEventEditDialog(False);
    end else if not ReadOnly then begin
      if not CheckCreateResource then
        Exit;
      if (DataStore = nil) or (DataStore.Resource = nil) then
        Exit;
      { otherwise, we must want to create a new event }
      StartTime := trunc(FDisplayDate + ActiveCol)
        + dvLineMatrix[ActiveCol, ActiveRow].Time;
      EndTime := StartTime + dvTimeIncSize * FRowLinesStep;
      FActiveEvent := DataStore.Resource.Schedule.AddEvent(
        DataStore.GetNextID(EventsTableName), StartTime, EndTime);
      { edit this new event }
      dvSpawnEventEditDialog(True);
    end;
  end;
end;
{=====}

{$IFDEF LCL}
function TVpDayView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
end;

function TVpDayView.DoMouseWheelDown(Shift: TShiftState;
  MousePos: TPoint): Boolean;
var
  delta: Integer;
begin
  Result := inherited DoMouseWheelDown(Shift, MousePos);
  if not Result then begin
    if [ssCtrl, ssShift] * Shift <> [] then begin
      delta := HourToLine(h_01, FGranularity);
      if delta = 1 then delta := 3;
    end else
      delta := 1;
    dvScrollVertical(delta);
    Result := True;
  end;
end;

function TVpDayView.DoMouseWheelUp(Shift: TShiftState;
  MousePos: TPoint): Boolean;
var
  delta: Integer;
begin
  Result := inherited DoMouseWheelUp(Shift, MousePos);
  if not Result then begin
    if [ssCtrl, ssShift] * Shift <> [] then begin
      delta := HourToLine(h_01, FGranularity);
      if delta = 1 then delta := 3;
    end else
      delta := 1;
    dvScrollVertical(-delta);
    Result := True;
  end;
end;
{$ENDIF}

procedure TVpDayView.EditSelectedEvent(IsNewEvent: Boolean = false);
begin
  if ReadOnly then
    Exit;
  if FActiveEvent <> nil then
    dvSpawnEventEditDialog(IsNewEvent);
end;
{=====}

procedure TVpDayView.dvSpawnEventEditDialog(IsNewEvent: Boolean);
var
  AllowIt: Boolean;
  EventDlg : TVpEventEditDialog;
begin
  if (DataStore = nil) or (DataStore.Resource = nil) or ReadOnly then
    Exit;

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

  AllowIt := false;
  if Assigned(FOwnerEditEvent) then
    FOwnerEditEvent(self, FActiveEvent, IsNewEvent, DataStore.Resource, AllowIt)
  else begin
    EventDlg := TVpEventEditDialog.Create(nil);
    try
      EventDlg.DataStore := DataStore;
      AllowIt := EventDlg.Execute(FActiveEvent);
    finally
      EventDlg.Free;
    end;
  end;

  if AllowIt then begin
    FActiveEvent.Changed := true;
    DataStore.PostEvents;
    if IsNewEvent and Assigned(FOnAddEvent) then
      FOnAddEvent(self, FActiveEvent);
  end else begin
    if IsNewEvent then begin
      FActiveEvent.Deleted := true;
      DataStore.PostEvents;
      FActiveEvent := nil;
      dvActiveEventRec := Rect(0, 0, 0, 0);
      dvActiveIconRec := Rect(0, 0, 0, 0);
    end;
  end;
  Invalidate;
end;
{=====}

{$IFNDEF LCL}
procedure TVpDayView.WMSetFocus(var Msg: TWMSetFocus);
{$ELSE}
procedure TVpDayView.WMSetFocus(var Msg: TLMSetFocus);
{$ENDIF}
begin
  Unused(Msg);
  if ActiveRow = -1 then ActiveRow := TopLine;
end;
{=====}

{$IFNDEF LCL}
procedure TVpDayView.WMEraseBackground(var Msg: TWMERASEBKGND);
{$ELSE}
procedure TVpDayView.WMEraseBackground(var Msg: TLMERASEBKGND);
{$ENDIF}
begin
  Msg.Result := 1;
end;
{=====}

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

procedure TVpDayView.SetActiveEventByCoord(APoint: TPoint);
var
  I : Integer;
begin
  for I := 0 to pred(Length(dvEventArray)) do begin
    if dvEventArray[I].Event = nil then
      Exit;
    if PointInRect(APoint, dvEventArray[I].Rec) then
    begin
      FActiveEvent := TVpEvent(dvEventArray[I].Event);
      dvActiveEventRec := dvEventArray[I].Rec;
      dvActiveIconRec := dvEventArray[I].IconRect;
      Exit;
    end;
  end;
end;

function TVpDayView.EditEventAtCoord(APoint: TPoint): Boolean;
var
  I: Integer;
begin
  result := false;
  if ReadOnly then
    Exit;
  for I := 0 to pred(Length(dvEventArray)) do begin
    FActiveEvent := nil;                               // wp: shouldn't these be set also if ReadOnly is true?
    dvActiveEventRec := Rect(0, 0, 0, 0);
    dvActiveIconRec := Rect(0, 0, 0, 0);
    if dvEventArray[I].Event = nil then
      { we've hit the end of visible events without finding a match }
      Exit;
    if PointInRect(APoint, dvEventArray[I].Rec) then
    begin
      FActiveEvent := TVpEvent(dvEventArray[I].Event);
      dvActiveEventRec := dvEventArray[I].Rec;
      dvActiveIconRec := dvEventArray[I].IconRect;
      dvClickTimer.Enabled := true;
      result := true;
      Break;
    end;
  end;
end;
{=====}

function TVpDayView.GetEventAtCoord(APoint: TPoint): TVpEvent;
var
  I: Integer;
begin
  result := nil;
  for I := 0 to pred(Length(dvEventArray)) do begin
    if dvEventArray[I].Event = nil then
      Exit;
    if PointInRect(APoint, dvEventArray[I].Rec) then
    begin
      result := TVpEvent(dvEventArray[I].Event);
      Exit;
    end;
  end;
end;

function TVpDayView.GetEventRect(AEvent: TVpEvent): TRect;
var
  i: Integer;
begin
  for i:=0 to High(dvEventArray) do
    if dvEventArray[i].Event = AEvent then begin
      Result := dvEventArray[i].Rec;
      exit;
    end;
end;

procedure TVpDayView.dvEditInPlace(Sender: TObject);
begin
  { this is the timer event which spawns an in-place editor }
  { if the event is doublecliked before this timer fires, then the }
  { event is edited in a dialog based editor. }
  dvClickTimer.Enabled := false;
  EditEvent;
end;
{=====}

procedure TVpDayView.EditEvent;
var
  AllowIt: Boolean;
begin
  if ReadOnly then
    Exit;
  if not FAllowInplaceEdit then
    Exit;
  if (FActiveEvent <> nil) and (not FActiveEvent.CanEdit) then
    Exit;

  { call the user defined BeforeEdit event }
  AllowIt := true;
  if Assigned(FBeforeEdit) then
    FBeforeEdit(Self, FActiveEvent, AllowIt);
  if not AllowIt then
    exit;

  { create and spawn the in-place editor }
  if dvInPlaceEditor = nil then begin
    dvInPlaceEditor := TVpDvInPlaceEdit.Create(Self);
    dvInPlaceEditor.Parent := self;
    dvInPlaceEditor.OnExit := EndEdit;
  end;
  if FActiveEvent.AllDayEvent then
    dvInplaceEditor.SetBounds(
      dvActiveEventRec.Left + 2 * (TextMargin div 2),  // this way it is calculated in DrawAllDayEvents
      dvActiveEventRec.Top + 2 * (TextMargin div 2),
      WidthOf(dvActiveEventRec) - TextMargin div 2,
      HeightOf(dvActiveEventRec)
    )
  else
    dvInPlaceEditor.SetBounds(
      dvActiveIconRec.Right + TextMargin,
      dvActiveEventRec.Top + TextMargin,
      dvActiveEventRec.Right - dvActiveIconRec.Right - TextMargin,
      dvActiveEventRec.Bottom - dvActiveEventRec.Top - TextMargin
    );
  dvInPlaceEditor.Show;
  dvInPlaceEditor.Text := FActiveEvent.Description;
  Invalidate;
  dvInPlaceEditor.SetFocus;
end;
{=====}

procedure TVpDayView.EndEdit(Sender: TObject);
begin
  if dvEndingEditing then
    Exit;
  dvEndingEditing := True;
  try
    if (dvInPlaceEditor <> nil) and dvInplaceEditor.Visible then begin
      if dvInPlaceEditor.Text <> FActiveEvent.Description then begin
        FActiveEvent.Description := dvInPlaceEditor.Text;
        FActiveEvent.Changed := true;
        DataStore.PostEvents;
        if Assigned(FAfterEdit) then
          FAfterEdit(self, FActiveEvent);
      end;
      dvInplaceEditor.Hide;
      Invalidate;
    end;
  finally
    dvEndingEditing := False;
  end;
end;
{=====}

procedure TVpDayView.KeyDown(var Key: Word; Shift: TShiftState);
var
  PopupPoint : TPoint;
begin
  case Key of
    VK_UP:
      ActiveRow := ActiveRow - 1;
    VK_DOWN:
      ActiveRow := ActiveRow + 1;
    VK_NEXT:
      ActiveRow := ActiveRow + FVisibleLines;
    VK_PRIOR:
      ActiveRow := ActiveRow - FVisibleLines;
    VK_LEFT:
      Date := Date - 1;
    VK_RIGHT:
      Date := Date + 1;
    VK_HOME:
      ActiveRow := 0;
    VK_END:
      ActiveRow := LineCount;
    VK_DELETE:
      if not ReadOnly then
        DeleteActiveEvent(true);
{$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;
    VK_RETURN:
      PopupEditEvent(Self);
    VK_INSERT:
      PopupAddEvent(Self);
    VK_F2:
      if Assigned(FActiveEvent) then
        dvEditInPlace(Self)
      else
      begin
        PopupPoint := dvLineMatrix[ActiveCol, ActiveRow].Rec.TopLeft;
        PopupPoint.x := PopupPoint.x + 1;
        PopupPoint.y := PopupPoint.y + 1;
        SetActiveEventByCoord (PopupPoint);
        if Assigned(FActiveEvent) then
          dvEditInPlace(Self);
      end;
  end;
end;
{=====}

{$IFNDEF LCL}
procedure TVpDayView.WMVScroll(var Msg: TWMVScroll);
{$ELSE}
procedure TVpDayView.WMVScroll(var Msg: TLMVScroll);
{$ENDIF}
begin
  { for simplicity, bail out of editing while scrolling. }
  EndEdit(Self);

  // wp: Next line should never happen after EndEdit...
  if (dvInPlaceEditor <> nil) and dvInplaceEditor.Visible then Exit;

  case Msg.ScrollCode of
    SB_LINEUP    : dvScrollVertical(-1);
    SB_LINEDOWN  : dvScrollVertical(1);
    SB_PAGEUP    : dvScrollVertical(-FVisibleLines);
    SB_PAGEDOWN  : dvScrollVertical(FVisibleLines);
    SB_THUMBPOSITION, SB_THUMBTRACK : TopLine := Msg.Pos;
  end;
end;
{=====}

procedure TVpDayView.dvScrollVertical(Lines: Integer);
begin
  TopLine := TopLine + Lines;
end;
{=====}

procedure TVpDayView.SetVScrollPos;
var
  SI : TScrollInfo;
begin
  if not HandleAllocated then
    Exit;
  with SI do begin
    cbSize := SizeOf(SI);
    fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
    nMin := 0;
    nMax := FLineCount;
    if FVisibleLines >= FLineCount then
      nPage := nMax
    else
      nPage := FVisibleLines;
    if FTopLine = pred(LineCount) - VisibleLines then
      nPos := LineCount
    else
      nPos := FTopLine;
    nTrackPos := nPos;
  end;
  SetScrollInfo(Handle, SB_VERT, SI, True);
end;
{=====}

procedure TVpDayView.SetCustomRowHeight(Value: Integer);
begin
  if Value <> FCustomRowHeight then begin
    if (Value <> 0) and (Value < 1)
      then FCustomRowHeight := 1
      else FCustomRowHeight := Value;
    Invalidate;
  end;
end;

procedure TVpDayView.SetRowLinesStep(Value: Integer);
begin
  if Value <> FRowLinesStep then begin
    if Value < 1
      then FRowLinesStep := 1
      else FRowLinesStep := Value;
    Invalidate;
  end;
end;

procedure TVpDayView.SetShowNavButtons(Value: Boolean);
begin
  if Value <> FShowNavButtons then begin
    FShowNavButtons := Value;
    Invalidate;
  end;
end;

procedure TVpDayView.SetShowResourceName(Value: Boolean);
begin
  if Value <> FShowResourceName then begin
    FShowResourceName := Value;
    Invalidate;
  end;
end;

procedure TVpDayView.SetSimpleRowTime(Value: Boolean);
begin
  if Value <> FSimpleRowTime then begin
    FSimpleRowTime := Value;
    Invalidate;
  end;
end;

procedure TVpDayView.SetNumDays(Value: Integer);
begin
  if (Value <> FNumDays) and (Value > 0) and (Value < 31) then begin
    FNumDays := Value;
    SetLength(dvColRectArray, FNumDays);
    SetTimeIntervals(Granularity);
    ActiveCol := 0;
    Invalidate;
  end;
end;

procedure TVpDayView.SetIncludeWeekends(Value : Boolean);
begin
  if Value <> FIncludeWeekends then begin
    FIncludeWeekends := Value;
    Invalidate;
  end;
end;
{=====}

procedure TVpDayView.SetActiveRow(Value: Integer);
var
  OldActiveRow: Integer;
begin
  if dvClickTimer.Enabled then
    dvClickTimer.Enabled := false;

  if not Focused then SetFocus;
  OldActiveRow := FActiveRow;
  { set active row }
  if (Value < 0) then
    FActiveRow := 0
  else if (Value >= pred(LineCount)) then
    FActiveRow := pred(LineCount)
  else
    FActiveRow := Value;

  { clamp in view }
  if (FActiveRow < FTopLine) then
    TopLine := FActiveRow
  else if (FActiveRow >= FTopLine + FVisibleLines) then
    TopLine := FActiveRow - FVisibleLines + 1;

  if (OldActiveRow <> FActiveRow) then begin
    Invalidate;
  end;
end;
{=====}

procedure TVpDayView.SetActiveCol(Value: Integer);
begin
  if FActiveCol <> Value then begin
    if Value < 0 then
      FActiveCol := 0
    else if Value > pred(NumDays) then
      FActiveCol := pred(NumDays)
    else
      FActiveCol := Value;
    Invalidate;
  end;
end;
{=====}
procedure TVpDayView.SetDotDotDotColor(const v: TColor);
begin
  if v <> FDotDotDotColor then begin
    FDotDotDotColor := v;
    Invalidate;
  end;
end;
{=====}

procedure TVpDayView.SetShowEventTimes(Value: Boolean);
begin
  if Value <> FShowEventTimes then begin
    FShowEventTimes := Value;
    Invalidate;
  end
end;
{=====}

procedure TVpDayView.SetWrapStyle(const v: TVpDVWrapStyle);
begin
  if v <> FWrapStyle then begin
    FWrapStyle := v;
    Invalidate;
  end;
end;

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

procedure TVpDayView.SetHintMode(const AValue: TVpHintMode);
begin
  if AValue = FHintMode then
    exit;
  FHintMode := AValue;
  if FHintMode = hmPlannerHint then
    FComponentHint := Hint;
end;

{=====}

procedure TVpDayView.dvSetActiveRowByCoord(Pnt: TPoint; Sloppy: Boolean);
var
  I : Integer;
begin
  if dvClickTimer.Enabled  then
    dvClickTimer.Enabled := false;
  for I := 0 to pred(LineCount) do begin
    if Sloppy and
       (Pnt.y <= dvLineMatrix[ActiveCol, I].Rec.Bottom) and
       (Pnt.y > dvLineMatrix[ActiveCol, I].Rec.Top)
    then begin
      ActiveRow := I;
      Exit;
    end else
    if PointInRect(Pnt, dvLineMatrix[ActiveCol, I].Rec) then
    begin
      ActiveRow := I;
      Exit;
    end;
  end;
end;
{=====}

procedure TVpDayView.dvSetActiveColByCoord(Pnt: TPoint);
var
  I : Integer;
begin
  for I := 0 to pred(length(dvColRectArray)) do begin
    if PointInRect(Pnt, dvColRectArray[I].Rec) then
    begin
      ActiveCol := I;
      Exit;
    end;
  end;
end;
{=====}

function TVpDayView.GetControlType : TVpItemType;
begin
  Result := itDayView;
end;

procedure TVpDayView.AutoScaledPaintToCanvas(PaintCanvas: TCanvas; PaintTo: TRect;
  Angle: TVpRotationAngle; RenderDate: TDateTime; StartLine, StopLine: Integer;
  UseGran: TVpGranularity);
var
  SrcResY: Integer;
  DestResY: Integer;
  Scale: Extended;
begin
  SrcResY := GetDeviceCaps(Canvas.Handle, LOGPIXELSY);
  DestResY := GetDeviceCaps(PaintCanvas.Handle, LOGPIXELSY);
  Scale := DestResY / SrcResY;
  RenderToCanvas(PaintCanvas, PaintTo, Angle, Scale, RenderDate, StartLine, StopLine, UseGran, True);
end;

procedure TVpDayView.PaintToCanvas(ACanvas: TCanvas; ARect: TRect;
  Angle: TVpRotationAngle; ADate: TDateTime; StartHour, EndHour: TVpHours;
  UseGran: TVpGranularity);
begin
  RenderToCanvas(
    ACanvas,
    ARect,
    Angle,
    1,
    ADate,
    HourToLine(StartHour, UseGran),
    HourToLine(EndHour, UseGran),
    UseGran,
    True);
end;

procedure TVpDayView.RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
  Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
  StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean);
var
  painter: TVpDayViewPainter;
begin
  dvPainting := true;
  painter := TVpDayviewPainter.Create(Self, RenderCanvas);
  try
    painter.RenderToCanvas(RenderIn, Angle, Scale, RenderDate, StartLine,
      StopLine, UseGran, DisplayOnly);
  finally
    painter.Free;
    dvPainting := false;
  end;
end;

procedure TVpDayView.VpDayViewInit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF});
begin
  Unused(Msg);

  if csLoading in ComponentState then begin
    PostMessage(Handle, Vp_DayViewInit, 0, 0);
    Exit;
  end;

  dvCalcColHeadHeight(1);
  dvCalcRowHeight(1, FGranularity);
  dvCalcVisibleLines(Height, dvColHeadHeight, dvRowHeight, 1, TopLine, -1);
  SetVScrollPos;
end;

{$IF VP_LCL_SCALING = 2}
procedure TVpDayView.ScaleFontsPPI(const AToPPI: Integer;
  const AProportion: Double);
begin
  inherited;
  DoScaleFontPPI(AllDayEventAttributes.Font, AToPPI, AProportion);
  DoScaleFontPPI(HeadAttributes.Font, AToPPI, AProportion);
  DoScaleFontPPI(RowHeadAttributes.HourFont, AToPPI, AProportion);
  DoScaleFontPPI(RowHeadAttributes.MinuteFont, AToPPI, AProportion);
end;
{$ELSEIF VP_LCL_SCALING = 1}
procedure TVpDayView.ScaleFontsPPI(const AProportion: Double);
begin
  inherited;
  DoScaleFontPPI(AllDayEventAttributes.Font, AProportion);
  DoScaleFontPPI(HeadAttributes.Font, AProportion);
  DoScaleFontPPI(RowHeadAttributes.HourFont, AProportion);
  DoScaleFontPPI(RowHeadAttributes.MinuteFont, AProportion);
end;
{$ENDIF}

(*****************************************************************************)
{ TVpCHAttributes }

constructor TVpCHAttributes.Create(AOwner: TVpDayView);
begin
  inherited Create;
  FOwner := AOwner;
  FFont := TVpFont.Create(AOwner);
end;
{=====}

destructor TVpCHAttributes.Destroy;
begin
  FFont.Free;
  inherited;
end;
{=====}

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

procedure TVpCHAttributes.SetFont(Value: TVpFont);
begin
  FFont.Assign(Value);
end;
{=====}

(*****************************************************************************)
{ TVpRHAttributes }

constructor TVpRHAttributes.Create(AOwner: TVpDayView);
begin
  inherited Create;
  FOwner := AOwner;
  FHourFont := TVpFont.Create(AOwner);
  FMinuteFont := TVpFont.Create(AOwner);
 {$IFNDEF LCL}
  FHourFont.Name := 'Tahoma';
  FMinuteFont.Name := 'Tahoma';
 {$ENDIF}
end;
{=====}

destructor TVpRHAttributes.Destroy;
begin
  FHourFont.Free;
  FMinuteFont.Free;
  inherited;
end;
{=====}

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

procedure TVpRHAttributes.SetHourFont(Value: TVpFont);
begin
  if Value <> FHourFont then begin
    FHourFont.Assign(Value);
    FOwner.Invalidate;
  end;
end;
{=====}

procedure TVpRHAttributes.SetMinuteFont(Value: TVpFont);
begin
  if Value <> FMinuteFont then begin
    FMinuteFont.Assign(Value);
    FOwner.Invalidate;
  end;
end;

end.