MonthCalendarで特定の日を一度だけ太字や赤色にするには？

---

MonthCalendarコンポーネントを使っていて例えば2007年5月8日だけを太字や赤文字にするにはどうすれば良いのでしょうか？

MonthCalendar1.BoldDays([8], MonthBoldInfo);

のようにすると毎月8日が太字になってしまいます。
よろしくお願いします。

編集 削除

---

MonthCalendar1.Dateプロパティから特定の年月の場合だけ
処理するルーチンを組めばいけるかも。
実行環境が今はないので想像のみです。
他にスマートなやり方有るかもしれないけどそれは他の人に・・・

編集 削除

---

OnGetMonthInfoイベントで出来そうですが、、駄目なの？？？

編集 削除

---

↓これでウマクいくはず...と思ってもジツはウマクいかない。
procedure TForm1.MonthCalendar1GetMonthInfo(Sender: TObject;
  Month: Cardinal; var MonthBoldInfo: Cardinal);
var
  Y, M, D: Word;
begin
  DecodeDate(MonthCalendar1.Date, Y, M, D);
  if (Y = 2007)and(M = 5) then begin
    MonthCalendar1.BoldDays([8], MonthBoldInfo);
  end;
end;
ナゼかというと、このイベントは「月」が切り換わる前に呼ばれるから。
Month引数を使えば「月」は問題ないけど「年」が問題。

編集 削除

---

こんな感じでどうでしょう。
  //年対応GetMonthInfoイベント
  TOnGetMonthInfoExEvent = procedure(Sender: TObject; Year, Month: LongWord;
    var MonthBoldInfo: LongWord) of object;

  //TMonthCalendarを継承、年対応GetMonthInfoを用意
  TMonthCalendarEx=class(TMonthCalendar)
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  protected
    FOnGetMonthInfoEx: TOnGetMonthInfoExEvent;
  published
    property OnGetMonthInfoEx: TOnGetMonthInfoExEvent read FOnGetMonthInfoEx write FOnGetMonthInfoEx;
  end;

//年対応メッセージ処理
procedure TMonthCalendarEx.CNNotify(var Message: TWMNotify);
var
  ST: PSystemTime;
  I, Year, MonthNo: Integer;
  CurState: PMonthDayState;
begin
  with Message, NMHdr^ do
  begin
    case code of
      MCN_GETDAYSTATE:
        begin
          with PNmDayState(NMHdr)^ do
          begin
            FillChar(prgDayState^, cDayState * SizeOf(TMonthDayState), 0);
            if Assigned(FOnGetMonthInfoEx) then
            begin
              CurState := prgDayState;
              for I := 0 to cDayState - 1 do
              begin
                Year := stStart.wYear;
                MonthNo := stStart.wMonth + I;
                if MonthNo > 12 then MonthNo := MonthNo - 12;
                FOnGetMonthInfoEx(Self, Year, MonthNo, CurState^);
                Inc(CurState);
              end;
            end;
          end;
          Result := 0;
          exit;
        end;
    end;
  end;
  inherited;
end;

//手動でフォームに貼り付け（コンポーネント登録してあればパレットからでもOK）
procedure TForm1.FormCreate(Sender: TObject);
begin
  mcex := TMonthCalendarEx.Create(Self);
  mcex.Parent := Self;
  mcex.Top := 0;
  mcex.Left := 0;
  mcex.Width := 200;
  mcex.Height := 200;
  mcex.Visible := True;
  mcex.OnGetMonthInfoEx := mcexGetMonthInfoEx;
end;

//年対応GetMonthInfoの実装
procedure TForm1.mcexGetMonthInfoEx(Sender: TObject;
  Year, Month: Cardinal; var MonthBoldInfo: Cardinal);
begin
  if (Year = 2007)and(Month = 5) then
  begin
    mcex.BoldDays([8], MonthBoldInfo);
  end;
end;

編集 削除

---

皆さんありがとうございます。

皆さんに教えて頂いたのを試してみたのですが、やはり出来そうで出来ないですね…

太字でなくとも色を変えるのでも構わないんですが、BoldDays以外の選択肢はないのでしょうか？

編集 削除

---

あれ？私のコードでできませんでしたか？
こちらの環境では動いているんですがねぇ。
予想している動作が違うのでしょうか。

１つ書き忘れです。
uses節に、
  CommCtrl
を追加してください。
もしかしてこれのせいだったらごめんなさい。書き漏らしました。

編集 削除

---

＞にしのさん

ありがとうございます。
やはりエラーになってしまいました。「未定義の識別子:'mcex'」と言われます。
因みに環境はdelphi4なのですが。

編集 削除

---

かわいい？
var
  mcex: TMonthCalendarEx;

編集 削除

---

本当にありがとうございます。

けれどやっぱりできません…

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  CommCtrl, ComCtrls;

type
  TForm1 = class(TForm)
    MonthCalendar1: TMonthCalendar;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  //年対応GetMonthInfoイベント
  TOnGetMonthInfoExEvent = procedure(Sender: TObject; Year, Month: LongWord;
    var MonthBoldInfo: LongWord) of object;

  //TMonthCalendarを継承、年対応GetMonthInfoを用意
  TMonthCalendarEx=class(TMonthCalendar)
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  protected
    FOnGetMonthInfoEx: TOnGetMonthInfoExEvent;
  published
    property OnGetMonthInfoEx: TOnGetMonthInfoExEvent read FOnGetMonthInfoEx write FOnGetMonthInfoEx;
  end;

var
  Form1: TForm1;
  mcex: TMonthCalendarEx;
implementation

{$R *.DFM}

//年対応メッセージ処理

以下は教えて頂いた通りなのですが、何かおかしいでしょうか？

編集 削除

---

TForm1の { Private 宣言 }の下に


type
  TForm1 = class(TForm)
    MonthCalendar1: TMonthCalendar;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    mcex: TMonthCalendarEx;
    procedure mcexGetMonthInfoEx(Sender: TObject;
      Year, Month: Cardinal; var MonthBoldInfo: Cardinal);

編集 削除

---

あと、MonthCalendar1: TMonthCalendar;を消すんだぞ。
form上にあるカレンダーを削除するのよいいわね？

編集 削除

---

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

←解決時は質問者本人がここをチェックしてください。

返信する