pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Add holiday support to DayView.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5199 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-09-22 23:12:16 +00:00
parent 9d7234c2c0
commit c5e93da15a
8 changed files with 145 additions and 89 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
components/tvplanit/examples/fulldemo/demomain.lfm
View File

@ -94,19 +94,15 @@ object MainForm: TMainForm
HeadAttributes.Font.Style = [fsItalic]
HeadAttributes.Color = clBtnFace
HolidayAttributes.Font.Color = clBlack
HolidayAttributes.Color = 8421631
LineColor = clGray
SelectedDayColor = clRed
ShowEvents = True
ShowEventTime = False
TimeFormat = tf12Hour
TodayAttributes.Font.Color = clBlue
TodayAttributes.Color = 16761024
TodayAttributes.BorderPen.Color = clBlue
TodayAttributes.BorderPen.Width = 3
OffDayColor = 15263976
SelectedDayColor = clRed
ShowEvents = True
ShowEventTime = False
WeekendAttributes.Font.Color = clBlack
WeekendAttributes.Color = 12632319
WeekStartsOn = dtSunday
OnHoliday = VpHoliday
end
@ -141,10 +137,6 @@ object MainForm: TMainForm
ShowEventTimes = False
DrawingStyle = dsFlat
TimeSlotColors.Active = clWhite
TimeSlotColors.Inactive = 8454143
TimeSlotColors.Holiday = 16744703
TimeSlotColors.Weekday = clWhite
TimeSlotColors.Weekend = 14737632
TimeSlotColors.ActiveRange.RangeBegin = h_00
TimeSlotColors.ActiveRange.RangeEnd = h_00
HeadAttributes.Font.Height = -13
@ -200,11 +192,12 @@ object MainForm: TMainForm
ShowResourceName = True
LineColor = clGray
GutterWidth = 5
DateLabelFormat = 'dddd, mmmm dd, yyyy'
DateLabelFormat = 'dddddd'
Granularity = gr30Min
DefaultTopHour = h_07
TimeFormat = tf12Hour
WrapStyle = wsNoFlow
OnHoliday = VpHoliday
end
object DaySelectorPanel: TPanel
Left = 0

5
components/tvplanit/readme.txt
View File

@ -113,12 +113,13 @@ steps:
- Add mORMot datastore
- Add drag and drop of events to DayView and WeekView
- Add hint support to DayView, WeekView and MonthView
- Add hint support to DayView, WeekView, MonthView, and Contact Grid
- New contact fields for
- three email addresses (in total)
- two websites
- 2nd address (work address, home address)
- department
and add them to the contact editor
and add them to the contact editor; redesigned contact editor.
- Activate task fields Priority and Category in task editor.
- Holiday support

16
components/tvplanit/source/vpbase.pas
View File

@ -361,10 +361,10 @@ type
procedure Changed;
published
property Active: TColor read FActive write SetActive;
property Inactive: TColor read FInactive write SetInactive;
property Holiday: TColor read FHoliday write SetHoliday;
property Weekday: TColor read FWeekday write SetWeekday;
property Weekend: TColor read FWeekend write SetWeekend;
property Inactive: TColor read FInactive write SetInactive default OFF_COLOR;
property Holiday: TColor read FHoliday write SetHoliday default HOLIDAY_COLOR;
property Weekday: TColor read FWeekday write SetWeekday default WEEKDAY_COLOR;
property Weekend: TColor read FWeekend write SetWeekend default WEEKEND_COLOR;
property ActiveRange: TVpTimeRange read FActiveRange write FActiveRange;
end;
@ -951,11 +951,11 @@ begin
inherited Create;
FOwner := AOwner;
FActiveRange := TVpTimeRange.Create(Self);
FInactive := $0080FFFF;
FHoliday := $00FF80FF;
FWeekend := $00FFFF80;
FInactive := OFF_COLOR; //$0080FFFF;
FHoliday := HOLIDAY_COLOR; //$00FF80FF;
FWeekend := WEEKEND_COLOR; //$00FFFF80;
FActive := clWhite;
FWeekday := clWhite;
FWeekday := WEEKDAY_COLOR; //clWhite;
end;
{=====}

5
components/tvplanit/source/vpconst.pas
View File

