大家帮我看一看，问题出在哪里！(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

I
Edit&Memo控件的文本得对齐方式
回复
0
查看
713
import
I
I
一个热键控件
回复
0
查看
693
import
I
I
图像旋转控件
回复
0
查看
638
import
I
I
类似IE地址栏的自动完成的效果
回复
0
查看
608
import
I
I
THotKey控件和RegisterHotKey控件的配合使用
回复
0
查看
825
import
I
后退
顶部