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

{*********************************************************}
{*                 VPWEEKVIEW.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 handles the TVpWeekView component as well as it's inline editor
  and navigation.

  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.  
}
{$I Vp.INC}

unit VpWeekView;

interface

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

type
  TVpWeekdayRec = packed record
    Rec: TRect;
    Day: TDateTime;
  end;

type
  TVpWeekdayArray = array of TVpWeekdayRec;

  { Forward Declarations }
  TVpWeekView = class;

  TVpWvInPlaceEdit = class(TCustomEdit)
  protected{private}
    procedure CreateParams(var Params: TCreateParams); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

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

  TVpDayHeadAttr = class(TPersistent)
  protected{private}
    FWeekView: TVpWeekView;
    FFont: TFont;
    FDateFormat: string;
    FColor: TColor;
    FBordered: Boolean;
    procedure SetColor(Value: TColor);
    procedure SetFont(Value: TFont);
    procedure SetBordered(Value: Boolean);
    procedure SetDateFormat(Value: string);
  public
    constructor Create(AOwner: TVpWeekView);
    destructor Destroy; override;
    property WeekView: TVpWeekView read FWeekView;
  published
    property Color: TColor read FColor write SetColor;
    property DateFormat: string read FDateFormat write SetDateFormat;
    property Font: TFont read FFont write SetFont;
    property Bordered: Boolean read FBordered write SetBordered;
  end;

  { TVpWeekView }

  TVpWeekView = class(TVpLinkableControl)
  private
    procedure SetActiveEvent(AValue: TVpEvent);
  protected{ private }
    FActiveDate: TDateTime;
    FColumnWidth: Integer;
    FColor: TColor;
    FDateLabelFormat: string;
    FDayHeadAttributes: TVpDayHeadAttr;
    FDrawingStyle: TVpDrawingStyle;
    FaActiveEvent: TVpEvent;
    FHeadAttr: TVpWvHeadAttributes;
    FEventFont: TFont;
    FLineColor: TColor;
    FLineCount: Integer;
    FTimeFormat: TVpTimeFormat;
    FShowEventTime: Boolean;
    FVisibleLines: Integer;
    FWeekStartsOn: TVpDayType;
    FDefaultPopup: TPopupMenu;
    FAllDayEventAttr: TVpAllDayEventAttributes;
    { event variables }
    FBeforeEdit: TVpBeforeEditEvent;
    FAfterEdit: TVpAfterEditEvent;
    FOwnerEditEvent: TVpEditEvent;
    FOnAddEvent: TVpOnAddNewEvent;
    { internal variables }
    wvInLinkHandler: Boolean;
    wvClickTimer: TTimer;
    wvLoaded: Boolean;
    wvRowHeight: Integer;
    wvDayHeadHeight: Integer;
    wvHeaderHeight: Integer;
    wvStartDate: TDateTime;
    wvSpinButtons: TUpDown;
    wvEventList: TList;
    wvEventArray: TVpEventArray;
    wvWeekdayArray: TVpWeekdayArray;
    wvActiveEventRec: TRect;
    wvInPlaceEditor: TVpWvInPlaceEdit;
    wvCreatingEditor: Boolean;
    wvPainting: Boolean;
    wvHotPoint: TPoint;

    { property methods }
    procedure SetDrawingStyle(Value: TVpDrawingStyle);
    procedure SetColor(Value: TColor);
    procedure SetLineColor(Value: TColor);
    procedure SetDateLabelFormat(Value: string);
    procedure SetEventFont(Value: TFont);
    procedure SetShowEventTime(Value: Boolean);
    procedure SetTimeFormat(Value: TVpTimeFormat);
    procedure SetActiveDate(Value: TDateTime);
    procedure SetWeekStartsOn(Value: TVpDayType);
    { internal methods }
    procedure wvEditInPlace(Sender: TObject);
    procedure wvHookUp;
    procedure PopupAddEvent(Sender: TObject);
    procedure PopupDeleteEvent(Sender: TObject);
    procedure PopupEditEvent(Sender: TObject);
    procedure PopupToday(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 InitializeDefaultPopup;
    procedure Paint; override;
    procedure Loaded; override;
    procedure wvSpawnEventEditDialog(NewEvent: Boolean);
    procedure wvPopulate;
    procedure wvSpinButtonClick(Sender: TObject; Button: TUDBtnType);
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    function EventAtCoord(Pt: TPoint): Boolean;
    procedure wvSetDateByCoord(Point: TPoint);
    procedure EditEvent;
    procedure EndEdit(Sender: TObject);
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    { message handlers }
    {$IFNDEF LCL}
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure WMLButtonDown(var Msg : TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMRButtonDown(var Msg : TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey);
              message CM_WANTSPECIALKEY;
    {$ELSE}
    procedure WMSize(var Msg: TLMSize); message LM_SIZE;
    procedure WMLButtonDown(var Msg : TLMLButtonDown); message LM_LBUTTONDOWN;
    procedure WMLButtonDblClk(var Msg : TLMLButtonDblClk); message LM_LBUTTONDBLCLK;
    //TODO: Bug 0020755 braks this in GTK2...
    procedure WMRButtonDown(var Msg : TLMRButtonDown); message LM_RBUTTONDOWN;
    {$ENDIF}

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadLanguage;
    procedure DeleteActiveEvent(Verify: Boolean);
    procedure Invalidate; override;
    procedure LinkHandler(Sender: TComponent;
      NotificationType: TVpNotificationType; const Value: Variant); override;
    function GetControlType: TVpItemType; override;
    procedure EditSelectedEvent;
    procedure PaintToCanvas(ACanvas: TCanvas;  ARect: TRect;
      Angle: TVpRotationAngle; ADate: TDateTime);
    procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
      Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
      StartLine: Integer; StopLine: Integer; UseGran: TVpGranularity;
      DisplayOnly: Boolean); override;
    property ActiveEvent: TVpEvent read FaActiveEvent write SetActiveEvent;
    property Date: TDateTime read FActiveDate write SetActiveDate;
    property VisibleLines: Integer read FVisibleLines;

  published
    property AllDayEventAttributes: TVpAllDayEventAttributes
      read FAllDayEventAttr write FAllDayEventAttr;
    property Color: TColor read FColor write SetColor;
    property DateLabelFormat: string read FDateLabelFormat write SetDateLabelFormat;
    property DayHeadAttributes: TVpDayHeadAttr read FDayHeadAttributes write FDayHeadAttributes;
    property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle stored True;
    property EventFont: TFont read FEventFont write SetEventFont;
    property HeadAttributes: TVpWvHeadAttributes read FHeadAttr write FHeadAttr;
    property LineColor: TColor read FLineColor write SetLineColor;
    property TimeFormat: TVpTimeFormat read FTimeFormat write SetTimeFormat;
    property ShowEventTime: Boolean read FShowEventTime write SetShowEventTime;
    property WeekStartsOn: TVpDayType read FWeekStartsOn write SetWeekStartsOn;

    {inherited properties}
    property Align;
    property Anchors;
    property TabStop;
    property TabOrder;

    {events}
    property AfterEdit : TVpAfterEditEvent read FAfterEdit write FAfterEdit;
    property BeforeEdit: TVpBeforeEditEvent read FBeforeEdit write FBeforeEdit;
    property OnAddEvent: TVpOnAddNewEvent read FOnAddEvent write FOnAddEvent;
    property OnOwnerEditEvent: TVpEditEvent read FOwnerEditEvent write FOwnerEditEvent;

  end;

implementation

uses
  SysUtils, Math, LazUTF8, Forms, Dialogs, VpEvntEditDlg;

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

constructor TVpWvInPlaceEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  TabStop := False;
  BorderStyle := bsNone;
  {$IFDEF VERSION4}
  DoubleBuffered := False;
  {$ENDIF}
end;
{=====}

procedure TVpWvInPlaceEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
//  Params.Style := Params.Style or ES_MULTILINE;
end;
{=====}

procedure TVpWvInPlaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
  Grid: TVpWeekView;
begin
  Grid := TVpWeekView(Owner);

  case Key of
  VK_RETURN:
    begin
      Key := 0;
      Grid.EndEdit(Self);
    end;

  VK_UP:
    begin
      Key := 0;
      Grid.EndEdit(Self);
    end;

  VK_DOWN:
    begin
      Key := 0;
      Grid.EndEdit(Self);
    end;

  VK_ESCAPE:
    begin
      Key := 0;
      Grid.EndEdit(self);
    end;

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

(*****************************************************************************)
{ TVpContactHeadAttr }
constructor TVpDayHeadAttr.Create(AOwner: TVpWeekView);
begin
  inherited Create;
  FWeekView := AOwner;
  FDateFormat := 'dddd mmmm, dd';
  FFont := TFont.Create;
  FFont.Assign(FWeekView.Font);
  FFont.Size := 8;
  FColor := clSilver;
  FBordered := true;
end;
{=====}

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

procedure TVpDayHeadAttr.SetBordered(Value: Boolean);
begin
  if Value <> FBordered then begin
    FBordered := Value;
    WeekView.Invalidate;
  end;
end;
{=====}

procedure TVpDayHeadAttr.SetDateFormat(Value: string);
begin
  if Value <> FDateFormat then begin
    FDateFormat := Value;
    WeekView.Invalidate;
  end;
end;
{=====}

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

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

(*****************************************************************************)
{ TVpWeekView }

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

  { Create internal classes and stuff }
  FDayHeadAttributes := TVpDayHeadAttr.Create(self);
  FHeadAttr := TVpWvHeadAttributes.Create(self);
  FAllDayEventAttr := TVpAllDayEventAttributes.Create (self);

  FEventFont := TFont.Create;
  FEventFont.Assign(Font);
  FShowEventTime := true;
  wvInLinkHandler := false;
  wvEventList := TList.Create;
  wvClickTimer := TTimer.Create(self);
  wvSpinButtons := TUpDown.Create(self);
  wvSpinButtons.OnClick := wvSpinButtonClick;
  wvSpinButtons.Orientation := udHorizontal;
  wvSpinButtons.Min := -32768;
  wvSpinButtons.Max := 32767;
  wvHotPoint := Point(0, 0);

  { Set styles and initialize internal variables }
  {$IFDEF VERSION4}
  DoubleBuffered := true;
  {$ENDIF}

  FWeekStartsOn := dtMonday;
  wvClickTimer.Enabled := false;
  wvClickTimer.Interval := ClickDelay;
  wvClickTimer.OnTimer := wvEditInPlace;
  wvCreatingEditor := false;
  FDrawingStyle := ds3d;
  wvPainting := false;
  FColor := clWindow;
  FLineColor := clGray;
  FActiveDate := Now;
  wvStartDate := trunc(GetStartOfWeek(Now, FWeekStartsOn));
  FTimeFormat := tf12Hour;
  FDateLabelFormat := 'dddd, mmmm dd, yyyy';
  FColumnWidth := 200;

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

  SetLength(wvEventArray, MaxVisibleEvents);
  SetLength(wvWeekdayArray, 7);

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

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

  FAllDayEventAttr.BackgroundColor := Color;
  FAllDayEventAttr.EventBackgroundColor := clBtnFace;
  FAllDayEventAttr.EventBorderColor := LineColor;
  FAllDayEventAttr.Font.Assign (Font);

  wvHookUp;
end;
{=====}

destructor TVpWeekView.Destroy;
begin
  FreeAndNil(wvInplaceEditor);
  FDayHeadAttributes.Free;
  FAllDayEventAttr.Free;
  FHeadAttr.Free;
  wvClickTimer.Free;
  FEventFont.Free;
  wvSpinButtons.Free;
  wvEventList.Free;
  FDefaultPopup.Free;
  inherited;
end;

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

{=====}

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

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

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

procedure TVpWeekView.Loaded;
begin
  inherited;
  wvLoaded := true;
  wvPopulate;
end;
{=====}

function TVpWeekView.GetControlType : TVpItemType;
begin
  Result := itWeekView;
end;

procedure TVpWeekView.Paint;
begin
  RenderToCanvas(
    Canvas,                      // Paint Canvas
    Rect (0, 0, Width, Height),  // Paint Rectangle
    ra0,
    1,                           // Scale
    wvStartDate,                 // Date
    -1,                          // Start At
    -1,                          // End At
    gr30Min,
    False                        // Display Only
  );
end;
{=====}

procedure TVpWeekView.PaintToCanvas(ACanvas: TCanvas; ARect: TRect;
  Angle: TVpRotationAngle; ADate: TDateTime);
begin
  RenderToCanvas(ACanvas, ARect, Angle, 1, ADate, -1, -1, gr30Min, True);
end;
{=====}

procedure TVpWeekView.RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
  Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
  StartLine: Integer; StopLine: Integer; UseGran: TVpGranularity;
  DisplayOnly: Boolean);