@ -94,10 +94,11 @@ const
strTRUE = 'true';
strFALSE = 'false';
WEEKEND_COLOR = $C0C0FF;
WEEKDAY_COLOR = $FFFFFF;
WEEKEND_COLOR = $C0C0C0; //$C0C0FF;
HOLIDAY_COLOR = $8080FF;
TODAY_COLOR = $FFC0C0;
OFF_COLOR = $C0C0C0;
OFF_COLOR = $E0E0E0;
{virtual key constants not already defined}
VK_NONE = 0;

22
components/tvplanit/source/vpdayview.pas
View File

@ -226,6 +226,7 @@ type
FHintMode: TVpHintMode;
FHintWindow: THintWindow;
FMouseEvent: TVpEvent;
FOnHoliday: TVpHolidayEvent;
protected{ private }
FGranularity: TVpGranularity;
@ -259,6 +260,8 @@ type
FAllowInplaceEdit: Boolean;
FDragDropTransparent: Boolean;
FAllowDragAndDrop: Boolean;
FNumDays: Integer;
FIncludeWeekends: Boolean;
{ event variables }
FOwnerDrawRowHead: TVpOwnerDrawRowEvent;
FOwnerDrawCells: TVpOwnerDrawRowEvent;
@ -270,8 +273,6 @@ type
FOnBeforeDrawEvent: TVpOnDVBeforeDrawEvent;
FOnAfterDrawEvent: TVpOnDVAfterDrawEvent;
FOnAddEvent: TVpOnAddNewEvent;
FNumDays: Integer;
FIncludeWeekends: Boolean;
{ internal variables }
dvClickTimer: TTimer;
dvLoaded: Boolean;
@ -413,12 +414,11 @@ type
destructor Destroy; override;
function BuildEventString(AEvent: TVpEvent; UseAsHint: Boolean): String;
procedure LoadLanguage;
procedure DeleteActiveEvent(Verify: Boolean);
procedure DragDrop(Source: TObject; X, Y: Integer); override;
// function HourToLine(const Value: TVpHours; const UseGran: TVpGranularity): Integer;
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;
@ -484,6 +484,7 @@ type
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;
@ -757,7 +758,7 @@ begin
FDisplayDate := Now;
TopHour := FDefTopHour;
FTimeFormat := tf12Hour;
FDateLabelFormat := 'dddd, mmmm dd, yyyy';
FDateLabelFormat := 'dddddd'; //'dddd, mmmm dd, yyyy';
FColumnWidth := 200;
FScrollBars := ssVertical;
FActiveRow := -1;
@ -966,7 +967,14 @@ 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);

67
components/tvplanit/source/vpdayviewpainter.pas
View File

