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

Question

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

Answer 1

==================接上贴=======================================================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;

Answer 2

呵呵，可以再完善一下，就是让FEditLabel能能够自动感知TField.DisplayLabel，这样使用起来才方便。
另外，你这个数据敏感控件可能不能将数据库中已经存在的日期/时间去掉，即改为空（没详细看你的代码）。—————————————————————————————————
宠辱不惊，看庭前花开花落，去留无意；毁誉由人，望天上云卷云舒，聚散任风。
—————————————————————————————————

Answer 3

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

Answer 4

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

Answer 5

另，你这两个控件可以合并为一个，可以公布一个属性让用户决定是否显示EditLabel。
TPOSDatetimePicker.WMPaint也是没有必要的，这极大的消耗了系统资源，在几个必要的环节调用SetLabelPosition(FLabelPosition);就可以了。—————————————————————————————————
宠辱不惊，看庭前花开花落，去留无意；毁誉由人，望天上云卷云舒，聚散任风。
—————————————————————————————————

Answer 6

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