D10xhGemei/A01基础公司管理/U_FactoryImport.pas
“ddf” 56b1ef408f 1
2024-12-14 17:23:12 +08:00

279 lines
7.0 KiB
ObjectPascal
Raw 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_FactoryImport;
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, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, ComObj, U_BaseList, System.ImageList,
Vcl.ImgList, dxScrollbarAnnotations;
type
TfrmFactoryImport = class(TfrmBaseHelp)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
ADOQueryMain: TADOQuery;
GPM_1: TcxGridPopupMenu;
DS_1: TDataSource;
CDS_1: TClientDataSet;
cxStyleRepository1: TcxStyleRepository;
cxStyle1: TcxStyle;
OpenDialog1: TOpenDialog;
ToolButton5: TToolButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
CDS_LM: TClientDataSet;
ToolButton3: TToolButton;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v2Column2: TcxGridDBColumn;
v2Column6: TcxGridDBColumn;
v2Column15: TcxGridDBColumn;
v2Column3: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
v2Column12: TcxGridDBColumn;
v2Column4: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
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
frmFactoryImport: TfrmFactoryImport;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmFactoryImport.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
SQL.Clear;
sql.Add(' select * from BS_Company where 2= 1 ');
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmFactoryImport.FormDestroy(Sender: TObject);
begin
inherited;
frmFactoryImport := nil;
end;
procedure TfrmFactoryImport.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := cafree;
end;
procedure TfrmFactoryImport.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmFactoryImport.FormShow(Sender: TObject);
begin
inherited;
ReadCxGrid(self.Caption, Tv1, '<27><>Ʒ<EFBFBD><C6B7><EFBFBD><EFBFBD>');
with CDS_LM 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 TfrmFactoryImport.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmFactoryImport.ToolButton1Click(Sender: TObject);
begin
WriteCxGrid(self.Caption, Tv1, '<27><>Ʒ<EFBFBD><C6B7><EFBFBD><EFBFBD>');
end;
procedure TfrmFactoryImport.ToolButton2Click(Sender: TObject);
begin
try
ADOQueryCmd.Connection.BeginTrans;
CDS_1.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_Company where CoCode=' + quotedstr(Trim(CDS_1.fieldbyname('CoCode').AsString)));
open;
end;
if not ADOQueryCmd.IsEmpty then
raise Exception.Create(PChar('<27><><EFBFBD>ţ<EFBFBD>' + Trim(ADOQueryCmd.fieldbyname('CoCode').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_Cloth_Info', 0);
FieldByName('COID').Value := Trim(CDS_1.fieldbyname('CoCode').AsString);
FieldByName('CoType').Value := '<27><>Ӧ<EFBFBD><D3A6>';
FieldByName('status').Value := '0';
Post;
end;
Next;
end;
end;
CDS_1.EnableControls;
ADOQueryCmd.Connection.CommitTrans;
except
ADOQueryCmd.Connection.RollbackTrans;
application.MessageBox(PChar(Exception(ExceptObject).Message), '<27><>ʾ<EFBFBD><CABE>Ϣ', 0);
end;
end;
procedure TfrmFactoryImport.ToolButton3Click(Sender: TObject);
begin
CDS_1.Delete;
end;
procedure TfrmFactoryImport.ToolButton5Click(Sender: TObject);
var
excelApp, WorkBook: Variant;
i, j, k, LX, ExcelRowCount: integer;
maxId, FCPID, FCPName, t1, t2, t3, FFID: string;
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_LM.EmptyDataSet;
for j := 0 to Tv1.ColumnCount - 1 do
begin
with CDS_LM 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 CDS_LM.Locate('LName', trim(WorkBook.WorkSheets[1].Cells[1, i].value), []) then
begin
with CDS_LM 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
with CDS_1 do
begin
Append;
CDS_LM.First;
while not CDS_LM.Eof do
begin
if CDS_LM.FieldByName('LXH').AsInteger > 0 then
CDS_1.fieldbyname(CDS_LM.FieldByName('LCode').AsString).Value := WorkBook.WorkSheets[1].Cells[i, CDS_LM.FieldByName('LXH').AsInteger].Value;
CDS_LM.Next;
end;
Post;
end;
end;
WorkBook.Close;
excelApp.Quit;
excelApp := Unassigned;
WorkBook := Unassigned;
except
WorkBook.Close;
excelApp.Quit;
excelApp := Unassigned;
WorkBook := Unassigned;
exit;
end;
end;
end.