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

名前

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

本文

こんな感じでどうでしょう。
  //年対応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;

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

戻る