var
  HeadRect: TRect;
  SaveBrushColor: TColor;
  SavePenStyle: TPenStyle;
  SavePenColor: TColor;
  DayRectHeight: Integer;
  StrLn: Integer;
  StartDate: TDateTime;
  RealWidth: Integer;
  RealHeight: Integer;
  RealLeft: Integer;
  RealRight: Integer;
  RealTop: Integer;
  RealBottom: Integer;
  ADEventsRect: TRect;
  Rgn: HRGN;

  DotDotDotColor: TColor;
  BevelHighlightColor: TColor;
  BevelShadowColor: TColor;
  BevelDarkShadow: TColor;
  BevelButtonFace: TColor;
  RealLineColor: TColor;
  RealDayHeadAttrColor: TColor;
  RealColor: TColor;
  RealHeadAttrColor: TColor;
  ADBackgroundColor: TColor;
  ADEventBackgroundColor: TColor;
  ADEventBorderColor: TColor;

  function DrawAllDayEvents(ADate: TDateTime; DayRect: TRect;
    var EAIndex: Integer): Boolean;
  var
    ADEventsList: TList;
    TempList: TList;
    I, J, K: Integer;
    Event: TVpEvent;
    ADEventRect: TRect;
    StartsBeforeRange: Boolean;
    MaxADEvents: Integer;
    Skip: Boolean;
    ADTextHeight: Integer;
    EventStr: string;
  begin
    Result := False;
    { initialize the All Day Events area... }
    ADEventsRect := DayRect;

    if (DataStore = nil) or (DataStore.Resource = nil) then
      Exit;

    { Collect all of the events for this range and determine the maximum     }
    { number of all day events for the range of days covered by the control. }
    MaxADEvents := 0;

    ADEventsList := TList.Create;
    try
      TempList := TList.Create;
      try
        { get the all day events for the day specified by ADate + I }
        DataStore.Resource.Schedule.AllDayEventsByDate(ADate, TempList);

        { Iterate through these events and place them in ADEventsList }
        Skip := false;
        for J := 0 to pred(TempList.Count) do begin
          if AdEventsList.Count > 0 then begin
            for K := 0 to pred(AdEventsList.Count) do begin
              if TVpEvent(AdEventsList[K]) = TVpEvent(TempList[J]) then begin
                Skip := true;
                Break;
              end;
            end;
            if not Skip then
              AdEventsList.Add(TempList[J]);
          end else
            AdEventsList.Add(TempList[J]);
        end;

        if TempList.Count > MaxADEvents then
          MaxADEvents := TempList.Count;
      finally
        TempList.Free;
      end;

      if MaxADEvents > 0 then begin
        { Set attributes }
        RenderCanvas.Brush.Color := ADBackgroundColor;
        RenderCanvas.Font.Assign(AllDayEventAttributes.Font);

        { Measure the AllDayEvent TextHeight }
        ADTextHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + TextMargin div 2;

        { Build the AllDayEvent rect based on the value of MaxADEvents }
        if AdEventsRect.Top + (MaxADEvents * ADTextHeight) + TextMargin * 2 > DayRect.Bottom
        then
          ADeventsrect.Bottom := DayRect.Bottom
        else
          ADEventsRect.Bottom := AdEventsRect.Top + (MaxADEvents * ADTextHeight) + TextMargin * 2;

        { Clear the AllDayEvents area }
        TpsFillRect(RenderCanvas, Angle, RenderIn, ADEventsRect);

        StartsBeforeRange  := false;
        { Cycle through the all day events and draw them appropriately }
        for I := 0 to pred(ADEventsList.Count) do begin
          Event := ADEventsList[I];

          { set the top of the event's rect }
          AdEventRect.Top := ADEventsRect.Top + TextMargin + I * ADTextHeight;

          if ADEventsRect.Top + TextMargin + ((I + 1)  * ADTextHeight) - TextMargin > DayRect.Bottom
          then begin
            RenderCanvas.Brush.Color := DotDotDotColor;
            { draw dot dot dot }
            TPSFillRect(RenderCanvas, Angle, RenderIn,
              Rect(DayRect.Right - 20,  DayRect.Bottom - 7, DayRect.Right - 17,  DayRect.Bottom - 4));
            TPSFillRect(RenderCanvas, Angle, RenderIn,
              Rect(DayRect.Right - 13,  DayRect.Bottom - 7, DayRect.Right - 10,  DayRect.Bottom - 4));
            TPSFillRect(RenderCanvas, Angle, RenderIn,
              Rect(DayRect.Right - 6,  DayRect.Bottom - 7, DayRect.Right -  3,  DayRect.Bottom - 4));
            break;
          end;

          { see if the event began before the start of the range }
          if (Event.StartTime < trunc(RenderDate)) then
            StartsBeforeRange := true;

          AdEventRect.Bottom := ADEventRect.Top + ADTextHeight;
          AdEventRect.Left := AdEventsRect.Left + (TextMargin div 2);
          AdEventRect.Right := DayRect.Right;

          if (StartsBeforeRange) then
            EventStr := '>> '
          else
            EventStr := '';

          EventStr := EventStr + Event.Description;

          RenderCanvas.Brush.Color := ADEventBackgroundColor;
          RenderCanvas.Pen.Color := ADEventBorderColor;
          TPSRectangle(RenderCanvas, Angle, RenderIn,
            ADEventRect.Left + TextMargin,
            ADEventRect.Top + TextMargin div 2,
            ADEventRect.Right - TextMargin,
            ADEventRect.Top + ADTextHeight + TextMargin div 2
          );
          TPSTextOut(RenderCanvas,Angle, RenderIn,
            AdEventRect.Left + TextMargin * 2 + TextMargin div 2,
            AdEventRect.Top + TextMargin,
            EventStr
          );
          Result := True;
          wvEventArray[EAIndex].Rec := Rect(
            ADEventRect.Left + TextMargin,
            ADEventRect.Top + TextMargin,
            ADEventRect.Right - TextMargin,
            ADEventRect.Bottom
          );
          wvEventArray[EAIndex].Event := Event;
          Inc(EAIndex);
        end; { for I := 0 to pred(ADEventsList.Count) do ... }

      end;   { if MaxADEvents > 0 }

    finally
      ADEventsList.Free;
    end;
  end;
    
  procedure DrawDays;
  var
    DayRect: TRect;
    TextRect: TRect;
    I, J, SL: Integer;
    EAIndex: Integer;
    DayStr: string;
    EventList: TList;
    TodayStartTime: Double;
    TodayEndTime: Double;
  begin
    RenderCanvas.Pen.Color := RealLineColor;
    RenderCanvas.Pen.Style := psSolid;
    { initialize WeekdayArray }
    for I := 0 to pred(Length(wvWeekdayArray)) do begin
      wvWeekdayArray[I].Rec.TopLeft := Point(-1, -1);
      wvWeekdayArray[I].Rec.BottomRight := Point(-1, -1);
      wvWeekdayArray[I].Day := 0;
    end;

    { initialize Event Array }
    EAIndex := 0;
    for I := 0 to pred(Length(wvEventArray)) do begin
      wvEventArray[I].Rec.TopLeft := Point(-1, -1);
      wvEventArray[I].Rec.BottomRight := Point(-1, -1);
      wvEventArray[I].Event := nil;
    end;

    RenderCanvas.Pen.Color := RealLineColor;
    { build the first dayrect }
    DayRectHeight := (RealBottom - RealTop - wvHeaderHeight) div 3;
    if DrawingStyle = ds3D then
      DayRect.TopLeft := Point(RealLeft + 1, RealTop + wvHeaderHeight + 3)
    else
      DayRect.TopLeft := Point(RealLeft + 1, RealTop + wvHeaderHeight + 2);
    DayRect.BottomRight := Point(
      RealLeft + (RealRight - RealLeft) div 2 + 1,
      RealTop + wvHeaderHeight + DayRectHeight
    );

    { draw the day frames }
    for I := 0 to 6 do begin
      { draw day head}
      RenderCanvas.Font.Assign(FDayHeadAttributes.Font);
      RenderCanvas.Brush.Color := RealDayHeadAttrColor;
      TextRect := Rect(DayRect.Left, DayRect.Top, DayRect.Right, DayRect.Top + wvDayHeadHeight);
      TPSFillRect (RenderCanvas, Angle, RenderIn, TextRect);
      if FDayHeadAttributes.Bordered then
        TPSRectangle (RenderCanvas, Angle, RenderIn, TextRect);
      { Fix Header String }
      {$IF FPC_FULLVERSION >= 30000}
      DayStr := FormatDateTime(FDayHeadAttributes.DateFormat, StartDate + I);
      {$ELSE}
      DayStr := SysToUTF8(FormatDateTime(FDayHeadAttributes.DateFormat, StartDate + I));
      {$ENDIF}
      SL := RenderCanvas.TextWidth(DayStr);
      if SL > TextRect.Right - TextRect.Left then
        DayStr := GetDisplayString(RenderCanvas, DayStr, 0, TextRect.Right - TextRect.Left - TextMargin);
      SL := RenderCanvas.TextWidth(DayStr);
      TextRect.Left := TextRect.Right - SL - TextMargin;
      TPSTextOut(RenderCanvas, Angle, RenderIn,
        TextRect.Left, TextRect.Top + TextMargin - 1, DayStr
      );

      if (DataStore <> nil) and (DataStore.Resource <> nil) and
         (DataStore.Resource.Schedule.EventCountByDay(StartDate + I) > 0) and
         (DayRect.Bottom - DayRect.Top >= (TextMargin * 2) + wvDayHeadHeight)
      then begin
        { events exist for this day }
        EventList := TList.Create;
        try
          { populate the eventlist with events for this day }
          DataStore.Resource.Schedule.EventsByDate(StartDate + I, EventList);
          { initialize TextRect for this day }
          TextRect.TopLeft := Point(DayRect.Left, DayRect.Top + wvDayHeadHeight);
          TextRect.BottomRight := Point(DayRect.Right, TextRect.Top + wvRowHeight);

          { Handle All Day Events }
          if DrawAllDayEvents (StartDate + I, Rect(TextRect.Left, TextRect.Top, TextRect.Right, DayRect.Bottom), EAIndex)
          then begin
            TextRect.Bottom := TextRect.Bottom + ADEventsRect.Bottom - TextRect.Top;
            TextRect.Top := ADEventsRect.Bottom;
          end;

          { Discard AllDayEvents, because they are drawn above. }
          for J := pred(EventList.Count) downto 0 do
            if TVpEvent (EventList[J]).AllDayEvent then
              EventList.Delete(J);

          { iterate the events, painting them one by one }
          for J := 0 to pred(EventList.Count) do begin
            { if the TextRect extends below the available space then draw a   }
            { dot dot dot to indicate there are more events than can be drawn }
            { in the available space }
            if TextRect.Bottom - TextMargin > DayRect.Bottom then begin
              RenderCanvas.Brush.Color := DotDotDotColor;
              { draw dot dot dot }
              TPSFillRect(RenderCanvas, Angle, RenderIn,
                Rect(DayRect.Right - 20,  DayRect.Bottom - 7, DayRect.Right - 17,  DayRect.Bottom - 4)
              );
              TPSFillRect(RenderCanvas, Angle, RenderIn,
                Rect(DayRect.Right - 13,  DayRect.Bottom - 7, DayRect.Right - 10,  DayRect.Bottom - 4)
              );
              TPSFillRect(RenderCanvas, Angle, RenderIn,
                Rect(DayRect.Right - 6,  DayRect.Bottom - 7, DayRect.Right -  3,  DayRect.Bottom - 4)
              );
              break;
            end;

            { format the display text }
            DayStr := '';
            TodayStartTime := TVpEvent(EventList.List^[j]).StartTime;
            TodayEndTime := TVpEvent(EventList.List^[j]).EndTime;
            if trunc(TodayStartTime) < trunc(StartDate + I) then //First Event
              TodayStartTime := 0;
            if trunc(TodayEndTime) > trunc(StartDate + I) then //Last Event
              TodayEndTime := 0.9999;
            if ShowEventTime then
            begin
              if TimeFormat = tf24Hour then
                DayStr := FormatDateTime('hh:nn',TodayStartTime) + ' - ' +
                          FormatDateTime('hh:nn',TodayEndTime) + ': '
              else
                DayStr := FormatDateTime('hh:nn AM/PM',TVpEvent(EventList.List^[j]).StartTime) + ' - ' +
                          FormatDateTime('hh:nn AM/PM',TVpEvent(EventList.List^[j]).EndTime) + ': ';
            end;
            if DayStr = '' then
              DayStr := TVpEvent(EventList.List^[j]).Description
            else
              DayStr := DayStr + ' '
                + TVpEvent(EventList.List^[j]).Description;

            { set the event font }
            RenderCanvas.Font.Assign(FEventFont);
            RenderCanvas.Brush.Color := RealColor;

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

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

            { update the EventArray }
            wvEventArray[EAIndex].Rec := TextRect;
            wvEventArray[EAIndex].Event := TVpEvent(EventList.List^[j]);
            Inc(EAIndex);

            TextRect.Top := TextRect.Bottom;
            TextRect.Bottom := TextRect.Top + wvRowHeight;
          end; { for loop }
        finally
          EventList.Free;
        end;
      end;

      { Draw focus rect if this is the current day }

      if (not DisplayOnly) and (StartDate + I = Trunc (FActiveDate)) and Focused
      then
        TPSDrawFocusRect(RenderCanvas, Angle, RenderIn, Rect(
          DayRect.Left + 2,
          DayRect.Top + wvDayHeadHeight + 2,
          DayRect.Right - 2,
          DayRect.Bottom - 2
        ));

      { update WeekdayArray }
      wvWeekdayArray[I].Rec := DayRect;
      wvWeekdayArray[I].Day := StartDate + I;
      { adjust the DayRect for the next day }
      if (I = 2) then begin
        { move the dayrect to the top of the next column }
        if DrawingStyle = ds3D then begin
          DayRect.TopLeft := Point(
            RealLeft + (RealRight - RealLeft) div 2,
            RealTop + wvHeaderHeight + 3
          );
          DayRect.BottomRight := Point(
            RealRight - 2,
            RealTop + wvHeaderHeight + DayRectHeight
          );
        end
        else begin
          DayRect.TopLeft := Point(
            RealLeft + (RealRight - RealLeft) div 2,
            RealTop + wvHeaderHeight + 2
          );
          DayRect.BottomRight := Point(
            RealRight - 1,
            RealTop + wvHeaderHeight + DayRectHeight
          );
        end;
      end

      else if (I = 4 {Friday}) then begin
        { shrink DayRect for weekend days }
        DayRectHeight := DayRectHeight div 2;
        DayRect.Top := DayRect.Bottom;
        DayRect.Bottom := DayRect.Top + DayRectHeight;
      end
      else begin
        DayRect.Top := DayRect.Bottom;
        DayRect.Bottom := DayRect.Top + DayRectHeight;
      end;

    end;

    { Draw the center vertical line }
    RenderCanvas.Pen.Color := RealLineColor;
    TPSMoveTo(RenderCanvas, Angle, RenderIn,
      RealLeft + (RealRight - RealLeft) div 2, RealTop + wvHeaderHeight + 2
    );
    TPSLineTo(RenderCanvas, Angle, RenderIn,
      RealLeft + (RealRight - RealLeft) div 2, RealBottom - 1
    );

    if (DataStore = nil) or (DataStore.Resource = nil) or (DataStore.Resource.Tasks.Count = 0)
      then Exit;
  end;
  {-}

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

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

    if RenderDate = 0 then
      StartDate := GetStartOfWeek(wvStartDate, FWeekStartsOn)
    else
      StartDate := GetStartOfWeek(RenderDate, FWeekStartsOn);

    RenderCanvas.Font.Assign(FDayHeadAttributes.Font);
    wvDayHeadHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + 2 ;
    RenderCanvas.Font.Assign(FEventFont);
    wvRowHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin div 2;
    RenderCanvas.Font.Assign(TFont(FHeadAttr.Font));
    wvHeaderHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin * 2;
  end;
  {-}

  procedure DrawHeader;
  var
    HeadTextRect: TRect;
    HeadStr: string;
    HeadStrLen : Integer;

    function GetWeekOfYear(Datum: TDateTime): byte;
    var
      AYear, dummy:word;
      First: TDateTime;
    begin
      DecodeDate(Datum+((8-DayOfWeek(Datum)) mod 7) - 3, AYear, dummy,dummy);
      First := EncodeDate(AYear, 1, 1);
      Result := (trunc(Datum-First-3+(DayOfWeek(First)+1) mod 7) div 7) + 1;
    end;

  begin
    RenderCanvas.Brush.Color := RealHeadAttrColor;
    RenderCanvas.Font.Assign(TFont(FHeadAttr.Font));
    { draw the header cell and borders }
    if FDrawingStyle = dsFlat then begin
      { draw an outer and inner bevel }
      HeadRect := Rect(RealLeft, RealTop, RealRight, RealTop + wvHeaderHeight + 2);
      TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect);
      { wp: above lines replace the next ones - no bevel in flat style!
      HeadRect.Left := RealLeft + 1;
      HeadRect.Top := RealTop + 1;
      HeadRect.Right := RealRight - 1;
      HeadRect.Bottom := HeadRect.Top + wvHeaderHeight;
      TPSFillRect (RenderCanvas, Angle, RenderIn, HeadRect);
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle, RenderIn, HeadRect),
                     BevelHighlightColor, BevelShadowColor);
      }
    end else if FDrawingStyle = ds3d then begin
      { draw a 3d bevel }
      HeadRect.Left := RealLeft + 2;
      HeadRect.Top := RealTop + 2;
      HeadRect.Right := RealRight - 3;
      HeadRect.Bottom := RealTop + wvHeaderHeight;
      TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect);
      DrawBevelRect(RenderCanvas, TPSRotateRectangle(Angle, RenderIn, HeadRect),
        BevelHighlightColor, BevelDarkShadow
      );
    end else begin
      HeadRect.Left := RealLeft + 1;
      HeadRect.Top := RealTop + 1;
      HeadRect.Right := RealRight - 1;
      HeadRect.Bottom := HeadRect.Top + wvHeaderHeight;
    end;

    { build header caption }
    HeadStr := HeadStr + Format('%s %s (%s %d)', [
      RSWeekOf, FormatDateTime(DateLabelFormat, StartDate), RSCalendarWeekAbbr, GetWeekOfYear(StartDate)
    ]);
//    HeadStr := HeadStr + RSWeekof + ' ' + FormatDateTime(DateLabelFormat, StartDate)+' (KW'+IntToStr(GetWeekOfYear(StartDate))+')';
    { draw the text }
    if DisplayOnly and (RenderCanvas.TextWidth(HeadStr) >= RenderIn.Right - RenderIn.Left)
    then
      HeadTextRect.TopLeft:= Point(RealLeft + TextMargin * 2, HeadRect.Top)
    else
    if DisplayOnly then
      HeadTextRect.TopLeft := Point(
        RealLeft + (RealRight - RealLeft - RenderCanvas.TextWidth(HeadStr)) div 2,
        HeadRect.Top
      )
    else
      HeadTextRect.TopLeft := Point(
        RealLeft + Trunc(wvHeaderHeight * 0.8) * 2 + TextMargin * 2,
        HeadRect.Top
      );
    HeadTextRect.BottomRight := HeadRect.BottomRight;
    { Fix Header String }
    HeadStrLen := RenderCanvas.TextWidth(HeadStr);
    if HeadStrLen > HeadTextRect.Right - HeadTextRect.Left - TextMargin then
    begin
      HeadStr := GetDisplayString(RenderCanvas, HeadStr, 0,
        HeadTextRect.Right - HeadTextRect.Left - TextMargin );
    end;
    { position the spinner }
    wvSpinButtons.Height := Trunc(wvHeaderHeight * 0.8);
    wvSpinButtons.Width := wvSpinButtons.Height * 2;
    wvSpinButtons.Left := TextMargin;
    wvSpinButtons.Top := (wvHeaderHeight - wvSpinButtons.Height) div 2 + 2;
    TPSTextOut(RenderCanvas, Angle, RenderIn,
      HeadTextRect.Left + TextMargin,
      HeadTextRect.Top + TextMargin,
      HeadStr
    );
  end;
  {-}

  procedure DrawBorders;
  begin
    if FDrawingStyle = dsFlat then begin
      { draw an outer and inner bevel }
      DrawBevelRect(RenderCanvas,
        TPSRotateRectangle(Angle, RenderIn, Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1)),
        BevelShadowColor,
        BevelHighlightColor
      );
      DrawBevelRect(RenderCanvas,
        TPSRotateRectangle(Angle, RenderIn, Rect(RealLeft + 1, RealTop + 1, RealRight - 2, RealBottom - 2)),
        BevelShadowColor,
        BevelHighlightColor
      );
    end else
    if FDrawingStyle = ds3d then begin
      { draw a 3d bevel }
      DrawBevelRect(RenderCanvas,
        TPSRotateRectangle(Angle, RenderIn, Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1)),
        BevelShadowColor,
        BevelShadowColor
      );
      DrawBevelRect(RenderCanvas,
        TPSRotateRectangle(Angle, RenderIn, Rect (RealLeft + 1, RealTop + 1, RealRight - 2, RealBottom - 2)),
        BevelDarkShadow,
        BevelButtonFace
      );
    end;
  end;
  {-}

begin

  if DisplayOnly then begin
    BevelHighlightColor := clBlack;
    BevelShadowColor := clBlack;
    BevelDarkShadow := clBlack;
    BevelButtonFace := clBlack;
    RealLineColor := clBlack;
    RealColor := clWhite;
    RealDayHeadAttrColor := clSilver;
    RealHeadAttrColor := clSilver;
    ADBackgroundColor := clWhite;
    ADEventBackgroundColor := clWhite;
    ADEventBorderColor := clSilver;
  end else begin
    BevelHighlightColor := clBtnHighlight;
    BevelShadowColor := clBtnShadow;
    BevelDarkShadow := cl3DDkShadow;
    BevelButtonFace := clBtnFace;
    RealLineColor := LineColor;
    RealColor := Color;
    RealDayHeadAttrColor := FDayHeadAttributes.Color;
    RealHeadAttrColor := FHeadAttr.Color;
    ADBackgroundColor := AllDayEventAttributes.BackgroundColor;
    ADEventBackgroundColor := AllDayEventAttributes.EventBackgroundColor;
    ADEventBorderColor := AllDayEventAttributes.EventBorderColor;
  end;
  DotDotDotColor := clBlack;

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

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

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

    { clear client area }
    Clear;

    { measure the row heights }
    SetMeasurements;

    { draw header }
    DrawHeader;

    { draw days }
    DrawDays;

    { draw the borders }
    DrawBorders;

  finally
    { reinstate canvas settings}
    SelectClipRgn(RenderCanvas.Handle, 0);
    DeleteObject(Rgn);
  end;

  RenderCanvas.Pen.Style := SavePenStyle;
  RenderCanvas.Brush.Color := SaveBrushColor;
  RenderCanvas.Pen.Color := SavePenColor;
  wvPainting := false;
