{*********************************************************} {* VPDAYVIEW.PAS 1.03 *} {*********************************************************} {* ***** BEGIN LICENSE BLOCK ***** *} {* Version: MPL 1.1 *} {* *} {* The contents of this file are subject to the Mozilla Public License *} {* Version 1.1 (the "License"); you may not use this file except in *} {* compliance with the License. You may obtain a copy of the License at *} {* http://www.mozilla.org/MPL/ *} {* *} {* Software distributed under the License is distributed on an "AS IS" basis, *} {* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *} {* for the specific language governing rights and limitations under the *} {* License. *} {* *} {* The Original Code is TurboPower Visual PlanIt *} {* *} {* The Initial Developer of the Original Code is TurboPower Software *} {* *} {* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} {* TurboPower Software Inc. All Rights Reserved. *} {* *} {* Contributor(s): *} {* *} {* ***** END LICENSE BLOCK ***** *} { This unit contains everything needed for the TVpDayView component (including the inline editor). The rendering of Visual PlanIt components is a bit involved. The component's Paint method calls RenderToCanvas. The RenderToCanvas method of each of the visual VisualPlanIt controls is responsible both for drawing to the screen (both design and run time) as well as printing. In the case of printing, the component needs to render itself to an arbitrary rectangle and possibly rotated (for the screen the rectangle is the ClientRect and the rotation angle is always zero). To achieve that goal, the functions in VpCanvasUtils are used to go between the rendering of the control and the TCanvas that it needs to render to. The rendering of the DayView is complex. Look at the other components (MonthView and TaskList are probably the best places to start) before making changes to the DayView rendering. In the current version of TvPlanIt the extremely long rendering procedure has been split off to a separate unit and an auxiliary painter class (TVpDayViewPaitner in unit VpDayViewPainter). The in place editor is currently based off the TCustomEdit class. This can probably be changed to use a TCustomMemo as its base class. This will provide multi-line editing capabilities. } unit VpDayView; {$IF FPC_FullVersion >= 30200} {$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} {$IFEND} {$I vp.inc} {.$DEFINE DEBUGDV} { Causes the DayView to operate in debug mode } interface uses {$IFDEF LCL} LMessages, LCLProc, LCLType, LCLIntf, {$ELSE} Windows, Messages, {$ENDIF} Classes, Graphics, Controls, ExtCtrls, StdCtrls, Buttons, Forms, Menus, ImgList, VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils; type TVpLineRec = packed record Hour: TVpHours; Minute: Integer; Time: TDateTime; Rec: TRect; end; TVpColRec = packed record Rec: TRect; Date: TDateTime; end; TVpLineArray = array of TVpLineRec; TVpLineMatrix = array of TVpLineArray; TVpColRectArray = array of TVpColRec; TVpDVIconData = record Show: Boolean; Bitmap: TBitmap; end; TVpDVIconTypes = (itAlarm, itRecurring, itCategory, itCustom); TVpDVIcons = array [itAlarm..itCustom] of TVpDVIconData; TVpOnDVBeforeDrawEvent = procedure (Sender: TObject; Event: TVpEvent; AActive: Boolean; ACanvas: TCanvas; AGutterRect, AEventRect, AIconRect: TRect) of object; TVpOnDVAfterDrawEvent = procedure (Sender: TObject; Event: TVpEvent; AActive: Boolean; ACanvas: TCanvas; AGutterRect, AEventRect, AIconRect: TRect) of object; TVpOnDVDrawIcons = procedure (Sender: TObject; Event: TVpEvent; var Icons: TVpDVIcons) of object; TVpDVWrapStyle = (wsNone, wsIconFlow, wsNoFlow); { Forward Declarations } TVpDayView = class; TVpDvInplaceEdit = class(TCustomEdit) protected procedure CreateParams(var Params: TCreateParams); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; {$IFNDEF LCL} procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS; {$ELSE} procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS; {$ENDIF} public constructor Create(AOwner: TComponent); override; end; TVpRHAttributes = class(TPersistent) private FOwner: TVpDayView; FColor: TColor; FHourFont: TVpFont; FMinuteFont: TVpFont; procedure SetColor(const Value: TColor); procedure SetHourFont(Value: TVpFont); procedure SetMinuteFont(Value: TVpFont); protected public constructor Create(AOwner: TVpDayView); destructor Destroy; override; property Owner: TVpDayView read FOwner; published property HourFont: TVpFont read FHourFont write SetHourFont; property MinuteFont: TVpFont read FMinuteFont write SetMinuteFont; property Color: TColor read FColor write SetColor; end; TVpAllDayEventAttributes = class(TPersistent) private FBackgroundColor: TColor; FEventBackgroundColor: TColor; FEventBorderColor: TColor; FFont: TVpFont; protected FOwner: TWinControl; public constructor Create(AOwner: TWinControl); destructor Destroy; override; procedure SetBackGroundColor(Value: TColor); procedure SetEventBackgroundColor(Value: TColor); procedure SetFont(Value: TVpFont); procedure SetEventBorderColor(Value: TColor); published property BackgroundColor: TColor read FBackgroundColor write SetBackGroundColor; property EventBorderColor: TColor read FEventBorderColor write SetEventBorderColor; property EventBackgroundColor: TColor read FEventBackgroundColor write SetEventBackgroundColor; property Font: TVpFont read FFont write SetFont; end; TVpCHAttributes = class(TPersistent) private FOwner: TVpDayView; FColor: TColor; FFont: TVpFont; procedure SetColor(const Value: TColor); procedure SetFont(Value: TVpFont); protected public constructor Create(AOwner: TVpDayView); destructor Destroy; override; property Owner: TVpDayView read FOwner; published property Font: TVpFont read FFont write SetFont; property Color: TColor read FColor write SetColor; end; TVpDayViewIconAttributes = class(TPersistent) private FShowAlarmBitmap: Boolean; FShowCategoryBitmap: Boolean; FShowRecurringBitmap: Boolean; FAlarmBitmap: TBitmap; FRecurringBitmap: TBitmap; FAlarmImageIndex: TImageIndex; FRecurringImageIndex: TImageIndex; FShowInPrint: Boolean; FOwner: TVpLinkableControl; protected procedure SetAlarmBitmap(v: TBitmap); procedure SetAlarmImageIndex(v: TImageIndex); procedure SetRecurringBitmap(v: TBitmap); procedure SetRecurringImageIndex(v: TImageIndex); procedure SetShowAlarmBitmap(const v: Boolean); procedure SetShowCategoryBitmap(const v: Boolean); procedure SetShowRecurringBitmap(const v: Boolean); public constructor Create(AOwner: TVpLinkableControl); destructor Destroy; override; published property AlarmBitmap: TBitmap read FAlarmBitmap write SetAlarmBitmap; property AlarmImageIndex: TImageIndex read FAlarmImageIndex write SetAlarmImageIndex default -1; property RecurringBitmap: TBitmap read FRecurringBitmap write SetRecurringBitmap; property RecurringImageIndex: TImageIndex read FRecurringImageIndex write SetRecurringImageIndex default -1; property ShowAlarmBitmap: Boolean read FShowAlarmBitmap write SetShowAlarmBitmap default True; property ShowCategoryBitmap : Boolean read FShowCategoryBitmap write SetShowCategoryBitmap default True; property ShowRecurringBitmap : Boolean read FShowRecurringBitmap write SetShowRecurringBitmap default True; property ShowInPrint: Boolean read FShowInPrint write FShowInPrint default True; end; { TVpDayView } TVpDayView = class(TVpLinkableControl) private FActiveCol: Integer; FActiveEvent: TVpEvent; FActiveRow: Integer; FAllDayEventAttr: TVpAllDayEventAttributes; FAllowDragAndDrop: Boolean; FAllowInplaceEdit: Boolean; FColor: TColor; FColumnWidth: Integer; FComponentHint: TTranslateString; FCustomRowHeight: Integer; FDateLabelFormat: string; FDefaultPopup: TPopupMenu; FDefTopHour: TVpHours; FDisplayDate: TDateTime; FDotDotDotColor: TColor; FDragDropTransparent: Boolean; FDrawingStyle: TVpDrawingStyle; FExternalPopup: TPopupMenu; FFixedDate: Boolean; FGranularity: TVpGranularity; FGutterWidth: Integer; FHeadAttr: TVpCHAttributes; FHintMode: TVpHintMode; FIconAttributes: TVpDayViewIconAttributes; FIncludeWeekends: Boolean; FLineColor: TColor; FLineCount: Integer; FMouseEvent: TVpEvent; FNumDays: Integer; FRowHeadAttr: TVpRHAttributes; FRowLinesStep: Integer; FScrollBars: TScrollStyle; FShowEventTimes: Boolean; FShowNavButtons: Boolean; FShowResourceName: Boolean; FSimpleRowTime: Boolean; FTimeFormat: TVpTimeFormat; FTimeSlotColors: TVpTimeSlotColor; FTopHour: TVpHours; FTopLine: Integer; FVisibleLines: Integer; FWrapStyle: TVpDVWrapStyle; // Internal variables dvClickTimer: TTimer; dvClientVArea: Integer; dvColHeadHeight: Integer; dvCreatingEditor: Boolean; dvDragging: Boolean; dvDragStartTime: TDateTime; dvEndingEditing: Boolean; dvInLinkHandler: Boolean; dvLoaded: Boolean; dvMouseDown: Boolean; dvMouseDownPoint: TPoint; dvPainting: Boolean; dvRowHeadWidth: Integer; dvRowHeight: Integer; dvTimeIncSize: double; // Event variables FAfterEdit: TVpAfterEditEvent; FBeforeEdit: TVpBeforeEditEvent; FOnAddEvent: TVpOnAddNewEvent; FOnAfterDrawEvent: TVpOnDVAfterDrawEvent; FOnBeforeDrawEvent: TVpOnDVBeforeDrawEvent; FOnDeletingEvent: TVpOnDeletingEvent; FOnDrawIcons: TVpOnDVDrawIcons; FOnHoliday: TVpHolidayEvent; FOnModifyEvent: TVpOnModifyEvent; FOwnerDrawCells: TVpOwnerDrawRowEvent; FOwnerDrawColHead: TVpOwnerDrawEvent; FOwnerDrawRowHead: TVpOwnerDrawRowEvent; FOwnerEditEvent: TVpEditEvent; // Property methods function GetLastVisibleDate: TDateTime; function IsStoredDateLabelFormat: Boolean; procedure SetActiveCol(Value: Integer); procedure SetActiveRow(Value: Integer); procedure SetColor(Value: TColor); reintroduce; procedure SetCustomRowHeight(Value: Integer); procedure SetDateLabelFormat(Value: string); procedure SetDefTopHour(Value: TVpHours); procedure SetDisplayDate(Value: TDateTime); procedure SetDotDotDotColor(const v: TColor); procedure SetDrawingStyle(Value: TVpDrawingStyle); procedure SetGranularity(Value: TVpGranularity); procedure SetGutterWidth(Value: Integer); procedure SetIncludeWeekends(Value: Boolean); procedure SetLineColor(Value: TColor); procedure SetNumDays(Value: Integer); procedure SetPopupMenu(AValue: TPopupMenu); procedure SetRowLinesStep(Value: Integer); procedure SetShowEventTimes(Value: Boolean); procedure SetShowNavButtons(Value: Boolean); procedure SetShowResourceName(Value: Boolean); procedure SetSimpleRowTime(Value: Boolean); procedure SetTimeFormat(Value: TVpTimeFormat); procedure SetTopHour(Value: TVpHours); procedure SetTopLine(Value: Integer); procedure SetVScrollPos; procedure SetWrapStyle(const v: TVpDVWrapStyle); protected // Needed by the DayViewPainter dvDayUpBtn: TSpeedButton; dvDayDownBtn: TSpeedButton; dvTodayBtn: TSpeedButton; dvWeekUpBtn: TSpeedButton; dvWeekDownBtn: TSpeedButton; dvActiveEventRec: TRect; dvActiveIconRec: TRect; dvColRectArray: TVpColRectArray; dvEventArray: TVpEventArray; dvInPlaceEditor: TVpDvInPlaceEdit; dvLineMatrix: TVpLineMatrix; { Drag-drop methods } procedure DoStartDrag(var DragObject: TDragObject); override; procedure DoEndDrag(Target: TObject; X, Y: Integer); override; procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override; { Hints } procedure ShowHintWindow(APoint: TPoint; AEvent: TVpEvent); procedure HideHintWindow; procedure SetHint(const AValue: TTranslateString); override; procedure SetHintMode(const AValue: TVpHintMode); { Popup } function GetPopupMenu: TPopupMenu; override; procedure PopupAddEvent(Sender: TObject); procedure PopupImportICalFile(Sender: TObject); procedure PopupExportICalFile(Sender: TObject); procedure PopupDeleteEvent(Sender: TObject); procedure PopupEditEvent(Sender: TObject); procedure PopupToday(Sender: TObject); procedure PopupTomorrow(Sender: TObject); procedure PopupYesterday(Sender: TObject); procedure PopupNextDay(Sender: TObject); procedure PopupPrevDay(Sender: TObject); procedure PopupNextWeek(Sender: TObject); procedure PopupPrevWeek(Sender: TObject); procedure PopupNextMonth(Sender: TObject); procedure PopupPrevMonth(Sender: TObject); procedure PopupNextYear(Sender: TObject); procedure PopupPrevYear(Sender: TObject); procedure PopupCustomDate(Sender: TObject); procedure PopupPickResourceGroupEvent(Sender: TObject); procedure InitializeDefaultPopup; { internal methods } function dvCalcRowHeight(Scale: Extended; UseGran: TVpGranularity): Integer; function dvCalcVisibleLines(RenderHeight, ColHeadHeight, ARowHeight: Integer; Scale: Extended; StartLine, StopLine: Integer): Integer; function dvCalcColHeadHeight(Scale: Extended): Integer; procedure dvEditInPlace(Sender: TObject); procedure dvHookUp; procedure dvNavButtonsClick(Sender: TObject); procedure dvPopulate; procedure dvScrollVertical(Lines: Integer); procedure dvSpawnEventEditDialog(IsNewEvent: Boolean); procedure dvSetActiveRowByCoord(Pnt: TPoint; Sloppy: Boolean); procedure dvSetActiveColByCoord(Pnt: TPoint); procedure EditEvent; function EditEventAtCoord(APoint: TPoint): Boolean; procedure EndEdit(Sender: TObject); function GetEventAtCoord(APoint: TPoint): TVpEvent; function GetEventRect(AEvent: TVpEvent): TRect; function GetRealNumDays(WorkDate: TDateTime): Integer; procedure SetActiveEventByCoord(APoint: TPoint); procedure SetTimeIntervals(UseGran: TVpGranularity); { inherited methods } procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure Loaded; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override; procedure MouseEnter; override; procedure MouseLeave; override; procedure MouseMove(Shift: TShiftState; X,Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure Paint; override; { message handlers } procedure VpDayViewInit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); message Vp_DayViewInit; {$IFNDEF LCL} procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk); message WM_LBUTTONDBLCLK; procedure WMSize(var Msg: TWMSize); message WM_SIZE; procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL; procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS; procedure WMEraseBackground (var Msg : TWMERASEBKGND); // ??? wp: missing "message WM_ERASEBKGND"? procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY; {$ELSE} function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; procedure WMSize(var Msg: TLMSize); message LM_SIZE; procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; procedure WMEraseBackground(var Msg: TLMERASEBKGND); message LM_ERASEBKGND; procedure WMLButtonDblClk(var Msg: TLMLButtonDblClk); message LM_LBUTTONDBLCLK; {$ENDIF} public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function BuildEventString(AEvent: TVpEvent; UseAsHint: Boolean): String; procedure DeleteActiveEvent(Verify: Boolean); procedure DragDrop(Source: TObject; X, Y: Integer); override; procedure ExportICalFile(const AFileName: String; const AEvents: TVpEventArr); function ImportICalFile(const AFileName: String; APreview: Boolean = false; ADefaultCategory: Integer = -1): TVpEventArr; procedure Invalidate; override; function IsHoliday(ADate: TDate; out AHolidayName: String): Boolean; procedure LoadLanguage; procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType; const Value: Variant); override; procedure EditSelectedEvent(IsNewEvent: Boolean = false); function GetControlType: TVpItemType; override; procedure AutoScaledPaintToCanvas(PaintCanvas: TCanvas; PaintTo: TRect; Angle: TVpRotationAngle; RenderDate: TDateTime; StartLine, StopLine: Integer; UseGran: TVpGranularity); procedure PaintToCanvas (ACanvas: TCanvas; ARect: TRect; Angle: TVpRotationAngle; ADate: TDateTime; StartHour, EndHour: TVpHours; UseGran: TVpGranularity); procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect; Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime; StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); override; {$IF VP_LCL_SCALING = 2} procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override; {$ELSE} {$IF VP_LCL_SCALING = 1} procedure ScaleFontsPPI(const AProportion: Double); override; {$ENDIF} {$ENDIF} property ActiveEvent: TVpEvent read FActiveEvent write FActiveEvent; property TopHour: TVpHours read FTopHour write SetTopHour; property TopLine: Integer read FTopLine write SetTopLine; property LineCount: Integer read FLineCount; property ActiveRow: Integer read FActiveRow write SetActiveRow; property ActiveCol: Integer read FActiveCol write SetActiveCol; property Date: TDateTime read FDisplayDate write SetDisplayDate; property LastVisibleDate: TDateTime read GetLastVisibleDate; property VisibleLines: Integer read FVisibleLines; published property Align; property Anchors; {$IFDEF LCL} property BorderSpacing; {$ENDIF} property Constraints; property PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu; property ReadOnly default false; property TabStop default true; property TabOrder; property Font; property AllDayEventAttributes: TVpAllDayEventAttributes read FAllDayEventAttr write FAllDayEventAttr; property AllowDragAndDrop: Boolean read FAllowDragAndDrop write FAllowDragAndDrop default false; property AllowInplaceEditing: Boolean read FAllowInplaceEdit write FAllowInplaceEdit default true; property DotDotDotColor: TColor read FDotDotDotColor write SetDotDotDotColor default clBlack; property ShowEventTimes: Boolean read FShowEventTimes write SetShowEventTimes default true; property DragDropTransparent: Boolean read FDragDropTransparent write FDragDropTransparent default false; property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d; property TimeSlotColors: TVpTimeSlotColor read FTimeSlotColors write FTimeSlotColors; property HeadAttributes: TVpCHAttributes read FHeadAttr write FHeadAttr; property RowHeadAttributes: TVpRHAttributes read FRowHeadAttr write FRowHeadAttr; property IconAttributes: TVpDayViewIconAttributes read FIconAttributes write FIconAttributes; property Color: TColor read FColor write SetColor default DEFAULT_COLOR; property OwnerDrawRowHeader: TVpOwnerDrawRowEvent read FOwnerDrawRowHead write FOwnerDrawRowHead; property OwnerDrawColHeader: TVpOwnerDrawEvent read FOwnerDrawColHead write FOwnerDrawColHead; property OwnerDrawCells: TVpOwnerDrawRowEvent read FOwnerDrawCells write FOwnerDrawCells; property ShowResourceName: Boolean read FShowResourceName write SetShowResourceName default true; property LineColor: TColor read FLineColor write SetLineColor default DEFAULT_LINECOLOR; property GutterWidth: Integer read FGutterWidth write SetGutterWidth default 7; property DateLabelFormat: string read FDateLabelFormat write SetDateLabelFormat stored IsStoredDateLabelFormat; Property Granularity: TVpGranularity read FGranularity write SetGranularity default gr30Min; property DefaultTopHour: TVpHours read FDefTopHour write SetDefTopHour default h_07; property TimeFormat: TVpTimeFormat read FTimeFormat write SetTimeFormat default tf12Hour; property IncludeWeekends: Boolean read FIncludeWeekends write SetIncludeWeekends default True; property NumDays: Integer read FNumDays write SetNumDays default 1; property WrapStyle: TVpDVWrapStyle read FWrapStyle Write SetWrapStyle default wsIconFlow; property HintMode: TVpHintMode read FHintMode write SetHintMode default hmPlannerHint; property ShowNavButtons: Boolean read FShowNavButtons write SetShowNavButtons default true; property FixedDate: Boolean read FFixedDate write FFixedDate default false; property RowHeight: Integer read FCustomRowHeight write SetCustomRowHeight default 0; property RowLinesStep: Integer read FRowLinesStep write SetRowLinesStep default 1; property SimpleRowTime: Boolean read FSimpleRowTime write SetSimpleRowTime default false; {events} property AfterEdit: TVpAfterEditEvent read FAfterEdit write FAfterEdit; property BeforeEdit: TVpBeforeEditEvent read FBeforeEdit write FBeforeEdit; property OnAddEvent: TVpOnAddNewEvent read FOnAddEvent write FOnAddEvent; property OnAfterDrawEvent: TVpOnDVAfterDrawEvent read FOnAfterDrawEvent write FOnAfterDrawEvent; property OnBeforeDrawEvent: TVpOnDVBeforeDrawEvent read FOnBeforeDrawEvent write FOnBeforeDrawEvent; property OnDeletingEvent: TVpOnDeletingEvent read FOnDeletingEvent write FOnDeletingEvent; property OnDrawIcons: TVpOnDVDrawIcons read FOnDrawIcons Write FOnDrawIcons; property OnHoliday: TVpHolidayEvent read FOnHoliday write FOnHoliday; property OnModifyEvent: TVpOnModifyEvent read FOnModifyEvent write FOnModifyEvent; property OnOwnerEditEvent: TVpEditEvent read FOwnerEditEvent write FOwnerEditEvent; property OnClick; end; implementation uses {$IFDEF LCL} DateUtils, {$ENDIF} SysUtils, StrUtils, Math, Dialogs, VpEvntEditDlg, VpDayViewPainter; (*****************************************************************************) { TVpTGInPlaceEdit } constructor TVpDvInPlaceEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); TabStop := False; BorderStyle := bsNone; // DoubleBuffered := False; end; procedure TVpDvInPlaceEdit.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); Params.Style := Params.Style{$IFNDEF LCL} or ES_MULTILINE{$ENDIF}; end; procedure TVpDvInPlaceEdit.KeyDown(var Key: Word; Shift: TShiftState); // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! // !!!! WARNING // !!!! // !!!! Experimental change below. Verify this change before releasing // !!!! VP 1.03 // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! begin case Key of VK_RETURN: begin Key := 0; TVpDayView(Owner).EndEdit(Self); end; VK_UP: begin Key := 0; TVpDayView(Owner).ActiveRow := TVpDayView(Owner).ActiveRow - 1; // !!!! TVpDayView(Owner).EndEdit(Self); !!!! !!!!!!!!!!!!!!!!!!!!!!!!! end; VK_DOWN: begin Key := 0; TVpDayView(Owner).ActiveRow := TVpDayView(Owner).ActiveRow + 1; // !!!! TVpDayView(Owner).EndEdit(Self); !!!! !!!!!!!!!!!!!!!!!!!!!!!!! end; VK_ESCAPE: begin Key := 0; Hide; TVpDayView(Owner).SetFocus; end; else inherited; end; end; {$IFNDEF LCL} procedure TVpDvInPlaceEdit.WMKillFocus(var Msg: TWMKillFocus); {$ELSE} procedure TVpDvInPlaceEdit.WMKillFocus(var Msg: TLMKillFocus); {$ENDIF} begin Unused(Msg); TVpDayView(Owner).EndEdit(self); end; (*****************************************************************************) { TVpAllDayEventAttributes } constructor TVpAllDayEventAttributes.Create(AOwner: TWinControl); begin FOwner:= AOwner; FFont := TVpFont.Create(AOwner); FBackgroundColor := clBtnShadow; FEventBackgroundColor := clBtnFace; FEventBorderColor := cl3dDkShadow; end; destructor TVpAllDayEventAttributes.Destroy; begin inherited; FFont.Free; end; procedure TVpAllDayEventAttributes.SetBackGroundColor(Value: TColor); begin FBackgroundColor := Value; FOwner.Invalidate; end; procedure TVpAllDayEventAttributes.SetEventBackgroundColor(Value: TColor); begin FEventBackgroundColor := Value; FOwner.Invalidate; end; procedure TVpAllDayEventAttributes.SetEventBorderColor(Value: TColor); begin FEventBorderColor := Value; FOwner.Invalidate; end; procedure TVpAllDayEventAttributes.SetFont(Value: TVpFont); begin FFont.Assign(Value); FFont.Owner := FOwner; end; (*****************************************************************************) { TVpDayViewIconAttributes } constructor TVpDayViewIconAttributes.Create(AOwner: TVpLinkableControl); begin inherited Create; FOwner := AOwner; FAlarmBitmap := TBitmap.Create; FRecurringBitmap := TBitmap.Create; FAlarmImageIndex := -1; FRecurringImageIndex := -1; FShowAlarmBitmap := True; FShowCategoryBitmap := True; FShowRecurringBitmap := True; FShowInPrint := True; end; destructor TVpDayViewIconAttributes.Destroy; begin FAlarmBitmap.Free; FRecurringBitmap.Free; inherited Destroy; end; procedure TVpDayViewIconAttributes.SetAlarmBitmap(v: TBitmap); begin FAlarmBitmap.Assign(v); if Assigned(FOwner) then FOwner.Invalidate; end; procedure TVpDayViewIconAttributes.SetAlarmImageIndex(v: TImageIndex); begin if FAlarmImageIndex <> v then begin FAlarmImageIndex := v; if Assigned(FOwner) then FOwner.Invalidate; end; end; procedure TVpDayViewIconAttributes.SetRecurringBitmap(v: TBitmap); begin FRecurringBitmap.Assign(v); if Assigned(FOwner) then FOwner.Invalidate; end; procedure TVpDayViewIconAttributes.SetRecurringImageIndex(v: TImageIndex); begin if FRecurringImageIndex <> v then begin FRecurringImageIndex := v; if Assigned(FOwner) then FOwner.Invalidate; end; end; procedure TVpDayViewIconAttributes.SetShowAlarmBitmap(const v: Boolean); begin if FShowAlarmBitmap <> v then begin FShowAlarmBitmap := v; if Assigned(FOwner) then FOwner.Invalidate end; end; procedure TVpDayViewIconAttributes.SetShowCategoryBitmap(const v: Boolean); begin if FShowCategoryBitmap <> v then begin FShowCategoryBitmap := v; if Assigned(FOwner) then FOwner.Invalidate; end; end; procedure TVpDayViewIconAttributes.SetShowRecurringBitmap(const v: Boolean); begin if FShowRecurringBitmap <> v then begin FShowRecurringBitmap := v; if Assigned(FOwner) then FOwner.Invalidate end; end; (*****************************************************************************) { TVpDayView } constructor TVpDayView.Create(AOwner: TComponent); begin inherited; ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks]; HintWindowClass := TVpHintWindow; { Create internal classes and stuff } FTimeSlotColors := TVpTimeSlotColor.Create(self); FHeadAttr := TVpCHAttributes.Create(self); FRowHeadAttr := TVpRHAttributes.Create(self); FAllDayEventAttr := TVpAllDayEventAttributes.Create(self); dvClickTimer := TTimer.Create(self); FIconAttributes := TVpDayViewIconAttributes.Create(Self); { create Nav buttons } dvDayUpBtn := TSpeedButton.Create(self); dvDayUpBtn.Parent := self; dvDayDownBtn := TSpeedButton.Create(self); dvDayDownBtn.Parent := self; dvTodayBtn := TSpeedButton.Create(self); dvTodayBtn.Parent := self; dvWeekDownBtn := TSpeedButton.Create(self); dvWeekDownBtn.Parent := self; dvWeekUpBtn := TSpeedButton.Create(self); dvWeekUpBtn.Parent := self; { flat } dvTodayBtn.Flat := true; dvWeekDownBtn.Flat := true; dvDayDownBtn.Flat := true; dvDayUpBtn.Flat := true; dvWeekUpBtn.Flat := true; { transparent } dvTodayBtn.Transparent := true; dvWeekDownBtn.Transparent := true; dvDayDownBtn.Transparent := true; dvDayUpBtn.Transparent := true; dvWeekUpBtn.Transparent := true; { load their images } {$IFDEF NEW_ICONS} LoadGlyphFromRCDATA(dvDayUpBtn.Glyph, 'VpRArrow', 16, 24, 32); LoadGlyphFromRCDATA(dvDayDownBtn.Glyph, 'VpLArrow', 16, 24, 32); LoadGlyphFromRCDATA(dvTodayBtn.Glyph, 'VpToday', 16, 24, 32); LoadGlyphFromRCDATA(dvWeekUpBtn.Glyph, 'VpRArrows', 16, 24, 32); LoadGlyphFromRCDATA(dvWeekDownBtn.Glyph, 'VpLArrows', 16, 24, 32); {$ELSE} dvDayUpBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPRIGHTARROW'); dvDayDownBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPLEFTARROW'); dvTodayBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPTODAY'); dvWeekUpBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPRIGHTARROWS'); dvWeekDownBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPLEFTARROWS'); {$ENDIF} { set their OnClick handler } dvDayUpBtn.OnClick := dvNavButtonsClick; dvDayDownBtn.OnClick := dvNavButtonsClick; dvTodayBtn.OnClick := dvNavButtonsClick; dvWeekUpBtn.OnClick := dvNavButtonsClick; dvWeekDownBtn.OnClick := dvNavButtonsClick; { Set up the hints } dvDayUpBtn.ShowHint := True; dvDayDownBtn.ShowHint := True; dvTodayBtn.ShowHint := True; dvWeekUpBtn.ShowHint := True; dvWeekDownBtn.ShowHint := True; { Set styles and initialize internal variables } {$IFDEF VERSION4} // DoubleBuffered := true; {$ENDIF} NumDays := 1; dvInLinkHandler := false; dvClickTimer.Enabled := false; dvClickTimer.Interval := ClickDelay; dvClickTimer.OnTimer := dvEditInPlace; dvCreatingEditor := false; FDrawingStyle := ds3d; dvPainting := false; FShowNavButtons := true; FShowResourceName := true; FColor := DEFAULT_COLOR; FLineColor := DEFAULT_LINECOLOR; Granularity := gr30min; FDefTopHour := h_07; FDisplayDate := Now; FFixedDate := false; FCustomRowHeight := 0; FRowLinesStep := 1; FSimpleRowTime := false; TopHour := FDefTopHour; FTimeFormat := tf12Hour; FDateLabelFormat := 'dddddd'; //'dddd, mmmm dd, yyyy'; FColumnWidth := 200; FScrollBars := ssVertical; FActiveRow := -1; FGutterWidth := 7; dvEndingEditing := False; FWrapStyle := wsIconFlow; FDotDotDotColor := clBlack; FIncludeWeekends := True; FAllowInplaceEdit := true; FShowEventTimes := true; { set up fonts and colors } FHeadAttr.Font.Size := 10; FHeadAttr.Font.Style := []; FHeadAttr.Color := clBtnFace; FRowHeadAttr.FHourFont.Size := 18; FRowHeadAttr.FHourFont.Style := []; FRowHeadAttr.FMinuteFont.Size := 9; FRowHeadAttr.FMinuteFont.Style := []; FRowHeadAttr.Color := clBtnFace; {$IFNDEF LCL} FHeadAttr.Font.Name := 'Tahoma'; FRowHeadAttr.FHourFont.Name := 'Tahoma'; FRowHeadAttr.FMinuteFont.Name := 'Tahoma'; {$ENDIF} SetLength(dvEventArray, MaxVisibleEvents); DragMode := dmManual; dvDragging := false; dvMouseDownPoint := Point(0, 0); dvMouseDown := false; // Size Height := 225; Width := 265; // popup menu FDefaultPopup := TPopupMenu.Create(Self); FDefaultPopup.Name := 'default'; InitializeDefaultPopup; Self.PopupMenu := FDefaultPopup; LoadLanguage; dvHookUp; end; destructor TVpDayView.Destroy; begin FreeAndNil(dvInplaceEditor); FTimeSlotColors.Free; FHeadAttr.Free; FRowHeadAttr.Free; FAllDayEventAttr.Free; dvClickTimer.Free; FDefaultPopup.Free; FIconAttributes.Free; dvDayUpBtn.Free; dvDayDownBtn.Free; dvTodayBtn.Free; dvWeekUpBtn.Free; dvWeekDownBtn.Free; inherited; end; function TVpDayView.BuildEventString(AEvent: TVpEvent; UseAsHint: Boolean): String; var timeFmt: String; timeStr: String; s: String; res: TVpResource; grp: TVpResourceGroup; isOverlayed: Boolean; showDetails: Boolean; begin Result := ''; if (AEvent = nil) or (Datastore = nil) or (Datastore.Resource = nil) then exit; grp := Datastore.Resource.Group; showDetails := (grp <> nil) and (grp.ShowDetails <> []); isOverlayed := AEvent.IsOverlayed; timefmt := GetTimeFormatStr(TimeFormat); if UseAsHint then begin { Usage as hint } if isOverlayed then begin grp := Datastore.Resource.Group; if (odResource in grp.ShowDetails) then begin res := Datastore.Resources.GetResource(AEvent.ResourceID); Result := RSOverlayed + ': ' + res.Description; end else Result := RSOverlayed; end else showDetails := true; timeStr := IfThen(AEvent.AllDayEvent, RSAllDay, FormatDateTime(timeFmt, AEvent.StartTime) + ' - ' + FormatDateTime(timeFmt, AEvent.EndTime) ); Result := IfThen(Result = '', timeStr, Result + LineEnding + timeStr ); if showDetails then begin // Event description Result := Result + LineEnding2 + RSEvent + ':' + LineEnding + AEvent.Description; // Event notes if (AEvent.Notes <> '') then begin s := WrapText(AEvent.Notes, MAX_HINT_WIDTH); s := StripLastLineEnding(s); Result := Result + LineEnding2 + RSNotes + ':' + LineEnding + s; end; // Event location if (AEvent.Location <> '') then Result := Result + LineEnding2 + RSLocation + ':' + LineEnding + AEvent.Location; end; end else begin { Usage as cell text } if isOverlayed then begin Result := '[' + RSOverlayedEvent + '] '; if showDetails then begin res := Datastore.Resources.GetResource(AEvent.ResourceID); if res <> nil then Result := '[' + res.Description + '] ' end; end else showDetails := true; timeStr := IfThen(ShowEventTimes, Format('%s - %s: ', [ FormatDateTime(timeFmt, AEvent.StartTime), FormatDateTime(timeFmt, AEvent.EndTime) ])); if showDetails then Result := IfThen(Result = '', timeStr + AEvent.Description, Result + timeStr + AEvent.Description) else Result := IfThen(Result = '', timeStr, Result + timeStr); end; end; procedure TVpDayView.LoadLanguage; var item: TMenuItem; begin dvDayUpBtn.Hint := RSNextDay; dvDayDownBtn.Hint := RSPrevDay; dvTodayBtn.Hint := RSToday; dvWeekUpBtn.Hint := RSNextWeek; dvWeekDownBtn.Hint := RSPrevWeek; for item in FDefaultPopup.Items do if item is TVpMenuItem then TVpMenuItem(item).Translate; end; procedure TVpDayView.DeleteActiveEvent(Verify: Boolean); var DoIt: Boolean; begin if ReadOnly then Exit; if (FActiveEvent <> nil) and (not FActiveEvent.CanEdit) then exit; dvClickTimer.Enabled := false; EndEdit(self); DoIt := not Verify; if FActiveEvent <> nil then begin if Assigned(FOnDeletingEvent) then begin DoIt := true; FOnDeletingEvent(self, FActiveEvent, DoIt); end else if Verify then DoIt := (MessageDlg(RSConfirmDeleteEvent + LineEnding2 + RSPermanent, mtConfirmation, [mbYes, mbNo], 0) = mrYes); if DoIt then begin FActiveEvent.Deleted := true; DataStore.PostEvents; Invalidate; end; end; end; procedure TVpDayView.Invalidate; begin inherited; end; function TVpDayView.IsHoliday(ADate: TDate; out AHolidayName: String): Boolean; begin AHolidayName := ''; if Assigned(FOnHoliday) then FOnHoliday(Self, ADate, AHolidayName); Result := AHolidayName <> ''; end; procedure TVpDayView.LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType; const Value: Variant); begin dvInLinkHandler := true; try case NotificationType of neDateChange : Date := Value; neDataStoreChange : Invalidate; neInvalidate : Invalidate; end; finally dvInLinkHandler := false; end; end; procedure TVpDayView.dvHookUp; var I: Integer; begin { If the component is being dropped on a form at designtime, then } { automatically hook up to the first datastore component found } if csDesigning in ComponentState then for I := 0 to pred(Owner.ComponentCount) do begin if (Owner.Components[I] is TVpCustomDataStore) then begin DataStore := TVpCustomDataStore(Owner.Components[I]); Exit; end; end; end; { Hint support } procedure TVpDayView.ShowHintWindow(APoint: TPoint; AEvent: TVpEvent); var txt: String; begin HideHintWindow; case FHintMode of hmPlannerHint: begin if (AEvent = nil) or (Datastore = nil) or (Datastore.Resource = nil) then exit; txt := BuildEventString(AEvent, true); end; hmComponentHint: txt := FComponentHint; end; if (txt <> '') and not (csDesigning in ComponentState) and not ((dvInplaceEditor <> nil) and dvInplaceEditor.Visible) then begin Hint := txt; Application.Hint := Hint; Application.ActivateHint(ClientToScreen(APoint), true); end; end; procedure TVpDayView.HideHintWindow; begin Application.CancelHint; end; { Popup menu } function TVpDayView.GetPopupMenu: TPopupMenu; begin if FExternalPopup = nil then Result := FDefaultPopup else Result := FExternalPopup; end; procedure TVpDayView.SetPopupMenu(AValue: TPopupMenu); begin if (AValue = nil) or (AValue = FDefaultPopup) then FExternalPopup := nil else FExternalPopup := AValue; end; procedure TVpDayView.InitializeDefaultPopup; var NewItem: TVpMenuItem; NewSubItem: TVpMenuItem; canEdit: Boolean; begin canEdit := (FActiveEvent <> nil) and FActiveEvent.CanEdit; FDefaultPopup.Items.Clear; if RSPopupAddEvent <> '' then begin // Add NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikAddEvent; NewItem.OnClick := PopupAddEvent; NewItem.Tag := 0; FDefaultPopup.Items.Add(NewItem); end; if RSPopupEditEvent <> '' then begin // Edit NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikEditEvent; NewItem.Enabled := canEdit; NewItem.OnClick := PopupEditEvent; NewItem.Tag := 1; FDefaultPopup.Items.Add(NewItem); end; if RSPopupDeleteEvent <> '' then begin // Delete NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikDeleteEvent; NewItem.Enabled := canEdit; NewItem.OnClick := PopupDeleteEvent; NewItem.Tag := 1; FDefaultPopup.Items.Add(NewItem); end; NewItem := TVpMenuItem.Create(Self); // ---- NewItem.Kind := mikSeparator; FDefaultPopup.Items.Add(NewItem); if RSPopupImportFromICal <> '' then begin NewItem := TVpMenuItem.Create(Self); // Import from iCal NewItem.Kind := mikImportEventFromICal; NewItem.OnClick := PopupImportICalFile; NewItem.Tag := 0; FDefaultPopup.Items.Add(NewItem); end; if RSPopupExportToICal <> '' then begin // Export ical NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikExportEventToICal; NewItem.OnClick := PopupExportICalFile; NewItem.Tag := 1; FDefaultPopup.Items.Add(NewItem); end; NewItem := TVpMenuItem.Create(Self); // ---- NewItem.Kind := mikSeparator; FDefaultPopup.Items.Add(NewItem); if RSPopupChangeDate <> '' then begin // Change date NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikChangeDate; NewItem.Tag := 0; FDefaultPopup.Items.Add(NewItem); if RSToday <> '' then begin // Today NewSubItem := TVpMenuItem.Create(Self); NewSubItem.Kind := mikToday; NewSubItem.OnClick := PopupToday; NewSubItem.Tag := 0; NewItem.Add(NewSubItem); end; NewSubItem := TVpMenuItem.Create(Self); // --- NewSubItem.Kind := mikSeparator; NewItem.Add(NewSubItem); if RSYesterday <> '' then begin // Yesterday NewSubItem := TVpMenuItem.Create(Self); NewSubItem.Kind := mikYesterday; NewSubItem.OnClick := PopupYesterday; NewSubItem.Tag := 0; NewItem.Add(NewSubItem); end; if RSTomorrow <> '' then begin // Tomorrow NewSubItem := TVpMenuItem.Create(Self); NewSubItem.Kind := mikTomorrow; NewSubItem.OnClick := PopupTomorrow; NewSubItem.Tag := 0; NewItem.Add(NewSubItem); end; NewSubItem := TVpMenuItem.Create(Self); // -- NewSubItem.Kind := mikSeparator; NewItem.Add(NewSubItem); if RSNextDay <> '' then begin // Next day NewSubItem := TVpMenuItem.Create(Self); NewSubItem.Kind := mikNextDay; NewSubItem.OnClick := PopupNextDay; NewSubItem.Tag := 0; NewItem.Add(NewSubItem); end; if RSPrevDay <> '' then begin // Prev day NewSubItem := TVpMenuItem.Create(Self); NewSubItem.Kind := mikPrevDay; NewSubItem.OnClick := PopupPrevDay; NewSubItem.Tag := 0; NewItem.Add(NewSubItem); end; NewSubItem := TVpMenuItem.Create(Self); // --- NewSubItem.Kind := mikSeparator; NewItem.Add(NewSubItem); if RSNextWeek <> '' then begin // Next week NewSubItem := TVpMenuItem.Create(Self); NewSubItem.Kind := mikNextWeek; NewSubItem.OnClick := PopupNextWeek; NewSubItem.Tag := 0; NewItem.Add(NewSubItem); end; if RSPrevWeek <> '' then begin // Prev week NewSubItem := TVpMenuItem.Create(Self); NewSubItem.Kind := mikPrevWeek; NewSubItem.OnClick := PopupPrevWeek; NewSubItem.Tag := 0; NewItem.Add(NewSubItem); end; NewSubItem := TVpMenuItem.Create(Self); // --- NewSubItem.Kind := mikSeparator; NewItem.Add(NewSubItem); if RSNextMonth <> '' then begin // Next month NewSubItem := TVpMenuItem.Create(Self); NewSubItem.Kind := mikNextMonth; NewSubItem.OnClick := PopupNextMonth; NewSubItem.Tag := 0; NewItem.Add(NewSubItem); end; if RSPrevMonth <> '' then begin // Prev Month NewSubItem := TVpMenuItem.Create(Self); NewSubItem.Kind := mikPrevMonth; NewSubItem.OnClick := PopupPrevMonth; NewSubItem.Tag := 0; NewItem.Add(NewSubItem); end; NewSubItem := TVpMenuItem.Create(Self); // --- NewSubItem.Kind := mikSeparator; NewItem.Add(NewSubItem); if RSNextYear <> '' then begin // Next year NewSubItem := TVpMenuItem.Create(Self); NewSubItem.Kind := mikNextYear; NewSubItem.OnClick := PopupNextYear; NewSubItem.Tag := 0; NewItem.Add(NewSubItem); end; if RSPrevYear <> '' then begin // Prev year NewSubItem := TVpMenuItem.Create(Self); NewSubItem.Kind := mikPrevYear; NewSubItem.OnClick := PopupPrevYear; NewSubItem.Tag := 0; NewItem.Add(NewSubItem); end; NewSubItem := TVpMenuItem.Create(Self); // --- NewSubItem.Kind := mikSeparator; NewItem.Add(NewSubItem); if RSCustomDate <> '' then begin // Custom date NewSubItem := TVpMenuItem.Create(Self); NewSubItem.Kind := mikCustomDate; NewSubItem.OnClick := PopupCustomDate; NewSubItem.Tag := 0; NewItem.Add(NewSubItem); end; end; if (Datastore <> nil) and (Datastore.Resource <> nil) then AddResourceGroupMenu(FDefaultPopup.Items, Datastore.Resource, PopupPickResourceGroupEvent); end; procedure TVpDayView.PopupAddEvent(Sender: TObject); var StartTime: TDateTime; EndTime: TDateTime; begin if ReadOnly or (not CheckCreateResource) or (not Assigned(DataStore)) or (not Assigned(DataStore.Resource)) then Exit; StartTime := trunc(FDisplayDate + ActiveCol) + dvLineMatrix[ActiveCol, ActiveRow].Time; EndTime := StartTime + dvTimeIncSize * FRowLinesStep; FActiveEvent := DataStore.Resource.Schedule.AddEvent( DataStore.GetNextID(EventsTableName), StartTime, EndTime ); Repaint; { edit this new event } dvSpawnEventEditDialog(True); end; procedure TVpDayView.PopupExportICalFile(Sender: TObject); var dlg: TSaveDialog; begin if (not Assigned(Datastore)) or (not Assigned(Datastore.Resource)) or (FActiveEvent = 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, [FActiveEvent]); finally dlg.Free; end; end; procedure TVpDayView.PopupImportICalFile(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 TVpDayView.PopupDeleteEvent(Sender: TObject); begin if ReadOnly then Exit; Repaint; if FActiveEvent <> nil then DeleteActiveEvent (True); end; procedure TVpDayView.PopupEditEvent(Sender: TObject); begin if ReadOnly then Exit; Repaint; if FActiveEvent <> nil then { edit this Event } dvSpawnEventEditDialog(False); end; procedure TVpDayView.PopupToday(Sender: TObject); begin Date := Now; end; procedure TVpDayView.PopupTomorrow(Sender: TObject); begin Date := Now + 1; end; procedure TVpDayView.PopupYesterday(Sender: TObject); begin Date := Now - 1; end; procedure TVpDayView.PopupNextDay(Sender: TObject); begin Date := Date + 1; end; procedure TVpDayView.PopupPrevDay(Sender: TObject); begin Date := Date - 1; end; procedure TVpDayView.PopupNextWeek(Sender: TObject); begin Date := Date + 7; end; procedure TVpDayView.PopupPrevWeek(Sender: TObject); begin Date := Date - 7; end; procedure TVpDayView.PopupNextMonth(Sender: TObject); begin Date := IncMonth(Date, +1); end; procedure TVpDayView.PopupPrevMonth(Sender: TObject); begin Date := IncMonth(Date, -1); end; procedure TVpDayView.PopupNextYear(Sender: TObject); begin Date := IncYear(Date); end; procedure TVpDayView.PopupPrevYear(Sender: TObject); begin Date := IncYear(Date, -1); end; procedure TVpDayView.PopupCustomDate(Sender: TObject); var d: TDate; begin d := Date; if DateDialog(RSSelectCustomDate, d) then Date := d; end; procedure TVpDayView.PopupPickResourceGroupEvent(Sender: TObject); begin Datastore.Resource.Group := TVpResourceGroup(TMenuItem(Sender).Tag); Datastore.UpdateGroupEvents; end; procedure TVpDayView.Loaded; begin inherited; TopHour := DefaultTopHour; dvLoaded := true; dvPopulate; end; procedure TVpDayView.Paint; begin RenderToCanvas(Canvas, Rect(0, 0, Width, Height), ra0, 1, FDisplayDate, TopLine, -1, FGranularity, False); SetVScrollPos; end; procedure TVpDayView.dvPopulate; begin if DataStore <> nil then DataStore.Date := FDisplayDate; end; procedure TVpDayView.dvNavButtonsClick(Sender: TObject); begin { set the value of Date based on which button was pressed. } if Sender = dvDayUpBtn then Date := Date + 1 else if Sender = dvDayDownBtn then Date := Date - 1 else if Sender = dvTodayBtn then Date := trunc(Now) else if Sender = dvWeekUpBtn then Date := Date + 7 else if Sender = dvWeekDownBtn then Date := Date - 7; end; function TVpDayView.dvCalcVisibleLines(RenderHeight, ColHeadHeight, ARowHeight: Integer; Scale: Extended; StartLine, StopLine: Integer): Integer; var vertical: integer; d: Integer = 0; // d = result of "div" m: Integer = 0; // m = result of "mod" begin if StartLine < 0 then StartLine := TopLine; { take into account the number lines that are allowed! } // vertical := Round(RenderHeight - ColHeadHeight * Scale - 2); vertical := Round(RenderHeight - ColHeadHeight * Scale); DivMod(Vertical, ARowHeight, d, m); Result := d + ord(m <> 0); { if Vertical mod ARowHeight = 0 then Result := Result := Vertical div ARowHeight + 1; // - 4; //+2; } if Result > FLineCount then Result := FLineCount; if (StopLine > 0) and (StopLine > StartLine) and (Result > Stopline-StartLine) then Result := StopLine - StartLine + 1; { if (StopLine > 0) and (StopLine > StartLine) then if Result > StopLine - StartLine then Result := StopLine - StartLine + 2; } FVisibleLines := Result; end; procedure TVpDayView.SetColor(Value: TColor); begin if FColor <> Value then begin FColor := Value; Invalidate; end; end; function TVpDayView.dvCalcColHeadHeight(Scale: Extended): Integer; var TextHeight: Integer; glyphHeights: Integer; begin Canvas.Font.Assign(FHeadAttr.Font); Canvas.Font.Size := ScaleY(Canvas.Font.Size, DesignTimeDPI); if FShowResourceName and (DataStore <> nil) and (DataStore.Resource <> nil) then TextHeight := Canvas.TextHeight(TallShortChars) * 2 + TextMargin * 3 else TextHeight := Canvas.TextHeight(TallShortChars) + TextMargin * 2; Result := Round(TextHeight * Scale); if Assigned(dvTodayBtn.Glyph) then begin glyphHeights := dvDayUpBtn.Glyph.Height + dvTodayBtn.Glyph.Height + 6; if Result < glyphHeights then Result := glyphHeights; end; dvColHeadHeight := Result; end; procedure TVpDayView.DoStartDrag(var DragObject: TDragObject); {$IFDEF LCL} var P, HotSpot: TPoint; EventName: string; {$ENDIF} begin DvDragStartTime := 0.0; if ReadOnly or not FAllowDragAndDrop then Exit; if FActiveEvent <> nil then begin // Set the time from which this event was dragged DvDragStartTime := trunc(Date + ActiveCol) + dvLineMatrix[ActiveCol, ActiveRow].Time; {$IFDEF LCL} EventName := FActiveEvent.Description; GetCursorPos(P{%H-}); P := TVpDayView(Self).ScreenToClient(P); HotSpot := Point(P.X - Self.dvActiveEventRec.Left, P.Y - Self.dvActiveEventRec.Top); DragObject := TVpEventDragObject.CreateWithDragImages(Self as TControl, HotSpot, Self.dvActiveEventRec, EventName, FDragDropTransparent); {$ELSE} DragObject := DragObject := TVpEventDragObject.Create(Self); {$ENDIF} TVpEventDragObject(DragObject).Event := FActiveEvent; end else {$IFDEF LCL} CancelDrag; {$ELSE} DragObject.Free;//EndDrag(false); {$ENDIF} end; procedure TVpDayView.DoEndDrag(Target: TObject; X, Y: Integer); begin Unused(Target, X, Y); if ReadOnly or (not FAllowDragAndDrop) then Exit; {$IFNDEF LCL} TVpEventDragObject(Target).Free; {$ENDIF} // not needed for LCL: we use DragObjectEx !! end; procedure TVpDayView.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Unused(Source, State); if ReadOnly or (not FAllowDragAndDrop) then begin Accept := False; Exit; end; if (X > dvRowHeadWidth + GutterWidth) and (Y > dvColHeadHeight) then begin { The mouse is dragging over the client area } dvSetActiveColByCoord(Point(X, Y)); dvSetActiveRowByCoord(Point(X, Y), False); Accept := true; end else Accept := false; end; procedure TVpDayView.DragDrop(Source: TObject; X, Y: Integer); var Event: TVpEvent; Duration: TDateTime; DragToTime: TDateTime; i: Integer; begin Unused(X, Y); if ReadOnly or (not FAllowDragAndDrop) then Exit; Event := TVpEventDragObject(Source).Event; if Event <> nil then begin Duration := Event.EndTime - Event.StartTime; DragToTime := trunc(Date + ActiveCol) + dvLineMatrix[ActiveCol, ActiveRow].Time; if Ord(Event.RepeatCode) = 0 then { if this is not a recurring event then just drop it here } Event.StartTime := DragToTime else { if this is a recurring event, then modify the event's start time according to how far the event was dragged } Event.StartTime := Event.StartTime + (DragToTime - DvDragStartTime); Event.EndTime := Event.StartTime + Duration; DataStore.PostEvents; { Force a repaint. This will update the rectangles for the event } Repaint; { Reset the active event rectangle } for I := 0 to pred(Length(dvEventArray)) do begin if dvEventArray[I].Event = nil then Break; if dvEventArray[i].Event = Event then begin dvActiveEventRec := dvEventArray[I].Rec; dvActiveIconRec := dvEventArray[I].IconRect; Break; end; end; end; end; function TVpDayView.dvCalcRowHeight(Scale: Extended; UseGran: TVpGranularity): Integer; var SaveFont: TFont; Temp: Integer; begin { Calculates row height based on the largest of the RowHead's Minute } { font, the standard client font, and a sample character string. } SaveFont := Canvas.Font; Canvas.Font.Assign(FRowHeadAttr.FMinuteFont); Canvas.Font.Size := ScaleY(Canvas.Font.Size, DesignTimeDPI); Canvas.Font.Height := GetRealFontHeight(Canvas.Font); Result := Canvas.TextHeight(TallShortChars); Canvas.Font.Assign(SaveFont); Temp := Canvas.TextHeight(TallShortChars); if Temp > Result then Result := Temp; if FCustomRowHeight = 0 then Result := Result + TextMargin * 2 else Result := FCustomRowHeight; Result := Round(Result * Scale); dvClientVArea := Result * MinutesInDay div GranularityMinutes[UseGran]; dvRowHeight := Result; end; function TVpDayView.GetLastVisibleDate: TDateTime; begin Result := Date + GetRealNumDays(Date); end; function TVpDayView.GetRealNumDays(WorkDate: TDateTime) : Integer; var i: Integer; begin if not FIncludeWeekends then begin Result := 0; i := 0; while i < FNumDays do begin if (DayOfWeek(WorkDate) <> 1) and (DayOfWeek(WorkDate) <> 7) then Inc(i); WorkDate := WorkDate + 1; Inc(Result); end; end else Result := FNumDays; end; procedure TVpDayView.SetDrawingStyle(Value: TVpDrawingStyle); begin if FDrawingStyle <> Value then begin FDrawingStyle := Value; Repaint; end; end; procedure TVpDayView.SetLineColor(Value: TColor); begin if FLineColor <> Value then begin FLineColor := Value; Repaint; end; end; procedure TVpDayView.SetTopHour(Value: TVpHours); begin if FTopHour <> Value then begin FTopHour := Value; TopLine := HourToLine(FTopHour, FGranularity); end; end; procedure TVpDayView.SetTopLine(Value: Integer); begin if Value <> FTopLine then begin if Value + VisibleLines >= pred(LineCount) then begin // FTopLine := pred(LineCount) - VisibleLines + 2; // why +2? FTopLine := pred(LineCount) - VisibleLines; if FTopLine < 0 then FTopLine := 0; { prevent the control from hanging at the bottom } if (Value < FTopLine) and (Value > 0) then FTopLine := Value; end else if Value < 0 then FTopLine := 0 else FTopLine := Value; Invalidate; SetVScrollPos; end; end; function TVpDayView.IsStoredDateLabelFormat: Boolean; begin Result := FDateLabeLFormat <> 'dddddd'; end; procedure TVpDayView.SetDateLabelFormat(Value: string); begin if Value <> FDateLabelFormat then begin FDateLabelFormat := Value; Invalidate; end; end; procedure TVpDayView.SetGutterWidth(Value: Integer); begin if (Value <> FGutterWidth) and (Value > -1) and (Value < Width div 10) then begin FGutterWidth := Value; Invalidate; end; end; procedure TVpDayView.SetDefTopHour(Value: TVpHours); begin if Value <> FDefTopHour then begin FDefTopHour := Value; if csDesigning in ComponentState then TopHour := Value; end; end; procedure TVpDayView.SetTimeIntervals(UseGran: TVpGranularity); var I, J: Integer; grPerHour: Integer; begin FLineCount := MinutesInDay div GranularityMinutes[UseGran]; dvTimeIncSize := GranularityMinutes[UseGran] / MinutesInDay; grPerHour := 60 div GranularityMinutes[UseGran]; SetLength(dvLineMatrix, NumDays); for I := 0 to pred(NumDays) do begin SetLength(dvLineMatrix[I], LineCount + 1); // was +1. Why? Without it, the IDE crashes! - there is an upper loop index of LineCount in DrawCells. After correcting that, the crash is gone. // wp: the additional line is needed to fully display the last line of the day. for J := 0 to pred(LineCount) do begin dvLineMatrix[I,J].Hour := TVpHours(J div grPerHour); dvLineMatrix[I,J].Minute := (J mod grPerHour) * GranularityMinutes[UseGran]; dvLineMatrix[I,J].Time := ord(dvLineMatrix[I,J].Hour) / 24 + dvTimeIncSize * (J mod grPerHour); end; end; if FLineCount <= FVisibleLines then FTopLine := HourToLine(h_00, FGranularity); SetVScrollPos; end; procedure TVpDayView.SetGranularity(Value: TVpGranularity); begin FGranularity := Value; SetTimeIntervals(FGranularity); FTopLine := HourToLine(FTopHour, FGranularity); if dvRowHeight <> 0 then dvCalcVisibleLines(Height, dvColHeadHeight, dvRowHeight, 1, FTopLine, -1); if (FGranularity = gr60Min) and (FVisibleLines = LineCount) then FTopLine := 0; Invalidate; end; procedure TVpDayView.SetTimeFormat(Value: TVpTimeFormat); begin if Value <> FTimeFormat then begin FTimeFormat := Value; Invalidate; end; end; procedure TVpDayView.SetDisplayDate(Value: TDateTime); begin if (not FFixedDate) and (FDisplayDate <> Value) then begin EndEdit(self); FDisplayDate := Value; if dvLoaded then dvPopulate; Invalidate; if (not dvInLinkHandler) and (ControlLink <> nil) then ControlLink.Notify(self, neDateChange, Date); end; end; {$IFNDEF LCL} procedure TVpDayView.WMSize(var Msg: TWMSize); {$ELSE} procedure TVpDayView.WMSize(var Msg: TLMSize); {$ENDIF} var MaxLinesToDraw: Integer; EmptyLines: Integer; begin inherited; { How many lines are there between TopLine and the last line of the day. } MaxLinesToDraw := Length(dvLineMatrix[0]) - TopLine; EmptyLines := FVisibleLines - MaxLinesToDraw; if EmptyLines > 0 then TopLine := TopLine - EmptyLines else Invalidate; end; procedure TVpDayView.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do begin Style := Style or WS_TABSTOP; if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL; if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL; {$IFNDEF LCL} WindowClass.style := CS_DBLCLKS; {$ENDIF} end; end; procedure TVpDayView.CreateWnd; begin inherited; PostMessage(Handle, Vp_DayViewInit, 0, 0); end; procedure TVpDayView.MouseEnter; begin FMouseEvent := nil; end; procedure TVpDayView.MouseLeave; begin HideHintWindow; end; procedure TVpDayView.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseUp(Button, Shift, X, Y); if Button = mbLeft then begin dvMouseDownPoint := Point(0, 0); dvMouseDown := false; dvDragging := false; end else begin end; end; procedure TVpDayView.MouseMove(Shift: TShiftState; X, Y: Integer); var event: TVpEvent; begin inherited MouseMove(Shift, X, Y); if (FActiveEvent <> nil) and (not ReadOnly) then begin if (not dvDragging) and dvMouseDown and ((dvMouseDownPoint.x <> x) or (dvMouseDownPoint.y <> y)) and FActiveEvent.CanEdit then begin dvDragging := true; dvClickTimer.Enabled := false; BeginDrag(true); end; end; if ShowHint then begin event := GetEventAtCoord(Point(X, Y)); if event = nil then HideHintWindow else if FMouseEvent <> event then begin // HideHintWindow; ShowHintWindow(Point(X, Y), event); FMouseEvent := event; end; end; end; procedure TVpDayView.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i: Integer; begin inherited MouseDown(Button, Shift, X, Y); if Button = mbLeft then begin dvMouseDownPoint := Point(x, y); dvMouseDown := true; { if the mouse was pressed down in the client area, then select the cell. } if not focused then SetFocus; if (x > dvRowHeadWidth - 9) and (y > dvColHeadHeight) then begin { The mouse click landed inside the client area } dvSetActiveColByCoord(Point(x, y)); dvSetActiveRowByCoord(Point(x, y), True); if not ReadOnly then EditEventAtCoord(Point(x, y)); end else if y > dvColHeadHeight then dvSetActiveRowByCoord(Point (x, y), True); if Assigned(OnClick) then OnClick(self); end else begin if not Focused then SetFocus; if (x > dvRowHeadWidth - 9) and (y > dvColHeadHeight) then begin { The mouse click landed inside the client area } dvSetActiveColByCoord(Point(x, y)); dvSetActiveRowByCoord(Point(x, y), True); end; EditEventAtCoord(Point (x, y)); dvClickTimer.Enabled := false; if not Assigned(FActiveEvent) then for i := 0 to FDefaultPopup.Items.Count - 1 do begin if (FDefaultPopup.Items[i].Tag = 1) or (ReadOnly) then FDefaultPopup.Items[i].Enabled := False; end else for i := 0 to FDefaultPopup.Items.Count - 1 do FDefaultPopup.Items[i].Enabled := True; end; end; {$IFNDEF LCL} procedure TVpDayView.WMLButtonDblClk(var Msg: TWMLButtonDblClk); {$ELSE} procedure TVpDayView.WMLButtonDblClk(var Msg: TLMLButtonDblClk); {$ENDIF} var StartTime, EndTime: TDateTime; begin inherited; dvClickTimer.Enabled := false; dvMouseDownPoint := Point(0, 0); dvMouseDown := false; dvDragging := false; { if the mouse was pressed down in the client area, then select the cell. } if not focused then SetFocus; if (Msg.XPos > dvRowHeadWidth - 9) and (Msg.YPos > dvColHeadHeight) then begin { The mouse click landed inside the client area } dvSetActiveRowByCoord(Point(Msg.XPos, Msg.YPos), True); { See if we hit an active event } if (FActiveEvent <> nil) and (not ReadOnly) then begin { edit this event } dvSpawnEventEditDialog(False); end else if not ReadOnly then begin if not CheckCreateResource then Exit; if (DataStore = nil) or (DataStore.Resource = nil) then Exit; { otherwise, we must want to create a new event } StartTime := trunc(FDisplayDate + ActiveCol) + dvLineMatrix[ActiveCol, ActiveRow].Time; EndTime := StartTime + dvTimeIncSize * FRowLinesStep; FActiveEvent := DataStore.Resource.Schedule.AddEvent( DataStore.GetNextID(EventsTableName), StartTime, EndTime); { edit this new event } dvSpawnEventEditDialog(True); end; end; end; {$IFDEF LCL} function TVpDayView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; begin Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos); end; function TVpDayView.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; var delta: Integer; begin Result := inherited DoMouseWheelDown(Shift, MousePos); if not Result then begin if [ssCtrl, ssShift] * Shift <> [] then begin delta := HourToLine(h_01, FGranularity); if delta = 1 then delta := 3; end else delta := 1; dvScrollVertical(delta); Result := True; end; end; function TVpDayView.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; var delta: Integer; begin Result := inherited DoMouseWheelUp(Shift, MousePos); if not Result then begin if [ssCtrl, ssShift] * Shift <> [] then begin delta := HourToLine(h_01, FGranularity); if delta = 1 then delta := 3; end else delta := 1; dvScrollVertical(-delta); Result := True; end; end; {$ENDIF} procedure TVpDayView.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = FExternalPopup) then FExternalPopup := nil; end; procedure TVpDayView.EditSelectedEvent(IsNewEvent: Boolean = false); begin if ReadOnly then Exit; if FActiveEvent <> nil then dvSpawnEventEditDialog(IsNewEvent); end; procedure TVpDayView.dvSpawnEventEditDialog(IsNewEvent: Boolean); var AllowIt: Boolean; EventDlg : TVpEventEditDialog; begin if (DataStore = nil) or (DataStore.Resource = nil) or ReadOnly then Exit; if (not IsNewEvent) and (not FActiveEvent.CanEdit) then begin MessageDlg(RSCannotEditOverlayedEvent, mtInformation, [mbOK], 0); exit; end; AllowIt := false; if Assigned(FOwnerEditEvent) then FOwnerEditEvent(self, FActiveEvent, IsNewEvent, DataStore.Resource, AllowIt) else begin EventDlg := TVpEventEditDialog.Create(nil); try EventDlg.DataStore := DataStore; AllowIt := EventDlg.Execute(FActiveEvent); finally EventDlg.Free; end; end; if AllowIt then begin FActiveEvent.Changed := true; DataStore.PostEvents; if IsNewEvent and Assigned(FOnAddEvent) then FOnAddEvent(self, FActiveEvent); if not IsNewEvent and Assigned(FOnModifyEvent) then FOnModifyEvent(self, FActiveEvent); end else begin if IsNewEvent then begin FActiveEvent.Deleted := true; DataStore.PostEvents; FActiveEvent := nil; dvActiveEventRec := Rect(0, 0, 0, 0); dvActiveIconRec := Rect(0, 0, 0, 0); end; end; Invalidate; end; {$IFNDEF LCL} procedure TVpDayView.WMSetFocus(var Msg: TWMSetFocus); {$ELSE} procedure TVpDayView.WMSetFocus(var Msg: TLMSetFocus); {$ENDIF} begin Unused(Msg); if ActiveRow = -1 then ActiveRow := TopLine; end; {$IFNDEF LCL} procedure TVpDayView.WMEraseBackground(var Msg: TWMERASEBKGND); {$ELSE} procedure TVpDayView.WMEraseBackground(var Msg: TLMERASEBKGND); {$ENDIF} begin Msg.Result := 1; end; {$IFNDEF LCL} procedure TVpDayView.CMWantSpecialKey(var Msg: TCMWantSpecialKey); begin inherited; Msg.Result := 1; end; {$ENDIF} procedure TVpDayView.SetActiveEventByCoord(APoint: TPoint); var I : Integer; begin for I := 0 to pred(Length(dvEventArray)) do begin if dvEventArray[I].Event = nil then Exit; if PointInRect(APoint, dvEventArray[I].Rec) then begin FActiveEvent := TVpEvent(dvEventArray[I].Event); dvActiveEventRec := dvEventArray[I].Rec; dvActiveIconRec := dvEventArray[I].IconRect; Exit; end; end; end; function TVpDayView.EditEventAtCoord(APoint: TPoint): Boolean; var I: Integer; begin result := false; if ReadOnly then Exit; for I := 0 to pred(Length(dvEventArray)) do begin FActiveEvent := nil; // wp: shouldn't these be set also if ReadOnly is true? dvActiveEventRec := Rect(0, 0, 0, 0); dvActiveIconRec := Rect(0, 0, 0, 0); if dvEventArray[I].Event = nil then { we've hit the end of visible events without finding a match } Exit; if PointInRect(APoint, dvEventArray[I].Rec) then begin FActiveEvent := TVpEvent(dvEventArray[I].Event); dvActiveEventRec := dvEventArray[I].Rec; dvActiveIconRec := dvEventArray[I].IconRect; dvClickTimer.Enabled := true; result := true; Break; end; end; end; function TVpDayView.GetEventAtCoord(APoint: TPoint): TVpEvent; var I: Integer; begin Result := nil; for I := 0 to pred(Length(dvEventArray)) do begin if dvEventArray[I].Event = nil then Exit; if PointInRect(APoint, dvEventArray[I].Rec) then begin Result := TVpEvent(dvEventArray[I].Event); Exit; end; end; end; function TVpDayView.GetEventRect(AEvent: TVpEvent): TRect; var i: Integer; begin for i:=0 to High(dvEventArray) do if dvEventArray[i].Event = AEvent then begin Result := dvEventArray[i].Rec; exit; end; end; procedure TVpDayView.dvEditInPlace(Sender: TObject); begin { this is the timer event which spawns an in-place editor } { if the event is doublecliked before this timer fires, then the } { event is edited in a dialog based editor. } dvClickTimer.Enabled := false; EditEvent; end; procedure TVpDayView.EditEvent; var AllowIt: Boolean; begin if ReadOnly then Exit; if not FAllowInplaceEdit then Exit; if (FActiveEvent <> nil) and (not FActiveEvent.CanEdit) then Exit; { call the user defined BeforeEdit event } AllowIt := true; if Assigned(FBeforeEdit) then FBeforeEdit(Self, FActiveEvent, AllowIt); if not AllowIt then exit; { create and spawn the in-place editor } if dvInPlaceEditor = nil then begin dvInPlaceEditor := TVpDvInPlaceEdit.Create(Self); dvInPlaceEditor.Parent := self; dvInPlaceEditor.OnExit := EndEdit; end; if FActiveEvent.AllDayEvent then dvInplaceEditor.SetBounds( dvActiveEventRec.Left + 2 * (TextMargin div 2), // this way it is calculated in DrawAllDayEvents dvActiveEventRec.Top + 2 * (TextMargin div 2), WidthOf(dvActiveEventRec) - TextMargin div 2, HeightOf(dvActiveEventRec) ) else dvInPlaceEditor.SetBounds( dvActiveIconRec.Right + TextMargin, dvActiveEventRec.Top + TextMargin, dvActiveEventRec.Right - dvActiveIconRec.Right - TextMargin, dvActiveEventRec.Bottom - dvActiveEventRec.Top - TextMargin ); dvInPlaceEditor.Show; dvInPlaceEditor.Text := FActiveEvent.Description; Invalidate; dvInPlaceEditor.SetFocus; end; procedure TVpDayView.EndEdit(Sender: TObject); begin if dvEndingEditing then Exit; dvEndingEditing := True; try if (dvInPlaceEditor <> nil) and dvInplaceEditor.Visible then begin if dvInPlaceEditor.Text <> FActiveEvent.Description then begin FActiveEvent.Description := dvInPlaceEditor.Text; FActiveEvent.Changed := true; DataStore.PostEvents; if Assigned(FAfterEdit) then FAfterEdit(self, FActiveEvent); end; dvInplaceEditor.Hide; Invalidate; end; finally dvEndingEditing := False; end; end; procedure TVpDayview.ExportICalFile(const AFileName: String; const AEvents: TVpEventArr); begin if Assigned(Datastore) and Assigned(Datastore.Resource) then Datastore.Resource.Schedule.ExportICalFile(AFileName, AEvents); end; { Reads the events listed in the specified ical file and adds them to the day view control. All events imported are collected in the Result array. ADefaultCategory is the category to which the event is assigned if no fitting category has been found in the ical, i.e. when the event's category is 0. If you are not happy with this category replacement you can iterate over the Result array and change it. } function TVpDayView.ImportICalFile(const AFileName: String; APreview: Boolean = false; ADefaultCategory: Integer = -1): TVpEventArr; begin if ReadOnly or (not CheckCreateResource) or (not Assigned(DataStore)) or (not Assigned(DataStore.Resource)) then Exit(nil); Result := Datastore.Resource.Schedule.ImportICalFile(AFileName, APreview, ADefaultCategory); if Length(Result) > 0 then begin FActiveEvent := Result[High(Result)]; Datastore.PostEvents; Datastore.NotifyDependents; Invalidate; end; end; procedure TVpDayView.KeyDown(var Key: Word; Shift: TShiftState); var PopupPoint : TPoint; begin case Key of VK_UP: ActiveRow := ActiveRow - 1; VK_DOWN: ActiveRow := ActiveRow + 1; VK_NEXT: ActiveRow := ActiveRow + FVisibleLines; VK_PRIOR: ActiveRow := ActiveRow - FVisibleLines; VK_LEFT: Date := Date - 1; VK_RIGHT: Date := Date + 1; VK_HOME: ActiveRow := 0; VK_END: ActiveRow := LineCount; VK_DELETE: if not ReadOnly then DeleteActiveEvent(true); {$IFNDEF LCL} VK_TAB: if ssShift in Shift then Windows.SetFocus (GetNextDlgTabItem(GetParent(Handle), Handle, False)) else Windows.SetFocus (GetNextDlgTabItem(GetParent(Handle), Handle, True)); {$ENDIF} VK_F10: if (ssShift in Shift) and not (Assigned (PopupMenu)) then begin PopupPoint := GetClientOrigin; FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10); end; VK_APPS : if not Assigned(PopupMenu) then begin PopupPoint := GetClientOrigin; FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10); end; VK_RETURN: PopupEditEvent(Self); VK_INSERT: PopupAddEvent(Self); VK_F2: if Assigned(FActiveEvent) then dvEditInPlace(Self) else begin PopupPoint := dvLineMatrix[ActiveCol, ActiveRow].Rec.TopLeft; PopupPoint.x := PopupPoint.x + 1; PopupPoint.y := PopupPoint.y + 1; SetActiveEventByCoord (PopupPoint); if Assigned(FActiveEvent) then dvEditInPlace(Self); end; end; end; {$IFNDEF LCL} procedure TVpDayView.WMVScroll(var Msg: TWMVScroll); {$ELSE} procedure TVpDayView.WMVScroll(var Msg: TLMVScroll); {$ENDIF} begin { for simplicity, bail out of editing while scrolling. } EndEdit(Self); // wp: Next line should never happen after EndEdit... if (dvInPlaceEditor <> nil) and dvInplaceEditor.Visible then Exit; case Msg.ScrollCode of SB_LINEUP : dvScrollVertical(-1); SB_LINEDOWN : dvScrollVertical(1); SB_PAGEUP : dvScrollVertical(-FVisibleLines); SB_PAGEDOWN : dvScrollVertical(FVisibleLines); SB_THUMBPOSITION, SB_THUMBTRACK : TopLine := Msg.Pos; end; end; procedure TVpDayView.dvScrollVertical(Lines: Integer); begin TopLine := TopLine + Lines; end; procedure TVpDayView.SetVScrollPos; var SI : TScrollInfo; begin if not HandleAllocated then Exit; with SI do begin cbSize := SizeOf(SI); fMask := SIF_RANGE or SIF_PAGE or SIF_POS; nMin := 0; nMax := FLineCount; if FVisibleLines >= FLineCount then nPage := nMax else nPage := FVisibleLines; if FTopLine = pred(LineCount) - VisibleLines then nPos := LineCount else nPos := FTopLine; nTrackPos := nPos; end; SetScrollInfo(Handle, SB_VERT, SI, True); end; procedure TVpDayView.SetCustomRowHeight(Value: Integer); begin if Value <> FCustomRowHeight then begin if (Value <> 0) and (Value < 1) then FCustomRowHeight := 1 else FCustomRowHeight := Value; Invalidate; end; end; procedure TVpDayView.SetRowLinesStep(Value: Integer); begin if Value <> FRowLinesStep then begin if Value < 1 then FRowLinesStep := 1 else FRowLinesStep := Value; Invalidate; end; end; procedure TVpDayView.SetShowNavButtons(Value: Boolean); begin if Value <> FShowNavButtons then begin FShowNavButtons := Value; Invalidate; end; end; procedure TVpDayView.SetShowResourceName(Value: Boolean); begin if Value <> FShowResourceName then begin FShowResourceName := Value; Invalidate; end; end; procedure TVpDayView.SetSimpleRowTime(Value: Boolean); begin if Value <> FSimpleRowTime then begin FSimpleRowTime := Value; Invalidate; end; end; procedure TVpDayView.SetNumDays(Value: Integer); begin if (Value <> FNumDays) and (Value > 0) and (Value < 31) then begin FNumDays := Value; SetLength(dvColRectArray, FNumDays); SetTimeIntervals(Granularity); ActiveCol := 0; Invalidate; end; end; procedure TVpDayView.SetIncludeWeekends(Value : Boolean); begin if Value <> FIncludeWeekends then begin FIncludeWeekends := Value; Invalidate; end; end; procedure TVpDayView.SetActiveRow(Value: Integer); var OldActiveRow: Integer; begin if dvClickTimer.Enabled then dvClickTimer.Enabled := false; if not Focused then SetFocus; OldActiveRow := FActiveRow; { set active row } if (Value < 0) then FActiveRow := 0 else if (Value >= pred(LineCount)) then FActiveRow := pred(LineCount) else FActiveRow := Value; { clamp in view } if (FActiveRow < FTopLine) then TopLine := FActiveRow else if (FActiveRow >= FTopLine + FVisibleLines) then TopLine := FActiveRow - FVisibleLines + 1; if (OldActiveRow <> FActiveRow) then begin Invalidate; end; end; procedure TVpDayView.SetActiveCol(Value: Integer); begin if FActiveCol <> Value then begin if Value < 0 then FActiveCol := 0 else if Value > pred(NumDays) then FActiveCol := pred(NumDays) else FActiveCol := Value; Invalidate; end; end; procedure TVpDayView.SetDotDotDotColor(const v: TColor); begin if v <> FDotDotDotColor then begin FDotDotDotColor := v; Invalidate; end; end; procedure TVpDayView.SetShowEventTimes(Value: Boolean); begin if Value <> FShowEventTimes then begin FShowEventTimes := Value; Invalidate; end end; procedure TVpDayView.SetWrapStyle(const v: TVpDVWrapStyle); begin if v <> FWrapStyle then begin FWrapStyle := v; Invalidate; end; end; procedure TVpDayView.SetHint(const AValue: TTranslateString); begin inherited; if FHintMode = hmComponentHint then FComponentHint := AValue; end; procedure TVpDayView.SetHintMode(const AValue: TVpHintMode); begin if AValue = FHintMode then exit; FHintMode := AValue; if FHintMode = hmPlannerHint then FComponentHint := Hint; end; procedure TVpDayView.dvSetActiveRowByCoord(Pnt: TPoint; Sloppy: Boolean); var I : Integer; begin if dvClickTimer.Enabled then dvClickTimer.Enabled := false; for I := 0 to pred(LineCount) do begin if Sloppy and (Pnt.y <= dvLineMatrix[ActiveCol, I].Rec.Bottom) and (Pnt.y > dvLineMatrix[ActiveCol, I].Rec.Top) then begin ActiveRow := I; Exit; end else if PointInRect(Pnt, dvLineMatrix[ActiveCol, I].Rec) then begin ActiveRow := I; Exit; end; end; end; procedure TVpDayView.dvSetActiveColByCoord(Pnt: TPoint); var I : Integer; begin for I := 0 to pred(length(dvColRectArray)) do begin if PointInRect(Pnt, dvColRectArray[I].Rec) then begin ActiveCol := I; Exit; end; end; end; function TVpDayView.GetControlType : TVpItemType; begin Result := itDayView; end; procedure TVpDayView.AutoScaledPaintToCanvas(PaintCanvas: TCanvas; PaintTo: TRect; Angle: TVpRotationAngle; RenderDate: TDateTime; StartLine, StopLine: Integer; UseGran: TVpGranularity); var SrcResY: Integer; DestResY: Integer; Scale: Extended; begin SrcResY := GetDeviceCaps(Canvas.Handle, LOGPIXELSY); DestResY := GetDeviceCaps(PaintCanvas.Handle, LOGPIXELSY); Scale := DestResY / SrcResY; RenderToCanvas(PaintCanvas, PaintTo, Angle, Scale, RenderDate, StartLine, StopLine, UseGran, True); end; procedure TVpDayView.PaintToCanvas(ACanvas: TCanvas; ARect: TRect; Angle: TVpRotationAngle; ADate: TDateTime; StartHour, EndHour: TVpHours; UseGran: TVpGranularity); begin RenderToCanvas( ACanvas, ARect, Angle, 1, ADate, HourToLine(StartHour, UseGran), HourToLine(EndHour, UseGran), UseGran, True); end; procedure TVpDayView.RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect; Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime; StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); var painter: TVpDayViewPainter; begin dvPainting := true; painter := TVpDayviewPainter.Create(Self, RenderCanvas); try painter.RenderToCanvas(RenderIn, Angle, Scale, RenderDate, StartLine, StopLine, UseGran, DisplayOnly); finally painter.Free; dvPainting := false; end; end; procedure TVpDayView.VpDayViewInit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); begin Unused(Msg); if csLoading in ComponentState then begin PostMessage(Handle, Vp_DayViewInit, 0, 0); Exit; end; dvCalcColHeadHeight(1); dvCalcRowHeight(1, FGranularity); dvCalcVisibleLines(Height, dvColHeadHeight, dvRowHeight, 1, TopLine, -1); SetVScrollPos; end; {$IF VP_LCL_SCALING = 2} procedure TVpDayView.ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); begin inherited; DoScaleFontPPI(AllDayEventAttributes.Font, AToPPI, AProportion); DoScaleFontPPI(HeadAttributes.Font, AToPPI, AProportion); DoScaleFontPPI(RowHeadAttributes.HourFont, AToPPI, AProportion); DoScaleFontPPI(RowHeadAttributes.MinuteFont, AToPPI, AProportion); end; {$ELSEIF VP_LCL_SCALING = 1} procedure TVpDayView.ScaleFontsPPI(const AProportion: Double); begin inherited; DoScaleFontPPI(AllDayEventAttributes.Font, AProportion); DoScaleFontPPI(HeadAttributes.Font, AProportion); DoScaleFontPPI(RowHeadAttributes.HourFont, AProportion); DoScaleFontPPI(RowHeadAttributes.MinuteFont, AProportion); end; {$ENDIF} (*****************************************************************************) { TVpCHAttributes } constructor TVpCHAttributes.Create(AOwner: TVpDayView); begin inherited Create; FOwner := AOwner; FFont := TVpFont.Create(AOwner); end; destructor TVpCHAttributes.Destroy; begin FFont.Free; inherited; end; procedure TVpCHAttributes.SetColor(const Value: TColor); begin if FColor <> Value then begin FColor := Value; FOwner.Invalidate; end; end; procedure TVpCHAttributes.SetFont(Value: TVpFont); begin FFont.Assign(Value); end; (*****************************************************************************) { TVpRHAttributes } constructor TVpRHAttributes.Create(AOwner: TVpDayView); begin inherited Create; FOwner := AOwner; FHourFont := TVpFont.Create(AOwner); FMinuteFont := TVpFont.Create(AOwner); {$IFNDEF LCL} FHourFont.Name := 'Tahoma'; FMinuteFont.Name := 'Tahoma'; {$ENDIF} end; destructor TVpRHAttributes.Destroy; begin FHourFont.Free; FMinuteFont.Free; inherited; end; procedure TVpRHAttributes.SetColor(const Value: TColor); begin if FColor <> Value then begin FColor := Value; FOwner.Invalidate; end; end; procedure TVpRHAttributes.SetHourFont(Value: TVpFont); begin if Value <> FHourFont then begin FHourFont.Assign(Value); FOwner.Invalidate; end; end; procedure TVpRHAttributes.SetMinuteFont(Value: TVpFont); begin if Value <> FMinuteFont then begin FMinuteFont.Assign(Value); FOwner.Invalidate; end; end; end.