Materiały uzupełniające do przykładu z kalendarzem (z Developer's Guide dla Delphi 4, rozdz. 40)

------------------------   Część 1 ---------------------------------
   published
      property Align; {properties}
      property BorderStyle;
      property Color;
      property Ctl3D;
      property Font;
      property GridLineWidth;
      property ParentColor;
      property ParentFont;
      property OnClick;  {events}
      property OnDblClick;
      property OnDragDrop;
      property OnDragOver;
      property OnEndDrag;
      property OnKeyDown;
      property OnKeyPress;
      property OnKeyUp;

------------------------   Część 2 ---------------------------------

  constructor TKalendarz.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);
      { defaults }
      FixedCols := 0;        // Bez etykiet wierszy
      FixedRows := 1;        // Jeden wiersz nagłówków kolumn
      ColCount := 7;         // Zawsze jest 7 dni na tydzień
      RowCount := 7;         // Zawsze 6 tygodni plus nagłówki
      ScrollBars := ssNone;  // Nie potrzeba skrolowania
      Options := Options - [goRangeSelect] + [goDrawFocusSelected];
                             // Bez możliwości wyboru zakresu komórek
    end;

------------------------   Część 3 ---------------------------------

  procedure TCalendar.WMSize(var Message: TWMSize);
     var
       GridLines: Integer;
     begin
       GridLines := 6 * GridLineWidth;
       DefaultColWidth := (Message.Width - GridLines) div 7;
       DefaultRowHeight := (Message.Height - GridLines) div 7;
     end;

------------------------   Część 4 ---------------------------------
     procedure TKalendarz.DrawCell(ACol, ARow: Longint; ARect: TRect;
                                   AState: TGridDrawState);
     begin
      if ARow = 0
      then
        Canvas.TextOut(ARect.Left, ARect.Top, ShortDayNames[ACol+1]);
        // Uproszczona wersja, tylko dla nagłówków. ShortDayNames to tablica
        // z krókimi nazwami dni (w języku systemu).
     end;

------------------------   Część 5 ---------------------------------
     public
        property Day: Integer index 3 read GetDateElement write SetDateElement;
        property Month: Integer index 2 read GetDateElement write SetDateElement;
        property Year: Integer index 1 read GetDateElement write SetDateElement;

       function TKalendarz.GetDateElement(Index: Integer): Integer;
        var
          AYear, AMonth, ADay: Word;
        begin
          DecodeDate(FDate, AYear, AMonth, ADay);
          case Index of
            1: Result := AYear;
            2: Result := AMonth;
            3: Result := ADay;
            else Result := -1;
          end;
        end;

        procedure TKalendarz.SetDateElement(Index: Integer; Value: Integer);
        var
          AYear, AMonth, ADay: Word;
        begin
          if Value > 0 then
          begin
            DecodeDate(FDate, AYear, AMonth, ADay);
            case Index of
              1: AYear := Value;
              2: AMonth := Value;
              3: ADay := Value;
              else Exit;
            end;
            FDate := EncodeDate(AYear, AMonth, ADay);
            Refresh;
          end;
        end;

------------------------   Część 6 ---------------------------------
      procedure TKalendarz.UpdateCalendar;
        var
          AYear, AMonth, ADay: Word;
          FirstDate: TDateTime;
        begin
          if FDate <> 0
          then
           begin
             DecodeDate(FDate, AYear, AMonth, ADay);
             FirstDate := EncodeDate(AYear, AMonth, 1);
             FMonthOffset := 2 - DayOfWeek(FirstDate);
           end;
          Refresh;
        end;
------------------------   Część 7 ---------------------------------
      constructor TKalendarz.Create(AOwner: TComponent);
      begin
       inherited Create(AOwner);
       FixedCols := 0;        // Bez etykiet wierszy
       FixedRows := 1;        // Jeden wiersz nagłówków kolumn
       ColCount := 7;         // Zawsze jest 7 dni na tydzień
       RowCount := 7;         // Zawsze 6 tygodni plus nagłówki
       ScrollBars := ssNone;  // Nie potrzeba przewijania
       Options := Options - [goRangeSelect] + [goDrawFocusSelected];
                              // Bez możliwości wyboru zakresu komórek
       FDate := Date;         // Date daje bieżącą datę
       UpdateCalender;
      end;

      procedure TKalendarz.SetCalendarDate(Value: TDateTime);
      begin
        FDate := Value;    // Zapamiętaj nową datę
        UpdateCalender;    // Odśwież obraz na ekranie
      end;

      procedure TKalendarz.SetDateElement(Index: Integer; Value: Integer);
      var
        AYear, AMonth, ADay: Word;
      begin
        if Value > 0 then
        begin
          DecodeDate(FDate, AYear, AMonth, ADay);
          case Index of
            1: AYear := Value;
            2: AMonth := Value;
            3: ADay := Value;
            else Exit;
          end;
          FDate := EncodeDate(AYear, AMonth, ADay);
          UpdateCalendar;
        end;
      end;

 ------------------------   Część 8 ---------------------------------

      function TKalendarz.DayNum(ACol, ARow: integer): integer;
       begin
        result := FMonthOffset + ACol + (ARow - 1) * 7; // Wylicz dzień dla tej komórki
        if (result < 1) or (Result > MonthDays[IsLeapYear(Year), Month])
        then
          result := -1;    // -1 gdy nieistniejący dzień
       end;

------------------------   Część 9 ---------------------------------
     
      procedure TKalendarz.DrawCell(ACol, ARow: Longint; ARect: TRect;
                             AState: TGridDrawState);
       var
        TheText: String;
        TempDay: integer;
       begin
         if ARow = 0
         then
           TheText := ShortDayNames[ACol+1]
         else
          begin
           TheText := '';
           TempDay := DayNum(ACol, ARow);
           if TempDay <> -1
           then
             TheText := IntToStr(TempDay)
          end;
         with ARect, Canvas do
           TextRect(ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
                    Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);
       end;
 ------------------------   Część 10 ---------------------------------

     procedure TKalendarz.UpdateCalendar;
      var
        AYear, AMonth, ADay: Word;
        FirstDate: TDateTime;
      begin
        if FDate <> 0
        then
         begin
           DecodeDate(FDate, AYear, AMonth, ADay);
           FirstDate := EncodeDate(AYear, AMonth, 1);
           FMonthOffset := 2 - DayOfWeek(FirstDate);
           // Teraz wyliczamy numer wiersza i kolumny z bieżącą datą
           Row := (ADay - FMonthOffset) div 7 + 1;
           Col := (ADay - FMOnthOffset) mod 7;
         end;
        Refresh;
      end;