RTFormwork/项目代码/RTBasicsV1/B04采购计划管理/U_ClothPurImport.pas
“ddf” 719cdbc141 1
2024-07-07 19:26:56 +08:00

458 lines
12 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_ClothPurImport;
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
TfrmClothPurImport = 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;
cxgrdpmn1: TcxGridPopupMenu;
CDS_2: TClientDataSet;
DS_2: TDataSource;
ADO_2: TADOQuery;
CDS_LM2: TClientDataSet;
cxGrid2: TcxGrid;
TV2: TcxGridDBTableView;
TV2Column1: TcxGridDBColumn;
VC_SCSCode: TcxGridDBColumn;
cxGridDBColumn2: TcxGridDBColumn;
v1Column5: TcxGridDBColumn;
cxGridDBColumn4: TcxGridDBColumn;
cxGridDBColumn5: TcxGridDBColumn;
v1PRTOrderQty: TcxGridDBColumn;
v1OrderUnit: TcxGridDBColumn;
v1PRTPrice: TcxGridDBColumn;
cxGridDBColumn9: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
TV2Column2: TcxGridDBColumn;
TV2Column3: TcxGridDBColumn;
TV2Column4: TcxGridDBColumn;
TV2Column5: TcxGridDBColumn;
TV2Column6: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1OrdDate: TcxGridDBColumn;
v1DeliveryDate: TcxGridDBColumn;
v1ConNo: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1CustomerNoName: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
Tv1Column19: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
v1Column10: TcxGridDBColumn;
v1Column13: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
TV2Column7: 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
frmClothPurImport: TfrmClothPurImport;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmClothPurImport.InitGrid();
begin
with ADO_1 do
begin
Close;
SQL.Clear;
sql.Add(' select * from Pur_ClothPlan_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 Pur_ClothPlan_sub where 2= 1 ');
Open;
end;
SCreateCDS(ADO_2, CDS_2);
// SInitCDSData(ADO_2, CDS_2);
end;
procedure TfrmClothPurImport.FormDestroy(Sender: TObject);
begin
inherited;
frmClothPurImport := nil;
end;
procedure TfrmClothPurImport.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := cafree;
end;
procedure TfrmClothPurImport.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmClothPurImport.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 TfrmClothPurImport.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmClothPurImport.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 TfrmClothPurImport.ToolButton2Click(Sender: TObject);
var
maxno: string;
hh: Integer;
begin
hh := 0;
try
ADOQueryCmd.Connection.BeginTrans;
if GetLSNo(ADOQueryTemp, maxno, 'DR', 'Pur_ClothPlan_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 Pur_ClothPlan_Main where PurNo=' + quotedstr(Trim(CDS_1.fieldbyname('PurNo').AsString)));
open;
end;
if not ADOQueryCmd.IsEmpty then
raise Exception.Create(PChar('<27>ɹ<EFBFBD><C9B9><EFBFBD><EFBFBD>ţ<EFBFBD>' + Trim(ADOQueryCmd.fieldbyname('PurNo').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, 'Pur_ClothPlan_Main', 0);
FieldByName('PurMId').Value := Trim(CDS_1.fieldbyname('PurNo').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 Pur_ClothPlan_sub where 1=2 ');
open;
end;
with ADOQueryCmd do
begin
Append;
RTSetSaveDataCDS(ADOQueryCmd, Tv2, CDS_2, 'Pur_ClothPlan_sub', 0);
FieldByName('PurSId').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><C9B9><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 TfrmClothPurImport.ToolButton3Click(Sender: TObject);
begin
CDS_1.Delete;
end;
procedure TfrmClothPurImport.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><C9B9><EFBFBD><EFBFBD><EFBFBD>' 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>ɹ<EFBFBD><C9B9><EFBFBD><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('PurNo', 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.