下面的必须Uses CommCtrl单元。
TDateTimePicker这个控件时间的显示方式比较单调，只有长短两种格式，那么如何自定义自己的格式呢？请看下面的论述：
TDateTimePicker的时间显示符合DTM的标准，所以可以修改DTM设置改变其显示格式。和日期相关的DTM宏（函数）有：
DateTime_GetMonthCal ///得到月历子窗口的句柄
GetTime_GetMonthCalColor ///得到月历颜色
DateTime_GetMonthCalFont ///取月历字体
DateTime_GetRange ///取可选范围
DateTime_GetSystemTime ///取系统时间
DateTime_SetFormat ///设置显示格式
DateTime_SetMonthCalColor ///设置月历颜色
DateTime_SetMonthCalFont ///设置字体
DateTime_GetRange ///取范围
DateTime_SetSystemTime ///设置系统时间
TDateTimePicker可以使用上面的任意一个宏！除此之外，还可以通过发送消息的方法来设置DateTimePicker控件的一些属性：
SendMessage(Handle,DTM_SETFORMAT,0,LongInt(PChar('yyyy/mm/dd')));
其中的Mask如下：
Day
d Day of the month as digits without leading zeros for single digit days.
dd Day of the month as digits with leading zeros for single digit days
ddd Day of the week as a 3-letter abbreviation as given by a LOCALE_SABBREVDAYNAME value.
dddd Day of the week as given by a LOCALE_SDAYNAME value.
Month
M Month as digits without leading zeros for single digit months.
MM Month as digits with leading zeros for single digit months
MMM Month as a three letter abbreviation as given by a LOCALE_SABBREVMONTHNAME value.
MMMM Month as given by a LOCALE_SMONTHNAME value.
Year
y Year represented only be the last digit.
yy Year represented only be the last two digits.
yyyy Year represented by the full 4 digits.
也可以设置时间的格式，其中时间的Mask如下：
Hours
h Hours without leading zeros for single digit hours (12 hour clock)
hh Hours with leading zeros for single digit hours (12 hour clock)
H Hours without leading zeros for single digit hours (24 hour clock)
HH Hours with leading zeros for single digit hours (24 hour clock)
Minutes
m Minutes without leading zeros for single digit minutes
mm Minutes with leading zeros for single digit minutes
Seconds
s Seconds without leading zeros for single digit seconds
ss Seconds with leading zeros for single digit seconds
Time Marker
t One character time marker string
tt Multi-character time marker string
下面是两个控件，一个是改良的TDateTimePicker控件，一个是和数据库关联的TDateTimePicker控件！那个和数据库关联的日历控件很好用噢！！！
///FileName:RRSDateTime.pas
unit RRSDateTime;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Commctrl, DB, DBCtrls;
type
TRRSDateTime = class(TDateTimePicker)
private
{ Private declarations }
FLongDateFormat: string;
FLongTimeFormat: string;
FShortDateFormat: string;
FShortTimeFormat: string;
protected
{ Protected declarations }
procedure CreateWnd; override;
function GetDateFormat: TDTDateFormat;
procedure SetDateFormat(Value: TDTDateFormat);
function GetKind: TDateTimeKind;
procedure SetKind(Value: TDateTimeKind);
procedure SetLongDateFormat(const Value: string);
procedure SetLongTimeFormat(const Value: string);
procedure SetShortDateFormat(const Value: string);
procedure SetShortTimeFormat(const Value: string);
procedure CheckEmptyDate; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
property DateFormat: TDTDateFormat read GetDateFormat write SetDateFormat;
property Kind: TDateTimeKind read GetKind write SetKind;
property LongDateFormat: string read FLongDateFormat write SetLongDateFormat;
property LongTimeFormat: string read FLongTimeFormat write SetLongTimeFormat;
property ShortDateFormat: string read FShortDateFormat write SetShortDateFormat;
property ShortTimeFormat: string read FShortTimeFormat write SetShortTimeFormat;
end;
type
TRRSDBDateTime = class(TRRSDateTime)
private
FDataLink: TFieldDataLink;
FReadOnly: Boolean;
procedure DataChange(Sender: TObject);
function GetDataField: string;
procedure SetDataField(const Value: string);
function GetDataSource: TDataSource;
function GetDate: TDateTime;
function GetField: TField;
function GetTime: TDateTime;
procedure SetDataSource(const Value: TDataSource);
procedure SetReadOnly(const Value: Boolean);
procedure UpdateData(Sender: TObject);
procedure WMCut(var Message: TMessage); message WM_CUT;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
procedure Change; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
property Field: TField read GetField;
published
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
property Date: TDateTime read GetDate;
property Time: TDateTime read GetTime;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Win32', [TRRSDateTime]);
RegisterComponents('Data Controls', [TRRSDBDateTime]);
end;
{ TRRSDateTime }
procedure TRRSDateTime.CheckEmptyDate;
begin
/// Do Nothing
end;
constructor TRRSDateTime.Create(AOwner: TComponent);
var
i : integer;
DefaultLCID : LCID;
begin
inherited;
DefaultLCID := GetThreadLocale;
FShortDateFormat := GetLocaleStr(DefaultLCID, LOCALE_SSHORTDATE, 'yy.M.dd');
FLongDateFormat := GetLocaleStr(DefaultLCID, LOCALE_SLONGDATE, 'yyyy.MM.dd');
FLongTimeFormat := GetLocaleStr(DefaultLCID, LOCALE_STIMEFORMAT, 'hh:mm:ss tt');
FShortTimeFormat := FLongTimeFormat;
i := Pos('s', FShortTimeFormat);
if i > 0 then begin
if FShortTimeFormat[i - 1] = TimeSeparator then
Delete(FShortTimeFormat, i - 1, 1);
end;
dec(i);
while i > 0 do begin
Delete(FShortTimeFormat, i, 1);
i := Pos('s', FShortTimeFormat);
end;
end;
procedure TRRSDateTime.CreateWnd;
begin
inherited;
if Kind = dtkTime then begin
if DateFormat = dfShort then begin
if FShortTimeFormat > '' then
SendMessage(Handle, DTM_SETFORMAT, 0, LongInt(PChar(FShortTimeFormat)));
end else begin
if FLongTimeFormat > '' then
SendMessage(Handle, DTM_SETFORMAT, 0, LongInt(PChar(FLongTimeFormat)));
end;
end else begin
if DateFormat = dfShort then begin
if FShortDateFormat > '' then
SendMessage(Handle, DTM_SETFORMAT, 0, LongInt(PChar(FShortDateFormat)));
end else begin
if FLongDateFormat > '' then
SendMessage(Handle, DTM_SETFORMAT, 0, LongInt(PChar(FLongDateFormat)));
end;
end;
end;
function TRRSDateTime.GetDateFormat: TDTDateFormat;
begin
Result := inherited DateFormat;
end;
function TRRSDateTime.GetKind: TDateTimeKind;
begin
Result := inherited Kind;
end;
procedure TRRSDateTime.SetDateFormat(Value: TDTDateFormat);
begin
inherited DateFormat := Value;
end;
procedure TRRSDateTime.SetKind(Value: TDateTimeKind);
begin
if inherited Kind = Value then exit;
inherited Kind := Value;
if Kind = dtkTime then
DateMode := dmUpDown;
RecreateWnd;
end;
procedure TRRSDateTime.SetLongDateFormat(const Value: string);
begin
if FLongDateFormat = Value then exit;
FLongDateFormat := Value;
RecreateWnd;
end;
procedure TRRSDateTime.SetLongTimeFormat(const Value: string);
begin
if FLongTimeFormat = Value then exit;
FLongTimeFormat := Value;
RecreateWnd;
end;
procedure TRRSDateTime.SetShortDateFormat(const Value: string);
begin
if FShortDateFormat = Value then exit;
FShortDateFormat := Value;
RecreateWnd;
end;
procedure TRRSDateTime.SetShortTimeFormat(const Value: string);
begin
if FShortTimeFormat = Value then exit;
FShortTimeFormat := Value;
RecreateWnd;
end;
{ TRRSDBDateTime }
procedure TRRSDBDateTime.Change;
begin
FDataLink.Modified;
inherited;
end;
procedure TRRSDBDateTime.CMExit(var Message: TCMExit);
begin
try
FDataLink.UpdateRecord;
except
SetFocus;
raise;
end;
inherited;
end;
procedure TRRSDBDateTime.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;
constructor TRRSDBDateTime.Create(AOwner: TComponent);
begin
inherited;
FReadOnly := False;
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
end;
procedure TRRSDBDateTime.DataChange(Sender: TObject);
begin
if FDataLink.Field = nil then begin
Checked := False;
DateTime := Now;
RecreateWnd;
Exit;
end;
with FDataLink.Field do
if IsNull then begin
Checked := False;
DateTime := Now;
RecreateWnd;
end else begin
Checked := True;
DateTime := AsDateTime;
RecreateWnd;
end;
end;
destructor TRRSDBDateTime.Destroy;
begin
FreeAndNil(FDataLink);
inherited;
end;
function TRRSDBDateTime.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink <> nil)
and FDataLink.ExecuteAction(Action);
end;
function TRRSDBDateTime.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
function TRRSDBDateTime.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
function TRRSDBDateTime.GetDate: TDateTime;
begin
Result:=inherited Date;
end;
function TRRSDBDateTime.GetField: TField;
begin
Result := FDataLink.Field;
end;
function TRRSDBDateTime.GetTime: TDateTime;
begin
Result:=inherited Time;
end;
procedure TRRSDBDateTime.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
FDataLink.Edit;
end;
procedure TRRSDBDateTime.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
if (Key in [#32..#255]) and (FDataLink.Field <> nil)
and not FDataLink.Field.IsValidChar(Key) then
begin
MessageBeep(0);
Key := #0;
end;
case Key of
^H, ^V, ^X, #32..#255: FDataLink.Edit;
#27: begin
FDataLink.Reset;
Key := #0;
end;
end;
end;
procedure TRRSDBDateTime.Loaded;
begin
inherited;
if csDesigning in ComponentState then DataChange(Self);
end;
procedure TRRSDBDateTime.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then
DataSource := nil;
end;
procedure TRRSDBDateTime.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
procedure TRRSDBDateTime.SetDataSource(const Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
procedure TRRSDBDateTime.SetReadOnly(const Value: Boolean);
begin
FReadOnly := Value;
FDataLink.ReadOnly := Value;
end;
function TRRSDBDateTime.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink <> nil)
and FDataLink.UpdateAction(Action);
end;
procedure TRRSDBDateTime.UpdateData(Sender: TObject);
begin
if not FDataLink.Editing then
FDataLink.Edit;
FDataLink.Field.AsDateTime := DateTime;
end;
procedure TRRSDBDateTime.WMCut(var Message: TMessage);
begin
FDataLink.Edit;
inherited;
end;
procedure TRRSDBDateTime.WMPaste(var Message: TMessage);
begin
FDataLink.Edit;
inherited;
end;
end.
此文章由 http://www.ositren.com 收集整理 ,地址为:
http://www.ositren.com/htmls/68384.html