{*********************************************************} {* 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; 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; function IsStoredDueDateFormat: Boolean; 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); procedure UpdateTaskList; public constructor Create(AOwner: TVpTaskList); published property CheckBGColor: TColor read FCheckBGColor write SetCheckBGColor default clWindow; property CheckColor: TColor read FCheckColor write SetCheckColor default cl3DDkShadow; property CheckStyle: TVpCheckStyle read FCheckStyle write SetCheckStyle default csCheck; property DueDateFormat: string read FDueDateFormat write SetDueDateFormat stored IsStoredDueDateFormat; property ShowCompletedTasks: Boolean read FShowCompleted write SetShowCompleted default false; property ShowAll: Boolean read FShowAll write SetShowAll default false; property ShowDueDate: Boolean read FShowDueDate write SetShowDueDate default true; property OverdueColor: TColor read FOverdueColor write SetOverdueColor default clRed; property NormalColor: TColor read FNormalColor write SetNormalColor default clWindowText; property CompletedColor: TColor read FCompletedColor write SetCompletedColor default clGray; 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(TPersistent) private FTaskList: TVpTaskList; FFont: TVpFont; FColor: TColor; FGlyphDist: Integer; procedure SetColor(Value: TColor); procedure SetFont(Value: TVpFont); procedure SetGlyphDist(Value: Integer); protected procedure UpdateTaskList; public constructor Create(AOwner: TVpTaskList); destructor Destroy; override; property TaskList: TVpTaskList read FTaskList; published property Color: TColor read FColor write SetColor default clBtnFace; property Font: TVpFont read FFont write SetFont; property GlyphDistance: Integer read FGlyphDist write SetGlyphDist default 10; end; { Task List } TVpTaskList = class(TVpLinkableControl) private FDefaultPopup: TPopupMenu; FExternalPopup: TPopupMenu; FTextMargin: Integer; procedure SetPopupMenu(AValue: TPopupMenu); procedure SetTextMargin(AValue: Integer); 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; 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 tlSetVScrollPos; procedure tlCalcRowHeight; procedure tlEditInPlace(Sender: TObject); procedure tlHookUp; procedure Paint; override; procedure Loaded; override; procedure Notification(AComponent: TComponent; Operation: TOperation); 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; { Popup menu } function GetPopupMenu: TPopupMenu; override; procedure InitializeDefaultPopup; procedure PopupAddTask(Sender: TObject); procedure PopupDeleteTask(Sender: TObject); procedure PopupEditTask(Sender: TObject); procedure PopupExportToICalFile(Sender: TObject); procedure PopupImportFromICalFile(Sender: TObject); { 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 ExportICalFile(const AFileName: String; const ATasks: TVpTaskArr); function ImportICalFile(const AFileName: String; APreview: Boolean = false; ADefaultCategory: Integer = -1): TVpTaskArr; 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; { LCL scaling } {$IF VP_LCL_SCALING <> 0} procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override; {$IFEND} {$IF VP_LCL_SCALING = 2} procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override; procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override; {$ELSEIF VP_LCL_SCALING = 1} procedure ScaleFontsPPI(const AProportion: Double); override; {$ENDIF} property ActiveTask: TVpTask read FActiveTask; property TaskIndex: Integer read GetTaskIndex write SetTaskIndex; published {inherited properties} property Align; property Anchors; property Font; property PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu; property ReadOnly default false; property TabStop default true; property TabOrder; {$IFDEF LCL} property BorderSpacing; {$ENDIF} property AllowInplaceEditing: Boolean read FAllowInplaceEdit write FAllowInplaceEdit default true; property Color: TColor read FColor write SetColor default DEFAULT_COLOR; property DisplayOptions: TVpTaskDisplayOptions read FDisplayOptions write FDisplayOptions; property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d; property LineColor: TColor read FLineColor write SetLineColor default DEFAULT_LINECOLOR; property MaxVisibleTasks: Word read FMaxVisibleTasks write SetMaxVisibleTasks default 250; property ShowIcon: Boolean read FShowIcon write SetShowIcon default True; property ShowResourceName: Boolean read FShowResourceName write SetShowResourceName default true; property TaskHeadAttributes: TVpTaskHeadAttr read FTaskHeadAttr write FTaskHeadAttr; property TextMargin: Integer read FTextMargin write SetTextMargin default TEXT_MARGIN; { 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; (*****************************************************************************) { TVpTaskDisplayOptions } (*****************************************************************************) constructor TVpTaskDisplayOptions.Create(AOwner: TVpTaskList); begin inherited Create; FTaskList := AOwner; FDueDateFormat := DefaultFormatSettings.ShortDateFormat; FShowDueDate := true; FCheckColor := cl3DDkShadow; FCheckBGColor := clWindow; FCheckStyle := csCheck; FOverdueColor := clRed; FCompletedColor := clGray; FNormalColor := clWindowText; end; function TVpTaskDisplayOptions.IsStoredDueDateFormat: Boolean; begin Result := FDueDateFormat <> DefaultFormatSettings.ShortDateFormat; end; procedure TVpTaskDisplayOptions.SetOverdueColor(Value : TColor); begin if FOverdueColor <> Value then begin FOverdueColor := Value; UpdateTaskList; end; end; procedure TVpTaskDisplayOptions.SetNormalColor(Value: TColor); begin if FNormalColor <> Value then begin FNormalColor := Value; UpdateTaskList; end; end; procedure TVpTaskDisplayOptions.SetCompletedColor(Value: TColor); begin if FCompletedColor <> Value then begin FCompletedColor := Value; UpdateTaskList; end; end; procedure TVpTaskDisplayOptions.SetCheckColor(Value: TColor); begin if FCheckColor <> Value then begin FCheckColor := Value; UpdateTaskList; end; end; procedure TVpTaskDisplayOptions.SetCheckBGColor(Value: TColor); begin if FCheckBGColor <> Value then begin FCheckBGColor := Value; UpdateTaskList; end; end; procedure TVpTaskDisplayOptions.SetCheckStyle(Value: TVpCheckStyle); begin if Value <> FCheckStyle then begin FCheckStyle := Value; UpdateTaskList; end; end; procedure TVpTaskDisplayOptions.SetDueDateFormat(Value: string); begin if FDueDateFormat <> Value then begin FDueDateFormat := Value; UpdateTaskList; end; end; procedure TVpTaskDisplayOptions.SetShowCompleted(Value : Boolean); begin if FShowCompleted <> Value then begin FShowCompleted := Value; UpdateTaskList; end; end; procedure TVpTaskDisplayOptions.SetShowDueDate(Value: Boolean); begin if FShowDueDate <> Value then begin FShowDueDate := Value; UpdateTaskList; end; end; procedure TVpTaskDisplayOptions.SetShowAll(Value: Boolean); begin if FShowAll <> Value then begin FShowAll := Value; UpdateTaskList; end; end; procedure TVpTaskDisplayOptions.UpdateTaskList; begin if FTaskList <> nil then FTaskList.Invalidate; end; (******************************************************************************) { TVpTaskHeadAttr } (******************************************************************************) constructor TVpTaskHeadAttr.Create(AOwner: TVpTaskList); begin inherited Create; FTaskList := AOwner; FFont := TVpFont.Create(AOwner); FFont.Assign(FTaskList.Font); FColor := clBtnFace; FGlyphDist := 10; end; destructor TVpTaskHeadAttr.Destroy; begin FFont.Free; end; procedure TVpTaskHeadAttr.SetColor(Value: TColor); begin if Value <> FColor then begin FColor := Value; UpdateTaskList; end; end; procedure TVpTaskHeadAttr.SetFont(Value: TVpFont); begin if Value <> FFont then begin FFont.Assign(Value); FFont.Owner := FTaskList; UpdateTaskList; end; end; procedure TVpTaskHeadAttr.SetGlyphDist(Value: Integer); begin if Value <> FGlyphDist then begin FGlyphDist := Value; UpdateTaskList; end; end; procedure TVpTaskHeadAttr.UpdateTaskList; begin if Assigned(FTaskList) then FTaskList.Invalidate; 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 := DEFAULT_COLOR; FLineColor := DEFAULT_LINECOLOR; FTextMargin := TEXT_MARGIN; FScrollBars := ssVertical; FTaskIndex := -1; FShowIcon := True; FAllowInplaceEdit := true; SetLength(tlVisibleTaskArray, MaxVisibleTasks); { size } Height := 225; Width := 169; FDefaultPopup := TPopupMenu.Create(Self); FDefaultPopup.Name := 'default'; InitializeDefaultPopup; Self.PopupMenu := FDefaultPopup; LoadLanguage; 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 + LineEnding2 + 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; var item: TMenuItem; begin for item in FDefaultPopup.Items do if item is TVpMenuItem then TVpMenuItem(item).Translate; 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; procedure TVpTaskList.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = FExternalPopup) then FExternalPopup := nil; end; function TVpTaskList.GetControlType: TVpItemType; begin Result := itTasks; end; procedure TVpTaskList.ExportICalFile(const AFileName: String; const ATasks: TVpTaskArr); begin if Assigned(Datastore) and Assigned(Datastore.Resource) then Datastore.Resource.Tasks.ExportICalFile(AFileName, ATasks); end; function TVpTaskList.ImportICalFile(const AFileName: String; APreview: Boolean = false; ADefaultCategory: Integer = -1): TVpTaskArr; begin if ReadOnly or (not CheckCreateResource) or (not Assigned(DataStore)) or (not Assigned(DataStore.Resource)) then Exit; Result := Datastore.Resource.Tasks.ImportICalFile(AFileName, APreview, ADefaultCategory); if Length(Result) > 0 then begin FActiveTask := Result[High(Result)]; Datastore.PostTasks; Datastore.NotifyDependents; Invalidate; end; 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); 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; procedure TVpTaskList.SetTextMargin(AValue: Integer); begin if AValue <> FTextMargin then begin FTextMargin := AValue; 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 (PopupMenu = FDefaultPopup) 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; function TVpTaskList.GetPopupMenu: TPopupMenu; begin if FExternalPopup = nil then Result := FDefaultPopup else Result := FExternalPopup; end; procedure TVpTaskList.SetPopupMenu(AValue: TPopupMenu); begin if (AValue = nil) or (AValue = FDefaultPopup) then FExternalPopup := nil else FExternalPopup := AValue; end; procedure TVpTaskList.InitializeDefaultPopup; var NewItem: TVpMenuItem; begin FDefaultPopup.Items.Clear; if RSTaskPopupAdd <> '' then begin // "Add" NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikAddTask; NewItem.OnClick := PopupAddTask; NewItem.Tag := 0; FDefaultPopup.Items.Add(NewItem); end; if RSTaskPopupEdit <> '' then begin // "Edit" NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikEditTask; NewItem.OnClick := PopupEditTask; NewItem.Tag := 1; FDefaultPopup.Items.Add(NewItem); end; if RSTaskPopupDelete <> '' then begin // "Delete" NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikDeleteTask; NewItem.OnClick := PopupDeleteTask; NewItem.Tag := 1; FDefaultPopup.Items.Add(NewItem); end; if (RSPopupImportFromICal <> '') or (RSPopupExportToICal <> '') then begin NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikSeparator; FDefaultPopup.Items.Add(NewItem); NewItem := TVpMenuItem.Create(Self); // Import from iCal NewItem.Kind := mikImportTaskFromICal; NewItem.OnClick := PopupImportFromICalFile; NewItem.Tag := 0; FDefaultPopup.Items.Add(NewItem); NewItem := TVpMenuItem.Create(Self); // Export to iCal NewItem.Kind := mikExportTaskToICal; NewItem.OnClick := PopupExportToICalFile; 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.PopupDeleteTask(Sender: TObject); begin if ReadOnly then Exit; if FActiveTask <> nil then begin Repaint; DeleteActiveTask(True); end; 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.PopupExportToICalFile(Sender: TObject); var dlg: TSaveDialog; begin if (not Assigned(Datastore)) or (not Assigned(Datastore.Resource)) or (FActiveTask = nil) then exit; dlg := TSaveDialog.Create(nil); try dlg.Title := RSSaveICalTitle; dlg.Filter := RSICalFilter; dlg.FileName := ''; dlg.Options := dlg.Options - [ofAllowMultiSelect] + [ofOverwritePrompt]; if dlg.Execute then ExportICalFile(dlg.FileName, [FActiveTask]); finally dlg.Free; end; end; procedure TVpTaskList.PopupImportFromICalFile(Sender: TObject); var dlg: TOpenDialog; fn: String; 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 for fn in dlg.Files do ImportICalFile(fn, dlg.Files.Count = 1); end; finally dlg.Free; 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 <> 0} procedure TVpTaskList.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); begin inherited; if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then begin FTextMargin := round(FTextMargin * AXProportion); with FTaskHeadAttr do FGlyphDist := round(FGlyphDist * AXProportion); end; end; {$IFEND} {$IF VP_LCL_SCALING = 2} procedure TVpTaskList.FixDesignFontsPPI(const ADesignTimePPI: Integer); begin inherited; DoFixDesignFontPPI(TaskHeadAttributes.Font, ADesignTimePPI); end; 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.