带DB的带Label的TDateTimePicker源代码公开，非让你给我开贴子不可。嘻嘻！

[feng93017]

给lxjgyl82朋友发了几封Email，可能没有收到，干脆把Code贴出来算了。
这是一个带DB的带Label的TDateTimePicker，方便、实用，如果有什么建议请给我Email：[e-mail] 需要的朋友可以自己打包编译安装,该程序在Delphi6.0下编译通过。用的爽给我开贴子，我是不会拒绝的哟，嘻嘻。
========================================================================
unit POSControls;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Grids, DB, DBCtrls, StdCtrls, ExtCtrls, ComCtrls, Buttons;

{**********THE TPOSLABEL CLASS DECLARE HERE*********}
type
TPOSLabel = class(TBoundLabel)
published
property FocusControl;
end;

{**************************************************}


TPOSDatetimePicker = class(TDatetimePicker)
private
FEditLabel: TPOSLabel;
FLabelPosition: TLabelPosition;
FLabelSpacing: Integer;
procedure SetLabelPosition(const Value: TLabelPosition);
procedure SetLabelSpacing(const Value: Integer);
protected
procedure SetParent(AParent: TWinControl); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetName(const Value: TComponentName); override;
procedure CMVisiblechanged(var Message: TMessage);
message CM_VISIBLECHANGED;
//procedure CMEnabledchanged(var Message: TMessage);
//message CM_ENABLEDCHANGED;
procedure CMBidimodechanged(var Message: TMessage);
message CM_BIDIMODECHANGED;
procedure WMPaint(var Message: TMessage); message WM_PAINT;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;
procedure SetupInternalLabel;
published
property LabelPosition: TLabelPosition read FLabelPosition write SetLabelPosition;
property LabelSpacing: Integer read FLabelSpacing write SetLabelSpacing;
property EditLabel: TPOSLabel read FEditLabel;
end;

TPOSDBDatetimePicker = class(TPOSDatetimePicker)
private
FAllowChange: Boolean;
FSaveMode: TDateTimeMode;
FDataLink: TFieldDataLink;
function GetDataField: String;
function GetDataSource: TDataSource;
procedure SetDataField(const Value: String);
procedure SetDataSource(Value: TDataSource);
procedure DataChange(Sender: TObject);
procedure CMExit(var Message: TWMNoParams); message CM_EXIT;
procedure SetSaveMode(const Value: TDateTimeMode);
protected
{ Protected declarations }
procedure DateTimeChange(Sender: TObject); virtual;
public
{ Public declarations }
constructor Create(Aowner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property SaveMode: TDateTimeMode read FSaveMode write SetSaveMode;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('POSComponent',[TPOSDatetimePicker, TPOSDBDatetimePicker]);
end;


{ TPOSDatetimePicker }

procedure TPOSDatetimePicker.CMBidimodechanged(var Message: TMessage);
begin
inherited;
FEditLabel.BiDiMode := BiDiMode;
end;
{
procedure TPOSDatetimePicker.CMEnabledchanged(var Message: TMessage);
begin
inherited;
FEditLabel.Enabled := Enabled;
end;
}
procedure TPOSDatetimePicker.CMVisiblechanged(var Message: TMessage);
begin
inherited;
FEditLabel.Visible := Visible;
end;

constructor TPOSDatetimePicker.Create(AOwner: TComponent);
begin
inherited;
FLabelPosition := lpLeft;
FLabelSpacing := 3;
SetupInternalLabel;
FEditLabel.Alignment := taRightJustify;
FEditLabel.Visible := true;
//MessageBox(handle, PChar(IntToStr(FLabelSpacing)),'',MB_OK);
//Invalidate;
//SetLabelPosition(FLabelPosition);
end;

procedure TPOSDatetimePicker.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = FEditLabel) and (Operation = opRemove) then
FEditLabel := nil;
end;

procedure TPOSDatetimePicker.SetBounds(ALeft, ATop, AWidth,
AHeight: Integer);
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
SetLabelPosition(FLabelPosition);
end;

[feng93017]

==================接上贴=======================================================

procedure TPOSDatetimePicker.SetLabelPosition(const Value: TLabelPosition);
var
P: TPoint;
begin
if FEditLabel = nil then exit;
FLabelPosition := Value;
case Value of
lpAbove: P := Point(Left, Top - FEditLabel.Height - FLabelSpacing);
lpBelow: P := Point(Left, Top + Height + FLabelSpacing);
lpLeft : P := Point(Left - FEditLabel.Width - FLabelSpacing,
Top + ((Height - FEditLabel.Height) div 2));
lpRight: P := Point(Left + Width + FLabelSpacing,
Top + ((Height - FEditLabel.Height) div 2));
end;
FEditLabel.SetBounds(P.x, P.y, FEditLabel.Width, FEditLabel.Height);
end;

procedure TPOSDatetimePicker.SetLabelSpacing(const Value: Integer);
begin
FLabelSpacing := Value;
SetLabelPosition(FLabelPosition);
end;

procedure TPOSDatetimePicker.SetName(const Value: TComponentName);
begin
inherited;
if (csDesigning in ComponentState) and ((FEditlabel.GetTextLen = 0) or
(CompareText(FEditLabel.Caption, Name) = 0)) then
FEditLabel.Caption := Value;
inherited SetName(Value);
if csDesigning in ComponentState then
Text := '';
SetLabelPosition(FLabelPosition);
end;

procedure TPOSDatetimePicker.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
if FEditLabel = nil then exit;
FEditLabel.Parent := AParent;
FEditLabel.Visible := True;
end;

