How-to-show-week-numbers-in-a-tdatetimepicker


            Ever wanted to know how to get week numbers to show on a TDateTimePicker component ?
I had originally found an excerpt of code, which I wanted to try out, but was in VB - I thought I would translate it, and use ideas from other excerpts of code I had found. It took a few days to get working, as I was getting some freaky results, until I came up with the following result.
Start a new project, drop a TDateTimePicker component onto the form, and change it's Name property to DTPicker1. (You can use any name you wish, but change the code accordingly). Add the code below, site back and enjoy !
unit cdShowWkNos;
interface
uses
 Classes, Forms, Controls, ComCtrls, Types, SysUtils;
type
 TForm1 = class(TForm)
 DTPicker1: TDateTimePicker;
 procedure DTPicker1DropDown(Sender: TObject);
 procedure FormCreate(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
end;
 { external declarations }
 function GetWindowLong(hWnd: LongWord; nIndex: Integer): Longint; stdcall; external 'user32.dll' name 'GetWindowLongA';
 function SetWindowLong(hWnd: LongWord; nIndex: Integer; dwNewLong: Longint): Longint; stdcall; external 'user32.dll' name 'SetWindowLongA';
 function SendMessage(hWnd: LongWord; Msg: LongWord; wParam: LongInt; lParam: LongInt): LongInt; stdcall; external 'user32.dll' name 'SendMessageA';
 function SetWindowPos(hWnd: LongWord; hWndInsertAfter: LongWord; X, Y, cx, cy: Integer; uFlags: LongWord): LongBool; stdcall; external 'user32.dll' name 'SetWindowPos';
 const
 { DateTime Picker, and MonthCalendar specific constants. }
 { Requires comctl32.dll ver. 4.70 }
 GWL_STYLE = (-16);
 MCS_WEEKNUMBERS = $0004;
 DTM_GETMONTHCAL = $1000 + 8;
 MCM_GETMINREQRECT = $1000 + 9;
 MCM_GETMAXTODAYWIDTH = $1000 + 21;
 SWP_NOACTIVATE = $10;
 SWP_NOZORDER = 4;
 SWP_NOMOVE = 2;
 var
 Form1 : TForm1; // the main form
 Style : LongInt; // style variable used for the calendar
 hDTP : THandle; // handle variable of the form
 r : TRect; // the Rect variable, used for the calendar "canvas"
 MaxTodayWidth: Integer; // length of the "Today" text at bottom of calendar
 Flags : Integer; // flags used in setting the new size of the calendar
implementation
{$R *.dfm}
procedure TForm1.DTPicker1DropDown(Sender: TObject);
begin
 Flags := SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOZORDER;
 { get a handle of calendar}
 hDTP := SendMessage(DTPicker1.Handle, DTM_GETMONTHCAL, 0, 0);
 { change a style }
 Style := GetWindowLong(hDTP, GWL_STYLE);
 SetWindowLong(hDTP, GWL_STYLE, Style or MCS_WEEKNUMBERS);
 { get the required rect }
 r := Rect(0, 0, 0, 0);
 SendMessage(hDTP, MCM_GETMINREQRECT, 0, Longint(@r));
 { adjust rect width to fit the "today" string }
 if SendMessage(hDTP, MCM_GETMAXTODAYWIDTH, 0, 0) > r.Right then
 r.Right := SendMessage(hDTP, MCM_GETMAXTODAYWIDTH, 0, 0);
 { set new the height and width of the calendar, to allow for week numbers moving }
 SetWindowPos(hDTP, 0, r.Left, r.Top, r.Right - r.Left, r.Bottom - r.Top, Flags);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 { adjusts calendar, to show today's date - this is optional }
 DTPicker1.Date := Date;
end;
end.
Examples Delphi
