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

unit VpGanttView;

{$mode objfpc}{$H+}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
interface

uses                          lazloggerbase,
  LCLType, LCLIntf, LMessages,
  Classes, SysUtils, Graphics, Types, Controls, StdCtrls, Menus, Forms,
  VpConst, VpMisc, VpBase, VpBaseDS, VpData;

type
  TVpGanttViewOption = (
    gvoActiveDate, gvoHorizGrid, gvoVertGrid, gvoWeekends, gvoHolidays
  );
  TVpGanttViewOptions = set of TVpGanttViewOption;

  TVpGanttSpecialDayMode = (sdmColumn, sdmHeader);

const
  DEFAULT_GANTTVIEW_OPTIONS = [
    gvoActiveDate, gvoHorizGrid, gvoVertGrid, gvoWeekends, gvoHolidays
  ];

type
  TVpGanttView = class;

  TVpGanttEventRec = record
    Event: TVpEvent;
    Caption: String;
    StartTime, EndTime: TDateTime;
    HeadRect: TRect;
    EventRect: TRect;
  end;
  PVpGanttEventRec = ^TVpGanttEventRec;

  TVpGanttEventList = class(TFPList)
  private
    FStartDate, FEndDate: TDateTime;
    function GetItem(AIndex: Integer): PVpGanttEventRec;
    procedure SetItem(AIndex: Integer; AItem: PVpGanttEventRec);
  protected
    procedure ClipDates(AEventRec: PVpGanttEventRec);
    function FindFirstRecurrence(AEvent: TVpEvent; out AStart, AEnd: TDateTime): Boolean;
    function FindNextRecurrence(AEvent: TVpEvent; var AStart, AEnd: TDateTime): Boolean;
  public
    constructor Create(AStartDate, AEndDate: TDateTime);
    destructor Destroy; override;
    function AddSingleEvent(AEvent: TVpEvent): PVpGanttEventRec;
    procedure AddRecurringEvents(AEvent: TVpEvent);
    procedure Clear;
    procedure Delete(AIndex: Integer);
    property Items[AIndex: Integer]: PVpGanttEventRec read GetItem write SetItem; default;
  end;

  TVpGanttHourRec = record
    Hour: Integer;
    Date: TDateTime;
    Rect: TRect;
  end;

  TVpGanttDayRec = record
    Date: TDateTime;
    Rect: TRect;
  end;

  TVpGanttWeekRec = record
    WeekNo: Integer;
    Date: TDateTime;
    Rect: TRect;
  end;

  TVpGanttMonthRec = record
    Date: TDateTime;
    Rect: TRect;
  end;

  TVpGanttHeaderAttributes = class(TPersistent)
  private
    FGanttView: TVpGanttView;
    FColor: TColor;
    procedure SetColor(AValue: TColor);
  protected
    procedure UpdateGanttView;
  public
    constructor Create(AOwner: TVpGanttView); virtual;
  published
    property Color: TColor read FColor write SetColor default DEFAULT_HEADERCOLOR;
  end;

  TVpGanttRowHeaderAttributes = class(TVpGanttHeaderAttributes)
  private
    FEventFont: TVpFont;
    procedure SetEventFont(AValue: TVpFont);
  protected
  public
    constructor Create(AOwner: TVpGanttView); override;
    destructor Destroy; override;
  published
    property EventFont: TVpFont read FEventFont write SetEventFont;
  end;

  TVpGanttColHeaderKind = (gchMonth, gchWeek, gchDay, gchHour);
  TVpGanttColHeaderKinds = set of TVpGanttColHeaderKind;

  TVpGanttColHeaderAttributes = class(TVpGanttHeaderAttributes)
  private
    FHourFont: TVpFont;
    FDayFont: TVpFont;
    FMonthFont: TVpFont;
    FWeekFont: TVpFont;
    FVisible: TVpGanttColHeaderKinds;
    procedure SetDayFont(AValue: TVpFont);
    procedure SetHourfont(AValue: TVpFont);
    procedure SetMonthFont(AValue: TVpFont);
    procedure SetVisible(AValue: TVpGanttColHeaderKinds);
    procedure SetWeekFont(AValue: TVpFont);
  public
    constructor Create(AOwner: TVpGanttView); override;
    destructor Destroy; override;
  published
    property DayFont: TVpFont read FDayFont write SetDayFont;
    property HourFont: TVpFont read FHourFont write SetHourFont;
    property MonthFont: TVpFont read FMonthFont write SetMonthFont;
    property Visible: TVpGanttColHeaderKinds read FVisible write SetVisible default [gchMonth, gchDay];
    property WeekFont: TVpFont read FWeekFont write SetWeekFont;
  end;

  TVpGanttView = class(TVpLinkableControl)
  private
    FActiveCol: Integer;     // Selected column
    FActiveRow: Integer;     // Selected row
    FActiveEvent: TVpEvent;  // Selected event
    FActiveDate: TDateTime;  // Selected date
    FFirstDate: TDateTime;   // Date of the first event in the resource
    FLastDate: TDateTime;    // Date of the last event in the resource
    FStartDate: TDateTime;   // Date of the first event to be displayed/printed (0 = first event ever)
    FEndDate: TDateTime;     // Date of the last event to be displayed/printed (0 = last event ever)
    FRealStartDate: TDate;   // Date of the first event to be displayed/printed (0 replaced)
    FRealEndDate: TDate;     // Date of the last event to be displayed/printed (0 repalaced)

    FLeftCol: Integer;       // Index of the left-most day column
    FTopRow: Integer;        // Index of the top-most event row
    FVisibleCols: Integer;
    FVisibleRows: Integer;
    FRowCount: Integer;
    FColCount: Integer;
    FScrollBars: TScrollStyle;

    FInLinkHandler: Boolean;
    FLoaded: Boolean;
    FPainting: Boolean;
    FMouseDown: Boolean;
    FMouseDownPoint: TPoint;

    FColWidth: Integer;
    FFixedColWidth: Integer;
    FRowHeight: Integer;
    FMonthColHeaderHeight: Integer;
    FWeekColHeaderHeight: Integer;
    FDayColHeaderHeight: Integer;
    FHourColHeaderHeight: Integer;
    FTotalColHeaderHeight: Integer;
    FTextMargin: Integer;

    FColor: TColor;
    FHolidayColor: TColor;
    FLineColor: TColor;
    FWeekendColor: TColor;

    FColHeaderAttributes: TVpGanttColHeaderAttributes;
    FRowHeaderAttributes: TVpGanttRowHeaderAttributes;

    FComponentHint: TTranslateString;
    FDateFormat: array[0..3] of String;
    FDrawingStyle: TVpDrawingStyle;
    FDefaultPopup: TPopupMenu;
    FExternalPopup: TPopupMenu;
    FHintMode: TVpHintMode;
    FMouseEvent: TVpEvent;
    FOptions: TVpGanttViewOptions;
    FSpecialDayMode: TVpGanttSpecialDayMode;
    FTimeFormat: TVpTimeFormat;
    FWeekStartsOn: TVpDayType;

    FStartHour: TVpHours;
    FEndHour: TVpHours;

    FOnAddEvent: TVpOnAddNewEvent;
    FOnDeletingEvent: TVpOnDeletingEvent;
    FOnHoliday: TVpHolidayEvent;
    FOnModifyEvent: TVpOnModifyEvent;
    FOwnerEditEvent: TVpEditEvent;

    function GetDateFormat(AIndex: Integer): String;
    function GetDayRec(AIndex: Integer): TVpGanttDayRec;
    function GetEventRec(AIndex: Integer): PVpGanttEventRec;
    function GetHourRec(AIndex: Integer): TVpGanttHourRec;
    function GetMonthRec(AIndex: Integer): TVpGanttMonthRec;
    function GetNumDays: Integer;
    function GetNumEvents: Integer;
    function GetNumHours: Integer;
    function GetNumMonths: Integer;
    function GetNumWeeks: Integer;
    function GetWeekRec(AIndex: Integer): TVpGanttWeekRec;
    function IsStoredColWidth: Boolean;
    function IsStoredDateFormat(AIndex: Integer): Boolean;
    function IsStoredEndHour: Boolean;
    function IsStoredStartHour: Boolean;
    procedure SetActiveCol(AValue: Integer);
    procedure SetActiveDate(AValue: TDateTime);
    procedure SetActiveEvent(AValue: TVpEvent);
    procedure SetActiveRow(AValue: Integer);
    procedure SetColor(Value: TColor); reintroduce;
    procedure SetColWidth(AValue: Integer);
    procedure SetDateFormat(AIndex: Integer; AValue: String);
    procedure SetDrawingStyle(AValue: TVpDrawingStyle);
    procedure SetEndHour(AValue: TVpHours);
    procedure SetFixedColWidth(AValue: Integer);
    procedure SetHolidayColor(AValue: TColor);
    procedure SetLeftCol(AValue: Integer);
    procedure SetLineColor(AValue: TColor);
    procedure SetOptions(AValue: TVpGanttViewOptions);
    procedure SetPopupMenu(AValue: TPopupMenu);
    procedure SetSpecialDayMode(AValue: TVpGanttSpecialDayMode);
    procedure SetStartHour(AValue: TVpHours);
    procedure SetTextMargin(AValue: Integer);
    procedure SetTopRow(AValue: Integer);
    procedure SetWeekendColor(AValue: TColor);
    procedure SetWeekStartsOn(Value: TVpDayType);

  protected
    // Needed by the painter
    FEventRecords: TVpGanttEventList;
    FHourRecords: array of TVpGanttHourRec;
    FDayRecords: array of TVpGanttDayRec;
    FWeekRecords: array of TVpGanttWeekRec;
    FMonthRecords: array of TVpGanttMonthRec;

    { internal methods }
    procedure CalcColHeaderHeight;
    function CalcDaysWidth(ANumDays: Integer): Integer;
    procedure CalcRowHeight;
    function ColToDateIndex(ACol: Integer): Integer;
    function GetColAtCoord(X: Integer): Integer;
    function GetDateOfCol(ACol: Integer): TDateTime;
    function GetDateTimeAtCoord(X: Integer): TDateTime;
    function GetEventAtCoord(X, Y: Integer): TVpEvent;
    function GetEventOfRow(ARow: Integer): TVpEvent;
    procedure GetRealEventDateRange(out AStartDate, AEndDate: TDate);
    function GetRowAtCoord(Y: Integer): Integer;
    function GetRowOfEvent(AEvent: TVpEvent): Integer;
    procedure GetEventDateRange(out AFirstDate, ALastDate: TDate);
    function IsEventOnDate(AEvent: TVpEvent; ADate: TDate): Boolean;
    procedure Hookup;
    procedure Populate;
    procedure PopulateDayRecords;
    procedure PopulateEventRecords;
    procedure PopulateHourRecords;
    procedure PopulateMonthRecords;
    procedure PopulateWeekRecords;
    procedure ScrollDateIntoView(ADate: TDateTime);
    procedure ScrollHorizontal(ANumCols: Integer);
    procedure ScrollRowIntoView(ARow: Integer);
    procedure ScrollVertical(ANumRows: Integer);
    procedure SetHScrollPos;
    procedure SetVScrollPos;
    procedure SpawnEventEditDialog(IsNewEvent: Boolean);

    { inherited methods }
    procedure CreateParams(var AParams: TCreateParams); override;
    procedure DblClick; override;
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    procedure DoOnResize; override;
    class function GetControlClassDefaultSize: TSize; override;
    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 Paint; override;
    procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL;
    procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL;

    { LCL scaling }
    {$IF VP_LCL_SCALING <> 0}
    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
      const AXProportion, AYProportion: Double); override;
    {$IFEND}

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

    { Popup }
    function GetPopupMenu: TPopupMenu; override;
    procedure InitializeDefaultPopup;
    procedure PopupAddEvent(Sender: TObject);
    procedure PopupDeleteEvent(Sender: TObject);
    procedure PopupEditEvent(Sender: TObject);
    procedure UpdatePopupMenuState;

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

    function BuildEventString(AEvent: TVpEvent; UseAsHint: Boolean): String;
    procedure DeleteActiveEvent(Prompt: Boolean);
    function GetControlType: TVpItemType; override;
    function HourMode: Boolean;
    function HoursPerDay: Integer;
    procedure Init;
    function IsHoliday(ADate: TDate; out AHolidayName: String): Boolean;
    procedure LoadLanguage;
    procedure LinkHandler(Sender: TComponent;
      NotificationType: TVpNotificationType; const Value: Variant); override;
    procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
      Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
      StartLine, StopLine: Integer; UseGran: TVpGranularity;
      DisplayOnly: Boolean); override;
    procedure SetDateLimits(AStartDate, AEndDate: TDateTime);

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

    // Methods/properties used by painter. Not meant to be called by user.
    function CalcVisibleCols(AWidth, AFixedColWidth, AColWidth: Integer): Integer;
    function CalcVisibleRows(AHeight, AHeaderHeight, ARowHeight: Integer): Integer;
    property FirstDate: TDateTime read FFirstDate;
    property LastDate: TDateTime read FLastDate;
    property RealStartDate: TDateTime read FRealStartDate;
    property RealEndDate: TDateTime read FRealEndDate;

    property ActiveCol: Integer read FActiveCol write SetActiveCol;
    property ActiveEvent: TVpEvent read FActiveEvent write SetActiveEvent;
    property ActiveDate: TDateTime read FActiveDate write SetActiveDate;
    property ActiveRow: Integer read FActiveRow write SetActiveRow;
    property StartDate: TDateTime read FStartDate write FStartDate;
    property EndDate: TDateTime read FEndDate write FEndDate;
    property ColCount: Integer read FColCount write FColCount;
    property RowCount: Integer read FRowCount write FRowCount;
    property VisibleCols: Integer read FVisibleCols write FVisibleCols;
    property VisibleRows: Integer read FVisibleRows write FVisibleRows;
    property LeftCol: Integer read FLeftCol write SetLeftCol;
    property TopRow: Integer read FTopRow write SetTopRow;

    // Unscaled dimensions
    property RowHeight: Integer read FRowHeight;
    property DayColHeaderHeight: Integer read FDayColHeaderHeight;
    property HourColHeaderHeight: Integer read FHourColHeaderHeight;
    property MonthColHeaderHeight: Integer read FMonthColHeaderHeight;
    property TotalColHeaderHeight: Integer read FTotalColHeaderHeight;

    property DayRecords[AIndex: Integer]: TVpGanttDayRec read GetDayRec;
    property EventRecords[AIndex: Integer]: PVpGanttEventRec read GetEventRec;
    property HourRecords[AIndex: Integer]: TVPGanttHourRec read GetHourRec;
    property MonthRecords[AIndex: Integer]: TVpGanttMonthRec read GetMonthRec;
    property WeekRecords[AIndex: Integer]: TVpGanttWeekRec read GetWeekRec;

    property NumDays: Integer read GetNumDays;
    property NumEvents: Integer read GetNumEvents;
    property NumHours: Integer read GetNumHours;
    property NumMonths: Integer read GetNumMonths;
    property NumWeeks: Integer read GetNumWeeks;

  published
    // inherited properties
    property Align;
    property Anchors;
    property BorderSpacing;
    property ReadOnly;
    // new properties
    property ColHeaderAttributes: TVpGanttColHeaderAttributes read FColHeaderAttributes write FColHeaderAttributes;
    property Color: TColor read FColor write SetColor default DEFAULT_COLOR;
    property ColWidth: Integer read FColWidth write SetColWidth stored IsStoredColWidth;
    property DayFormat: String index 0 read GetDateFormat write SetDateFormat stored IsStoredDateFormat;
    property DayFormat_HourMode: String index 3 read GetDateFormat write SetDateFormat stored IsStoredDateFormat;
    property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d;
    property EndHour: TVpHours read FEndHour write SetEndHour stored IsStoredEndHour;
    property FixedColWidth: Integer read FFixedColWidth write SetFixedColWidth default 120;
    property HintMode: TVpHintMode read FHintMode write SetHintMode default hmPlannerHint;
    property HolidayColor: TColor read FHolidayColor write SetHolidayColor default HOLIDAY_COLOR;
    property LineColor: TColor read FLineColor write SetLineColor default DEFAULT_LINECOLOR;
    property MonthFormat: String index 1 read GetDateFormat write SetDateFormat stored IsStoredDateFormat;
    property MonthFormat_short: String index 2 read GetDateFormat write SetDateFormat stored IsStoredDateFormat;
    property Options: TVpGanttViewOptions read FOptions write SetOptions default DEFAULT_GANTTVIEW_OPTIONS;
    property PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu;
    property RowHeaderAttributes: TVpGanttRowHeaderAttributes read FRowHeaderAttributes write FRowHeaderAttributes;
    property SpecialDayMode: TVpGanttSpecialDayMode read FSpecialDayMode write SetSpecialDayMode default sdmColumn;
    property StartHour: TVpHours read FStartHour write SetStartHour stored IsStoredStartHour;
    property TextMargin: Integer read FTextMargin write SetTextMargin default 2;
    property TimeFormat: TVpTimeFormat read FTimeFormat write FTimeFormat default tf12Hour;
    property WeekendColor: TColor read FWeekendColor write SetWeekendColor default WEEKEND_COLOR;
    property WeekStartsOn: TVpDayType read FWeekStartsOn write SetWeekStartsOn default dtSunday;
    // inherited events
    property OnClick;
    // new events
    property OnAddEvent: TVpOnAddNewEvent read FOnAddEvent write FOnAddEvent;
    property OnDeletingEvent: TVpOnDeletingEvent read FOnDeletingEvent write FOnDeletingEvent;
    property OnHoliday: TVpHolidayEvent read FOnHoliday write FOnHoliday; deprecated 'Use TControlLink.OnHoliday instead';
    property OnModifyEvent: TVpOnModifyEvent read FOnModifyEvent write FOnModifyEvent;
    property OwnerEditEvent: TVpEditEvent read FOwnerEditEvent write FOwnerEditEvent;
  end;

