pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
901b92fa7253da596d484795c088fd52c0c54b41
lazarus-ccr/components/tvplanit/source/vpdayview.pas

2847 lines
79 KiB
ObjectPascal
Raw Blame History

{*********************************************************}
{* 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 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.
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.
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.
}
{$I vp.inc}
{.$DEFINE DEBUGDV} { Causes the DayView to operate in debug mode }
unit VpDayView;
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;
type
TVpLineArray = array of TVpLineRec;
type
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{private}
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)
protected{ private }
FOwner: TVpDayView;
FColor: TColor;
FHourFont: TVpFont;
FMinuteFont: TVpFont;
procedure SetColor(const Value: TColor);
procedure SetHourFont(Value: TVpFont);
procedure SetMinuteFont(Value: TVpFont);
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)
protected {Private}
FOwner: TWinControl;
FBackgroundColor: TColor;
FEventBackgroundColor: TColor;
FEventBorderColor: TColor;
FFont: TVpFont;
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)
protected{ private }
FOwner: TVpDayView;
FColor: TColor;
FFont: TVpFont;
procedure SetColor(const Value: TColor);
procedure SetFont(Value: TVpFont);
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
FComponentHint: TTranslateString;
FHintMode: TVpHintMode;
FMouseEvent: TVpEvent;
FOnHoliday: TVpHolidayEvent;
protected{ private }
FGranularity: TVpGranularity;
FColumnWidth: Integer;
FColor: TColor;
FLineColor: TColor;
FDefTopHour: TVpHours;
FTopHour: TVpHours;
FDateLabelFormat: string;
FShowResourceName: Boolean;
FTopLine: Integer;
FActiveRow: Integer;
FActiveCol: Integer;
FActiveEvent: TVpEvent;
FGutterWidth: Integer;
FDefaultPopup: TPopupMenu;
FLineCount: Integer;
FVisibleLines: Integer;
FTimeFormat: TVpTimeFormat;
FDrawingStyle: TVpDrawingStyle;
FTimeSlotColors: TVpTimeSlotColor;
FRowHeadAttr: TVpRHAttributes;
FHeadAttr: TVpCHAttributes;
FAllDayEventAttr: TVpAllDayEventAttributes;
FDisplayDate: TDateTime;
FScrollBars: TScrollStyle;
FIconAttributes: TVpDayViewIconAttributes;
FWrapStyle: TVpDVWrapStyle;
FDotDotDotColor: TColor;
FShowEventTimes: Boolean;
FAllowInplaceEdit: Boolean;
FDragDropTransparent: Boolean;
FAllowDragAndDrop: Boolean;
FNumDays: Integer;
FIncludeWeekends: Boolean;
FRowLinesStep: Integer;
FShowNavButtons: Boolean;
FFixedDate: Boolean;
FCustomRowHeight: Integer;
FSimpleRowTime: Boolean;
{ event variables }
FOwnerDrawRowHead: TVpOwnerDrawRowEvent;
FOwnerDrawCells: TVpOwnerDrawRowEvent;
FOwnerDrawColHead: TVpOwnerDrawEvent;
FBeforeEdit: TVpBeforeEditEvent;
FAfterEdit: TVpAfterEditEvent;
FOwnerEditEvent: TVpEditEvent;
FOnDrawIcons: TVpOnDVDrawIcons;
FOnBeforeDrawEvent: TVpOnDVBeforeDrawEvent;
FOnAfterDrawEvent: TVpOnDVAfterDrawEvent;
FOnAddEvent: TVpOnAddNewEvent;
{ internal variables }
dvClickTimer: TTimer;
dvLoaded: Boolean;
dvInLinkHandler: Boolean;
dvRowHeight: Integer;
dvColHeadHeight: Integer;
dvRowHeadWidth: Integer;
dvClientVArea: Integer;
dvMouseDownPoint: TPoint;
dvMouseDown: Boolean;
dvEndingEditing: Boolean;
dvDragging: Boolean;
dvDragStartTime: TDateTime;
{ Nav Buttons }
dvDayUpBtn: TSpeedButton;
dvDayDownBtn: TSpeedButton;
dvTodayBtn: TSpeedButton;
dvWeekUpBtn: TSpeedButton;
dvWeekDownBtn: TSpeedButton;
dvLineMatrix: TVpLineMatrix;
dvColRectArray: TVpColRectArray;
dvEventArray: TVpEventArray;
dvActiveEventRec: TRect;
dvActiveIconRec: TRect;
dvInPlaceEditor: TVpDvInPlaceEdit;
dvCreatingEditor: Boolean;
{ the granularity based time increment for each row }
dvTimeIncSize: double;
dvPainting: Boolean;
dvVScrollDelta: Integer;
dvHotPoint: TPoint;
{ property methods }
function GetLastVisibleDate: TDateTime;
function GetRealNumDays(WorkDate: TDateTime) : Integer;
procedure SetDrawingStyle(Value: TVpDrawingStyle);
procedure SetColor(Value: TColor);
procedure SetLineColor(Value: TColor);
procedure SetTopHour(Value: TVpHours);
procedure SetTopLine(Value: Integer);
procedure SetDateLabelFormat(Value: string);
procedure SetGutterWidth(Value: Integer);
procedure SetDefTopHour(Value: TVpHours);
procedure SetGranularity(Value: TVpGranularity);
procedure SetTimeFormat(Value: TVpTimeFormat);
procedure SetNumDays(Value: Integer);
procedure SetIncludeWeekends(Value: Boolean);
procedure SetDisplayDate(Value: TDateTime);
procedure SetVScrollPos;
procedure SetCustomRowHeight(Value: Integer);
procedure SetRowLinesStep(Value: Integer);
procedure SetShowNavButtons(Value: Boolean);
procedure SetShowResourceName(Value: Boolean);
procedure SetSimpleRowTime(Value: Boolean);
procedure SetActiveRow(Value: Integer);
procedure SetActiveCol(Value: Integer);
procedure SetWrapStyle(const v: TVpDVWrapStyle);
procedure SetDotDotDotColor(const v: TColor);
procedure SetShowEventTimes(Value: Boolean);
{ 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 }
procedure PopupAddEvent(Sender: TObject);
procedure PopupAddFromICalFile(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 PopupPickResourceGroupEvent(Sender: TObject);
procedure PopupDropdownEvent(Sender: TObject);
procedure InitializeDefaultPopup;
{ internal methods }
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
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;
procedure SetActiveEventByCoord(APoint: TPoint);
procedure SetTimeIntervals(UseGran: TVpGranularity);
{ inherited methods }
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 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 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 ReadOnly;
property TabStop;
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 stored True;
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;
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;
property LineColor: TColor read FLineColor write SetLineColor;
property GutterWidth: Integer read FGutterWidth write SetGutterWidth;
property DateLabelFormat: string read FDateLabelFormat write SetDateLabelFormat;
Property Granularity: TVpGranularity read FGranularity write SetGranularity;
property DefaultTopHour: TVpHours read FDefTopHour write SetDefTopHour;
property TimeFormat: TVpTimeFormat read FTimeFormat write SetTimeFormat;
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 OnDrawIcons: TVpOnDVDrawIcons read FOnDrawIcons Write FOnDrawIcons;
property OnHoliday: TVpHolidayEvent read FOnHoliday write FOnHoliday;
property OnOwnerEditEvent: TVpEditEvent read FOwnerEditEvent write FOwnerEditEvent;
property OnClick;
end;
implementation
uses
{$IFDEF LCL}
DateUtils,
{$ENDIF}
SysUtils, StrUtils, Math, Dialogs,
VpEvntEditDlg, VpDayViewPainter, VpICal;
(*****************************************************************************)
{ 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 := clWindow;
FLineColor := clGray;
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);
Self.PopupMenu := FDefaultPopup;
FDefaultPopup.OnPopup := PopupDropDownEvent;
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 (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 + LineEnding + LineEnding +
RSEvent + ':' + LineEnding + AEvent.Description;
// Event notes
if (AEvent.Notes <> '') then begin
s := WrapText(AEvent.Notes, MAX_HINT_WIDTH);
s := StripLastLineEnding(s);
Result := Result + LineEnding + LineEnding +
RSNotes + ':' + LineEnding + s;
end;
// Event location
if (AEvent.Location <> '') then
Result := Result + LineEnding + LineEnding +
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;
begin
dvDayUpBtn.Hint := RSNextDay;
dvDayDownBtn.Hint := RSPrevDay;
dvTodayBtn.Hint := RSToday;
dvWeekUpBtn.Hint := RSNextWeek;
dvWeekDownBtn.Hint := RSPrevWeek;
FDefaultPopup.Items.Clear;
InitializeDefaultPopup;
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 Verify then
DoIt := (MessageDlg(RSConfirmDeleteEvent + #13#10#10 + 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 }
procedure TVpDayView.InitializeDefaultPopup;
var
NewItem: TMenuItem;
NewSubItem: TMenuItem;
canEdit: Boolean;
begin
canEdit := (FActiveEvent <> nil) and FActiveEvent.CanEdit;
FDefaultPopup.Items.Clear;
if RSPopupAddEvent <> '' then begin // Add
NewItem := TMenuItem.Create(Self);
NewItem.Caption := RSPopupAddEvent;
NewItem.OnClick := PopupAddEvent;
NewItem.Tag := 0;
FDefaultPopup.Items.Add(NewItem);
end;
if RSPopupAddEventFromICal <> '' then begin
NewItem := TMenuItem.Create(Self);
NewItem.Caption := RSPopupAddEventFromICal; // Import from iCal
NewItem.OnClick := PopupAddFromICalFile;
NewItem.Tag := 0;
FDefaultPopup.Items.Add(NewItem);
end;
if RSPopupEditEvent <> '' then begin // Edit
NewItem := TMenuItem.Create(Self);
NewItem.Caption := RSPopupEditEvent;
NewItem.Enabled := canEdit;
NewItem.OnClick := PopupEditEvent;
NewItem.Tag := 1;
FDefaultPopup.Items.Add(NewItem);
end;
if RSPopupDeleteEvent <> '' then begin // Delete
NewItem := TMenuItem.Create(Self);
NewItem.Caption := RSPopupDeleteEvent;
NewItem.Enabled := canEdit;
NewItem.OnClick := PopupDeleteEvent;
NewItem.Tag := 1;
FDefaultPopup.Items.Add(NewItem);
end;
NewItem := TMenuItem.Create(Self); // ----
NewItem.Caption := '-';
FDefaultPopup.Items.Add(NewItem);
if RSPopupChangeDate <> '' then begin // Change date >
NewItem := TMenuItem.Create(Self);
NewItem.Caption := RSPopupChangeDate;
NewItem.Tag := 0;
FDefaultPopup.Items.Add(NewItem);
if RSToday <> '' then begin // Today
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSToday;
NewSubItem.OnClick := PopupToday;
NewSubItem.Tag := 0;
NewItem.Add(NewSubItem);
end;
NewSubItem := TMenuItem.Create(Self); // ---
NewSubItem.Caption := '-';
NewItem.Add(NewSubItem);
if RSYesterday <> '' then begin // Yesterday
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSYesterday;
NewSubItem.OnClick := PopupYesterday;
NewSubItem.Tag := 0;
NewItem.Add(NewSubItem);
end;
if RSTomorrow <> '' then begin // Tomorrow
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSTomorrow;
NewSubItem.OnClick := PopupTomorrow;
NewSubItem.Tag := 0;
NewItem.Add(NewSubItem);
end;
NewSubItem := TMenuItem.Create(Self); // --
NewSubItem.Caption := '-';
NewItem.Add(NewSubItem);
if RSNextDay <> '' then begin // Next day
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSNextDay;
NewSubItem.OnClick := PopupNextDay;
NewSubItem.Tag := 0;
NewItem.Add(NewSubItem);
end;
if RSPrevDay <> '' then begin // Prev day
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSPrevDay;
NewSubItem.OnClick := PopupPrevDay;
NewSubItem.Tag := 0;
NewItem.Add(NewSubItem);
end;
NewSubItem := TMenuItem.Create(Self); // ---
NewSubItem.Caption := '-';
NewItem.Add(NewSubItem);
if RSNextWeek <> '' then begin // Next week
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSNextWeek;
NewSubItem.OnClick := PopupNextWeek;
NewSubItem.Tag := 0;
NewItem.Add(NewSubItem);
end;
if RSPrevWeek <> '' then begin // Prev week
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSPrevWeek;
NewSubItem.OnClick := PopupPrevWeek;
NewSubItem.Tag := 0;
NewItem.Add(NewSubItem);
end;
NewSubItem := TMenuItem.Create(Self); // ---
NewSubItem.Caption := '-';
NewItem.Add(NewSubItem);
if RSNextMonth <> '' then begin // Next month
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSNextMonth;
NewSubItem.OnClick := PopupNextMonth;
NewSubItem.Tag := 0;
NewItem.Add(NewSubItem);
end;
if RSPrevMonth <> '' then begin // Prev Month
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSPrevMonth;
NewSubItem.OnClick := PopupPrevMonth;
NewSubItem.Tag := 0;
NewItem.Add(NewSubItem);
end;
NewSubItem := TMenuItem.Create(Self); // ---
NewSubItem.Caption := '-';
NewItem.Add(NewSubItem);
if RSNextYear <> '' then begin // Next year
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSNextYear;
NewSubItem.OnClick := PopupNextYear;
NewSubItem.Tag := 0;
NewItem.Add(NewSubItem);
end;
if RSPrevYear <> '' then begin // Prev year
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSPrevYear;
NewSubItem.OnClick := PopupPrevYear;
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.PopupAddFromICalFile(Sender: TObject);
var
dlg: TOpenDialog;
ical: TVpICalendar;
fn: String;
i: Integer;
id: Integer;
startTime, endTime: TDateTime;
begin
if ReadOnly or (not CheckCreateResource) or
(not Assigned(DataStore)) or (not Assigned(DataStore.Resource))
then
Exit;
dlg := TOpenDialog.Create(nil);
try
dlg.Title := RSLoadICalTitle;
dlg.Filter := RSICalFilter;
dlg.FileName := '';
dlg.Options := dlg.Options + [ofAllowMultiSelect, ofFileMustExist];
if dlg.Execute then begin
Screen.Cursor := crHourGlass;
Application.ProcessMessages;
ical := TVpICalendar.Create;
try
for fn in dlg.Files do begin
ical.LoadFromFile(fn);
for i := 0 to ical.Count-1 do begin
if not (ical[i] is TVpICalEvent) then
Continue;
startTime := TVpICalEvent(ical[i]).StartTime[false]; // use local times
endTime := TVpICalEvent(ical[i]).EndTime[false];
if (startTime = 0) and (endTime = 0) then
continue;
id := DataStore.GetNextID(EventsTableName);
FActiveEvent := Datastore.Resource.Schedule.AddEvent(id, starttime, endtime);
FActiveEvent.Changed := true;
FActiveEvent.LoadFromICalendar(TVpICalEvent(ical[i]));
Datastore.PostEvents;
Datastore.NotifyDependents;
end;
end;
Invalidate;
finally
ical.Free;
Screen.Cursor := crDefault;
end;
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);
var
M, D, Y: Word;
begin
DecodeDate(Date, Y, M, D);
if M = 12 then begin
M := 1;
Y := Y + 1;
end else
M := M + 1;
if (D > DaysInAMonth(Y, M)) then
D := DaysInAMonth(Y, M);
Date := EncodeDate(Y, M, D);
end;
{=====}
procedure TVpDayView.PopupPrevMonth(Sender: TObject);
var
M, D, Y: Word;
begin
DecodeDate(Date, Y, M, D);
if M = 1 then begin
M := 12;
Y := Y - 1;
end else
M := M - 1;
if (D > DaysInAMonth(Y, M)) then
D := DaysInAMonth(Y, M);
Date := EncodeDate(Y, M, D);
end;
{=====}
procedure TVpDayView.PopupNextYear(Sender: TObject);
var
M, D, Y : Word;
begin
DecodeDate(Date, Y, M, D);
Date := EncodeDate(Y + 1, M, 1);
end;
{=====}
procedure TVpDayView.PopupPrevYear(Sender: TObject);
var
M, D, Y: Word;
begin
DecodeDate(Date, Y, M, D);
Date := EncodeDate(Y - 1, M, 1);
end;
{=====}
procedure TVpDayView.PopupPickResourceGroupEvent(Sender: TObject);
begin
Datastore.Resource.Group := TVpResourceGroup(TMenuItem(Sender).Tag);
Datastore.UpdateGroupEvents;
end;
procedure TVpDayView.PopupDropDownEvent(Sender: TObject);
begin
InitializeDefaultPopup;
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;
{ Invalidate; }
end;
// TVpEventDragObject(Source).EndDrag(False);
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;
{=====}
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.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);
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.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.
Reference in New Issue View Git Blame Copy Permalink