{*********************************************************} {* VPWEEKVIEW.PAS 1.03 *} {*********************************************************} {* ***** BEGIN LICENSE BLOCK ***** *} {* Version: MPL 1.1 *} {* *} {* The contents of this file are subject to the Mozilla Public License *} {* Version 1.1 (the "License"); you may not use this file except in *} {* compliance with the License. You may obtain a copy of the License at *} {* http://www.mozilla.org/MPL/ *} {* *} {* Software distributed under the License is distributed on an "AS IS" basis, *} {* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *} {* for the specific language governing rights and limitations under the *} {* License. *} {* *} {* The Original Code is TurboPower Visual PlanIt *} {* *} {* The Initial Developer of the Original Code is TurboPower Software *} {* *} {* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} {* TurboPower Software Inc. All Rights Reserved. *} {* *} {* Contributor(s): *} {* *} {* ***** END LICENSE BLOCK ***** *} { This unit handles the TVpWeekView component as well as it's inline editor and navigation. The rendering of Visual PlanIt components is a bit involved. The component's Paint method calls RenderToCanvas. The RenderToCanvas method of each of the visual VisualPlanIt controls is repsonsible both for drawing to the screen (both design and run time) as well as printing. In the case of printing, the component needs to render itself to an arbitrary rectangle and possibly rotated (for the screen the rectangle is the ClientRect and the rotation angle is always zero). To achieve that goal, the functions in VpCanvasUtils are used to go between the rendering of the control and the TCanvas that it needs to render to. } unit VpWeekView; {$I vp.inc} {$IF FPC_FullVersion >= 30200} {$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} {$IFEND} interface uses {$IFDEF LCL} LMessages, LCLProc, LCLType, LCLIntf, FileUtil, {$ELSE} Windows, Messages, {$ENDIF} Classes, Graphics, Controls, ComCtrls, ExtCtrls, StdCtrls, Buttons, Forms, Menus, VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpDayView; type TVpWeekdayRec = packed record Rec: TRect; Day: TDateTime; end; TVpWeekViewLayout = (wvlVertical, wvlHorizontal); type TVpWeekdayArray = array of TVpWeekdayRec; { Forward Declarations } TVpWeekView = class; TVpWvInPlaceEdit = class(TCustomEdit) protected procedure CreateParams(var Params: TCreateParams); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; public constructor Create(AOwner: TComponent); override; end; TVpWvAttributes = class(TPersistent) private FOwner: TVpWeekView; protected procedure UpdateWeekView; public constructor Create(AOwner: TVpWeekView); virtual; property Owner: TVpWeekView read FOwner; end; TVpWvHeadAttributes = class(TVpWvAttributes) private FColor: TColor; FFont: TVpFont; procedure SetColor(const Value: TColor); procedure SetFont(Value: TVpFont); protected public constructor Create(AOwner: TVpWeekView); override; destructor Destroy; override; published property Font: TVpFont read FFont write SetFont; property Color: TColor read FColor write SetColor default DEFAULT_HEADERCOLOR; end; TVpWvDayHeadAttr = class(TVpWvAttributes) private FFont: TVpFont; FDateFormat: string; FColor: TColor; FAlignment: TAlignment; FBordered: Boolean; function IsStoredDateFormat: Boolean; procedure SetAlignment(Value: TAlignment); procedure SetBordered(Value: Boolean); procedure SetColor(Value: TColor); procedure SetDateFormat(Value: string); procedure SetFont(Value: TVpFont); protected public constructor Create(AOwner: TVpWeekView); override; destructor Destroy; override; published property Alignment: TAlignment read FAlignment write SetAlignment default taRightJustify; property Bordered: Boolean read FBordered write SetBordered default true; property Color: TColor read FColor write SetColor default DEFAULT_HEADERCOLOR; property DateFormat: string read FDateFormat write SetDateFormat stored IsStoredDateFormat; property Font: TVpFont read FFont write SetFont; end; { TVpWeekView } TVpWeekView = class(TVpLinkableControl) private FActiveDate: TDateTime; FActiveEvent: TVpEvent; FAllDayEventAttr: TVpAllDayEventAttributes; FAllowInplaceEdit: Boolean; FAllowDragAndDrop: Boolean; FApplyCategoryInfos: Boolean; FColor: TColor; FComponentHint: TTranslateString; FDateLabelFormat: string; FDayHeadAttributes: TVpWvDayHeadAttr; FDefaultPopup: TPopupMenu; FDragDropTransparent: Boolean; FDrawingStyle: TVpDrawingStyle; FGutterWidth: Integer; FEventFont: TVpFont; // was: TFont FExternalPopup: TPopupMenu; FHeadAttr: TVpWvHeadAttributes; FHeaderMargin: Integer; FHintMode: TVpHintMode; FLineColor: TColor; FMouseEvent: TVpEvent; FLayout: TVpWeekviewLayout; FShowEventTime: Boolean; FTextMargin: Integer; FTimeFormat: TVpTimeFormat; FVisibleLines: Integer; FWeekStartsOn: TVpDayType; // Internal variables wvClickTimer: TTimer; wvCreatingEditor: Boolean; wvDragging: Boolean; wvHotPoint: TPoint; wvInLinkHandler: Boolean; wvInPlaceEditor: TVpWvInPlaceEdit; wvLoaded: Boolean; wvMouseDown: Boolean; wvMouseDownPoint: TPoint; wvPainting: Boolean; // Event variables FAfterEdit: TVpAfterEditEvent; FBeforeEdit: TVpBeforeEditEvent; FOnAddEvent: TVpOnAddNewEvent; FOnDeletingEvent: TVpOnDeletingEvent; FOnHoliday: TVpHolidayEvent; FOnModifyEvent: TVpOnModifyEvent; FOwnerEditEvent: TVpEditEvent; // Property getter and setter methods function IsStoredDateLabelFormat: Boolean; procedure SetActiveDate(Value: TDateTime); procedure SetActiveEvent(AValue: TVpEvent); procedure SetApplyCategoryInfos(AValue: Boolean); procedure SetColor(Value: TColor); reintroduce; procedure SetDateLabelFormat(Value: string); procedure SetDrawingStyle(Value: TVpDrawingStyle); procedure SetEventFont(Value: TVpFont); procedure SetHeaderMargin(AValue: Integer); procedure SetLayout(AValue: TVpWeekviewLayout); procedure SetLineColor(AValue: TColor); procedure SetPopupMenu(AValue: TPopupMenu); procedure SetShowEventTime(Value: Boolean); procedure SetTextMargin(Value: Integer); procedure SetTimeFormat(Value: TVpTimeFormat); procedure SetWeekStartsOn(Value: TVpDayType); protected // Needed by the drawer FPrevWeekBtn: TSpeedButton; FPrevMonthBtn: TSpeedButton; FNextMonthBtn: TSpeedButton; FNextWeekBtn: TSpeedButton; { internal variables } wvActiveEventRec: TRect; wvEventArray: TVpEventArray; wvHeaderHeight: Integer; wvRowHeight: Integer; wvStartDate: TDateTime; wvWeekdayArray: TVpWeekdayArray; { internal methods } procedure SpinButtonClick(Sender: TObject); procedure wvEditInPlace(Sender: TObject); procedure wvHookUp; procedure wvPopulate; { inherited standard methods } procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; procedure Loaded; override; procedure KeyDown(var Key: Word; Shift: TShiftState); 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; { event related methods } procedure EditEvent; procedure EndEdit(Sender: TObject); function EventAtCoord(Pt: TPoint): Boolean; function GetEventAtCoord(Pt: TPoint): TVpEvent; function GetEventRect(AEvent: TVpEvent): TRect; procedure wvSetDateByCoord(Point: TPoint); procedure wvSpawnEventEditDialog(IsNewEvent: Boolean); { drag and drop } procedure DoEndDrag(Target: TObject; X, Y: Integer); override; procedure DoStartDrag(var DragObject: TDragObject); override; procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override; { Popup } function GetPopupMenu: TPopupMenu; override; procedure InitializeDefaultPopup; procedure PopupAddEvent(Sender: TObject); procedure PopupDeleteEvent(Sender: TObject); procedure PopupEditEvent(Sender: TObject); procedure PopupExportToICalFile(Sender: TObject); procedure PopupImportFromICalFile(Sender: TObject); procedure PopupToday(Sender: TObject); procedure PopupNextWeek(Sender: TObject); procedure PopupPrevWeek(Sender: TObject); procedure PopupNextMonth(Sender: TObject); procedure PopupPrevMonth(Sender: TObject); procedure PopupNextYear(Sender: TObject); procedure PopupPrevYear(Sender: TObject); procedure PopupCustomDate(Sender: TObject); procedure PopupPickResourceGroupEvent(Sender: TObject); { hints } procedure ShowHintWindow(APoint: TPoint; AEvent: TVpEvent); procedure HideHintWindow; procedure SetHint(const AValue: TTranslateString); override; { message handlers } {$IFNDEF LCL} procedure WMSize(var Msg: TWMSize); message WM_SIZE; procedure WMRButtonDown(var Msg : TWMRButtonDown); message WM_RBUTTONDOWN; procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY; {$ELSE} procedure WMSize(var Msg: TLMSize); message LM_SIZE; procedure WMLButtonDblClk(var Msg : TLMLButtonDblClk); message LM_LBUTTONDBLCLK; //TODO: Bug 0020755 braks this in GTK2... {$ENDIF} public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function BuildEventString(AEvent: TVpEvent; AStartTime, AEndTime: TDateTime; UseAsHint: Boolean): String; procedure LoadLanguage; 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 LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType; const Value: Variant); override; function GetControlType: TVpItemType; override; procedure EditSelectedEvent(IsNewEvent: Boolean = false); procedure PaintToCanvas(ACanvas: TCanvas; ARect: TRect; Angle: TVpRotationAngle; ADate: TDateTime); procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect; Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime; StartLine: Integer; StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); override; { 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 ActiveEvent: TVpEvent read FActiveEvent write SetActiveEvent; property Date: TDateTime read FActiveDate write SetActiveDate; property GutterWidth: Integer read FGutterWidth; property VisibleLines: Integer read FVisibleLines; property PrevWeekBtn: TSpeedButton read FPrevWeekBtn; property PrevMonthBtn: TSpeedButton read FPrevMonthBtn; property NextMonthBtn: TSpeedButton read FNextMonthBtn; property NextWeekBtn: TSpeedButton read FNextWeekBtn; published 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 ApplyCategoryInfos: Boolean read FApplyCategoryInfos write SetApplyCategoryInfos default false; property Color: TColor read FColor write SetColor default DEFAULT_COLOR; property DateLabelFormat: string read FDateLabelFormat write SetDateLabelFormat stored IsStoredDateLabelFormat; property DayHeadAttributes: TVpWvDayHeadAttr read FDayHeadAttributes write FDayHeadAttributes; property DragDropTransparent: Boolean read FDragDropTransparent write FDragDropTransparent default false; property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d; property EventFont: TVpFont read FEventFont write SetEventFont; property HeadAttributes: TVpWvHeadAttributes read FHeadAttr write FHeadAttr; property HeaderMargin: Integer read FHeaderMargin write SetHeaderMargin default TEXT_MARGIN; property HintMode: TVpHintMode read FHintMode write FHintMode default hmPlannerHint; property LineColor: TColor read FLineColor write SetLineColor default DEFAULT_LINECOLOR; property Layout: TVpWeekviewLayout read FLayout write SetLayout default wvlVertical; property TextMargin: Integer read FTextMargin write SetTextMargin default 2; property TimeFormat: TVpTimeFormat read FTimeFormat write SetTimeFormat default tf12Hour; property ShowEventTime: Boolean read FShowEventTime write SetShowEventTime default true; property WeekStartsOn: TVpDayType read FWeekStartsOn write SetWeekStartsOn default dtSunday; {inherited properties} property Align; property Anchors; {$IFDEF LCL} property BorderSpacing; {$ENDIF} property PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu; property TabStop default true; property TabOrder; {events} property AfterEdit : TVpAfterEditEvent read FAfterEdit write FAfterEdit; property BeforeEdit: TVpBeforeEditEvent read FBeforeEdit write FBeforeEdit; property OnAddEvent: TVpOnAddNewEvent read FOnAddEvent write FOnAddEvent; property OnDeletingEvent: TVpOnDeletingEvent read FOnDeletingEvent write FOnDeletingEvent; property OnHoliday: TVpHolidayEvent read FOnHoliday write FOnHoliday; property OnModifyEvent: TVpOnModifyEvent read FOnModifyEvent write FOnModifyEvent; property OnOwnerEditEvent: TVpEditEvent read FOwnerEditEvent write FOwnerEditEvent; end; implementation uses {$IFDEF LCL} DateUtils, {$ENDIF} SysUtils, StrUtils, LazUTF8, Dialogs, VpEvntEditDlg, VpWeekViewPainter; (*****************************************************************************) { TVpTGInPlaceEdit } (*****************************************************************************) constructor TVpWvInPlaceEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); TabStop := False; BorderStyle := bsNone; {$IFDEF VERSION4} // DoubleBuffered := False; {$ENDIF} end; procedure TVpWvInPlaceEdit.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); // Params.Style := Params.Style or ES_MULTILINE; end; procedure TVpWvInPlaceEdit.KeyDown(var Key: Word; Shift: TShiftState); var Grid: TVpWeekView; begin Grid := TVpWeekView(Owner); case Key of VK_RETURN: begin Key := 0; Grid.EndEdit(Self); end; VK_UP: begin Key := 0; Grid.EndEdit(Self); end; VK_DOWN: begin Key := 0; Grid.EndEdit(Self); end; VK_ESCAPE: begin Key := 0; Hide; Grid.SetFocus; end; else inherited; end; end; (*****************************************************************************) { TVpWvAttributes } (*****************************************************************************) constructor TVpWvAttributes.Create(AOwner: TVpWeekView); begin inherited Create; FOwner := AOwner; end; procedure TVpWvAttributes.UpdateWeekView; begin if FOwner <> nil then FOwner.Invalidate; end; (*****************************************************************************) { TVpWvDayHeadAttr } (*****************************************************************************) constructor TVpWvDayHeadAttr.Create(AOwner: TVpWeekView); begin inherited Create(AOwner); FDateFormat := 'ddddd'; FFont := TVpFont.Create(AOwner); FColor := DEFAULT_HEADERCOLOR; FBordered := true; FAlignment := taRightJustify; end; destructor TVpWvDayHeadAttr.Destroy; begin FFont.Free; inherited; end; function TVpWvDayHeadAttr.IsStoredDateFormat: Boolean; begin Result := FDateFormat = 'ddddd'; end; procedure TVpWvDayHeadAttr.SetAlignment(Value: TAlignment); begin if Value <> FAlignment then begin FAlignment := Value; UpdateWeekView; end; end; procedure TVpWvDayHeadAttr.SetBordered(Value: Boolean); begin if Value <> FBordered then begin FBordered := Value; UpdateWeekView; end; end; procedure TVpWvDayHeadAttr.SetDateFormat(Value: string); begin if Value <> FDateFormat then begin FDateFormat := Value; UpdateWeekView; end; end; procedure TVpWvDayHeadAttr.SetColor(Value: TColor); begin if Value <> FColor then begin FColor := Value; UpdateWeekView; end; end; procedure TVpWvDayHeadAttr.SetFont(Value: TVpFont); begin if Value <> FFont then begin FFont.Assign(Value); FFont.Owner := FOwner; UpdateWeekView; end; end; (*****************************************************************************) { TVpWvHeadAttributes } (*****************************************************************************) constructor TVpWvHeadAttributes.Create(AOwner: TVpWeekView); begin inherited Create(AOwner); FColor := DEFAULT_HEADERCOLOR; FFont := TVpFont.Create(AOwner); end; destructor TVpWvHeadAttributes.Destroy; begin FFont.Free; inherited; end; procedure TVpWvHeadAttributes.SetColor(const Value: TColor); begin if FColor <> Value then begin FColor := Value; UpdateWeekView; end; end; procedure TVpWvHeadAttributes.SetFont(Value: TVpFont); begin FFont.Assign(Value); FFont.Owner := FOwner; UpdateWeekView; end; (*****************************************************************************) { TVpWeekView } (*****************************************************************************) constructor TVpWeekView.Create(AOwner: TComponent); begin inherited; ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks]; HintWindowClass := TVpHintWindow; { Create internal classes and stuff } FDayHeadAttributes := TVpWvDayHeadAttr.Create(self); FHeadAttr := TVpWvHeadAttributes.Create(self); FAllDayEventAttr := TVpAllDayEventAttributes.Create(self); FPrevMonthBtn := TSpeedButton.Create(self); FPrevMonthBtn.Hint := RSPrevMonth; FPrevMonthBtn.OnClick := SpinButtonClick; FPrevWeekBtn := TSpeedButton.Create(self); FPrevWeekBtn.Hint := RSPrevWeek; FPrevWeekBtn.OnClick := SpinButtonClick; FNextWeekBtn := TSpeedButton.Create(self); FNextWeekBtn.Hint := RSNextWeek; FNextWeekBtn.OnClick := SpinButtonClick; FNextMonthBtn := TSpeedButton.Create(self); FNextMonthBtn.Hint := RSNextMonth; FNextMonthBtn.OnClick := SpinButtonClick; // Speedbutton glyphs {$IFDEF NEW_ICONS} LoadGlyphFromRCDATA(FPrevMonthBtn.Glyph, 'VpLArrows', 16, 24, 32); LoadGlyphFromRCDATA(FPrevWeekBtn.Glyph, 'VpLArrow', 16, 24, 32); LoadGlyphFromRCDATA(FNextWeekBtn.Glyph, 'VpRArrow', 16, 24, 32); LoadGlyphFromRCDATA(FNextMonthBtn.Glyph, 'VpRArrows', 16, 24, 32); {$ELSE} FPrevMonthBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPLEFTARROWS'); FPrevWeekBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPLEFTARROW'); FNextWeekBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPRIGHTARROW'); FNextMonthUpBtn.Glyph.LoadFromResourceName(HINSTANCE, 'VPRIGHTARROWS'); {$ENDIF} FEventFont := TVpFont.Create(self); FEventFont.Assign(Font); FShowEventTime := true; wvInLinkHandler := false; wvClickTimer := TTimer.Create(self); wvHotPoint := Point(0, 0); wvDragging := false; wvMouseDownPoint := Point(0, 0); wvMouseDown := false; DragMode := dmManual; { Set styles and initialize internal variables } {$IFDEF VERSION4} // DoubleBuffered := true; {$ENDIF} FWeekStartsOn := dtSunday; wvClickTimer.Enabled := false; wvClickTimer.Interval := ClickDelay; wvClickTimer.OnTimer := wvEditInPlace; wvCreatingEditor := false; FDrawingStyle := ds3d; wvPainting := false; FColor := DEFAULT_COLOR; FLineColor := DEFAULT_LINECOLOR; FTextMargin := 2; FHeaderMargin := TEXT_MARGIN; wvStartDate := trunc(GetStartOfWeek(Now, FWeekStartsOn)); FTimeFormat := tf12Hour; FDateLabelFormat := 'ddddd'; FAllowInplaceEdit := true; FGutterWidth := 6; { set up fonts and colors } FDayHeadAttributes.Font.Size := 10; FDayHeadAttributes.Font.Style := []; FDayHeadAttributes.Bordered := true; FAllDayEventAttr.Font.Assign (Font); SetLength(wvEventArray, MaxVisibleEvents); SetLength(wvWeekdayArray, 7); { size } Height := 225; Width := 300; FDefaultPopup := TPopupMenu.Create(Self); FDefaultPopup.Name := 'default'; InitializeDefaultPopup; Self.PopupMenu := FDefaultPopup; LoadLanguage; wvHookUp; SetActiveDate(Now); end; destructor TVpWeekView.Destroy; begin FreeAndNil(wvInplaceEditor); FDayHeadAttributes.Free; FAllDayEventAttr.Free; FHeadAttr.Free; wvClickTimer.Free; FEventFont.Free; FDefaultPopup.Free; inherited; end; function TVpWeekView.BuildEventString(AEvent: TVpEvent; AStartTime, AEndTime: TDateTime; 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 (odEventDescription in 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 } timeStr := IfThen(ShowEventTime, Format('%s - %s: ', [ FormatDateTime(timeFmt, AStartTime), FormatDateTime(timeFmt, AEndTime) ])); Result := timeStr; if isOverlayed then begin if (grp <> nil) and (odResource in grp.ShowDetails) then begin res := Datastore.Resources.GetResource(AEvent.ResourceID); if res <> nil then Result := Result + '[' + res.Description + '] '; end else Result := Result + '[' + RSOverlayedEvent + '] '; end else showDetails := True; if showDetails then Result := Result + AEvent.Description; end; end; procedure TVpWeekView.LoadLanguage; var item: TMenuItem; begin for item in FDefaultPopup.Items do if item is TVpMenuItem then TVpMenuItem(item).Translate; end; procedure TVpWeekView.Invalidate; begin inherited; end; function TVpWeekView.IsHoliday(ADate: TDate; out AHolidayName: String): Boolean; begin AHolidayName := ''; if Assigned(FOnHoliday) then FOnHoliday(Self, ADate, AHolidayName); Result := AHolidayName <> ''; end; procedure TVpWeekView.LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType; const Value: Variant); begin wvInLinkHandler := true; try case NotificationType of neDateChange : Date := Value; neDataStoreChange : Invalidate; neInvalidate : Invalidate; end; finally wvInLinkHandler := false; end; end; procedure TVpWeekView.wvHookUp; var I: Integer; begin { If the component is being dropped on a form at designtime, then } { automatically hook up to the first datastore component found } if csDesigning in ComponentState then for I := 0 to pred(Owner.ComponentCount) do begin if (Owner.Components[I] is TVpCustomDataStore) then begin DataStore := TVpCustomDataStore(Owner.Components[I]); Exit; end; end; end; procedure TVpWeekView.Loaded; begin inherited; wvLoaded := true; wvPopulate; end; function TVpWeekView.GetControlType : TVpItemType; begin Result := itWeekView; end; procedure TVpWeekView.Paint; begin RenderToCanvas( Canvas, // Paint Canvas Rect (0, 0, Width, Height), // Paint Rectangle ra0, 1, // Scale wvStartDate, // Date -1, // Start At -1, // End At gr30Min, False // Display Only ); end; procedure TVpWeekView.PaintToCanvas(ACanvas: TCanvas; ARect: TRect; Angle: TVpRotationAngle; ADate: TDateTime); begin RenderToCanvas(ACanvas, ARect, Angle, 1, ADate, -1, -1, gr30Min, True); end; procedure TVpWeekView.RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect; Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime; StartLine: Integer; StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); var painter: TVpWeekViewPainter; begin wvPainting := true; painter := TVpWeekViewPainter.Create(self, RenderCanvas); try painter.RenderToCanvas(RenderIn, Angle, Scale, RenderDate, Startline, StopLine, UseGran, DisplayOnly); finally painter.Free; wvPainting := false; end; end; procedure TVpWeekView.wvPopulate; begin if DataStore <> nil then DataStore.Date := FActiveDate; end; procedure TVpWeekView.DeleteActiveEvent(Verify: Boolean); var DoIt: Boolean; begin if ReadOnly then exit; if (FActiveEvent <> nil) and (not FActiveEvent.CanEdit) then exit; wvClickTimer.Enabled := false; EndEdit(nil); DoIt := not Verify; if ActiveEvent <> nil then begin if Assigned(FOnDeletingEvent) then begin DoIt := true; FOnDeletingEvent(Self, ActiveEvent, DoIt); end else if Verify then DoIt := (MessageDlg(RSConfirmDeleteEvent + LineEnding2 + RSPermanent, mtConfirmation, [mbYes, mbNo], 0) = mrYes); if DoIt then begin ActiveEvent.Deleted := true; ActiveEvent := nil; DataStore.PostEvents; Invalidate; end; end; end; procedure TVpWeekView.SpinButtonClick(Sender: TObject); begin if Sender = FPrevWeekBtn then Date := IncWeek(Date, -1) else if Sender = FNextWeekBtn then Date := IncWeek(Date, +1) else if Sender = FPrevMonthBtn then Date := IncMonth(Date, -1) else if Sender = FNextMonthBtn then Date := IncMonth(Date, +1); end; procedure TVpWeekView.SetColor(Value: TColor); begin if FColor <> Value then begin FColor := Value; Invalidate; end; end; procedure TVpWeekView.SetActiveEvent(AValue: TVpEvent); begin if FActiveEvent = AValue then Exit; FActiveEvent := AValue; end; procedure TVpWeekView.SetApplyCategoryInfos(AValue: Boolean); begin if FApplyCategoryInfos <> AValue then begin FApplyCategoryInfos := AValue; Invalidate; end; end; procedure TVpWeekView.SetDrawingStyle(Value: TVpDrawingStyle); begin if FDrawingStyle <> Value then begin FDrawingStyle := Value; Invalidate; end; end; procedure TVpWeekView.SetLineColor(AValue: TColor); begin if FLineColor <> AValue then begin FLineColor := AValue; Invalidate; end; end; function TVpWeekView.IsStoredDateLabelFormat: Boolean; begin Result := FDateLabelFormat <> 'ddddd'; end; procedure TVpWeekView.SetDateLabelFormat(Value: string); begin if Value <> FDateLabelFormat then begin FDateLabelFormat := Value; Invalidate; end; end; procedure TVpWeekView.SetEventFont(Value: TVpFont); begin FEventFont.Assign(Value); Invalidate; end; procedure TVpWeekView.SetHeaderMargin(AValue: Integer); begin if AValue <> FHeaderMargin then begin FHeaderMargin := AValue; Invalidate; end; end; procedure TVpWeekView.SetLayout(AValue: TVpWeekviewLayout); begin if AValue <> FLayout then begin FLayout := AValue; Invalidate; end; end; procedure TVpWeekView.SetShowEventTime(Value: Boolean); begin if Value <> FShowEventTIme then begin FShowEventTime := Value; Invalidate; end; end; procedure TVpWeekView.SetTextMargin(Value: Integer); begin if Value <> FTextMargin then begin FTextMargin := Value; Invalidate; end; end; procedure TVpWeekView.SetTimeFormat(Value: TVpTimeFormat); begin if Value <> FTimeFormat then begin FTimeFormat := Value; Invalidate; end; end; procedure TVpWeekView.SetActiveDate(Value: TDateTime); begin if FActiveDate <> Value then begin FActiveDate := Value; if (Value < wvStartDate) or (Value >= wvStartDate + 7) then wvStartDate := Trunc(GetStartOfWeek(Value, FWeekStartsOn)); if wvStartDate > Value then wvStartDate := wvStartDate - 7; if wvLoaded then wvPopulate; Invalidate; if (not wvInLinkHandler) and (ControlLink <> nil) then ControlLink.Notify(self, neDateChange, FActiveDate); end; end; procedure TVpWeekView.SetWeekStartsOn(Value: TVpDayType); begin if FWeekStartsOn <> Value then begin FWeekStartsOn := Value; Invalidate; end; end; {$IFNDEF LCL} procedure TVpWeekView.WMSize(var Msg: TWMSize); {$ELSE} procedure TVpWeekView.WMSize(var Msg: TLMSize); {$ENDIF} begin inherited; { force a repaint on resize } Invalidate; end; procedure TVpWeekView.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do begin Style := Style or WS_TABSTOP; {$IFDEF DELPHI} WindowClass.style := CS_DBLCLKS; {$ENDIF} end; end; procedure TVpWeekView.CreateWnd; begin inherited; FPrevMonthBtn.Parent := Self; FPrevWeekBtn.Parent := Self; FNextWeekBtn.Parent := Self; FNextMonthBtn.Parent := Self; end; procedure TVpWeekView.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 TVpWeekView.DoStartDrag(var DragObject: TDragObject); {$IFDEF LCL} var P, HotSpot: TPoint; EventName: string; {$ENDIF} begin if ReadOnly or not FAllowDragAndDrop then Exit; if FActiveEvent <> nil then begin {$IFDEF LCL} GetCursorPos(P{%H-}); P := TVpWeekView(Self).ScreenToClient(P); EventName := FActiveEvent.Description; HotSpot := Point(P.X - Self.wvActiveEventRec.Left, P.Y - Self.wvActiveEventRec.Top); DragObject := TVpEventDragObject.CreateWithDragImages(Self as TControl, HotSpot, Self.wvActiveEventRec, 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 TVpWeekView.DragDrop(Source: TObject; X, Y: Integer); var Event: TVpEvent; i: Integer; P: TPoint; newDate, dateDiff: TDate; begin if ReadOnly or (not FAllowDragAndDrop) then Exit; P := Point(X, Y); newDate := -1; for i := 0 to pred(Length(wvWeekdayArray)) do if PointInRect(P, wvWeekdayArray[i].Rec) then begin newDate := wvWeekdayArray[i].Day; break; end; if newDate = -1 then exit; Event := TVpEventDragObject(Source).Event; if Event <> nil then begin dateDiff := trunc(newDate) - trunc(Event.StartTime); Event.StartTime := newDate + frac(Event.StartTime); Event.EndTime := Event.EndTime + dateDiff; DataStore.PostEvents; Repaint; end; end; procedure TVpWeekView.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Unused(Source, X, State); Accept := false; if ReadOnly or (not FAllowDragAndDrop) then Exit; if (Y > wvHeaderHeight) then Accept := true; end; {$IFNDEF LCL} procedure TVpWeekView.WMLButtonDblClk(var Msg: TWMLButtonDblClk); {$ELSE} procedure TVpWeekView.WMLButtonDblClk(var Msg: TLMLButtonDblClk); {$ENDIF} var StartTime, EndTime: TDateTime; begin inherited; wvClickTimer.Enabled := false; wvMouseDownPoint := Point(0, 0); wvMouseDown := false; wvDragging := false; if not CheckCreateResource then Exit; if DataStore = nil then Exit; wvSetDateByCoord(Point(Msg.XPos, Msg.YPos)); EventAtCoord(Point(Msg.XPos, Msg.YPos)); // if the mouse was pressed down in the client area, then select the cell. if not focused then SetFocus; if (Msg.YPos > wvHeaderHeight) then begin { The mouse click landed inside the client area } { If we have hit an active event then we must want to edit it } if ActiveEvent <> nil then begin { edit this event } wvSpawnEventEditDialog(False); end else if (DataStore.Resource <> nil) then begin { otherwise, we must want to create a new event } StartTime := NextFullHour(FActiveDate + Time()); // Be careful: By taking the next full hour we may advance to the next day // here which is very confusing to the user who had dbl-clicked on the // previous day. In this case we go back by one hour (--> 23:00) if trunc(StartTime) <> FActiveDate then StartTime := StartTime - OneHour; EndTime := StartTime + 30 / MinutesInDay; { StartTime + 30 minutes } ActiveEvent := DataStore.Resource.Schedule.AddEvent( DataStore.GetNextID('Events'), StartTime, EndTime ); { edit this new event } wvSpawnEventEditDialog(True); // true = new event end; end; end; procedure TVpWeekView.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 TVpWeekView.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; { Hints } procedure TVpWeekView.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, AEvent.StartTime, AEvent.EndTime, true); end; hmComponentHint: txt := FComponentHint; end; if (txt <> '') and not ((wvInplaceEditor <> nil) and wvInplaceEditor.Visible) and not (csDesigning in ComponentState) then begin Hint := txt; Application.Hint := txt; Application.ActivateHint(ClientToScreen(APoint), true); end; end; procedure TVpWeekView.HideHintWindow; begin Application.CancelHint; end; procedure TVpWeekView.SetHint(const AValue: TTranslateString); begin inherited; if FHintMode = hmComponentHint then FComponentHint := AValue; end; { Popup menu } function TVpWeekView.GetPopupMenu: TPopupMenu; begin if FExternalPopup = nil then Result := FDefaultPopup else Result := FExternalPopup; end; procedure TVpWeekView.SetPopupMenu(AValue: TPopupMenu); begin if (AValue = nil) or (AValue = FDefaultPopup) then FExternalPopup := nil else FExternalPopup := AValue; end; procedure TVpWeekView.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); NewItem.Kind := mikImportEventFromICal; // Import from iCal NewItem.OnClick := PopupImportFromICalFile; NewItem.Tag := 0; FDefaultPopup.Items.Add(NewItem); end; if RSPopupExportToICal <> '' then begin NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikExportEventToICal; // Export to iCal NewItem.OnClick := PopupExportToICalFile; 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 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 // Previous 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 // Previous 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 // previous 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 TVpWeekView.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; // Default start time: next full hour on the active day. // Be careful: By taking the next full hour we may advance to the next day // here which is very confusing to the user who had selected the previous day. // In this case we go back by one hour (--> 23:00) StartTime := NextFullHour(FActiveDate + Time()); if Trunc(StartTime) <> FActiveDate then StartTime := StartTime - OneHour; // Default end time: Start time + 30 minutes EndTime := StartTime + 30 * OneMinute; ActiveEvent := DataStore.Resource.Schedule.AddEvent( DataStore.GetNextID('Events'), StartTime, EndTime ); // Edit this new event wvSpawnEventEditDialog(True); end; procedure TVpWeekView.PopupDeleteEvent(Sender: TObject); begin if ReadOnly then Exit; if ActiveEvent <> nil then DeleteActiveEvent (True); end; procedure TVpWeekView.PopupEditEvent(Sender: TObject); begin if ReadOnly then Exit; if ActiveEvent <> nil then { edit this Event } wvSpawnEventEditDialog(False); end; procedure TVpWeekView.PopupExportToICalFile(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 TVpWeekView.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 TVpWeekView.EditSelectedEvent(IsNewEvent: Boolean = false); begin if ActiveEvent <> nil then wvSpawnEventEditDialog(IsNewEvent); end; procedure TVpWeekView.PopupToday(Sender: TObject); begin Date := Now; end; procedure TVpWeekView.PopupNextWeek(Sender: TObject); begin Date := Date + 7; end; procedure TVpWeekView.PopupPrevWeek(Sender: TObject); begin Date := Date - 7; end; procedure TVpWeekView.PopupNextMonth(Sender: TObject); begin Date := IncMonth(Date, 1); end; procedure TVpWeekView.PopupPrevMonth(Sender : TObject); begin Date := IncMonth(Date, -1); end; procedure TVpWeekView.PopupNextYear(Sender: TObject); begin Date := IncYear(Date, +1); end; procedure TVpWeekView.PopupPrevYear(Sender: TObject); begin Date := IncYear(Date, -1); end; procedure TVpWeekView.PopupCustomDate(Sender: TObject); var d: TDate; begin d := Date; if DateDialog(RSSelectCustomDate, d) then Date := d; end; procedure TVpWeekView.PopupPickResourceGroupEvent(Sender: TObject); begin Datastore.Resource.Group := TVpResourceGroup(TMenuItem(Sender).Tag); Datastore.UpdateGroupEvents; end; procedure TVpWeekView.wvSpawnEventEditDialog(IsNewEvent: Boolean); var AllowIt: Boolean; EventDlg : TVpEventEditDialog; begin if DataStore = nil then Exit; if (not IsNewEvent) and (not ActiveEvent.CanEdit) then begin MessageDlg(RSCannotEditOverlayedEvent, mtInformation, [mbOk], 0); exit; end; AllowIt := false; if Assigned(FOwnerEditEvent) then FOwnerEditEvent(self, ActiveEvent, IsNewEvent, DataStore.Resource, AllowIt) else begin EventDlg := TVpEventEditDialog.Create(nil); try EventDlg.DataStore := DataStore; EventDlg.TimeFormat := FTimeFormat; AllowIt := EventDlg.Execute(ActiveEvent); finally EventDlg.Free; end; end; if AllowIt then begin ActiveEvent.Changed := true; DataStore.PostEvents; if IsNewEvent and Assigned(FOnAddEvent) then FOnAddEvent(self, ActiveEvent); if not IsNewEvent and Assigned(FOnModifyEvent) then FOnModifyEvent(self, ActiveEvent); end else begin if IsNewEvent then begin DataStore.Resource.Schedule.DeleteEvent(ActiveEvent); ActiveEvent := nil; end; DataStore.PostEvents; end; Invalidate; end; {$IFNDEF LCL} procedure TVpWeekView.CMWantSpecialKey(var Msg: TCMWantSpecialKey); begin inherited; Msg.Result := 1; end; {$ENDIF} procedure TVpWeekView.wvSetDateByCoord(Point: TPoint); var I: Integer; begin for I := 0 to pred(Length(wvWeekdayArray)) do if PointInRect(Point, wvWeekdayArray[I].Rec) then begin Date := wvWeekdayArray[I].Day; Invalidate; Exit; end; end; function TVpWeekView.EventAtCoord(Pt: TPoint): Boolean; var I: Integer; begin result := false; for I := 0 to pred(Length(wvEventArray)) do begin // We've hit the end of visible events without finding a match if wvEventArray[I].Event = nil then Break; // Point falls inside this event's rectangle if PointInRect(Pt, wvEventArray[I].Rec) then begin wvHotPoint := Pt; ActiveEvent := TVpEvent(wvEventArray[I].Event); wvActiveEventRec := wvEventArray[I].Rec; result := true; Exit; end; end; // Not found ActiveEvent := nil; wvActiveEventRec.Top := 0; wvActiveEventRec.Bottom := 0; wvActiveEventRec.Right := 0; wvActiveEventRec.Left := 0; end; function TVpWeekView.GetEventAtCoord(Pt: TPoint): TVpEvent; var i: Integer; begin for i:=0 to High(wvEventArray) do begin // We've hit the end of visible events without finding a match if wvEventArray[i].Event = nil then Break; // Point falls inside this event's rectangle if PointInRect(Pt, wvEventArray[i].Rec) then begin Result := wvEventArray[i].Event; Exit; end; end; Result := nil; end; function TVpWeekView.GetEventRect(AEvent: TVpEvent): TRect; var i: Integer; begin for i:=0 to High(wvEventArray) do if wvEventArray[i].Event = AEvent then begin Result := wvEventArray[i].Rec; exit; end; end; { This is the timer event which spawns an in-place editor. If the event is double-clicked before this timer fires, then the event is edited in a dialog based editor. } procedure TVpWeekView.wvEditInPlace(Sender: TObject); begin wvClickTimer.Enabled := false; EditEvent; end; procedure TVpWeekView.EditEvent; var AllowIt: Boolean; begin if ActiveEvent <> nil then begin if (not FAllowInplaceEdit) or (not ActiveEvent.CanEdit) then exit; AllowIt := true; { call the user defined BeforeEdit event } if Assigned(FBeforeEdit) then FBeforeEdit(Self, ActiveEvent, AllowIt); if AllowIt then begin { create and spawn the in-place editor } if wvInplaceEditor = nil then begin wvInPlaceEditor := TVpWvInPlaceEdit.Create(Self); wvInPlaceEditor.Parent := self; wvInPlaceEditor.OnExit := EndEdit; end; if ActiveEvent.AllDayEvent then wvInPlaceEditor.SetBounds( wvActiveEventRec.Left + TextMargin, wvActiveEventRec.Top + TextMargin, WidthOf(wvActiveEventRec) - TextMargin * 2 - 1, HeightOf(wvActiveEventRec) - TextMargin * 2 ) else wvInPlaceEditor.SetBounds( wvActiveEventRec.Left + FGutterWidth + TextMargin, wvActiveEventRec.Top + TextMargin, WidthOf(wvActiveEventRec) - TextMargin - FGutterWidth - 1, HeightOf(wvActiveEventRec) - 2*TextMargin ); wvInplaceEditor.Show; wvInPlaceEditor.Text := ActiveEvent.Description; Invalidate; wvInPlaceEditor.SetFocus; end; end; end; procedure TVpWeekView.KeyDown(var Key: Word; Shift: TShiftState); var PopupPoint : TPoint; begin case Key of VK_DELETE : DeleteActiveEvent(true); VK_RIGHT : if Shift = [ssShift] then PopupNextWeek (Self) else if (Shift = [ssCtrl]) then PopupNextMonth (Self) else if (Shift = [ssShift, ssCtrl]) then PopupNextYear (Self) else if Shift = [] then begin case DayOfWeek (FActiveDate) of 1 : FActiveDate := FActiveDate - 4; 2 : FActiveDate := FActiveDate + 3; 3 : FActiveDate := FActiveDate + 3; 4 : FActiveDate := FActiveDate + 3; 5 : FActiveDate := FActiveDate - 3; 6 : FActiveDate := FActiveDate - 3; 7 : FActiveDate := FActiveDate - 3; end; Invalidate; end; VK_LEFT : if Shift = [ssShift] then PopupPrevWeek (Self) else if (Shift = [ssCtrl]) then PopupPrevMonth (Self) else if (Shift = [ssShift, ssCtrl]) then PopupPrevYear (Self) else if Shift = [] then begin case DayOfWeek (FActiveDate) of 1 : FActiveDate := FActiveDate - 4; 2 : FActiveDate := FActiveDate + 3; 3 : FActiveDate := FActiveDate + 3; 4 : FActiveDate := FActiveDate + 3; 5 : FActiveDate := FActiveDate - 3; 6 : FActiveDate := FActiveDate - 3; 7 : FActiveDate := FActiveDate - 3; end; Invalidate; end; VK_UP : begin if Shift = [] then case DayOfWeek (FActiveDate) of 1 : FActiveDate := FActiveDate - 1; 2 : FActiveDate := FActiveDate + 2; 3 : FActiveDate := FActiveDate - 1; 4 : FActiveDate := FActiveDate - 1; 5 : FActiveDate := FActiveDate + 3; 6 : FActiveDate := FActiveDate - 1; 7 : FActiveDate := FActiveDate - 1; end; Invalidate; end; VK_DOWN : begin if Shift = [] then case DayOfWeek (FActiveDate) of 1 : FActiveDate := FActiveDate - 3; 2 : FActiveDate := FActiveDate + 1; 3 : FActiveDate := FActiveDate + 1; 4 : FActiveDate := FActiveDate - 2; 5 : FActiveDate := FActiveDate + 1; 6 : FActiveDate := FActiveDate + 1; 7 : FActiveDate := FActiveDate + 1; end; Invalidate; end; VK_INSERT : PopupAddEvent(Self); {$IFNDEF LCL} VK_TAB : if ssShift in Shift then Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, False)) else Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, True)); {$ENDIF} VK_F10: if (ssShift in Shift) and not Assigned(PopupMenu) then begin PopupPoint := GetClientOrigin; FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10); end; VK_APPS: if not Assigned (PopupMenu) then begin PopupPoint := GetClientOrigin; FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10); end; end; end; procedure TVpWeekView.EndEdit(Sender: TObject); begin if (wvInPlaceEditor <> nil) and wvInplaceEditor.Visible and (ActiveEvent <> nil) then begin if wvInPlaceEditor.Text <> ActiveEvent.Description then begin ActiveEvent.Description := wvInPlaceEditor.Text; ActiveEvent.Changed := true; if Assigned(FAfterEdit) then FAfterEdit(self, ActiveEvent); DataStore.PostEvents; end; wvInplaceEditor.Hide; Invalidate; // SetFocus; end; end; procedure TVpWeekView.MouseEnter; begin FMouseEvent := nil; end; procedure TVpWeekView.MouseLeave; begin HideHintWindow; end; procedure TVpWeekView.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); var oldDate: TDate; i: Integer; begin inherited; if not Focused then SetFocus; { Left button } if Button = mbLeft then begin if (wvInPlaceEditor <> nil) and wvInPlaceEditor.Visible then EndEdit(Self); wvMouseDown := true; wvMouseDownPoint := Point(X, Y); if (Y > wvHeaderHeight) then begin { The mouse click landed inside the client area } oldDate := FActiveDate; wvSetDateByCoord(wvMouseDownPoint); { We must repaint the control here, before evaluation of the click on the events, because if the day has changed by wvSetDateByCoord then events will have different indexes in the event array; and index positions are evaluated during painting. } if oldDate <> FActiveDate then Paint; { If an active event was clicked, then enable the click timer. If the item is double clicked before the click timer fires, then the edit dialog will appear, otherwise the in-place editor will appear. } if EventAtCoord(wvMouseDownPoint) then wvClickTimer.Enabled := true; end; end; { Right button } if Button = mbRight then begin if (PopupMenu <> FDefaultPopup) then exit; { The mouse click landed inside the client area } wvSetDateByCoord(Point(X, Y)); EventAtCoord(Point(X, Y)); wvClickTimer.Enabled := false; if not Assigned(ActiveEvent) then begin for i := 0 to FDefaultPopup.Items.Count - 1 do if (FDefaultPopup.Items[i].Tag = 1) or (ReadOnly) then FDefaultPopup.Items[i].Enabled := False; end else begin for i := 0 to FDefaultPopup.Items.Count - 1 do FDefaultPopup.Items[i].Enabled := True; end; end; end; procedure TVpWeekView.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 wvDragging) and wvMouseDown and ((wvMouseDownPoint.x <> x) or (wvMouseDownPoint.y <> y)) and FActiveEvent.CanEdit then begin wvDragging := true; wvClickTimer.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 TVpWeekView.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseUp(Button, Shift, X, Y); if Button = mbLeft then begin wvMouseDownPoint := Point(0, 0); wvMouseDown := false; wvDragging := false; end; end; {$IF VP_LCL_SCALING <> 0} procedure TVpWeekView.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); begin inherited; if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then begin FTextMargin := round(FTextMargin * AXProportion); FHeaderMargin := round(FHeaderMargin * AXProportion); FGutterWidth := round(FGutterWidth * AXProportion); end; end; {$IFEND} {$IF VP_LCL_SCALING = 2} procedure TVpWeekView.FixDesignFontsPPI(const ADesignTimePPI: Integer); begin inherited; DoFixDesignFontPPI(AllDayEventAttributes.Font, ADesignTimePPI); DoFixDesignFontPPI(DayHeadAttributes.Font, ADesignTimePPI); DoFixDesignFontPPI(EventFont, ADesignTimePPI); DoFixDesignFontPPI(HeadAttributes.Font, ADesignTimePPI); end; procedure TVpWeekView.ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); begin inherited; DoScaleFontPPI(AllDayEventAttributes.Font, AToPPI, AProportion); DoScaleFontPPI(DayHeadAttributes.Font, AToPPI, AProportion); DoScaleFontPPI(EventFont, AToPPI, AProportion); DoScaleFontPPI(HeadAttributes.Font, AToPPI, AProportion); end; {$ELSEIF VP_LCL_SCALING = 1} procedure TVpWeekView.ScaleFontsPPI(const AProportion: Double); begin inherited; DoScaleFontPPI(AllDayEventAttributes.Font, AProportion); DoScaleFontPPI(DayHeadAttributes.Font, AProportion); DoScaleFontPPI(EventFont, AProportion); DoScaleFontPPI(HeadAttributes.Font, AProportion); end; {$ENDIF} procedure TVpWeekView.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = FExternalPopup) then FExternalPopup := nil; end; end.