implementation

uses
  DateUtils, Math, Dialogs,
  VpSR, VpGanttViewPainter, VpEvntEditDlg;

const
  DEFAULT_DAYFORMAT = 'd';
  DEFAULT_MONTHFORMAT = 'mmmm yyyy';
  DEFAULT_MONTHFORMAT_SHORT = 'mmm yyyy';
  DEFAULT_DAYFORMAT_HOURMODE = 'dddddd';  // long date format
  DEFAULT_COLWIDTH = 20;
  DEFAULT_START_HOUR = h_07;
  DEFAULT_END_HOUR = h_20;

{ Compare function for sorting event records: Compares the start times of two events.
  If the times are equal (within 1 seconds) then end times are compared.
  The function is used by TVpGanttEventList.Sort. }
function CompareEventRecs(Item1, Item2: Pointer): Integer;
var
  eventRec1, eventRec2: PVpGanttEventRec;
begin
  eventRec1 := PVpGanttEventRec(Item1);
  eventRec2 := PVpGanttEventRec(Item2);
  if SameValue(eventRec1^.StartTime, eventRec2^.StartTime, TIME_EPS) then
    Result := CompareValue(eventRec1^.EndTime, eventRec2^.EndTime)
  else
    Result := CompareValue(eventRec1^.StartTime, eventRec2^.StartTime);
end;

{******************************************************************************}
{   TVpGanttEventList                                                          }
{******************************************************************************}
constructor TVpGanttEventList.Create(AStartDate, AEndDate: TDateTime);
begin
  inherited Create;
  FStartDate := AStartDate;
  FEndDate := AEndDate;
end;

destructor TVpGanttEventList.Destroy;
begin
  Clear;
  inherited;
end;

procedure TVpGanttEventList.AddRecurringEvents(AEvent: TVpEvent);
var
  eventRec: PVpGanttEventRec;
  dt1, dt2: TDateTime;
begin
  if AEvent.AllDayEvent then
  begin
    dt1 := DatePart(AEvent.StartTime);
    dt2 := DatePart(AEvent.EndTime) + 1;
    if frac(AEvent.EndTime) = 0 then dt2 := dt2 + 1;
  end else
  begin
    dt1 := AEvent.StartTime;
    dt2 := AEvent.EndTime;
  end;

  if FindFirstRecurrence(AEvent, dt1, dt2) then
    repeat
      eventRec := AddSingleEvent(AEvent);
      eventRec^.StartTime := dt1;
      eventRec^.EndTime := dt2;
    until not FindNextRecurrence(AEvent, dt1, dt2);
end;

