记得有位高人写了一个可以输入空值的日期控件,见到的朋友给个消息(100分)

  • 主题发起人 郭玉梁
  • 开始时间

郭玉梁

Unregistered / Unconfirmed
GUEST, unregistred user!
记得有位高人写了一个可以输入空值的日期控件,见到的朋友给个消息
 
1stClass可以
 
頂一下!
 
大富翁一个朋友写过,并且发表了一下,但忘了是那个贴子
 
rxlib就可以呀
 
我想找个轻量级的
 
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1181780
你可以和下面这些人要,我没有
 
不高,自己写个就是了。我自己写了个
 
让我看看,可以吗?
 
这有用吗?日期为空或 0000-00-00 在不同的环境中都有
不同的解释(主要是计算的起始年不同),一个空能代表
什么?那还不如用一个串表示了,再对串作分析比什么组
件都好!
 
我们公司就这个就改过的,你试试看行不?
// 常规工具库 ___ 佐尔软件公司 |||//
// 日期时间编辑器 _____ 版权所有 ||//
// ||/
//______________________Copyright(C) Zuoer 2002_____________________|/

unit ZRDbDateTime;

interface

uses Messages, Windows, SysUtils, CommCtrl, Classes, Controls, Forms,
Menus, Graphics, StdCtrls, RichEdit, ToolWin, dbctrls, Db, ComCtrls;

type

TDBDateTimeEdit=class(TDateTimePicker)
protected
FDataLink: TFieldDataLink;
FOldBeforePost:TDataSetNotifyEvent;
FNullFormat: string;
procedure DataChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetDataField(const Value: string);
procedure SetDataSource(const Value: TDataSource);
procedure SetReadOnly(const Value: Boolean);
procedure UpdateData(Sender: TObject);
procedure UpdateDataBeforePost(DataSet: TDataSet);
procedure CMEnter (var Message: TCMEnter); message CM_ENTER;
procedure CMExit (var Message: TCMExit); message CM_EXIT;
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
function GetDateTime: TDateTime;
procedure SetDateTime(const Value: TDateTime);
procedure Change; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure CheckEmptyDate; override;
procedure RequestAlign; override;
procedure CheckNullDateTime;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; 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 GetReadOnly write SetReadOnly default False;
property NullFormat:string read FNullFormat write FNullFormat;
property DateTime:TDateTime read GetDateTime write SetDateTime;
end;

implementation

uses {$IFDEF VER140}RTLConsts,Variants,{$ENDIF} Consts;

{ TDBDateTimeEdit }

procedure TDBDateTimeEdit.Change;
begin
FDataLink.Modified;
inherited Change;
end;

procedure TDBDateTimeEdit.CheckEmptyDate;
begin
if ShowCheckbox then
inherited CheckEmptyDate;
end;

procedure TDBDateTimeEdit.CMEnter(var Message: TCMEnter);
begin
if FDataLink.DataSet<>nil then
begin
FOldBeforePost:=FDataLink.DataSet.BeforePost;
FDataLink.DataSet.BeforePost:=UpdateDataBeforePost;
end;
inherited;
CheckNullDateTime;
end;

procedure TDBDateTimeEdit.CMExit(var Message: TCMExit);
begin
if FDataLink.DataSet<>nil then
begin
if FDataLink.DataSet.State in [dsInsert,dsEdit] then
begin
UpdateData (Self);
FDataLink.UpdateRecord;
end;
FDataLink.DataSet.BeforePost:=FOldBeforePost;
end;
inherited;
CheckNullDateTime;
end;

type
TDateTimePickerRef = class(TCommonCalendar)
private
FCalAlignment: TDTCalAlignment;
FChanging: Boolean;
FChecked: Boolean;
FDateFormat: TDTDateFormat;
FDateMode: TDTDateMode;
FDroppedDown: Boolean;
FKind: TDateTimeKind;
FLastChange: TSystemTime;
FParseInput: Boolean;
FShowCheckbox: Boolean;
FOnUserInput: TDTParseInputEvent;
FOnCloseUp: TNotifyEvent;
FOnChange: TNotifyEvent;
FOnDropDown: TNotifyEvent;
FFormat: String;
end;

