source: cprs/branches/GUI-config/CPRS-Lib/ORDtTmCal.pas@ 801

Last change on this file since 801 was 476, checked in by Kevin Toppenberg, 16 years ago

New WorldVistA Config Utility

File size: 1.5 KB
Line 
1unit ORDtTmCal;
2
3interface
4
5uses SysUtils, Windows, Classes, Graphics, Grids, Calendar;
6
7type
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
14procedure Register;
15
16implementation
17
18{ TORCalendar ------------------------------------------------------------------------------- }
19
20procedure TORCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
21{ uses the Calendar that is part of Samples and highlights the current date }
22var
23 TheText: string;
24 CurMonth, CurYear, CurDay: Word;
25begin
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;
38end;
39
40procedure TORCalendar.KeyDown(var Key: Word; Shift: TShiftState);
41begin
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);
47end;
48
49procedure Register;
50{ used by Delphi to put components on the Palette }
51begin
52 RegisterComponents('CPRS', [TORCalendar]);
53end;
54
55end.
56
Note: See TracBrowser for help on using the repository browser.