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

{*********************************************************}
{*                 VPTASKLIST.PAS 1.03                   *}
{*********************************************************}

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

{$I vp.inc}

unit VpTaskList;

interface

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

type
  TVpTaskRec = packed record
    Task: Pointer;
    LineRect: TRect;
    CheckRect: TRect;
  end;

type
  TVpTaskArray = array of TVpTaskRec;

  { forward declarations }
  TVpTaskList = class;

  TVpTaskDisplayOptions = class(TPersistent)
  protected{private}
    FTaskList: TVpTaskList;
    FShowAll: Boolean;
    FShowCompleted: Boolean;
    FShowDueDate: Boolean;
    FDueDateFormat: string;
    FCheckColor: TColor;
    FCheckBGColor: TColor;
    FCheckStyle: TVpCheckStyle;
    FOverdueColor: TColor;
    FNormalColor: TColor;
    FCompletedColor: TColor;
    procedure SetCheckColor(Value: TColor);
    procedure SetCheckBGColor(Value: TColor);
    procedure SetCheckStyle(Value: TVpCheckStyle);
    procedure SetDueDateFormat(Value: string);
    procedure SetShowCompleted(Value: Boolean);
    procedure SetShowDueDate(Value: Boolean);
    procedure SetShowAll(Value: Boolean);
    procedure SetOverdueColor(Value: TColor);
    procedure SetNormalColor(Value: TColor);
    procedure SetCompletedColor(Value: TColor);
  public
    constructor Create(Owner: TVpTaskList);
    destructor Destroy; override;
  published
    property CheckBGColor: TColor read FCheckBGColor write SetCheckBGColor;
    property CheckColor: TColor read FCheckColor write SetCheckColor;
    property CheckStyle: TVpCheckStyle read FCheckStyle write SetCheckStyle;
    property DueDateFormat: string read FDueDateFormat write SetDueDateFormat;
    property ShowCompletedTasks: Boolean read FShowCompleted write SetShowCompleted;
    property ShowAll: Boolean read FShowAll write SetShowAll;
    property ShowDueDate: Boolean read FShowDueDate write SetShowDueDate;
    property OverdueColor: TColor read FOverdueColor write SetOverdueColor;
    property NormalColor: TColor read FNormalColor write SetNormalColor;
    property CompletedColor: TColor read FCompletedColor write SetCompletedColor;
  end;

  { InPlace Editor }
  TVpTLInPlaceEdit = class(TCustomEdit)
  protected{private}
    procedure CreateParams(var Params: TCreateParams); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    constructor Create(AOwner: TComponent); override;
