123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431 |
- unit stgGclSubGatherFile;
- // 导入导出汇总结果
- interface
- uses
- stgGclSubGatherFileDm, ADODB, sdDB, stgGclGatherDm, SysUtils, ProjectData,
- StageDm, mDataRecord, BillsTree, DetailExcelImport, OExport, stgGclImportHint;
- type
- TstgGclSubGatherFileHelper = class
- private
- FTempFile: string;
- FConnection: TADOConnection;
- FGatherData: TstgGclSubGatherData;
- public
- constructor Create;
- destructor Destroy; override;
- procedure Open(const AFileName: string);
- procedure Close;
- procedure SaveTo(const AFileName: string);
- property Connection: TADOConnection read FConnection;
- property GatherData: TstgGclSubGatherData read FGatherData;
- end;
- TstgGclSubGatherFileExportor = class(TstgGclSubGatherFileHelper)
- private
- procedure LoadMemoryRecord(ARec: TsdDataRecord);
- procedure LoadMemoryGatherData(AGatherData: TstgGclGatherData);
- public
- procedure ExportGatherDataTo(AGatherData: TstgGclGatherData; const AFileName: string);
- end;
- TstgGclSubGatherFileImportor = class(TstgGclSubGatherFileHelper)
- private
- FFails: TstgGclFailList;
- procedure ClearOldData(AStageData: TStageData);
- procedure ImportGatherData(AProjectData: TProjectData);
- public
- constructor Create;
- destructor Destroy; override;
- procedure ImportGatherDataTo(AProjectData: TProjectData; const AFileName: string);
- end;
- TstgGclSubGatherFileExcelImportor = class(TDetailExcelImport)
- private
- FCurRow: Integer;
- FB_CodeCol: Integer;
- FNameCol: Integer;
- FUnitsCol: Integer;
- FPriceCol: Integer;
- FDealQuantityCol: Integer;
- FFails: TstgGclFailList;
- procedure ClearOldData(AStageData: TStageData);
- function LoadColumnsFromHead(ASheet: TExportWorkSheet): Boolean;
- procedure LoadGatherData(ASheet: TExportWorkSheet);
- protected
- procedure BeginImport; override;
- procedure EndImport; override;
- procedure Import; override;
- public
- constructor Create(AProjectData: TProjectData); override;
- destructor Destroy; override;
- end;
- implementation
- uses
- UtilMethods, ZhAPI, Connections, stgGclTables, ScAutoUpdateUnit, Math,
- BillsMeasureDm, stgGclImportHintFrm;
- { TstgGclSubGatherFileExportor }
- procedure TstgGclSubGatherFileExportor.ExportGatherDataTo(
- AGatherData: TstgGclGatherData; const AFileName: string);
- begin
- Open(GetEmptyDataBaseFileName);
- try
- LoadMemoryGatherData(AGatherData);
- finally
- SaveTo(AFileName);
- end;
- end;
- procedure TstgGclSubGatherFileExportor.LoadMemoryRecord(ARec: TsdDataRecord);
- var
- vRec: TsdDataRecord;
- begin
- vRec := GatherData.sddBills.Add;
- vRec.ValueByName('B_Code').AsString := ARec.ValueByName('B_Code').AsString;
- vRec.ValueByName('Name').AsString := ARec.ValueByName('Name').AsString;
- vRec.ValueByName('Units').AsString := ARec.ValueByName('Units').AsString;
- vRec.ValueByName('Price').AsFloat := ARec.ValueByName('Price').AsFloat;
- vRec.ValueByName('DealQuantity').AsFloat := ARec.ValueByName('DealQuantity').AsFloat;
- vRec.ValueByName('DealTotalPrice').AsFloat := ARec.ValueByName('DealTotalPrice').AsFloat;
- vRec.ValueByName('QcQuantity').AsFloat := ARec.ValueByName('QcQuantity').AsFloat;
- vRec.ValueByName('QcTotalPrice').AsFloat := ARec.ValueByName('QcTotalPrice').AsFloat;
- vRec.ValueByName('QcBGLCode').AsString := ARec.ValueByName('QcBGLCode').AsString;
- vRec.ValueByName('QcBGLNum').AsString := ARec.ValueByName('QcBGLNum').AsString;
- end;
- procedure TstgGclSubGatherFileExportor.LoadMemoryGatherData(
- AGatherData: TstgGclGatherData);
- var
- i: Integer;
- vRec: TsdDataRecord;
- begin
- GatherData.sddBills.BeginUpdate;
- try
- for i := 0 to AGatherData.sddGatherGcl.RecordCount - 1 do
- begin
- vRec := AGatherData.sddGatherGcl.Records[i];
- LoadMemoryRecord(vRec);
- end;
- finally
- GatherData.sddBills.EndUpdate;
- end;
- end;
- { TstgGclSubGatherFileHelper }
- procedure TstgGclSubGatherFileHelper.Close;
- begin
- FConnection.Close;
- if FileExists(FTempFile) then
- DeleteFile(FTempFile);
- end;
- constructor TstgGclSubGatherFileHelper.Create;
- begin
- FConnection := TADOConnection.Create(nil);
- FConnection.LoginPrompt := False;
- FGatherData := TstgGclSubGatherData.Create(nil);
- end;
- destructor TstgGclSubGatherFileHelper.Destroy;
- begin
- Close;
- FGatherData.Free;
- FConnection.Free;
- inherited;
- end;
- procedure TstgGclSubGatherFileHelper.Open(const AFileName: string);
- procedure UpdateDataTables;
- var
- Updater: TScUpdater;
- begin
- Updater := TScUpdater.Create;
- try
- Updater.ForceUpdate := True;
- Updater.Open('', FConnection, '', '');
- Updater.AddTableDef(sStgGclBills, @tdStgGclBills, Length(tdStgGclBills), False, False);
- Updater.ExcuteUpdate;
- finally
- Updater.Free;
- end;
- end;
- begin
- FTempFile := GetTempFileName;
- CopyFileOrFolder(AFileName, FTempFile);
- FConnection.ConnectionString := Format(SAdoConnectStr, [FTempFile]);
- FConnection.Open;
- UpdateDataTables;
- GatherData.Open(FConnection);
- end;
- procedure TstgGclSubGatherFileHelper.SaveTo(const AFileName: string);
- begin
- FGatherData.Save;
- CopyFileOrFolder(FTempFile, AFileName);
- end;
- { TstgGclSubGatherFileImportor }
- procedure TstgGclSubGatherFileImportor.ClearOldData(AStageData: TStageData);
- var
- i: Integer;
- vRec: TStageRecord;
- begin
- for i := 0 to AStageData.sddStage.RecordCount - 1 do
- begin
- vRec := TStageRecord(AStageData.sddStage.Records[i]);
- vRec.DealQuantity.AsFloat := 0;
- vRec.DealTotalPrice.AsFloat := 0;
- vRec.DealFlag.AsInteger := 0;
- vRec.DealFormula.AsString := '';
- vRec.EndDealQuantity.AsFloat := vRec.PreDealQuantity.AsFloat;
- vRec.EndDealTotalPrice.AsFloat := vRec.PreDealTotalPrice.AsFloat;
- end;
- end;
- constructor TstgGclSubGatherFileImportor.Create;
- begin
- FFails := TstgGclFailList.Create;
- inherited Create;
- end;
- destructor TstgGclSubGatherFileImportor.Destroy;
- begin
- FFails.Free;
- inherited;
- end;
- procedure TstgGclSubGatherFileImportor.ImportGatherData(
- AProjectData: TProjectData);
- function FindBillsNode(ARec: TsdDataRecord): TBillsIDTreeNode;
- var
- i: Integer;
- vNode: TBillsIDTreeNode;
- begin
- Result := nil;
- for i := 0 to AProjectData.BillsMeasureData.BillsMeasureTree.Count - 1 do
- begin
- vNode := TBillsIDTreeNode(AProjectData.BillsMeasureData.BillsMeasureTree.Items[i]);
- if (vNode.HasChildren) then Continue;
- if (vNode.Rec.B_Code.AsString = ARec.ValueByName('B_Code').AsString) and
- (vNode.Rec.Name.AsString = ARec.ValueByName('Name').AsString) and
- (vNode.Rec.Units.AsString = ARec.ValueByName('Units').AsString) then
- //(vNode.Rec.Units.AsString = ARec.ValueByName('Units').AsString) and
- //(CommonRoundTo(vNode.Rec.Price.AsFloat - ARec.ValueByName('Price').AsFloat, -6) = 0) then
- begin
- Result := vNode;
- Break;
- end;
- end;
- end;
- var
- i: Integer;
- vNode: TBillsIDTreeNode;
- vOrgRec: TsdDataRecord;
- vStageRec: TStageRecord;
- begin
- for i := 0 to GatherData.sddBills.RecordCount - 1 do
- begin
- vOrgRec := GatherData.sddBills.Records[i];
- vNode := FindBillsNode(vOrgRec);
- if Assigned(vNode) then
- begin
- vStageRec := AProjectData.PhaseData.StageData.StageRecordWithAdd(vNode.ID);
- vStageRec.DealQuantity.AsFloat := vOrgRec.ValueByName('DealQuantity').AsFloat;
- end
- else
- FFails.AddFailGcl(vOrgRec.ValueByName('B_Code').AsString,
- vOrgRec.ValueByName('Name').AsString, vOrgRec.ValueByName('Units').AsString,
- vOrgRec.ValueByName('Price').AsFloat, vOrgRec.ValueByName('DealQuantity').AsFloat);
- end;
- end;
- procedure TstgGclSubGatherFileImportor.ImportGatherDataTo(
- AProjectData: TProjectData; const AFileName: string);
- begin
- Open(AFileName);
- AProjectData.PhaseData.StageData.sddStage.BeginUpdate;
- AProjectData.PhaseData.StageData.BeforeBatchOperation;
- try
- ClearOldData(AProjectData.PhaseData.StageData);
- ImportGatherData(AProjectData);
- finally
- AProjectData.PhaseData.StageData.AfterBatchOperation;
- AProjectData.PhaseData.StageData.sddStage.EndUpdate;
- end;
- if FFails.Count > 0 then
- ShowGclImportForm(FFails);
- end;
- { TstgGclSubGatherFileExcelImportor }
- procedure TstgGclSubGatherFileExcelImportor.BeginImport;
- begin
- inherited;
- ProjectData.PhaseData.StageData.sddStage.BeginUpdate;
- ProjectData.PhaseData.StageData.BeforeBatchOperation;
- end;
- procedure TstgGclSubGatherFileExcelImportor.ClearOldData(
- AStageData: TStageData);
- var
- i: Integer;
- vRec: TStageRecord;
- begin
- for i := 0 to AStageData.sddStage.RecordCount - 1 do
- begin
- vRec := TStageRecord(AStageData.sddStage.Records[i]);
- vRec.DealQuantity.AsFloat := 0;
- vRec.DealTotalPrice.AsFloat := 0;
- vRec.DealFlag.AsInteger := 0;
- vRec.DealFormula.AsString := '';
- vRec.EndDealQuantity.AsFloat := vRec.PreDealQuantity.AsFloat;
- vRec.EndDealTotalPrice.AsFloat := vRec.PreDealTotalPrice.AsFloat;
- end;
- end;
- constructor TstgGclSubGatherFileExcelImportor.Create(
- AProjectData: TProjectData);
- begin
- inherited Create(AProjectData);
- FFails := TstgGclFailList.Create;
- end;
- destructor TstgGclSubGatherFileExcelImportor.Destroy;
- begin
- FFails.Free;
- inherited;
- end;
- procedure TstgGclSubGatherFileExcelImportor.EndImport;
- begin
- ProjectData.PhaseData.StageData.AfterBatchOperation;
- ProjectData.PhaseData.StageData.sddStage.EndUpdate;
- if FFails.Count > 0 then
- ShowGclImportForm(FFails);
- inherited;
- end;
- procedure TstgGclSubGatherFileExcelImportor.Import;
- begin
- ClearOldData(ProjectData.PhaseData.StageData);
- FCurRow := 0;
- if LoadColumnsFromHead(OExport.OpenWorkSheet) then
- LoadGatherData(OExport.OpenWorkSheet)
- else
- ErrorMessage('导入的Excel格式有误!');
- inherited;
- end;
- function TstgGclSubGatherFileExcelImportor.LoadColumnsFromHead(
- ASheet: TExportWorkSheet): Boolean;
- var
- vRow: TExportRow;
- iCol: Integer;
- sColName: String;
- begin
- FB_CodeCol := -1;
- FNameCol := -1;
- FUnitsCol := -1;
- FPriceCol := -1;
- FDealQuantityCol := -1;
- vRow := ASheet.Rows[FCurRow];
- for iCol := 0 to vRow.Cells.Count - 1 do
- begin
- sColName := GetCellTrimStr(vRow, iCol);
- if (sColName = '清单编号') then
- FB_CodeCol := iCol
- else if sColName = '名称' then
- FNameCol := iCol
- else if sColName = '单位' then
- FUnitsCol := iCol
- else if sColName = '单价' then
- FPriceCol := iCol
- else if (sColName = '合同计量') then
- FDealQuantityCol := iCol;
- end;
- Result := (FB_CodeCol <> -1) and (FNameCol <> -1) and (FUnitsCol <> -1) and
- (FPriceCol <> -1) and (FDealQuantityCol <> -1);
- Inc(FCurRow);
- end;
- procedure TstgGclSubGatherFileExcelImportor.LoadGatherData(
- ASheet: TExportWorkSheet);
- function FindBillsNode(const AB_Code, AName, AUnits: string; APrice: Double): TBillsIDTreeNode;
- var
- i: Integer;
- vNode: TBillsIDTreeNode;
- begin
- Result := nil;
- for i := 0 to ProjectData.BillsMeasureData.BillsMeasureTree.Count - 1 do
- begin
- vNode := TBillsIDTreeNode(ProjectData.BillsMeasureData.BillsMeasureTree.Items[i]);
- if (vNode.HasChildren) then Continue;
- if (vNode.Rec.B_Code.AsString = AB_Code) and
- (vNode.Rec.Name.AsString = AName) and
- (vNode.Rec.Units.AsString = AUnits) then
- //(vNode.Rec.Units.AsString = AUnits) and
- //(CommonRoundTo(vNode.Rec.Price.AsFloat - APrice, -6) = 0) then
- begin
- Result := vNode;
- Break;
- end;
- end;
- end;
- var
- vRow: TExportRow;
- sB_Code, sName, sUnits: string;
- fPrice: Double;
- vNode: TBillsIDTreeNode;
- vStageRec: TStageRecord;
- begin
- while FCurRow < ASheet.Rows.Count do
- begin
- vRow := ASheet.Rows[FCurRow];
- Inc(FCurRow);
- sB_Code := Trim(GetCellStr(vRow, FB_CodeCol));
- sName := Trim(GetCellStr(vRow, FNameCol));
- sUnits := Trim(GetCellStr(vRow, FUnitsCol));
- fPrice := StrToFloatDef(GetCellStr(vRow, FPriceCol), 0);
- if (sB_Code = '') then Continue;
- vNode := FindBillsNode(sB_Code, sName, sUnits, fPrice);
- if Assigned(vNode) then
- begin
- vStageRec := ProjectData.PhaseData.StageData.StageRecordWithAdd(vNode.ID);
- vStageRec.DealQuantity.AsFloat := StrToFloatDef(GetCellStr(vRow, FDealQuantityCol), 0);
- end
- else
- FFails.AddFailGcl(sB_Code, sName, sUnits, fPrice, StrToFloatDef(GetCellStr(vRow, FDealQuantityCol), 0));
- end;
- end;
- end.
|