unit ORDtTmCal;

interface

uses SysUtils, Windows, Classes, Graphics, Grids, Calendar;

type
  TDateRange = class(TObject)
  private
    fMinDate: Double;
    fMaxDate: Double;
    procedure SetMinDate(Const aMinDte: Double);
    procedure SetMaxDate(const aMaxDte: Double);
  public
    property MaxDate: Double read fMaxDate write SetMaxDate;
    property MinDate: Double read fMinDate write SetMinDate;
    function IsBetweenMinAndMax(const LookupDate: TDateTime): Boolean;
    function IsFullDay(const aDate: TDateTime): Boolean;
    constructor Create;
  end;

  TORCalendar = class(TCalendar)
  private
    fValidRange: TDateRange;
    procedure SetValidRange(aRange: TDateRange);
    function IsBetweenMinAndMax(const LookupDate: TDateTime): Boolean;

    function getMinDateTime: TDateTime;
    function getMaxDateTime: TDateTime;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;
    property ValidRange: TDateRange read fValidRange write SetValidRange;
    property MinDateTime: TDateTime read getMinDateTime;
    property MaxDateTime: TDateTime read getMaxDateTime;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    function SelectCell(ACol, ARow: Longint): Boolean; override;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
  end;

procedure Register;

implementation

uses
  System.DateUtils, System.UITypes,
  ORDtTm;

/// /////////////////////////////////////////////////////////////////////////////

constructor TDateRange.Create;
begin
  inherited;
  fMinDate := -1;
  fMaxDate := -1;
end;

procedure TDateRange.SetMinDate(Const aMinDte: Double);
begin
  if (fMaxDate <> -1) and (aMinDte > fMaxDate) then
  begin
    raise Exception.Create('Min date cannot be after Max date');
    exit;
  end;
  fMinDate := aMinDte;
end;

procedure TDateRange.SetMaxDate(const aMaxDte: Double);
begin
  if (fMinDate <> -1) and (aMaxDte < fMinDate) then
  begin
    raise Exception.Create('Max date cannot be before Min date');
    exit;
  end;
  fMaxDate := aMaxDte;
end;

function TDateRange.IsBetweenMinAndMax(const LookupDate: TDateTime): Boolean;
var
  dd, ddd, dt: TDateTime;
begin
  dt := LookupDate;
  dd := fMinDate;
  ddd := fMaxDate;
  Result := (dt >= dd) and (dt <= ddd);
end;

function TDateRange.IsFullDay(const aDate: TDateTime): Boolean;
var
  _min, _max, dtMin, dtMax: TDateTime;
begin
  _min := TDateTime(MinDate);
  _max := TDateTime(MaxDate);
  dtMin := round(aDate) + 1 / (24 * 60 * 60);
  dtMax := round(aDate + 1) - 1 / (24 * 60 * 60);
  Result := (_min < dtMin) and (dtMax < _max);
end;

{ TORCalendar ------------------------------------------------------------------------------- }
(*
  procedure TORCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
  { uses the Calendar that is part of Samples and highlights the current date }
  var
  TheText: string;
  CurMonth, CurYear, CurDay: Word;
  begin
  TheText := CellText[ACol, ARow];
  with ARect, Canvas do
  begin
  DecodeDate(Date, CurYear, CurMonth, CurDay);
  if (CurYear = Year) and (CurMonth = Month) and (IntToStr(CurDay) = TheText) then
  begin
  TheText := '[' + TheText + ']';
  Font.Style := [fsBold];
  end;
  TextRect(ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
  Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);
  end;
  end;

  procedure TORCalendar.KeyDown(var Key: Word; Shift: TShiftState);
  begin
  inherited;
  if Key = VK_PRIOR then
  CalendarDate := IncMonth(CalendarDate,-1)
  else if Key = VK_NEXT then
  CalendarDate := IncMonth(CalendarDate,1);
  end;
*)

{ TORCalendar ------------------------------------------------------------------------------- }
constructor TORCalendar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TORCalendar.Destroy();
begin
  inherited;
end;

procedure TORCalendar.KeyDown(var Key: Word; Shift: TShiftState);
var
  iDelta: Integer;