function TVpGanttEventList.AddSingleEvent(AEvent: TVpEvent): PVpGanttEventRec;
const
  EPS = 1e-9;
var
  eventRec: PVpGanttEventRec;
  dt1, dt2: TDateTime;
begin
  // Handle the start/end times of all-day events correctly.
  if AEvent.AllDayEvent then
  begin
    dt1 := DatePart(AEvent.StartTime);
    dt2 := DatePart(AEvent.EndTime) + 1 - EPS;
  end else
  begin
    dt1 := AEvent.StartTime;
    dt2 := AEvent.EndTime;
  end;

  // Populate the event record
  New(eventRec);
  eventRec^ := Default(TVpGanttEventRec);
  eventRec^.Event := AEvent;
  eventRec^.Caption := AEvent.Description;
  eventRec^.StartTime := dt1;
  eventRec^.EndTime := dt2;
  eventRec^.HeadRect := Rect(-1, -1, -1, -1);
  eventRec^.EventRect := Rect(-1, -1, -1, -1);

  ClipDates(eventRec);

  Result := eventRec;

  Add(Result);
end;

procedure TVpGanttEventList.Clear;
var
  eventRec: PVpGanttEventRec;
  i: Integer;
begin
  for i := 0 to Count-1 do
  begin
    eventRec := GetItem(i);
    Dispose(eventRec);
  end;
  inherited;
end;

procedure TVpGanttEventList.ClipDates(AEventRec: PVpGanttEventRec);
begin
  // The time range of events reaching out of the displayed date range
  // must be clipped at the edges.
  if AEventRec^.StartTime < FStartDate then
    AEventRec^.StartTime := FStartDate;
  if AEventRec^.EndTime > FEndDate + 1 then
    AEventRec^.EndTime := FEndDate + 1;
end;

procedure TVpGanttEventList.Delete(AIndex: Integer);
var
  eventRec: PVpGanttEventRec;
begin
  eventRec := GetItem(AIndex);
  Dispose(eventRec);
  inherited;
end;

// Find date/times of first recurrence of the specified event in the gantt view's
// date range.
function TVpGanttEventList.FindFirstRecurrence(AEvent: TVpEvent;
  out AStart, AEnd: TDateTime): Boolean;
var
  delta: Double;
  d: TDateTime;
  eventYear, eventMonth, eventDay: Word;
  startYear, startMonth, startDay: Word;
begin
  Result := false;
  if AEvent.StartTime >= FEndDate then
    exit;
  if (AEvent.RepeatRangeEnd > 0) and (AEvent.RepeatRangeEnd <= FStartDate) then
    exit;

  if AEvent.StartTime >= FStartDate then
  begin
    AStart := AEvent.StartTime;
    AEnd := AEvent.EndTime;
    Result := true;
    exit;
  end;

  DecodeDate(AEvent.StartTime, eventYear, eventMonth, eventDay);
  DecodeDate(FStartDate, startYear, startMonth, startDay);

  case AEvent.RepeatCode of
    rtDaily:
      AStart := DatePart(FStartDate) + TimePart(AEvent.StartTime);
    rtWeekly:
      begin
        delta := AEvent.StartTime - StartOfTheWeek(AEvent.StartTime);
        AStart := StartOfTheWeek(FStartDate) + delta;
      end;
    rtMonthlyByDay:
      begin
        delta := AEvent.StartTime - StartOfTheMonth(AEvent.StartTime);
        AStart := StartOfTheMonth(FStartDate) + delta;
      end;
    rtMonthlyByDate:
      AStart := EncodeDate(startYear, startMonth, eventDay);
    rtYearlyByDay:
      begin
        delta := AEvent.StartTime - StartofTheYear(AEvent.StartTime);
        AStart := StartOfTheYear(FStartDate) + delta;
      end;
    rtYearlyByDate:
      if not TryEncodeDate(startYear, eventMonth, eventDay, AStart) then
        AStart := EncodeDate(startYear, 2, 28);
    rtCustom:
      begin
        AStart := trunc((FStartDate - DatePart(AEvent.StartTime)) / AEvent.CustomInterval) * AEvent.CustomInterval + TimePart(AEvent.StartTime);
        if AStart < FStartdate then
          AStart := AStart + AEvent.CustomInterval;
      end;
  end;
  AEnd := AStart + (AEvent.EndTime - AEvent.StartTime);
  if (AEvent.RepeatRangeEnd > 0) and (AEnd > AEvent.RepeatRangeEnd) then
    exit;
  if AStart > FEndDate + 1 then
    exit;

  Result := true;
end;

// Find date/times of next recurrence of the specified event.
function TVpGanttEventList.FindNextRecurrence(AEvent: TVpEvent;
  var AStart, AEnd: TDateTime): Boolean;
var
  delta: Double;
begin
  Result := false;
  if (AStart >= FEndDate) then
    exit;

  case AEvent.RepeatCode of
    rtDaily:
      begin
        AStart := AStart + 1;
        AEnd := AEnd + 1;
      end;
    rtWeekly:
      begin
        AStart := AStart + 7;
        AEnd := AEnd + 7;
      end;
    rtMonthlyByDay:
      begin
        delta := DatePart(AStart) - StartOfTheMonth(AStart);
        AStart := AStart + delta;
        AEnd := AEnd + delta;
      end;
    rtMonthlyByDate:
      begin
        AStart := IncMonth(AStart, 1);
        AEnd := IncMonth(AEnd, 1);
      end;
    rtYearlyByDay:
      begin
        delta := DatePart(AStart) - StartOfTheYear(AStart);
        AStart := AStart + delta;
        AEnd := AEnd + delta;
      end;
    rtYearlyByDate:
      begin
        AStart := IncYear(AStart, 1);
        AEnd := IncYear(AEnd, 1);
      end;
    rtCustom:
      begin
        AStart := AStart + AEvent.CustomInterval;
        AEnd := AEnd + AEvent.CustomInterval;
      end;
  end;
  if (AEvent.RepeatRangeEnd > 0) and (AEnd > AEvent.RepeatRangeEnd) then
    exit;
  if AStart > FEndDate + 1 then
    exit;

  Result := true;
end;

function TVpGanttEventList.GetItem(AIndex: Integer): PVpGanttEventRec;
begin
  Result := PVpGanttEventRec(inherited Items[AIndex]);
end;

procedure TVpGanttEventList.SetItem(AIndex: Integer; AItem: PVpGanttEventRec);
begin
  inherited Items[AIndex] := AItem;
end;


{******************************************************************************}
{   TVpGanttHeaderAttributes                                                   }
{******************************************************************************}
constructor TVpGanttHeaderAttributes.Create(AOwner: TVpGanttView);
begin
  inherited Create;
  FGanttView := AOwner;
  FColor := DEFAULT_HEADERCOLOR;
end;

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

procedure TVpGanttHeaderAttributes.UpdateGanttView;
begin
  if Assigned(FGanttView) then
    FGanttView.Invalidate;
end;


{******************************************************************************}
{   TVpGanttRowHeaderAttributes                                                   }
{******************************************************************************}
constructor TVpGanttRowHeaderAttributes.Create(AOwner: TVpGanttView);
begin
  inherited Create(AOwner);
  FEventFont := TVpFont.Create(AOwner);
end;

destructor TVpGanttRowHeaderAttributes.Destroy;
begin
  FEventFont.Free;
  inherited;
end;

procedure TVpGanttRowHeaderAttributes.SetEventFont(AValue: TVpFont);
begin
  if FEventFont <> AValue then
  begin
    FEventFont := AValue;
    FEventFont.Owner := FGanttView;
    UpdateGanttView;
  end;
end;


{******************************************************************************}
{   TVpGanttColHeaderAttributes                                                   }
{******************************************************************************}
constructor TVpGanttColHeaderAttributes.Create(AOwner: TVpGanttView);
begin
  inherited Create(AOwner);
  FHourFont := TVpFont.Create(AOwner);
  FDayFont := TVpFont.Create(AOwner);
  FWeekFont := TVpFont.Create(AOwner);
  FMonthFont := TVpFont.Create(AOwner);
  FVisible := [gchMonth, gchDay];
end;

destructor TVpGanttColHeaderAttributes.Destroy;
begin
  FHourFont.Free;
  FDayFont.Free;
  FWeekFont.Free;
  FMonthFont.Free;
  inherited;
end;

procedure TVpGanttColHeaderAttributes.SetDayFont(AValue: TVpFont);
begin
  if FDayFont <> AValue then
  begin
    FDayFont := AValue;
    FDayFont.Owner := FGanttView;
    UpdateGanttView;
  end;
end;

procedure TVpGanttColHeaderAttributes.SetHourFont(AValue: TVpFont);
begin
  if FHourFont <> AValue then
  begin
    FHourFont := AValue;
    FHourFont.Owner := FGanttView;
    UpdateGanttView;
  end;
end;

procedure TVpGanttColHeaderAttributes.SetMonthFont(AValue: TVpFont);
begin
  if FMonthFont <> AValue then
  begin
    FMonthFont := AValue;
    FMonthFont.Owner := FGanttView;
    UpdateGanttView;
  end;
end;

procedure TVpGanttColHeaderAttributes.SetVisible(AValue: TVpGanttColHeaderKinds);
var
  HourModeChanged: Boolean;
  d: TDateTime;
begin
  if FVisible <> AValue then
  begin
    HourModeChanged := (gchHour in FVisible) <> (gchHour in AValue);
    FVisible := AValue;
    if HourModeChanged then
    begin
      d := FGanttView.ActiveDate;
      FGanttView.Init;
      FGanttView.FActiveDate := 0;   // Enforce execution of SetActiveDate
      FGanttView.SetActiveDate(d);
    end;
    UpdateGanttView;
  end;
end;

procedure TVpGanttColHeaderAttributes.SetWeekFont(AValue: TVpFont);
begin
  if FWeekFont <> AValue then
  begin
    FWeekFont := AValue;
    FWeekFont.Owner := FGanttView;
    UpdateGanttView;
  end;
end;


{******************************************************************************}
{  TVpGanttView                                                                }
{******************************************************************************}
constructor TVpGanttView.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := [csCaptureMouse, csOpaque, csClickEvents, csDoubleClicks];

  FInLinkHandler := false;
  FLoaded := false;
  FPainting := false;
  FMouseDown := false;

  SetActiveDate(Now);

  FColWidth := DEFAULT_COLWIDTH;
  FFixedColWidth := 120;
  FTextMargin := 2;

  FColor := DEFAULT_COLOR;
  FLineColor := DEFAULT_LINECOLOR;
  FWeekendColor := WEEKEND_COLOR;
  FHolidayColor := HOLIDAY_COLOR;

  FStartHour := DEFAULT_START_HOUR;
  FEndHour := DEFAULT_END_HOUR;

  FRowHeaderAttributes := TVpGanttRowHeaderAttributes.Create(self);
  FColHeaderAttributes := TVpGanttColHeaderAttributes.Create(self);

  FDateFormat[0] := DEFAULT_DAYFORMAT;
  FDateFormat[1] := DEFAULT_MONTHFORMAT;
  FDateFormat[2] := DEFAULT_MONTHFORMAT_SHORT;
  FDateFormat[3] := DEFAULT_DAYFORMAT_HOURMODE;
  FDrawingStyle := ds3d;
  FOptions := DEFAULT_GANTTVIEW_OPTIONS;
  FScrollBars := ssBoth;
  FWeekStartsOn := dtSunday;

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

  // Initial size of the control
  with GetControlClassDefaultSize do
    SetInitialBounds(0, 0, CX, CY);

  Hookup;
end;

destructor TVpGanttView.Destroy;
begin
  FEventRecords.Free;
  FRowHeaderAttributes.Free;
  FColHeaderAttributes.Free;
  inherited;
end;

function TVpGanttView.BuildEventString(AEvent: TVpEvent;
  UseAsHint: Boolean): String;
const
  DATE_FORMAT = 'ddddd';
var
  timeFmt: String;
  startDateStr, endDateStr: string;
  s: String;
begin
  Result := '';

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

  if UseAsHint then begin
    { Usage as hint }
    startDateStr := FormatDateTime(DATE_FORMAT, AEvent.StartTime);
    if SameDate(AEvent.StartTime, AEvent.EndTime) then
      endDateStr := ''
    else
      endDateStr := FormatDateTime(DATE_FORMAT, AEvent.EndTime);

    if AEvent.AllDayEvent then
    begin
      if endDateStr <> '' then endDateStr := ' - ' + endDateStr;
      Result := startDateStr + endDatestr + LineEnding + RSAllDay;
    end else
    begin
      timefmt := GetTimeFormatStr(TimeFormat);
      startDateStr := startDateStr + ' ' + FormatDateTime(timeFmt, AEvent.StartTime) + ' - ';
      if endDateStr <> '' then endDateStr := endDateStr + ' ';
      endDateStr := endDateStr + FormatDateTime(timeFmt, AEvent.EndTime);
      Result := startDateStr + endDateStr;
    end;

    // Event description
    Result := Result + LineEnding2 +
      RSEvent + ':' + LineEnding + AEvent.Description;

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

    // Event location
    if (AEvent.Location <> '') then
      Result := Result + LineEnding2 +
        RSLocation + ':' + LineEnding + AEvent.Location;
  end
  else
    { Usage as cell text }
    Result := '';
end;

procedure TVpGanttView.CalcColHeaderHeight;
var
  s: String;
  h: Integer;
begin
  h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.MonthFont);
  FMonthColHeaderHeight := h;

  h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.WeekFont);
  FWeekColHeaderHeight := h;

  // A typical date string to measure the text height (line breaks in DayFormat allowed)
  s := FormatDateTime(DayFormat, EncodeDate(2000, 12, 28));
  h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.DayFont, s);
  FDayColHeaderHeight := h;

  h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.HourFont);
  FHourColHeaderHeight := h;

  FTotalColHeaderHeight := 0;
  if (gchMonth in FColHeaderAttributes.Visible) then
    inc(FTotalColHeaderHeight, FMonthColHeaderHeight + FTextMargin);
  if (gchWeek in FColHeaderAttributes.Visible) then
    inc(FTotalColHeaderHeight, FWeekColHeaderHeight + FTextMargin);
  if (gchDay in FColHeaderAttributes.Visible) then
    inc(FTotalColHeaderHeight, FDayColHeaderHeight + FTextMargin);
  if (gchHour in FColHeaderAttributes.Visible) then
    inc(FTotalColHeaderHeight, FHourColHeaderHeight + FTextMargin);
  if FTotalColHeaderHeight > 0 then
    inc(FTotalColHeaderHeight, FTextMargin);
end;

function TvpGanttView.CalcDaysWidth(ANumDays: Integer): Integer;
begin
  Result := ANumDays * FColWidth;
  if HourMode then
    Result := Result * HoursPerDay;
end;

procedure TVpGanttView.CalcRowHeight;
var
  h: Integer;
begin
  h := GetCanvasTextHeight(Canvas, FRowHeaderAttributes.EventFont);
  FRowHeight := h + 2 * FTextMargin;
end;

function TVpGanttView.CalcVisibleCols(AWidth, AFixedColWidth, AColWidth: Integer): Integer;
var
  d: Integer = 0;   // Result of div
  m: Integer = 0;   // Result of mod
begin
  if AColWidth <> 0 then
  begin
    DivMod(AWidth - AFixedColWidth, AColWidth, d, m);
    if (m = 0) and (d > 1) then dec(d);
    Result := d;
  end else
    Result := 0;
end;

function TVpGanttView.CalcVisibleRows(AHeight, AHeaderHeight, ARowHeight: Integer): Integer;
var
  d: Integer = 0;  // Result of div
  m: Integer = 0;  // Result of mod
begin
  if ARowHeight <> 0 then
  begin
    DivMod(AHeight - AHeaderHeight, ARowHeight, d, m);
    if (m = 0) and (d > 1) then dec(d);
    Result := d;
  end else
    Result := 0;
end;

function TVpGanttView.ColToDateIndex(ACol: Integer): Integer;
begin
  if HourMode then
    Result := ACol div HoursPerDay
  else
    Result := ACol;
end;

procedure TVpGanttView.CreateParams(var AParams: TCreateParams);
begin
  inherited CreateParams(AParams);
  with AParams do
  begin
    Style := Style or WS_TABSTOP;
    if FScrollBars in [ssVertical, ssBoth, ssAutoVertical, ssAutoBoth] then
      Style := Style or WS_VSCROLL;
    if FScrollBars in [ssHorizontal, ssBoth, ssAutoHorizontal, ssAutoBoth] then
      Style := Style or WS_HSCROLL;
  end;
end;

procedure TVpGanttView.DblClick;
var
  dt, startTime, endTime: TDateTime;
begin
  inherited;
  FMouseDown := false;

  // If the mouse was pressed down in the client area, then select the cell.
  if not Focused then
    SetFocus;

  if ReadOnly then
  begin
    FMouseDownPoint := Point(0, 0);
    exit;
  end;

  // Is there an event at the clicked cell?
  FActiveEvent := GetEventAtCoord(FMouseDownPoint.X, FMouseDownPoint.Y);
  if (FActiveEvent <> nil) then
    // yes: edit the event
    SpawnEventEditDialog(False)
  else
  begin
    // no: add a new event
    dt := GetDateTimeAtCoord(FMouseDownPoint.X);
    if dt <> NO_DATE then
    begin
      startTime := DatePart(dt);
      endTime := startTime + 1.0 - OneSecond;
      FActiveEvent := Datastore.Resource.Schedule.AddEvent(
        Datastore.GetNextID(EventsTableName),
        startTime,
        endTime
      );
      FActiveEvent.AllDayEvent := true;
      SetActiveEvent(FActiveEvent);
      SpawnEventEditDialog(True);
    end;
  end;
  FMouseDownPoint := Point(0, 0);
end;

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

  DoIt := not Prompt;

  if FActiveEvent <> nil then begin
    if Assigned(FOnDeletingEvent) then
    begin
      DoIt := true;
      FOnDeletingEvent(self, FActiveEvent, DoIt);
    end else
    if Prompt then
      DoIt := (MessageDlg(RSConfirmDeleteEvent + LineEnding2 + RSPermanent,
        mtConfirmation, [mbYes, mbNo], 0) = mrYes);

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

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

function TVpGanttView.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheelDown(Shift, MousePos);
  if not Result then begin
    if Shift = [] then
      ScrollVertical(1)
    else if Shift = [ssCtrl] then
      ScrollHorizontal(1)
    else
      exit;
    Result := True;
  end;
end;

function TVpGanttView.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheelUp(Shift, MousePos);
  if not Result then begin
    if Shift = [] then
      ScrollVertical(-1)
    else if Shift = [ssCtrl] then
      ScrollHorizontal(-1)
    else
      exit;
    Result := True;
  end;
end;

procedure TVpGanttView.DoOnResize;
var
  emptyRows, emptyCols: Integer;
begin
  inherited;

  if (FRowHeight > 0) and Assigned(FEventRecords) and (FEventRecords.Count > 0) then
  begin
    VisibleRows := CalcVisibleRows(ClientHeight, FTotalColHeaderHeight, FRowHeight);
    emptyRows := VisibleRows - (FEventRecords.Count - FTopRow);
    if emptyRows > 0 then
      ScrollVertical(-emptyRows);

    VisibleCols := CalcVisibleCols(ClientWidth, FFixedColWidth, FColWidth);
    emptyCols := VisibleCols - (ColCount - FLeftCol);
    if emptyCols > 0 then
      ScrollHorizontal(-emptyCols);
  end;

  Invalidate;
end;

function TVpGanttView.GetColAtCoord(X: Integer): Integer;
begin
  Result := (X - FixedColWidth) div FColWidth + FLeftCol;
end;

{ Defines the initial size of the control. }
class function TVpGanttView.GetControlClassDefaultSize: TSize;
begin
  Result.CX := 300;
  Result.CY := 200;
end;

function TVpGanttView.GetControlType: TVpItemType;
begin
  Result := itGanttView;
end;

function TVpGanttView.GetDateFormat(AIndex: Integer): String;
begin
  Result := FDateFormat[AIndex];
end;

function TVpGanttView.GetDateOfCol(ACol: Integer): TDateTime;
begin
  Result := FRealStartDate + ColToDateIndex(ACol);
end;

function TVpGanttView.GetDateTimeAtCoord(X: Integer): TDateTime;
var
  c: Integer;
  dayIdx: Integer;
  dayPos: Integer;
  dayWidth: Integer;
  timePart: TTime;
begin
  c := GetColAtCoord(X);
  if (c >= 0) and (c < ColCount)  then
  begin
    Result := GetDateOfCol(c);
    X := X - FFixedColWidth;
    dayWidth := CalcDaysWidth(1);
    if HourMode then
    begin
      dayIdx := ColToDateIndex(c);
      dayPos := FDayRecords[dayIdx].Rect.Left - FFixedColWidth;
      dec(dayPos, FLeftCol * FColWidth);
      timePart := (((X - dayPos) / dayWidth) * HoursPerDay + ord(FStartHour)) / 24;
    end else
      timePart := frac(X / dayWidth);
    Result := Result + timePart;
  end
  else
    Result := NO_DATE;
end;

function TVpGanttView.GetDayRec(AIndex: Integer): TVpGanttDayRec;
begin
  Result := FDayRecords[AIndex];
end;

function TVpGanttView.GetEventAtCoord(X, Y: Integer): TVpEvent;
var
  idx: Integer;
  eventRec: PVpGanttEventRec;
  dt: TDateTime;
begin
  Result := nil;

  dt := GetDateTimeAtCoord(X);
  if (dt = NO_DATE) or (FRowHeight = 0) then
    exit;

  idx := GetRowAtCoord(Y);
  if (idx >= 0) and (idx < NumEvents) then
  begin
    eventRec := FEventRecords[idx];
    Result := eventRec^.Event;
    if Result.AllDayEvent then
    begin
      if (dt < DatePart(eventRec^.StartTime)) or (dt > DatePart(eventRec^.EndTime) + 1) then
        Result := nil;
    end else
      if (dt < eventRec^.StartTime) or (dt > eventRec^.EndTime) then
        Result := nil;
  end;
end;

{ Determines the dates when the earliest event in the entire Schedule starts,
  and when the latest event ends. }
procedure TVpGanttView.GetEventDateRange(out AFirstDate, ALastDate: TDate);
var
  i, j: Integer;
  event: TVpEvent = nil;
  d: TDateTime;
begin
  AFirstDate := NO_DATE;
  ALastDate := NO_DATE;
  if (Datastore = nil) or (Datastore.Resource = nil) or (Datastore.Resource.Schedule.EventCount = 0) then
    exit;

  // Find first non-recurring event; recurring events will be accepted only
  // between FStartDate and FEndDate.
  i := 0;
  repeat
    event := Datastore.Resource.Schedule.GetEvent(i);
    inc(i);
  until (event.RepeatCode = rtNone) or (i = DataStore.Resource.Schedule.EventCount);

  if event <> nil then
  begin
    AFirstDate := DatePart(event.StartTime);
    ALastDate := -99999;
    for j := i-1 to Datastore.Resource.Schedule.EventCount-1 do
    begin
      event := Datastore.Resource.Schedule.GetEvent(j);
      if event.RepeatCode = rtNone then
      begin
        d := DatePart(event.EndTime);
        if d > ALastDate then ALastDate := d;
      end;
    end;
  end;

  // To do: handle recurring events
end;

function TVpGanttView.GetEventOfRow(ARow: Integer): TVpEvent;
begin
  Result := EventRecords[ARow]^.Event;
end;

function TVpGanttView.GetEventRec(AIndex: Integer): PVpGanttEventRec;
begin
  Result := FEventRecords[AIndex];
end;

function TVpGanttView.GetHourRec(AIndex: Integer): TVpGanttHourRec;
begin
  Result := FHourRecords[AIndex];
end;

function TVpGanttView.GetMonthRec(AIndex: Integer): TVpGanttMonthRec;
begin
  Result := FMonthRecords[AIndex];
end;

{ Determines the number of days between the first and last Gantt event. This is
  the number of day columns in the view. }
function TVpGanttView.GetNumDays: Integer;
begin
  Result := 0;
  if ValidDate(FRealStartDate) and ValidDate(FRealEndDate) then
  begin
    Result := trunc(FRealEndDate) - trunc(FRealStartDate) + 1;
    if Result < 0 then
      Result := 0;
  end;
end;

{ Determines the number of events (= rows) to be displayed in the GanttView. }
function TVpGanttView.GetNumEvents: Integer;
begin
  if FEventRecords <> nil then
    Result := FEventRecords.Count
  else
    Result := 0;
end;

{ Determines the number of hours between the first and last Gantt event.
  This is the number of hour columns in the view. }
function TVpGanttView.GetNumHours: Integer;
begin
  Result := GetNumDays * HoursPerDay;
end;

{ Determines the number of months (complete or partial) between the first and
  last Gantt event. }
function TVpGanttView.GetNumMonths: Integer;
var
  y1, m1, d1: Word;
  y2, m2, d2: Word;
begin
  if ValidDate(FRealStartDate) and ValidDate(FRealEndDate) then
  begin
    DecodeDate(FRealStartDate, y1, m1, d1);
    DecodeDate(FRealEndDate, y2, m2, d2);
    if (y1 = y2) then
      Result := m2 - m1 + 1
    else
      Result := 13 - m1 + m2 + (y2 - y1 - 1)*12;
  end else
    Result := 0;
end;

{ Determines the number of weeks (complete or partial) between the first and
  last Gantt events.
  NOTE: Week calculations are based on ISO week numbers only! }
function TVpGanttView.GetNumWeeks: Integer;
var
  d1, d2: TVpDayType;
  dt1, dt2: TDate;
  wn1, wn2: Integer;
begin
  if ValidDate(FRealStartDate) and ValidDate(FRealEndDate) then
  begin
    d1 := GetVpDayType(FRealStartDate);
    d2 := GetVpDayType(FRealEndDate);
    if (FRealEndDate - FRealStartDate < 7) then
    begin
      wn1 := WeekOfTheYear(FRealStartDate);
      wn2 := WeekOfTheYear(FRealEndDate);
      if wn1 = wn2 then
        Result := 1
      else
        Result := 2;
      exit;
    end;

    if d1 = dtMonday then
    begin
      // No partial week at start
      Result := 0;
      dt1 := FRealStartDate;
    end else
    begin
      // Partial week at start
      Result := 1;
      dt1 := StartOfTheWeek(FRealStartDate) + 7; // Start of next week
    end;

    if d2 = dtSunday then
      // No partial week at end
      dt2 := FRealEndDate
    else begin
      // Partial week at the end
      Inc(Result);
      dt2 := StartOfTheWeek(FRealEndDate) - 1;
    end;

    Result := Result + (trunc(dt2) - trunc(dt1) + 1) div 7;
  end else
    Result := 0;
end;

{ Calculates the first and last date to be displayed in the GanttView. This
  is necessary because the properties StartDate and EndDate may be 0 which
  means the very first/last event. }
procedure TVpGanttView.GetRealEventDateRange(out AStartDate, AEndDate: TDate);
begin
  if ValidDate(FStartDate) then
    AStartDate := DatePart(FStartDate)
  else
    AStartDate := FFirstDate;

  if ValidDate(FEndDate) then
    AEndDate := DatePart(FEndDate)
  else
    AEndDate := FLastDate;
end;

function TVpGanttView.GetRowAtCoord(Y: Integer): Integer;
begin
  Result := (Y - FTotalColHeaderHeight) div FRowHeight + FTopRow;
end;

function TVpGanttView.GetRowOfEvent(AEvent: TVpEvent): Integer;
var
  i: Integer;
  eventRec: PVpGanttEventRec;
  found: Boolean;
begin
  for i := 0 to FEventRecords.Count-1 do
  begin
    eventRec := FEventRecords[i];
    if (eventRec^.Event = AEvent) then
    begin
      if AEvent.RepeatCode = rtNone then
        found := true
      else
        found := (DatePart(eventRec^.StartTime) <= FActiveDate) and (DatePart(eventRec^.EndTime) >= FActiveDate);
      if found then
      begin
        Result := i;
        exit;
      end;
    end;
  end;
  Result := -1;
end;

function TVpGanttView.GetWeekRec(AIndex: Integer): TVpGanttWeekRec;
begin
  Result := FWeekRecords[AIndex];
end;

{ If the component is being dropped on a form at designtime, then
  automatically hook up to the first datastore component found. }
procedure TVpGanttView.HookUp;
var
  I: Integer;
begin
  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;

function TVpGanttView.HourMode: Boolean;
begin
  Result := (gchHour in FColHeaderAttributes.Visible);
end;

function TVpGanttView.HoursPerDay: Integer;
begin
  Result := ord(FEndHour) - ord(FStartHour) + 1;
end;

procedure TVpGanttView.Init;
begin
  CalcRowHeight;
  CalcColHeaderHeight;

  GetEventDateRange(FFirstDate, FLastDate);
  GetRealEventDateRange(FRealStartDate, FRealEndDate);
  if HourMode then
    FColCount := GetNumHours
  else
    FColCount := GetNumDays;
  FRowCount := GetNumEvents;

  PopulateHourRecords;
  PopulateDayRecords;
  PopulateWeekRecords;
  PopulateMonthRecords;
  PopulateEventRecords;
end;

{ Checks whether the specified date belongs to the specified event.
  The function returns true if the event begins before or at the date and ends
  at or after it. }
function TVpGanttView.IsEventOnDate(AEvent: TVpEvent; ADate: TDate): Boolean;
var
  dEv1, dEv2: TDate;
begin
  if AEvent <> nil then
  begin
    dEv1 := DatePart(AEvent.StartTime);
    dEv2 := DatePart(AEvent.EndTime);
    Result := (dEv1 <= ADate) and (ADate <= dEv2);
  end else
    Result := false;
end;

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

procedure TVpGanttView.KeyDown(var Key: Word; Shift: TShiftState);

  procedure ScrollCols(ADelta: Integer);
  begin
    SetActiveCol(FActiveCol + ADelta);
    if FActiveCol <= FLeftCol then
      ScrollHorizontal(FActiveCol - FLeftCol)
    else
    if FActiveCol >= FLeftCol + FVisibleCols then
      ScrollHorizontal(FActiveCol - (FLeftCol + FVisibleCols) + 1);
  end;

  procedure ScrollRows(ADelta: Integer);
  begin
    FActiveRow := FActiveRow + ADelta;
    if FActiveRow < 0 then FActiveRow := 0;
    if FActiveRow >= RowCount then FActiveRow := RowCount-1;
