RTFormwork/项目代码/RTBasicsV1/B01基础合同管理/U_ContractImport.pas
“ddf” 719cdbc141 1
2024-07-07 19:26:56 +08:00

479 lines
13 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit U_ContractImport;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin, StdCtrls,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, ShellAPI, IniFiles, cxCheckBox, cxCalendar, cxButtonEdit,
cxTextEdit, cxDropDownEdit, cxPC, U_BaseHelp, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, ComObj, U_BaseList, System.ImageList,
Vcl.ImgList, dxSkinWXI, dxScrollbarAnnotations, dxSkinBasic, dxSkinBlack,
dxSkinBlue, dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee, dxSkinDarkroom,
dxSkinDarkSide, dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle, dxSkinFoggy,
dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary, dxSkinLilian,
dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMetropolis,
dxSkinMetropolisDark, dxSkinMoneyTwins, dxSkinOffice2007Black,
dxSkinOffice2007Blue, dxSkinOffice2007Green, dxSkinOffice2007Pink,
dxSkinOffice2007Silver, dxSkinOffice2010Black, dxSkinOffice2010Blue,
dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, dxSkinOffice2013LightGray,
dxSkinOffice2013White, dxSkinOffice2016Colorful, dxSkinOffice2016Dark,
dxSkinOffice2019Black, dxSkinOffice2019Colorful, dxSkinOffice2019DarkGray,
dxSkinOffice2019White, dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic,
dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, dxSkinSpringtime, dxSkinStardust,
dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinTheBezier, dxSkinValentine,
dxSkinVisualStudio2013Blue, dxSkinVisualStudio2013Dark,
dxSkinVisualStudio2013Light, dxSkinVS2010, dxSkinWhiteprint,
dxSkinXmas2008Blue;
type
TfrmContractImport = class(TfrmBaseHelp)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
ADO_1: TADOQuery;
GPM_1: TcxGridPopupMenu;
DS_1: TDataSource;
CDS_1: TClientDataSet;
cxStyleRepository1: TcxStyleRepository;
cxStyle1: TcxStyle;
OpenDialog1: TOpenDialog;
ToolButton5: TToolButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
CDS_LM1: TClientDataSet;
ToolButton3: TToolButton;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
Tv2Column15: TcxGridDBColumn;
Tv2Column16: TcxGridDBColumn;
VC_SCSCode: TcxGridDBColumn;
v1Column4: TcxGridDBColumn;
Tv2Column3: TcxGridDBColumn;
Tv2Column2: TcxGridDBColumn;
Tv2Column4: TcxGridDBColumn;
v1Column5: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
Tv2Column6: TcxGridDBColumn;
Tv2Column8: TcxGridDBColumn;
Tv2Column5: TcxGridDBColumn;
v1Column8: TcxGridDBColumn;
Tv2Column10: TcxGridDBColumn;
Tv2Column1: TcxGridDBColumn;
v1Column6: TcxGridDBColumn;
v1Column7: TcxGridDBColumn;
v1PRTOrderQty: TcxGridDBColumn;
v1OrderUnit: TcxGridDBColumn;
Tv2Column12: TcxGridDBColumn;
Tv2Column13: TcxGridDBColumn;
Tv2Column11: TcxGridDBColumn;
v1PRTPrice: TcxGridDBColumn;
Tv2Column9: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
cxGrid2Level1: TcxGridLevel;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1OrdDate: TcxGridDBColumn;
v1ConNo: TcxGridDBColumn;
cxGridDBColumn2: TcxGridDBColumn;
v1CustomerNoName: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
Tv1Column19: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
Tv1Column14: TcxGridDBColumn;
Tv1Column7: TcxGridDBColumn;
cxGridDBColumn3: TcxGridDBColumn;
v1OrdPerson1: TcxGridDBColumn;
v1Column13: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
Tv1Column3: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
Tv1Column25: TcxGridDBColumn;
Tv1Column27: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
cxgrdpmn1: TcxGridPopupMenu;
CDS_2: TClientDataSet;
DS_2: TDataSource;
ADO_2: TADOQuery;
CDS_LM2: TClientDataSet;
Tv2Column7: TcxGridDBColumn;
Tv2Column14: TcxGridDBColumn;
Tv2Column17: TcxGridDBColumn;
Tv2Column18: TcxGridDBColumn;
Tv2Column19: TcxGridDBColumn;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
public
{ Public declarations }
FCTID: string;
end;
var
frmContractImport: TfrmContractImport;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmContractImport.InitGrid();
begin
with ADO_1 do
begin
Close;
SQL.Clear;
sql.Add(' select * from BS_Contract_Main where 2= 1 ');
Open;
end;
SCreateCDS(ADO_1, CDS_1);
// SInitCDSData(ADO_1, CDS_1);
with ADO_2 do
begin
Close;
SQL.Clear;
sql.Add(' select * from BS_Contract_sub where 2= 1 ');
Open;
end;
SCreateCDS(ADO_2, CDS_2);
// SInitCDSData(ADO_2, CDS_2);
end;
procedure TfrmContractImport.FormDestroy(Sender: TObject);
begin
inherited;
frmContractImport := nil;
end;
procedure TfrmContractImport.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := cafree;
end;
procedure TfrmContractImport.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmContractImport.FormShow(Sender: TObject);
begin
inherited;
ReadCxGrid(self.Caption + 'Tv1', Tv1, '<27><>ͬ<EFBFBD><CDAC><EFBFBD><EFBFBD>');
ReadCxGrid(self.Caption + 'Tv2', Tv2, '<27><>ͬ<EFBFBD><CDAC><EFBFBD><EFBFBD>');
with CDS_LM1 do
begin
FieldDefs.Clear;
FieldDefs.Add('LXH', ftInteger, 0);
FieldDefs.Add('lCode', ftString, 40);
FieldDefs.Add('LName', ftString, 40);
close;
CreateDataSet;
end;
with CDS_LM2 do
begin
FieldDefs.Clear;
FieldDefs.Add('LXH', ftInteger, 0);
FieldDefs.Add('lCode', ftString, 40);
FieldDefs.Add('LName', ftString, 40);
close;
CreateDataSet;
end;
InitGrid();
end;
procedure TfrmContractImport.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmContractImport.ToolButton1Click(Sender: TObject);
begin
WriteCxGrid(self.Caption + 'Tv1', Tv1, '<27><>ͬ<EFBFBD><CDAC><EFBFBD><EFBFBD>');
WriteCxGrid(self.Caption + 'Tv2', Tv2, '<27><>ͬ<EFBFBD><CDAC><EFBFBD><EFBFBD>');
end;
procedure TfrmContractImport.ToolButton2Click(Sender: TObject);
var
maxno: string;
hh: Integer;
begin
hh := 0;
try
ADOQueryCmd.Connection.BeginTrans;
if GetLSNo(ADOQueryTemp, maxno, 'DR', 'BS_Contract_Main', 4, 0) = False then
raise Exception.Create(<><C8A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>');
CDS_1.DisableControls;
CDS_2.DisableControls;
with CDS_1 do
begin
First;
while not eof do
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select top 1 * from BS_Contract_Main where ConNo=' + quotedstr(Trim(CDS_1.fieldbyname('ConNo').AsString)));
open;
end;
if not ADOQueryCmd.IsEmpty then
raise Exception.Create(PChar('<27><>ͬ<EFBFBD>ţ<EFBFBD>' + Trim(ADOQueryCmd.fieldbyname('ConNo').AsString) + ' <20>ظ<EFBFBD><D8B8><EFBFBD>'));
with ADOQueryCmd do
begin
Append;
FieldByName('Fillid').Value := Trim(Dcode);
FieldByName('Filler').Value := Trim(DName);
RTSetSaveDataCDS(ADOQueryCmd, Tv1, CDS_1, 'BS_Contract_Main', 0);
FieldByName('ConMID').Value := Trim(CDS_1.fieldbyname('ConNo').AsString);
FieldByName('status').Value := '0';
Post;
end;
Next;
end;
end;
with CDS_2 do
begin
First;
hh := 1;
while not eof do
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select top 1 * from BS_Contract_Sub where 1=2 ');
open;
end;
with ADOQueryCmd do
begin
Append;
RTSetSaveDataCDS(ADOQueryCmd, Tv2, CDS_2, 'BS_Contract_Sub', 0);
FieldByName('ConSID').Value := maxno + inttostr(hh);
// FieldByName('SerialNo').Value := hh;
Post;
end;
hh := hh + 1;
Next;
end;
end;
ADOQueryCmd.Connection.CommitTrans;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('exec P_BS_Com_UP_AllTable @UPType=''<27><><EFBFBD>ۺ<EFBFBD>ͬ'' ');
ExecSQL;
end;
CDS_2.EnableControls;
CDS_1.EnableControls;
application.MessageBox('<27><EFBFBD>ɹ<EFBFBD>', '<27><>ʾ');
ModalResult := 1;
except
CDS_2.EnableControls;
CDS_1.EnableControls;
ADOQueryCmd.Connection.RollbackTrans;
application.MessageBox(PChar(Exception(ExceptObject).Message), '<27><>ʾ<EFBFBD><CABE>Ϣ', 0);
end;
end;
procedure TfrmContractImport.ToolButton3Click(Sender: TObject);
begin
CDS_1.Delete;
end;
procedure TfrmContractImport.ToolButton5Click(Sender: TObject);
var
excelApp, WorkBook: Variant;
i, j, k, LX, ExcelRowCount: integer;
maxId, FCPID, FCPName, t1, t2, t3, FFID: string;
conflag: integer;
begin
try
excelApp := CreateOleObject('Excel.Application');
openDialog1.Filter := '*.CSV;*.xls';
if opendialog1.Execute then
begin
WorkBook := excelApp.WorkBooks.Open(OpenDialog1.FileName);
end
else
exit;
excelApp.Visible := false;
ExcelRowCount := WorkBook.WorkSheets[1].UsedRange.Rows.Count;
except
application.MessageBox('<27><><EFBFBD><EFBFBD>EXCEL<45><4C><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϣ', MB_ICONERROR);
exit;
end;
CDS_LM1.EmptyDataSet;
for j := 0 to Tv1.ColumnCount - 1 do
begin
with CDS_LM1 do
begin
Append;
FieldByName('LCode').Value := trim(Tv1.Columns[j].DataBinding.FieldName);
FieldByName('LName').Value := trim(Tv1.Columns[j].Caption);
Post;
end;
end;
try
for i := 1 to 50 do
begin
if trim(WorkBook.WorkSheets[1].Cells[1, i].value) = '' then
continue;
if trim(WorkBook.WorkSheets[1].Cells[1, i].value) = '<27><>ͬ<EFBFBD><CDAC>' then
begin
conflag := i;
end;
if CDS_LM1.Locate('LName', trim(WorkBook.WorkSheets[1].Cells[1, i].value), []) then
begin
with CDS_LM1 do
begin
Edit;
FieldByName('LXH').Value := i;
Post;
end;
end;
end;
except
application.MessageBox('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϣ', MB_ICONERROR);
exit;
end;
if conflag = 0 then
begin
application.MessageBox(<><CEB4><EFBFBD><EFBFBD><E2B5BD>ͬ<EFBFBD>ţ<EFBFBD>', '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϣ', MB_ICONERROR);
exit;
end;
CDS_LM2.EmptyDataSet;
for j := 0 to Tv2.ColumnCount - 1 do
begin
if not CDS_LM2.Locate('LName', trim(Tv2.Columns[j].Caption), []) then
begin
with CDS_LM2 do
begin
Append;
FieldByName('LCode').Value := trim(Tv2.Columns[j].DataBinding.FieldName);
FieldByName('LName').Value := trim(Tv2.Columns[j].Caption);
Post;
end;
end;
end;
try
for i := 1 to 50 do
begin
if trim(WorkBook.WorkSheets[1].Cells[1, i].value) = '' then
continue;
if CDS_LM2.Locate('LName', trim(WorkBook.WorkSheets[1].Cells[1, i].value), []) then
begin
with CDS_LM2 do
begin
Edit;
FieldByName('LXH').Value := i;
Post;
end;
end;
end;
except
application.MessageBox('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϣ', MB_ICONERROR);
exit;
end;
try
for i := 2 to ExcelRowCount do
begin
if trim(WorkBook.WorkSheets[1].Cells[i, conflag].Value) <> '' then
begin
if not CDS_1.Locate('ConNo', WorkBook.WorkSheets[1].Cells[i, conflag].Value, []) then
begin
with CDS_1 do
begin
Append;
CDS_LM1.First;
while not CDS_LM1.Eof do
begin
if CDS_LM1.FieldByName('LXH').AsInteger > 0 then
CDS_1.fieldbyname(CDS_LM1.FieldByName('LCode').AsString).Value := WorkBook.WorkSheets[1].Cells[i, CDS_LM1.FieldByName('LXH').AsInteger].Value;
CDS_LM1.Next;
end;
Post;
end;
end;
end;
end;
for i := 2 to ExcelRowCount do
begin
if trim(WorkBook.WorkSheets[1].Cells[i, conflag].Value) <> '' then
begin
with CDS_2 do
begin
Append;
CDS_LM2.First;
while not CDS_LM2.Eof do
begin
if CDS_LM2.FieldByName('LXH').AsInteger > 0 then
CDS_2.fieldbyname(CDS_LM2.FieldByName('LCode').AsString).Value := WorkBook.WorkSheets[1].Cells[i, CDS_LM2.FieldByName('LXH').AsInteger].Value;
CDS_LM2.Next;
end;
Post;
end;
end;
end;
WorkBook.Close;
excelApp.Quit;
excelApp := Unassigned;
WorkBook := Unassigned;
except
WorkBook.Close;
excelApp.Quit;
excelApp := Unassigned;
WorkBook := Unassigned;
exit;
end;
end;
end.