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;
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.