//    SetActiveRow(FActiveRow + ADelta);
    if FActiveRow <= FTopRow then
      ScrollVertical(FActiveRow - FTopRow)
    else
    if FActiveRow >= FTopRow + FVisibleRows then
      ScrollVertical(FActiveRow - (FTopRow + FVisibleRows) + 1);
    SetActiveRow(FActiveRow);
  end;

var
  P: TPoint;
  OneDay: Integer;
  c: Integer;
begin
  inherited;

  if HourMode then
    OneDay := HoursPerDay
  else
    OneDay := 1;
  case Key of
    VK_LEFT:
      ScrollCols(-OneDay);
    VK_RIGHT:
      ScrollCols(OneDay);
    VK_DOWN:
      ScrollRows(1);
    VK_UP:
      ScrollRows(-1);
    VK_HOME:
      if Shift = [ssCtrl] then
      begin
        ActiveCol := 0;
        FLeftCol := 0;
      end else
      if Shift = [ssCtrl, ssShift] then
      begin
        ActiveCol := 0;
        ActiveRow := 0;
        FLeftCol := 0;
        FTopRow := 0;
      end else
      if Shift = [] then
        ScrollCols(-FVisibleCols);
    VK_END:
      if Shift = [ssCtrl] then
      begin
        ActiveCol := ColCount-1;
        ScrollHorizontal(FLeftCol + FVisibleCols);
      end else
      if Shift = [ssCtrl, ssShift] then
      begin
        ActiveCol := ColCount-1;
        ActiveRow := RowCount-1;
        FLeftCol := ColCount - FVisibleCols;
        if FLeftCol < 0 then FLeftCol := 0;
        FTopRow := RowCount - FVisibleRows;
        if FTopRow < 0 then FTopRow := 0;
      end else
        ScrollCols(FVisibleCols);
    VK_NEXT:
      if Shift = [ssCtrl] then     // ctrl + page down
        ScrollRows(FRowCount)
      else
        ScrollRows(FVisibleRows);  // page down
    VK_PRIOR:
      if Shift = [ssCtrl] then     // ctrl + page up
        ScrollRows(-FRowCount)
      else
        ScrollRows(-FVisibleRows); // page up
    VK_F10, VK_APPS:
      if (ssShift in Shift) then
      begin
        P := GetClientOrigin;
        if HourMode then
        begin
          P.X := P.X + FHourRecords[FActiveCol].Rect.Right;
          P.Y := P.Y + FHourRecords[FActiveCol].Rect.Top;
        end else
        begin
          P.X := P.X + FDayRecords[FActiveCol].Rect.Right;
          P.Y := P.Y + FDayRecords[FActiveCol].Rect.Top;
        end;
        PopupMenu.Popup(P.X + 10, P.Y + 10);
      end;
    VK_RETURN:
      PopupEditEvent(Self);
    VK_INSERT:
      PopupAddEvent(Self);
    VK_DELETE:
      DeleteActiveEvent(true);
    else
      exit;
  end;
  Invalidate;
  Key := 0;
end;

function TVpGanttView.IsStoredColWidth: Boolean;
begin
  Result := FColWidth <> DEFAULT_COLWIDTH;
end;

function TVpGanttView.IsStoredDateFormat(AIndex: Integer): Boolean;
begin
  case AIndex of
    0: Result := FDateFormat[0] <> DEFAULT_DAYFORMAT;
    1: Result := FDateFormat[1] <> DEFAULT_MONTHFORMAT;
    2: Result := FDateFormat[2] <> DEFAULT_MONTHFORMAT_SHORT;
    3: Result := FDateFormat[3] <> DEFAULT_DAYFORMAT_HOURMODE;
  end;
end;

function TVpGanttView.IsStoredEndHour: Boolean;
begin
  Result := FEndHour <> DEFAULT_END_HOUR;
end;

function TVpGanttView.IsStoredStartHour: Boolean;
begin
  Result := FStartHour <> DEFAULT_START_HOUR;
end;

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

procedure TVpGanttView.LinkHandler(Sender: TComponent;
  NotificationType: TVpNotificationType; const Value: Variant);
begin
  FInLinkHandler := true;
  try
    case NotificationType of
      neDateChange      : SetActiveDate(Value);
      neDataStoreChange : Invalidate;
      neInvalidate      : Invalidate;
    end;
  finally
    FInLinkHandler := false;
  end;
end;

procedure TVpGanttView.Loaded;
begin
  inherited;
  FLoaded := true;
  Populate;
end;

procedure TVpGanttView.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  dt: TDateTime;
begin
  inherited MouseDown(Button, Shift, X, Y);

  if not Focused then
    SetFocus;

  FMouseDownPoint := Point(X, Y);
  FActiveCol := GetColAtCoord(X);
  FActiveRow := GetRowAtCoord(Y);
  SetActiveEvent(GetEventAtCoord(X, Y));
  dt := GetDateTimeAtCoord(X);
  if dt <> NO_DATE then
    SetActiveDate(dt);

  Invalidate;
end;

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

procedure TVpGanttView.MouseLeave;
begin
  HideHintWindow;
end;

procedure TVpGanttView.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  event: TVpEvent;
begin
  inherited MouseMove(Shift, X, Y);
  if ShowHint then
  begin
    event := GetEventAtCoord(X, Y);
    if event = nil then
      HideHintWindow
    else
    if FMouseEvent <> event then begin
      ShowHintWindow(Point(X, Y), event);
      FMouseEvent := event;
    end;
  end;
end;

procedure TVpGanttView.Paint;
begin
  RenderToCanvas(
    Canvas,                      // Paint Canvas
    Rect(0, 0, Width, Height),   // Paint Rectangle
    ra0,                         // Rotation angle: none
    1,                           // Scale
    FActiveDate,                 // Date
    -1,                          // Start At
    -1,                          // End At
    gr30Min,                     // Granularity
    False                        // Display Only
  );
  SetVScrollPos;
  SetHScrollPos;
end;

procedure TVpGanttView.Populate;
begin
  if DataStore <> nil then
    DataStore.Date := FActiveDate;
end;

// Populates the array of TVpGanttRec records containing the date of each day
// cell and the *unscrolled* cell rectangle coordinates.
procedure TVpGanttView.PopulateDayRecords;
var
  i: Integer;
  x1, y1, x2, y2: Integer;
begin
  SetLength(FDayRecords, GetNumDays);
  x1 := FixedColWidth;
  y1 := 0;
  if (gchMonth in FColHeaderAttributes.Visible) then
    inc(y1, FMonthColHeaderHeight + FTextMargin);
  if (gchWeek in FColHeaderAttributes.Visible) then
    inc(y1, FWeekColHeaderHeight + FTextMargin);
  if (gchHour in FColHeaderAttributes.Visible) then
    y2 := y1 + FDayColHeaderHeight + FTextMargin
  else
    y2 := FTotalColHeaderHeight;
  for i := 0 to High(FDayRecords) do
  begin
    x2 := x1 + CalcDaysWidth(1);
    FDayRecords[i].Rect := Rect(x1, y1, x2, y2);
    FDayRecords[i].Date := FRealStartDate + i;
    x1 := x2;
  end;
end;

procedure TVpGanttView.PopulateEventRecords;
var
  event: TVpEvent;
  eventRec: PVpGanttEventRec;
  i: Integer;
  xh1, xh2, y1, xe1, xe2, y2: Integer;
  t1, t2: TDateTime;
  startHr, endHr: TDateTime;
  dayWidth, totalWidth: Integer;
  dayFactor, hourFactor: Double;
begin
  if (Datastore = nil) or (DataStore.Resource = nil) then
    exit;

  // The EventRecords list is supposed to collect all events displayed by the
  // GanttView.
  FEventRecords.Free;
  FEventRecords := TVpGanttEventList.Create(FRealStartDate, FRealEndDate);

  // Consider only events which are, fully or partly, inside the
  // displayed date range between FRealStartDate and FRealEndDate
  for i := 0 to Datastore.Resource.Schedule.EventCount-1 do
  begin
    event := Datastore.Resource.Schedule.GetEvent(i);
    if event.RepeatCode <> rtNone then
      FEventRecords.AddRecurringEvents(event)
    else
    begin
      if DatePart(event.EndTime) < FRealStartDate then
        continue;
      if DatePart(event.StartTime) > FRealEndDate then
        continue;
      FEventRecords.AddSingleEvent(event);
    end;
  end;

  // Sort events by date/time - this is a general requirement for Gantt
  FEventRecords.Sort(@CompareEventRecs);

  // Iterate over all considered events, fill the event record and store it
  // in the array
  xh1 := 0;
  xh2 := FixedColWidth;
  y1 := FTotalColHeaderHeight;
  totalWidth := CalcDaysWidth(GetNumDays);
  dayWidth := CalcDaysWidth(1);
  startHr := ord(FStartHour) / 24;
  endHr := (ord(FEndHour) + 1) / 24;     // extend to the end of the endhour box
  dayFactor := totalWidth / GetNumDays;
  hourFactor := dayWidth / HoursPerDay * 24;
  for i := 0 to FEventRecords.Count-1 do
  begin
    eventRec := FEventRecords[i];
    t1 := eventRec^.StartTime;
    t2 := eventRec^.EndTime;

    // Store event rectangle coordinates in the EventRec
    y2 := y1 + FRowHeight;
    if HourMode then
    begin
      // Visible beginning of day at which the event starts
      xe1 := round((DatePart(t1) - FRealStartDate) * dayFactor) + FixedColWidth;
      // Add time part if event starts after FStartHour
      if TimePart(t1) >= startHr then
        xe1 := xe1 + round((TimePart(t1) - startHr) * hourFactor);
      // Visible beginning of day at which the event ends
      xe2 := round((DatePart(t2) - FRealStartDate) * dayFactor) + FixedColWidth;
      // Add time part of event end, clipped at end of EndHour.
      if TimePart(t2) <= endHr then
        xe2 := xe2 + round((TimePart(t2) - startHr) * hourFactor)
      else
        xe2 := xe2 + round((endHr - startHr) * hourFactor);
    end else
    begin
      xe1 := round((t1 - FRealStartDate) / numDays * totalWidth) + FixedColWidth;
      xe2 := round((t2 - FRealStartDate) / numDays * totalWidth) + FixedColWidth;
    end;
    if xe1 = xe2 then xe2 := xe1 + 1;

    eventRec^.HeadRect := Rect(xh1, y1, xh2, y2);
    eventRec^.EventRect := Rect(xe1, y1, xe2, y2);

    // Find the active row. This is the row with the active event.
    if eventRec^.Event = FActiveEvent then
    begin
      if FActiveEvent.RepeatCode = rtNone then
        FActiveRow := i
      else
      if (DatePart(eventRec^.StartTime) <= FActiveDate) and (DatePart(eventRec^.EndTime) >= FActiveDate) then
        FActiveRow := i;
    end;

    // Prepare for next row
    y1 := y2;
  end;