@ -54,6 +54,7 @@ type
RealADEventBkgColor: TColor;
ADEventAttrBkgColor: TColor;
ADEventBorderColor: TColor;
FRenderHoliday: String;
// variables from local procedures for better access
dvBmpRecurring: TBitmap;
dvBmpCategory: TBitmap;
@ -100,6 +101,8 @@ type
procedure DrawRowHeaderBackground(R: TRect);
procedure DrawRowHeaderLabels(R: TRect);
procedure DrawRowHeaderTicks(R: TRect);
function FixDateStr(ADate: TDateTime; AFormat, AHoliday: String;
AWidth: Integer): String;
procedure FixFontHeights;
procedure FreeBitmaps;
procedure GetIcons(Event: TVpEvent);
@ -518,6 +521,9 @@ begin
RenderCanvas.Brush.Color := HighlightBkg;
RenderCanvas.Font.Color := HighlightText;
end else
if (FRenderHoliday <> '') then
RenderCanvas.Brush.Color := FDayview.TimeSlotColors.Holiday
else
if IsWeekend(ColDate) then
{ weekend color }
RenderCanvas.Brush.Color := FDayView.TimeSlotColors.Weekend
@ -527,7 +533,7 @@ begin
If it is, then paint inactive rows the color corresponding to inactive
and the active rows the color corresponding to Active Rows. }
if FDayView.TimeSlotColors.ActiveRange.RangeBegin = FDayView.TimeSlotColors.ActiveRange.RangeEnd then
{ There is not active range --> Paint all time slots in the weekday color }
{ There is no active range --> Paint all time slots in the weekday color }
RenderCanvas.Brush.Color := FDayView.TimeSlotColors.Weekday
else begin
{ There is an active range defined, so we need to see if the current
@ -633,9 +639,9 @@ procedure TVpDayViewPainter.DrawColHeader(R: TRect; ARenderDate: TDateTime;
Col: Integer);
var
SaveFont: TFont;
DateStr, ResStr: string;
DateStr, DateOnlyStr, ResStr: string;
DateStrLen, ResStrLen: integer;
StrHt: Integer;
DateStrHt: Integer;
TextRect: TRect;
X, Y: Integer;
tmpRect: TRect;
@ -663,14 +669,10 @@ begin
TextRect.Right := TextRect.Right - 3;
TextRect.Left := TextRect.Left + 2;
{ Fix Date String }
DateStr := FormatDateTime(FDayView.DateLabelFormat, ARenderDate);
{ Fix date string for best usage of the available width }
DateStr := FixDateStr(ARenderDate, FDayView.DateLabelFormat, FRenderHoliday, WidthOf(TextRect));
DateStrLen := RenderCanvas.TextWidth(DateStr);
StrHt := RenderCanvas.TextHeight(DateStr);
if DateStrLen > TextRect.Right - TextRect.Left then begin
DateStr := GetDisplayString(RenderCanvas, DateStr, 0, TextRect.Right - TextRect.Left);
DateStrLen := RenderCanvas.TextWidth(DateStr);
end;
DateStrHt := RenderCanvas.TextHeight(DateStr);
if (FDayView.DataStore <> nil) and (FDayView.DataStore.Resource <> nil)
and FDayView.ShowResourceName
@ -690,7 +692,7 @@ begin
end;
{ center the date string }
X := TextRect.Left + (TextRect.Right - TextRect.Left) div 2 - DateStrLen div 2;
Y := TextRect.Top + (TextMargin * 2) + StrHt;
Y := TextRect.Top + (TextMargin * 2) + DateStrHt;
end else begin
{ center the date string }
Y := TextRect.Top + TextMargin;
@ -1291,6 +1293,9 @@ begin
DrawMe := False
end;
if DrawMe then begin
{ Check if the currently rendered day is a holiday and store its name }
FDayView.IsHoliday(RenderDate + i, FRenderHoliday);
{ Calculate Column Header rectangle }
ColHeadRect := Rect(RPos, RealTop + 2, RPos + DayWidth - 1, RealTop + RealColHeadHeight);
if (i = RealNumDays - 1) and (ExtraSpace > 0) then
@ -1554,6 +1559,39 @@ begin
inc(Result, RenderCanvas.TextWidth('33'));
end;
function TVpDayViewPainter.FixDateStr(ADate: TDateTime; AFormat, AHoliday: String;
AWidth: Integer): String;
begin
// Check long date format with holiday name
if AHoliday <> '' then begin
Result := Format('%s - %s', [FormatDateTime(AFormat, ADate), AHoliday]);
if RenderCanvas.TextWidth(Result) <= AWidth then
exit;
// Check short date format with holiday name
if AFormat <> 'ddddd' then begin
Result := Format('%s - %s', [FormatDateTime('ddddd', ADate), AHoliday]);
if RenderCanvas.TextWidth(Result) <= AWidth then
exit;
end;
end;
// Check long date format without holiday name
Result := FormatDateTime(AFormat, ADate);
if RenderCanvas.TextWidth(Result) <= AWidth then
exit;
// Check short date format without holiday name
if AFormat <> 'ddddd' then begin
Result := FormatDateTime('ddddd', ADate);
if RenderCanvas.TextWidth(Result) <= AWidth then
exit;
end;
// Chop off the short-date-format string and add '...'
Result := GetDisplayString(RenderCanvas, Result, 0, AWidth);
end;
procedure TVpDayViewPainter.FixFontHeights;
begin
with FDayView do begin
@ -1782,22 +1820,21 @@ begin
StartLine := FDayView.TopLine;
if VisibleLines < LineCount then
ScrollbarOffset := GetSystemMetrics(SM_CYHSCROLL);
// ScrollbarOffset := 14;
end;
Rgn := CreateRectRgn(RenderIn.Left, RenderIn.Top, RenderIn.Right, RenderIn.Bottom);
try
SelectClipRgn(RenderCanvas.Handle, Rgn);
// Calculate the RealNumDays (The number of days the control covers)
RealNumDays := TVpDayViewOpener(FDayView).GetRealNumDays(RenderDate);
// Calculate row and column header
RealRowHeight := TVpDayViewOpener(FDayView).dvCalcRowHeight(Scale, UseGran);
RealRowHeadWidth := CalcRowHeadWidth;
RealColHeadHeight := TVpDayViewOpener(FDayView).dvCalcColHeadHeight(Scale);
// RowHeadRect and RealVisibleLines are calculated below...
// Calculate the RealNumDays (The number of days the control covers)
RealNumDays := TVpDayViewOpener(FDayView).GetRealNumDays(RenderDate);
// Draw the all-day events
DrawAllDayEvents;

85
components/tvplanit/source/vpmonthview.pas
View File

@ -74,6 +74,20 @@ type
property Color: TColor read FColor write SetColor;
end;
TVpMvHolidayAttr = class(TVpMonthViewAttr)
public
constructor Create(AOwner: TVpMonthView);
published
property Color default HOLIDAY_COLOR;
end;
TVpMvWeekendAttr = class(TVpMonthViewAttr)
public
constructor Create(AOwner: TVpMonthView);
published
property Color default WEEKEND_COLOR;
end;
(*
TVpMvHeadAttr = class(TPersistent)
protected{ private }
@ -117,29 +131,14 @@ type
published
property BorderPen: TPen read FBorderPen write SetBorderPen;
end;
(*
TVpMvHolidayAttr = class(TPersistent)
protected
FMonthView: TVpMonthView;
FFont: TVpFont;
FColor: TColor;
procedure SetColor(Value: TColor);
procedure SetFont(Value: TVpFont);
public
constructor Create(AOwner: TVpMonthView);
destructor Destroy; override;
property MonthView: TVpMonthView read FMonthView;
published
property Color: TColor read FColor write SetColor;
property Font: TVpFont read FFont write FFont;
end;
*)
{ TVpMonthView }
TVpMonthView = class(TVpLinkableControl)
private
FHintMode: TVpHintMode;
FOnHoliday: TVpHolidayEvent;
protected{ private }
FKBNavigate: Boolean;
FColumnWidth: Integer;
@ -159,15 +158,9 @@ type
FTopLine: Integer;
FDayHeadAttr: TVpMonthViewAttr;
FHeadAttr: TVpMonthViewAttr;
FHolidayAttr: TVpMonthViewAttr;
FTodayAttr: TVpMvTodayAttr;
FWeekendAttr: TVpMonthViewAttr;
{
FDayHeadAttr: TVpDayHeadAttr;
FHeadAttr: TVpMvHeadAttr;
FHolidayAttr: TVpMvHolidayAttr;
FTodayAttr: TVpMvTodayAttr; }
FTodayAttr: TVpMvTodayAttr;
FWeekendAttr: TVpMvWeekendAttr;
FDayNumberFont: TVpFont;
FEventFont: TVpFont;
FTimeFormat: TVpTimeFormat;
@ -182,7 +175,6 @@ type
FOwnerDrawCells: TVpOwnerDrawDayEvent;
FOnEventClick: TVpOnEventClick;
FOnEventDblClick: TVpOnEventClick;
FOnHoliday: TVpHolidayEvent;
{ internal variables }
mvLoaded: Boolean;
@ -297,13 +289,10 @@ type
property EventFont: TVpFont read FEventFont write SetEventFont;
// property HeadAttributes: TVpMvHeadAttr read FHeadAttr write FHeadAttr;
property HeadAttributes: TVpMonthViewAttr read FHeadAttr write FHeadAttr;
property HolidayAttributes: TVpMonthViewAttr read FHolidayAttr write FHolidayAttr;
// property HolidayAttributes: TVpMvHolidayAttr read FHolidayAttr write FHolidayAttr;
property HolidayAttributes: TVpMvHolidayAttr read FHolidayAttr write FHolidayAttr;
property HintMode: TVpHintMode read FHintMode write FHintMode default hmPlannerHint;
property LineColor: TColor read FLineColor write SetLineColor;
property TimeFormat: TVpTimeFormat read FTimeFormat write SetTimeFormat;
property TodayAttributes: TVpMvTodayAttr read FTodayAttr write FTodayAttr;
property OffDayColor: TColor read FOffDayColor write SetOffDayColor;
property LineColor: TColor read FLineColor write SetLineColor default clGray;
property OffDayColor: TColor read FOffDayColor write SetOffDayColor default OFF_COLOR;
property OffDayFontColor: TColor read FOffDayFontColor write SetOffDayFontColor default clGray;
property OwnerDrawCells: TVpOwnerDrawDayEvent read FOwnerDrawCells write FOwnerDrawCells;
property RightClickChangeDate: Boolean
@ -311,7 +300,9 @@ type
property SelectedDayColor: TColor read FSelectedDayColor write SetSelectedDayColor;
property ShowEvents: Boolean read FShowEvents write SetShowEvents;
property ShowEventTime: Boolean read FShowEventTime write SetShowEventTime;
property WeekendAttributes: TVpMonthViewAttr read FWeekendAttr write FWeekendAttr;
property TimeFormat: TVpTimeFormat read FTimeFormat write SetTimeFormat;
property TodayAttributes: TVpMvTodayAttr read FTodayAttr write FTodayAttr;
property WeekendAttributes: TVpMvWeekendAttr read FWeekendAttr write FWeekendAttr;
property WeekStartsOn: TVpDayType read FWeekStartsOn write SetWeekStartsOn;
{events}
property OnEventClick: TVpOnEventClick read FOnEventClick write FOnEventClick;
@ -360,6 +351,26 @@ begin
end;
(*****************************************************************************)
{ TVpMvHolidayAttr }
(*****************************************************************************)
constructor TVpMvHolidayAttr.Create(AOwner: TVpMonthView);
begin
inherited Create(AOwner);
FColor := HOLIDAY_COLOR;
end;
(*****************************************************************************)
{ TVpMvWeekendAttr }
(*****************************************************************************)
constructor TVpMvWeekendAttr.Create(AOwner: TVpMonthView);
begin
inherited Create(AOwner);
FColor := WEEKEND_COLOR;
end;
(*****************************************************************************)
{ TVpMvTodayAttr }
(*****************************************************************************)
@ -398,8 +409,8 @@ begin
{ Create internal classes and stuff }
FHeadAttr := TVpMonthViewAttr.Create(self);
FDayHeadAttr := TVpMonthViewAttr.Create(self);
FHolidayAttr := TVpMonthViewAttr.Create(self);
FWeekendAttr := TVpMonthviewAttr.Create(self);
FHolidayAttr := TVpMvHolidayAttr.Create(self);
FWeekendAttr := TVpMvWeekendAttr.Create(self);
FTodayAttr := TVpMvTodayAttr.Create(Self);
mvSpinButtons := TUpDown.Create(self);
{
@ -428,7 +439,6 @@ begin
FDrawingStyle := ds3d;
// mvPainting := false;
FColor := clWindow;
FOffDayColor := clSilver;
FLineColor := clGray;
FDate := Trunc(Now);
FTimeFormat := tf12Hour;
@ -454,11 +464,8 @@ begin
FOffDayColor := OFF_COLOR;
FHolidayAttr.Font.Assign(FDayNumberFont);
FHolidayAttr.Font.Color := clBlack;
FHolidayAttr.Color := HOLIDAY_COLOR;
FWeekendAttr.Font.Assign(FHolidayAttr.Font);
FWeekendAttr.Color := WEEKEND_COLOR;
SetLength(mvEventArray, MaxVisibleEvents);
SetLength(mvMonthdayArray, 45);

13
components/tvplanit/source/vpweekview.pas
View File

@ -121,6 +121,7 @@ type
FHintMode: TVpHintMode;
FMouseEvent: TVpEvent;
FHintWindow: THintWindow;
FOnHoliday: TVpHolidayEvent;
procedure SetActiveEvent(AValue: TVpEvent);
protected{ private }
FActiveDate: TDateTime;
@ -247,6 +248,7 @@ type
procedure DeleteActiveEvent(Verify: Boolean);
procedure DragDrop(Source: TObject; X, Y: Integer); override;
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;
@ -289,6 +291,7 @@ type
property AfterEdit : TVpAfterEditEvent read FAfterEdit write FAfterEdit;
property BeforeEdit: TVpBeforeEditEvent read FBeforeEdit write FBeforeEdit;
property OnAddEvent: TVpOnAddNewEvent read FOnAddEvent write FOnAddEvent;
property OnHoliday: TVpHolidayEvent read FOnHoliday write FOnHoliday;
property OnOwnerEditEvent: TVpEditEvent read FOwnerEditEvent write FOwnerEditEvent;
end;
@ -612,7 +615,14 @@ 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);
@ -628,7 +638,6 @@ begin
wvInLinkHandler := false;
end;
end;
{=====}
procedure TVpWeekView.wvHookUp;
var