TAdvSmoothCalendarを使ってみる

RadStudioXE シリーズを持ってる人はダウンロード出来るTMS SoftwareのTMS Smooth Controls。
こちらからダウンロード出来まるようです。最新版は4.0です。フリーダウンロードで貰えるのは3.7.2.0までは確認しました。

このコンポーネントセット、見た目が派手目なコントロールが揃ってて中々面白いです。
今回は、その中でTAdvSmoothCalendarを使ってみようと思います。

プロパティは

プロパティ名	説明
Animation	月の切り替え時のアニメーション表示の制御
DateAppearance	カレンダ表示の見てくれを制御します。（Fillが塗り潰し設定、Fontがフォント設定。）
DisjunctDaySelect	複数選択可にした時に、Ctrlキーを押しながらの選択の可否を制御
Fill	全体の塗り潰し設定
SingleFillSelection	複数選択時の選択日の表示方法を制御
StatusAppearance	ステータス表示の表示方法を制御

等、結構色々設定出来ます。またFillの設定が下のようにかなり色々設定出来ます。

イベントのOnDateFillを使って、土日祝日の色を変えるようにしてみようと思います。

type
  TAUDateKind = (adtNormal, adtSaturday, adtSunday, adtHoliday);

// ADateが祝日の場合adtHolidayを返します。
// とりあえず適当に春分・秋分は計算してません。実際にやるならDBかなんかに登録するようにする方が楽ですかね。
function IsHoliday(const ADate: TDateTime): TAUDateKind;
var
  Year, Month, Day: Word;
begin
  Result := adtNormal;
  DecodeDate(ADate, Year, Month, Day);
  if Month = 1 then
  begin
    if Day = 1 then
      Result := adtHoliday
    else begin
      if (NthDayOfWeek(ADate) = 2) And (DayOfTheWeek(ADate)=DayMonday) then
        Result := adtHoliday;
    end;
  end else if Month = 2 then
  begin
    if Day = 11 then
      Result := adtHoliday;
  end else if Month = 4 then
  begin
    if Day = 29 then
      Result := adtHoliday;
  end else if Month = 5 then
  begin
    if (Day >= 3) And (Day <= 5) then
      Result := adtHoliday;
  end else if Month = 7 then
  begin
    if (NthDayOfWeek(ADate) = 3) And (DayOfTheWeek(ADate)=DayMonday) then
      Result := adtHoliday;
  end else if Month = 9 then
  begin
    if (NthDayOfWeek(ADate) = 3) And (DayOfTheWeek(ADate)=DayMonday) then
      Result := adtHoliday;
  end else if Month = 10 then
  begin
    if (NthDayOfWeek(ADate) = 2) And (DayOfTheWeek(ADate)=DayMonday) then
      Result := adtHoliday;
  end else if Month = 11 then
  begin
    if (Day = 3) Or (Day = 23) then
      Result := adtHoliday;
  end else if Month = 12 then
  begin
    if (Day = 23) then
      Result := adtHoliday;
  end;
end;

function DateKindCheck(const ADate: TDateTime): TAUDateKind;
var
  WeekDay: Integer;
begin
  Result := IsHoliday(ADate);
  if Result = adtNormal then
  begin
    WeekDay := DayOfTheWeek(ADate);
    case WeekDay of
    DaySaturday: Result := adtSaturday;
    DaySunday:   Result := adtSunday;
    end;
  end;
end;

// 土曜日は青字。日曜は赤字。祝日はピンク背景の赤字で表示するようにしてみました。
procedure TForm1.AdvSmoothCalendar1DateFill(Sender: TObject; AFill: TGDIPFill;
    AFont: TFont; Date: TDateTime; DateKind: TAdvSmoothCalendarDateKind);
var
  DateType: TAUDateKind;
begin
  if TAdvSmoothCalendar(Sender).Month = MonthOf(Date) then
  begin
    DateType := DateKindCheck(Date);
    case DateType of
    adtSunday,adtHoliday: AFont.Color := clRed;
    adtSaturday: AFont.Color := clBlue;
    end;
    if (DateKind<=dkWeekend) And (DateType = adtHoliday) then
    begin
      AFill.Color := $00E4CAFF;
      AFill.ColorTo := $00E4CAFF;
      AFill.ColorMirror := $00E4CAFF;
      AFill.ColorMirrorTo := $00E4CAFF;
    end;
  end;
end;

追記

OnDateStatusイベントを実装する事で、日付にステータスを表示出来ます。

// 今日の日付に「今日」とステータス表示
procedure TForm1.AdvSmoothCalendar1DateStatus(Sender: TObject; Date: TDateTime;
    var StatusMessage: string; Fill: TGDIPStatus; var OffsetX, OffsetY:
    Integer);
begin
  if SameDate(Date, Now) then
  begin
    StatusMessage := '今日';
  end;
end;