end;

{=====}

procedure TVpWeekView.wvPopulate;
begin
  if DataStore <> nil then
    DataStore.Date := FActiveDate;
end;
{=====}

procedure TVpWeekView.DeleteActiveEvent(Verify: Boolean);
var
  Str: string;
  DoIt: Boolean;
begin
  DoIt := not Verify;

  EndEdit(nil);
  if ActiveEvent <> nil then begin
    Str := '"' + ActiveEvent.Description + '"';

    if Verify then
      DoIt := (MessageDlg(RSDelete + ' ' + Str + ' ' + RSFromSchedule + #13#10#10 + RSPermanent,
        mtConfirmation, [mbYes, mbNo], 0) = mrYes);

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

procedure TVpWeekView.wvSpinButtonClick(Sender: TObject; Button: TUDBtnType);
begin
  if Button = btNext then
    Date := Date + 7
  else
    Date := Date - 7;
end;
{=====}

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

procedure TVpWeekView.SetActiveEvent(AValue: TVpEvent);
begin
  if FaActiveEvent = AValue then Exit;
  FaActiveEvent := AValue;
end;

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

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

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

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

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

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

procedure TVpWeekView.SetActiveDate(Value: TDateTime);
begin
  if FActiveDate <> Value then begin
    FActiveDate := Value;

    if (Value < wvStartDate) or (Value >= wvStartDate + 7) then
      wvStartDate := Trunc(GetStartOfWeek(Value, FWeekStartsOn));

    if wvStartDate > Value then
      wvStartDate := wvStartDate - 7;

    if wvLoaded then
      wvPopulate;

    Invalidate;

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

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

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

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

