Delphi + Word Solution Reference

[转] This is a few functions I do in the process of doing the project. I see everyone asking Word. Now take it out and share it. (I hope some friends can add new features, or make packages or libs, etc., more convenient for everyone. I don't have time, huh, I will build an empty word file as needed before use, in the template Set a variety of formats and text in the file. In addition, the parameters of the PRNWORDTABLE are the TDBGRIDEH type control, which is taken from the SHFileCopy function (for copying files) and the GUIINFO function (for displaying the message box), the code is also attached.

The demonstration code is as follows: The function of the code is completed: 1. Replace the "# title #" text in the print template is "Demonstration Code 1" 2. And insert the contents of the DBGRIDEH1 control into the end of the document 3. Insert one at the end of the document Dark line 4. Insert a new line of text in the end of the document 5. Remove the empty line in the document IF PRNWORDBEGIN ('C: / Print Template .doc', 'C: / Target File 1.Doc') THEN BEGIN PRNWORDREPLACE (' # Title # ',' Demonstrative Code 1 '); PRNWORDTABLE (DBGRIDEH1); PRNWORDINSERT (' '); PRNWORDINSERT (' This is new line text '); PRNWORDREPLACE (' ^ p ^ p ',' ^ p ', true ); PrnWordSave; end; source code is as follows: // Word printing (declaration section) wDoc, wApp: Variant; function PrnWordBegin (tempDoc, docName: String): boolean; function PrnWordReplace (docText, newText: String; bSimpleReplace: boolean = false ): boolean; function PrnWordInsert (lineText: String; bNewLine: boolean = true): boolean; overload; function PrnWordInsert (var imgInsert: TImage; sBookMark: String = ''): boolean; overload; function PrnWordInsert (var chartInsert: TChart; sBookMark: String = ''): boolean; overload; function PrnWordTable (var dbG: TDBGridEh; sBookMark: String = ''): boolean; procedure PrnWordSave; procedure PrnWordEnd; // Word print (to achieve some) {functions: file-based templates Temp Doc New Target Document Docname and Open File} Function PRNWORDBEGIN (Tempdoc, Docname: String): Boolean; Begin Result: = false; // Replicating template IF Tempdoc <> '' Ten if not shfilecopy (Tempdoc, DOCNAME) THEN EXIT; / / Connect Word Try Wapp: = CreateoleObject ('Word.Application'); Except GuiInfo ('Please install Microsoft Word first.

'); Exit; end; try // Open if tempdoc =' 'Then Begin // Create a new document WDOC: = Wapp.document. Add; WDOC.SAVEAS (DOCNAME); END ELSE BEGIN / / Open Template WDOC: = Wapp.Document. .Open (docname); End; Except guiinfo ('Opening the template failed, please check if the template is correct.

'); Wapp.quit; exit; end; wapp.visible: = true; result: = true; end; {Function: Use newText to replace DOCTEXT contents BSIMPLETEPLACE: True only makes simple replacement, FALSE is wrapped in new text processing} function PrnWordReplace (docText, newText: String; bSimpleReplace: boolean = false): boolean; var i: Integer; begin if bSimpleReplace then begin // simple treatment, performed directly replace operation try wApp.Selection.Find.ClearFormatting; wApp. Selection.Find.Replacement.ClearFormatting; wApp.Selection.Find.Text: = docText; wApp.Selection.Find.Replacement.Text: = newText; wApp.Selection.Find.Forward: = True; wApp.Selection.Find.Wrap : = WDFINDCONTINUE; wapp.selection.find.format: = false; wapp.selection.find.matchcase: = false; wapp.selection.find.matchWholeWord: = true; wapp.selection.find.matchbyte: = true; WAPP. Selection.Find.MatchWildcards: = False; wApp.Selection.Find.MatchSoundsLike: = False; wApp.Selection.Find.MatchAllWordForms: = False; wApp.Selection.Find.Execute (Replace: = wdReplaceAll); result: = true; Except Result: = false; end; e XIT; END; // Automatic Branch Reword.Lines.clear; Reword.Lines.Add (NewText); try // Looking back at the back wapp.selection.find.clearformatting; wapp.selection.find.text: = DOCTEXT; wapp.selection.find.replacement.text: = '; wapp.selection.find.forward: = true; wapp.selection.find.wrap: = wdfindContinue; wapp.selection.Find.Format: = false; wApp.Selection.Find.MatchCase: = False; wApp.Selection.Find.MatchWholeWord: = False; wApp.Selection.Find.MatchByte: = True; wApp.Selection.Find.MatchWildcards: = False; wApp.Selection.Find. Matchsoundslike: = false;

Wapp.selection.Find.matchallWordForms: = false; wapp.selection.find.execute; wapp.seecute; wdcharacter, 1); // Start inserting for i: = 0 to reason.lines.count-1 do Begin // Insert the current line Wapp.Selection.InsertAfter (Reword.Lines [i]); // Automatically join the new line IF i

