Daten bei TMonthCalendar markieren

[blackdrake]

OK, gehen wir mal nur von folgenden Dingen aus:

1. Statische Markierung (dynamische Folgt aus dieser Lösung dann heraus)
2. Es seien nur maximal 2 Jahre auf dem Calendar zu sehen.

Wie kann ich dann bei mntCalendarGetMonthInfo() das Jahr errechnen? Ich komme wie gesagt mit der Beschreibung von "Alter Mann" nicht weiter.

Gruß
blackdrake

[Alter Mann]

So, So,

was soll da denn noch erklärt werden?

GetMonthInfo wird nun mal von oben links nach unten rechts für jeden dargestellten Monat aufgerufen!
Dazu wird immer der jeweils für diesen (aktuellen) Monat der Monat als ZAHL übergeben und
wenn (bei 3x4 Monaten) oben links Mai 2008 steht, heiß es, GetMonthInfo wird in der Reihenfolge
5,6,7,8,9,10,11,12,1,2,3,4 aufgerufen!
Und da der Mai nach dem April kommt, ist es auch klar welches Jahr aktuell ist.

Es gibt nun mal Sachen, die sind so wie sie sind und daran kann man nichts ändern, was soll's.

Geht davon aus und reagiere erst wenn sich daran etwas ändert, du kannst unmöglich Änderungen
voraussehen.

Gruß

[blackdrake]

Hallo.

Ja, das habe ich klar verstanden. Mein Problem ist aber: Woher soll GetMonthInfo() wissen, dass es zum ersten Mal (seit dem letzten "Scrollen" durch die Monate) aufgerufen ist? Es gibt auch kein Event, das aufgerufen wird, wenn der Benutzer durch die Monate scrollt. Ansonsten würde ich bei dem Scroll-Event eine Variable auf das aktuelle Jahr setzen und diese Variable bei jedem GetMonthInfo() für Januar um 1 erhöhen. Ich komme einfach nicht drauf, wie ich ohne ein solches Event auf das aktuelle Jahr von GetMonthInfo() kommen soll!

Delphi-Quellcode:

procedure TForm1.MonthCalendar1GetMonthInfo(Sender: TObject; Month: Cardinal;
  var MonthBoldInfo: Cardinal);
var
  jahr, monat, tag: word;
begin
  DecodeDate(monthcalendar1.Date, jahr, monat, tag);
  if Month > Monat then
  begin
    memo1.lines.add(inttostr(Month)+'/'+inttostr(jahr+1));
  end
  else
  begin
    memo1.lines.add(inttostr(Month)+'/'+inttostr(jahr));
  end;
end;

Gruß
blackdrake

[blackdrake]

Keiner eine Lösung?

[Alter Mann]

Hi blackdrake,

hast Du den Source von ComCtrls und CommCtrl?

Wenn JA dann schau Dir procedure TMonthCalendar.CNNotify(var Message: TWMNotify); (ComCtrls) und
tagNMDAYSTATE = packed record(CommCtrl) an.

Wenn NEIN dann musst Du damit leben.

Zitat:

// MCN_GETDAYSTATE is sent for MCS_DAYSTATE controls whenever new daystate
// information is needed (month or year scroll) to draw bolding information.
// The app must fill in cDayState months worth of information starting from
// stStart date. The app may fill in the array at prgDayState or change
// prgDayState to point to a different array out of which the information
// will be copied. (similar to tooltips)

Gruß

[blackdrake]

Hallo.

Danke für den Tipp. Leider hab ich hier ein Problem mit der Umsetzung:

Delphi-Quellcode:

private
  OriginalCalendarWindowProc: TWndMethod;
  procedure CalendarWindowProcEx(var Message: TMessage);

procedure TForm1.CalendarWindowProcEx(var Message: TMessage);
begin
  if Message.Msg = CN_NOTIFY then
  begin
    memo1.lines.add('Message CN_NOTIFY ('+inttostr(message.Msg)+')');
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OriginalCalendarWindowProc := MonthCalendar1.WindowProc;

  // EOSError: Ein Aufruf einer Betriebssystemfunktion ist fehlgeschlagen
  MonthCalendar1.WindowProc := CalendarWindowProcEx;
end;

Ich hab mir dieses CN_NOTIFY Modell von folgendem Tutorial abgeleitet: http://delphi.about.com/od/delphitip...iewchecked.htm

Im Delphi-Quelltext ist TMonthCalendar.WindowProc folgendermaßen deklariert:

Delphi-Quellcode:

property WindowProc: TWndMethod read FWindowProc write FWindowProc;

type
  TWndMethod = procedure(var Message: TMessage) of object;

Ich denke also, dass die Funktion CalendarWindowProcEx korrekt deklariert ist. Aber was soll der Fehler bedeuten?

Gruß
blackdrake

[blackdrake]

Danke nochmal für die Hilfe. Ich habe es nun mit dem CN_NOTIFY lösen können.

Über farbliche Markierungen (OwnerDraw?) mache ich mir zu einem anderen Zeitpunkt gedanken.

Delphi-Quellcode:

type
  TDynArrayLongWord = array of LongWord;

  TForm1 = class(TForm)
    MonthCalendar1: TMonthCalendar;
    Memo1: TMemo;
    procedure MonthCalendar1GetMonthInfo(Sender: TObject; Month: Cardinal;
      var MonthBoldInfo: Cardinal);
    procedure FormCreate(Sender: TObject);
  private
    OriginalCalendarWindowProc: TWndMethod;
    jahr_zusatz: integer;
    procedure CalendarWindowProcEx(var Message: TMessage);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CalendarWindowProcEx(var Message: TMessage);
begin
  if Message.Msg = CN_NOTIFY then
  begin
    jahr_zusatz := 0;
  end;
  OriginalCalendarWindowProc(Message);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OriginalCalendarWindowProc := MonthCalendar1.WindowProc;
  MonthCalendar1.WindowProc := CalendarWindowProcEx;
end;

function MyMonthMarker(Month, Year: integer): TDynArrayLongWord;
begin
  // Zum Test
  SetLength(result, 2);
  result[0] := month;
  result[1] := year-2000;
end;

procedure TForm1.MonthCalendar1GetMonthInfo(Sender: TObject; Month: Cardinal;
  var MonthBoldInfo: Cardinal);
var
  jahr, monat, tag: word;
begin
  DecodeDate(monthcalendar1.Date, jahr, monat, tag);
  (Sender as TMonthCalendar).BoldDays(MyMonthMarker(Month, jahr+jahr_zusatz), MonthBoldInfo);
  if month = 12 then inc(jahr_zusatz);
end;

Gruß
blackdrake

[CmdrRicK]

Da ich grade mit einem ähnlichen Problem beschäftigt bin und über diesen Thread gestolpert bin, wollte ich kurz hinterlassen was ich bereits als mögliche Lösung entdeckt habe. Auf QualityCentral findet man folgenden Workaround:

http://qc.embarcadero.com/wc/qcmain.aspx?d=26318

Delphi-Quellcode:

//Edit ComCtrls.pas to change the TOnGetMonthInfoEvent type definition:

TOnGetMonthInfoEvent = procedure(Sender: TObject; Month, Year: LongWord; var MonthBoldInfo: LongWord) of object;

//and change the (private) TMonthCalendar.CNNotify method adding the lines with comments:

procedure TMonthCalendar.CNNotify(var Message: TWMNotifyMC);
var
  ST: TSystemTime;
  I, MonthNo, YearNo: Integer;  // Add year
{$IF DEFINED(CLR)}
  DayState: TNMDayState;
  CurState: TMonthDayStateArray;
{$ELSE}
  DayState: PNMDayState;
  CurState: PMonthDayState;
{$IFEND}
begin
  with Message, NMHdr{$IFNDEF CLR}^{$ENDIF} do
  begin
    case code of
      MCN_GETDAYSTATE:
        begin
          DayState := NMDayState;
          with DayState{$IFNDEF CLR}^{$ENDIF} do
          begin
{$IF DEFINED(CLR)}
            SetLength(CurState, cDayState);
{$ELSE}
            FillChar(prgDayState^, cDayState * SizeOf(TMonthDayState), 0);
{$IFEND}
            if Assigned(FOnGetMonthInfo) then
            begin
{$IF DEFINED(CLR)}
              CurState := TMonthDayStateArray(NativeBufToArray(prgDayState, CurState));
{$IFEND}
              for I := 0 to cDayState - 1 do
              begin
                YearNo := stStart.wYear;  // Get year
                MonthNo := stStart.wMonth + I;
                if MonthNo > 12 then
                begin
                  Inc(YearNo);   // Update year
                  MonthNo := MonthNo - 12;
                end;
{$IF DEFINED(CLR)}
                FOnGetMonthInfo(Self, MonthNo, YearNo, CurState[I]);  // Pass year
{$ELSE}
                FOnGetMonthInfo(Self, MonthNo, YearNo, CurState^);   // Pass year
                Inc(CurState);
{$IFEND}
              end;
            end;
{$IF DEFINED(CLR)}
            prgDayState := ArrayToNativeBuf(CurState, prgDayState);
            NmDayState := DayState;
{$IFEND}
          end;
        end;
      MCN_SELECT, MCN_SELCHANGE:
        with NMSelChange{$IFNDEF CLR}^{$ENDIF} do
        begin
          ST := stSelStart;
          if not IsBlankSysTime(ST) then
            FDateTime := SystemTimeToDateTime(ST);
          if FMultiSelect then
          begin
            ST := stSelEnd;
            if not IsBlankSysTime(ST) then
              FEndDate := SystemTimeToDateTime(ST);
          end;
        end;
    end;
  end;
  inherited;
end;

anstatt die VCL Quellen zu überschreiben kann man natürlich einfach eine eigene Komponente ableiten...

entschuldigt bitte die Threadnekromantie, aber anderen Suchenden ist damit evtl geholfen

[blackdrake]

Hallo.

Danke für deine Antwort. Ich werde es die nächsten Tage mal ausprobieren.

Quasi alle meiner noch offenen Threads interessieren mich tatsächlich immer noch. Meist habe ich das Feature oder gar das Projekt liegengelassen, weil ich keine Lösung für etwas fand. Ist also nicht negativ, dass du das Thema wiederbelebt hast.

Gruß
blackdrake