end;

// Populates the array of TVpGanttRec records containing the hours of each day
// cell and the *unscrolled* cell rectangle coordinates.
procedure TVpGanttView.PopulateHourRecords;
var
  i: Integer;
  x1, y1, x2, y2: Integer;
  divRes: Integer = 0;
  modRes: Integer = 0;
begin
  SetLength(FHourRecords, GetNumHours);
  x1 := FixedColWidth;
  y1 := 0;
  if (gchMonth in FColHeaderAttributes.Visible) then
    inc(y1, FMonthColHeaderHeight + FTextMargin);
  if (gchWeek in FColHeaderAttributes.Visible) then
    inc(y1, FWeekColHeaderHeight + FTextMargin);
  if (gchDay in FColHeaderAttributes.Visible) then
    inc(y1, FDayColHeaderHeight + FTextMargin);
  y2 := FTotalColHeaderHeight;
  for i := 0 to High(FHourRecords) do
  begin
    x2 := x1 + ColWidth;
    FHourRecords[i].Rect := Rect(x1, y1, x2, y2);
    DivMod(i, HoursPerDay, divRes, modRes);
    FHourRecords[i].Date := FRealStartDate + divRes;
    FHourRecords[i].Hour := ord(FStartHour) + modRes;
    x1 := x2;
  end;
end;

procedure TVpGanttView.PopulateMonthRecords;
var
  i, n: Integer;
  x1, y1, x2, y2: Integer;
  dm: TDateTime;
  ndays: Integer;
begin
  n := GetNumMonths;
  SetLength(FMonthRecords, n);
  if (Datastore = nil) or (Datastore.Resource = nil) then
    exit;
  if not (gchMonth in FColHeaderAttributes.Visible) then
    exit;

  x1 := FixedColWidth;
  y1 := 0;
  if [gchWeek, gchDay] * FColHeaderAttributes.Visible = [gchWeek, gchDay] then
    y2 := FMonthColHeaderHeight + FTextMargin
  else
    y2 := FTotalColHeaderHeight;

  if n > 1 then
  begin
    // Date interval crosses one or more month boundaries
    dm := FRealStartDate;
    for i := 0 to n - 1 do
    begin
      if i = 0 then begin
        nDays := DaysInMonth(dm) - DayOf(dm) + 1;
        dm := StartOfTheMonth(dm);
      end else
      if i = n-1 then
        nDays := DayOf(FRealEndDate)
      else
        nDays := DaysInMonth(dm);
      if dm + nDays > FRealEndDate then
        nDays := trunc(FRealEndDate) - trunc(dm) + 1;
      x2 := x1 + CalcDaysWidth(nDays);
      FMonthRecords[i].Rect := Rect(x1, y1, x2, y2);
      FMonthRecords[i].Date := dm;
      dm := IncMonth(dm, 1);
      x1 := x2;
    end;
  end else
  begin
    // Date interval is within the same month
    nDays := DayOf(FRealEndDate) - DayOf(FRealStartDate) + 1;
    x2 := x1 + CalcDaysWidth(nDays);
    FMonthRecords[0].Rect := Rect(x1, y1, x2, y2);
    FMonthRecords[0].Date := FRealStartDate;
  end;
end;

procedure TVpGanttView.PopulateWeekRecords;
var
  i: Integer;
  x1, y1, x2, y2: Integer;
  d: TVpDayType;
  dt1, dt2: TDateTime;
begin
  if not (gchWeek in FColHeaderAttributes.Visible) then
  begin
    SetLength(FWeekRecords, 0);
    exit;
  end;

  SetLength(FWeekRecords, GetNumWeeks);
  if Length(FWeekRecords) = 0 then
    exit;

  x1 := FixedColWidth;
  y1 := 0;
  if (gchMonth in FColHeaderAttributes.Visible) then
    inc(y1, FMonthColHeaderHeight + FTextMargin);
  if (gchDay in FColHeaderAttributes.Visible) then
    y2 := y1 + FWeekColHeaderHeight + FTextMargin
  else
    y2 := FTotalColHeaderHeight;

  d := GetVpDayType(FRealStartDate);
  dt1 := FRealStartDate;
  if d = dtMonday then
    dt2 := dt1 + 6
  else
    dt2 := StartOfTheWeek(FRealStartDate + 7) - 1;
  if dt2 > FRealEndDate then
    dt2 := FRealEndDate;

  x2 := x1 + CalcDaysWidth(trunc(dt2) - trunc(dt1) + 1);
  FWeekRecords[0].Rect := Rect(x1, y1, x2, y2);
  FWeekRecords[0].Date := dt1;
  FWeekRecords[0].WeekNo := WeekOfTheYear(dt1);

  for i := 1 to High(FWeekRecords) do
  begin
    dt1 := dt2 + 1;
    dt2 := Min(dt1 + 6, FRealEndDate);
    x1 := x2;
    x2 := x1 + CalcDaysWidth(trunc(dt2) - trunc(dt1) + 1);
    FWeekRecords[i].Rect := Rect(x1, y1, x2, y2);
    FWeekRecords[i].Date := dt1;
    FWeekRecords[i].WeekNo := WeekOfTheYear(dt1);
  end;
end;

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

procedure TVpGanttView.SetDateLimits(AStartDate, AEndDate: TDateTime);
var
  oldDate: TDateTime;
begin
  oldDate := FActiveDate;

  FStartDate := AStartDate;
  FEndDate := AEndDate;
  Init;

  FActiveDate := 0;
  SetActiveDate(oldDate);
end;

{$IF VP_LCL_SCALING = 2}
procedure TVpGanttView.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin
  inherited;
  DoFixDesignFontPPI(ColHeaderAttributes.MonthFont, ADesignTimePPI);
  DoFixDesignFontPPI(ColHeaderAttributes.WeekFont, ADesignTimePPI);
  DoFixDesignFontPPI(ColHeaderAttributes.DayFont, ADesignTimePPI);
  DoFixDesignFontPPI(ColHeaderAttributes.HourFont, ADesignTimePPI);
  DoFixDesignFontPPI(RowHeaderAttributes.EventFont, ADesignTimePPI);
end;

procedure TVpGanttView.ScaleFontsPPI(const AToPPI: Integer;
  const AProportion: Double);
begin
  inherited;
  DoScaleFontPPI(ColHeaderAttributes.MonthFont, AToPPI, AProportion);
  DoScaleFontPPI(ColHeaderAttributes.WeekFont, AToPPI, AProportion);
  DoScaleFontPPI(ColHeaderAttributes.DayFont, AToPPI, AProportion);
  DoScaleFontPPI(ColHeaderAttributes.HourFont, AToPPI, AProportion);
  DoScaleFontPPI(RowHeaderAttributes.EventFont, AToPPI, AProportion);
end;
{$ELSEIF VP_LCL_SCALING = 1}
procedure TVpGantView.ScaleFontsPPI(const AProportion: Double);
begin
  inherited;
  DoScaleFontPPI(ColHeaderAttributes.MonthFont, AProportion);
  DoScaleFontPPI(ColHeaderAttributes.WeekFont, AProportion);
  DoScaleFontPPI(ColHeaderAttributes.DayFont, AProportion);
  DoScaleFontPPI(ColHeaderAttributes.HourFont, AProportion);
  DoScaleFontPPI(RowHeadAttributes.EventFont, AProportion);
end;
{$ENDIF}

procedure TVpGanttView.ScrollDateIntoView(ADate: TDateTime);
var
  nCols: Integer;
begin
  if (FRealStartDate = 0) or (FRealStartDate = NO_DATE) then
    exit;

  if HourMode then
    nCols := GetNumHours
  else
    nCols := GetNumDays;

  if ADate < FRealStartDate then
  begin
    FRealStartDate := DatePart(ADate);
    FColCount := nCols;
    SetLeftCol(-MaxInt);
  end else
  if ADate > FRealEndDate then
  begin
    FRealEndDate := DatePart(ADate);
    FColCount := nCols;
    SetLeftCol(FColCount - 1 - FVisibleCols);
  end else
  if ADate < FRealStartDate + FLeftCol then
  begin
    if HourMode then
      SetLeftCol((trunc(ADate) - trunc(FRealStartDate))*HoursPerDay)
    else
      SetLeftCol(trunc(ADate) - trunc(FRealStartDate));
  end else
  if ADate > FRealStartDate + FVisibleCols then
  begin
    if HourMode then
      SetLeftCol(trunc(ADate*HoursPerDay) - FVisibleCols)
    else
      SetLeftCol(trunc(ADate) - FVisibleCols);
  end else
    exit;
  Invalidate;
end;

procedure TVpGanttView.ScrollHorizontal(ANumCols: Integer);
begin
  SetLeftCol(FLeftCol + ANumCols);
  Invalidate;
end;

procedure TVpGanttView.ScrollRowIntoView(ARow: Integer);
begin
  if (ARow < TopRow) or (ARow >= TopRow + FVisibleRows) then
    SetTopRow(ARow - FVisibleRows div 2)
end;

procedure TVpGanttView.ScrollVertical(ANumRows: Integer);
begin
  SetTopRow(FTopRow + ANumRows);
  Invalidate;
end;

procedure TVpGanttView.SetActiveCol(AValue: Integer);
var
  R: TRect = (Left:0; Top:0; Right:0; Bottom:0);
  eventRect, dayRect: TRect;
  dt: TDateTime;
  event: TVpEvent;
  c: Integer;
begin
  if AValue <= 0 then
    FActiveCol := 0
  else if AValue >= ColCount then
    FActiveCol := ColCount - 1
  else
    FActiveCol := AValue;

  c := ColToDateIndex(FActiveCol);
  dt := DayRecords[c].Date;
  dayRect := DayRecords[c].Rect;

  event := EventRecords[FActiveRow]^.Event;
  eventRect := EventRecords[FActiveRow]^.EventRect;
  dayRect.Top := eventRect.Top;
  dayRect.Bottom := eventRect.Bottom;

  if IntersectRect(R, dayRect, eventRect) then
    SetActiveEvent(event)
  else
    SetActiveEvent(nil);

  SetActiveDate(dt);
