From 6eda0b879b4bf26baf1f1ea828259f2aa100e1aa Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 5 Sep 2022 15:14:18 +0000 Subject: [PATCH] tvplanit: Refactor TVpCalendar. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8450 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/tvplanit/source/vpcalendar.pas | 410 +++++++++--------- .../tvplanit/source/vpcalendarpainter.pas | 111 +++-- 2 files changed, 244 insertions(+), 277 deletions(-) diff --git a/components/tvplanit/source/vpcalendar.pas b/components/tvplanit/source/vpcalendar.pas index 097b350b3..88e792d17 100644 --- a/components/tvplanit/source/vpcalendar.pas +++ b/components/tvplanit/source/vpcalendar.pas @@ -52,7 +52,7 @@ type TVpCalDisplayOptions = set of TVpCalDisplayOption; - TVpCalColorArray = array[0..6] of TColor; + TVpCalColorArray = array[0..9] of TColor; TVpCalColorScheme = (cscalCustom, cscalClassic, cscalWindows, cscalGold, cscalOcean, cscalRose); @@ -63,47 +63,41 @@ type TColArray = array[0..6] of Integer; const - {ActiveDay, DayNames, Days, InactiveDays, MonthAndYear, Weekend} - CalScheme : TVpCalSchemeArray = - ((0, 0, 0, 0, 0, 0, 0), - (clHighlight, clWindow, clWindow, clWindow, clWindow, clWindow, clBlack), - (clRed, clMaroon, clBlack, clGray, clBlue, clRed, clBlack), - (clBlack, clBlack, clYellow, clGray, clBlack, clTeal, clBlack), - (clBlack, clBlack, clAqua, clGray, clBlack, clNavy, clBlack), - (clRed, clRed, clFuchsia, clGray, clBlue, clTeal, clBlack) - ); + {ActiveDay, DayNames, Days, InactiveDays, MonthAndYear, Weekend, EventDays, ActiveDayBorder, ActiveDayText} + CalScheme : TVpCalSchemeArray = ( + // Active BG DayNames Days Inact.Days Month/Year Weekend Event Background Active border Active text + (0, 0, 0, 0, 0, 0, 0, 0, 0, 0), + (clWindow, clWindowText, clWindowText, clSilver, clWindowText, clRed, clWindowText, clWindow, clWindowText, clWindowText), // classic + (clBlue, clMaroon, clBlack, clMedGray, clBlue, clRed, clBlack, clDefault, clBlack, clWhite), // windows + (clMaroon, clBlack, clYellow, clSilver, clBlack, $7777FF, clWhite, clOlive, clBlack, clYellow), // gold + (clBlue, clSilver, clAqua, clBlue, clSilver, clRed, clWhite, clNavy, clNavy, clWhite), // ocean + ($007500EA, clBlack, clFuchsia, clMedGray, clBlack, clRed, clMaroon, $00D9B3FF, clMaroon, clWhite) // rose + ); calDefWeekStarts = dtSunday; { default start of the week } type TVpCalColors = class(TPersistent) - protected {private} - {property variables} - FUpdating : Boolean; - FOnChange : TNotifyEvent; - - {internal variables} - SettingScheme : Boolean; - - {property methods} + private + FUpdating: Boolean; + FOnChange: TNotifyEvent; + SettingScheme: Boolean; function GetColor(Index: Integer): TColor; procedure SetColor(Index: Integer; Value: TColor); procedure SetColorScheme(Value: TVpCalColorScheme); - - {internal methods} + protected procedure DoOnChange; - public - {public property variables} FCalColors: TVpCalColorArray; FColorScheme: TVpCalColorScheme; - procedure Assign(Source : TPersistent); override; + procedure Assign(Source: TPersistent); override; procedure BeginUpdate; procedure EndUpdate; - - property OnChange : TNotifyEvent read FOnChange write FOnChange; - + property OnChange: TNotifyEvent read FOnChange write FOnChange; published property ActiveDay: TColor index 0 read GetColor write SetColor; + property ActiveDayBorder: TColor index 8 read GetColor write SetColor; + property ActiveDayText: TColor index 9 read GetColor write SetColor; + property Background: TColor index 7 read GetColor write SetColor; property ColorScheme: TVpCalColorScheme read FColorScheme write SetColorScheme; property DayNames: TColor index 1 read GetColor write SetColor; property Days: TColor index 2 read GetColor write SetColor; @@ -121,8 +115,9 @@ type TVpCustomCalendar = class(TVpLinkableControl) protected {private} - {property variables} + {$IFNDEF LCL} FBorderStyle : TBorderStyle; + {$ENDIF} FBrowsing : Boolean; FColors : TVpCalColors; FOptions : TVpCalDisplayOptions; @@ -176,7 +171,10 @@ type function GetDay: Integer; function GetMonth: Integer; function GetYear: Integer; + {$IFNDEF LCL} procedure SetBorderStyle(Value: TBorderStyle); reintroduce; + {$ENDIF} + procedure SetColor(Value: TColor); override; procedure SetDate(Value: TDateTime); procedure SetDateFormat(Value: TVpDateFormat); procedure SetDayNameWidth(Value: TVpDayNameWidth); @@ -268,9 +266,10 @@ type property Browsing : Boolean read FBrowsing; property Canvas; + property CurrentRectangle: TRect read calGetCurrentRectangle; property Day: Integer read GetDay; - property Month : Integer read GetMonth; - property Year : Integer read GetYear; + property Month: Integer read GetMonth; + property Year: Integer read GetYear; {properties} property Align; @@ -278,24 +277,24 @@ type {$IFDEF LCL} property BorderSpacing; {$ENDIF} - property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone; + property BorderStyle default bsNone; //: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone; property Color; property Colors: TVpCalColors read FColors write FColors; property Date: TDateTime read FDate write SetDate; property DateFormat: TVpDateFormat read FDateFormat write SetDateFormat default dfLong; - property DayNameWidth: TVpDayNameWidth read FDayNameWidth write SetDayNameWidth; + property DayNameWidth: TVpDayNameWidth read FDayNameWidth write SetDayNameWidth default 3; property Options: TVpCalDisplayOptions read FOptions write SetDisplayOptions default [cdoHighlightSat, cdoHighlightSun, cdoShortNames, cdoShowNavBtns, cdoShowRevert, cdoShowToday, cdoShowYear]; - property ReadOnly: Boolean read FReadOnly write FReadOnly; - property WantDblClicks: Boolean read FWantDblClicks write SetWantDblClicks; - property WeekStarts: TVpDayType read FWeekStarts write SetWeekStarts; + property ReadOnly: Boolean read FReadOnly write FReadOnly default false; + property WantDblClicks: Boolean read FWantDblClicks write SetWantDblClicks default true; + property WeekStarts: TVpDayType read FWeekStarts write SetWeekStarts default dtSunday; {events} property OnChange: TDateChangeEvent read FOnChange write FOnChange; - property OnDrawDate : TCalendarDateEvent read FOnDrawDate write FOnDrawDate; - property OnDrawItem : TCalendarDateEvent read FOnDrawItem write FOnDrawItem; - property OnGetDateEnabled : TGetDateEnabledEvent read FOnGetDateEnabled write FOnGetDateEnabled; - property OnGetHighlight : TGetHighlightEvent read FOnGetHighlight write FOnGetHighlight; + property OnDrawDate: TCalendarDateEvent read FOnDrawDate write FOnDrawDate; + property OnDrawItem: TCalendarDateEvent read FOnDrawItem write FOnDrawItem; + property OnGetDateEnabled: TGetDateEnabledEvent read FOnGetDateEnabled write FOnGetDateEnabled; + property OnGetHighlight: TGetHighlightEvent read FOnGetHighlight write FOnGetHighlight; end; TVpCalendar = class(TVpCustomCalendar) @@ -385,7 +384,6 @@ begin end else inherited Assign(Source); end; -{=====} procedure TVpCalColors.BeginUpdate; begin @@ -397,7 +395,6 @@ begin FUpdating := False; DoOnChange; end; -{=====} procedure TVpCalColors.DoOnChange; begin @@ -407,13 +404,11 @@ begin if not SettingScheme then FColorScheme := cscalCustom; end; -{=====} function TVpCalColors.GetColor(Index: Integer) : TColor; begin Result := FCalColors[Index]; end; -{=====} procedure TVpCalColors.SetColor(Index: Integer; Value: TColor); begin @@ -422,7 +417,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpCalColors.SetColorScheme(Value: TVpCalColorScheme); begin @@ -439,10 +433,143 @@ begin end; end; end; -{=====} -{*** TVpCustomCalendar ***} +(******************************************************************************) +{ TVpCustomCalendar } +(******************************************************************************) +constructor TVpCustomCalendar.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + {$IFDEF LCL} + ControlStyle := ControlStyle + [csClickEvents] - [csCaptureMouse]; + {$ELSE} + ControlStyle := ControlStyle + [csClickEvents, csFramed] - [csCaptureMouse]; + {$ENDIF} + + Height := 140; + TabStop := True; + Width := 200; + + calMargin := ScaleX(CAL_MARGIN, DesignTimeDPI); + + {$IFNDEF LCL} + Font.Name := 'MS Sans Serif'; + Font.Size := 8; + {$ENDIF} + + BorderStyle := bsNone; + FDayNameWidth := 3; + FDateFormat := dfLong; + FOptions := [cdoShortNames, cdoShowYear, cdoShowRevert, cdoShowToday, + cdoShowNavBtns, cdoHighlightSun, cdoHighlightSat]; + FWantDblClicks := True; + FWeekStarts := dtSunday; + FLastRenderX := 0; + FLastRenderY := 0; + + clInLinkHandler := false; + + {create navigation buttons} + clBtnLeft := TSpeedButton.Create(Self); + clBtnLeft.Parent := Self; + {$IFDEF NEW_ICONS} + LoadGlyphFromRCDATA(clBtnLeft.Glyph, 'VpLArrow', 16, 24, 32); + {$ELSE} + clBtnLeft.Glyph.LoadFromResourceName(HINSTANCE,'VPLEFTARROW'); //soner geändert: clBtnLeft.Glyph.Handle := LoadBaseBitmap('VPLEFTARROW'); + {$ENDIF} + clBtnLeft.OnClick := calBtnClick; + clBtnLeft.Hint := RSPrevMonth; + clBtnLeft.ShowHint := True; + + clBtnRight := TSpeedButton.Create(Self); + clBtnRight.Parent := Self; + {$IFDEF NEW_ICONS} + LoadGlyphFromRCDATA(clBtnRight.Glyph, 'VpRArrow', 16, 24, 32); + {$ELSE} + clBtnRight.Glyph.LoadFromResourceName(HINSTANCE,'VPRIGHTARROW'); //soner geändert: clBtnRight.Glyph.Handle := LoadBaseBitmap('VPRIGHTARROW'); + {$ENDIF} + clBtnRight.OnClick := calBtnClick; + clBtnRight.Hint := RSNextMonth; + clBtnRight.ShowHint := True; + + clBtnNextYear := TSpeedButton.Create(Self); + clBtnNextYear.Parent := Self; + {$IFDEF NEW_ICONS} + LoadGlyphFromRCDATA(clBtnNextYear.Glyph, 'VpRArrows', 16, 24, 32); + {$ELSE} + clBtnNextYear.Glyph.LoadFromResourceName(HINSTANCE,'VPRIGHTARROWS'); //soner geöndert: clBtnNextYear.Glyph.Handle := LoadBaseBitmap('VPRIGHTARROWS'); + {$ENDIF} + clBtnNextYear.OnClick := calBtnClick; + clBtnNextYear.Hint := RSNextYear; + clBtnNextYear.ShowHint := True; + + clBtnPrevYear := TSpeedButton.Create(Self); + clBtnPrevYear.Parent := Self; + {$IFDEF NEW_ICONS} + LoadGlyphFromRCData(clBtnPrevYear.Glyph, 'VpLArrows', 16, 24, 32); + {$ELSE} + clBtnPrevYear.Glyph.LoadFromResourceName(HINSTANCE,'VPLEFTARROWS'); //soner geöndert: clBtnPrevYear.Glyph.Handle := LoadBaseBitmap('VPLEFTARROWS'); + {$ENDIF} + clBtnPrevYear.OnClick := calBtnClick; + clBtnPrevYear.Hint := RSPrevYear; + clBtnPrevYear.ShowHint := True; + + {create "revert" button} + clBtnRevert := TSpeedButton.Create(Self); + clBtnRevert.Parent := Self; + {$IFDEF NEW_ICONS} + LoadGlyphFromRCData(clBtnRevert.Glyph, 'VpRevert', 16, 24, 32); + {$ELSE} + clBtnRevert.Glyph.LoadFromResourceName(HINSTANCE,'VPREVERT'); //soner geändert: clBtnRevert.Glyph.Handle := LoadBaseBitmap('VPREVERT'); + {$ENDIF} + clBtnRevert.OnClick := calBtnClick; + clBtnRevert.Hint := RSCalendarRevert; + clBtnRevert.ShowHint := True; + + {create "today" button} + clBtnToday := TSpeedButton.Create(Self); + clBtnToday.Parent := Self; + {$IFDEF NEW_ICONS} + LoadGlyphFromRCData(clBtnToday.Glyph, 'VpToday', 16, 24, 32); + {$ELSE} + clBtnToday.Glyph.LoadFromResourceName(HINSTANCE,'VPTODAY'); //soner geändert: clBtnToday.Glyph.Handle := LoadBaseBitmap('VPTODAY'); + {$ENDIF} + clBtnToday.OnClick := calBtnClick; + clBtnToday.Hint := RSToday; + clBtnToday.ShowHint := True; + + // Assign default color scheme + FColors := TVpCalColors.Create; + FColors.OnChange := calColorChange; + FColors.FCalColors := CalScheme[cscalWindows]; + + // Assign default international support object + FDrawHeader := True; + clRowCount := 8; + clStartRow := 0; + + FDefaultPopup := TPopupMenu.Create (Self); + InitializeDefaultPopup; +end; + +constructor TVpCustomCalendar.CreateEx(AOwner: TComponent; AsPopup: Boolean); +begin + clPopup := AsPopup; + Create(AOwner); +end; + +destructor TVpCustomCalendar.Destroy; +begin + FColors.Free; + FColors := nil; + + FDefaultPopup.Free; + + inherited Destroy; +end; + procedure TVpCustomCalendar.calBtnClick(Sender: TObject); var Key: Word; @@ -470,7 +597,6 @@ begin KeyDown(Key, [ssCtrl]); end; end; -{=====} procedure TVpCustomCalendar.calChangeMonth(Sender: TObject); var @@ -500,21 +626,19 @@ procedure TVpCustomCalendar.calColorChange(Sender: TObject); begin Invalidate; end; -{=====} +{ Get bounding rectangle for the current date} function TVpCustomCalendar.calGetCurrentRectangle: TRect; - {-get bounding rectangle for the current date} var Idx : Integer; R, C: Integer; begin - {index into the month grid} + // Index into the month grid Idx := clFirst + Pred(clDay) + 13; R := (Idx div 7); C := (Idx mod 7); Result := clRowCol[R,C]; end; -{=====} function TVpCustomCalendar.calGetValidDate(ADate: TDateTime; Delta: Integer): TDateTime; @@ -545,7 +669,6 @@ begin else raise(EVpCalendarError.Create(RSInvalidDate)); end; -{=====} procedure TVpCustomCalendar.calRebuildCalArray(ADate: TDateTime); var @@ -587,7 +710,6 @@ begin Inc(J); end; end; -{=====} procedure TVpCustomCalendar.CalculateSizes(WorkCanvas: TCanvas; Angle: TVpRotationAngle; Rect: TRect; out Row: TRowArray; out Col: TColArray; @@ -671,8 +793,8 @@ begin end; end; +{ Calculate new sizes for rows and columns } procedure TVpCustomCalendar.calRecalcSize(DisplayOnly: Boolean); - {-calcualte new sizes for rows and columns} var Row: TRowArray; Col: TColArray; @@ -743,7 +865,6 @@ begin clBtnRevert.Top := ClientHeight - calMargin - clBtnRevert.Height + 1; clBtnRevert.Left := clBtnToday.Left - clBtnRevert.Width - calMargin; end; -{=====} procedure TVpCustomCalendar.CMEnter(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); var @@ -757,7 +878,6 @@ begin R := calGetCurrentRectangle; InvalidateRect(Handle, @R, False); end; -{=====} procedure TVpCustomCalendar.CMExit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); var @@ -781,128 +901,7 @@ begin calRecalcSize(False); Invalidate; end; -{=====} -constructor TVpCustomCalendar.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - - ControlStyle := ControlStyle + [csClickEvents, csFramed] - [csCaptureMouse]; - - Height := 140; - TabStop := True; - Width := 200; - - calMargin := ScaleX(CAL_MARGIN, DesignTimeDPI); - - {$IFNDEF LCL} - Font.Name := 'MS Sans Serif'; - Font.Size := 8; - {$ENDIF} - - FBorderStyle := bsNone; - FDayNameWidth := 3; - FDateFormat := dfLong; - FOptions := [cdoShortNames, cdoShowYear, cdoShowRevert, cdoShowToday, - cdoShowNavBtns, cdoHighlightSun, cdoHighlightSat]; - FWantDblClicks := True; - FWeekStarts := dtSunday; - FLastRenderX := 0; - FLastRenderY := 0; - - clInLinkHandler := false; - - {create navigation buttons} - clBtnLeft := TSpeedButton.Create(Self); - clBtnLeft.Parent := Self; - {$IFDEF NEW_ICONS} - LoadGlyphFromRCDATA(clBtnLeft.Glyph, 'VpLArrow', 16, 24, 32); - {$ELSE} - clBtnLeft.Glyph.LoadFromResourceName(HINSTANCE,'VPLEFTARROW'); //soner geändert: clBtnLeft.Glyph.Handle := LoadBaseBitmap('VPLEFTARROW'); - {$ENDIF} - clBtnLeft.OnClick := calBtnClick; - clBtnLeft.Hint := RSPrevMonth; - clBtnLeft.ShowHint := True; - - clBtnRight := TSpeedButton.Create(Self); - clBtnRight.Parent := Self; - {$IFDEF NEW_ICONS} - LoadGlyphFromRCDATA(clBtnRight.Glyph, 'VpRArrow', 16, 24, 32); - {$ELSE} - clBtnRight.Glyph.LoadFromResourceName(HINSTANCE,'VPRIGHTARROW'); //soner geändert: clBtnRight.Glyph.Handle := LoadBaseBitmap('VPRIGHTARROW'); - {$ENDIF} - clBtnRight.OnClick := calBtnClick; - clBtnRight.Hint := RSNextMonth; - clBtnRight.ShowHint := True; - - clBtnNextYear := TSpeedButton.Create(Self); - clBtnNextYear.Parent := Self; - {$IFDEF NEW_ICONS} - LoadGlyphFromRCDATA(clBtnNextYear.Glyph, 'VpRArrows', 16, 24, 32); - {$ELSE} - clBtnNextYear.Glyph.LoadFromResourceName(HINSTANCE,'VPRIGHTARROWS'); //soner geöndert: clBtnNextYear.Glyph.Handle := LoadBaseBitmap('VPRIGHTARROWS'); - {$ENDIF} - clBtnNextYear.OnClick := calBtnClick; - clBtnNextYear.Hint := RSNextYear; - clBtnNextYear.ShowHint := True; - - clBtnPrevYear := TSpeedButton.Create(Self); - clBtnPrevYear.Parent := Self; - {$IFDEF NEW_ICONS} - LoadGlyphFromRCData(clBtnPrevYear.Glyph, 'VpLArrows', 16, 24, 32); - {$ELSE} - clBtnPrevYear.Glyph.LoadFromResourceName(HINSTANCE,'VPLEFTARROWS'); //soner geöndert: clBtnPrevYear.Glyph.Handle := LoadBaseBitmap('VPLEFTARROWS'); - {$ENDIF} - clBtnPrevYear.OnClick := calBtnClick; - clBtnPrevYear.Hint := RSPrevYear; - clBtnPrevYear.ShowHint := True; - - {create "revert" button} - clBtnRevert := TSpeedButton.Create(Self); - clBtnRevert.Parent := Self; - {$IFDEF NEW_ICONS} - LoadGlyphFromRCData(clBtnRevert.Glyph, 'VpRevert', 16, 24, 32); - {$ELSE} - clBtnRevert.Glyph.LoadFromResourceName(HINSTANCE,'VPREVERT'); //soner geändert: clBtnRevert.Glyph.Handle := LoadBaseBitmap('VPREVERT'); - {$ENDIF} - clBtnRevert.OnClick := calBtnClick; - clBtnRevert.Hint := RSCalendarRevert; - clBtnRevert.ShowHint := True; - - {create "today" button} - clBtnToday := TSpeedButton.Create(Self); - clBtnToday.Parent := Self; - {$IFDEF NEW_ICONS} - LoadGlyphFromRCData(clBtnToday.Glyph, 'VpToday', 16, 24, 32); - {$ELSE} - clBtnToday.Glyph.LoadFromResourceName(HINSTANCE,'VPTODAY'); //soner geändert: clBtnToday.Glyph.Handle := LoadBaseBitmap('VPTODAY'); - {$ENDIF} - clBtnToday.OnClick := calBtnClick; - clBtnToday.Hint := RSToday; - clBtnToday.ShowHint := True; - - {assign default color scheme} - FColors := TVpCalColors.Create; - FColors.OnChange := calColorChange; - FColors.FCalColors := CalScheme[cscalWindows]; - - {assign default international support object} - - FDrawHeader:= True; - clRowCount := 8; - clStartRow := 0; - - FDefaultPopup := TPopupMenu.Create (Self); - InitializeDefaultPopup; -end; -{=====} - -constructor TVpCustomCalendar.CreateEx(AOwner: TComponent; AsPopup: Boolean); -begin - clPopup := AsPopup; - Create(AOwner); -end; -{=====} procedure TVpCustomCalendar.CreateParams(var Params: TCreateParams); {$IFNDEF LCL} @@ -919,7 +918,7 @@ begin end; end; {$ENDIF} - if NewStyleControls and ({Ctl3D or }clPopup) and (FBorderStyle = bsSingle) then begin + if NewStyleControls and ({Ctl3D or }clPopup) and (BorderStyle = bsSingle) then begin if not clPopup then Params.Style := Params.Style and not WS_BORDER; Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE; @@ -943,18 +942,6 @@ begin if FDate = 0 then SetDate(calGetValidDate(SysUtils.Date-1, +1)); end; -{=====} - -destructor TVpCustomCalendar.Destroy; -begin - FColors.Free; - FColors := nil; - - FDefaultPopup.Free; - - inherited Destroy; -end; -{=====} procedure TVpCustomCalendar.DoOnChange(Value: TDateTime); begin @@ -1028,7 +1015,7 @@ var PopupPoint: TPoint; begin - inherited KeyDown(Key, Shift); +// inherited KeyDown(Key, Shift); if IsReadOnly then Exit; @@ -1118,8 +1105,13 @@ begin PopupPoint := GetClientOrigin; FDefaultPopup.Popup (PopupPoint.x + 10, PopupPoint.y + 10); end; + + else + inherited; end; + Key := 0; + if HD <> FDate then begin FBrowsing := True; try @@ -1498,23 +1490,28 @@ begin end; end; +{$IFNDEF LCL} procedure TVpCustomCalendar.SetBorderStyle(Value: TBorderStyle); begin if Value <> FBorderStyle then begin FBorderStyle := Value; - RecreateWnd(Self); { *Converted from RecreateWnd* } + Invalidate; end; end; -{=====} +{$ENDIF} + +procedure TVpCustomCalendar.SetColor(Value: TColor); +begin + Colors.Background := Value; +end; procedure TVpCustomCalendar.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); begin inherited SetBounds(ALeft, ATop, AWidth, AHeight); if csLoading in ComponentState then Exit; - calRecalcSize (False); + calRecalcSize(False); end; -{=====} procedure TVpCustomCalendar.SetDate(Value: TDateTime); var @@ -1545,7 +1542,6 @@ begin ControlLink.Notify(self, neDateChange, Date); end; end; -{=====} procedure TVpCustomCalendar.SetDateFormat(Value: TVpDateFormat); begin @@ -1554,7 +1550,6 @@ begin Invalidate; end; end; -{=====} procedure TVpCustomCalendar.SetDayNameWidth(Value: TVpDayNameWidth); begin @@ -1563,7 +1558,6 @@ begin Invalidate; end; end; -{=====} procedure TVpCustomCalendar.SetDisplayOptions(Value: TVpCalDisplayOptions); begin @@ -1594,10 +1588,9 @@ begin Invalidate; end; end; -{=====} +{ Set the DrawHeader property value } procedure TVpCustomCalendar.SetDrawHeader(Value: Boolean); - {-set the DrawHeader property value} begin if Value <> FDrawHeader then begin FDrawHeader := Value; @@ -1612,14 +1605,12 @@ begin Refresh; end; end; -{=====} +{ Set the calendar to todays date } procedure TVpCustomCalendar.SetToday; - {-set the calendar to todays date} begin Date := Now; end; -{=====} procedure TVpCustomCalendar.SetWantDblClicks(Value: Boolean); begin @@ -1628,7 +1619,6 @@ begin RecreateWnd(Self); { *Converted from RecreateWnd* } end; end; -{=====} procedure TVpCustomCalendar.SetWeekStarts(Value: TVpDayType); begin @@ -1640,33 +1630,28 @@ begin Invalidate; end; end; -{=====} {$IFDEF DELPHI} procedure TVpCustomCalendar.WMEraseBkgnd(var Msg: TWMEraseBkgnd); begin Msg.Result := 1; {don't erase background, just say we did. Shhhhhhh!} end; -{=====} procedure TVpCustomCalendar.WMGetDlgCode(var Msg: TWMGetDlgCode); begin Msg.Result := DLGC_WANTARROWS; end; -{=====} procedure TVpCustomCalendar.WMKillFocus(var Msg: TWMKillFocus); begin inherited; Invalidate; end; -{=====} {$ELSE} procedure TVpCustomCalendar.WMEraseBkgnd(var Msg: TLMEraseBkgnd); begin Msg.Result := 1; {don't erase background, just say we did. Shhhhhhh!} end; -{=====} { procedure TVpCustomCalendar.WMGetDlgCode(var Msg: TLMGetDlgCode); begin @@ -1679,7 +1664,6 @@ begin inherited; Invalidate; end; -{=====} {$ENDIF} procedure TVpCustomCalendar.InitializeDefaultPopup; @@ -1721,36 +1705,30 @@ begin FDefaultPopup.Items.Add (NewItem); end; end; -{=====} procedure TVpCustomCalendar.PopupToday(Sender: TObject); begin SetDate (Now); end; -{=====} procedure TVpCustomCalendar.PopupNextMonth(Sender: TObject); begin IncMonth (1); end; -{=====} procedure TVpCustomCalendar.PopupPrevMonth(Sender: TObject); begin IncMonth (-1); end; -{=====} procedure TVpCustomCalendar.PopupNextYear(Sender: TObject); begin IncYear (1); end; -{=====} procedure TVpCustomCalendar.PopupPrevYear(Sender: TObject); begin IncYear (-1); end; -{=====} end. diff --git a/components/tvplanit/source/vpcalendarpainter.pas b/components/tvplanit/source/vpcalendarpainter.pas index 800af84ec..00e710dba 100644 --- a/components/tvplanit/source/vpcalendarpainter.pas +++ b/components/tvplanit/source/vpcalendarpainter.pas @@ -5,7 +5,7 @@ unit VpCalendarPainter; interface uses - SysUtils, Classes, Graphics, + SysUtils, Classes, Graphics, Controls, VpBase, VpMisc, VpBasePainter, VpCalendar; type @@ -13,8 +13,6 @@ type private FCalendar: TVpCustomCalendar; // local variables of the old RenderToCanvas method of TVpCalendar -// R, C: Integer; -// I: Integer; SatCol: Integer; SunCol: Integer; DOW: TVpDayType; @@ -23,6 +21,9 @@ type lDate: TDateTime; BevelHighlight: TColor; BevelShadow: TColor; + ActiveDayColor: TColor; + ActiveDayBorderColor: TColor; + ActiveDayTextColor: TColor; InactiveDayColor: TColor; MonthYearColor: TColor; DayNameColor: TColor; @@ -53,7 +54,7 @@ type implementation uses - LCLProc, LazUtf8, + LCLProc, LCLIntf, LazUtf8, {%H-}VpConst, VpCanvasUtils; type @@ -66,6 +67,9 @@ begin FCalendar := ACalendar; end; +{ Draws the day numbers in the calendar. Colors are used to distinguish + normal days, weekend days, event days, inactive days (= overflow from adjacent + months). } procedure TVpCalendarPainter.DrawAllDays; var I, R, C: Integer; @@ -74,7 +78,7 @@ begin for R := 2 to 8 do for C := 0 to 6 do begin if ((C = SatCol) and (cdoHighlightSat in FCalendar.Options)) or - ((C = SunCol) and (cdoHighlightSun in Fcalendar.Options)) + ((C = SunCol) and (cdoHighlightSun in FCalendar.Options)) then RenderCanvas.Font.Color := WeekendColor else @@ -108,12 +112,14 @@ begin end else RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold, fsUnderline]; end; + with TVpCalendarOpener(FCalendar) do DrawDay(R, C, I, (I < clFirst) or (I > clLast)); Inc(I); end; end; +{ Draws the title "month year" between the navigation buttons } procedure TVpCalendarPainter.DrawDate; var R: TRect; @@ -141,9 +147,9 @@ begin else S := FormatDateTime('mmm', RenderDate); - // switch to short date format if string won't fit + // Switch to short date format if string won't fit if FCalendar.DateFormat = dfLong then - if RenderCanvas.TextWidth(S) > R.Right - R.Left then + if RenderCanvas.TextWidth(S) > WidthOf(R) then S := FormatDateTime('mmm yyyy', RenderDate); {$IF FPC_FULLVERSION < 30000} @@ -159,14 +165,15 @@ end; procedure TVpCalendarPainter.DrawDay(R, C, I: Integer; Grayed: Boolean); var - Cl: TColor; + clr: TColor; + day: Byte; OldIdx: Integer; NewIdx: Integer; S: string[10]; DrawRect: TRect; TH: Integer; begin - {avoid painting day number under buttons} + // Avoid painting day number under buttons if cdoShowRevert in FCalendar.Options then if (R = 8) and (C >= 3) then Exit; @@ -175,19 +182,23 @@ begin Exit; {convert to a string and draw it centered in its rectangle} - S := IntToStr(TVpCalendarOpener(FCalendar).clCalendar[I]); + day := TVpCalendarOpener(FCalendar).clCalendar[I]; + S := IntToStr(day); if Grayed then - RenderCanvas.Font.Color := InactiveDayColor; + RenderCanvas.Font.Color := InactiveDayColor + else + if (day = FCalendar.Day) then + RenderCanvas.Font.Color := ActiveDayTextColor; if not Grayed or (cdoShowInactive in FCalendar.Options) then begin NewIdx := ((R-2) * 7) + Succ(C); with TVpCalendarOpener(FCalendar) do OldIdx := clFirst + Pred(clDay); if Assigned(FCalendar.OnGetHighlight) then begin - Cl := RenderCanvas.Font.Color; - FCalendar.OnGetHighlight(Self, RenderDate + NewIdx - OldIdx , Cl); - RenderCanvas.Font.Color := Cl; + clr := RenderCanvas.Font.Color; + FCalendar.OnGetHighlight(Self, RenderDate + NewIdx - OldIdx , clr); + RenderCanvas.Font.Color := clr; end; with TVpCalendarOpener(FCalendar) do if Assigned(OnDrawItem) then @@ -198,19 +209,19 @@ begin OffsetRect(DrawRect, RealLeft, RealTop); TH := RenderCanvas.TextHeight(S); if TH < DrawRect.Bottom - DrawRect.Top then - DrawRect.Top := DrawRect.Top + ((DrawRect.Bottom - DrawRect.Top) - TH) div 2; + DrawRect.Top := (DrawRect.Top + DrawRect.Bottom - TH) div 2; TPSCenteredTextOut(RenderCanvas, Angle, RenderIn, DrawRect, S); end; end; end; +{ Draw the day name column labels } procedure TVpCalendarPainter.DrawDayNames; var I: Integer; S: string; DrawRect: TRect; begin - {draw the day name column labels} RenderCanvas.Font.Color := DayNameColor; I := 0; DOW := FCalendar.WeekStarts; @@ -262,6 +273,7 @@ begin if DisplayOnly then begin BevelHighlight := clBlack; BevelShadow := clBlack; + ActiveDayColor := clBlack; InactiveDayColor := clSilver; MonthYearColor := clBlack; DayNameColor := clBlack; @@ -273,56 +285,29 @@ begin end else begin BevelHighlight := clBtnHighlight; BevelShadow := clBtnShadow; + ActiveDayColor := FCalendar.Colors.ActiveDay; + ActiveDayBorderColor := FCalendar.Colors.ActiveDayBorder; + ActiveDayTextColor := FCalendar.Colors.ActiveDayText; InactiveDayColor := FCalendar.Colors.InactiveDays; MonthYearColor := FCalendar.Colors.MonthAndYear; DayNameColor := FCalendar.Colors.DayNames; LineColor := FCalendar.Font.Color; EventDayColor := FCalendar.Colors.EventDays; DayColor := FCalendar.Colors.Days; - RealColor := FCalendar.Color; + RealColor := FCalendar.Colors.Background; WeekendColor := FCalendar.Colors.WeekEnd; end; end; +{ Draws a box around the selected day } procedure TVpCalendarPainter.DrawFocusBox; var R: TRect; - S: string[10]; begin - S := IntToStr(TVpCalendarOpener(FCalendar).clDay); - - { set highlight color and font style for days with events } - RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold]; - lBadDate := false; - - if (FCalendar.DataStore <> nil) and (FCalendar.DataStore.Resource <> nil) then begin - DecodeDate(RenderDate, Y, M, D); - try - {$IFDEF VERSION6} - if not TryEncodeDate (Y, M, TVpCalendarOpener(FCalendar).clDay, lDate) then - lBadDate := true; - {$ELSE} - lDate := EncodeDate(Y, M, TVpCalendarOpener(FCalendar).clDay); - {$ENDIF} - except - lBadDate := true; - end; - - if (not lBadDate) and (FCalendar.DataStore.Resource.Schedule.EventCountByDay(lDate) > 0) - then begin - RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsBold, fsUnderline]; - RenderCanvas.Font.Color := EventDayColor; - end else - RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold, fsUnderline]; - end; - - R := TVpCalendarOpener(FCalendar).calGetCurrentRectangle; - R.Left := R.Left + RealLeft; - R.Top := R.Top + RealTop; - R.Right := R.Right + RealLeft; - R.Bottom := R.Bottom + RealTop; - + R := FCalendar.CurrentRectangle; + OffsetRect(R, RealLeft, RealTop); R := TPSRotateRectangle (Angle, RenderIn, R); + if not DisplayOnly then begin {$IFNDEF LCL} if Focused then @@ -331,11 +316,13 @@ begin DrawButtonFace (RenderCanvas, R, 1, bsNew, True, False, False); {$ENDIF} R := TVpCalendarOpener(FCalendar).calGetCurrentRectangle; - R.Left := R.Left + RealLeft; - R.Top := R.Top + RealTop; - R.Right := R.Right + RealLeft; - R.Bottom := R.Bottom + RealTop; - TPSCenteredTextOut (RenderCanvas, Angle, RenderIn, R, S); + InflateRect(R, -1, -1); + OffsetRect(R, RealLeft, RealTop); + + RenderCanvas.Pen.Color := ActiveDayBorderColor; + RenderCanvas.Brush.Color := ActiveDayColor; + RenderCanvas.Pen.Width := 1; + TPSRectangle(RenderCanvas, Angle, RenderIn, R); end; end; @@ -395,23 +382,25 @@ begin RenderCanvas.Brush.Color := RealColor; RenderCanvas.FillRect(RenderIn); - {draw the month and year at the top of the calendar} + // Draw the month and year at the top of the calendar DrawDate; - {draw the days of the week} + // Draw the days of the week DrawDayNames; - {draw line under day names} + // Draw line under day names DrawLine; - {draw each day} - DrawAllDays; + // Draw each day +// DrawAllDays; RenderCanvas.Font.Color := DayColor; if not Assigned(FCalendar.OnDrawItem) then if not (cdoHideActive in FCalendar.Options) then DrawFocusBox; + DrawAllDays; + finally RenderCanvas.Unlock; end;