procedure TPOSDatetimePicker.SetupInternalLabel;
begin
if Assigned(FEditLabel) then exit;
FEditLabel := TPOSLabel.Create(Self);
FEditLabel.FreeNotification(Self);
FEditLabel.FocusControl := Self;
end;

procedure TPOSDatetimePicker.WMPaint(var Message: TMessage);
begin
inherited;
SetLabelPosition(FLabelPosition);
end;

{ TPOSDBDatetimePicker }

procedure TPOSDBDatetimePicker.CMExit(var Message: TWMNoParams);
begin
try
if FDataLink.DataSet.State in [dsEdit, dsInsert] then
FDataLink.UpdateRecord;
except
on Exception do SetFocus;
end;
end;

constructor TPOSDBDatetimePicker.Create(Aowner: TComponent);
begin
inherited Create(AOwner);
FDataLink := TFieldDataLink.Create;
FDataLink.OnDataChange := DataChange;

Self.Kind := dtkDate;
OnChange := DateTimeChange;
FAllowChange := True;
FSaveMode := dtDateTime;
DateFormat := dfShort;
end;

procedure TPOSDBDatetimePicker.DataChange(Sender: TObject);
begin
if FDataLink.Field = nil then
begin
Self.Date := SysUtils.Date;
Self.Time := SysUtils.Time;
end
else begin
if (FAllowChange) and (not FDataLink.Field.IsNull) then
begin
Self.Date := FDataLink.Field.AsDateTime;
Self.Time := FDataLink.Field.AsDateTime;
end
else if FDataLink.Field.IsNull then
begin
Self.Date := SysUtils.Date;
Self.Time := SysUtils.Time;
DateTimeChange(nil);
end;
end;
end;

procedure TPOSDBDatetimePicker.DateTimeChange(Sender: TObject);
begin
if FDataLink.DataSet.State in [dsEdit, dsInsert] then
begin
with FDataLink do
begin
FAllowChange := False;
if not Editing then Edit;
end;

case FSaveMode of
dtDate:
FDatalink.Field.AsDateTime := StrToDate(FormatDateTime('YYYY' + DateSeparator + 'MM' + DateSeparator + 'DD', Self.Date));
dtTime:
FDatalink.Field.AsDateTime := StrToTime(FormatDateTime('HH' + TimeSeparator + 'NN' + TimeSeparator + 'SS', Self.Time));
dtDateTime:
FDatalink.Field.AsDateTime := Self.Date;
end;
FAllowChange := True;
end;
end;

destructor TPOSDBDatetimePicker.Destroy;
begin
FDataLink.OnDataChange := nil;
FDataLink.Free;

inherited;
end;

function TPOSDBDatetimePicker.GetDataField: String;
begin
Result := FDataLink.FieldName;
end;

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

procedure TPOSDBDatetimePicker.SetDataField(const Value: String);
begin
FDataLink.FieldName := Value;
end;

procedure TPOSDBDatetimePicker.SetDataSource(Value: TDataSource);
begin
FDataLink.DataSource := Value;
end;

procedure TPOSDBDatetimePicker.SetSaveMode(const Value: TDateTimeMode);
begin
FSaveMode := Value;
if FSaveMode = dtTime then
Kind := dtkTime
else
Kind := dtkDate;
end;

[lxpbuaa]

呵呵，可以再完善一下，就是让FEditLabel能能够自动感知TField.DisplayLabel，这样使用起来才方便。
另外，你这个数据敏感控件可能不能将数据库中已经存在的日期/时间去掉，即改为空（没详细看你的代码）。

—————————————————————————————————
宠辱不惊，看庭前花开花落，去留无意；毁誉由人，望天上云卷云舒，聚散任风。
—————————————————————————————————

[feng93017]

楼上的朋友的意思让我很是不明白，可否详细点。
1：我这个控件是从TDateTimePicker继承过来的，你所谓的FEditLabel是指Edit还是Label？
你怎么知道它不能感知数据，你有试过么？
2：正因为是从TDateTimePicker继承过来，所以没有办法删除已经存在的日期/时间。不过可以增加一个方法来处理，但是这样做已经没有意义了。

3：兄台可否详细点看看我的代码。呵呵！

[lxpbuaa]

1、FEditLabel是你的代码中定义的变量：
FEditLabel: TPOSLabel;
我所说的感知不是指“数据敏感”，而指FEditLabel自动取得TField.DisplayLabel。比如数据库一个字段Name对应中文名字是“名字”，那么FEditLabel最好自动设置其Caption为“名字”。
2、并不是没有办法“删除已经存在的日期/时间”，也不是没有意思，实际上这个功能很有必要。
3、我去年已经开发过一个类似的组件，功能比你这个要多一些。另外，数据敏感控件的开发大同小异，而且VCL源代码中有很多例子。

—————————————————————————————————
宠辱不惊，看庭前花开花落，去留无意；毁誉由人，望天上云卷云舒，聚散任风。
—————————————————————————————————

[lxpbuaa]

另，你这两个控件可以合并为一个，可以公布一个属性让用户决定是否显示EditLabel。
TPOSDatetimePicker.WMPaint也是没有必要的，这极大的消耗了系统资源，在几个必要的环节调用SetLabelPosition(FLabelPosition);就可以了。

—————————————————————————————————
宠辱不惊，看庭前花开花落，去留无意；毁誉由人，望天上云卷云舒，聚散任风。
—————————————————————————————————

[feng93017]

猩猩果然是猩猩。楼上几句话，着实让鄙人受益匪浅。

另：我用WMPaint也是迫于无奈，才出此下策。原因是设计期间，Label的Position表现正常，可是在运行期，label总是会缩进去一些。（躲在TDateTimePicker的里面去了）。试了一些方法，没有效果，只好用这个浪费资源的家伙。