//    procedure Move(const Loc: TRect; Redraw: Boolean);
  end;

  TVpTaskHeadAttr = class(TVpPersistent)
  protected{private}
    FTaskList: TVpTaskList;
    FFont: TVpFont;
    FColor: TColor;
    procedure SetColor(Value: TColor);
    procedure SetFont(Value: TVpFont);
  public
    constructor Create(AOwner: TVpTaskList);
    destructor Destroy; override;
    procedure Invalidate; override;
      { The Invalidate method is used as a bridge between FFont & FTaskList. }
    property TaskList: TVpTaskList read FTaskList;
  published
    property Color: TColor read FColor write SetColor;
    property Font: TVpFont read FFont write SetFont;
  end;

  { Task List }
  TVpTaskList = class(TVpLinkableControl)
  protected{ private }
    FColor: TColor;
    FCaption: string;
    FDisplayOptions: TVpTaskDisplayOptions;
    FLineColor: TColor;
    FActiveTask: TVpTask;
    FShowResourceName: Boolean;
    FTaskIndex: Integer;
    FScrollBars: TScrollStyle;
    FTaskHeadAttr: TVpTaskHeadAttr;
    FMaxVisibleTasks: Word;
    FDrawingStyle: TVpDrawingStyle;
    FTaskID: Integer;
    FDefaultPopup: TPopupMenu;
    FShowIcon: Boolean;
    FAllowInplaceEdit: Boolean;
    { task variables }
    FOwnerDrawTask: TVpOwnerDrawTask;
    FBeforeEdit: TVpBeforeEditTask;
    FAfterEdit: TVpAfterEditTask;
    FOwnerEditTask: TVpEditTask;
    { internal variables }
    tlVisibleTaskArray: TVpTaskArray;
    tlAllTaskList: TList;
    tlItemsBefore: Integer;
    tlItemsAfter: Integer;
    tlVisibleItems: Integer;
    tlHitPoint: TPoint;
    tlClickTimer: TTimer;
    tlLoaded: Boolean;
    tlRowHeight: Integer;
    tlInPlaceEditor: TVpTLInPlaceEdit;
    tlCreatingEditor: Boolean;
    tlPainting: Boolean;
    tlVScrollDelta: Integer;
    tlHotPoint: TPoint;

    { property methods }
    function GetTaskIndex: Integer;
    procedure SetLineColor(Value: TColor);
    procedure SetMaxVisibleTasks(Value: Word);
    procedure SetTaskIndex(Value: Integer);
    procedure SetDrawingStyle(const Value: TVpDrawingStyle);
    procedure SetColor(const Value: TColor); reintroduce;
    procedure SetShowIcon(const v: Boolean);
    procedure SetShowResourceName(Value: Boolean);
    { internal methods }
    procedure InitializeDefaultPopup;
    procedure PopupAddTask(Sender: TObject);
    procedure PopupAddFromICalFile(Sender: TObject);
    procedure PopupDeleteTask(Sender: TObject);
    procedure PopupDropdownEvent(Sender: TObject);
    procedure PopupEditTask(Sender: TObject);
    procedure tlSetVScrollPos;
    procedure tlCalcRowHeight;
    procedure tlEditInPlace(Sender: TObject);
    procedure tlHookUp;
    procedure Paint; override;
    procedure Loaded; override;
    procedure tlSpawnTaskEditDialog(IsNewTask: Boolean);
    procedure tlSetActiveTaskByCoord(Pnt: TPoint);
    function tlVisibleTaskToTaskIndex(const VisTaskIndex: Integer) : Integer;
    function tlTaskIndexToVisibleTask(const ATaskIndex: Integer) : Integer;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure EditTask;
    procedure EndEdit(Sender: TObject);
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;

    { message handlers }
    {$IFNDEF LCL}
    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 WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
    procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey);
      message CM_WANTSPECIALKEY;
    {$ELSE}
    procedure WMLButtonDown(var Msg: TLMLButtonDown); message LM_LBUTTONDOWN;
    procedure WMLButtonDblClk(var Msg: TLMLButtonDblClk); message LM_LBUTTONDBLCLK;
    procedure WMRButtonDown (var Msg: TLMRButtonDown); message LM_RBUTTONDOWN;
    procedure WMSize(var Msg: TLMSize); message LM_SIZE;
    procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL;
    {$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DeleteActiveTask(Verify: Boolean);
    procedure LoadLanguage;
    procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType;
      const Value: Variant); override;
    function GetControlType: TVpItemType; override;
    procedure PaintToCanvas(ACanvas: TCanvas; ARect: TRect; Angle: TVpRotationAngle);
    procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
      Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
      StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); override;

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

    property ActiveTask: TVpTask read FActiveTask;
    property TaskIndex: Integer read GetTaskIndex write SetTaskIndex;

  published
    {inherited properties}
    property Align;
    property Anchors;
    property Font;
    property TabStop;
    property TabOrder;
    property ReadOnly;
    {$IFDEF LCL}
    property BorderSpacing;
    {$ENDIF}

    property AllowInplaceEditing: Boolean
      read FAllowInplaceEdit write FAllowInplaceEdit default true;
    property DisplayOptions: TVpTaskDisplayOptions read FDisplayOptions write FDisplayOptions;
    property LineColor: TColor read FLineColor write SetLineColor;
    property MaxVisibleTasks: Word read FMaxVisibleTasks write SetMaxVisibleTasks;
    property TaskHeadAttributes: TVpTaskHeadAttr read FTaskHeadAttr write FTaskHeadAttr;
    property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle;
    property Color: TColor read FColor write SetColor;
    property ShowIcon: Boolean read FShowIcon write SetShowIcon default True;
    property ShowResourceName: Boolean read FShowResourceName write SetShowResourceName;
    { events }
    property BeforeEdit: TVpBeforeEditTask read FBeforeEdit write FBeforeEdit;
    property AfterEdit: TVpAfterEditTask read FAfterEdit write FAfterEdit;
    property OnOwnerEditTask: TVpEditTask read FOwnerEditTask write FOwnerEditTask;
  end;

implementation

uses
  SysUtils, Forms, Dialogs,
  VpDlg, VpTaskEditDlg, VpTasklistPainter, VpICal;

(*****************************************************************************)