procedure TVpWeekView.CreateWnd;
begin
  inherited;
  wvSpinButtons.Parent := self;
end;
{=====}

{$IFNDEF LCL}
procedure TVpWeekView.WMLButtonDown(var Msg: TWMLButtonDown);
{$ELSE}
procedure TVpWeekView.WMLButtonDown(var Msg: TLMLButtonDown);
{$ENDIF}
begin
  inherited;

  if not Focused then SetFocus; 

  if wvInPlaceEditor <> nil then
    EndEdit(Self);

  if (Msg.YPos > wvHeaderHeight) then
  begin
    { If an active event was clicked, then enable the click timer.  If the }
    { item is double clicked before the click timer fires, then the edit   }
    { dialog will appear, otherwise the in-place editor will appear.       }
    if EventAtCoord(Point(Msg.XPos, Msg.YPos)) then
      wvClickTimer.Enabled := true;

    { The mouse click landed inside the client area }
    wvSetDateByCoord(Point(Msg.XPos, Msg.YPos));
  end;
end;
{=====}

{$IFNDEF LCL}
procedure TVpWeekView.WMLButtonDblClk(var Msg: TWMLButtonDblClk);
{$ELSE}
procedure TVpWeekView.WMLButtonDblClk(var Msg: TLMLButtonDblClk);
{$ENDIF}
var
  StartTime, EndTime: TDateTime;