// Surge if it is 1. ICOL: = 0; for i: = 0 to dbg.columns.count-1 do begin if DBG.COLUMNS [i] .visible kilocol: = ICOL 1; End; end; // Calculate the number of rows (excluding hidden columns) if dbg.datasource.dataset.active kiline: = dbg.datasource.DataSet.RecordCount Else iline: = 0; IGRIDLINE: = iline ititleline dbg.footerrowcount; // Location Insertion Point If SBOOKMARK = '' TEN BEGIN / / The end of the document IRANGEEND: = WDOC.RANGE.END-1; if iRANGEEND <0 Then IRANGEEND: = 0; wrange: = Wdoc.range (IRANGEEND, IRANGEEND); ELSE Begin // WRANGE: = WDOC.Range.goto (WDGOTOBOOKMARK,, SBOOKMARK); END; WRANGE: = WDOC.TABLES.ADD (Wrange, IGRIDLINE, ICOL); wtable.column.autofit; // Title line K: = 1; for j: = 1 to dbg.columns.count do begin if dbg.columns [j-1] .visible kilnsi DBG.USEMULTITITLITITITITITELITELITITITITELITLIBLIN c i .Title.caption, '|'); wtable.cell (1, k) .Range.insertafter (titlelist.strings [0]); ELSE Wtable.cell (1, k) .Range.insertafter (DBG.COLUMNS [J-1] .title.caption); // Setting cell alignment method if dbg.columns [j-1] .title.alignment = Tacenter Then wTable.Cell (1, k) .Range.ParagraphFormat.Alignment: = wdAlignParagraphCenter else if dbG.Columns [j-1] .Title.Alignment = taRightJustify then wTable.Cell (1, k) .Range.ParagraphFormat.Alignment: = wdAlignParagraphRight else if dbG.Columns [j-1] .Title.Alignment = taLeftJustify then wTable.Cell (1, k) .Range.ParagraphFormat.Alignment: = wdAlignParagraphJustify; k: = k 1; end; end; // fill Each row IF iLine>

0 THEN BEGIN DBG.DASASOURCE.DATASET.DISABLECONTROLS; DBG.DataSource.DataSet.First; for i: = 1 to iline do begin k: = 1; for j: = 1 to dbg.columns.count do begin if dbg.columns [J-1] .visible kiln ife if.columns [j-1] .fieldname <> '' THEN / / Avoid error Begin // If the column has its own formatting display function, call display Function Get Display Strings GetTextText: = '; if Assigned (DBG.DataSource.DataSet.fieldbyName (DBG.COLUMNS [J-1] .fieldName) .ongetText) The begin dbg.datasource.Dataset.fieldbyname (DBG.COLUMNS [J -1] .FieldName) .OnGetText (dbG.DataSource.DataSet.FieldByName (dbG.Columns [j-1] .FieldName), getTextText, getTextDisplay); wTable.Cell (i iTitleLine, k) .Range.InsertAfter (getTextText ); END ELSE BEGIN // Use database contents to display wtable.cell (i ititleline, k) .Range.InsertAfter (dbg.datasource.DataSet.fieldbyName (DBG.COLUMNS [J-1] .fieldname) .sstring; end ; END; // Set cell alignment method if dbg.columns [j-1] .alignment = Tacenter Then Wtable.cell (i ititleline, k) .Range.ParagraphFormat.Alignment: = WDalignParaGraphCenter else if DBG.Columns [J- 1] .Alignment = taRightJustify then wTable.Cell (i iTitleLine, k) .Range.ParagraphFormat.Alignment: = wdAlignParagraphRight else if dbG.Columns [j-1] .Alignment = taLeftJustify then wTable.Cell (i iTitleLine, k ) .Range.ParagraphFormat.Alignment: = wdalignparagraphjustify; k: = k 1; end; end; dbg.datasource.dataset.next; end; end; // End FOR i: =

