unit uStringGridCalendar;
interface
uses
Vcl.Grids;
type
TStringGridCalendar =
class
private
FGrid : TStringGrid;
FSelDate : TDate;
procedure SetSelDate(
const Value : TDate );
protected
procedure GridSelectCell( Sender : TObject; ACol, ARow : Integer;
var CanSelect : Boolean );
procedure DoGridDataFill;
function TryGetDateFromGrid( ACol, ARow : Integer;
out aDate : TDate ) : Boolean;
function GetDateFromGrid( ACol, ARow : Integer ) : TDate;
public
constructor Create( aStringGrid : TStringGrid );
property SelDate : TDate
read FSelDate
write SetSelDate;
procedure DoIncYear( aValue : Integer );
end;
implementation
uses
System.SysUtils, System.DateUtils;
{ TStringGridCalendar }
constructor TStringGridCalendar.Create( aStringGrid : TStringGrid );
begin
inherited Create;
FGrid := aStringGrid;
FGrid.Options := FGrid.Options - [goRangeSelect];
FGrid.OnSelectCell := GridSelectCell;
FSelDate := Date;
DoGridDataFill;
end;
procedure TStringGridCalendar.DoGridDataFill;
var
idx : Integer;
DateIdx : TDate;
lRow, lCol : Integer;
begin
FGrid.FixedCols := 1;
FGrid.FixedRows := 1;
FGrid.ColCount := 38;
FGrid.RowCount := MonthsPerYear + FGrid.FixedRows;
// Jahreszahl in die erste Zelle
FGrid.Cells[0, 0] := IntToStr( YearOf( SelDate ) );
// Tagesnamen in die erste Zeile
for idx := FGrid.FixedCols
to Pred( FGrid.ColCount )
do
begin
FGrid.Cells[idx, 0] := ShortDayNames[( idx - FGrid.FixedCols + 1 )
mod DaysPerWeek + 1];
end;
// Monatsnamen in die erste Spalte
for idx := FGrid.FixedRows
to Pred( FGrid.RowCount )
do
begin
FGrid.Cells[0, idx] := LongMonthNames[idx - FGrid.FixedRows + 1];
end;
for lRow := FGrid.FixedRows
to Pred( FGrid.RowCount )
do
begin
for lCol := FGrid.FixedCols
to Pred( FGrid.ColCount )
do
begin
if TryGetDateFromGrid( lCol, lRow, DateIdx )
then
FGrid.Cells[lCol, lRow] := IntToStr( DayOf( DateIdx ) )
else
FGrid.Cells[lCol, lRow] := '
';
end;
end;
end;
function TStringGridCalendar.GetDateFromGrid( ACol, ARow : Integer ) : TDate;
begin
if not TryGetDateFromGrid( ACol, ARow, Result )
then
raise Exception.Create( '
Fehlermeldung' );
end;
procedure TStringGridCalendar.GridSelectCell( Sender : TObject; ACol, ARow : Integer;
var CanSelect : Boolean );
var
lDate : TDate;
begin
if TryGetDateFromGrid( ACol, ARow, lDate )
then
begin
CanSelect := True;
SelDate := lDate;
end
else
CanSelect := False;
end;
procedure TStringGridCalendar.DoIncYear( aValue : Integer );
begin
SelDate := IncYear( SelDate, aValue )
end;
function TStringGridCalendar.TryGetDateFromGrid( ACol, ARow : Integer;
out aDate : TDate ) : Boolean;
var
lMonth, lDay, lYear : Word;
lMinCol, lMaxCol : Integer;
begin
Result := False;
if ( ACol >= FGrid.FixedCols )
and ( ARow >= FGrid.FixedRows )
then
begin
lYear := YearOf( SelDate );
lMonth := ARow - FGrid.FixedRows + 1;
aDate := EncodeDate( lYear, lMonth, 1 );
lMinCol := DayOfTheWeek( aDate ) + FGrid.FixedCols - 1;
lMaxCol := lMinCol + DaysInMonth( aDate ) - 1;
if ( ACol >= lMinCol )
and ( ACol <= lMaxCol )
then
begin
Result := True;
lDay := ACol - lMinCol + 1;
aDate := EncodeDate( lYear, lMonth, lDay );
end;
end;
end;
procedure TStringGridCalendar.SetSelDate(
const Value : TDate );
var
lYearChange : Boolean;
begin
if ( Value <> SelDate )
then
begin
lYearChange := YearOf( Value ) <> YearOf( SelDate );
FSelDate := Value;
if lYearChange
then
DoGridDataFill;
end;
end;
end.