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

tvplanit: Refactor TVpCalendar.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8450 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-09-05 15:14:18 +00:00
parent eb439247e1
commit 6eda0b879b
2 changed files with 244 additions and 277 deletions
Download Patch File Download Diff File Expand all files Collapse all files

410
components/tvplanit/source/vpcalendar.pas
View File

@ -52,7 +52,7 @@ type
TVpCalDisplayOptions = set of TVpCalDisplayOption; TVpCalDisplayOptions = set of TVpCalDisplayOption;
TVpCalColorArray = array[0..6] of TColor; TVpCalColorArray = array[0..9] of TColor;
TVpCalColorScheme = (cscalCustom, cscalClassic, cscalWindows, TVpCalColorScheme = (cscalCustom, cscalClassic, cscalWindows,
cscalGold, cscalOcean, cscalRose); cscalGold, cscalOcean, cscalRose);
@ -63,47 +63,41 @@ type
TColArray = array[0..6] of Integer; TColArray = array[0..6] of Integer;
const const
{ActiveDay, DayNames, Days, InactiveDays, MonthAndYear, Weekend} {ActiveDay, DayNames, Days, InactiveDays, MonthAndYear, Weekend, EventDays, ActiveDayBorder, ActiveDayText}
CalScheme : TVpCalSchemeArray = CalScheme : TVpCalSchemeArray = (
((0, 0, 0, 0, 0, 0, 0), // Active BG DayNames Days Inact.Days Month/Year Weekend Event Background Active border Active text
(clHighlight, clWindow, clWindow, clWindow, clWindow, clWindow, clBlack), (0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(clRed, clMaroon, clBlack, clGray, clBlue, clRed, clBlack), (clWindow, clWindowText, clWindowText, clSilver, clWindowText, clRed, clWindowText, clWindow, clWindowText, clWindowText), // classic
(clBlack, clBlack, clYellow, clGray, clBlack, clTeal, clBlack), (clBlue, clMaroon, clBlack, clMedGray, clBlue, clRed, clBlack, clDefault, clBlack, clWhite), // windows
(clBlack, clBlack, clAqua, clGray, clBlack, clNavy, clBlack), (clMaroon, clBlack, clYellow, clSilver, clBlack, $7777FF, clWhite, clOlive, clBlack, clYellow), // gold
(clRed, clRed, clFuchsia, clGray, clBlue, clTeal, clBlack) (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 } calDefWeekStarts = dtSunday; { default start of the week }
type type
TVpCalColors = class(TPersistent) TVpCalColors = class(TPersistent)
protected {private} private
{property variables} FUpdating: Boolean;
FUpdating : Boolean; FOnChange: TNotifyEvent;
FOnChange : TNotifyEvent; SettingScheme: Boolean;
{internal variables}
SettingScheme : Boolean;
{property methods}
function GetColor(Index: Integer): TColor; function GetColor(Index: Integer): TColor;
procedure SetColor(Index: Integer; Value: TColor); procedure SetColor(Index: Integer; Value: TColor);
procedure SetColorScheme(Value: TVpCalColorScheme); procedure SetColorScheme(Value: TVpCalColorScheme);
protected
{internal methods}
procedure DoOnChange; procedure DoOnChange;
public public
{public property variables}
FCalColors: TVpCalColorArray; FCalColors: TVpCalColorArray;
FColorScheme: TVpCalColorScheme; FColorScheme: TVpCalColorScheme;
procedure Assign(Source : TPersistent); override; procedure Assign(Source: TPersistent); override;
procedure BeginUpdate; procedure BeginUpdate;
procedure EndUpdate; procedure EndUpdate;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChange : TNotifyEvent read FOnChange write FOnChange;
published published
property ActiveDay: TColor index 0 read GetColor write SetColor; 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 ColorScheme: TVpCalColorScheme read FColorScheme write SetColorScheme;
property DayNames: TColor index 1 read GetColor write SetColor; property DayNames: TColor index 1 read GetColor write SetColor;
property Days: TColor index 2 read GetColor write SetColor; property Days: TColor index 2 read GetColor write SetColor;
@ -121,8 +115,9 @@ type
TVpCustomCalendar = class(TVpLinkableControl) TVpCustomCalendar = class(TVpLinkableControl)
protected {private} protected {private}
{property variables} {$IFNDEF LCL}
FBorderStyle : TBorderStyle; FBorderStyle : TBorderStyle;
{$ENDIF}
FBrowsing : Boolean; FBrowsing : Boolean;
FColors : TVpCalColors; FColors : TVpCalColors;
FOptions : TVpCalDisplayOptions; FOptions : TVpCalDisplayOptions;
@ -176,7 +171,10 @@ type
function GetDay: Integer; function GetDay: Integer;
function GetMonth: Integer; function GetMonth: Integer;
function GetYear: Integer; function GetYear: Integer;
{$IFNDEF LCL}
procedure SetBorderStyle(Value: TBorderStyle); reintroduce; procedure SetBorderStyle(Value: TBorderStyle); reintroduce;
{$ENDIF}
procedure SetColor(Value: TColor); override;
procedure SetDate(Value: TDateTime); procedure SetDate(Value: TDateTime);
procedure SetDateFormat(Value: TVpDateFormat); procedure SetDateFormat(Value: TVpDateFormat);
procedure SetDayNameWidth(Value: TVpDayNameWidth); procedure SetDayNameWidth(Value: TVpDayNameWidth);
@ -268,9 +266,10 @@ type
property Browsing : Boolean read FBrowsing; property Browsing : Boolean read FBrowsing;
property Canvas; property Canvas;
property CurrentRectangle: TRect read calGetCurrentRectangle;
property Day: Integer read GetDay; property Day: Integer read GetDay;
property Month : Integer read GetMonth; property Month: Integer read GetMonth;
property Year : Integer read GetYear; property Year: Integer read GetYear;
{properties} {properties}
property Align; property Align;
@ -278,24 +277,24 @@ type
{$IFDEF LCL} {$IFDEF LCL}
property BorderSpacing; property BorderSpacing;
{$ENDIF} {$ENDIF}
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone; property BorderStyle default bsNone; //: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
property Color; property Color;
property Colors: TVpCalColors read FColors write FColors; property Colors: TVpCalColors read FColors write FColors;
property Date: TDateTime read FDate write SetDate; property Date: TDateTime read FDate write SetDate;
property DateFormat: TVpDateFormat read FDateFormat write SetDateFormat default dfLong; 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 property Options: TVpCalDisplayOptions read FOptions write SetDisplayOptions
default [cdoHighlightSat, cdoHighlightSun, cdoShortNames, cdoShowNavBtns, cdoShowRevert, cdoShowToday, cdoShowYear]; default [cdoHighlightSat, cdoHighlightSun, cdoShortNames, cdoShowNavBtns, cdoShowRevert, cdoShowToday, cdoShowYear];
property ReadOnly: Boolean read FReadOnly write FReadOnly; property ReadOnly: Boolean read FReadOnly write FReadOnly default false;
property WantDblClicks: Boolean read FWantDblClicks write SetWantDblClicks; property WantDblClicks: Boolean read FWantDblClicks write SetWantDblClicks default true;
property WeekStarts: TVpDayType read FWeekStarts write SetWeekStarts; property WeekStarts: TVpDayType read FWeekStarts write SetWeekStarts default dtSunday;
{events} {events}
property OnChange: TDateChangeEvent read FOnChange write FOnChange; property OnChange: TDateChangeEvent read FOnChange write FOnChange;
property OnDrawDate : TCalendarDateEvent read FOnDrawDate write FOnDrawDate; property OnDrawDate: TCalendarDateEvent read FOnDrawDate write FOnDrawDate;
property OnDrawItem : TCalendarDateEvent read FOnDrawItem write FOnDrawItem; property OnDrawItem: TCalendarDateEvent read FOnDrawItem write FOnDrawItem;
property OnGetDateEnabled : TGetDateEnabledEvent read FOnGetDateEnabled write FOnGetDateEnabled; property OnGetDateEnabled: TGetDateEnabledEvent read FOnGetDateEnabled write FOnGetDateEnabled;
property OnGetHighlight : TGetHighlightEvent read FOnGetHighlight write FOnGetHighlight; property OnGetHighlight: TGetHighlightEvent read FOnGetHighlight write FOnGetHighlight;
end; end;
TVpCalendar = class(TVpCustomCalendar) TVpCalendar = class(TVpCustomCalendar)
@ -385,7 +384,6 @@ begin
end else end else
inherited Assign(Source); inherited Assign(Source);
end; end;
{=====}
procedure TVpCalColors.BeginUpdate; procedure TVpCalColors.BeginUpdate;
begin begin
@ -397,7 +395,6 @@ begin
FUpdating := False; FUpdating := False;
DoOnChange; DoOnChange;
end; end;
{=====}
procedure TVpCalColors.DoOnChange; procedure TVpCalColors.DoOnChange;
begin begin
@ -407,13 +404,11 @@ begin
if not SettingScheme then if not SettingScheme then
FColorScheme := cscalCustom; FColorScheme := cscalCustom;
end; end;
{=====}
function TVpCalColors.GetColor(Index: Integer) : TColor; function TVpCalColors.GetColor(Index: Integer) : TColor;
begin begin
Result := FCalColors[Index]; Result := FCalColors[Index];
end; end;
{=====}
procedure TVpCalColors.SetColor(Index: Integer; Value: TColor); procedure TVpCalColors.SetColor(Index: Integer; Value: TColor);
begin begin
@ -422,7 +417,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpCalColors.SetColorScheme(Value: TVpCalColorScheme); procedure TVpCalColors.SetColorScheme(Value: TVpCalColorScheme);
begin begin
@ -439,10 +433,143 @@ begin
end; end;
end; 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); procedure TVpCustomCalendar.calBtnClick(Sender: TObject);
var var
Key: Word; Key: Word;
@ -470,7 +597,6 @@ begin
KeyDown(Key, [ssCtrl]); KeyDown(Key, [ssCtrl]);
end; end;
end; end;
{=====}
procedure TVpCustomCalendar.calChangeMonth(Sender: TObject); procedure TVpCustomCalendar.calChangeMonth(Sender: TObject);
var var
@ -500,21 +626,19 @@ procedure TVpCustomCalendar.calColorChange(Sender: TObject);
begin begin
Invalidate; Invalidate;
end; end;
{=====}
{ Get bounding rectangle for the current date}
function TVpCustomCalendar.calGetCurrentRectangle: TRect; function TVpCustomCalendar.calGetCurrentRectangle: TRect;
{-get bounding rectangle for the current date}
var var
Idx : Integer; Idx : Integer;
R, C: Integer; R, C: Integer;
begin begin
{index into the month grid} // Index into the month grid
Idx := clFirst + Pred(clDay) + 13; Idx := clFirst + Pred(clDay) + 13;
R := (Idx div 7); R := (Idx div 7);
C := (Idx mod 7); C := (Idx mod 7);
Result := clRowCol[R,C]; Result := clRowCol[R,C];
end; end;
{=====}
function TVpCustomCalendar.calGetValidDate(ADate: TDateTime; function TVpCustomCalendar.calGetValidDate(ADate: TDateTime;
Delta: Integer): TDateTime; Delta: Integer): TDateTime;
@ -545,7 +669,6 @@ begin
else else
raise(EVpCalendarError.Create(RSInvalidDate)); raise(EVpCalendarError.Create(RSInvalidDate));
end; end;
{=====}
procedure TVpCustomCalendar.calRebuildCalArray(ADate: TDateTime); procedure TVpCustomCalendar.calRebuildCalArray(ADate: TDateTime);
var var
@ -587,7 +710,6 @@ begin
Inc(J); Inc(J);
end; end;
end; end;
{=====}
procedure TVpCustomCalendar.CalculateSizes(WorkCanvas: TCanvas; procedure TVpCustomCalendar.CalculateSizes(WorkCanvas: TCanvas;
Angle: TVpRotationAngle; Rect: TRect; out Row: TRowArray; out Col: TColArray; Angle: TVpRotationAngle; Rect: TRect; out Row: TRowArray; out Col: TColArray;
@ -671,8 +793,8 @@ begin
end; end;
end; end;
{ Calculate new sizes for rows and columns }
procedure TVpCustomCalendar.calRecalcSize(DisplayOnly: Boolean); procedure TVpCustomCalendar.calRecalcSize(DisplayOnly: Boolean);
{-calcualte new sizes for rows and columns}
var var
Row: TRowArray; Row: TRowArray;
Col: TColArray; Col: TColArray;
@ -743,7 +865,6 @@ begin
clBtnRevert.Top := ClientHeight - calMargin - clBtnRevert.Height + 1; clBtnRevert.Top := ClientHeight - calMargin - clBtnRevert.Height + 1;
clBtnRevert.Left := clBtnToday.Left - clBtnRevert.Width - calMargin; clBtnRevert.Left := clBtnToday.Left - clBtnRevert.Width - calMargin;
end; end;
{=====}
procedure TVpCustomCalendar.CMEnter(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); procedure TVpCustomCalendar.CMEnter(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF});
var var
@ -757,7 +878,6 @@ begin
R := calGetCurrentRectangle; R := calGetCurrentRectangle;
InvalidateRect(Handle, @R, False); InvalidateRect(Handle, @R, False);
end; end;
{=====}
procedure TVpCustomCalendar.CMExit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); procedure TVpCustomCalendar.CMExit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF});
var var
@ -781,128 +901,7 @@ begin
calRecalcSize(False); calRecalcSize(False);
Invalidate; Invalidate;
end; 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); procedure TVpCustomCalendar.CreateParams(var Params: TCreateParams);
{$IFNDEF LCL} {$IFNDEF LCL}
@ -919,7 +918,7 @@ begin
end; end;
end; end;
{$ENDIF} {$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 if not clPopup then
Params.Style := Params.Style and not WS_BORDER; Params.Style := Params.Style and not WS_BORDER;
Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE; Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
@ -943,18 +942,6 @@ begin
if FDate = 0 then if FDate = 0 then
SetDate(calGetValidDate(SysUtils.Date-1, +1)); SetDate(calGetValidDate(SysUtils.Date-1, +1));
end; end;
{=====}
destructor TVpCustomCalendar.Destroy;
begin
FColors.Free;
FColors := nil;
FDefaultPopup.Free;
inherited Destroy;
end;
{=====}
procedure TVpCustomCalendar.DoOnChange(Value: TDateTime); procedure TVpCustomCalendar.DoOnChange(Value: TDateTime);
begin begin
@ -1028,7 +1015,7 @@ var
PopupPoint: TPoint; PopupPoint: TPoint;
begin begin
inherited KeyDown(Key, Shift); // inherited KeyDown(Key, Shift);
if IsReadOnly then if IsReadOnly then
Exit; Exit;
@ -1118,8 +1105,13 @@ begin
PopupPoint := GetClientOrigin; PopupPoint := GetClientOrigin;
FDefaultPopup.Popup (PopupPoint.x + 10, PopupPoint.y + 10); FDefaultPopup.Popup (PopupPoint.x + 10, PopupPoint.y + 10);
end; end;
else
inherited;
end; end;
Key := 0;
if HD <> FDate then begin if HD <> FDate then begin
FBrowsing := True; FBrowsing := True;
try try
@ -1498,23 +1490,28 @@ begin
end; end;
end; end;
{$IFNDEF LCL}
procedure TVpCustomCalendar.SetBorderStyle(Value: TBorderStyle); procedure TVpCustomCalendar.SetBorderStyle(Value: TBorderStyle);
begin begin
if Value <> FBorderStyle then begin if Value <> FBorderStyle then begin
FBorderStyle := Value; FBorderStyle := Value;
RecreateWnd(Self); { *Converted from RecreateWnd* } Invalidate;
end; end;
end; end;
{=====} {$ENDIF}
procedure TVpCustomCalendar.SetColor(Value: TColor);
begin
Colors.Background := Value;
end;
procedure TVpCustomCalendar.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); procedure TVpCustomCalendar.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight); inherited SetBounds(ALeft, ATop, AWidth, AHeight);
if csLoading in ComponentState then if csLoading in ComponentState then
Exit; Exit;
calRecalcSize (False); calRecalcSize(False);
end; end;
{=====}
procedure TVpCustomCalendar.SetDate(Value: TDateTime); procedure TVpCustomCalendar.SetDate(Value: TDateTime);
var var
@ -1545,7 +1542,6 @@ begin
ControlLink.Notify(self, neDateChange, Date); ControlLink.Notify(self, neDateChange, Date);
end; end;
end; end;
{=====}
procedure TVpCustomCalendar.SetDateFormat(Value: TVpDateFormat); procedure TVpCustomCalendar.SetDateFormat(Value: TVpDateFormat);
begin begin
@ -1554,7 +1550,6 @@ begin
Invalidate; Invalidate;
end; end;
end; end;
{=====}
procedure TVpCustomCalendar.SetDayNameWidth(Value: TVpDayNameWidth); procedure TVpCustomCalendar.SetDayNameWidth(Value: TVpDayNameWidth);
begin begin
@ -1563,7 +1558,6 @@ begin
Invalidate; Invalidate;
end; end;
end; end;
{=====}
procedure TVpCustomCalendar.SetDisplayOptions(Value: TVpCalDisplayOptions); procedure TVpCustomCalendar.SetDisplayOptions(Value: TVpCalDisplayOptions);
begin begin
@ -1594,10 +1588,9 @@ begin
Invalidate; Invalidate;
end; end;
end; end;
{=====}
{ Set the DrawHeader property value }
procedure TVpCustomCalendar.SetDrawHeader(Value: Boolean); procedure TVpCustomCalendar.SetDrawHeader(Value: Boolean);
{-set the DrawHeader property value}
begin begin
if Value <> FDrawHeader then begin if Value <> FDrawHeader then begin
FDrawHeader := Value; FDrawHeader := Value;
@ -1612,14 +1605,12 @@ begin
Refresh; Refresh;
end; end;
end; end;
{=====}
{ Set the calendar to todays date }
procedure TVpCustomCalendar.SetToday; procedure TVpCustomCalendar.SetToday;
{-set the calendar to todays date}
begin begin
Date := Now; Date := Now;
end; end;
{=====}
procedure TVpCustomCalendar.SetWantDblClicks(Value: Boolean); procedure TVpCustomCalendar.SetWantDblClicks(Value: Boolean);
begin begin
@ -1628,7 +1619,6 @@ begin
RecreateWnd(Self); { *Converted from RecreateWnd* } RecreateWnd(Self); { *Converted from RecreateWnd* }
end; end;
end; end;
{=====}
procedure TVpCustomCalendar.SetWeekStarts(Value: TVpDayType); procedure TVpCustomCalendar.SetWeekStarts(Value: TVpDayType);
begin begin
@ -1640,33 +1630,28 @@ begin
Invalidate; Invalidate;
end; end;
end; end;
{=====}
{$IFDEF DELPHI} {$IFDEF DELPHI}
procedure TVpCustomCalendar.WMEraseBkgnd(var Msg: TWMEraseBkgnd); procedure TVpCustomCalendar.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin begin
Msg.Result := 1; {don't erase background, just say we did. Shhhhhhh!} Msg.Result := 1; {don't erase background, just say we did. Shhhhhhh!}
end; end;
{=====}
procedure TVpCustomCalendar.WMGetDlgCode(var Msg: TWMGetDlgCode); procedure TVpCustomCalendar.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin begin
Msg.Result := DLGC_WANTARROWS; Msg.Result := DLGC_WANTARROWS;
end; end;
{=====}
procedure TVpCustomCalendar.WMKillFocus(var Msg: TWMKillFocus); procedure TVpCustomCalendar.WMKillFocus(var Msg: TWMKillFocus);
begin begin
inherited; inherited;
Invalidate; Invalidate;
end; end;
{=====}
{$ELSE} {$ELSE}
procedure TVpCustomCalendar.WMEraseBkgnd(var Msg: TLMEraseBkgnd); procedure TVpCustomCalendar.WMEraseBkgnd(var Msg: TLMEraseBkgnd);
begin begin
Msg.Result := 1; {don't erase background, just say we did. Shhhhhhh!} Msg.Result := 1; {don't erase background, just say we did. Shhhhhhh!}
end; end;
{=====}
{ {
procedure TVpCustomCalendar.WMGetDlgCode(var Msg: TLMGetDlgCode); procedure TVpCustomCalendar.WMGetDlgCode(var Msg: TLMGetDlgCode);
begin begin
@ -1679,7 +1664,6 @@ begin
inherited; inherited;
Invalidate; Invalidate;
end; end;
{=====}
{$ENDIF} {$ENDIF}
procedure TVpCustomCalendar.InitializeDefaultPopup; procedure TVpCustomCalendar.InitializeDefaultPopup;
@ -1721,36 +1705,30 @@ begin
FDefaultPopup.Items.Add (NewItem); FDefaultPopup.Items.Add (NewItem);
end; end;
end; end;
{=====}
procedure TVpCustomCalendar.PopupToday(Sender: TObject); procedure TVpCustomCalendar.PopupToday(Sender: TObject);
begin begin
SetDate (Now); SetDate (Now);
end; end;
{=====}
procedure TVpCustomCalendar.PopupNextMonth(Sender: TObject); procedure TVpCustomCalendar.PopupNextMonth(Sender: TObject);
begin begin
IncMonth (1); IncMonth (1);
end; end;
{=====}
procedure TVpCustomCalendar.PopupPrevMonth(Sender: TObject); procedure TVpCustomCalendar.PopupPrevMonth(Sender: TObject);
begin begin
IncMonth (-1); IncMonth (-1);
end; end;
{=====}
procedure TVpCustomCalendar.PopupNextYear(Sender: TObject); procedure TVpCustomCalendar.PopupNextYear(Sender: TObject);
begin begin
IncYear (1); IncYear (1);
end; end;
{=====}
procedure TVpCustomCalendar.PopupPrevYear(Sender: TObject); procedure TVpCustomCalendar.PopupPrevYear(Sender: TObject);
begin begin
IncYear (-1); IncYear (-1);
end; end;
{=====}
end. end.

111
components/tvplanit/source/vpcalendarpainter.pas
View File

@ -5,7 +5,7 @@ unit VpCalendarPainter;
interface interface
uses uses
SysUtils, Classes, Graphics, SysUtils, Classes, Graphics, Controls,
VpBase, VpMisc, VpBasePainter, VpCalendar; VpBase, VpMisc, VpBasePainter, VpCalendar;
type type
@ -13,8 +13,6 @@ type
private private
FCalendar: TVpCustomCalendar; FCalendar: TVpCustomCalendar;
// local variables of the old RenderToCanvas method of TVpCalendar // local variables of the old RenderToCanvas method of TVpCalendar
// R, C: Integer;
// I: Integer;
SatCol: Integer; SatCol: Integer;
SunCol: Integer; SunCol: Integer;
DOW: TVpDayType; DOW: TVpDayType;
@ -23,6 +21,9 @@ type
lDate: TDateTime; lDate: TDateTime;
BevelHighlight: TColor; BevelHighlight: TColor;
BevelShadow: TColor; BevelShadow: TColor;
ActiveDayColor: TColor;
ActiveDayBorderColor: TColor;
ActiveDayTextColor: TColor;
InactiveDayColor: TColor; InactiveDayColor: TColor;
MonthYearColor: TColor; MonthYearColor: TColor;
DayNameColor: TColor; DayNameColor: TColor;
@ -53,7 +54,7 @@ type
implementation implementation
uses uses
LCLProc, LazUtf8, LCLProc, LCLIntf, LazUtf8,
{%H-}VpConst, VpCanvasUtils; {%H-}VpConst, VpCanvasUtils;
type type
@ -66,6 +67,9 @@ begin
FCalendar := ACalendar; FCalendar := ACalendar;
end; 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; procedure TVpCalendarPainter.DrawAllDays;
var var
I, R, C: Integer; I, R, C: Integer;
@ -74,7 +78,7 @@ begin
for R := 2 to 8 do for R := 2 to 8 do
for C := 0 to 6 do begin for C := 0 to 6 do begin
if ((C = SatCol) and (cdoHighlightSat in FCalendar.Options)) or if ((C = SatCol) and (cdoHighlightSat in FCalendar.Options)) or
((C = SunCol) and (cdoHighlightSun in Fcalendar.Options)) ((C = SunCol) and (cdoHighlightSun in FCalendar.Options))
then then
RenderCanvas.Font.Color := WeekendColor RenderCanvas.Font.Color := WeekendColor
else else
@ -108,12 +112,14 @@ begin
end else end else
RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold, fsUnderline]; RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold, fsUnderline];
end; end;
with TVpCalendarOpener(FCalendar) do with TVpCalendarOpener(FCalendar) do
DrawDay(R, C, I, (I < clFirst) or (I > clLast)); DrawDay(R, C, I, (I < clFirst) or (I > clLast));
Inc(I); Inc(I);
end; end;
end; end;
{ Draws the title "month year" between the navigation buttons }
procedure TVpCalendarPainter.DrawDate; procedure TVpCalendarPainter.DrawDate;
var var
R: TRect; R: TRect;
@ -141,9 +147,9 @@ begin
else else
S := FormatDateTime('mmm', RenderDate); 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 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); S := FormatDateTime('mmm yyyy', RenderDate);
{$IF FPC_FULLVERSION < 30000} {$IF FPC_FULLVERSION < 30000}
@ -159,14 +165,15 @@ end;
procedure TVpCalendarPainter.DrawDay(R, C, I: Integer; Grayed: Boolean); procedure TVpCalendarPainter.DrawDay(R, C, I: Integer; Grayed: Boolean);
var var
Cl: TColor; clr: TColor;
day: Byte;
OldIdx: Integer; OldIdx: Integer;
NewIdx: Integer; NewIdx: Integer;
S: string[10]; S: string[10];
DrawRect: TRect; DrawRect: TRect;
TH: Integer; TH: Integer;
begin begin
{avoid painting day number under buttons} // Avoid painting day number under buttons
if cdoShowRevert in FCalendar.Options then if cdoShowRevert in FCalendar.Options then
if (R = 8) and (C >= 3) then if (R = 8) and (C >= 3) then
Exit; Exit;
@ -175,19 +182,23 @@ begin
Exit; Exit;
{convert to a string and draw it centered in its rectangle} {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 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 if not Grayed or (cdoShowInactive in FCalendar.Options) then begin
NewIdx := ((R-2) * 7) + Succ(C); NewIdx := ((R-2) * 7) + Succ(C);
with TVpCalendarOpener(FCalendar) do with TVpCalendarOpener(FCalendar) do
OldIdx := clFirst + Pred(clDay); OldIdx := clFirst + Pred(clDay);
if Assigned(FCalendar.OnGetHighlight) then begin if Assigned(FCalendar.OnGetHighlight) then begin
Cl := RenderCanvas.Font.Color; clr := RenderCanvas.Font.Color;
FCalendar.OnGetHighlight(Self, RenderDate + NewIdx - OldIdx , Cl); FCalendar.OnGetHighlight(Self, RenderDate + NewIdx - OldIdx , clr);
RenderCanvas.Font.Color := Cl; RenderCanvas.Font.Color := clr;
end; end;
with TVpCalendarOpener(FCalendar) do with TVpCalendarOpener(FCalendar) do
if Assigned(OnDrawItem) then if Assigned(OnDrawItem) then
@ -198,19 +209,19 @@ begin
OffsetRect(DrawRect, RealLeft, RealTop); OffsetRect(DrawRect, RealLeft, RealTop);
TH := RenderCanvas.TextHeight(S); TH := RenderCanvas.TextHeight(S);
if TH < DrawRect.Bottom - DrawRect.Top then 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); TPSCenteredTextOut(RenderCanvas, Angle, RenderIn, DrawRect, S);
end; end;
end; end;
end; end;
{ Draw the day name column labels }
procedure TVpCalendarPainter.DrawDayNames; procedure TVpCalendarPainter.DrawDayNames;
var var
I: Integer; I: Integer;
S: string; S: string;
DrawRect: TRect; DrawRect: TRect;
begin begin
{draw the day name column labels}
RenderCanvas.Font.Color := DayNameColor; RenderCanvas.Font.Color := DayNameColor;
I := 0; I := 0;
DOW := FCalendar.WeekStarts; DOW := FCalendar.WeekStarts;
@ -262,6 +273,7 @@ begin
if DisplayOnly then begin if DisplayOnly then begin
BevelHighlight := clBlack; BevelHighlight := clBlack;
BevelShadow := clBlack; BevelShadow := clBlack;
ActiveDayColor := clBlack;
InactiveDayColor := clSilver; InactiveDayColor := clSilver;
MonthYearColor := clBlack; MonthYearColor := clBlack;
DayNameColor := clBlack; DayNameColor := clBlack;
@ -273,56 +285,29 @@ begin
end else begin end else begin
BevelHighlight := clBtnHighlight; BevelHighlight := clBtnHighlight;
BevelShadow := clBtnShadow; BevelShadow := clBtnShadow;
ActiveDayColor := FCalendar.Colors.ActiveDay;
ActiveDayBorderColor := FCalendar.Colors.ActiveDayBorder;
ActiveDayTextColor := FCalendar.Colors.ActiveDayText;
InactiveDayColor := FCalendar.Colors.InactiveDays; InactiveDayColor := FCalendar.Colors.InactiveDays;
MonthYearColor := FCalendar.Colors.MonthAndYear; MonthYearColor := FCalendar.Colors.MonthAndYear;
DayNameColor := FCalendar.Colors.DayNames; DayNameColor := FCalendar.Colors.DayNames;
LineColor := FCalendar.Font.Color; LineColor := FCalendar.Font.Color;
EventDayColor := FCalendar.Colors.EventDays; EventDayColor := FCalendar.Colors.EventDays;
DayColor := FCalendar.Colors.Days; DayColor := FCalendar.Colors.Days;
RealColor := FCalendar.Color; RealColor := FCalendar.Colors.Background;
WeekendColor := FCalendar.Colors.WeekEnd; WeekendColor := FCalendar.Colors.WeekEnd;
end; end;
end; end;
{ Draws a box around the selected day }
procedure TVpCalendarPainter.DrawFocusBox; procedure TVpCalendarPainter.DrawFocusBox;
var var
R: TRect; R: TRect;
S: string[10];
begin begin
S := IntToStr(TVpCalendarOpener(FCalendar).clDay); R := FCalendar.CurrentRectangle;
OffsetRect(R, RealLeft, RealTop);
{ 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 := TPSRotateRectangle (Angle, RenderIn, R); R := TPSRotateRectangle (Angle, RenderIn, R);
if not DisplayOnly then begin if not DisplayOnly then begin
{$IFNDEF LCL} {$IFNDEF LCL}
if Focused then if Focused then
@ -331,11 +316,13 @@ begin
DrawButtonFace (RenderCanvas, R, 1, bsNew, True, False, False); DrawButtonFace (RenderCanvas, R, 1, bsNew, True, False, False);
{$ENDIF} {$ENDIF}
R := TVpCalendarOpener(FCalendar).calGetCurrentRectangle; R := TVpCalendarOpener(FCalendar).calGetCurrentRectangle;
R.Left := R.Left + RealLeft; InflateRect(R, -1, -1);
R.Top := R.Top + RealTop; OffsetRect(R, RealLeft, RealTop);
R.Right := R.Right + RealLeft;
R.Bottom := R.Bottom + RealTop; RenderCanvas.Pen.Color := ActiveDayBorderColor;
TPSCenteredTextOut (RenderCanvas, Angle, RenderIn, R, S); RenderCanvas.Brush.Color := ActiveDayColor;
RenderCanvas.Pen.Width := 1;
TPSRectangle(RenderCanvas, Angle, RenderIn, R);
end; end;
end; end;
@ -395,23 +382,25 @@ begin
RenderCanvas.Brush.Color := RealColor; RenderCanvas.Brush.Color := RealColor;
RenderCanvas.FillRect(RenderIn); 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; DrawDate;
{draw the days of the week} // Draw the days of the week
DrawDayNames; DrawDayNames;
{draw line under day names} // Draw line under day names
DrawLine; DrawLine;
{draw each day} // Draw each day
DrawAllDays; // DrawAllDays;
RenderCanvas.Font.Color := DayColor; RenderCanvas.Font.Color := DayColor;
if not Assigned(FCalendar.OnDrawItem) then if not Assigned(FCalendar.OnDrawItem) then
if not (cdoHideActive in FCalendar.Options) then if not (cdoHideActive in FCalendar.Options) then
DrawFocusBox; DrawFocusBox;
DrawAllDays;
finally finally
RenderCanvas.Unlock; RenderCanvas.Unlock;
end; end;