Archivado/Componentes.Terceros.jvcl
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
b40ce04eb4
Componentes.Terceros.jvcl/official/3.32/qexamples/JvNavigationPane/QMonthCalendar.pas

845 lines
22 KiB
ObjectPascal
Raw Blame History

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvQMonthCalendar.pas, released on 2003-06-28
The Initial Developer of the Original Code is André Snepvangers [asn@xs4all.nl]
Copyright (C) 2003 André Snepvangers.
All Rights Reserved.
Contributor(s):
Known Issues:
TODO : show today circle
-----------------------------------------------------------------------------}
// $Id: QMonthCalendar.pas 10610 2006-05-19 13:35:08Z elahn $
unit QMonthCalendar;
interface
uses
Classes, SysUtils, QControls, QButtons, QStdCtrls, QExtCtrls,
QGraphics, QTypes, QForms, Qt, Types, DateUtils;
resourcestring
rsNow = 'Today';
type
TDayOfWeekName = (Mon, Tue, Wed, Thu, Fri, Sat, Sun); TDaysOfWeek = set of TDayOfWeekName;
TCustomMonthCalendar = class(TWidgetControl)
private
{ Private declarations }
FCaption : TCaption ;
Bevel1: TBevel;
DayLbl: array[1..42] of TLabel ;
WeekDayLbl : array[1..7] of TLabel;
TodayLbl: TLabel;
TitlePanel: TPanel;
PrevMonthBtn: TBitBtn;
NextMonthBtn: TBitBtn;
WeekLbl: array[1..7] of TLabel;
WeekBevel: TBevel;
FToday : TDateTime ;
FDate : TDateTime ;
FEndDate : TDateTime ;
FMinDate : TDateTime ;
FMaxDate : TDateTime ;
FWeekNumbers : boolean ;
FWidth : integer ;
FHeight : integer ;
FShowToday : boolean ;
FShowTodayCircle : boolean ;
FOnDblClick: TNotifyEvent;
FOnClick: TNotifyEvent;
FTextColor: TColor ;
WeekWidth : integer ;
FirstDay, Lastday : integer ;
FWeekends: TDaysOfWeek;
FWeekendColor: TColor;
FSelectBmp: TBitmap;
FTodayBmp: TBitmap;
FSelectTodayBmp: TBitmap;
procedure PaintBitmap(Bmp: TBitmap; ASize: TSize; TodayCircle: boolean; Selected: boolean);
procedure ReAlign ;
procedure UpdateMonth ;
procedure PaintDays ;
procedure SetDate( aDate : TDateTime ) ;
procedure SetEndDate( aDate : TDateTime ) ;
procedure SetMaxDate( aDate : TDateTime ) ;
procedure SetMinDate( aDate : TDateTime ) ;
procedure SetShowToday( aShow : boolean) ;
procedure SetShowTodayCircle( aShow : boolean) ;
procedure SetWeekNumbers( aShow : boolean) ;
procedure SetMonthBackColor( aColor : TColor );
procedure SetTextColor( aColor : TColor );
procedure SetTitleTextColor( aColor : TColor );
procedure SetTitleBackColor( aColor : TColor );
procedure SetTrailingTextColor( aColor : TColor );
procedure SetFontColor(ALabel: TLabel);
function GetMonthBackColor: TColor ;
function GetTitleTextColor: TColor;
function GetTitleBackColor: TColor ;
function GetTrailingTextColor : TColor ;
procedure PrevMonthBtnClick(Sender: TObject);
procedure NextMonthBtnClick(Sender: TObject);
procedure BtnClick(Sender: TObject);
procedure Label1Click(Sender: TObject);
procedure Label1DblClick(Sender: TObject);
procedure SetDefaultLblProps( aLbl : TLabel ) ;
procedure SetWeekendColor(Value: TColor);
procedure SetWeekends(Value: TDaysOfWeek);
protected
procedure FontChanged ; override ;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure Loaded; override;
procedure SetParent(const aParent: TWidgetControl); override;
property Weekends: TDaysOfWeek read FWeekends write SetWeekends default [Sun];
property WeekendColor: TColor read FWeekendColor write SetWeekendColor default clRed;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy ; override;
procedure SetBounds(ALeft, ATop , AWidth , AHeight : integer); override ;
published
property DateTime : TDateTime read FDate write SetDate ; // selected day
property EndDate : TDateTime read FEndDate write SetEndDate;
property MaxDate : TDateTime read FMaxDate write SetMaxDate;
property MinDate : TDateTime read FMinDate write SetMinDate;
property ShowToday : boolean read FShowToday write SetShowToday default true;
property ShowTodayCircle : boolean read FShowTodayCircle write SetShowTodayCircle default true;
property WeekNumbers : boolean read FWeekNumbers write SetWeekNumbers default false;
property MonthBackColor: TColor read GetMonthBackColor write SetMonthBackColor default clWhite ;
property TextColor: TColor read FTextColor write SetTextColor default clNormalText ;
property TitleBackColor: TColor read GetTitleBackColor write SetTitleBackColor default clHighlight ;
property TitleTextColor: TColor read GetTitleTextColor write SetTitleTextColor default clBrightText ;
property TrailingTextColor: TColor read GetTrailingTextColor write SetTrailingTextColor default clHighlight;
Property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
Property OnClick : TNotifyEvent read FOnClick write FOnClick;
property Top;
property Left;
Property Font;
property Hint;
property Tag;
property ShowHint ;
property Enabled;
property Visible ;
Property OnEnter ;
Property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
Property OnContextPopup;
Property OnDragDrop;
Property OnDragOver;
property OnMouseEnter;
property OnMouseDown;
property OnMouseUp;
property OnMouseMove;
property OnMouseLeave ;
property TabStop;
property TabOrder;
end;
type
TMonthCalendar = class(TCustomMonthCalendar)
public
{ Public declarations }
published
property DateTime;
property EndDate ;
property MaxDate ;
property MinDate ;
property ShowToday ;
property ShowTodayCircle ;
property WeekNumbers;
property MonthBackColor;
property TextColor ;
property TitleBackColor;
property TitleTextColor;
property TrailingTextColor;
Property OnDblClick;
Property OnClick;
property Top;
// property TabStop ;
property Left;
Property Font;
property Hint;
property Tag;
property ShowHint ;
property Enabled;
property Visible ;
Property OnEnter ;
Property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
Property OnContextPopup;
Property OnDragDrop;
Property OnDragOver;
property OnMouseEnter;
property OnMouseDown;
property OnMouseUp;
property OnMouseMove;
property OnMouseLeave ;
property TabStop;
property TabOrder;
end;
implementation
uses
Math;
{$R *.dcr}
procedure TCustomMonthCalendar.SetDefaultLblProps( aLbl : TLabel ) ;
begin
with aLbl do
begin
Parent := self;
// ParentFont := true ;
Alignment := taCenter ;
Anchors := [akRight] ;
Alignment := taCenter ;
Autosize := false;
end;
end;
destructor TCustomMonthCalendar.Destroy;
begin
FSelectBmp.Free;
FTodayBmp.Free;
FSelectTodayBmp.Free;
inherited ;
end;
constructor TCustomMonthCalendar.Create(AOwner : TComponent);
var
i : integer ;
begin
inherited Create(AOwner) ;
ControlStyle := ControlStyle -[csNoFocus, csSetCaption];
Height := 168 ;
Width := 250 ;
Color := clBase ;
FSelectBmp := TBitmap.Create;
FTodayBmp := TBitmap.Create;
FSelectTodayBmp := TBitmap.Create;
FWeekEndColor := clRed;
FWeekEnds := [sun];
{$IFDEF MSWINDOWS}
Font.name := 'Arial';
{$ENDIF MSWINDOWS}
InputKeys := InputKeys + [ikNav, ikArrows];
FCaption := '';
FShowToday := true;
FWeekNumbers := true ;
ToDayLbl := TLabel.Create(self);
with TodayLbl do
begin
Parent := self ;
SetDefaultLblProps( TodayLbl );
AutoSize := true ;
Font.Style := [fsBold] ;
// Font.Size := Font.Size ;
Caption := rsNow + ': ' + FormatDateTime(ShortDateFormat, Today );
OnClick := BtnClick ;
end;
TitlePanel:= TPanel.Create(self);
with TitlePanel do
begin
Parent := self ;
Width := 250 ;
BevelOuter := bvNone;
Font.Color := clBrightText;
// Font.Size := ToDayLbl.Font.Size ;
Font.Style := [fsBold];
Anchors := [akLeft, akRight];
Color := clHighLight ;
Height := 2 * Font.Height ;
OnClick := BtnClick ;
ParentShowHint := false ;
end;
PrevMonthBtn := TBitBtn.Create(self);
with PrevMonthBtn do
begin
Parent := TitlePanel ;
Width := 16 ;
Height := 16 ;
Top := (TitlePanel.Height - Height) div 2 ;
Left := Top ;
Caption := '' ;
Bitmap.LoadFromResourceName(HInstance,'LEFTARROW');
Anchors := [akLeft];
TabStop := false ;
OnClick := PrevMonthBtnClick ;
ParentShowHint := true ;
end;
NextMonthBtn := TBitBtn.Create(self);
with NextMonthBtn do
begin
Parent := TitlePanel ;
Width := PrevMonthBtn.Width ;
Height := PrevMonthBtn.Height ;
Top := PrevMonthBtn.Top ;
Left := TitlePanel.Width - Top -Width;
Caption := '' ;
Bitmap.LoadFromResourceName(HInstance,'RIGHTARROW');
Anchors := [akRight];
OnClick := NextMonthBtnClick ;
TabStop := false ;
ParentShowHint := true ;
end;
For i:= 1 to 42 do
begin
DayLbl[i] := TLabel.Create(self) ;
SetDefaultLblProps(DayLbl[i]);
DayLbl[i].OnClick := Label1Click ;
DayLbl[i].OnDblClick := Label1DblClick ;
ParentShowHint := true ;
end;
For i:=1 to 7 do
begin
WeekDayLbl[i] := TLabel.Create(self) ;
SetDefaultLblProps( WeekDayLbl[i] );
WeekDayLbl[i].Font.Color := clActiveHighLight ;
OnClick := BtnClick ;
end ;
For i:=1 to 6 do
begin
WeekLbl[i] := TLabel.Create(self);
SetDefaultLblProps( WeekLbl[i] );
WeekLbl[i].Font.Color := clActiveHighLight ;
OnClick := BtnClick ;
end ;
Bevel1:= TBevel.Create(self);
Bevel1.Parent := self ;
with Bevel1 do
begin
Left := 28 ;
Top := 46 ;
Width := 214 ;
Height := 2 ;
Anchors := [ akRight];
ParentShowHint := False ;
Shape := bsTopLine ;
ShowHint := False ;
end;
WeekBevel := TBevel.Create(self);
WeekBevel.Parent := self ;
with WeekBevel do
begin
Left := 24 ;
Top := 52 ;
Width := 2 ;
Height := 94 ;
Anchors := [akTop, akRight] ;
Shape := bsLeftLine ;
end ;
FWeekNumbers := false ;
WeekWidth := WeekBevel.Left + 2 ;
FToday := Today ;
FDate := FToday ;
FShowTodayCircle := true;
ToDayLbl.Caption := rsNow + ': ' + FormatDateTime(ShortDateFormat, Today );
PaintDays;
ReAlign;
UpdateMonth ;
end;
procedure TCustomMonthCalendar.Loaded;
begin
inherited Loaded;
// ReAlign;
end;
procedure TCustomMonthCalendar.SetParent(const aParent: TWidgetControl);
begin
inherited;
// ReAlign;
end;
procedure TCustomMonthCalendar.SetBounds(ALeft, ATop , AWidth , AHeight : integer);
begin
// if csdesigning in componentstate then
begin
AWidth := Fwidth;
AHeight := FHeight;
end;
inherited;
end;
procedure TCustomMonthCalendar.FontChanged ;
begin
if not (csCreating in Controlstate)
then
ReAlign ;
end;
procedure TCustomMonthCalendar.PaintBitmap(Bmp: TBitmap; ASize: TSize; TodayCircle: boolean; Selected: boolean);
begin
with Bmp do
begin
Width := ASize.cx ;
Height := ASize.cy ;
with Bmp.Canvas do
begin
Brush.Color := GetMonthBackColor;
Brush.Style := bsSolid;
FillRect(Bounds(0, 0, ASize.cx, ASize.cy));
Brush.Color := GetTitleBackColor;
if Selected then
Brush.Style := bsSolid
else
Brush.Style := bsClear;
Pen.Color := clRed;
Pen.Width := 2;
if TodayCircle then
Pen.Style := psSolid
else
Pen.Style := psClear;
Ellipse(0, 0, ASize.cx, ASize.cy);
end;
end;
end;
procedure TCustomMonthCalendar.ReAlign ; // if font changes
var
i, j: integer ;
oColor: TColor;
Canvas: TControlCanvas;
ASize: TSize;
begin
if csDestroying in ComponentState then exit;
Canvas := TControlCanvas.Create;
Canvas.Control := self;
// oColor := DayLbl[1].Font.Color;
// DayLbl[1].Font := Font;
// DayLbl[1].Font.Color := oColor;
Canvas.Font.Assign(Font);
// with DayLbl[1] do
begin
ASize := Canvas.TextExtent('9999');
end;
Canvas.free;
PaintBitmap(FSelectBmp, ASize, false, true);
PaintBitmap(FTodayBmp, ASize, true, false);
PaintBitmap(FSelectTodayBmp, ASize, true, true);
FWidth := 8 * ASize.cx + 4;
inherited Width := FWidth ;
TitlePanel.Width := FWidth ;
TitlePanel.Font.name := Font.name ;
TitlePanel.Font.size := Font.Size ;
with TitlePanel do
begin
Top := 0 ;
Left := 0 ;
Height := 2 * ASize.cy;
end;
PrevMonthBtn.Top:=1 + (TitlePanel.Height - PrevMonthBtn.Height) div 2 ;
NextMonthBtn.Top:= PrevMonthBtn.Top ;
FHeight := 7 * ASize.cy + TitlePanel.Height + 6 + ToDayLbl.Height ;
inherited Height := FHeight ;
DayLbl[1].Top := TitlePanel.Height + 6 ;
with WeekBevel do
begin
Left := ASize.cx ;
Top := TitlePanel.Height + ASize.cy + 6 ;
Height := 6 * ASize.cy ;
end;
with Bevel1 do
begin
Left := DayLbl[1].Width + 4 ;
Top := TitlePanel.Height + ASize.cy + 2 ;
Width := 13 * ASize.cx ;
end;
oColor := WeekDayLbl[1].Font.Color ;
for i:= 1 to 7 do
begin
WeekDayLbl[i].Font := Font ;
with WeekDayLbl[i] do
begin
Font.Color := oColor ;
Width := ASize.cx ;
Height := ASize.cy ;
Left := WeekBevel.Left + 4 + (i - 1) * Width;
Top := TitlePanel.Height + 2 ;
end;
end;
for j:= 1 to 6 do
begin
oColor := WeekLbl[j].Font.Color;
WeekLbl[j].Font := Font ;
with WeekLbl[j] do
begin
Font.Color := oColor ;
Width := ASize.cx ;
Height := ASize.cy ;
Left := 0 ;
Top := WeekDayLbl[1].Top + j * Height + 4 ;
end;
for i:= 1 to 7 do
begin
with DayLbl[ i + (j-1)* 7] do
begin
oColor := Font.Color;
Font := DayLbl[1].Font;
Font.Color := oColor;
Width := ASize.cx ;
Height := ASize.cy ;
Top := WeekLbl[j].Top ;
Left := WeekBevel.Left + 4 + (i-1) * Width
end;
end;
end;
if ShowToday then
begin
TodayLbl.Font.Name := Font.Name ;
TodayLbl.Font.Height := Font.Height ;
// TodayLbl.Anchors := [akLeft] ;
if FShowTodayCircle then
TodayLbl.Left := ASize.cx + 4
else
TodayLbl.Left := 2 * ASize.cx + 4 ;
TodayLbl.Top := Height - TodayLbl.Height - 1;
end
else
if not FWeekNumbers then
begin
FWidth := FWidth - WeekBevel.Left - 1 ;
inherited Width := FWidth ;
end ;
end;
procedure TCustomMonthCalendar.PaintDays ; // weekdays
var
aDate : TDateTime ;
i : integer ;
begin
aDate := IncDay( FDate , 1 - DayOftheWeek( FDate ) );
for i:=1 to 7 do
begin
with WeekDayLbl[i] do
begin
Caption := FormatDateTime( 'ddd' ,aDate );
end;
aDate := IncDay( aDate ) ;
end;
end;
procedure TCustomMonthCalendar.UpdateMonth; // days of month
var
i,j : integer ;
Days : integer ;
begin
TitlePanel.Caption := FormatDateTime('mmmm yyyy', FDate );
FirstDay := DayOfTheWeek(StartOfTheMonth(FDate));
LastDay := DayOfTheMonth( IncDay( StartOfTheMonth( FDate ), -1 ) ) ;
Days := DaysInMonth( FDate );
for i := pred(FirstDay) downto 1 do
begin
with DayLbl[i] do
begin
Caption := inttostr(LastDay);
Font.Color := TextColor ;
Color := MonthBackColor ;
Enabled := false ;
Bitmap := nil;
dec(LastDay);
end;
end;
j:= WeekOfTheYear( StartOfTheMonth(FDate) ) ;
for i := 1 to 6 do
begin
with WeekLbl[i] do
begin
Caption := inttostr(j);
end;
inc(j) ;
end;
for i:= 1 to Days do
begin
with DayLbl[FirstDay + i -1 ] do
begin
Enabled := true ;
Tag := Floor(StartOfTheMonth(FDate))+ i - 1;
SetFontColor(DayLbl[FirstDay + i -1]) ;
if i = DayOfTheMonth(FDate) then
begin
Font.Color := TitleTextColor;
if FShowTodayCircle and (Tag = Today) then
Bitmap := FSelectTodayBmp
else
Bitmap := FSelectBmp;
invalidate;
end
else
begin
if FShowTodayCircle and (Tag = Today) then
Bitmap := FTodayBmp
else
Bitmap := nil;
end;
Caption := inttostr(i);
end;
end;
j := 1 ;
for i:= FirstDay+Days to 42 do
begin
with DayLbl[i] do
begin
Caption := inttostr(j);
Font.Color := clText ;
Enabled := false ;
Color := MonthBackColor ;
Bitmap := nil;
end;
inc(j) ;
end;
end;
procedure TCustomMonthCalendar.PrevMonthBtnClick(Sender: TObject);
begin
SetFocus;
FDate := IncMonth( FDate , -1 );
if Assigned( FOnClick ) then
FonClick( Sender );
UpdateMonth;
end;
procedure TCustomMonthCalendar.BtnClick(Sender: TObject);
begin
SetFocus;
end;
procedure TCustomMonthCalendar.NextMonthBtnClick(Sender: TObject);
begin
SetFocus;
FDate := IncMonth( FDate );
if Assigned( FOnClick ) then
FonClick( Sender );
UpdateMonth ;
end;
procedure TCustomMonthCalendar.SetWeekNumbers( aShow : boolean) ;
var
i: integer;
begin
for i := 1 to 7 do
WeekDayLbl[i].visible := aShow;
WeekBevel.visible := false;
if AShow <> FWeekNumbers then
begin
FWeekNumbers := aShow ;
ReAlign;
end;
end;
procedure TCustomMonthCalendar.SetDate( aDate : TDateTime ) ;
begin
FDate := aDate ;
UpdateMonth ;
end;
procedure TCustomMonthCalendar.SetEndDate( aDate : TDateTime ) ;
begin
FEndDate := aDate ;
end;
procedure TCustomMonthCalendar.SetMaxDate( aDate : TDateTime ) ;
begin
FMaxDate := aDate ;
end;
procedure TCustomMonthCalendar.SetMinDate( aDate : TDateTime ) ;
begin
FMinDate := aDate ;
end;
procedure TCustomMonthCalendar.SetShowToday( aShow : boolean) ;
begin
if aShow <> FShowToday
then
TodayLbl.Visible := aShow ;
FShowToday := aShow ;
invalidate;
end;
procedure TCustomMonthCalendar.SetShowTodayCircle( aShow : boolean) ;
begin
FShowTodayCircle := aShow ;
// nothing so far
end;
procedure TCustomMonthCalendar.SetMonthBackColor( aColor : TColor );
begin
if aColor <> Color then
begin
Color := aColor ;
end;
end;
procedure TCustomMonthCalendar.SetTextColor( aColor : TColor );
begin
FTextColor := aColor ;
UpdateMonth ;
end;
procedure TCustomMonthCalendar.SetTitleBackColor( aColor : TColor );
begin
TitlePanel.Color := aColor ;
PaintDays;
end;
procedure TCustomMonthCalendar.SetTitleTextColor( aColor : TColor );
begin
TitlePanel.Font.Color := aColor ;
PaintDays;
end;
procedure TCustomMonthCalendar.SetTrailingTextColor( aColor : TColor );
var
i : integer ;
begin
for i:=1 to 7 do
with WeekDayLbl[i] do
Font.Color := aColor ;
for i:=1 to 6 do
with WeekLbl[i] as TLabel do
Font.Color := aColor ;
end;
procedure TCustomMonthCalendar.SetWeekendColor(Value: TColor);
begin
if Value <> FWeekendColor then
begin
FWeekendColor := Value;
// UpdatePopup;
end;
end;
procedure TCustomMonthCalendar.SetWeekends(Value: TDaysOfWeek);
begin
if Value <> FWeekends then
begin
FWeekends := Value;
// UpdatePopup;
end;
end;
function TCustomMonthCalendar.GetTrailingTextColor: TColor ;
begin
with WeekDayLbl[1] do
Result := Font.Color ;
end;
function TCustomMonthCalendar.GetMonthBackColor: TColor ;
begin
Result := Color ;
end;
function TCustomMonthCalendar.GetTitleTextColor: TColor;
begin
Result := TitlePanel.Font.Color ;
end;
function TCustomMonthCalendar.GetTitleBackColor: TColor ;
begin
Result := TitlePanel.Color ;
end;
procedure TCustomMonthCalendar.SetFontColor( ALabel: TLabel);
const
WeekDays: array [1..7] of TDayOfWeekName =
(Mon, Tue, Wed, Thu, Fri, Sat, Sun);
var
WkDay: TDayOfWeekName;
begin
WkDay := WeekDays[DayOfTheWeek(ALabel.Tag)];
if WkDay in Weekends then
ALabel.Font.Color := WeekendColor
else
ALabel.Font.Color := TextColor;
end;
procedure TCustomMonthCalendar.Label1Click(Sender: TObject);
var
curDay : integer ;
begin
// SetFocus ;
curDay := DayOfTheMonth(FDate) ;
SetFontColor(DayLbl[FirstDay + curDay - 1]);
with DayLbl[FirstDay + curDay - 1] do
begin
if ShowTodayCircle and (Tag = Today) then
Bitmap := FTodayBmp
else
Bitmap := nil;
SetFontColor(DayLbl[FirstDay + curDay - 1]);
end;
with Sender as TLabel do
begin
FDate := IncDay( FDate , strtoint(Caption) - curDay );
Font.Color := TitleTextColor ;
if ShowTodayCircle and (Tag = Floor(Now)) then
Bitmap := FSelectTodayBmp
else
Bitmap := FSelectBmp;
end;
if Assigned( FOnClick ) then
FonClick( Sender );
end;
procedure TCustomMonthCalendar.Label1DblClick(Sender: TObject);
begin
if Assigned( FOnDblClick ) then
FonDblClick( Sender );
end;
procedure TCustomMonthCalendar.KeyDown(var Key: Word; Shift: TShiftState);
begin
case Key of
Key_Up:
DateTime := IncWeek(FDate, -1);
Key_Down:
DateTime := IncWeek(FDate, 1);
Key_Left:
DateTime := IncDay(FDate, -1);
Key_Right:
DateTime := IncDay(FDate, 1);
Key_Home:
DateTime := Now ;
Key_Prior:
DateTime := IncMonth(FDate, -1);
Key_Next:
DateTime := IncMonth(Fdate, 1);
end;
end;
end.
Reference in New Issue View Git Blame Copy Permalink