end;

procedure TVpGanttView.SetActiveDate(AValue: TDateTime);
var
  days: Integer;
begin
  if FColHeaderAttributes = nil then   // Needed for HourMode
    exit;

  if FActiveDate <> DatePart(AValue) then begin
    FActiveDate := DatePart(AValue);

    if FLoaded then
      Populate;

    ScrollDateIntoView(FActiveDate);
    days := trunc(FActiveDate) - trunc(FRealStartDate);
    if HourMode then
      FActiveCol := days * HoursPerDay
    else
      FActiveCol := days;

    Invalidate;

    if (not FInLinkHandler) and (ControlLink <> nil) then
      ControlLink.Notify(self, neDateChange, FActiveDate);
  end;
end;

procedure TVpGanttView.SetActiveEvent(AValue: TVpEvent);
begin
  if FActiveEvent <> AValue then
  begin
    FActiveEvent := AValue;
    if FActiveEvent <> nil then
    begin
      FActiveRow := GetRowOfEvent(FActiveEvent);
      ScrollRowIntoView(FActiveRow);
    end;
  end;
  UpdatePopupMenuState;
end;

procedure TVpGanttView.SetActiveRow(AValue: Integer);
var
  R: TRect = (Left:0; Top:0; Right:0; Bottom:0);
  eventRect, dayRect: TRect;
  event: TVpEvent;
  dt: TDateTime;
  c: Integer;
begin
  if AValue < 0 then
    FActiveRow := 0
  else if AValue >= RowCount then
    FActiveRow := RowCount - 1
  else
    FActiveRow := AValue;

  event := EventRecords[FActiveRow]^.Event;
  eventRect := EventRecords[FActiveRow]^.EventRect;
  c := ColToDateIndex(FActiveCol);
  dt := DayRecords[c].Date;
  dayRect := DayRecords[c].Rect;
  dayRect.Top := eventRect.Top;
  dayRect.Bottom := eventRect.Bottom;

  if IntersectRect(R, dayRect, eventRect) then
    SetActiveEvent(event)
  else
    SetActiveEvent(nil);

  SetActiveDate(dt);
end;

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

procedure TVpGanttView.SetColWidth(AValue: Integer);
begin
  if FColWidth <> AValue then
  begin
    FColWidth := AValue;
    Invalidate;
  end;
end;

procedure TVpGanttView.SetDateFormat(AIndex: Integer; AValue: String);
begin
  if FDateFormat[AIndex] <> AValue then
  begin
    FDateFormat[AIndex] := AValue;
    Invalidate;
  end;
end;

procedure TVpGanttView.SetDrawingStyle(AValue: TVpDrawingStyle);
begin
  if FDrawingStyle <> AValue then
  begin
    FDrawingStyle := AValue;
    Invalidate;
  end;
end;

procedure TVpGanttView.SetEndHour(AValue: TVpHours);
begin
  if FEndHour <> AValue then
  begin
    FEndHour := AValue;
    Invalidate;
  end;
end;

procedure TVpGanttView.SetFixedColWidth(AValue: Integer);
begin
  if FFixedColWidth <> AValue then
  begin
    FFixedColWidth := AValue;
    Invalidate;
  end;
end;

procedure TVpGanttView.SetHolidayColor(AValue: TColor);
begin
  if FHolidayColor <> AValue then
  begin
    FHolidayColor := AValue;
    Invalidate;
  end;
end;

procedure TVpGanttView.SetHScrollPos;
var
  scrollInfo: TScrollInfo;
begin
  if not HandleAllocated then
    Exit;
  with scrollInfo do
  begin
    cbSize := SizeOf(scrollInfo);
    fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
    nMin := 0;
    nMax := FColCount;
    if FVisibleCols >= FColCount then
      nPage := nMax
    else
      nPage := FVisibleCols;
    if FLeftCol = pred(ColCount) - VisibleCols then
      nPos := ColCount
    else
      nPos := FLeftCol;
    nTrackPos := nPos;
  end;
  SetScrollInfo(Handle, SB_HORZ, scrollInfo, True);
end;

procedure TVpGanttView.SetLeftCol(AValue: Integer);
begin
  if AValue <> FLeftCol then begin
    if AValue + FVisibleCols >= FColCount then begin
      FLeftCol := FColCount - FVisibleCols;
      if FLeftCol < 0 then
        FLeftCol := 0;
      // Prevent the control from hanging at the right
      if (AValue < FLeftCol) and (AValue > 0) then
        FLeftCol := AValue;
    end
    else if AValue < 0 then
      FLeftCol := 0
    else
      FLeftCol := AValue;
    Invalidate;
    SetHScrollPos;
  end;
end;

procedure TVpGanttView.SetLineColor(AValue: TColor);
begin
  if FLineColor <> AValue then begin
    FLineColor := AValue;
    Repaint;
  end;
end;

procedure TVpGanttView.SetOptions(AValue: TVpGanttViewOptions);
begin
  if FOptions <> AValue then
  begin
    FOptions := AValue;
    Invalidate;
  end;
end;

procedure TVpGanttView.SetSpecialDayMode(AValue: TVpGanttSpecialDayMode);
begin
  if FSpecialDayMode <> AValue then
  begin
    FSpecialDayMode := AValue;
    Invalidate;
  end;
end;

procedure TVpGanttView.SetStartHour(AValue: TVpHours);
begin
  if FStartHour <> AValue then
  begin
    FStartHour := AValue;
    Invalidate;
  end;
end;

procedure TVpGanttView.SetTextMargin(AValue: Integer);
begin
  if FTextMargin <> AValue then
  begin
    FTextMargin := AValue;
    Invalidate;
  end;
end;

procedure TVpGanttView.SetTopRow(AValue: Integer);
begin
  if AValue <> FTopRow then begin
    if AValue + FVisibleRows >= RowCount then begin
      FTopRow := FRowCount - FVisibleRows;
      if FTopRow < 0 then
        FTopRow := 0;
      // Prevent the control from hanging at the bottom
      if (AValue < FTopRow) and (AValue > 0) then
        FTopRow := AValue;
    end
    else if AValue < 0 then
      FTopRow := 0
    else
      FTopRow:= AValue;
    Invalidate;
    SetVScrollPos;
  end;
end;

procedure TVpGanttView.SetVScrollPos;
var
  scrollInfo: TScrollInfo;
begin
  if not HandleAllocated then
    Exit;
  with scrollInfo do
  begin
    cbSize := SizeOf(scrollInfo);
    fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
    nMin := 0;
    nMax := FRowCount;
    if FVisibleRows >= FRowCount then
      nPage := nMax
    else
      nPage := FVisibleRows;
    if FTopRow = pred(RowCount) - VisibleRows then
      nPos := FRowCount
    else
      nPos := FTopRow;
    nTrackPos := nPos;
  end;
  SetScrollInfo(Handle, SB_VERT, scrollInfo, True);
end;

procedure TVpGanttView.SetWeekendColor(AValue: TColor);
begin
  if FWeekendColor <> AValue then
  begin
    FWeekendColor := AValue;
    Invalidate;
  end;
end;

procedure TVpGanttView.SetWeekStartsOn(Value: TVpDayType);
begin
  if FWeekStartsOn <> Value then begin
    FWeekStartsOn := Value;
    Invalidate;
  end;
end;

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

  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;

    // The new or edited event may be at a different position in the grid.
    // --> Re-read the events to sort them, find the new active row/col and
    // scroll them into view
    PopulateEventRecords;
    SetActiveDate(FActiveEvent.StartTime);
    ScrollRowIntoView(FActiveRow);

    if IsNewEvent and Assigned(FOnAddEvent) then
      FOnAddEvent(self, FActiveEvent);
    if not IsNewEvent and Assigned(FOnModifyEvent) then
      FOnModifyEvent(self, FActiveEvent);
  end else begin
    if IsNewEvent then begin
      FActiveEvent.Deleted := true;
      DataStore.PostEvents;
      SetActiveEvent(nil);
    end;
  end;
  Invalidate;
end;

procedure TVpGanttView.WMHScroll(var Msg: TLMHScroll);
begin
  case Msg.ScrollCode of
    SB_LINELEFT    : ScrollHorizontal(-1);
    SB_LINERIGHT   : ScrollHorizontal(1);
    SB_PAGELEFT    : ScrollHorizontal(-FVisibleCols);
    SB_PAGERIGHT   : ScrollHorizontal(FVisibleCols);
    SB_THUMBPOSITION, SB_THUMBTRACK : SetLeftCol(Msg.Pos);
  end;
end;

procedure TVpGanttView.WMVScroll(var Msg: TLMVScroll);
begin
  case Msg.ScrollCode of
    SB_LINEUP    : ScrollVertical(-1);
    SB_LINEDOWN  : ScrollVertical(1);
    SB_PAGEUP    : ScrollVertical(-FVisibleRows);
    SB_PAGEDOWN  : ScrollVertical(FVisibleRows);
    SB_THUMBPOSITION, SB_THUMBTRACK : SetTopRow(Msg.Pos);
  end;
end;


{ Hint support }

procedure TVpGanttView.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) then
  begin
    Hint := txt;
    Application.Hint := Hint;
    Application.ActivateHint(ClientToScreen(APoint), true);
  end;
end;

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

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

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


{ Popup menu }

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

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

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

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

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

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

procedure TVpGanttView.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;

  // Create the new event as an all-day event for the clicked day.
  startTime := DatePart(FActiveDate);
  endTime := startTime + 1 - OneMilliSecond;
  FActiveEvent := DataStore.Resource.Schedule.AddEvent(
    DataStore.GetNextID(EventsTableName),
    StartTime,
    EndTime
  );
  FActiveEvent.AllDayEvent := true;

  // Edit this new event
  SpawnEventEditDialog(True);
end;

procedure TVpGanttView.PopupDeleteEvent(Sender: TObject);
begin
  if ReadOnly then
    Exit;
  Invalidate;
  if FActiveEvent <> nil then
    DeleteActiveEvent(True);
end;

procedure TVpGanttView.PopupEditEvent(Sender: TObject);
begin
  if ReadOnly then
    Exit;
  Invalidate;
  if FActiveEvent <> nil then
    // edit this event
    SpawnEventEditDialog(false);
end;

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

end.