begin
  inherited;
  wvClickTimer.Enabled := false;

  if not CheckCreateResource then
    Exit;

  if DataStore = nil then
    Exit;

  wvSetDateByCoord(Point(Msg.XPos, Msg.YPos));
  EventAtCoord (Point (Msg.XPos, Msg.YPos));

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

  if (Msg.YPos > wvHeaderHeight) then
  begin
    { The mouse click landed inside the client area }
    { If we have hit an active event then we must want to edit it }
    if ActiveEvent <> nil then begin
      { edit this event }
      wvSpawnEventEditDialog(False);
    end
    else if (DataStore.Resource <> nil) then begin
      { otherwise, we must want to create a new event }
      StartTime := trunc(Date) + 1 / 2; { default to 12:00 noon }
      EndTime := StartTime + (30 / MinutesInDay); { StartTime + 30 minutes }
      ActiveEvent := DataStore.Resource.Schedule.AddEvent(
        DataStore.GetNextID('Events'),
        StartTime,
        EndTime
      );
      { edit this new event }
      wvSpawnEventEditDialog(True);
    end;
  end;
end;
{=====}

{$IFNDEF LCL}
procedure TVpWeekView.WMRButtonDown(var Msg: TWMRButtonDown);
{$ELSE}
procedure TVpWeekView.WMRButtonDown(var Msg: TLMRButtonDown);
{$ENDIF}
var
  i: Integer;
begin
  inherited;
  if not Assigned(PopupMenu) then
    exit;

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

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

procedure TVpWeekView.InitializeDefaultPopup;
var
  NewItem: TMenuItem;
  NewSubItem: TMenuItem;
begin
  if RSWeekPopupAdd <> '' then begin
    NewItem := TMenuItem.Create (Self);
    NewItem.Caption := RSWeekPopupAdd;
    NewItem.OnClick := PopupAddEvent;
    NewItem.Tag := 0;
    FDefaultPopup.Items.Add (NewItem);
  end;

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

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

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

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

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

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

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

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

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

    if RSWeekPopupNavPrevYear <> '' then begin
      NewSubItem := TMenuItem.Create (Self);
      NewSubItem.Caption := RSWeekPopupNavPrevYear;
      NewSubItem.OnClick := PopupPrevYear;
      NewSubItem.Tag := 0;
      NewItem.Add (NewSubItem);
    end;
  end;
end;
{=====}

procedure TVpWeekView.PopupAddEvent(Sender: TObject);
var
  StartTime: TDateTime;
  EndTime: TDateTime;

begin
  if ReadOnly then
    Exit;
  if not CheckCreateResource then
    Exit;
  if not Assigned(DataStore) then
    Exit;
  if not Assigned(DataStore.Resource) then
    Exit;

  StartTime := trunc(Date) + 1 / 2; { default to 12:00 noon }
  EndTime := StartTime + (30 / MinutesInDay); { StartTime + 30 minutes }
  ActiveEvent := DataStore.Resource.Schedule.AddEvent(
    DataStore.GetNextID('Events'),
    StartTime,
    EndTime
  );

  { edit this new event }
  wvSpawnEventEditDialog(True);
end;
{=====}

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

procedure TVpWeekView.PopupEditEvent(Sender: TObject);
begin
  if ReadOnly then
    Exit;
  if ActiveEvent <> nil then
    { edit this Event }
    wvSpawnEventEditDialog(False);
end;
{=====}

procedure TVpWeekView.EditSelectedEvent;
begin
  if ActiveEvent <> nil then
    wvSpawnEventEditDialog(false);
end;
{=====}

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

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

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

procedure TVpWeekView.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 > DaysInMonth(Y, M)) then
    D := DaysInMonth(Y, M);

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

procedure TVpWeekView.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 > DaysInMonth(Y, M)) then
    D := DaysInMonth(Y, M);

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

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

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

procedure TVpWeekView.wvSpawnEventEditDialog(NewEvent: Boolean);
var
  AllowIt: Boolean;
  EventDlg : TVpEventEditDialog;
begin
  if DataStore = nil then Exit;

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

  if AllowIt then begin
    ActiveEvent.Changed := true;
    DataStore.PostEvents;
    if Assigned(FOnAddEvent) then
      FOnAddEvent(self, ActiveEvent);
    Invalidate;
  end else begin
    if NewEvent then begin
      DataStore.Resource.Schedule.DeleteEvent(ActiveEvent);
      ActiveEvent := nil;
    end;
    DataStore.PostEvents;
    Invalidate;
  end;
end;
{=====}

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

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

function TVpWeekView.EventAtCoord(Pt: TPoint): Boolean;
var
  I: Integer;
