123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940 |
- 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;
- var
- ParentRec: TsdDataRecord;
- begin
- FSelectSheets.Free;
- FCacheTree.Free;
- FProjectData.BillsData.EnableEvents;
- FProjectData.ReConnectTree;
- ParentRec := FProjectData.BillsData.sddBills.FindKey('idxID', ParentID);
- FProjectData.BillsCompileData.sdvBillsCompile.LocateInControl(ParentRec);
- 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.
|