{ TVpTaskDisplayOptions }
constructor TVpTaskDisplayOptions.Create(Owner: TVpTaskList);
begin
  inherited Create;
  FTaskList := Owner;
  FDueDateFormat := DefaultFormatSettings.ShortDateFormat;
  FShowDueDate := true;
  FCheckColor := cl3DDkShadow;
  FCheckBGColor := clWindow;
  FCheckStyle := csCheck;
  FOverdueColor := clRed;
  FCompletedColor := clGray;
  FNormalColor := clBlack;
end;
{=====}

destructor TVpTaskDisplayOptions.Destroy;
begin
  inherited;
end;
{=====}

procedure TVpTaskDisplayOptions.SetOverdueColor(Value : TColor);
begin
  if FOverdueColor <> Value then begin
    FOverdueColor := Value;
    FTaskList.Invalidate;
  end;
end;
{=====}

procedure TVpTaskDisplayOptions.SetNormalColor(Value: TColor);
begin
  if FNormalColor <> Value then begin
    FNormalColor := Value;
    FTaskList.Invalidate;
  end;
end;
{=====}

procedure TVpTaskDisplayOptions.SetCompletedColor(Value: TColor);
begin
  if FCompletedColor <> Value then begin
    FCompletedColor := Value;
    FTaskList.Invalidate;
  end;
end;
{=====}

procedure TVpTaskDisplayOptions.SetCheckColor(Value: TColor);
begin
  if FCheckColor <> Value then begin
    FCheckColor := Value;
    FTaskList.Invalidate;
  end;
end;
{=====}

procedure TVpTaskDisplayOptions.SetCheckBGColor(Value: TColor);
begin
  if FCheckBGColor <> Value then begin
    FCheckBGColor := Value;
    FTaskList.Invalidate;
  end;
end;
{=====}

procedure TVpTaskDisplayOptions.SetCheckStyle(Value: TVpCheckStyle);
begin
  if Value <> FCheckStyle then begin
    FCheckStyle := Value;
    FTaskList.Invalidate;
  end;
end;
{=====}

procedure TVpTaskDisplayOptions.SetDueDateFormat(Value: string);
begin
  if FDueDateFormat <> Value then begin
    FDueDateFormat := Value;
    FTaskList.Invalidate;
  end;
end;
{=====}

procedure TVpTaskDisplayOptions.SetShowCompleted(Value : Boolean);
begin
  if FShowCompleted <> Value then begin
    FShowCompleted := Value;
    FTaskList.Invalidate;
  end;
end;
{=====}

procedure TVpTaskDisplayOptions.SetShowDueDate(Value: Boolean);
begin
  if FShowDueDate <> Value then begin
    FShowDueDate := Value;
    FTaskList.Invalidate;
  end;
end;
{=====}

procedure TVpTaskDisplayOptions.SetShowAll(Value: Boolean);
begin
  if FShowAll <> Value then begin
    FShowAll := Value;
    FTaskList.Invalidate;
  end;
end;
{=====}

{ TVpTaskHeadAttr }
constructor TVpTaskHeadAttr.Create(AOwner: TVpTaskList);
begin
  inherited Create;
  FTaskList := AOwner;
  FFont := TVpFont.Create(self);
  FFont.Assign(FTaskList.Font);
  FColor := clSilver;
end;
{=====}

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

procedure TVpTaskHeadAttr.Invalidate;
begin
  if Assigned(FTaskList) then
    FTaskList.Invalidate;
end;
{=====}

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

procedure TVpTaskHeadAttr.SetFont(Value: TVpFont);
begin
  if Value <> FFont then begin
    FFont.Assign(Value);
    TaskList.Invalidate;
  end;
end;
{=====}


{ TVpCGInPlaceEdit }

constructor TVpTLInPlaceEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  TabStop := False;
  BorderStyle := bsNone;
  {$IFDEF VERSION4}
//  DoubleBuffered := False;
  {$ENDIF}
end;
{=====}
                           {
procedure TVpTLInPlaceEdit.Move(const Loc: TRect; Redraw: Boolean);
begin
  CreateHandle;
  Redraw := Redraw or not IsWindowVisible(Handle);
  Invalidate;
  SetBounds(Loc.Left, Loc.Top, Loc.Right-Loc.Left, Loc.Bottom-Loc.Top);
  if Redraw then Invalidate;
  SetFocus;
end;                        }
{=====}

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

procedure TVpTLInPlaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
  TaskList: TVpTaskList;