begin
  // inherited;
  if ssCtrl in Shift then
    iDelta := 11
  else
    iDelta := 0;

  if Key = VK_PRIOR then
  begin
    CalendarDate := IncMonth(CalendarDate, -iDelta);
    if CalendarDate < MinDateTime then
      CalendarDate := MinDateTime;
  end
  else if Key = VK_LEFT then
  begin
    CalendarDate := CalendarDate - 1;
    if CalendarDate < MinDateTime then
      CalendarDate := MinDateTime;
  end
  else if Key = VK_NEXT then
  begin
    CalendarDate := IncMonth(CalendarDate, iDelta);
    if CalendarDate > MaxDateTime then
      CalendarDate := MaxDateTime;
  end
  else if Key = VK_RIGHT then
  begin
    CalendarDate := CalendarDate + 1;
    if CalendarDate > MaxDateTime then
      CalendarDate := MaxDateTime;
  end;
end;

procedure TORCalendar.SetValidRange(aRange: TDateRange);
begin
  fValidRange := aRange;
  if ValidRange.IsBetweenMinAndMax(ServerToday) then
    CalendarDate := ServerToday
  else
    CalendarDate := ValidRange.MinDate;
end;

function TORCalendar.getMinDateTime: TDateTime;
begin
  if Assigned(ValidRange) then
    Result := ValidRange.MinDate
  else
    Result := -1.0;
end;

function TORCalendar.getMaxDateTime: TDateTime;
begin
  if Assigned(ValidRange) then
    Result := ValidRange.MaxDate
  else
    Result := -1.0;
end;

function TORCalendar.IsBetweenMinAndMax(const LookupDate: TDateTime): Boolean;
begin
  Result := False;
  if Assigned(ValidRange) then
    Result := ValidRange.IsBetweenMinAndMax(LookupDate);
end;

function TORCalendar.SelectCell(ACol, ARow: Longint): Boolean;
var
  TheText: string;
  DteToChk: TDateTime;
  _min, _max: TDateTime;
begin
  Result := (Inherited);

  TheText := CellText[ACol, ARow];
  if TheText = '' then
    exit;
  DteToChk := EncodeDate(Year, Month, StrToIntDef(TheText, 0));

  if Assigned(ValidRange) then
  begin
    if Result then
    begin
      _min := getMinDateTime;
      _max := getMaxDateTime;
      if _min <> -1 then
        Result := DateOf(DteToChk) >= DateOf(FloatToDateTime(_min));
      if _max <> -1 then
        Result := Result and
          (DateOf(DteToChk) <= DateOf(FloatToDateTime(_max)));
    end;
  end;
end;

function InverseColor(Color: TColor): TColor;
var
  rgb_: TColorref;

  function Inv(b: Byte): Byte;
  begin
    if b > 128 then
      Result := 0
    else
      Result := 255;
  end;

begin
  rgb_ := ColorToRgb(Color);
  rgb_ := RGB(Inv(GetRValue(rgb_)), Inv(GetGValue(rgb_)), Inv(GetBValue(rgb_)));

  Result := rgb_;
end;

procedure TORCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect;
  AState: TGridDrawState);
var
  TheText: string;
  DteToChk: TDateTime;
  CurMonth, CurYear, CurDay: Word;
  UseColor: TColor;
  _min, _max: TDateTime;

begin
  TheText := CellText[ACol, ARow];
  with ARect, Canvas do
  begin
    if Assigned(ValidRange) then
    begin
      _min := getMinDateTime;
      _max := getMaxDateTime;

      if StrToIntDef(TheText, -1) <> -1 then
      begin
        DteToChk := EncodeDate(Year, Month, StrToIntDef(TheText, 0));
        UseColor := clWindow;
        // if IsFullDay(DteToChk) then
        // UseColor := clLtGray;

        if (_min <> -1) and (_max <> -1) then
        begin
          // All dates between
          if not IsBetweenMinAndMax(DteToChk) then
            UseColor := clLtGray;
        end
        else if _min <> -1 then
        begin
          // All dates between
          if DateOf(DteToChk) < DateOf(FloatToDateTime(_min)) then
            UseColor := clLtGray;
        end
        else if _max <> -1 then
        begin
          // All dates between
          if DateOf(DteToChk) > DateOf(FloatToDateTime(_max)) then
            UseColor := clLtGray;
        end;
        Brush.Color := UseColor;
      end;
    end;
    DecodeDate(Date, CurYear, CurMonth, CurDay);
    if (CurYear = Year) and (CurMonth = Month) and (IntToStr(CurDay) = TheText)
    then
    begin
      TheText := '[' + TheText + ']';
      Font.Style := [fsBold];
    end;

    Font.Color := InverseColor(Brush.Color);

    TextRect(ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
      Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);
  end;
end;

procedure Register;
{ used by Delphi to put components on the Palette }
begin
  RegisterComponents('CPRS', [TORCalendar]);
end;

end.
