123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287 |
- unit ExportExcel;
- interface
- uses
- Classes, ZjGrid, ScXlsOutput, ScXlsCustomUD, Windows, StdCtrls,
- sdIDTree, sdDB, Graphics, SysUtils, ProgressHintFrm, Forms, Controls,
- OExport, OExport_Vcl, OExport_VclForms, BillsPosTree, BillsTree;
- type
- TExcelExportor = class
- private
- FOExport: TOExport;
- FGrid: TZJGrid;
- FTempFile: string;
- FFileName: string;
- procedure InitialPage(AGrid: TZJGrid; ASheet: TExportWorkSheet);
- protected
- procedure BeforeExport;
- procedure EndExport;
- public
- constructor Create;
- destructor Destroy; override;
- procedure ExportToSheet(AGrid: TZJGrid; ASheet: TExportWorkSheet);
- procedure ExportToFile(AGrid: TZJGrid; const AFileName: string);
- end;
- PColInfo = ^TColInfo;
- TColInfo = record
- // 字段名
- FieldName: string;
- // 查询字段名,应用于联合几个数据库的情况,参照dataset的Lookup方式
- KeyField: string;
- LookupKeyField: string;
- // 查询数据库ID
- LookupDataSetIndex: Integer;
- // 列名
- TitleCaption: string;
- // 列宽
- Width: Integer;
- // 对齐方式
- HorTextAlign: TCellHAlignment;
- //VerTextAlign: TUDVTextAlign;
- end;
- PColInfos = ^TColInfos;
- TColInfos = array [0..30] of TColInfo;
- // 仿照DataSet的Lookup以及数据库的AutoUpdate, 以达到关于sdIDTree导出数据至Excel的普适性
- // 导出前须根据所需列信息,以及查询数据库(列信息须与查询数据库对等,否则将会报错,并不检查列与数据库是否匹配)
- TIDTreeExcelExportor = class
- private
- FOExport: TOExport;
- FDataSetList: TList;
- FColInfos: PColInfos;
- FColCount: Integer;
- FHasLevelCode: Boolean;
- FTree: TsdIDTree;
- FTempFile: string;
- // 当清单数超过3w3k行时,使用Variant会内存溢出
- function GetCellValue(ANode: TsdIDTreeNode; ColInfo: TColInfo): Variant;
- // 故换成直接使用String
- function GetCellStr(ANode: TsdIDTreeNode; ColInfo: TColInfo): string;
- procedure ExportNodeData(ANode: TsdIDTreeNode; ASheet: TExportWorkSheet; const ALevelCode: string);
- procedure ExportTreeNode(ANode: TsdIDTreeNode; ASheet: TExportWorkSheet; const ALevelCode: string);
- procedure DefineHeader(ASheet: TExportWorkSheet);
- protected
- procedure BeforeExport;
- procedure AfterExport;
- public
- constructor Create;
- destructor Destroy; override;
- procedure AddLookupDataSet(ADataSet: TsdDataSet);
- procedure DefineCol(AColInfos: PColInfos; AColCount: Integer);
- procedure ExportToSheet(ATree: TsdIDTree; ASheet: TExportWorkSheet);
- procedure ExportToFile(ATree: TsdIDTree; const AFileName: string);
- property HasLevelCode: Boolean read FHasLevelCode write FHasLevelCode;
- end;
- TMasterExcelExportor = class
- private
- FOExport: TOExport;
- FColInfos: PColInfos;
- FRelaColInfos: PColInfos;
- FColCount: Integer;
- FTempFile: string;
- FMasterDataSet: TsdDataSet;
- FKeyFieldName: string;
- FRelaDataSet: TsdDataSet;
- FMasterFieldName: string;
- function GetCellValue(ARec: TsdDataRecord; ColInfo: TColInfo): Variant;
- procedure ExportRecord(ARec: TsdDataRecord; ASheet: TExportWorkSheet; AColInfos: PColInfos);
- procedure ExportData(ASheet: TExportWorkSheet);
- procedure DefineHeader(ASheet: TExportWorkSheet);
- protected
- procedure BeforeExport;
- procedure AfterExport;
- public
- constructor Create;
- destructor Destroy; override;
- procedure DefineCol(AColInfos: PColInfos; AColCount: Integer; ARelaColInfo: PColInfos = nil);
- procedure DefineMasterDataSet(ADataSet: TsdDataSet; const AKeyFieldName: string);
- procedure DefineRelaDataSet(ADataSet: TsdDataSet; const AMasterFieldName: string);
- procedure ExportToSheet(ASheet: TExportWorkSheet);
- procedure ExportToFile(const AFileName: string);
- end;
- TBillsPosExcelExportor = class
- private
- FOExport: TOExport;
- FTempFile: string;
- FTree: TBillsPosTree;
- FCodeCol: Integer;
- FB_CodeCol: Integer;
- FP_CodeCol: Integer;
- FNameCol: Integer;
- FUnitsCol: Integer;
- FQuantityCol: Integer;
- FDgnQty1: Integer;
- FDgnQty2: Integer;
- FPriceCol: Integer;
- FTotalPriceCol: Integer;
- FDrawingCodeCol: Integer;
- FMemoStrCol: Integer;
- procedure DefineHeader(ASheet: TExportWorkSheet);
- function HasGclChild(ANode: TBillsIDTreeNode): Boolean;
- function FindNode(AParent: TBillsPosTreeNode; AMatch: TBillsIDTreeNode): TBillsPosTreeNode;
- procedure ConversePosNode(ANode: TBillsIDTreeNode; AParent: TBillsPosTreeNode = nil);
- function ConverseNodeData(ANode: TBillsIDTreeNode; AParent: TBillsPosTreeNode = nil): TBillsPosTreeNode;
- procedure ConverseTreeNode(ANode: TBillsIDTreeNode; AParent: TBillsPosTreeNode = nil);
- procedure ExportPos(ASheet: TExportWorkSheet; ANode: TBillsPosTreeNode);
- procedure ExportNode(ASheet: TExportWorkSheet; ANode: TBillsPosTreeNode);
- procedure ExportData(ASheet: TExportWorkSheet);
- protected
- procedure BeforeExport;
- procedure AfterExport;
- public
- constructor Create;
- destructor Destroy; override;
- procedure ExportToSheet(ABillsIDTree: TBillsIDTree; ASheet: TExportWorkSheet);
- procedure ExportToFile(ABillsIDTree: TBillsIDTree; const AFileName: string);
- end;
- TPosBillsExcelExportor = class
- private
- FOExport: TOExport;
- FTempFile: string;
- FCodeCol: Integer;
- FB_CodeCol: Integer;
- FP_CodeCol: Integer;
- FNameCol: Integer;
- FUnitsCol: Integer;
- FQuantityCol: Integer;
- FDgnQty1: Integer;
- FDgnQty2: Integer;
- FPriceCol: Integer;
- FTotalPriceCol: Integer;
- FDrawingCodeCol: Integer;
- FMemoStrCol: Integer;
- procedure DefineHeader(ASheet: TExportWorkSheet);
- function HasGclChild(ANode: TBillsIDTreeNode): Boolean;
- procedure ExportNode(ASheet: TExportWorkSheet; ANode: TBillsIDTreeNode);
- protected
- procedure BeforeExport;
- procedure AfterExport;
- public
- constructor Create;
- destructor Destroy; override;
- procedure ExportToSheet(ABillsIDTree: TBillsIDTree; ASheet: TExportWorkSheet);
- procedure ExportToFile(ABillsIDTree: TBillsIDTree; const AFileName: string);
- end;
- const
- ciLedger: array [0..8] of TColInfo =(
- (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
- (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
- (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
- (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
- (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
- (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 80; HorTextAlign: cahRight),
- (FieldName: 'OrgTotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
- (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
- (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
- );
- ciLedgerWithMis: array [0..10] of TColInfo =(
- (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
- (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
- (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
- (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
- (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
- (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '施工图数量'; Width: 90; HorTextAlign: cahRight),
- (FieldName: 'MisQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计错漏数量'; Width: 90; HorTextAlign: cahRight),
- (FieldName: 'OthQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '其他错漏数量'; Width: 90; HorTextAlign: cahRight),
- (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
- (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
- (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
- );
- ciFxBills: array [0..10] of TColInfo =(
- (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '预算项目节'; Width: 120; HorTextAlign: cahLeft),
- (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单子目号'; Width: 80; HorTextAlign: cahLeft),
- (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
- (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
- (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单数量'; Width: 80; HorTextAlign: cahRight),
- (FieldName: 'DgnQuantity1'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量1'; Width: 80; HorTextAlign: cahRight),
- (FieldName: 'DgnQuantity2'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量2'; Width: 80; HorTextAlign: cahRight),
- (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
- (FieldName: 'OrgTotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '合价'; Width: 80; HorTextAlign: cahRight),
- (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
- (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
- );
- ciFxBillsWithMis: array [0..12] of TColInfo =(
- (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '预算项目节'; Width: 120; HorTextAlign: cahLeft),
- (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单子目号'; Width: 80; HorTextAlign: cahLeft),
- (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
- (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
- (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单数量'; Width: 90; HorTextAlign: cahRight),
- (FieldName: 'MisQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计错漏数量'; Width: 90; HorTextAlign: cahRight),
- (FieldName: 'OthQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '其他错漏数量'; Width: 90; HorTextAlign: cahRight),
- (FieldName: 'DgnQuantity1'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量1'; Width: 80; HorTextAlign: cahRight),
- (FieldName: 'DgnQuantity2'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量2'; Width: 80; HorTextAlign: cahRight),
- (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
- (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '合价'; Width: 80; HorTextAlign: cahRight),
- (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
- (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
- );
- ciTpPegGcl: array [0..9] of TColInfo =(
- (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
- (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
- (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
- (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
- (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
- (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
- (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
- (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
- (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
- (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
- );
- ciTpGclPeg_Gcl: array [0..9] of TColInfo =(
- (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
- (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
- (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
- (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
- (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
- (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
- (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
- (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
- (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
- (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
- );
- ciTpGclPeg_Peg: array [0..9] of TColInfo =(
- (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
- (FieldName: 'PegXmjCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
- (FieldName: 'PegXmjName'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
- (FieldName: 'PegXmjUnits'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
- (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
- (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
- (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
- (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
- (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
- (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
- );
- implementation
- uses
- ZhAPI, Variants, UtilMethods, Math, CacheTree, mDataRecord;
- function GetExportor(const AFileType: string): TOCustomExporter;
- begin
- if SameText(AFileType, '.xls') then
- Result := TOCustomExporterXLS.Create
- else if SameText(AFileType, '.xlsx') then
- Result := TOCustomExporterXLSX.Create;
- end;
- { TExcelExportor }
- procedure TExcelExportor.BeforeExport;
- begin
- Screen.Cursor := crHourGlass;
- ShowProgressHint('导出Excel表格数据', FGrid.RowCount);
- end;
- constructor TExcelExportor.Create;
- begin
- FOExport := TOExport.Create;
- FOExport.UseProgress := False;
- FTempFile := GetTempFileName;
- end;
- destructor TExcelExportor.Destroy;
- begin
- if FileExists(FTempFile) then
- DeleteFileOrFolder(FTempFile);
- FOExport.Free;
- inherited;
- end;
- procedure TExcelExportor.EndExport;
- begin
- CloseProgressHint;
- Screen.Cursor := crDefault;
- end;
- procedure TExcelExportor.ExportToFile(AGrid: TZJGrid;
- const AFileName: string);
- var
- vExportor: TOCustomExporter;
- begin
- FFileName := AFileName;
- FGrid := AGrid;
- BeforeExport;
- try
- vExportor := GetExportor(ExtractFileExt(AFileName));
- ExportToSheet(AGrid, FOExport.AddWorkSheet);
- FOExport.SaveToFile(FTempFile, vExportor);
- if not FileExists(FFileName) or QuestMessage('存在同名文件,是否替换?') then
- CopyFileOrFolder(FTempFile, FFileName);
- finally
- vExportor.Free;
- EndExport;
- end;
- end;
- procedure TExcelExportor.ExportToSheet(AGrid: TZJGrid;
- ASheet: TExportWorkSheet);
- procedure SetXlsCellTextAlign(ACell: TExportCell; AGridCell: TzjCell);
- begin
- case AGridCell.TextAlign of
- gaTopLeft:
- begin
- ACell.SetVAlignment(cavTop);
- ACell.SetAlignment(cahLeft);
- end;
- gaTopCenter:
- begin
- ACell.SetVAlignment(cavTop);
- ACell.SetAlignment(cahCenter);
- end;
- gaTopRight:
- begin
- ACell.SetVAlignment(cavTop);
- ACell.SetAlignment(cahRight);
- end;
- gaCenterLeft:
- begin
- ACell.SetVAlignment(cavCenter);
- ACell.SetAlignment(cahLeft);
- end;
- gaCenterCenter:
- begin
- ACell.SetVAlignment(cavCenter);
- ACell.SetAlignment(cahCenter);
- end;
- gaCenterRight:
- begin
- ACell.SetVAlignment(cavCenter);
- ACell.SetAlignment(cahRight);
- end;
- gaBottomLeft:
- begin
- ACell.SetVAlignment(cavBottom);
- ACell.SetAlignment(cahLeft);
- end;
- gaBottomCenter:
- begin
- ACell.SetVAlignment(cavBottom);
- ACell.SetAlignment(cahCenter);
- end;
- gaBottomRight:
- begin
- ACell.SetVAlignment(cavBottom);
- ACell.SetAlignment(cahRight);
- end;
- end;
- if goWarpText in AGridCell.Grid.Options then
- ACell.WrapText := True;
- end;
- procedure ExportGridCell(AGridCell: TzjCell; ARow: TExportRow);
- var
- vCell: TExportCell;
- XlsCell: TXlsCustomCell;
- begin
- if (AGridCell = nil) then Exit;
- if ARow.Cells.Count >= AGridCell.Col + 1 then
- vCell := ARow.Cells[AGridCell.Col]
- else
- vCell := ARow.AddCellString(AGridCell.Text);
- SetXlsCellTextAlign(vCell, AGridCell);
- vCell.Font.Name := AGridCell.Font.Name;
- vCell.Font.Size := AGridCell.Font.Size;
- vCell.RowSpan := AGridCell.Height;
- vCell.ColSpan := AGridCell.Width;
- vCell.Width := FGrid.ColWidths[AGridCell.Col];
- vCell.Height := FGrid.RowHeights[AGridCell.Row];
- end;
- var
- iColumn, iRow: Integer;
- vRow: TExportRow;
- begin
- for iRow := 0 to AGrid.RowCount - 1 do
- begin
- UpdateProgressHint(Format('导出第%d行数据', [iRow + 1]));
- UpdateProgressHint(1);
- vRow := ASheet.AddRow;
- for iColumn := 0 to AGrid.ColCount - 1 do
- ExportGridCell(AGrid.Cells[iColumn, iRow], vRow);
- end;
- end;
- procedure TExcelExportor.InitialPage(AGrid: TZJGrid;
- ASheet: TExportWorkSheet);
- procedure InitialColumnWidth;
- var
- iColumn: Integer;
- begin
- for iColumn := 0 to AGrid.ColCount - 1 do
- ASheet.Cols[iColumn].SetWidth(AGrid.ColWidths[iColumn]);
- end;
- procedure InitialRowHeight;
- var
- iRow: Integer;
- begin
- for iRow := 0 to AGrid.RowCount - 1 do
- ASheet.Rows[iRow].SetHeight(AGrid.RowHeights[iRow]);
- end;
- begin
- InitialColumnWidth;
- InitialRowHeight;
- end;
- { TIDTreeExcelExportor }
- constructor TIDTreeExcelExportor.Create;
- begin
- FOExport := TOExport.Create;
- FDataSetList := TList.Create;
- FTempFile := GetTempFileName;
- end;
- destructor TIDTreeExcelExportor.Destroy;
- begin
- if FileExists(FTempFile) then
- DeleteFileOrFolder(FTempFile);
- FDataSetList.Free;
- FOExport.Free;
- inherited;
- end;
- procedure TIDTreeExcelExportor.ExportToFile(ATree: TsdIDTree;
- const AFileName: string);
- var
- vExportor: TOCustomExporter;
- begin
- FTree := ATree;
- BeforeExport;
- try
- vExportor := GetExportor(ExtractFileExt(AFileName));
- ExportToSheet(ATree, FOExport.AddWorkSheet);
- UpdateProgressHint('保存0号台账Excel数据');
- FOExport.SaveToFile(FTempFile, vExportor);
- if not FileExists(AFileName) or QuestMessage('存在同名文件,是否替换?') then
- CopyFileOrFolder(FTempFile, AFileName);
- finally
- vExportor.Free;
- AfterExport;
- end;
- end;
- procedure TIDTreeExcelExportor.ExportTreeNode(ANode: TsdIDTreeNode;
- ASheet: TExportWorkSheet; const ALevelCode: string);
- function GetFirstChildLevelCode(const ACode: string): string;
- begin
- Result := ACode + '.1';
- end;
- function GetNextSiblingLevelCode(const ACode: string): string;
- var
- strPreCode, strLastCode: string;
- iNextCode: Integer;
- begin
- if Pos('.', ACode) = 0 then
- Result := IntToStr(StrToIntDef(ACode, 1) + 1)
- else
- begin
- strPreCode := GetPrefixOfCode(ACode, '.');
- strLastCode := GetLastSetmentOfCode(ACode, '.');
- iNextCode := StrToIntDef(strLastCode, 1) + 1;
- Result := strPreCode + '.' + IntToStr(iNextCode);
- end;
- end;
- var
- sHint: string;
- begin
- if not Assigned(ANode) then Exit;
- if ANode.Rec.ValueByName('Code').AsString <> '' then
- sHint := '正在导出清单 ' + ANode.Rec.ValueByName('Code').AsString
- else if ANode.Rec.ValueByName('B_Code').AsString <> '' then
- sHint := '正在导出清单 ' + ANode.Rec.ValueByName('B_Code').AsString
- else
- sHint := '正在导出清单 ' + ANode.Rec.ValueByName('Name').AsString;
- UpdateProgressHint(sHint);
- UpdateProgressHint(1);
- ExportNodeData(ANode, ASheet, ALevelCode);
- ExportTreeNode(ANode.FirstChild, ASheet, GetFirstChildLevelCode(ALevelCode));
- ExportTreeNode(ANode.NextSibling, ASheet, GetNextSiblingLevelCode(ALevelCode));
- end;
- procedure TIDTreeExcelExportor.ExportNodeData(ANode: TsdIDTreeNode;
- ASheet: TExportWorkSheet; const ALevelCode: string);
- var
- iCol: Integer;
- ColInfo: TColInfo;
- vRow: TExportRow;
- vCell: TExportCell;
- XlsCell: TXlsCustomCell;
- sStr: string;
- begin
- if not Assigned(ANode) then Exit;
- vRow := ASheet.AddRow;
- vRow.Height := 20;
- for iCol := 0 to FColCount - 1 do
- begin
- ColInfo := FColInfos[iCol];
- vCell := vRow.AddCellString(GetCellStr(ANode, ColInfo));
- vCell.Alignment := ColInfo.HorTextAlign;
- vCell.Font.Name := 'SmartSimSun';
- vCell.Font.Size := 9;
- end;
- if HasLevelCode then
- begin
- vCell := vRow.AddCellString(ALevelCode);
- vCell.Font.Name := 'SmartSimSun';
- vCell.Font.Size := 9;
- end;
- end;
- procedure TIDTreeExcelExportor.ExportToSheet(ATree: TsdIDTree;
- ASheet: TExportWorkSheet);
- begin
- DefineHeader(ASheet);
- ExportTreeNode(ATree.FirstNode, ASheet, '1');
- end;
- function TIDTreeExcelExportor.GetCellValue(ANode: TsdIDTreeNode;
- ColInfo: TColInfo): Variant;
- function GetRec: TsdDataRecord;
- var
- DataSet: TsdDataSet;
- begin
- Result := nil;
- DataSet := TsdDataSet(FDataSetList.Items[ColInfo.LookupDataSetIndex]);
- if not Assigned(DataSet) then Exit;
- Result := DataSet.Locate(ColInfo.LookupKeyField, ANode.Rec.ValueByName(ColInfo.KeyField).Value);
- end;
- var
- ARec: TsdDataRecord;
- begin
- Result := '';
- if not Assigned(ANode) then Exit;
- if ColInfo.LookupDataSetIndex = -1 then
- ARec := ANode.Rec
- else
- ARec := GetRec;
- if Assigned(ARec) then
- Result := ARec.ValueByName(ColInfo.FieldName).Value;
- end;
- procedure TIDTreeExcelExportor.DefineHeader(ASheet: TExportWorkSheet);
- var
- iCol: Integer;
- ColInfo: TColInfo;
- vRow: TExportRow;
- vCell: TExportCell;
- XlsCell: TXlsCustomCell;
- begin
- vRow := ASheet.AddRow;
- vRow.Height := 20;
- for iCol := 0 to FColCount - 1 do
- begin
- ColInfo := FColInfos[iCol];
- vCell := vRow.AddCellString(ColInfo.TitleCaption);
- vCell.SetAlignment(cahCenter);
- vCell.SetVAlignment(cavCenter);
- vCell.Font.Name := '黑体';
- vCell.Font.Size := 10;
- vCell.Width := ColInfo.Width;
- end;
- if HasLevelCode then
- begin
- vCell := vRow.AddCellString('层次编号');
- vCell.SetAlignment(cahCenter);
- vCell.SetVAlignment(cavCenter);
- vCell.Font.Name := '黑体';
- vCell.Font.Size := 10;
- end;
- end;
- procedure TIDTreeExcelExportor.AddLookupDataSet(ADataSet: TsdDataSet);
- begin
- FDataSetList.Add(ADataSet);
- end;
- procedure TIDTreeExcelExportor.DefineCol(AColInfos: PColInfos;
- AColCount: Integer);
- begin
- FColInfos := AColInfos;
- FColCount := AColCount;
- end;
- procedure TIDTreeExcelExportor.BeforeExport;
- begin
- Screen.Cursor := crHourGlass;
- ShowProgressHint('导出0号台账Excel数据', FTree.Count);
- end;
- procedure TIDTreeExcelExportor.AfterExport;
- begin
- CloseProgressHint;
- Screen.Cursor := crDefault;
- end;
- function TIDTreeExcelExportor.GetCellStr(ANode: TsdIDTreeNode;
- ColInfo: TColInfo): string;
- function GetRec: TsdDataRecord;
- var
- DataSet: TsdDataSet;
- begin
- Result := nil;
- DataSet := TsdDataSet(FDataSetList.Items[ColInfo.LookupDataSetIndex]);
- if not Assigned(DataSet) then Exit;
- Result := DataSet.Locate(ColInfo.LookupKeyField, ANode.Rec.ValueByName(ColInfo.KeyField).Value);
- end;
- var
- ARec: TsdDataRecord;
- begin
- Result := '';
- if not Assigned(ANode) then Exit;
- if ColInfo.LookupDataSetIndex = -1 then
- ARec := ANode.Rec
- else
- ARec := GetRec;
- if Assigned(ARec) then
- Result := ARec.ValueByName(ColInfo.FieldName).AsString;
- if SameText(Result, '0') then
- Result := '';
- end;
- { TMasterExcelExportor }
- procedure TMasterExcelExportor.BeforeExport;
- begin
- Screen.Cursor := crHourGlass;
- end;
- constructor TMasterExcelExportor.Create;
- begin
- FOExport := TOExport.Create;
- FTempFile := GetTempFileName;
- end;
- procedure TMasterExcelExportor.DefineCol(AColInfos: PColInfos;
- AColCount: Integer; ARelaColInfo: PColInfos);
- begin
- FColInfos := AColInfos;
- FColCount := AColCount;
- FRelaColInfos := ARelaColInfo;
- end;
- procedure TMasterExcelExportor.DefineHeader(ASheet: TExportWorkSheet);
- var
- iCol: Integer;
- ColInfo: TColInfo;
- vRow: TExportRow;
- vCell: TExportCell;
- begin
- vRow := ASheet.AddRow;
- vRow.Height := 20;
- for iCol := 0 to FColCount - 1 do
- begin
- ColInfo := FColInfos[iCol];
- vCell := vRow.AddCellString(ColInfo.TitleCaption);
- vCell.SetAlignment(cahCenter);
- vCell.SetVAlignment(cavCenter);
- vCell.Font.Name := '黑体';
- vCell.Font.Size := 10;
- vCell.Width := ColInfo.Width;
- end;
- end;
- procedure TMasterExcelExportor.DefineMasterDataSet(ADataSet: TsdDataSet;
- const AKeyFieldName: string);
- begin
- FMasterDataSet := ADataSet;
- FKeyFieldName := AKeyFieldName;
- end;
- procedure TMasterExcelExportor.DefineRelaDataSet(ADataSet: TsdDataSet;
- const AMasterFieldName: string);
- begin
- FRelaDataSet := ADataSet;
- FMasterFieldName := AMasterFieldName;
- end;
- destructor TMasterExcelExportor.Destroy;
- begin
- if FileExists(FTempFile) then
- DeleteFileOrFolder(FTempFile);
- FOExport.Free;
- inherited;
- end;
- procedure TMasterExcelExportor.AfterExport;
- begin
- Screen.Cursor := crDefault;
- end;
- procedure TMasterExcelExportor.ExportData(ASheet: TExportWorkSheet);
- var
- i, j: Integer;
- Rec, RelaRec: TsdDataRecord;
- begin
- for i := 0 to FMasterDataSet.RecordCount - 1 do
- begin
- Rec := FMasterDataSet.Records[i];
- ExportRecord(Rec, ASheet, FColInfos);
- for j := 0 to FRelaDataSet.RecordCount - 1 do
- begin
- RelaRec := FRelaDataSet.Records[j];
- if (RelaRec.ValueByName(FMasterFieldName).Value = Rec.ValueByName(FKeyFieldName).Value) then
- begin
- if Assigned(FRelaColInfos) then
- ExportRecord(RelaRec, ASheet, FRelaColInfos)
- else
- ExportRecord(RelaRec, ASheet, FColInfos);
- end;
- end;
- end;
- end;
- procedure TMasterExcelExportor.ExportRecord(ARec: TsdDataRecord;
- ASheet: TExportWorkSheet; AColInfos: PColInfos);
- var
- iCol: Integer;
- ColInfo: TColInfo;
- vRow: TExportRow;
- vCell: TExportCell;
- sStr: string;
- begin
- if not Assigned(ARec) then Exit;
- vRow := ASheet.AddRow;
- for iCol := 0 to FColCount - 1 do
- begin
- ColInfo := AColInfos[iCol];
- vCell := vRow.AddCellVariant(GetCellValue(ARec, ColInfo));
- vCell.Font.Name := 'SmartSimSun';
- vCell.Font.Size := 9;
- end;
- end;
- procedure TMasterExcelExportor.ExportToFile(const AFileName: string);
- var
- vExportor: TOCustomExporter;
- begin
- if not Assigned(FMasterDataSet) then Exit;
- BeforeExport;
- try
- vExportor := GetExportor(ExtractFileExt(AFileName));
- ExportToSheet(FOExport.AddWorkSheet);
- FOExport.SaveToFile(FTempFile, vExportor);
- if not FileExists(AFileName) or QuestMessage('存在同名文件,是否替换?') then
- CopyFile(PChar(FTempFile), PChar(AFileName), False);
- finally
- vExportor.Free;
- AfterExport;
- end;
- end;
- procedure TMasterExcelExportor.ExportToSheet(ASheet: TExportWorkSheet);
- begin
- if not Assigned(FMasterDataSet) then Exit;
- DefineHeader(ASheet);
- ExportData(ASheet);
- end;
- function TMasterExcelExportor.GetCellValue(ARec: TsdDataRecord;
- ColInfo: TColInfo): Variant;
- var
- Value: TsdValue;
- begin
- Result := '';
- if Assigned(ARec) then
- begin
- Value := ARec.ValueByName(ColInfo.FieldName);
- if Assigned(Value) then
- Result := Value.AsVariant;
- end;
- end;
- { TBillsPosExcelExportor }
- procedure TBillsPosExcelExportor.AfterExport;
- begin
- Screen.Cursor := crDefault;
- end;
- procedure TBillsPosExcelExportor.BeforeExport;
- begin
- Screen.Cursor := crHourGlass;
- end;
- procedure TBillsPosExcelExportor.ConversePosNode(ANode: TBillsIDTreeNode;
- AParent: TBillsPosTreeNode);
- var
- i: Integer;
- vChild: TBillsIDTreeNode;
- vCur: TBillsPosTreeNode;
- vPos: TPosNode;
- begin
- if ANode.ChildCount = 0 then Exit;
- for i := 0 to ANode.ChildCount - 1 do
- begin
- vChild := TBillsIDTreeNode(ANode.ChildNodes[i]);
- if (vChild.Rec.B_Code.AsString <> '') then
- begin
- vCur := FindNode(AParent, vChild);
- if not Assigned(vCur) then
- vCur := ConverseNodeData(vChild, AParent);
- vPos := vCur.AddPos;
- vPos.Name := ANode.Rec.Name.AsString;
- vPos.Quantity := vChild.Rec.Quantity.AsFloat;
- vPos.MemoStr := ANode.Rec.MemoStr.AsString;
- vPos.DrawingCode := ANode.Rec.DrawingCode.AsString;
- end;
- end;
- end;
- procedure TBillsPosExcelExportor.ConverseTreeNode(
- ANode: TBillsIDTreeNode; AParent: TBillsPosTreeNode);
- var
- vCur: TBillsPosTreeNode;
- begin
- if not Assigned(ANode) then Exit;
- if (ANode.Rec.B_Code.AsString = '') then
- begin
- if (Pos('1-1-', ANode.Rec.Code.AsString) = 1) or (not HasGclChild(ANode)) then
- begin
- vCur := ConverseNodeData(ANode, AParent);
- ConverseTreeNode(TBillsIDTreeNode(ANode.FirstChild), vCur);
- end
- else
- ConversePosNode(ANode, AParent);
- end
- else if (Assigned(ANode.Parent) And (Pos('1-1-', TBillsIDTreeNode(ANode.Parent).Rec.Code.AsString) = 1)) then
- begin
- vCur := ConverseNodeData(ANode, AParent);
- vCur.Quantity := ANode.Rec.Quantity.AsFloat;
- ConverseTreeNode(TBillsIDTreeNode(ANode.FirstChild), vCur);
- end;
- ConverseTreeNode(TBillsIDTreeNode(ANode.NextSibling), AParent);
- end;
- function TBillsPosExcelExportor.ConverseNodeData(ANode: TBillsIDTreeNode;
- AParent: TBillsPosTreeNode): TBillsPosTreeNode;
- begin
- Result := TBillsPosTreeNode(FTree.AddNode(AParent));
- Result.Code := ANode.Rec.Code.AsString;
- Result.B_Code := ANode.Rec.B_Code.AsString;
- Result.Name := ANode.Rec.Name.AsString;
- Result.Units := ANode.Rec.Units.AsString;
- Result.DrawingCode := ANode.Rec.DrawingCode.AsString;
- Result.MemoStr := ANode.Rec.MemoStr.AsString;
- Result.DgnQty1 := ANode.Rec.DgnQuantity1.AsFloat;
- Result.DgnQty2 := ANode.Rec.DgnQuantity2.AsFloat;
- Result.Price := ANode.Rec.Price.AsFloat;
- Result.TotalPrice := ANode.Rec.TotalPrice.AsFloat;
- end;
- constructor TBillsPosExcelExportor.Create;
- begin
- FOExport := TOExport.Create;
- FTempFile := GetTempFileName;
- FCodeCol := 0;
- FB_CodeCol := 1;
- FP_COdeCol := 2;
- FNameCol := 3;
- FUnitsCol := 4;
- FQuantityCol := 5;
- FDgnQty1 := 6;
- FDgnQty2 := 7;
- FPriceCol := 8;
- FTotalPriceCol := 9;
- FDrawingCodeCol := 10;
- FMemoStrCol := 11;
- end;
- procedure TBillsPosExcelExportor.DefineHeader(ASheet: TExportWorkSheet);
- procedure AddHeaderCell(ARow: TExportRow; iCol: Integer; const AText: String; AWidth: Integer);
- var
- vCell: TExportCell;
- begin
- vCell := ARow.AddCellString(AText);
- vCell.SetAlignment(cahCenter);
- vCell.SetVAlignment(cavCenter);
- vCell.Font.Name := '黑体';
- vCell.Font.Size := 10;
- vCell.Width := AWidth;
- end;
- var
- iCol: Integer;
- ColInfo: TColInfo;
- vRow: TExportRow;
- vCell: TExportCell;
- begin
- vRow := ASheet.AddRow;
- vRow.Height := 20;
- AddHeaderCell(vRow, FCodeCol, '项目节编号', 100);
- AddHeaderCell(vRow, FB_CodeCol, '清单编号', 80);
- AddHeaderCell(vRow, FP_CodeCol, '计量单元', 80);
- AddHeaderCell(vRow, FNameCol, '名称', 300);
- AddHeaderCell(vRow, FUnitsCol, '单位', 60);
- AddHeaderCell(vRow, FQuantityCol, '清单数量', 70);
- AddHeaderCell(vRow, FDgnQty1, '设计数量1', 70);
- AddHeaderCell(vRow, FDgnQty2, '设计数量2', 70);
- AddHeaderCell(vRow, FPriceCol, '单价', 70);
- AddHeaderCell(vRow, FTotalPriceCol, '合价', 70);
- AddHeaderCell(vRow, FDrawingCodeCol, '图号', 85);
- AddHeaderCell(vRow, FMemoStrCol, '备注', 100);
- end;
- destructor TBillsPosExcelExportor.Destroy;
- begin
- if FileExists(FTempFile) then
- DeleteFileOrFolder(FTempFile);
- FOExport.Free;
- inherited;
- end;
- procedure TBillsPosExcelExportor.ExportData(ASheet: TExportWorkSheet);
- begin
- ExportNode(ASheet, TBillsPosTreeNode(FTree.FirstNode));
- end;
- procedure TBillsPosExcelExportor.ExportNode(ASheet: TExportWorkSheet;
- ANode: TBillsPosTreeNode);
- var
- vRow: TExportRow;
- vCell: TExportCellNumber;
- begin
- if not Assigned(ANode) then Exit;
- vRow := ASheet.AddRow;
- vRow.AddCellString(ANode.Code);
- vRow.AddCellString(ANode.B_Code);
- vRow.AddCellString('');
- vRow.AddCellString(ANode.Name);
- vRow.AddCellString(ANode.Units);
- vCell := vRow.AddCellNumber(ANode.Quantity);
- vCell.EmptyIfZero := True;
- vCell := vRow.AddCellNumber(ANode.DgnQty1);
- vCell.EmptyIfZero := True;
- vCell := vRow.AddCellNumber(ANode.DgnQty2);
- vCell.EmptyIfZero := True;
- vCell := vRow.AddCellNumber(ANode.Price);
- vCell.EmptyIfZero := True;
- vCell := vRow.AddCellNumber(ANode.TotalPrice);
- vCell.EmptyIfZero := True;
- vRow.AddCellString(ANode.DrawingCode);
- vRow.AddCellString(ANode.MemoStr);
- ExportPos(ASheet, ANode);
- ExportNode(ASheet, TBillsPosTreeNode(ANode.FirstChild));
- ExportNode(ASheet, TBillsPosTreeNode(ANode.NextSibling));
- end;
- procedure TBillsPosExcelExportor.ExportPos(ASheet: TExportWorkSheet;
- ANode: TBillsPosTreeNode);
- var
- i: Integer;
- vPos: TPosNode;
- vRow: TExportRow;
- vCell: TExportCellNumber;
- begin
- if not Assigned(ANode) then Exit;
- for i := 0 to ANode.PosCount - 1 do
- begin
- vPos := ANode.Pos[i];
- vRow := ASheet.AddRow;
- vRow.AddCellString();
- vRow.AddCellString();
- vRow.AddCellString(IntToStr(i+1));
- vRow.AddCellString(vPos.Name);
- vRow.AddCellString();
- vCell := vRow.AddCellNumber(vPos.Quantity);
- vCell.EmptyIfZero := True;
- vCell := vRow.AddCellNumber();
- vCell.EmptyIfZero := True;
- vCell := vRow.AddCellNumber();
- vCell.EmptyIfZero := True;
- vCell := vRow.AddCellNumber();
- vCell.EmptyIfZero := True;
- vCell := vRow.AddCellNumber();
- vCell.EmptyIfZero := True;
- vRow.AddCellString(vPos.DrawingCode);
- vRow.AddCellString(vPos.MemoStr);
- end;
- end;
- procedure TBillsPosExcelExportor.ExportToFile(ABillsIDTree: TBillsIDTree; const AFileName: string);
- var
- vExportor: TOCustomExporter;
- begin
- BeforeExport;
- try
- vExportor := GetExportor(ExtractFileExt(AFileName));
- ExportToSheet(ABillsIDTree, FOExport.AddWorkSheet);
- FOExport.SaveToFile(FTempFile, vExportor);
- if not FileExists(AFileName) or QuestMessage('存在同名文件,是否替换?') then
- CopyFile(PChar(FTempFile), PChar(AFileName), False);
- finally
- vExportor.Free;
- AfterExport;
- end;
- end;
- procedure TBillsPosExcelExportor.ExportToSheet(ABillsIDTree: TBillsIDTree; ASheet: TExportWorkSheet);
- begin
- DefineHeader(ASheet);
- FTree := TBillsPosTree.Create;
- try
- ConverseTreeNode(TBillsIDTreeNode(ABillsIDTree.FirstNode));
- FTree.CalculateAll;
- ExportData(ASheet);
- finally
- FTree.Free;
- end;
- end;
- function TBillsPosExcelExportor.HasGclChild(
- ANode: TBillsIDTreeNode): Boolean;
- var
- i: Integer;
- vChild: TBillsIDTreeNode;
- begin
- Result := False;
- for i := 0 to ANode.ChildCount - 1 do
- begin
- vChild := TBillsIDTreeNode(ANode.ChildNodes[i]);
- if (vChild.Rec.B_Code.AsString <> '') then
- begin
- Result := True;
- Exit;
- end;
- end;
- end;
- function TBillsPosExcelExportor.FindNode(AParent: TBillsPosTreeNode;
- AMatch: TBillsIDTreeNode): TBillsPosTreeNode;
- var
- i: Integer;
- vChild: TBillsPosTreeNode;
- begin
- Result := nil;
- if not Assigned(AParent) then Exit;
- for i := 0 to AParent.Children.Count - 1 do
- begin
- vChild := TBillsPosTreeNode(AParent.Children.Items[i]);
- if ((vChild.B_Code = AMatch.Rec.B_Code.AsString) And
- (vChild.Name = AMatch.Rec.Name.AsString) And
- (vChild.Units = AMatch.Rec.Units.AsString) And
- (PriceRoundTo(vChild.Price - AMatch.Rec.Price.AsFloat) = 0)) then
- begin
- Result := vChild;
- Break;
- end;
- end;
- end;
- { TPosBillsExcelExportor }
- procedure TPosBillsExcelExportor.AfterExport;
- begin
- Screen.Cursor := crDefault;
- end;
- procedure TPosBillsExcelExportor.BeforeExport;
- begin
- Screen.Cursor := crHourGlass;
- end;
- constructor TPosBillsExcelExportor.Create;
- begin
- FOExport := TOExport.Create;
- FTempFile := GetTempFileName;
- FCodeCol := 0;
- FP_COdeCol := 1;
- FB_CodeCol := 2;
- FNameCol := 3;
- FUnitsCol := 4;
- FQuantityCol := 5;
- FDgnQty1 := 6;
- FDgnQty2 := 7;
- FPriceCol := 8;
- FTotalPriceCol := 9;
- FDrawingCodeCol := 10;
- FMemoStrCol := 11;
- end;
- procedure TPosBillsExcelExportor.DefineHeader(ASheet: TExportWorkSheet);
- procedure AddHeaderCell(ARow: TExportRow; iCol: Integer; const AText: String; AWidth: Integer);
- var
- vCell: TExportCell;
- begin
- vCell := ARow.AddCellString(AText);
- vCell.SetAlignment(cahCenter);
- vCell.SetVAlignment(cavCenter);
- vCell.Font.Name := '黑体';
- vCell.Font.Size := 10;
- vCell.Width := AWidth;
- end;
- var
- iCol: Integer;
- ColInfo: TColInfo;
- vRow: TExportRow;
- vCell: TExportCell;
- begin
- vRow := ASheet.AddRow;
- vRow.Height := 20;
- AddHeaderCell(vRow, FCodeCol, '项目节编号', 100);
- AddHeaderCell(vRow, FP_CodeCol, '计量单元', 80);
- AddHeaderCell(vRow, FB_CodeCol, '清单编号', 80);
- AddHeaderCell(vRow, FNameCol, '名称', 300);
- AddHeaderCell(vRow, FUnitsCol, '单位', 60);
- AddHeaderCell(vRow, FQuantityCol, '清单数量', 70);
- AddHeaderCell(vRow, FDgnQty1, '设计数量1', 70);
- AddHeaderCell(vRow, FDgnQty2, '设计数量2', 70);
- AddHeaderCell(vRow, FPriceCol, '单价', 70);
- AddHeaderCell(vRow, FTotalPriceCol, '合价', 70);
- AddHeaderCell(vRow, FDrawingCodeCol, '图号', 85);
- AddHeaderCell(vRow, FMemoStrCol, '备注', 100);
- end;
- destructor TPosBillsExcelExportor.Destroy;
- begin
- if FileExists(FTempFile) then
- DeleteFileOrFolder(FTempFile);
- FOExport.Free;
- inherited;
- end;
- procedure TPosBillsExcelExportor.ExportNode(ASheet: TExportWorkSheet;
- ANode: TBillsIDTreeNode);
- var
- vRow: TExportRow;
- vCell: TExportCellNumber;
- begin
- if not Assigned(ANode) then Exit;
- vRow := ASheet.AddRow;
- if (Pos('1-1-', ANode.Rec.Code.AsString) = 1) or (not HasGclChild(ANode)) then
- begin
- vRow.AddCellString(ANode.Rec.Code.AsString);
- vRow.AddCellString('');
- end
- else
- begin
- vRow.AddCellString('');
- vRow.AddCellString(ANode.Rec.Code.AsString);
- end;
- vRow.AddCellString(ANode.Rec.B_Code.AsString);
- vRow.AddCellString(ANode.Rec.Name.AsString);
- vRow.AddCellString(ANode.Rec.Units.AsString);
- vCell := vRow.AddCellNumber(ANode.Rec.Quantity.AsFloat);
- vCell.EmptyIfZero := True;
- vCell := vRow.AddCellNumber(ANode.Rec.DgnQuantity1.AsFloat);
- vCell.EmptyIfZero := True;
- vCell := vRow.AddCellNumber(ANode.Rec.DgnQuantity2.AsFloat);
- vCell.EmptyIfZero := True;
- vCell := vRow.AddCellNumber(ANode.Rec.Price.AsFloat);
- vCell.EmptyIfZero := True;
- vCell := vRow.AddCellNumber(ANode.Rec.TotalPrice.AsFloat);
- vCell.EmptyIfZero := True;
- vRow.AddCellString(ANode.Rec.DrawingCode.AsString);
- vRow.AddCellString(ANode.Rec.MemoStr.AsString);
- ExportNode(ASheet, TBillsIDTreeNode(ANode.FirstChild));
- ExportNode(ASheet, TBillsIDTreeNode(ANode.NextSibling));
- end;
- procedure TPosBillsExcelExportor.ExportToFile(ABillsIDTree: TBillsIDTree;
- const AFileName: string);
- var
- vExportor: TOCustomExporter;
- begin
- BeforeExport;
- try
- vExportor := GetExportor(ExtractFileExt(AFileName));
- ExportToSheet(ABillsIDTree, FOExport.AddWorkSheet);
- FOExport.SaveToFile(FTempFile, vExportor);
- if not FileExists(AFileName) or QuestMessage('存在同名文件,是否替换?') then
- CopyFile(PChar(FTempFile), PChar(AFileName), False);
- finally
- vExportor.Free;
- AfterExport;
- end;
- end;
- procedure TPosBillsExcelExportor.ExportToSheet(ABillsIDTree: TBillsIDTree;
- ASheet: TExportWorkSheet);
- begin
- DefineHeader(ASheet);
- ExportNode(ASheet, TBillsIDTreeNode(ABillsIDTree.FirstNode));
- end;
- function TPosBillsExcelExportor.HasGclChild(
- ANode: TBillsIDTreeNode): Boolean;
- var
- i: Integer;
- vChild: TBillsIDTreeNode;
- begin
- Result := False;
- for i := 0 to ANode.ChildCount - 1 do
- begin
- vChild := TBillsIDTreeNode(ANode.ChildNodes[i]);
- if (vChild.Rec.B_Code.AsString <> '') then
- begin
- Result := True;
- Exit;
- end;
- end;
- end;
- end.
|