begin
  TaskList := TVpTaskList(Owner);

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

    VK_UP:
      begin
        Key := 0;
        TaskList.TaskIndex := TaskList.TaskIndex - 1;
      end;

    VK_DOWN:
      begin
        Key := 0;
        TaskList.TaskIndex := TaskList.TaskIndex + 1;
      end;

    VK_ESCAPE:
      begin
        Key := 0;
        Hide;
        TaskList.SetFocus;
//        TaskList.EndEdit(Self);
      end;

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

(*****************************************************************************)
{ TVpTaskList }

constructor TVpTaskList.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
  { Create internal classes and stuff }
  tlClickTimer := TTimer.Create(self);
  FTaskHeadAttr := TVpTaskHeadAttr.Create(Self);
  FDisplayOptions := TVpTaskDisplayOptions.Create(self);
  tlAllTaskList := TList.Create;

  { Set styles and initialize internal variables }
  {$IFDEF VERSION4}
//  DoubleBuffered := true;
  {$ENDIF}
  tlItemsBefore := 0;
  tlItemsAfter := 0;
  tlVisibleItems := 0;
  tlClickTimer.Enabled := false;
  FMaxVisibleTasks := 250;
  tlClickTimer.Interval := ClickDelay;
  tlClickTimer.OnTimer := tlEditInPlace;
  tlCreatingEditor := false;
  FDrawingStyle := ds3d;
  tlPainting := false;
  FShowResourceName := true;
  FColor := clWindow;
  FLineColor := clGray;
  FScrollBars := ssVertical;
  FTaskIndex := -1;
  FShowIcon := True;
  FAllowInplaceEdit := true;

  SetLength(tlVisibleTaskArray, MaxVisibleTasks);

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

  FDefaultPopup := TPopupMenu.Create(Self);
  FDefaultPopup.OnPopup := PopupDropDownEvent;

  tlHookUp;
end;
{=====}

destructor TVpTaskList.Destroy;
begin
  FreeAndNil(tlInplaceEditor);
  tlClickTimer.Free;
  FDisplayOptions.Free;
  tlAllTaskList.Free;
  FTaskHeadAttr.Free;
  FDefaultPopup.Free;

  inherited;
end;
{=====}

procedure TVpTaskList.DeleteActiveTask(Verify: Boolean);
var
  DoIt: Boolean;
begin
  DoIt := not Verify;
  if FActiveTask <> nil then begin
    if Verify then
      DoIt := (MessageDlg(RSConfirmDeleteTask + #13#10#10 + RSPermanent,
        mtConfirmation, [mbYes, mbNo], 0) = mrYes);

    if DoIt then begin
      FActiveTask.Deleted := true;
      if Assigned(DataStore) then
        if Assigned(DataStore.Resource) then
          DataStore.Resource.TasksDirty := True;
      DataStore.PostTasks;
      DataStore.RefreshTasks;
      Invalidate;
    end;
  end;
end;
{=====}

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

procedure TVpTaskList.LinkHandler(Sender: TComponent;
  NotificationType: TVpNotificationType; const Value: Variant);
begin
  Unused(Value);
  case NotificationType of
    neDataStoreChange : Invalidate;
    neInvalidate      : Invalidate;
  end;
end;
{=====}

procedure TVpTaskList.tlHookUp;
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 TVpTaskList.Loaded;
begin
  inherited;
  tlLoaded := true;
end;
{=====}

function TVpTaskList.GetControlType: TVpItemType;
begin
  Result := itTasks;
end;
{=====}

procedure TVpTaskList.Paint;
begin
  { paint simply calls RenderToCanvas and passes in the screen canvas. }
  RenderToCanvas(
    Canvas,   { Screen Canvas}
    Rect(0, 0, Width, Height), { Clipping Rectangle             }
    ra0,      { Rotation Angle                                  }
    1,        { Scale                                           }
    Now,      { Render Date                                     }
    tlItemsBefore,  { Starting Line                             }
    -1,       { Stop Line                                       }
    gr30Min,  { Granularity - Not used int the task list        }
    False     { Display Only - True for a printed version,      }
  );          {                False for an interactive version }
end;
{=====}

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

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

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

procedure TVpTaskList.tlCalcRowHeight;
var
  SaveFont: TFont;
  Temp: Integer;
begin
  { Calculates row height based on the largest of the RowHead's Minute }
  { font, the standard client font, and a sample character string.     }
  SaveFont := Canvas.Font;
  Canvas.Font.Assign(FTaskHeadAttr.Font);
  tlRowHeight := Canvas.TextHeight(TallShortChars);
  Canvas.Font.Assign(SaveFont);
  Temp := Canvas.TextHeight(TallShortChars);
  if Temp > tlRowHeight then
    tlRowHeight := Temp;
  tlRowHeight := tlRowHeight + TextMargin * 2;
  Canvas.Font.Assign(SaveFont);
end;
{=====}

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

procedure TVpTaskList.SetTaskIndex(Value: Integer);
begin
  if (tlInPlaceEditor <> nil) and tlInplaceEditor.Visible then
    EndEdit(self);

  if (Value < DataStore.Resource.Tasks.Count) and (FTaskIndex <> Value) then
  begin
    FTaskIndex := Value;
    if FTaskIndex > -1 then
      FActiveTask := DataStore.Resource.Tasks.GetTask(Value)
    else
      FActiveTask := nil;
    Invalidate;
  end;
end;
{=====}

function TVpTaskList.GetTaskIndex: Integer;
begin
  if FActiveTask = nil then
    Result := -1
  else
    Result := FActiveTask.Owner.IndexOf(FActiveTask);
//    result := FActiveTask.ItemIndex;
end;
{=====}

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

procedure TVpTaskList.SetMaxVisibleTasks(Value: Word);
begin
  if Value <> FMaxVisibleTasks then begin
    FMaxVisibleTasks := Value;
    SetLength(tlVisibleTaskArray, FMaxVisibleTasks);
    Invalidate;
  end;
end;
{=====}

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

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

procedure TVpTaskList.CreateWnd;
begin
  inherited;
  tlCalcRowHeight;
  tlSetVScrollPos;
end;
{=====}

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

  if not Focused then SetFocus;

  if not (csDesigning in ComponentState) then begin
    {See if the user clicked on a checkbox}
    tlSetActiveTaskByCoord (Point(Msg.XPos, Msg.YPos));
  end;
end;
{=====}

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

  if not Assigned (PopupMenu) then begin
    if not Focused then 
      SetFocus;
    tlSetActiveTaskByCoord(Point(Msg.XPos, Msg.YPos));
    tlClickTimer.Enabled := False;
    ClientOrigin := GetClientOrigin;

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

    FDefaultPopup.Popup(Msg.XPos + ClientOrigin.x, Msg.YPos + ClientOrigin.y);
  end;
end;
{=====}

{$IFNDEF LCL}
procedure TVpTaskList.WMLButtonDblClk(var Msg: TWMLButtonDblClk);
{$ELSE}
procedure TVpTaskList.WMLButtonDblClk(var Msg: TLMLButtonDblClk);
{$ENDIF}
begin
  inherited;
  tlClickTimer.Enabled := false;
  { if the mouse was pressed down in the client area, then select the cell. }
  if not Focused then 
    SetFocus;
  { The mouse click landed inside the client area }
  tlSetActiveTaskByCoord(Point(Msg.XPos, Msg.YPos));
  { Spawn the TaskList editor }
  if not ReadOnly then                                                   
    tlSpawnTaskEditDialog(FActiveTask = nil);
end;
{=====}

procedure TVpTaskList.InitializeDefaultPopup;
var
  NewItem: TMenuItem;
begin
  FDefaultPopup.Items.Clear;

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

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

  if RSTaskPopupEdit <> '' then begin     // "Edit"
    NewItem := TMenuItem.Create(Self);
    NewItem.Caption := RSTaskPopupEdit;
    NewItem.OnClick := PopupEditTask;
    NewItem.Tag := 1;
    FDefaultPopup.Items.Add(NewItem);
  end;

  if RSTaskPopupDelete <> '' then begin    // "Delete"
    NewItem := TMenuItem.Create(Self);
    NewItem.Caption := RSTaskPopupDelete;
    NewItem.OnClick := PopupDeleteTask;
    NewItem.Tag := 1;
    FDefaultPopup.Items.Add(NewItem);
  end;
end;
{=====}

procedure TVpTaskList.PopupAddTask(Sender: TObject);
begin
  if ReadOnly then                                                     
    Exit;                                                              
  if not CheckCreateResource then                                      
    Exit;                                                              
  { Allow the user to fill in all the new information }
  Repaint;                                                             
  tlSpawnTaskEditDialog(True);
end;
{=====}

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

  dlg := TOpenDialog.Create(nil);
  try
    dlg.Title := RSLoadICalTitle;
    dlg.Filter := RSICalFilter;
    dlg.FileName := '';
    dlg.Options := dlg.Options + [ofAllowMultiSelect, ofFileMustExist];
    if dlg.Execute then begin
      Screen.Cursor := crHourGlass;
      Application.ProcessMessages;
      ical := TVpICalendar.Create;
      try
        for fn in dlg.Files do begin
          ical.LoadFromFile(fn);
          for i := 0 to ical.Count-1 do begin
            if not (ical[i] is TVpICalToDo) then
              Continue;
            id := DataStore.GetNextID(EventsTableName);
            FActiveTask := Datastore.Resource.Tasks.AddTask(id);
            FActiveTask.LoadFromICalendar(TVpICalToDo(ical[i]));
            Datastore.PostTasks;
            Datastore.NotifyDependents;
          end;
        end;
        Invalidate;
      finally
        ical.Free;
        Screen.Cursor := crDefault;
      end;
    end;
  finally
    dlg.Free;
  end;
end;

procedure TVpTaskList.PopupDeleteTask(Sender: TObject);
begin
  if ReadOnly then                                                     
    Exit;                                                              
  if FActiveTask <> nil then begin                                       
    Repaint;                                                             
    DeleteActiveTask(True);
  end;                                                                   
end;

procedure TVpTaskList.PopupDropdownEvent(Sender: TObject);
begin
  InitializeDefaultPopup;
end;

procedure TVpTaskList.PopupEditTask(Sender: TObject);
begin
  if ReadOnly then                                                     
    Exit;                                                              
  if FActiveTask <> nil then begin                                       
    Repaint;                                                             
    { edit this Task }
    tlSpawnTaskEditDialog(False);
  end;                                                                   
end;
{=====}

procedure TVpTaskList.tlSpawnTaskEditDialog(IsNewTask: Boolean);
var
  AllowIt: Boolean;
  Task: TVpTask;
  TaskDlg: TVpTaskEditDialog;
begin
  tlClickTimer.Enabled := false;
  if not CheckCreateResource then                                      
    Exit;                                                              
  if (DataStore = nil) or (DataStore.Resource = nil) then
    Exit;

  AllowIt := false;
  if IsNewTask then begin
    Task := DataStore.Resource.Tasks.AddTask(DataStore.GetNextID('Tasks'));
    Task.CreatedOn := now;
    Task.DueDate := Now + 7;
  end else
    Task := FActiveTask;

  if Assigned(FOwnerEditTask) then
    FOwnerEditTask(self, Task, IsNewTask, DataStore.Resource, AllowIt)
  else begin
    TaskDlg := TVpTaskEditDialog.Create(nil);
    try
      TaskDlg.Options := TaskDlg.Options + [doSizeable];
      TaskDlg.DataStore := DataStore;
      AllowIt := TaskDlg.Execute(Task);
    finally
      TaskDlg.Free;
    end;
  end;

  if AllowIt then begin
    DataStore.PostTasks();
    DataStore.NotifyDependents;
  end else begin
    if IsNewTask then begin
      DataStore.Resource.Tasks.DeleteTask(Task);
    end;
    DataStore.PostTasks;
  end;
  Invalidate;
end;
{=====}

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

procedure TVpTaskList.tlEditInPlace(Sender: TObject);
begin
  { this is the timer Task which spawns an in-place editor }
  { if the task is doublecliked before this timer fires, then the }
  { task is edited in a dialog based editor. }
  tlClickTimer.Enabled := false;
  EditTask;
end;
{=====}

procedure TVpTaskList.EditTask;
var
  AllowIt: Boolean;
  R: TRect;
  VisTask: Integer;
begin
  {don't allow a user to edit a completed task in place.}
  if FActiveTask.Complete then
    Exit;

  if not FAllowInplaceEdit then
    exit;

  if Assigned(tlInplaceEditor) and tlInplaceEditor.Visible then
    exit;

  AllowIt := true;

  VisTask := tlTaskIndexToVisibleTask(TaskIndex);
  if VisTask < 0 then
    Exit;

  { call the user defined BeforeEdit task }
  if Assigned(FBeforeEdit) then
    FBeforeEdit(Self, FActiveTask, AllowIt);

  if AllowIt then begin
    { build the editor's rectangle }
    R := tlVisibleTaskArray[VisTask].LineRect;
    R.Top := R.Top + TextMargin;
    R.Left := R.Left + TextMargin - 1;
    { create and spawn the in-place editor }
    if tlInplaceEditor = nil then begin
      tlInPlaceEditor := TVpTLInPlaceEdit.Create(Self);
      tlInPlaceEditor.Parent := self;
      tlInPlaceEditor.OnExit := EndEdit;
    end;
    tlInPlaceEditor.Font.Assign(Font);
    tlInPlaceEditor.SetBounds(R.Left, R.Top, WidthOf(R), HeightOf(R));
    tlInPlaceEditor.Text := FActiveTask.Description;
    tlInplaceEditor.Show;
    tlInplaceEditor.SetFocus;
    Invalidate;
  end;
end;
{=====}

procedure TVpTaskList.EndEdit(Sender: TObject);
begin
  if (tlInPlaceEditor <> nil) and tlInplaceEditor.Visible then begin
    if tlInPlaceEditor.Text <> FActiveTask.Description then begin
      FActiveTask.Description := tlInPlaceEditor.Text;
      FActiveTask.Changed := true;
      DataStore.Resource.TasksDirty := true;
      DataStore.PostTasks;
      if Assigned(FAfterEdit) then
        FAfterEdit(self, FActiveTask);
    end;
    tlInPlaceEditor.Hide;
    SetFocus;
    Invalidate;
  end;
end;
{=====}

procedure TVpTaskList.KeyDown(var Key: Word; Shift: TShiftState);
var
  PopupPoint: TPoint;
begin
  case Key of
    VK_UP:
      if TaskIndex > 0 then
        TaskIndex := TaskIndex - 1
      else
        TaskIndex := Pred(DataStore.Resource.Tasks.Count);
    VK_DOWN:
      if TaskIndex < Pred(DataStore.Resource.Tasks.Count) then
        TaskIndex := TaskIndex + 1
      else
        TaskIndex := 0;
    VK_NEXT:
      if TaskIndex < Pred(DataStore.Resource.Tasks.Count) - tlVisibleItems then
        TaskIndex := TaskIndex + tlVisibleItems                          
      else                                                               
        TaskIndex := Pred(DataStore.Resource.Tasks.Count);               
    VK_PRIOR :
      if TaskIndex > tlVisibleItems then                                 
        TaskIndex := TaskIndex - tlVisibleItems                          
      else                                                               
        TaskIndex := 0;                                                  
    VK_HOME:
      TaskIndex := 0;
    VK_END:
      TaskIndex := Pred(DataStore.Resource.Tasks.Count);
    VK_DELETE:
      DeleteActiveTask(true);
    VK_RETURN:
      tlSpawnTaskEditDialog (False);
    VK_INSERT:
      tlSpawnTaskEditDialog (True);
    VK_F2:
      if Assigned(DataStore) then begin
        if Assigned(DataStore.Resource) then
          tlEditInPlace(Self);
      end;
    VK_SPACE:
      if Assigned(FActiveTask) then begin
        FActiveTask.Complete := not FActiveTask.Complete;
        Invalidate;
      end;
{$IFNDEF LCL}
    VK_TAB:
      if ssShift in Shift then
        Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, False))
      else
        Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, True));
{$ENDIF}
    VK_F10:
      if (ssShift in Shift) and not (Assigned(PopupMenu)) then begin
        PopupPoint := GetClientOrigin;
        FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10);
      end;
    VK_APPS:
      if not Assigned(PopupMenu) then begin
        PopupPoint := GetClientOrigin;
        FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10);
      end;
  end;

  if TaskIndex < tlItemsBefore then                                      
    tlItemsBefore := TaskIndex;                                          
  if TaskIndex >= tlItemsBefore + tlVisibleItems then                    
    tlItemsBefore := TaskIndex - tlVisibleItems + 1;                     
