...Show Week Numbers in a TDateTimePicker?
在DateTimePicker中显示星期？
uses
CommCtrl;
type
THackCommonCalendar = class(TCommonCalendar);
{...}
procedure TForm1.DateTimePicker1DropDown(Sender: TObject);
var
Style: Integer;
ReqRect: TRect;
MaxTodayWidth: Integer;
begin
with THackCommonCalendar(Sender as TDateTimePicker) do
begin
// set style to include week numbers
Style := GetWindowLong(CalendarHandle, GWL_STYLE);
SetWindowLong(CalendarHandle, GWL_STYLE, Style or MCS_WEEKNUMBERS);
FillChar(ReqRect, SizeOf(TRect), 0);
// get required rect
Win32Check(MonthCal_GetMinReqRect(CalendarHandle, ReqRect));
// get max today string width
MaxTodayWidth := MonthCal_GetMaxTodayWidth(CalendarHandle);
// adjust rect width to fit today string
if MaxTodayWidth > ReqRect.Right then
ReqRect.Right := MaxTodayWidth;
// set new height & width
SetWindowPos(CalendarHandle, 0, 0, 0, ReqRect.Right, ReqRect.Bottom,
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOZORDER);
end;
end;
********************************
如何实现再开始的时候，让DateTimePicker如下面一样，提醒用户选择时间？
{
Use the DateTime_SetFormat API macro (put CommCtrl in the uses clause) to set
the date to blank or a message.
Then in the DateTimePicker OnCloseUp event handler set the format to what you
want when a date has been selected, and the DTP will show the selected date.
Attach an onClick handler if you want it to open when you
click on the edit control.
}
uses
CommCtrl;
var
FDTMDateEmpty: Boolean;
procedure TForm1.FormCreate(Sender: TObject);
begin
DateTime_SetFormat(DateTimePicker1.Handle, '''Choose a date''');
FDTMDateEmpty := True;
end;
procedure TForm1.DateTimePicker1CloseUp(Sender: TObject);
begin
DateTime_SetFormat(DateTimePicker1.Handle, PChar('dd.MM.yy'));
end;
procedure TForm1.DateTimePicker1Click(Sender: TObject);
begin
if FDTMDateEmpty then
begin
DateTimePicker1.Perform(WM_KEYDOWN, VK_F4, 0);
DateTimePicker1.Perform(WM_KEYUP, VK_F4, 0);
end;
end;
procedure TForm1.DateTimePicker1Change(Sender: TObject);
begin
FDTMDateEmpty := False;
end;
此文章由 http://www.ositren.com 收集整理 ,地址为:
http://www.ositren.com/htmls/68034.html