begin
  result := false;
  for I := 0 to pred(Length(wvEventArray)) do begin
    if wvEventArray[I].Event = nil then begin
      { we've hit the end of visible events without finding a match }
      ActiveEvent := nil;
      wvActiveEventRec.Top := 0;
      wvActiveEventRec.Bottom := 0;
      wvActiveEventRec.Right := 0;
      wvActiveEventRec.Left := 0;
      result := false;
      Exit;
    end;

    if (Pt.X > wvEventArray[I].Rec.Left) and
       (Pt.X < wvEventArray[I].Rec.Right) and
       (Pt.Y > wvEventArray[I].Rec.Top) and
       (Pt.Y < wvEventArray[I].Rec.Bottom)
    then begin
      { point falls inside this event's rectangle }
      wvHotPoint := Pt;
      ActiveEvent := TVpEvent(wvEventArray[I].Event);
      wvActiveEventRec := wvEventArray[I].Rec;
      result := true;
      Exit;
    end
    else begin
      { point is not within the boundaries of this event's rectangle. }
      ActiveEvent := nil;
      wvActiveEventRec.Top := 0;
      wvActiveEventRec.Bottom := 0;
      wvActiveEventRec.Right := 0;
      wvActiveEventRec.Left := 0;
      result := false;
    end;
  end;
end;
{=====}

procedure TVpWeekView.wvEditInPlace(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. }
  wvClickTimer.Enabled := false;
  EditEvent;
end;
{=====}

procedure TVpWeekView.EditEvent;
var
  AllowIt: Boolean;
begin
  if ActiveEvent <> nil then begin
    AllowIt := true;
    { call the user defined BeforeEdit event }
    if Assigned(FBeforeEdit) then
      FBeforeEdit(Self, ActiveEvent, AllowIt);

    if AllowIt then begin
      { create and spawn the in-place editor }
      if wvInplaceEditor = nil then begin
        wvInPlaceEditor := TVpWvInPlaceEdit.Create(Self);
        wvInPlaceEditor.Parent := self;
        wvInPlaceEditor.OnExit := EndEdit;
      end;
      wvInPlaceEditor.SetBounds(
        wvActiveEventRec.Left + TextMargin,
        wvActiveEventRec.Top,
        wvActiveEventRec.Right - TextMargin * 2,
        wvActiveEventRec.Bottom - TextMargin * 2
      );
      wvInplaceEditor.Show;
      wvInPlaceEditor.Text := ActiveEvent.Description;
      Invalidate;
      wvInPlaceEditor.SetFocus;
    end;
  end;
end;
{=====}

procedure TVpWeekView.KeyDown(var Key: Word; Shift: TShiftState);
var
  PopupPoint : TPoint;
begin
  case Key of
    VK_DELETE : DeleteActiveEvent(true);
    VK_RIGHT  : if Shift = [ssShift] then
                  PopupNextWeek (Self)
                else if (Shift = [ssCtrl]) then
                  PopupNextMonth (Self)
                else if (Shift = [ssShift, ssCtrl]) then
                  PopupNextYear (Self)
                else if Shift = [] then begin
                  case DayOfWeek (FActiveDate) of
                    1 : FActiveDate := FActiveDate - 4;
                    2 : FActiveDate := FActiveDate + 3;
                    3 : FActiveDate := FActiveDate + 3;
                    4 : FActiveDate := FActiveDate + 3;
                    5 : FActiveDate := FActiveDate - 3;
                    6 : FActiveDate := FActiveDate - 3;
                    7 : FActiveDate := FActiveDate - 3;
                  end;
                  Invalidate;
                end;
    VK_LEFT   : if Shift = [ssShift] then
                  PopupPrevWeek (Self)
                else if (Shift = [ssCtrl]) then
                  PopupPrevMonth (Self)
                else if (Shift = [ssShift, ssCtrl]) then
                  PopupPrevYear (Self)
                else if Shift = [] then begin
                  case DayOfWeek (FActiveDate) of
                    1 : FActiveDate := FActiveDate - 4;
                    2 : FActiveDate := FActiveDate + 3;
                    3 : FActiveDate := FActiveDate + 3;
                    4 : FActiveDate := FActiveDate + 3;
                    5 : FActiveDate := FActiveDate - 3;
                    6 : FActiveDate := FActiveDate - 3;
                    7 : FActiveDate := FActiveDate - 3;
                  end;
                  Invalidate;
                end;
    VK_UP     : begin
                  if Shift = [] then
                    case DayOfWeek (FActiveDate) of
                      1 : FActiveDate := FActiveDate - 1;
                      2 : FActiveDate := FActiveDate + 2;
                      3 : FActiveDate := FActiveDate - 1;
                      4 : FActiveDate := FActiveDate - 1;
                      5 : FActiveDate := FActiveDate + 3;
                      6 : FActiveDate := FActiveDate - 1;
                      7 : FActiveDate := FActiveDate - 1;
                    end;
                  Invalidate;
                end;
    VK_DOWN   : begin
                  if Shift = [] then
                    case DayOfWeek (FActiveDate) of
                      1 : FActiveDate := FActiveDate - 3;
                      2 : FActiveDate := FActiveDate + 1;
                      3 : FActiveDate := FActiveDate + 1;
                      4 : FActiveDate := FActiveDate - 2;
                      5 : FActiveDate := FActiveDate + 1;
                      6 : FActiveDate := FActiveDate + 1;
                      7 : FActiveDate := FActiveDate + 1;
                    end;
                  Invalidate;
                end;
    VK_INSERT : PopupAddEvent(Self);
{$IFNDEF LCL}
    VK_TAB    :
      if ssShift in Shift then
        Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, False))
      else
        Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, True));
{$ENDIF}
    VK_F10:
      if (ssShift in Shift) and not Assigned(PopupMenu) then begin
        PopupPoint := GetClientOrigin;
        FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10);
      end;
    VK_APPS:
      if not Assigned (PopupMenu) then begin
        PopupPoint := GetClientOrigin;
        FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10);
      end;
  end;
end;
{=====}

procedure TVpWeekView.EndEdit(Sender: TObject);
begin
  if (wvInPlaceEditor <> nil) and (ActiveEvent <> nil) then begin
    if wvInPlaceEditor.Text <> ActiveEvent.Description then begin
      ActiveEvent.Description := wvInPlaceEditor.Text;
      ActiveEvent.Changed := true;
      if Assigned(FAfterEdit) then
        FAfterEdit(self, ActiveEvent);
      DataStore.PostEvents;
    end;
    wvInplaceEditor.Hide;
    Invalidate;
//    SetFocus;
  end;
end;
{=====}

{ TVpWvHeadAttributes }

constructor TVpWvHeadAttributes.Create(AOwner: TVpWeekView);
begin
  inherited Create;
  FOwner := AOwner;
  FColor := clBtnFace;
  FFont := TVpFont.Create(AOwner);
end;
{=====}

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

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

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

end.