unit ExportExcel; interface uses ScXlsOutput, ScXlsCustomUD, DataBase, ZjIDTree, DBClient, Graphics, Math, Classes, ScBillsTree, ConstVarUnit, ScFileArchiver, ConstTypeUnit, SysUtils, Variants; // 小数的精确度 const DoubleAccuracy: Double = 0.0001; type TExcelExportor = class private FRow: Integer; FBillItems: TList; FBillsData: TDMDataBase; FXlsOutput: TXlsOutPut; FProjectManager: TObject; procedure AddItem(ANode: TZjIDTreeNode; aXlsPage: TXlsCustomPage; aIncludeDQ: Boolean); procedure AddDQToExcel(ABillsID: Integer; AXlsPage: TXlsCustomPage); procedure AddDQItemQty(aBillsID: Integer; aCdsDQItems: TClientDataSet); procedure AddRecordToExcel(ANode: TZjIDTreeNode; aXlsPage: TXlsCustomPage; aIncludeDQ: Boolean); procedure InitializePage(aXlsPage: TXlsCustomPage; aSheetName: string); procedure InitializeQtyPage(aXlsPage: TXlsCustomPage; aSheetName: string); procedure CustomExportItems(aXlsPage: TXlsCustomPage; aIncludeDQ: Boolean); procedure CustomExportQty(aXlsPage: TXlsCustomPage; aIncludeDQ: Boolean; AChapter800: Boolean = False); procedure ExtractFirstPartBillsQty(AList: Tlist; ANode: TZjIDTreeNode); procedure ExtractChapter800(AList: Tlist; ANode: TZjIDTreeNode); function GetTotalPrice2(AObjBills: TBillIDRecord): Double; // 获取第二部分当前项的清单数量 GiLi function GetTotalQuantity2(AObjBills: TBillIDRecord): Double; {sheets} procedure ExportItems; procedure ExportProjItemsWithDQ; procedure ExportProjItemsNoDQ; procedure ExportQtyItemsWithDQ; procedure ExportQtyItemsNoDQ; procedure ExportQuantityBillsOfChapter800; public constructor Create(aBillsData: TDMDataBase; aProjMgr: TObject); destructor Destroy; override; procedure ExportToExcel(const aFileName: string; aStrings: TStrings; aFlag: Integer); end; TFlatGclExcelExportor = class private FRowIndex: Integer; FXlsOutPut: TXlsOutPut; FBillsData: TDMDataBase; FCodeCol: Integer; FNameCol: Integer; FUnitsCol: Integer; FQuantityCol: Integer; FPriceCol: Integer; FPegCol: Integer; // 单位工程 FProCol: Integer; // 分部工程 FSubProCol: Integer; // 分项工程 FSubSubProCol: Integer; // 部位 FPositonCol: Integer; FDrawingCol: Integer; procedure InitHeadCell(AXlsPage: TXlsCustomPage; ACol, ARow: Integer; const AText: string); procedure InitialPageHead(AXlsPage: TXlsCustomPage); procedure SetCommonCellFont(AXlsCell: TXlsCustomCell); procedure AddCellExceptZero(AXlsPage: TXlsCustomPage; ACol, ARow: Integer; AValue: Variant); procedure AddCellRightAlign(AXlsPage: TXlsCustomPage; ACol, ARow: Integer; AValue: Variant); procedure AddCellCenterAlign(AXlsPage: TXlsCustomPage; ACol, ARow: Integer; AValue: Variant); function CheckPegStr(const AStr: string): Boolean; function GetPeg(ANode: TZjIDTreeNode): string; function GetPro(ANode: TZjIDTreeNode): string; function GetSubPro(ANode: TZjIDTreeNode): string; function GetSubSubPro(ANode: TZjIDTreeNode): string; function GetPositon(ANode: TZjIDTreeNode): string; function GetDrawingCode(ANode: TZjIDTreeNode): string; procedure ExportData(AXlsPage: TXlsCustomPage; ANode: TZjIDTreeNode); procedure ExportNode(AXlsPage: TXlsCustomPage; ANode: TZjIDTreeNode); procedure ExportTo(AXlsPage: TXlsCustomPage); public constructor Create(ABillsData: TDMDataBase); destructor Destroy; override; procedure ExportFile(const AFileName: string); end; implementation uses DB, ConstMethodUnit, ScUpdateDataBase, ScProjectManager, ScConfig; { TExcelExportor } procedure TExcelExportor.AddDQItemQty(aBillsID: Integer; aCdsDQItems: TClientDataSet); var bFlag: Boolean; CDS: TClientDataSet; xlsCell: TXlsCustomCell; begin CDS := TClientDataSet.Create(nil); try CDS.CloneCursor(FBillsData.cdsDrawingQuantity, True); CDS.IndexFieldNames := 'BillsID'; CDS.SetRange([ABillsID], [aBillsID]); while not CDS.Eof do begin if CDS.FieldByName('Name').AsString <> '' then begin bFlag := False; aCdsDQItems.First; while not aCdsDQItems.Eof do begin if SameText(CDS.FieldByName('Name').AsString, aCdsDQItems.FieldByName('Name').AsString) then begin aCdsDQItems.Edit; aCdsDQItems.FieldByName('Quantity').AsFloat := aCdsDQItems.FieldByName('Quantity').AsFloat + CDS.FieldByName('DQuantity1').AsFloat; aCdsDQItems.Post; bFlag := True; Break; end; aCdsDQItems.Next; end; if not bFlag then begin aCdsDQItems.Append; aCdsDQItems.FieldByName('Name').AsString := CDS.FieldByName('Name').AsString; aCdsDQItems.FieldByName('Units').AsString := CDS.FieldByName('Units').AsString; aCdsDQItems.FieldByName('Quantity').AsFloat := CDS.FieldByName('DQuantity1').AsFloat; aCdsDQItems.FieldByName('MemoStr').AsString := CDS.FieldByName('MemoContext').AsString; aCdsDQItems.Post; end; end; CDS.Next; end; finally CDS.Free; end; end; procedure TExcelExportor.AddDQToExcel(ABillsID: Integer; AXlsPage: TXlsCustomPage); var CDS: TClientDataSet; xlsCell: TXlsCustomCell; begin CDS := TClientDataSet.Create(nil); try CDS.CloneCursor(FBillsData.cdsDrawingQuantity, True); CDS.IndexFieldNames := 'BillsID'; CDS.SetRange([ABillsID], [ABillsID]); while not CDS.Eof do begin if CDS.FieldByName('Name').AsString <> '' then begin AXlsPage.AddCell(2, FRow, CDS.FieldByName('Name').AsString); xlsCell := AXlsPage.AddCell(3, FRow, CDS.FieldByName('Units').AsString); xlsCell.HTextAlign := htaCenter; if CDS.FieldByName('DQuantity1').AsFloat <> 0 then begin xlsCell := AXlsPage.AddCell(5, FRow, CDS.FieldByName('DQuantity1').AsFloat); xlsCell.HTextAlign := htaRight; end; AXlsPage.AddCell(9, FRow, CDS.FieldByName('MemoContext').AsString); Inc(FRow); end; CDS.Next; end; finally CDS.Free; end; end; procedure TExcelExportor.AddItem(ANode: TZjIDTreeNode; aXlsPage: TXlsCustomPage; aIncludeDQ: Boolean); var xlsCell: TXlsCustomCell; begin with FBillsData do begin if cdsBills.FindKey([ANode.ID]) then begin xlsCell := aXlsPage.AddCell(0, FRow, cdsBillsCode.AsString); xlsCell := aXlsPage.AddCell(1, FRow, cdsBillsB_Code.AsString); xlsCell := aXlsPage.AddCell(2, FRow, cdsBillsName.AsString); xlsCell := aXlsPage.AddCell(3, FRow, cdsBillsUnits.AsString); xlsCell.HTextAlign := htaCenter; if cdsBillsQuantity.AsFloat <> 0 then begin xlsCell := aXlsPage.AddCell(4, FRow, cdsBillsQuantity.AsFloat); xlsCell.HTextAlign := htaRight; end; if cdsBillsDesignQuantity.AsFloat <> 0 then begin xlsCell := aXlsPage.AddCell(5, FRow, cdsBillsDesignQuantity.AsFloat); xlsCell.HTextAlign := htaRight; end; if cdsBillsDesignQuantity2.AsFloat <> 0 then begin xlsCell := aXlsPage.AddCell(6, FRow, cdsBillsDesignQuantity2.AsFloat); xlsCell.HTextAlign := htaRight; end; if cdsBillsUnitPrice.AsFloat <> 0 then begin xlsCell := aXlsPage.AddCell(7, FRow, cdsBillsUnitPrice.AsFloat); xlsCell.HTextAlign := htaRight; end; if cdsBillsTotalPrice.AsFloat <> 0 then begin xlsCell := aXlsPage.AddCell(8, FRow, cdsBillsTotalPrice.AsFloat); xlsCell.HTextAlign := htaRight; end; xlsCell := aXlsPage.AddCell(9, FRow, cdsBillsMemoStr.AsString); Inc(FRow); // add drawingQuantity here if aIncludeDQ then AddDQToExcel(cdsBillsID.AsInteger, aXlsPage); end; end; end; procedure TExcelExportor.AddRecordToExcel(ANode: TZjIDTreeNode; aXlsPage: TXlsCustomPage; aIncludeDQ: Boolean); begin if not Assigned(ANode) then Exit; {$IF Not DEFINED(_beEncrypt) and not DEFINED(_beOnLine)} if FRow >= MaxExcelRow then Exit; {$IFEND} AddItem(ANode, aXlsPage, aIncludeDQ); if Assigned(ANode.FirstChild) then AddRecordToExcel(ANode.FirstChild, aXlsPage, aIncludeDQ); if Assigned(ANode.NextSibling) then AddRecordToExcel(ANode.NextSibling, aXlsPage, aIncludeDQ); end; constructor TExcelExportor.Create(aBillsData: TDMDataBase; aProjMgr: TObject); begin FBillsData := aBillsData; FProjectManager := aProjMgr; FXlsOutput := TXlsOutPut.Create('Template.xls'); FBillItems := TList.Create; end; procedure TExcelExportor.CustomExportItems(aXlsPage: TXlsCustomPage; aIncludeDQ: Boolean); var ztnNode: TZjIDTreeNode; begin FRow := 1; ztnNode := FBillsData.BillsTree.FirstNode; // 新需求,全部导出 chenshilong, 2012-12-10 while Assigned(ztnNode) do begin AddItem(ztnNode, aXlsPage, aIncludeDQ); if Assigned(ztnNode.FirstChild) then AddRecordToExcel(ztnNode.FirstChild, aXlsPage, aIncludeDQ); ztnNode := ztnNode.NextSibling; end; (* {第一部分} if Assigned(ztnNode) then AddItem(ztnNode, aXlsPage, aIncludeDQ); if Assigned(ztnNode.FirstChild) then AddRecordToExcel(ztnNode.FirstChild, aXlsPage, aIncludeDQ); {第二部分} ztnNode := ztnNode.NextSibling; AddItem(ztnNode, aXlsPage, aIncludeDQ); if Assigned(ztnNode.FirstChild) then AddRecordToExcel(ztnNode.FirstChild, aXlsPage, aIncludeDQ); {第三部分} ztnNode := ztnNode.NextSibling; AddItem(ztnNode, aXlsPage, aIncludeDQ); if Assigned(ztnNode.FirstChild) then AddRecordToExcel(ztnNode.FirstChild, aXlsPage, aIncludeDQ); *) end; function Compare(Item1, Item2: Pointer): Integer; begin Result := CompareCodeWithChar(TBillIDRecord(Item1).Code, TBillIDRecord(Item2).Code); if not ScConfigInfo.MatchCodeOnly and (Result = 0) then Result := CompareText(TBillIDRecord(Item1).Name, TBillIDRecord(Item2).Name) end; procedure TExcelExportor.CustomExportQty(aXlsPage: TXlsCustomPage; aIncludeDQ: Boolean; AChapter800: Boolean); var // cdsQtyItems : TClientDataSet; cdsDQItems : TClientDataSet; xlsCell : TXlsCustomCell; strOldCode : string; strOldName : string; strOldUnit : string; strOldMemo : string; strNewCode : string; strNewName : string; strNewUnit : string; strNewMemo : string; dQuantity : Double; dQuantity2 : Double; dUnitPrice : Double; dUnitPrice2 : Double; dTotalPrice : Double; dTotalPrice2: Double; bFirst : Boolean; lstPQ : TList; bRecord : TBillIDRecord; objBills : TBillIDRecord; qRecord : TDQRecord; iLoopPQ : Integer; iLoopDQ : Integer; iLoopBills : Integer; vSL: TStringList; begin FRow := 1; bFirst := True; lstPQ := TList.Create; // cdsQtyItems := TClientDataSet.Create(nil); cdsDQItems := TClientDataSet.Create(nil); try { create dataset } with cdsDQItems.FieldDefs.AddFieldDef do begin DataType := ftWideString; Size := 200; Name := 'Name'; end; with cdsDQItems.FieldDefs.AddFieldDef do begin DataType := ftWideString; Size := 50; Name := 'Units'; end; with cdsDQItems.FieldDefs.AddFieldDef do begin DataType := ftFloat; Name := 'Quantity'; end; with cdsDQItems.FieldDefs.AddFieldDef do begin DataType := ftWideString; Size := 200; Name := 'MemoStr'; end; cdsDQItems.CreateDataSet; if FBillItems.Count = 0 then begin ExtractFirstPartBillsQty(FBillItems, FBillsData.BillsTree.FirstNode); // 其它部分也有工程量清单 chenshilong, 2013-04-28 //ExtractFirstPartBillsQty(FBillItems, FBillsData.BillsTree[2]); ExtractFirstPartBillsQty(FBillItems, FBillsData.BillsTree[3]); ExtractFirstPartBillsQty(FBillItems, FBillsData.BillsTree[7]); // 预留费用 ExtractFirstPartBillsQty(FBillItems, FBillsData.BillsTree[15]); // 其他费用项目 ExtractChapter800(FBillItems, FBillsData.BillsTree.FirstNode.NextSibling); FBillItems.Sort(Compare); end; { 终于搞清了李涛的原理:先对列表进行排序,然后依次跟上条比,相同则合并。 凤岗 项目编号为803-5-2B的没有合并,原因是: FBillItems.Sort(Compare) 这句不可靠,排成了: Idx123 803-5-2B 24口接入以太网交换机(含光纤模块) Idx124 803-5-2A 24口接入以太网交换机(含光纤模块) Idx125 803-5-2A 24口接入以太网交换机(含光纤模块) Idx126 803-5-2B 24口接入以太网交换机(含光纤模块) 导致中间两条可以正常合并,1、4两条不行。 chenshilong, 2013-08-20 } {vSL := TStringList.Create; for iLoopBills := 0 to FBillItems.Count - 1 do begin objBills := TBillIDRecord(FBillItems.List^[iLoopBills]); vSL.Add(IntToStr(iLoopBills)+ #9 + objBills.Code + #9 + objBills.Name); end; vSL.SaveToFile('E:\ListLT.txt'); vSL.Free; } for iLoopBills := 0 to FBillItems.Count - 1 do //with cdsQtyItems do begin objBills := TBillIDRecord(FBillItems.List^[iLoopBills]); if AChapter800 and (objBills.Code[1] <> '8') then Continue; {CloneCursor(FBillsData.cdsBills, True); IndexFieldNames := 'B_Code'; Filter := 'B_Code<>'''''; Filtered := True; while not Eof do begin strNewCode := FieldByName('B_Code').AsString; strNewName := FieldByName('Name').AsString; strNewUnit := FieldByName('Units').AsString; strNewMemo := FieldByName('MemoStr').AsString; } strNewCode := objBills.Code; strNewName := objBills.Name; strNewUnit := objBills.Units; strNewMemo := objBills.MemoStr; if bFirst then begin dQuantity := 0; dQuantity2 := 0; dUnitPrice := 0; dUnitPrice2 := 0; dTotalPrice := 0; dTotalPrice2 := 0; strOldCode := strNewCode; strOldName := strNewName; strOldUnit := strNewUnit; strOldMemo := strNewMemo; bFirst := False; end; if (ScConfigInfo.MatchCodeOnly and (strOldCode <> strNewCode)) or (not ScConfigInfo.MatchCodeOnly and ((strOldCode <> strNewCode) or (strOldName <> strNewName))) then begin bRecord := TBillIDRecord.Create; bRecord.Code := strOldCode; bRecord.Name := strOldName; bRecord.Units := strOldUnit; // 如果清单子目在第一部分的汇总数量约等于0,则取第二部分的汇总数量,否则,取第一部分的汇总数量 if (dQuantity = 0) then bRecord.Quantity := dQuantity2 else bRecord.Quantity := dQuantity; bRecord.Quantity2 := dQuantity2; // 加权平均求单价 if bRecord.Quantity <> 0 then begin dUnitPrice := RoundTo((dTotalPrice + dTotalPrice2)/bRecord.Quantity, -2); dUnitPrice2 := RoundTo(dTotalPrice2/bRecord.Quantity, -2); end; bRecord.UnitPrice := dUnitPrice; bRecord.UnitPrice2 := dUnitPrice2; bRecord.TotalPrice := RoundTo(dUnitPrice*dQuantity, 0);// dTotalPrice; bRecord.TotalPrice2 := RoundTo(dUnitPrice2*dQuantity2, 0); //dTotalPrice2; {if dQuantity = 0 then bRecord.UnitPrice := 0 else bRecord.UnitPrice := RoundTo((dTotalPrice + dTotalPrice2)/dQuantity, -2); } bRecord.MemoStr := strOldMemo; lstPQ.Add(bRecord); if aIncludeDQ then begin cdsDQItems.First; while not cdsDQItems.Eof do begin qRecord := TDQRecord.Create; qRecord.Name := cdsDQItems.FieldByName('Name').AsString; qRecord.Units := cdsDQItems.FieldByName('Units').AsString; qRecord.DQuantity := cdsDQItems.FieldByName('Quantity').AsFloat; qRecord.MemoStr := cdsDQItems.FieldByName('MemoStr').AsString; bRecord.List.Add(qRecord); cdsDQItems.Next; end; cdsDQItems.EmptyDataSet; end; {dQuantity := FieldByName('Quantity').AsFloat; dTotalPrice := FieldByName('TotalPrice').AsFloat; } dQuantity := objBills.Quantity; dQuantity2 := GetTotalQuantity2(objBills); dUnitPrice := objBills.UnitPrice; dUnitPrice2 := objBills.UnitPrice2; dTotalPrice := objBills.Quantity * objBills.UnitPrice; dTotalPrice2 := GetTotalPrice2(objBills); //objBills.Quantity*objBills.UnitPrice2; strOldCode := strNewCode; strOldName := strNewName; strOldUnit := strNewUnit; strOldMemo := strNewMemo; end else begin {dQuantity := dQuantity + FieldByName('Quantity').AsFloat; dTotalPrice := dTotalPrice + FieldByName('TotalPrice').AsFloat; } dQuantity := dQuantity + objBills.Quantity; dQuantity2 := dQuantity2 + GetTotalQuantity2(objBills); dTotalPrice := dTotalPrice + objBills.Quantity*objBills.UnitPrice; dTotalPrice2 := dTotalPrice2 + GetTotalPrice2(objBills); end; if aIncludeDQ then AddDQItemQty(objBills.NewID {FieldByName('ID').Value}, cdsDQItems); // Next; end; { last record } bRecord := TBillIDRecord.Create; bRecord.Code := strOldCode; bRecord.Name := strOldName; bRecord.Units := strOldUnit; //bRecord.Quantity := dQuantity; if (dQuantity = 0) then bRecord.Quantity := dQuantity2 else bRecord.Quantity := dQuantity; bRecord.Quantity2 := dQuantity2; { if dQuantity <> 0 then begin dUnitPrice := RoundTo((dTotalPrice + dTotalPrice2)/dQuantity, -2); dUnitPrice2 := RoundTo(dTotalPrice2/dQuantity, -2); end; } // 加权平均求单价 if bRecord.Quantity <> 0 then begin dUnitPrice := RoundTo((dTotalPrice + dTotalPrice2)/bRecord.Quantity, -2); dUnitPrice2 := RoundTo(dTotalPrice2/bRecord.Quantity, -2); end; bRecord.UnitPrice := dUnitPrice; bRecord.UnitPrice2 := dUnitPrice2; bRecord.TotalPrice := RoundTo(dUnitPrice*bRecord.Quantity, 0); bRecord.TotalPrice2 := RoundTo(dUnitPrice2*bRecord.Quantity, 0); { bRecord.TotalPrice := dTotalPrice; bRecord.TotalPrice2 := dTotalPrice2; if dQuantity = 0 then bRecord.UnitPrice := 0 else bRecord.UnitPrice := RoundTo((dTotalPrice + dTotalPrice2) / dQuantity, -2); } bRecord.MemoStr := strOldMemo; lstPQ.Add(bRecord); lstPQ.Sort(Compare); for iLoopPQ := 0 to lstPQ.Count - 1 do begin bRecord := TBillIDRecord(lstPQ.List^[iLoopPQ]); xlsCell := aXlsPage.AddCell(0, FRow, bRecord.Code); xlsCell := aXlsPage.AddCell(1, FRow, bRecord.Name); xlsCell := aXlsPage.AddCell(2, FRow, bRecord.Units); xlsCell.HTextAlign := htaCenter; if bRecord.Quantity <> 0 then begin xlsCell := aXlsPage.AddCell(3, FRow, bRecord.Quantity); xlsCell.HTextAlign := htaRight; end; if bRecord.UnitPrice <> 0 then begin xlsCell := aXlsPage.AddCell(4, FRow, bRecord.UnitPrice); xlsCell.HTextAlign := htaRight; end; if bRecord.TotalPrice + bRecord.TotalPrice2 <> 0 then begin if AChapter800 then begin if bRecord.TotalPrice <> 0 then xlsCell := aXlsPage.AddCell(5, FRow, bRecord.TotalPrice - bRecord.TotalPrice2); end else xlsCell := aXlsPage.AddCell(5, FRow, bRecord.TotalPrice); xlsCell.HTextAlign := htaRight; end; if AChapter800 then begin if bRecord.TotalPrice2 <> 0 then begin xlsCell := aXlsPage.AddCell(6, FRow, bRecord.TotalPrice2); xlsCell.HTextAlign := htaRight; end; end else xlsCell := aXlsPage.AddCell(6, FRow, bRecord.MemoStr); Inc(FRow); {$IF Not DEFINED(_beEncrypt) and not DEFINED(_beOnLine)} if FRow >= MaxExcelRow then Exit; {$IFEND} for iLoopDQ := 0 to bRecord.List.Count - 1 do begin qRecord := TDQRecord(bRecord.List.List^[iLoopDQ]); aXlsPage.AddCell(1, FRow, qRecord.Name); xlsCell := aXlsPage.AddCell(2, FRow, qRecord.Units); xlsCell.HTextAlign := htaCenter; if qRecord.DQuantity <> 0 then begin xlsCell := aXlsPage.AddCell(3, FRow, qRecord.DQuantity); xlsCell.HTextAlign := htaRight; end; if AChapter800 then aXlsPage.AddCell(7, FRow, qRecord.MemoStr) else aXlsPage.AddCell(6, FRow, qRecord.MemoStr); Inc(FRow); end; end; finally cdsDQItems.Free; // cdsQtyItems.Free; ClearObjectList(lstPQ); lstPQ.Free; end; end; destructor TExcelExportor.Destroy; begin FXlsOutput.Free; ClearObjectList(FBillItems); FBillItems.Free; inherited; end; procedure TExcelExportor.ExportItems; var xlsPage: TXlsCustomPage; begin xlsPage := FXlsOutput.AddPage; InitializePage(xlsPage, '分项清单'); CustomExportItems(xlsPage, True); end; procedure TExcelExportor.ExportProjItemsNoDQ; var xlsPage: TXlsCustomPage; begin xlsPage := FXlsOutput.AddPage; InitializePage(xlsPage, '项目清单'); CustomExportItems(xlsPage, False); end; procedure TExcelExportor.ExportProjItemsWithDQ; var xlsPage: TXlsCustomPage; begin xlsPage := FXlsOutput.AddPage; InitializePage(xlsPage, '项目清单(含细目)'); CustomExportItems(xlsPage, True); end; procedure TExcelExportor.ExportQtyItemsNoDQ; var xlsPage: TXlsCustomPage; begin xlsPage := FXlsOutput.AddPage; InitializeQtyPage(xlsPage, '工程量清单'); CustomExportQty(xlsPage, False); end; procedure TExcelExportor.ExportQtyItemsWithDQ; var xlsPage: TXlsCustomPage; begin xlsPage := FXlsOutput.AddPage; InitializeQtyPage(xlsPage, '工程量清单(含细目)'); CustomExportQty(xlsPage, True); end; procedure TExcelExportor.ExportQuantityBillsOfChapter800; var xlsPage: TXlsCustomPage; procedure SetPageStyleOfChapter800; var xlsCell: TXlsCustomCell; begin FRow := 0; XlsPage.Widths[0] := 80; XlsPage.Widths[1] := 300; XlsPage.Widths[2] := 50; //XlsPage.Widths[7] := 150; XlsPage.SheetName := '800章'; xlsCell := XlsPage.AddCell(0, 0, '清单编号'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := XlsPage.AddCell(1, 0, '名称'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := XlsPage.AddCell(2, 0, '单位'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := XlsPage.AddCell(3, 0, '数量'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := XlsPage.AddCell(4, 0, '单价'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := XlsPage.AddCell(5, 0, '安装费'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := XlsPage.AddCell(6, 0, '器具购置费'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; { xlsCell := XlsPage.AddCell(7, 0, '备注'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; } end; begin xlsPage := FXlsOutput.AddPage; SetPageStyleOfChapter800; CustomExportQty(xlsPage, False, True); end; procedure TExcelExportor.ExportToExcel(const aFileName: string; aStrings: TStrings; aFlag: Integer); var I, iIdx: Integer; sDir, sFileName: string; Project: TProject; pfaArchiver: TScProjectFileArchiver; begin if (aFlag <> 1) and (aStrings.Count > 1) then begin sDir := ExtractFilePath(ParamStr(0)); for I := 0 to aStrings.Count - 1 do begin pfaArchiver := nil; sFileName := string(aStrings.Objects[I]); iIdx := TProjectManager(FProjectManager).CheckProjectExists(sDir + sFileName); if iIdx = -1 then begin pfaArchiver := TScProjectFileArchiver.Create; pfaArchiver.FileName := sDir + sFileName; pfaArchiver.OpenFile; FBillsData := TDMDataBase.Create(nil); FBillsData.Connection := pfaArchiver.Connection; UpdateDB(pfaArchiver); pfaArchiver.Save; FBillsData.Active := True; FBillsData.ConnectionBillsTree; end else FBillsData := TProjectManager(FProjectManager).Projects[iIdx].BillsData; if aStrings[I] = '1' then begin { 分项清单 } // 标段的 ExportItems; end else begin { 项目清单 带图纸 } // 汇总后的 ExportProjItemsWithDQ; { 项目清单 不带图纸 } ExportProjItemsNoDQ; // 汇总后的 { 工程量清单 带图纸 } ExportQtyItemsWithDQ; // 标段和汇总后的一样,随便哪个 { 工程量清单 不带图纸 } ExportQtyItemsNoDQ; ExportQuantityBillsOfChapter800; end; if Assigned(pfaArchiver) then begin FBillsData.Free; pfaArchiver.Free; end; end; end else begin { 分项清单 } // 标段的 ExportItems; { 工程量清单 带图纸 } ExportQtyItemsWithDQ; // 标段和汇总后的一样,随便哪个 { 工程量清单 不带图纸 } ExportQtyItemsNoDQ; ExportQuantityBillsOfChapter800; end; { 生成文件 } FXlsOutput.SaveToFile(aFileName); end; procedure TExcelExportor.ExtractChapter800(AList: Tlist; ANode: TZjIDTreeNode); // Added by GiLi 2012-4-25 判断第二分部的800章在第一部分是否存在(编号) function IsItemInChapter1(const ABCode: string): Boolean; var I: Integer; objBills: TBillIDRecord; begin for I := 0 to FBillItems.Count - 1 do begin objBills := TBillIDRecord(FBillItems.List^[I]); if ABCode = objBills.Code then begin Result := True; Exit; end; end; Result := False; end; function IsItemOfChapter800(ABillNode: TZjIDTreeNode): Boolean; begin Result := (TScBillsItem(ABillNode).SBillBCode <> '') and (TScBillsItem(ABillNode).SBillBCode[1] = '8'); end; procedure AddTotalPriceOfChapter800(AQuantity, AUnitPrice: Double; const ABCode: string); var I: Integer; objBills: TBillIDRecord; FloatItem: TFloatItem; begin for I := 0 to FBillItems.Count - 1 do begin objBills := TBillIDRecord(FBillItems.List^[I]); if ABCode = objBills.Code then begin {if objBills.Quantity = 0 then objBills.Quantity := AQuantity; } FloatItem := TFloatItem.Create; FloatItem.Quantity2 := AQuantity; FloatItem.UnitPrice2 := AUnitPrice; objBills.List.Add(FloatItem); Break; end; end; end; var I: Integer; ztnNode: TZjIDTreeNode; objBills: TBillIDRecord; begin for I := 0 to ANode.ChildCount - 1 do begin ztnNode := ANode.ChildNodes[I]; if IsItemOfChapter800(ztnNode) then begin if FBillsData.cdsBills.FindKey([ztnNode.ID]) then begin // 如果第二部分有800章,第一部分没有,那么把第二部分算入第一部分,方便处理 GiLi if not IsItemInChapter1(FBillsData.cdsBillsB_Code.AsString) then begin objBills := TBillIDRecord.Create; objBills.NewID := FBillsData.cdsBillsID.AsInteger; objBills.Code := FBillsData.cdsBillsB_Code.AsString; objBills.Name := FBillsData.cdsBillsName.AsString; objBills.Units := FBillsData.cdsBillsUnits.AsString; { if not ztnNode.HasChildren then begin objBills.Quantity := FBillsData.cdsBillsQuantity.AsFloat; objBills.UnitPrice := FBillsData.cdsBillsUnitPrice.AsFloat; objBills.TotalPrice := FBillsData.cdsBillsTotalPrice.AsFloat; end; } objBills.Quantity := 0; objBills.Quantity2 := FBillsData.cdsBillsQuantity.AsFloat; objBills.UnitPrice := 0; objBills.TotalPrice := 0; objBills.MemoStr := FBillsData.cdsBillsMemoStr.AsString; AList.Add(objBills); end; AddTotalPriceOfChapter800(FBillsData.cdsBillsQuantity.AsFloat, FBillsData.cdsBillsUnitPrice.AsFloat, FBillsData.cdsBillsB_Code.AsString); end; end; ExtractChapter800(AList, ztnNode); end; end; procedure TExcelExportor.ExtractFirstPartBillsQty(AList: Tlist; ANode: TZjIDTreeNode); var I: Integer; cNode: TZjIDTreeNode; objBills: TBillIDRecord; begin for I := 0 to ANode.ChildCount - 1 do begin cNode := ANode.ChildNodes[I]; if TScBillsItem(cNode).SBillBCode <> '' then begin if FBillsData.cdsBills.FindKey([cNode.ID]) then begin objBills := TBillIDRecord.Create; objBills.NewID := FBillsData.cdsBillsID.AsInteger; objBills.Code := FBillsData.cdsBillsB_Code.AsString; objBills.Name := FBillsData.cdsBillsName.AsString; objBills.Units := FBillsData.cdsBillsUnits.AsString; if not cNode.HasChildren then begin objBills.Quantity := FBillsData.cdsBillsQuantity.AsFloat; objBills.UnitPrice := FBillsData.cdsBillsUnitPrice.AsFloat; objBills.TotalPrice := FBillsData.cdsBillsTotalPrice.AsFloat; end; objBills.MemoStr := FBillsData.cdsBillsMemoStr.AsString; AList.Add(objBills); end; end; ExtractFirstPartBillsQty(AList, cNode); end; end; function TExcelExportor.GetTotalPrice2(AObjBills: TBillIDRecord): Double; var I: Integer; FloatItem: TFloatItem; begin Result := 0; for I := 0 to AObjBills.List.Count - 1 do begin FloatItem := TFloatItem(AObjBills.List[I]); // Modified By MaiXinRong 2012-03-19 器具购置费用第二部分的数量*单价 Result := Result + FloatItem.Quantity2 * FloatItem.UnitPrice2; end; end; function TExcelExportor.GetTotalQuantity2( AObjBills: TBillIDRecord): Double; var I: Integer; FloatItem: TFloatItem; begin Result := 0; for I := 0 to AObjBills.List.Count - 1 do begin FloatItem := TFloatItem(AObjBills.List[I]); Result := Result + FloatItem.Quantity2; end; end; procedure TExcelExportor.InitializePage(aXlsPage: TXlsCustomPage; aSheetName: string); var xlsCell: TXlsCustomCell; begin FRow := 0; aXlsPage.Widths[0] := 100; aXlsPage.Widths[2] := 300; aXlsPage.Widths[3] := 50; aXlsPage.Widths[9] := 100; aXlsPage.SheetName := aSheetName; xlsCell := aXlsPage.AddCell(0, FRow, '预算项目节'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(1, FRow, '清单子目号'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(2, FRow, '名称'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(3, FRow, '单位'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(4, FRow, '清单数量'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(5, FRow, '设计数量1'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(6, FRow, '设计数量2'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(7, FRow, '单价'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(8, FRow, '合价'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(9, FRow, '备注'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; end; procedure TExcelExportor.InitializeQtyPage(aXlsPage: TXlsCustomPage; aSheetName: string); var xlsCell: TXlsCustomCell; begin FRow := 0; aXlsPage.Widths[0] := 80; aXlsPage.Widths[1] := 300; aXlsPage.Widths[2] := 50; aXlsPage.Widths[6] := 200; aXlsPage.SheetName := aSheetName; xlsCell := aXlsPage.AddCell(0, FRow, '清单编号'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(1, FRow, '名称'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(2, FRow, '单位'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(3, FRow, '清单数量'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(4, FRow, '单价'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(5, FRow, '合价'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; xlsCell := aXlsPage.AddCell(6, FRow, '备注'); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; xlsCell.Font.Name := '黑体'; end; { TFlatGclExcelExportor } procedure TFlatGclExcelExportor.AddCellCenterAlign( AXlsPage: TXlsCustomPage; ACol, ARow: Integer; AValue: Variant); var xlsCell: TXlsCustomCell; begin xlsCell := nil; xlsCell := AXlsPage.AddCell(ACol, ARow, AValue); xlsCell.HTextAlign := htaCenter; SetCommonCellFont(xlsCell); end; procedure TFlatGclExcelExportor.AddCellExceptZero(AXlsPage: TXlsCustomPage; ACol, ARow: Integer; AValue: Variant); var xlsCell: TXlsCustomCell; begin xlsCell := nil; case VarType(AValue) of varSmallInt, varInteger, varSingle, varDouble, varCurrency, varShortInt, varByte, varWord, varLongWord, varInt64: begin if AValue <> 0 then begin xlsCell := AXlsPage.AddCell(ACol, ARow, AValue); xlsCell.HTextAlign := htaRight; end; end else xlsCell := AXlsPage.AddCell(ACol, ARow, AValue); end; SetCommonCellFont(xlsCell); end; procedure TFlatGclExcelExportor.AddCellRightAlign(AXlsPage: TXlsCustomPage; ACol, ARow: Integer; AValue: Variant); var xlsCell: TXlsCustomCell; begin xlsCell := nil; xlsCell := AXlsPage.AddCell(ACol, ARow, AValue); xlsCell.HTextAlign := htaRight; SetCommonCellFont(xlsCell); end; function TFlatGclExcelExportor.CheckPegStr(const AStr: string): Boolean; function GetPosition(const AName, AStr, AStrSpare: string): Integer; begin Result := Pos(AStr, AName); if Result = 0 then Result := Pos(AStrSpare, AName); end; var iPosK, iPosPlus: Integer; fNum: Double; begin Result := False; iPosK := GetPosition(AStr, 'K', 'k'); iPosPlus := GetPosition(AStr, '+', '+'); if (iPosK = 0) or (iPosPlus = 0) or (iPosPlus < iPosK) then Exit; Result := TryStrToFloat(Copy(AStr, iPosK + 1, iPosPlus - iPosK - 1), fNum); end; constructor TFlatGclExcelExportor.Create(ABillsData: TDMDataBase); begin FRowIndex := 0; FXlsOutPut := TXlsOutPut.Create; FBillsData := ABillsData; FCodeCol := 0; FNameCol := 1; FUnitsCol := 2; FQuantityCol := 3; FPriceCol := 4; FPegCol := 5; FProCol := 6; FSubProCol := 7; FSubSubProCol := 8; FPositonCol := 9; FDrawingCol := 10; end; destructor TFlatGclExcelExportor.Destroy; begin FXlsOutPut.Free; inherited; end; procedure TFlatGclExcelExportor.ExportData(AXlsPage: TXlsCustomPage; ANode: TZjIDTreeNode); begin with FBillsData do begin if not cdsBills.FindKey([ANode.ID]) then Exit; if cdsBillsB_Code.AsString = '' then Exit; AddCellExceptZero(AXlsPage, FCodeCol, FRowIndex, cdsBillsB_Code.AsString); AddCellExceptZero(AXlsPage, FNameCol, FRowIndex, cdsBillsName.AsString); AddCellCenterAlign(AXlsPage, FUnitsCol, FRowIndex, cdsBillsUnits.AsString); AddCellExceptZero(AXlsPage, FQuantityCol, FRowIndex, cdsBillsQuantity.AsFloat); AddCellExceptZero(AXlsPage, FPriceCol, FRowIndex, cdsBillsUnitPrice.AsFloat); // cdsBills当前节点会改变 AddCellExceptZero(AXlsPage, FPegCol, FRowIndex, GetPeg(ANode.Parent)); AddCellExceptZero(AXlsPage, FProCol, FRowIndex, GetPro(ANode)); AddCellExceptZero(AXlsPage, FSubProCol, FRowIndex, GetSubPro(ANode)); AddCellExceptZero(AXlsPage, FSubSubProCol, FRowIndex, GetSubSubPro(ANode)); AddCellExceptZero(AXlsPage, FPositonCol, FRowIndex, GetPositon(ANode)); AddCellExceptZero(AXlsPage, FDrawingCol, FRowIndex, GetDrawingCode(ANode)); Inc(FRowIndex); end; end; procedure TFlatGclExcelExportor.ExportFile(const AFileName: string); begin ExportTo(FXlsOutPut.AddPage); FXlsOutPut.SaveToFile(AFileName); end; procedure TFlatGclExcelExportor.ExportNode(AXlsPage: TXlsCustomPage; ANode: TZjIDTreeNode); begin if not Assigned(ANode) then Exit; ExportData(AXlsPage, ANode); if ANode.HasChildren then ExportNode(AXlsPage, ANode.FirstChild); ExportNode(AXlsPage, ANode.NextSibling); end; procedure TFlatGclExcelExportor.ExportTo(AXlsPage: TXlsCustomPage); begin InitialPageHead(AXlsPage); ExportNode(AXlsPage, FBillsData.BillsTree.FirstNode.FirstChild); end; function TFlatGclExcelExportor.GetDrawingCode( ANode: TZjIDTreeNode): string; begin Result := ''; if not Assigned(ANode) then Exit; if FBillsData.cdsBills.FindKey([ANode.ID]) then if FBillsData.cdsBillsDrawingCode.AsString <> '' then Result := FBillsData.cdsBillsDrawingCode.AsString else Result := GetDrawingCode(ANode.Parent); end; function TFlatGclExcelExportor.GetPeg(ANode: TZjIDTreeNode): string; begin Result := ''; if not Assigned(ANode) then Exit; if FBillsData.cdsBills.FindKey([ANode.ID]) then if CheckPegStr(FBillsData.cdsBillsName.AsString) then Result := FBillsData.cdsBillsName.AsString else Result := GetPeg(ANode.Parent); end; function TFlatGclExcelExportor.GetPositon(ANode: TZjIDTreeNode): string; function GetFirstXmjParent(AChild: TZjIDTreeNode): TZjIDTreeNode; begin Result := AChild; if not Assigned(ANode) then Exit; if FBillsData.cdsBills.FindKey([AChild.ID]) then if FBillsData.cdsBillsCode.AsString <> '' then Result := AChild else Result := GetFirstXmjParent(AChild.Parent); end; var AFirstXmjParent: TZjIDTreeNode; begin Result := ''; if not Assigned(ANode) then Exit; // 若首先找到的项目节(项目节编号有数值)的名称中有桩号,则留空 AFirstXmjParent := GetFirstXmjParent(ANode); if FBillsData.cdsBills.FindKey([AFirstXmjParent.ID]) and CheckPegStr(FBillsData.cdsBillsName.AsString) then Exit; // 若首先找到的项目节为第二层或第三层(或者判断小于第四层),则留空 if AFirstXmjParent.Level < 4 then Exit; // 否则显示项目节名称 if FBillsData.cdsBills.FindKey([AFirstXmjParent.ID]) then Result := FBillsData.cdsBillsName.AsString; end; function TFlatGclExcelExportor.GetPro(ANode: TZjIDTreeNode): string; begin Result := ''; if not Assigned(ANode) then Exit; // 取树结构的第二层节点的名称(level从0开始) if ANode.Level > 1 then Result := GetPro(ANode.Parent) else if FBillsData.cdsBills.FindKey([ANode.ID]) and (FBillsData.cdsBillsCode.AsString <> '') then Result := FBillsData.cdsBillsName.AsString; end; function TFlatGclExcelExportor.GetSubPro(ANode: TZjIDTreeNode): string; begin Result := ''; if not Assigned(ANode) then Exit; // 取树结构的第三层节点的名称 if ANode.Level > 2 then Result := GetSubPro(ANode.Parent) else if FBillsData.cdsBills.FindKey([ANode.ID]) and (FBillsData.cdsBillsCode.AsString <> '') then Result := FBillsData.cdsBillsName.AsString; end; function TFlatGclExcelExportor.GetSubSubPro(ANode: TZjIDTreeNode): string; begin Result := ''; if not Assigned(ANode) then Exit; // 取树结构的第四层节点的名称 if ANode.Level > 3 then Result := GetSubSubPro(ANode.Parent) else if FBillsData.cdsBills.FindKey([ANode.ID]) and (FBillsData.cdsBillsCode.AsString <> '') then Result := FBillsData.cdsBillsName.AsString; end; procedure TFlatGclExcelExportor.InitHeadCell(AXlsPage: TXlsCustomPage; ACol, ARow: Integer; const AText: string); var xlsCell: TXlsCustomCell; begin xlsCell := AXlsPage.AddCell(ACol, ARow, AText); xlsCell.HTextAlign := htaCenter; xlsCell.Font.Name := '黑体'; xlsCell.Font.Size := 10; xlsCell.Font.Style := [fsBold]; end; procedure TFlatGclExcelExportor.InitialPageHead(AXlsPage: TXlsCustomPage); begin InitHeadCell(AXlsPage, FCodeCol, FRowIndex, '清单编号'); InitHeadCell(AXlsPage, FNameCol, FRowIndex, '名称'); InitHeadCell(AXlsPage, FUnitsCol, FRowIndex, '单位'); InitHeadCell(AXlsPage, FQuantityCol, FRowIndex, '工程量'); InitHeadCell(AXlsPage, FPriceCol, FRowIndex, '单价'); InitHeadCell(AXlsPage, FPegCol, FRowIndex, '桩号及位置'); InitHeadCell(AXlsPage, FProCol, FRowIndex, '单位工程'); InitHeadCell(AXlsPage, FSubProCol, FRowIndex, '分部工程'); InitHeadCell(AXlsPage, FSubSubProCol, FRowIndex, '分项工程'); InitHeadCell(AXlsPage, FPositonCol, FRowIndex, '部位'); InitHeadCell(AXlsPage, FDrawingCol, FRowIndex, '图号'); AXlsPage.Widths[FCodeCol] := 72; AXlsPage.Widths[FNameCol] := 188; AXlsPage.Widths[FUnitsCol] := 40; AXlsPage.Widths[FQuantityCol] := 72; AXlsPage.Widths[FPriceCol] := 62; AXlsPage.Widths[FPegCol] := 160; AXlsPage.Widths[FProCol] := 100; AXlsPage.Widths[FSubProCol] := 100; AXlsPage.Widths[FSubSubProCol] := 100; AXlsPage.Widths[FPositonCol] := 100; AXlsPage.Widths[FDrawingCol] := 100; Inc(FRowIndex); end; procedure TFlatGclExcelExportor.SetCommonCellFont( AXlsCell: TXlsCustomCell); begin if Assigned(AXlsCell) then begin AXlsCell.Font.Name := 'SmartSimsun'; AXlsCell.Font.Size := 9; end; end; end.