1 to dbg.footerrowcount do begin k: = 1; for j: = 1 to dbg.columns.count do begin if DBG.COLUMNS [J-1] .visible kilin wtable.cell (iline 1 i, k) .Range.insertafter (DBG.GetfooterValue (i-1, dbg.columns [j-1])); // Set cell alignment method if dbg.columns [j-1] .footer.alignment = Tacenter Then Wtable.cell (iline 1 i, k) .Range.ParagraphFormat.Alignment: = WDALIGNPARAGRAGRENTER ELSE IF DBG.COLUMNS [J-1] .footer.Alignment = TATIHTJUSTIFY THEN WTABLE.CELL (Iline 1 i, k) .range. ParagraphFormat.Alignment: = wdAlignParagraphRight else if dbG.Columns [j-1] .Footer.Alignment = taLeftJustify then wTable.Cell (iLine 1 i, k) .Range.ParagraphFormat.Alignment: = wdAlignParagraphJustify; k: = k 1; end; end; end; // Handling Multi-Bank Title If DBG.USEMULTITITITLE THEN Begin // First Segment cell, then fill in the second line K: = 1; titlecol: = 1; LastTitleSplit: = 1; Subtitle : = 0; LastTitle: = ''; for j: = 1 to dbg.columns.count do beg IN iF dbg.columns [j-1] .visible kiln = strsplit (dbg.columns [j-1] .title.caption, '|'); if TitleList.count> 1 Then Begin // Processing Second Above the content wtable.cell (1, k-subtitle) .Range.cells.Split (titleList.count, 1, false); for titlesplit: = 1 to titlelist.count-1 do begin Wtable.cell (Titlesplit 1 , TitleCol) .Range.insertAfter (Titlelist.strings [titlesplit]); end; titlecol: = titlecol 1; // Handling the first line merge IF (LastTitleSplit = Titlelist.count) and (lasttitle =

Titlelist.strings [0]) THEN Begin // Contents, Merged Units Wtable.cell (1, K-subtitle) .Range.copy; Wrange: = Wdoc.Range (Wtable.cell (1, K-Subtitle- 1) .range.start, wtable.cell (1, k-subtitle) .range.end; wrange.cells.merge; wrange.paste; subtitle: = subtitle 1; end; end; lasttitle: = titleList.Strings [0]; Lasttitlesplit: = titleList.count; titleList.cle; k: = k 1; end; end; end; // automatic adjustment table Wtable.autofitbehavior (1); // Automatically adjust according to content table wdAutoFitContent wTable.AutoFitBehavior (2); // table automatically adjust to window wdAutoFitWindow result: = true; except result: = false; end; try dbG.DataSource.dataset.EnableControls; except end; end; {function: Word file Insert a text (able to automatically make a wrap) LINETEXT: When you want to insert a new line, False is inserted in the current row when you are in the current line} Function PRNWORDINSERT (Linetext: String; boolean; var i: Integer; begin tryness.Insertafter (# 13); //动 分 分 r = = o...... O o o o o o o o o o o o o o o o o o o o o o o o o o o o o .LINES [I]); // In addition to the last line, automatically add new line IF i

0 THEN IRANGEEND: = 0; wrange: = wdoc.range (IRANGEEND, IRANGEEND); Else Begin // Wrange: = Wdoc.Range.goto (WDGOTOBOOKMARK, SBOKMARK); End; if imginsert.picture. Graphic <> nil dam clipboard.assign (imginsert.picture); wrange.Paste; end else begin wrange.insertafter ('photo'); end; result: = true; eXcept results: = false; end; end; {function : insert TChart controls contained in the bookmark sBookMark chart} function PrnWordInsert (var chartInsert: TChart; sBookMark: String = ''): boolean; var wRange: Variant; iRangeEnd: Integer; begin try if sBookMark = '' then begin // In the end of the document, Irangend: = wdoc.range.end-1; if irangeend <0 Then IRANGEEND: = 0; wrange: = Wdoc.Range (iRANGEEND, IRANGEEND); Else Begin // WRANGE: = WDOC.RANGE .Goto (wdGoToBookmark ,,, sBookMark); end; chartInsert.CopyToClipboardBitmap; wRange.Paste; result: = true; except result: = false; end; end; {function: save Word files} procedure PrnWordSave; begin try wDoc.Save EXCEPT End; End; {Function: Close Word file } procedure pRNWORDEND; begin try wdoc.save; wdoc.close; wapp.quit; Except end; end; addition: SHFileCopy Source code {Function: Secure copy file srcfile, DESTFILE: Source file and target file BDELDEST: If the target file is already Presented, whether it is overridden to return value: true success, false failed} Function Shfilecopy (srcfile, destfile &: string; bofeldest: boolean = true): boolean; begin result: = false; if not fileexists (srcfile) THEN BEGIN GUIINFO ('source file Do not exist, can not be copied. ' # 10 # 13 srcfile; exit; end; if srcfile = destfile The begin guiinfo ("The source file and the target file are the same, can not be copied.