📄 dimain.~pas
字号:
if RG_SourceType.ItemIndex =0 then
begin
Case OD.FilterIndex of
1:
begin
with Aq_Table do
begin
close;
Sql.Clear;
Sql.Add('Select * from ['+Trim(TV_DB.Selected.Text)+'$]');
Open;
end;
DBGridAutoSize(DBGrid1);
end;
2:
begin
end;
3:
begin
end;
end;
end
else begin
With Aq_Table do
begin
Close;
Sql.Clear;
Sql.Add('Select * from '+Trim(TV_DB.Selected.Text));
Open;
end;
DBGridAutoSize(DBGrid1);
end;
end;
end;
procedure TfrmDIMain.BtnGoClick(Sender: TObject);
Var
i,n,m,OkRec,StartRecord,EndRecord:integer;
BK:TBookmark;
TmpStr,TmpStr2:String;
RstValue:TDateTime;
AQ_Temp:TADOQuery;
TFName,SFName,QryTable,QryField,RstField,UpdField:TStringList;
RecExist:Boolean;
begin
try
DllTargetDT.DisableControls;
Case Pagecontrol1.ActivePageIndex of
0:begin
if Aq_Table.Active =False then
begin
Messagebox(Application.Handle,'还未确定数据源!','提示',Mb_Iconinformation+Mb_Ok);
Exit;
end;
AutoMatchField;
if Pagecontrol1.ActivePageIndex<(Pagecontrol1.PageCount-1) then
Pageswitch(pagecontrol1.ActivePageIndex+1);
end;
1:begin
try
BK:=DllCfgDT.GetBookmark ;
DllCfgDT.DisableControls ;
DllCfgDT.First;
for i:=1 to DllCfgDT.RecordCount do
begin
if Trim(DllCfgDT.FieldByName('SourceField').AsString) <>'' then
begin
CDS_Temp.Append;
for n:=0 to DllCfgDT.FieldCount-1 do
CDS_Temp.Fields[n].Value :=DllCfgDT.Fields[n].Value;
CDS_Temp.Post;
end;
DllCfgDT.Next;
end;
DllCfgDT.GotoBookmark(Bk);
DllCfgDT.FreeBookmark(BK);
finally
DllCfgDT.EnableControls ;
end;
if CDS_Temp.RecordCount=0 then
begin
Messagebox(Application.Handle,'您还没有选择匹配字段!','提示',Mb_Iconinformation+Mb_Ok);
Exit;
end;
if Pagecontrol1.ActivePageIndex<(Pagecontrol1.PageCount-1) then
Pageswitch(pagecontrol1.ActivePageIndex+1);
CDS_Temp2.CloneCursor(CDS_Temp,False,True);
end;
2:begin
if RadioGroup2.ItemIndex =0 then
begin
StartRecord:=1;
EndRecord:=Aq_Table.RecordCount ;
end
else
begin
StartRecord:=dxSpinEdit1.IntValue;
EndRecord:=dxSpinEdit2.IntValue;
end;
if StartRecord>EndRecord then
begin
Messagebox(Application.Handle,'开始行号不能大于结束行号,请重新输入','提示',Mb_IconError+Mb_Ok);
Exit;
end;
if Pagecontrol1.ActivePageIndex<(Pagecontrol1.PageCount-1) then
Pageswitch(pagecontrol1.ActivePageIndex+1);
BtnBack.Enabled :=False;
OkRec:=0;
PB1.Min :=0;
PB1.Max :=EndRecord-StartRecord+1;
AQ_Temp:=TADOQuery.Create(Application);
Aq_Temp.Connection :=DllDBCnn;
try
TFName:=TStringList.Create;
SFName:=TStringList.Create;
QryTable:=TStringList.Create;
QryField:=TStringList.Create;
RstField:=TStringList.Create;
UpdField:=TStringList.Create;
Aq_Table.First;
Aq_Table.MoveBy(StartRecord-1);
CancelImport:=False;
BtnCancel.Enabled :=False;
for i:=1 to EndRecord-StartRecord+1 do
begin
Application.ProcessMessages ;
PB1.Position :=i;
LbMsg.Caption :='正在导入第 '+InttoStr(i)+' 条记录,共需要导入 '+InttoStr(EndRecord-StartRecord+1)+'条记录!';
if CancelImport then
begin
if Messagebox(Application.Handle,'真的要停止导入吗?','导入',Mb_IconQuestion+Mb_YesNo)=IdYes then
begin
Messagebox(Application.Handle,'由于用户取消导入,部分数据未导入成功!','提示',Mb_iconwarning+Mb_Ok);
BtnGo.Visible :=False;
Exit;
end;
CancelImport:=False;
end;
showmessage(inttostr(i));
//开始导入记录
try
TmpStr:='';
TmpStr2:='';
TFName.Clear;
SFName.Clear;
DllTargetDT.Append;
CDS_Temp.First;
for n:=0 to CDS_Temp.RecordCount-1 do
begin
TFName.Add(CDS_Temp.FieldByName('FieldName').AsString);
SFName.Add(CDS_Temp.FieldByName('SourceField').AsString);
QryTable.Add(Trim(CDS_Temp.FieldByName('QryTable').AsString));
QryField.Add(Trim(CDS_Temp.FieldByName('QryField').AsString));
RstField.Add(Trim(CDS_Temp.FieldByName('RstField').AsString));
UpdField.Add(Trim(CDS_Temp.FieldByName('UpdateField').AsString));
if CDS_Temp.FieldByName('QueryField').AsBoolean =True then
begin
if (QryTable[n]='') Or (QryField[n]='') Or (RstField[n]='') Or (UpdField[n]='') then
begin
MessageBox(Application.Handle,'导入参数不完整!','提示',MB_IconError+MB_Ok);
Continue;
end
else begin
RecExist:=False;
TmpStr2:=QryTable[n]+'/'+RstField[n]+'/'+UpdField[n];
if n>0 then
for m:=0 to n-1 do
if TmpStr2=QryTable[m]+'/'+RstField[m]+'/'+UpdField[m] then
begin
RecExist:=True;
Break;
end;
if RecExist=False then begin
With AQ_Temp do
begin
Close;
Sql.Clear;
Sql.Add('Select '+RstField[n]+' from '+QryTable[n]+' Where ');
CDS_Temp2.Filtered :=False;
CDS_Temp2.Filter :='QryTable='''+QryTable[n]+''' And RstField='''+RstField[n]+''' And UpdateField='''+UpdField[n]+'''';
CDS_Temp2.Filtered :=True;
CDS_Temp2.First;
for m:=1 to CDS_Temp2.RecordCount do
begin
if m>1 then
Sql.Add(' And ');
Sql.Add('('+CDS_Temp2.FieldByName('QryField').AsString+'='''+Trim(Aq_Table.FieldByName(CDS_Temp2.FieldByName('SourceField').AsString).AsString)+''')');
CDS_Temp2.Next;
end;
Open;
if RecordCount>0 then
DllTargetDT.FieldByName(UpdField[n]).Value :=FieldByName(RstField[n]).Value
else
DllTargetDT.FieldByName(UpdField[n]).Value :=CDS_Temp.FieldByName('DefaultValue').Value;
end;
end;
end;
end
else begin
if DllTargetDT.FieldByName(TFName.Strings[n]).DataType=ftDateTime then
begin
if Trim(Aq_Table.FieldByName(SFName.Strings[n]).AsString)<>'' then
begin
RstValue:=ConvertAsDateTime(Aq_Table.FieldByName(SFName.Strings[n]).AsString);
DllTargetDT.FieldByName(TFName.Strings[n]).AsString :=FormatDateTime('yyyy-MM-dd HH:mm:ss',RstValue);
end;
end
else
DllTargetDT.FieldByName(TFName.Strings[n]).AsString :=Aq_Table.FieldByName(SFName.Strings[n]).AsString;
end;
CDS_Temp.Next;
end; //end for
DllTargetDT.Post;
Inc(OkRec);
except
on e:Exception do
Memo1.Lines.Add('导入第 '+InttoStr(i)+' (绝对位置: '+InttoStr(StartRecord+i)+') 条记录时出错!错误信息:'+E.Message);
end;
Aq_Table.Next;
end; //end for
if (OkRec>0) And (SqlStr<>'') then
begin
LbMsg.Caption :='正在执行导入后命令';
Memo1.Lines.Add('开始执行导入后命令');
With Aq_Temp do
begin
Close;
Sql.Clear;
Sql.Add(SqlStr);
try
ExecSql;
Memo1.Lines.Add('导入后命令执行成功!');
except
on e:Exception do
Memo1.Lines.Add('执行导入后命令时出错!错误信息:'+E.Message);
end;
end;
end;
if OkRec=EndRecord-StartRecord+1 then
Messagebox(Application.Handle,'数据导入成功!','提示',Mb_Iconinformation+Mb_Ok)
else
begin
Messagebox(Application.Handle,Pchar('数据完成,但有 '+InttoStr(EndRecord-StartRecord+1-OkRec)+' 条记录导入失败!'),'提示',Mb_Iconinformation+Mb_Ok);
BtnGo.Visible :=False;
end;
finally
QryTable.Free;
QryField.Free;
RstField.Free;
UpdField.Free;
TFName.Free;
SFName.Free;
Aq_Temp.Free;
BtnCancel.Enabled :=True;
end;
end;
3:begin
CancelImport:=True;
end;
end;
finally
DllTargetDT.EnableControls;
end;
end;
procedure TfrmDIMain.AQ_TableAfterOpen(DataSet: TDataSet);
var
n:integer;
begin
inherited;
DBGrid2.Columns[3].Picklist.Clear;
if Aq_Table.RecordCount>0 then
begin
for n:=0 to Aq_Table.Fields.Count-1 do
DBGrid2.Columns[3].Picklist.Add(Aq_Table.Fields[n].FieldName);
PB1.Min:=1;
PB1.Max:=Aq_Table.RecordCount ;
end;
end;
procedure TfrmDIMain.RadioGroup2Click(Sender: TObject);
begin
dxSpinEdit1.Enabled :=(RadioGroup2.ItemIndex =1);
dxSpinEdit2.Enabled :=(RadioGroup2.ItemIndex =1);
end;
procedure TfrmDIMain.CheckBox1Click(Sender: TObject);
begin
DBGrid3.Enabled :=(CheckBox1.Checked);
RadioGroup4.Enabled :=(CheckBox1.Checked);
end;
procedure TfrmDIMain.BtnCancelClick(Sender: TObject);
begin
Close;
end;
procedure TfrmDIMain.DBGrid3ColExit(Sender: TObject);
begin
if DBGrid3.SelectedField.DataType = ftBoolean then
DBGrid3.Options := Self.FOriginalOptions;
end;
procedure TfrmDIMain.DBGrid3ColEnter(Sender: TObject);
begin
if DBGrid3.SelectedField.DataType = ftBoolean then
begin
FOriginalOptions := DBGrid3.Options;
DBGrid3.Options := DBGrid3.Options - [dgEditing];
end;
end;
procedure TfrmDIMain.DBGrid3DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
Const
CtrlState : array[Boolean] of Integer = (DFCS_BUTTONCHECK,
DFCS_BUTTONCHECK or DFCS_CHECKED);
var
CheckBoxRectangle : TRect;
begin
if Column.Field.DataType = ftBoolean then
begin
DBGrid3.Canvas.FillRect(Rect);
CheckBoxRectangle.Left := Rect.Left + 2;
CheckBoxRectangle.Right := Rect.Right - 2;
CheckBoxRectangle.Top := Rect.Top + 2;
CheckBoxRectangle.Bottom := Rect.Bottom - 2;
DrawFrameControl(DBGrid3.Canvas.Handle,
CheckBoxRectangle,
DFC_BUTTON,
CtrlState[Column.Field.AsBoolean]);
end;
end;
procedure TfrmDIMain.DBGrid3CellClick(Column: TColumn);
begin
if DBGrid3.SelectedField.DataType = ftBoolean then
SaveBoolean();
end;
procedure TfrmDIMain.BtnBackClick(Sender: TObject);
begin
if Pagecontrol1.ActivePageIndex=0 then
Pageswitch(0)
else
Pageswitch(pagecontrol1.ActivePageIndex-1);
end;
procedure TfrmDIMain.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
begin
DBGridRecordSize(Column);
with TMyDBGrid(Sender) do
begin
if DataLink.ActiveRecord=Row-1 then
begin
Canvas.Font.Color:=clWhite;
Canvas.Brush.Color:=$00800040;
end
else
begin
Canvas.Brush.Color:=Color;
Canvas.Font.Color:=Font.Color;
end;
DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;
end;
procedure TfrmDIMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CDS_Temp.Free;
CDS_Temp2.Free;
Action:=cafree;
end;
procedure TfrmDIMain.FormShow(Sender: TObject);
var
i:Integer;
FName:String;
begin
try
CDS_Temp.FieldDefs.Clear;
CDS_Temp.FieldDefs.Add('Autoid',ftAutoInc,0);
CDS_Temp.FieldDefs.Add('FieldName',ftString,30);
CDS_Temp.FieldDefs.Add('DataType',ftString,30);
CDS_Temp.FieldDefs.Add('DataSize',ftInteger,0);
CDS_Temp.FieldDefs.Add('FieldCaption',ftString,30);
CDS_Temp.FieldDefs.Add('FieldVisable',ftBoolean,0);
CDS_Temp.FieldDefs.Add('QueryField',ftBoolean,0);
CDS_Temp.FieldDefs.Add('QryTable',ftString,30);
CDS_Temp.FieldDefs.Add('QryField',ftString,30);
CDS_Temp.FieldDefs.Add('RstField',ftString,30);
CDS_Temp.FieldDefs.Add('UpdateField',ftString,30);
CDS_Temp.FieldDefs.Add('SourceField',ftString,30);
CDS_Temp.FieldDefs.Add('DefaultValue',ftString,50);
CDS_Temp.CreateDataSet;
With DllCfgDT do
begin
DllCfgDT.First;
for i:=0 to DllCfgDT.RecordCount-1 do
begin
FName:=Trim(DllCfgDT.FieldByName('FieldName').AsString);
Edit;
Case DllTargetDT.FieldByName(FName).DataType of
ftString:begin
FieldByName('DataType').AsString :='字符串型';
end;
ftAutoInc:begin
FieldByName('DataType').AsString :='自动编号';
end;
ftSmallInt,ftInteger,ftWord:begin
FieldByName('DataType').AsString :='整型';
end;
ftBoolean:begin
FieldByName('DataType').AsString :='布尔型';
end;
ftFloat:begin
FieldByName('DataType').AsString :='浮点型';
end;
ftCurrency:begin
FieldByName('DataType').AsString :='货币型';
end;
ftDate:begin
FieldByName('DataType').AsString :='日期型';
end;
ftTime:begin
FieldByName('DataType').AsString :='时间型';
end;
ftDateTime:begin
FieldByName('DataType').AsString :='日期时间型';
end ;
ftBlob:begin
FieldByName('DataType').AsString :='图片';
end;
else
begin
FieldByName('DataType').AsString :='数据类型未知';
end;
end; //end case
Post;
DllCfgDT.Next;
end;
end;
finally
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -