大家帮我看一看，问题出在哪里！(300分)

  • 主题发起人 主题发起人 swean_98
  • 开始时间 开始时间
S

swean_98

Unregistered / Unconfirmed
GUEST, unregistred user!
[8D][8D] 我编写这个控件的目的是使这DBDateTimePiker可以有读写数据库的功能，可是现在的这个控件只能读取，
不能将内容写入数据库！先将代码公布如下，请各位高手指教！
unit DBDateTimePicker;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls,DBCtrls,DB;

type
TDBDateTimePicker=Class(TDateTimePicker)
private
FFocused: Boolean;
FAlignment: TAlignment;
FDataLink: TFieldDataLink;
FPaintControl: TPaintControl;
procedure DataChange(Sender: TObject);
procedure EditingChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure UpdateData(Sender: TObject);
protected
procedure Change; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
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;
end;
procedure Register;

implementation

constructor TDBDateTimePicker.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnEditingChange := EditingChange;
FDataLink.OnUpdateData := UpdateData;
end;

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

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

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

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

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

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

procedure TDBDateTimePicker.DataChange(Sender: TObject);
begin
if FDataLink.Field <> nil then
begin
if FAlignment <> FDataLink.Field.Alignment then
begin
FAlignment := FDataLink.Field.Alignment;
end;
if not (csDesigning in ComponentState) then
begin
if (FDataLink.Field.DataType in [ftString, ftWideString]) then
end;
if FFocused and FDataLink.CanModify then
Date := StrToDate(Trim(FDataLink.Field.Text))
else
begin
Date := StrToDate(FDataLink.Field.DisplayText);
end;
end else
begin
FAlignment := taLeftJustify;
if csDesigning in ComponentState then
Date := StrToDate(Trim('2000-1-1'))

end;
end;

procedure TDBDateTimePicker.EditingChange(Sender: TObject);
begin

end;

procedure TDBDateTimePicker.UpdateData(Sender: TObject);
begin
FDataLink.Modified;
FDataLink.Field.Text :=DateToStr(Date);
end;

procedure TDBDateTimePicker.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 TDBDateTimePicker.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 TDBDateTimePicker.Change;
begin
inherited Change;
FDataLink.Edit;
end;

procedure Register;
begin
RegisterComponents('Swean',[TDBDateTimePicker]);
end;
end.
 
没有人知道吗？请高手帮忙解答一下！
 
我以前是这样的D5，现在用DX控件了
unit DBDate;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls,DB,DBCtrls;

type
TDBDate = class(TDateTimePicker)
private
FDataLink: TFieldDataLink;
procedure DataChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure UpdateData(Sender: TObject);
{ Private declarations }
protected
{ Protected declarations }
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;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Data Access', [TDBDate]);
end;

{ TDBDate }
constructor TDBDate.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
end;

procedure TDBDate.DataChange(Sender: TObject);
begin
if FDataLink.Field <> nil then
DateTime:=FDataLink.Field.AsDateTime
else
DateTime:=Now;
end;

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

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

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

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

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

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

end.
 
谢谢china_peng！我回去对照一下！
我的邮箱是 swean_98@163.com
 
TO china_peng:
我回去试了一下，和我遇到的是相同的问题！只能读取数据库中的值而不能修改！
(我用DBNavigation来确认修改！）
 
關注,關注
你好像都沒有寫回到數據庫中,在UPDATEDATA中顯式地調用回寫試試
 
TO wen00000000:
我是按照DBEDIT来修改控件的，怎样显式的调用回写，请明示！
 
我使用断点跟踪发现数据改动过程中并不经过UpDateData过程，所以我将Updatedata过程中
的程序添加到Change国程中，问题解决了！
谢谢各位捧场！
现将修改后的代码公布如下（调试环境：D5，Win2000）：
unit DBDateTimePicker;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls,DBCtrls,DB;

type
TDBDateTimePicker=Class(TDateTimePicker)
private
FFocused: Boolean;
FAlignment: TAlignment;
FDataLink: TFieldDataLink;
FPaintControl: TPaintControl;
procedure DataChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
protected
procedure Change; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
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;
end;
procedure Register;

implementation

constructor TDBDateTimePicker.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
end;

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

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

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

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

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

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

procedure TDBDateTimePicker.DataChange(Sender: TObject);
begin
if FDataLink.Field <> nil then
begin
if FAlignment <> FDataLink.Field.Alignment then
begin
FAlignment := FDataLink.Field.Alignment;
end;
if not (csDesigning in ComponentState) then
begin
if (FDataLink.Field.DataType in [ftString, ftWideString]) then
end;
if FFocused and FDataLink.CanModify then
Date := FDataLink.Field.AsDateTime
else
begin
Date := FDataLink.Field.AsDateTime;
end;
end else
begin
FAlignment := taLeftJustify;
if csDesigning in ComponentState then
Date := Now;

end;
end;

procedure TDBDateTimePicker.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 TDBDateTimePicker.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 TDBDateTimePicker.Change;
begin
FDataLink.Edit;
inherited Change;
FDataLink.Modified;
FDataLink.Field.AsDateTime :=Date;
end;

procedure Register;
begin
RegisterComponents('Swean',[TDBDateTimePicker]);
end;
end.
 
[:)][:D][8D][:(][:(!][^][?]
 
您必须登录或注册才可回复。

Similar threads

S
把我自己的事件代替原有的事件(50分)
2
回复
21
查看
390
cailihui
C
W
怪了，ｅｄｉｔ的ｏｎｅｘｉｔ (100分)
回复
4
查看
174
wjqdelphi
W
M
我从TDBGrid继承了一个MyDBGrid，并改写了一下KeyDown事件，然而当我把dgAlwaysShowEditor改为True时，KeyDown事件就
回复
5
查看
295
maple_guo
M
W
300大洋，请高手帮忙看看这个控件为什么不能正常工作??(300分)
回复
10
查看
190
www
W
P
写控件中一个小问题，大伙来看看.......... 在线等待.....(100) (100分)
回复
11
查看
206
Puma Wang
P
后退
顶部