end;
{=====}

{$IFNDEF LCL}
procedure TVpTaskList.WMVScroll(var Msg: TWMVScroll);
{$ELSE}
procedure TVpTaskList.WMVScroll(var Msg: TLMVScroll);
{$ENDIF}
begin
  { for simplicity, bail out of editing while scrolling. }
  EndEdit(Self);
  if (tlInPlaceEditor <> nil) and tlInplaceEditor.Visible then Exit;

  case Msg.ScrollCode of
    SB_LINEUP:
      if tlItemsBefore > 0 then
        tlItemsBefore := tlItemsBefore - 1;
    SB_LINEDOWN:
      if tlItemsAfter > 0 then
        tlItemsBefore := tlItemsBefore + 1;
    SB_PAGEUP:
      if tlItemsBefore >= tlVisibleItems then
        tlItemsBefore := tlItemsBefore - tlVisibleItems
      else
        tlItemsBefore := 0;
    SB_PAGEDOWN:
      if tlItemsAfter >= tlVisibleItems then
        tlItemsBefore := tlItemsBefore + tlVisibleItems
      else
        tlItemsBefore := tlAllTaskList.Count - tlVisibleItems;
    SB_THUMBPOSITION, SB_THUMBTRACK:
      tlItemsBefore := Msg.Pos;
  end;
  Invalidate;
