unit ExcelImport; interface uses Classes, SMXLS, SMCells, ProjectData, MCacheTree, ZhAPI, sdDB, Forms, Controls, ProgressHintFrm, mDataRecord; type TExcelImport = class private FMSExcel: TMSExcel; FProjectData: TProjectData; FProgresssHintFrom: TProgressHintForm; procedure BeginImport; virtual; abstract; procedure EndImport; virtual; abstract; procedure Import; virtual; abstract; function GetCellValue(ASheet: TSpreadSheet; ACol, ARow: Integer): Variant; function GetCellTrimText(ASheet: TSpreadSheet; ACol, ARow: Integer): string; public constructor Create(AProjectData: TProjectData); destructor Destroy; override; procedure ImportFile(const AExcelFile: string); property MSExcel: TMSExcel read FMSExcel; end; TBillsExcelImport = class(TExcelImport) private FCacheTree: TBillsCacheTree; FCurRow: Integer; FLevelCol: Integer; FCodeCol: Integer; FB_CodeCol: Integer; FNameCol: Integer; FUnitsCol: Integer; FFixedIDCol: Integer; FCanDeleteCol: Integer; procedure BeginImport; override; procedure EndImport; override; procedure LoadColumnsFromHead(ASheet: TSpreadSheet); procedure LoadNodes(ASheet: TSpreadSheet); procedure LoadNode(ASheet: TSpreadSheet); procedure WriteNode(ADataSet: TsdDataSet; ANode: TBillsCacheNode); procedure WriteNodes(ADataSet: TsdDataSet); procedure Import; override; public procedure ImportToTree(ACacheTree: TBillsCacheTree; const sFileName: string); end; // 代码中注释部分为导入[无层次编号]的0号台账Excel TBillsEdtExcelImport = class(TExcelImport) private FCacheTree: TBillsCacheTree; FCurRow: Integer; FIsFirstPart: Boolean; FWithLevelCode: Boolean; FWithoutGclBills: Boolean; FBaseTree: TBillsCacheTree; FFixedIDNodes: TList; FCodeCol: Integer; FB_CodeCol: Integer; FNameCol: Integer; FUnitsCol: Integer; FPriceCol: Integer; FQuantityCol: Integer; FDgnQuantity1Col: Integer; FDgnQuantity2Col: Integer; FDrawingCol: Integer; FMemoCol: Integer; FLevelCol: Integer; procedure BeginImport; override; procedure EndImport; override; function GetFixedIDNode(AID: Integer): TBillsCacheNode; function GetFixedID(ACode, AName: string): Integer; procedure LoadBaseTree(ATree: TBillsCacheTree); procedure LoadColumnsFromHead(ASheet: TSpreadSheet); procedure LoadNodes(ASheet: TSpreadSheet); procedure LoadNode(ASheet: TSpreadSheet); procedure WriteNode(ADataSet: TsdDataSet; ANode: TBillsCacheNode); procedure WriteNodes(ADataSet: TsdDataSet); procedure Import; override; public property WithLevelCode: Boolean read FWithLevelCode write FWithLevelCode; property WithoutGclBills: Boolean read FWithoutGclBills write FWithoutGclBills; end; TGclBillsExcelImport = class(TExcelImport) private FParentID: Integer; FSelectSheets: TList; FCacheTree: TGclCacheTree; FCurRow: Integer; FB_CodeCol: Integer; FNameCol: Integer; FUnitsCol: Integer; FPriceCol: Integer; FQuantityCol: Integer; procedure BeginImport; override; procedure EndImport; override; procedure LoadNode(ASheet: TSpreadSheet); procedure ImportSheet(ASheet: TSpreadSheet); procedure WriteNode(ADataSet: TsdDataSet; ANode: TGclCacheNode); procedure WriteNodes(ADataSet: TsdDataSet); procedure Import; override; public property ParentID: Integer read FParentID write FParentID; end; // 清单单价 TBillsPriceExcelImport = class(TExcelImport) private FCurRow: Integer; FB_CodeCol: Integer; FNameCol: Integer; FPriceCol: Integer; procedure BeginImport; override; procedure EndImport; override; procedure LoadColumnsFromHead(ASheet: TSpreadSheet); procedure UpdateBillsPrice(const AB_Code: string; APrice: Double); procedure ImportBillsPriceData(ASheet: TSpreadSheet); procedure Import; override; end; // 合同清单 TDealBillsExcelImport = class(TExcelImport) private FCurRow: Integer; FBillsID: Integer; FB_CodeCol: Integer; FNameCol: Integer; FUnitsCol: Integer; FPriceCol: Integer; FQuantityCol: Integer; FTotalPriceCol: Integer; procedure BeginImport; override; procedure EndImport; override; procedure LoadColumnsFromHead(ASheet: TSpreadSheet); procedure LoadDealBillsData(ASheet: TSpreadSheet); procedure Import; override; end; implementation uses Variants, CacheTree, SysUtils, UtilMethods, sdDataSet, BillsDm, DealBillsDm, SheetSelectFrm, ADODB, Math; { TExcelImport } constructor TExcelImport.Create(AProjectData: TProjectData); begin FProjectData := AProjectData; FMSExcel := TMSExcel.Create(nil); end; destructor TExcelImport.Destroy; begin FMSExcel.Free; inherited; end; function TExcelImport.GetCellTrimText(ASheet: TSpreadSheet; ACol, ARow: Integer): string; begin Result := Trim(VarToStrDef(GetCellValue(ASheet, ACol, ARow), '')); end; function TExcelImport.GetCellValue(ASheet: TSpreadSheet; ACol, ARow: Integer): Variant; begin Result := Null; if ACol <> -1 then Result := ASheet.Cells.GetValue(ACol, ARow); end; procedure TExcelImport.ImportFile(const AExcelFile: string); begin BeginImport; try FMSExcel.LoadFromFile(AExcelFile); Import; finally EndImport; end; end; { TBillsExcelImport } procedure TBillsExcelImport.BeginImport; begin FCurRow := 0; FCacheTree := TBillsCacheTree.Create; FCacheTree.NewNodeID := 101; FCacheTree.SeparateChar := '.'; FCacheTree.AutoSort := True; end; procedure TBillsExcelImport.EndImport; begin FCacheTree.Free; end; procedure TBillsExcelImport.Import; begin LoadColumnsFromHead(FMSExcel.Sheets.Spreadsheet(0)); LoadNodes(FMSExcel.Sheets.Spreadsheet(0)); WriteNodes(FProjectData.BillsData.sddBills); end; procedure TBillsExcelImport.ImportToTree(ACacheTree: TBillsCacheTree; const sFileName: string); var sChar: Char; begin FCurRow := 0; FCacheTree := ACacheTree; sChar := FCacheTree.SeparateChar; FCacheTree.SeparateChar := '.'; MSExcel.LoadFromFile(sFileName); LoadColumnsFromHead(FMSExcel.Sheets.Spreadsheet(0)); LoadNodes(FMSExcel.Sheets.Spreadsheet(0)); FCacheTree.SeparateChar := sChar; end; procedure TBillsExcelImport.LoadColumnsFromHead(ASheet: TSpreadSheet); var iCol: Integer; sColName: string; begin for iCol := 0 to ASheet.Cells.UsedRowCount do begin sColName := VarToStrDef(ASheet.Cells.GetValue(iCol, FCurRow), ''); if sColName = '层次编号' then FLevelCol := iCol else if sColName = '项目节编号' then FCodeCol := iCol else if sColName = '清单子目号' then FB_CodeCol := iCol else if sColName = '名称' then FNameCol := iCol else if sColName = '单位' then begin FUnitsCol := iCol; FFixedIDCol := iCol + 1; FCanDeleteCol := iCol + 2; end; end; Inc(FCurRow); end; procedure TBillsExcelImport.LoadNode(ASheet: TSpreadSheet); var sLevelCode: string; iFixedID: Integer; Node: TBillsCacheNode; vValue: Variant; begin sLevelCode := GetCellTrimText(ASheet, FLevelCol, FCurRow); if sLevelCode = '' then Exit; iFixedID := StrToIntDef(GetCellTrimText(ASheet, FFixedIDCol, FCurRow), -1); Node := FCacheTree.AddNodeByCode(sLevelCode, iFixedID); Node.Code := GetCellTrimText(ASheet, FCodeCol, FCurRow); Node.B_Code := GetCellTrimText(ASheet, FB_CodeCol, FCurRow); Node.Name := GetCellTrimText(ASheet, FNameCol, FCurRow); Node.Units := GetCellTrimText(ASheet, FUnitsCol, FCurRow); Node.CanDelete := VarToIntDef(GetCellValue(ASheet, FCanDeleteCol, FCurRow), 0) = 0; end; procedure TBillsExcelImport.LoadNodes(ASheet: TSpreadSheet); begin while FCurRow < ASheet.Cells.UsedRowCount do begin LoadNode(ASheet); Inc(FCurRow); end; end; procedure TBillsExcelImport.WriteNode(ADataSet: TsdDataSet; ANode: TBillsCacheNode); var Rec: TBillsRecord; begin Rec := TBillsRecord(ADataSet.Add); Rec.ID.AsInteger := ANode.ID; Rec.ParentID.AsInteger := ANode.ParentID; Rec.NextSiblingID.AsInteger := ANode.NextSiblingID; Rec.Code.AsString := ANode.Code; Rec.B_Code.AsString := ANode.B_Code; Rec.Name.AsString := ANode.Name; Rec.Units.AsString := ANode.Units; //Rec.ValueByName('LockedLevel').AsBoolean := ANode.CanDelete; end; procedure TBillsExcelImport.WriteNodes(ADataSet: TsdDataSet); var i: Integer; begin for i := 0 to FCacheTree.CacheNodes.Count - 1 do WriteNode(ADataSet, TBillsCacheNode(FCacheTree.CacheNodes[i])); end; { TBillsEdtExcelImport } procedure TBillsEdtExcelImport.BeginImport; begin Screen.Cursor := crHourGlass; ShowProgressHint('导入Excel数据', 100, '读取Excel数据', 100); FCurRow := 0; FIsFirstPart := True; FCacheTree := TBillsCacheTree.Create; FCacheTree.NewNodeID := 101; // 以层次编号为依据,分隔用'.',以项目节、清单编号为依据,分隔用'-' if WithLevelCode then FCacheTree.SeparateChar := '.' else FCacheTree.SeparateChar := '-'; FCacheTree.AutoSort := True; FProjectData.DisConnectTree; FProjectData.BillsData.DisableEvents; FBaseTree := TBillsCacheTree.Create; FBaseTree.NewNodeID := 101; FBaseTree.SeparateChar := '.'; FFixedIDNodes := TList.Create; end; procedure TBillsEdtExcelImport.EndImport; begin // For Test // FCacheTree.SaveTreeToFile('E:\Tree.txt'); FFixedIDNodes.Free; FBaseTree.Free; FProjectData.BillsData.EnableEvents; FProjectData.ReConnectTree; FCacheTree.Free; FProjectData.BillsCompileData.CalculateAll; CloseProgressHint; Screen.Cursor := crDefault; end; function TBillsEdtExcelImport.GetFixedIDNode(AID: Integer): TBillsCacheNode; var i: Integer; Node: TBillsCacheNode; begin Result := nil; for i := 0 to FFixedIDNodes.Count - 1 do begin Node := TBillsCacheNode(FFixedIDNodes.Items[i]); if (AID = Node.ID) then begin Result := Node; Break; end; end; end; function TBillsEdtExcelImport.GetFixedID(ACode, AName: string): Integer; var i: Integer; Node: TBillsCacheNode; begin Result := -1; for i := 0 to FBaseTree.CacheNodes.Count - 1 do begin Node := TBillsCacheNode(FBaseTree.CacheNodes.Items[i]); if (Node.Code = ACode) and (Node.Name = AName) then begin if Node.ID < 100 then Result := Node.ID; Break; end; end; end; procedure TBillsEdtExcelImport.Import; begin if WithLevelCode then LoadBaseTree(FBaseTree) else LoadBaseTree(FCacheTree); LoadColumnsFromHead(FMSExcel.Sheets.Spreadsheet(0)); LoadNodes(FMSExcel.Sheets.Spreadsheet(0)); WriteNodes(FProjectData.BillsData.sddBills); end; procedure TBillsEdtExcelImport.LoadBaseTree(ATree: TBillsCacheTree); var BaseImportor: TBillsExcelImport; begin BaseImportor := TBillsExcelImport.Create(nil); try BaseImportor.ImportToTree(ATree, GetTemplateBillsFileName); finally BaseImportor.Free; end; end; procedure TBillsEdtExcelImport.LoadColumnsFromHead(ASheet: TSpreadSheet); var iCol: Integer; sColName: string; begin FCodeCol := -1; FB_CodeCol := -1; FNameCol := -1; FUnitsCol := -1; FPriceCol := -1; FQuantityCol := -1; FDgnQuantity1Col := -1; FDgnQuantity2Col := -1; FDrawingCol := -1; FMemoCol := -1; for iCol := 0 to ASheet.Cells.UsedRowCount do begin sColName := VarToStrDef(ASheet.Cells.GetValue(iCol, FCurRow), ''); if (sColName = '预算项目节') or (sColName = '项目节编号') then FCodeCol := iCol else if (sColName = '清单子目号') or (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 = '清单数量') or (sColName = '工程量') or (sColName = '数量') then FQuantityCol := iCol else if (sColName = '设计数量1') or (sColName = '数量1') then FDgnQuantity1Col := iCol else if (sColName = '设计数量2') or (sColName = '数量2') then FDgnQuantity2Col := iCol else if sColName = '图号' then FDrawingCol := iCol else if sColName = '备注' then FMemoCol := iCol else if sColName = '层次编号' then FLevelCol := iCol; end; Inc(FCurRow); end; procedure TBillsEdtExcelImport.LoadNode(ASheet: TSpreadSheet); var sLevelCode, sCode, sB_Code, sName: string; Node: TBillsCacheNode; vValue: Variant; iFixedID: Integer; begin sLevelCode := GetCellTrimText(ASheet, FLevelCol, FCurRow); sCode := GetCellTrimText(ASheet, FCodeCol, FCurRow); sB_Code := GetCellTrimText(ASheet, FB_CodeCol, FCurRow); sName := GetCellTrimText(ASheet, FNameCol, FCurRow); // 含层次编号时,层次编号为空不导入 // 不含层次编号时,仅导入第一部分,且项目节编号、清单编号均未空时不导入 if WithLevelCode then begin if sLevelCode = '' then Exit; end else begin if ((sCode = '') and (sB_Code = '')) or SameText(sCode, '2') or (Pos('第二部分', sName) > 0) then begin FIsFirstPart := False; Exit; end; end; if (sCode = '') and FWithoutGclBills then Exit; // 含层次编号时,以层次编号为依据新增节点;反之以项目节编号为依据新增节点 if not WithLevelCode then begin if (sCode <> '') then Node := FCacheTree.AddNodeByCode(sCode, -1) else Node := FCacheTree.AddLeafBillsNode(sB_Code); end else begin // 1. 从模板树中查询当前节点是否为固定ID,否则为-1 iFixedID := GetFixedID(sCode, sName); // 2. 从导入树中查询是否添加过该固定ID,防止存在两个固定ID节点主键冲突 // 如果已添加过固定ID节点,则其他节点未非固定ID节点 Node := GetFixedIDNode(iFixedID); if Assigned(Node) then iFixedID := -1; // 3. 添加当前节点 Node := FCacheTree.AddNodeByCode(sLevelCode, iFixedID); // 4. 如果当前添加的节点为固定ID节点,则添加到List中便于2快速查找 if Node.ID < 100 then FFixedIDNodes.Add(Node); end; Node.Code := sCode; Node.B_Code := sB_Code; Node.Name := sName; Node.Units := GetCellTrimText(ASheet, FUnitsCol, FCurRow); Node.Price := StrToFloatDef(VarToStrDef(GetCellValue(ASheet, FPriceCol, FCurRow), ''), 0); Node.Quantity := StrToFloatDef(VarToStrDef(GetCellValue(ASheet, FQuantityCol, FCurRow), ''), 0); Node.DgnQuantity1 := StrToFloatDef(VarToStrDef(GetCellValue(ASheet, FDgnQuantity1Col, FCurRow), ''), 0); Node.DgnQuantity2 := StrToFloatDef(VarToStrDef(GetCellValue(ASheet, FDgnQuantity2Col, FCurRow), ''), 0); Node.DrawingCode := GetCellTrimText(ASheet, FDrawingCol, FCurRow); Node.MemoStr := GetCellTrimText(ASheet, FMemoCol, FCurRow); end; procedure TBillsEdtExcelImport.LoadNodes(ASheet: TSpreadSheet); var iPos, iSubPos: Integer; begin while (FCurRow < ASheet.Cells.UsedRowCount){ and FIsFirstPart }do begin LoadNode(ASheet); Inc(FCurRow); iSubPos := FCurRow * 100 div ASheet.Cells.UsedRowCount; iPos := iSubPos div 2; UpdateProgressPosition(iPos, iSubPos); end; end; procedure TBillsEdtExcelImport.WriteNode(ADataSet: TsdDataSet; ANode: TBillsCacheNode); var Rec: TBillsRecord; begin if ANode.Code <> '' then UpdateProgressHint('写入读取的Excel数据 ' + ANode.Code) else if ANode.B_Code <> '' then UpdateProgressHint('写入读取的Excel数据 ' + ANode.B_Code) else UpdateProgressHint('写入读取的Excel数据 ' + ANode.Name); Rec := TBillsRecord(ADataSet.Add); Rec.ID.AsInteger := ANode.ID; Rec.ParentID.AsInteger := ANode.ParentID; Rec.NextSiblingID.AsInteger := ANode.NextSiblingID; Rec.Code.AsString := ANode.Code; Rec.B_Code.AsString := ANode.B_Code; Rec.Name.AsString := ANode.Name; Rec.Units.AsString := ANode.Units; Rec.Price.AsFloat := PriceRoundTo(ANode.Price); Rec.OrgQuantity.AsFloat := QuantityRoundTo(ANode.Quantity); Rec.DgnQuantity1.AsFloat := QuantityRoundTo(ANode.DgnQuantity1); Rec.DgnQuantity2.AsFloat := QuantityRoundTo(ANode.DgnQuantity2); Rec.DrawingCode.AsString := ANode.DrawingCode; Rec.MemoStr.AsString := ANode.MemoStr; end; procedure TBillsEdtExcelImport.WriteNodes(ADataSet: TsdDataSet); var i, iPos, iSubPos: Integer; begin UpdateProgressHint('写入读取的Excel数据', True); UpdateProgressPosition(50, 0); ADataSet.DeleteAll; for i := 0 to FCacheTree.CacheNodes.Count - 1 do begin WriteNode(ADataSet, TBillsCacheNode(FCacheTree.CacheNodes[i])); iSubPos := i*100 div FCacheTree.CacheNodes.Count; iPos := 50 + iSubPos div 2; UpdateProgressPosition(iPos, iSubPos); end; UpdateProgressPosition(100, 100); end; { TBillsPriceExcelImport } procedure TBillsPriceExcelImport.BeginImport; begin ShowProgressHint('导入Excel清单单价', 100); FProjectData.BillsData.sddBills.BeginUpdate; end; procedure TBillsPriceExcelImport.EndImport; begin FProjectData.BillsData.sddBills.EndUpdate; UpdateProgressHint('正在计算导入后的数据'); FProjectData.BillsCompileData.CalculateAll; CloseProgressHint; end; procedure TBillsPriceExcelImport.Import; begin LoadColumnsFromHead(FMSExcel.Sheets.Spreadsheet(0)); ImportBillsPriceData(FMSExcel.Sheets.Spreadsheet(0)); end; procedure TBillsPriceExcelImport.ImportBillsPriceData(ASheet: TSpreadSheet); function CheckIsBillsCode(ACode: string): Boolean; const FBillsCodeSet: set of char = ['0'..'9', '-', 'a'..'z', 'A'..'Z']; var I: Integer; begin Result := True; I := 1; while I < Length(ACode) do if ACode[I] in FBillsCodeSet then Inc(I) else begin Result := False; Break; end; end; var iPos: Integer; sB_Code: string; fPrice: Double; begin UpdateProgressHint('写入读取的Excel数据'); UpdateProgressPosition(0); while (FCurRow < ASheet.Cells.UsedRowCount) do begin sB_Code := GetCellTrimText(ASheet, FB_CodeCol, FCurRow); if (sB_Code <> '') and CheckIsBillsCode(sB_Code) then begin fPrice := StrToFloatDef(VarToStrDef(ASheet.Cells.GetValue(FPriceCol, FCurRow), ''), 0); UpdateBillsPrice(sB_Code, fPrice); end; Inc(FCurRow); iPos := FCurRow * 100 div ASheet.Cells.UsedRowCount; UpdateProgressPosition(iPos); end; UpdateProgressPosition(100); end; procedure TBillsPriceExcelImport.LoadColumnsFromHead(ASheet: TSpreadSheet); var iCol: Integer; sColName: string; begin FB_CodeCol := -1; FNameCol := -1; FPriceCol := -1; while ((FB_CodeCol = -1) or (FPriceCol = -1)) and (FCurRow < ASheet.Cells.UsedRowCount) do begin for iCol := 0 to ASheet.Cells.UsedColCount do begin sColName := GetCellTrimText(ASheet, iCol, FCurRow); if SameText(sColName, '清单编号') or SameText(sColName, '子目号') then FB_CodeCol := iCol else if SameText(sColName, '名称') then FNameCol := iCol else if Pos('单价', sColName) = 1 then FPriceCol := iCol; end; Inc(FCurRow); end; end; procedure TBillsPriceExcelImport.UpdateBillsPrice(const AB_Code: string; APrice: Double); var iIndex: Integer; Rec: TBillsRecord; begin with FProjectData.BillsData do begin for iIndex := 0 to sddBills.RecordCount - 1 do begin Rec := TBillsRecord(sddBills.Records[iIndex]); if SameText(AB_Code, Rec.B_Code.AsString) then Rec.Price.AsFloat := PriceRoundTo(APrice); end; end; end; { TDealBillsExcelImport } procedure TDealBillsExcelImport.BeginImport; begin FProjectData.DealBillsData.sddDealBills.BeginUpdate; end; procedure TDealBillsExcelImport.EndImport; begin FProjectData.DealBillsData.sddDealBills.EndUpdate; end; procedure TDealBillsExcelImport.Import; begin LoadColumnsFromHead(FMSExcel.Sheets.Spreadsheet(0)); FBillsID := 1; FProjectData.DealBillsData.Clear; FProjectData.DealBillsData.DisableEvent; LoadDealBillsData(FMSExcel.Sheets.Spreadsheet(0)); FProjectData.DealBillsData.EnableEvent; end; procedure TDealBillsExcelImport.LoadColumnsFromHead(ASheet: TSpreadSheet); var iCol: Integer; sColName: string; begin FB_CodeCol := -1; FNameCol := 1; FUnitsCol := 2; FPriceCol := 3; FQuantityCol := 4; FTotalPriceCol := 5; while ((FB_CodeCol = -1) or (FPriceCol = -1)) and (FCurRow < ASheet.Cells.UsedRowCount) do begin for iCol := 0 to ASheet.Cells.UsedColCount do begin sColName := GetCellTrimText(ASheet, iCol, FCurRow); if SameText(sColName, '清单编号') or SameText(sColName, '子目号') then FB_CodeCol := iCol else if SameText(sColName, '名称') then FNameCol := iCol else if SameText(sColName, '单位') then FUnitsCol := iCol else if Pos('单价', sColName) = 1 then FPriceCol := iCol else if SameText(sColName, '数量') then FQuantityCol := iCol else if SameText(sColName, '金额') then FTotalPriceCol := iCol; end; Inc(FCurRow); end; end; procedure TDealBillsExcelImport.LoadDealBillsData(ASheet: TSpreadSheet); function CheckIsBillsCode(ACode: string): Boolean; const FBillsCodeSet: set of char = ['0'..'9', '-', 'a'..'z', 'A'..'Z']; var I: Integer; begin Result := True; I := 1; while I < Length(ACode) do if ACode[I] in FBillsCodeSet then Inc(I) else begin Result := False; Break; end; end; var sB_Code: string; Rec: TsdDataRecord; begin while (FCurRow < ASheet.Cells.UsedRowCount) do begin sB_Code := GetCellTrimText(ASheet, FB_CodeCol, FCurRow); if (sB_Code <> '') and CheckIsBillsCode(sB_Code) then begin Rec := FProjectData.DealBillsData.sddDealBills.Add; Rec.ValueByName('ID').AsInteger := FBillsID; Rec.ValueByName('B_Code').AsString := sB_Code; Rec.ValueByName('IndexCode').AsString := B_CodeToIndexCode(sB_Code); Rec.ValueByName('Name').AsString := GetCellTrimText(ASheet, FNameCol, FCurRow); Rec.ValueByName('Units').AsString := GetCellTrimText(ASheet, FUnitsCol, FCurRow); Rec.ValueByName('Price').AsFloat := PriceRoundTo( StrToFloatDef(GetCellTrimText(ASheet, FPriceCol, FCurRow), 0)); Rec.ValueByName('Quantity').AsFloat := QuantityRoundTo( StrToFloatDef(GetCellTrimText(ASheet, FQuantityCol, FCurRow), 0)); Rec.ValueByName('TotalPrice').AsFloat := TotalPriceRoundTo( StrToFloatDef(GetCellTrimText(ASheet, FTotalPriceCol, FCurRow), 0)); Inc(FBillsID); end; Inc(FCurRow); end; end; { TGclBillsExcelImport } procedure TGclBillsExcelImport.BeginImport; begin Screen.Cursor := crHourGlass; ShowProgressHint('导入Excel数据', 100); FCacheTree := TGclCacheTree.Create; FCacheTree.NewNodeID := FProjectData.BillsData.GetMaxBillsID + 1; FProjectData.DisConnectTree; FProjectData.BillsData.DisableEvents; FSelectSheets := TList.Create; FB_CodeCol := 0; FNameCol := 1; FUnitsCol := 2; FQuantityCol := 3; FPriceCol := 4; end; procedure TGclBillsExcelImport.EndImport; begin FSelectSheets.Free; FCacheTree.Free; FProjectData.BillsData.EnableEvents; FProjectData.ReConnectTree; FProjectData.BillsCompileData.CalculateAll; CloseProgressHint; Screen.Cursor := crDefault; end; procedure TGclBillsExcelImport.Import; var i: Integer; begin {if SelectSheets(FMSExcel, FSelectSheets) then begin for i := 0 to FSelectSheets.Count - 1 do begin UpdateProgressHint(Format('导入Excel数据--工作表[%s]', [FMSExcel.SheetNames.Strings[i]])); UpdateProgressPosition(0); ImportSheet(FSelectSheets.Items[i]); end; end;} ImportSheet(FMSExcel.Sheets.Spreadsheet(0)); WriteNodes(FProjectData.BillsData.sddBills); end; procedure TGclBillsExcelImport.ImportSheet(ASheet: TSpreadSheet); var iPos: Integer; begin FCurRow := 1; while (FCurRow < ASheet.Cells.UsedRowCount) do begin LoadNode(ASheet); Inc(FCurRow); iPos := FCurRow * 100 div ASheet.Cells.UsedRowCount; UpdateProgressPosition(iPos); end; end; procedure TGclBillsExcelImport.LoadNode(ASheet: TSpreadSheet); var sB_Code, sName: string; Node: TGclCacheNode; begin with ASheet.Cells do begin sB_Code := Trim(VarToStrDef(GetValue(FB_CodeCol, FCurRow), '')); sName := Trim(VarToStrDef(GetValue(FNameCol, FCurRow), '')); Node := FCacheTree.AddNodeByData(sB_Code, sName); Node.B_Code := sB_Code; Node.Name := sName; Node.Units := Trim(VarToStrDef(GetValue(FUnitsCol, FCurRow), '')); Node.Price := StrToFloatDef(VarToStrDef(GetValue(FPriceCol, FCurRow), ''), 0); Node.Quantity := StrToFloatDef(VarToStrDef(GetValue(FQuantityCol, FCurRow), ''), 0); end; end; procedure TGclBillsExcelImport.WriteNodes(ADataSet: TsdDataSet); var i, iPos: Integer; begin UpdateProgressHint('写入读取的Excel数据'); UpdateProgressPosition(0); for i := 0 to FCacheTree.CacheNodes.Count - 1 do begin WriteNode(ADataSet, TGclCacheNode(FCacheTree.CacheNodes[i])); iPos := i*100 div FCacheTree.CacheNodes.Count; UpdateProgressPosition(iPos); end; UpdateProgressPosition(100); end; procedure TGclBillsExcelImport.WriteNode(ADataSet: TsdDataSet; ANode: TGclCacheNode); var Rec: TBillsRecord; begin if ANode.B_Code <> '' then UpdateProgressHint('写入读取的Excel数据 ' + ANode.B_Code) else UpdateProgressHint('写入读取的Excel数据 ' + ANode.Name); Rec := TBillsRecord(ADataSet.Add); Rec.ID.AsInteger := ANode.ID; if ANode.ParentID = -1 then Rec.ParentID.AsInteger := ParentID else Rec.ParentID.AsInteger := ANode.ParentID; Rec.NextSiblingID.AsInteger := ANode.NextSiblingID; Rec.B_Code.AsString := ANode.B_Code; Rec.Name.AsString := ANode.Name; Rec.Units.AsString := ANode.Units; Rec.Price.AsFloat := PriceRoundTo(ANode.Price); Rec.OrgQuantity.AsFloat := QuantityRoundTo(ANode.Quantity); end; end.