有人知道关于DElphi7 使用table 控件的增加如下错误

lx2323235 2016-08-03 09:19:53
请教大神们有无知道这个问题是个什么问题
第一次增加一点问题也没有
如果再一次点击【table新增】按钮就出现如下问题


关闭程序会提示 已经停止工作


代码如下
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, DBTables, ADODB, DBGridEhGrouping, ToolCtrlsEh,
DBGridEhToolCtrls, DynVarsEh, EhLibVCL, GridsEh, DBAxisGridsEh, DBGridEh;

type
TForm1 = class(TForm)
DataSource1: TDataSource;
Table1: TTable;
Button1: TButton;
Button2: TButton;
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
Button3: TButton;
Memo1: TMemo;
DBGridEh1: TDBGridEh;
DataSource2: TDataSource;
Button4: TButton;
Button5: TButton;
Button6: TButton;
procedure Button1Click(Sender: TObject);
function GetParadoxConnectionString(Path: string; Password: string): string;
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure SplitString(Source,Deli:string; var StringList :TStringList);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
with Table1 do
begin
Active := False;
DatabaseName := '';
TableType := ttParadox;
TableName := 'D:\desktop\999.db';

with FieldDefs do
begin
Clear;
Add('Field1', ftInteger, 0, True); // I
Add('Field2', ftString, 30, False); //A
Add('Field3', ftFloat,0 , True); // N
Add('Field4', ftSmallint,0 , True); //S
end;
CreateTable;
end;
end;
function TForm1.GetParadoxConnectionString(Path: string; Password: string): string;
var
s: string;
begin
s := 'Provider=Microsoft.Jet.OLEDB.4.0;';
s := s + 'Data Source=' + Path + ';';
s := s + 'Extended Properties=Paradox 7.x;Persist Security Info=False;';
s := s + 'Mode=Share Deny None;';
if Password <> '' then
s := s + 'Jet OLEDB:Database Password=' + Password;
Result := s;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ADOConnection1.ConnectionString:=GetParadoxConnectionString('D:\desktop\','');
ADOConnection1.Connected:=True;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
ADOQuery1.Close;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Text:='Update 999 Set Name =:name';
ADOQuery1.Parameters.ParamByName('Name').Value:='try';
ADOQuery1.ExecSQL;
end;

procedure TForm1.Button4Click(Sender: TObject);
VAR
listA,listb,listc:TStringList;
i,x:Integer;
begin
listA:=TStringList.Create;
listb:=TStringList.Create;
listC:=TStringList.Create;
listA:=Table1.FieldDefList;
Memo1.Lines.Text;
Table1.Active:=False;
Table1.Open;
for i:=0 to listA.Count-1 do
begin
listc.Clear;
SplitString(Memo1.Lines[i],';',listc);
Table1.Edit;
with Table1 do
begin
Append;
for x:=0 to listc.Count-2 do
begin
FieldByName(listA[x]).AsString:=listc[x];
end;
Append;
end;
end;
Table1.Close;
Table1.Active:=True;
listA.Free;
listb.Free;
listC.Free;
Memo1.Clear;
end;
procedure TForm1.SplitString(Source,Deli:string; var StringList :TStringList);
var
EndOfCurrentString: Integer;
begin
if StringList = nil then
exit;

StringList.Clear;
while Pos(Deli, Source)>0 do
begin
EndOfCurrentString := Pos(Deli, Source);
StringList.add(Copy(Source, 1, EndOfCurrentString - 1));
Source := Copy(Source, EndOfCurrentString + length(Deli), length(Source) - EndOfCurrentString);
end;
StringList.Add(source);
end;
procedure TForm1.Button5Click(Sender: TObject);
VAR
listA:TStringList;
begin
Table1.Open;
while not Table1.Eof do
Table1.Delete;
// listA:=TStringList.Create;
//listA:=Table1.FieldDefList;
// ShowMessage(listA[0]);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
Table1.Append;
end;

end.

...全文
112 点赞 收藏 1
写回复
1 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
lx2323236 2016-08-04
去掉 lista.free; listb.free; listc.free;
回复
相关推荐
发帖
数据库相关
创建于2007-08-02

2454

社区成员

Delphi 数据库相关
申请成为版主
帖子事件
创建了帖子
2016-08-03 09:19
社区公告
暂无公告