end;
{=====}

procedure TVpTaskList.tlSetVScrollPos;
var
  SI: TScrollInfo;
begin
  if (not HandleAllocated) or (DataStore = nil) or (DataStore.Resource = nil)
    or (csDesigning in ComponentState) then Exit;

  with SI do begin
    cbSize := SizeOf(SI);
    fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
    nMin := 1;
    nMax := tlAllTaskList.Count;
    nPage := tlVisibleItems;
    if tlItemsAfter = 0 then
      nPos := tlAllTaskList.Count
    else
      nPos := tlItemsBefore;
    nTrackPos := nPos;
  end;
  SetScrollInfo(Handle, SB_VERT, SI, True);
end;
{=====}
procedure TVpTaskList.SetShowIcon(const v: Boolean);
begin                                                                    
  if v <> FShowIcon then begin                                           
    FShowIcon := v;                                                      
    Invalidate;                                                          
  end;                                                                   
end;                                                                     
{=====}

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

procedure TVpTaskList.tlSetActiveTaskByCoord(Pnt: TPoint);
var
  I: integer;
begin
  if (DataStore = nil) or (DataStore.Resource = nil) then
    Exit;

  if not ReadOnly and tlClickTimer.Enabled then
    tlClickTimer.Enabled := false;

  TaskIndex := -1;

  for I := 0 to pred(Length(tlVisibleTaskArray)) do begin
    { we've hit the end of active tasks, so bail }
    if tlVisibleTaskArray[I].Task = nil then
      Exit;

    { if the point is in an active task's check box... }

    if PointInRect(Pnt, tlVisibleTaskArray[I].CheckRect) then begin
      { set the active task index }
      TaskIndex := tlVisibleTaskToTaskIndex (I);
      if not ReadOnly then begin                                         
        { toggle the complete flag. }
        FActiveTask.Complete := not FActiveTask.Complete;
        FActiveTask.Changed := true;
        DataStore.Resource.TasksDirty := true;
        DataStore.PostTasks;
        Invalidate;
      end;                                                               
      Exit;
    end;

    { if the point is in an active task..}
    if PointInRect(Pnt, tlVisibleTaskArray[I].LineRect) then begin
      { Set ActiveTask to the selected one }
      TaskIndex := tlVisibleTaskToTaskIndex (I);
      if not ReadOnly then
        tlClickTimer.Enabled := true;
      Exit;
    end;
  end;
end;
{=====}

function TVpTaskList.tlVisibleTaskToTaskIndex(const VisTaskIndex: Integer): Integer;
var
  RealTask: TVpTask;
begin
  Result := -1;
  if (VisTaskIndex < 0) or (VisTaskIndex >= Length(tlVisibleTaskArray)) then
    Exit;
  RealTask := TVpTask(tlVisibleTaskArray[VisTaskIndex].Task);
  Result := RealTask.ItemIndex;
end;

function TVpTaskList.tlTaskIndexToVisibleTask(const ATaskIndex: Integer): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to Length(tlVisibleTaskArray) - 1 do
    if ATaskIndex = TVpTask(tlVisibleTaskArray[i].Task).ItemIndex then begin
      Result := i;
      Break;
    end;
end;

{$IF VP_LCL_SCALING = 2}
procedure TVpTaskList.ScaleFontsPPI(const AToPPI: Integer;
  const AProportion: Double);
begin
  inherited;
  DoScaleFontPPI(TaskHeadAttributes.Font, AToPPI, AProportion);
end;
{$ELSEIF VP_LCL_SCALING = 1}
procedure TVpTaskList.ScaleFontsPPI(const AProportion: Double);
begin
  inherited;
  DoScaleFontPPI(TaskHeadAttributes.Font, AProportion);
end;
{$ENDIF}

end.