| 1 | unit ORDtTmCal;
 | 
|---|
| 2 | 
 | 
|---|
| 3 | interface
 | 
|---|
| 4 | 
 | 
|---|
| 5 | uses SysUtils, Windows, Classes, Graphics, Grids, Calendar;
 | 
|---|
| 6 | 
 | 
|---|
| 7 | type
 | 
|---|
| 8 |   TORCalendar = class(TCalendar)
 | 
|---|
| 9 |   protected
 | 
|---|
| 10 |     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
 | 
|---|
| 11 |     procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
 | 
|---|
| 12 |   end;
 | 
|---|
| 13 | 
 | 
|---|
| 14 | procedure Register;
 | 
|---|
| 15 | 
 | 
|---|
| 16 | implementation
 | 
|---|
| 17 | 
 | 
|---|
| 18 | { TORCalendar ------------------------------------------------------------------------------- }
 | 
|---|
| 19 | 
 | 
|---|
| 20 | procedure TORCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
 | 
|---|
| 21 | { uses the Calendar that is part of Samples and highlights the current date }
 | 
|---|
| 22 | var
 | 
|---|
| 23 |   TheText: string;
 | 
|---|
| 24 |   CurMonth, CurYear, CurDay: Word;
 | 
|---|
| 25 | begin
 | 
|---|
| 26 |   TheText := CellText[ACol, ARow];
 | 
|---|
| 27 |   with ARect, Canvas do
 | 
|---|
| 28 |   begin
 | 
|---|
| 29 |     DecodeDate(Date, CurYear, CurMonth, CurDay);
 | 
|---|
| 30 |     if (CurYear = Year) and (CurMonth = Month) and (IntToStr(CurDay) = TheText) then
 | 
|---|
| 31 |     begin
 | 
|---|
| 32 |       TheText := '[' + TheText + ']';
 | 
|---|
| 33 |       Font.Style := [fsBold];
 | 
|---|
| 34 |     end;
 | 
|---|
| 35 |     TextRect(ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
 | 
|---|
| 36 |       Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);
 | 
|---|
| 37 |   end;
 | 
|---|
| 38 | end;
 | 
|---|
| 39 | 
 | 
|---|
| 40 | procedure TORCalendar.KeyDown(var Key: Word; Shift: TShiftState);
 | 
|---|
| 41 | begin
 | 
|---|
| 42 |   inherited;
 | 
|---|
| 43 |   if Key = VK_PRIOR then
 | 
|---|
| 44 |     CalendarDate := IncMonth(CalendarDate,-1)
 | 
|---|
| 45 |   else if Key = VK_NEXT then
 | 
|---|
| 46 |     CalendarDate := IncMonth(CalendarDate,1);
 | 
|---|
| 47 | end;
 | 
|---|
| 48 | 
 | 
|---|
| 49 | procedure Register;
 | 
|---|
| 50 | { used by Delphi to put components on the Palette }
 | 
|---|
| 51 | begin
 | 
|---|
| 52 |   RegisterComponents('CPRS', [TORCalendar]);
 | 
|---|
| 53 | end;
 | 
|---|
| 54 | 
 | 
|---|
| 55 | end.
 | 
|---|
| 56 |  
 | 
|---|