function IsBlankSysTime(const ST: TSystemTime): Boolean;
type
TFast = array [0..3] of DWORD;
begin
Result := (TFast(ST)[0] or TFast(ST)[1] or TFast(ST)[2] or TFast(ST)[3]) = 0;
end;

procedure TDBDateTimeEdit.CNNotify(var Message: TWMNotify);
var
DT: TDateTime;
begin
with Message, NMHdr^ do
begin
if code = DTN_DATETIMECHANGE then
begin
Result := 0;
with PNMDateTimeChange(NMHdr)^ do
begin
if TDateTimePickerRef(self).FDroppedDown and (dwFlags = GDT_VALID) then
begin
TDateTimePickerRef(self).FLastChange := st;
inherited DateTime := SystemTimeToDateTime(TDateTimePickerRef(self).FLastChange);
end
else begin
if TDateTimePickerRef(self).FShowCheckbox and IsBlankSysTime(st) then
TDateTimePickerRef(self).FChecked := False
else if dwFlags = GDT_VALID then
begin
TDateTimePickerRef(self).FLastChange := st;
DT := SystemTimeToDateTime(st);
inherited DateTime:=DT;
if TDateTimePickerRef(self).FShowCheckbox then TDateTimePickerRef(self).FChecked := True;
end;
end;
Change;
end
end
else
inherited;
end;
end;

constructor TDBDateTimeEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FNullFormat:='''''';
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
end;

procedure TDBDateTimeEdit.DataChange(Sender: TObject);
begin
if FDataLink.Field <> nil then
DateTime:=FDataLink.Field.AsDateTime
else
//if csDesigning in ComponentState then
DateTime:=Now;
//inherited Change;
end;

destructor TDBDateTimeEdit.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;

function TDBDateTimeEdit.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;

function TDBDateTimeEdit.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;

function TDBDateTimeEdit.GetDateTime: TDateTime;
begin
Result:=inherited DateTime;
end;

function TDBDateTimeEdit.GetField: TField;
begin
Result := FDataLink.Field;
end;

function TDBDateTimeEdit.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;

procedure TDBDateTimeEdit.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;

procedure TDBDateTimeEdit.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
CheckNullDateTime;
end;

procedure TDBDateTimeEdit.SetDataSource(const Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
CheckNullDateTime;
end;

procedure TDBDateTimeEdit.SetDateTime(const Value: TDateTime);
begin
inherited DateTime:=Value;
CheckNullDateTime;
end;

procedure TDBDateTimeEdit.SetReadOnly(const Value: Boolean);
begin
FDataLink.ReadOnly := Value;
CheckNullDateTime;
end;

procedure TDBDateTimeEdit.UpdateData(Sender: TObject);
begin
FDataLink.Field.AsDateTime := DateTime;
end;

procedure TDBDateTimeEdit.UpdateDataBeforePost(DataSet: TDataSet);
begin
UpdateData(Self);
if Assigned(FOldBeforePost) then
FOldBeforePost(DataSet);
end;

procedure TDBDateTimeEdit.RequestAlign;
begin
inherited RequestAlign;
CheckNullDateTime;
end;

procedure TDBDateTimeEdit.CheckNullDateTime;
begin
if HasParent {and Visible }then
if (DateTime=0.0) and (not Focused {or (Kind=dtkDate) and (DateMode=dmComboBox) }or ReadOnly) then
SendMessage(Handle, DTM_SETFORMAT, 0 , Integer(PChar(FNullFormat)))
else
begin
SendMessage(Handle, DTM_SETFORMAT, 0 , Integer(PChar(Format)));
if ReadOnly then
SendMessage(Handle, DTM_SETFORMAT, 0 , Integer(PChar(Text)));
end;
end;

end.
 
简单,在时间控件上放个edit,就行了,我就这么用
 
郭玉梁,借用贵贴问声:Free erp 还在搞吗?
 
明年3月9号准备发布。
 
顶部