Delphi Word Solution Reference
This is a few functions I do in the process of doing the project. Seeing everyone is asking Word. Now take it out and share it. (I hope some friends can further add new features, or make packages or libs, etc., more convenient for everyone. I have no time, huh, huh)
Before use, build an empty Word file as a template as needed, set a variety of formats and text in the template file. In addition, the parameters of the PRNWORDTABLE are TDBGRIDEH types of controls, taken from EHLIB2.6
The SHFileCopy function (for copying file) and the GuiInfo function (for displaying the message box) are also written, 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. Insert the contents of the DBGRIDEH1 control to the end of the document
3. Insert an empty line at the end of the document
4. Insert a new line of text at the end of the document
5. Remove the empty lines in the document
IF PRNWORDBEGIN ('C: / Print Template.doc', 'C: / Target File 1.doc') THEN
Begin
PRNWORDREPLACE ('# title #', 'Demonstration Code 1');
PRNWORDTABLE (DBGRIDEH1);
PRNWORDINSERT ('');
PRNWORDINSERT ('This is a new line of text');
PRNWORDREPLACE ('^ p ^ p', '^ p', true);
PRNWORDSAVE;
END;
The source code is as follows:
// Word Print (Declaration section)
WDOC, WAPP: VARIANT;
Function PRNWORDBEGIN (Tempdoc, Docname: String): Boolean
Function PRNWORDREPLACE (DOCTEXT, NewText: String; BSIMPLEPLACE: 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 (Implementation)
{
Function: Based on template file Tempdoc New Target file DOCNAME and open files
}
Function PRNWORDBEGIN (Tempdoc, Docname: String): Boolean
Begin
Result: = FALSE;
// copy template
IF Tempdoc <> '' Then
IF not shfilecopy (Tempdoc, Docname) THEN EXIT;
// Connect Word
Try
Wapp: = creteoleObject ('word.application'); Except
GuiInfo ('Please install Microsoft Word.');
EXIT;
END;
Try
//turn on
IF Tempdoc = '' THEN
Begin
// Create a new document
WDOC: = wapp.document.add;
WDoc.saveas (docname);
ELSE BEGIN
// Open the template
WDOC: = wapp.documents.open (docname);
END;
Except
GuiInfo ('Open the template failed, please check if the template is correct.');
Wapp.quit;
EXIT;
END;
Wapp.visible: = TRUE;
RESULT: = true;
END;
{
Function: Replace DOCTEXT content with NewText
BSIMPLEREPLACE: True is only simple to replace, and the new text is wrapped when False.
}
Function PRNWORDREPLACE (DOCTEXT, NewText: String; BSIMPLEPLACE: BOOLEAN = false: boolean;
VAR i: integer;
Begin
IF BSIMPLEREPLACE THEN
Begin
// Simple processing, direct execution of replacement operations
Try
Wapp.seection.find.clearformatting;
Wapp.selection.find.Replacement.clearformatting;
Wapp.seection.find.text: = DOCTEXT;
Wapp.selection.find.replacement.text: = newText;
Wapp.seection.find.forward: = true;
Wapp.selection.find.wrap: = WDFINDCONTINUE;
Wapp.seection.find.format: = false;
Wapp.selection.find.matchcase: = false;
Wapp.seection.find.matchwholeword: = true;
Wapp.selection.find.matchbyte: = TRUE
Wapp.seection.find.matchwildcards: = false;
Wapp.seection.find.matchsoundslike: = false;
Wapp.seection.find.matchallwordforms: = false;
Wapp.selection.find.execute (Replace: = WDREPLACEALL);
RESULT: = true;
Except
Result: = FALSE;
END;
EXIT;
END;
// Automatic branch
Reword.lines.clear;
Reword.Lines.Add (NewText);
Try
/ / Laid to the back of the location to be replaced
Wapp.seection.find.clearformatting;
Wapp.seection.find.text: = DOCTEXT;
Wapp.seection.find.replacement.text: = ';
Wapp.seection.find.forward: = true;
Wapp.selection.find.wrap: = WDFINDCONTINUE;
Wapp.seection.find.format: = false; wapp.selection.find.matchcase: = false;
Wapp.seection.find.matchwholeword: = false;
Wapp.selection.find.matchbyte: = TRUE
Wapp.seection.find.matchwildcards: = false;
Wapp.seection.find.matchsoundslike: = false;
Wapp.seection.find.matchallwordforms: = false;
Wapp.seection.find.execute;
Wapp.seection.moveright (WDCharacter, 1);
// Start insertion
For i: = 0 to reason.lines.count-1 do
Begin
// Insert the current line
Wapp.selection.insertafter (Reword.Lines [i]);
// In addition to the last line, automatically join the new line
IF i Wapp.seection.insertafter; END; / / Delete replacement position Wapp.seection.find.clearformatting; Wapp.selection.find.Replacement.clearformatting; Wapp.seection.find.text: = DOCTEXT; Wapp.seection.find.replacement.text: = '; Wapp.seection.find.forward: = true; Wapp.selection.find.wrap: = WDFINDCONTINUE; Wapp.seection.find.format: = false; Wapp.selection.find.matchcase: = false; Wapp.seection.find.matchwholeword: = true; Wapp.selection.find.matchbyte: = TRUE Wapp.seection.find.matchwildcards: = false; Wapp.seection.find.matchsoundslike: = false; Wapp.seection.find.matchallwordforms: = false; Wapp.selection.find.execute (Replace: = WDREPLACEALL); RESULT: = true; Except Result: = FALSE; END; END; { Function: Print the content currently displayed by TDBGRIDEH Based on the format and content of the TDBGRIDEH control, the Word table is automatically generated at the SBOOKMARK bookmark in the document. At present, it is possible to support cells, multi-line headings (two lines), and bottom total. SBOOKMARK: The bookmark name to insert the table in Word } Function PRNWORDTABLE (VAR DBG: TDBGRIDEH; SBOOKMARK: STRING = '): boolean; VAR ICOL, ILINE, I, J, K: Integer; WTABLE, WRANGE: VARIANT; irangend: longint; IGRIDLINE, ITITLINE: INTEGER; GetTextText: String; GetTextdisplay: Boolean; TitleList: TstringList; TitleSplit, titlecol: integer; latitleSplit, Subtitle: integer; lasttitle: string Begin Result: = FALSE; Try / / Computing the number of columns (excluding hidden columns) iTertleLine: = 1; // always definitely thinks 1 ICOL: = 0; For i: = 0 to dbg.columns.count-1 do Begin IF dbg.columns [i] .visible the Begin ICOL: = ICOL 1; END; END; / / Calculate the number of rows in the form (excluding hidden columns) if dbg.datasource.dataset.active the iline: = dbg.datasource.dataset.recordcount Else iline: = 0; IGRIDLINE: = iline ititleline dbg.footerrowcount; // Positioning Insertion Point IF SBOOKMARK = '' THEN Begin // At the end of the document Irangend: = WDOC.RANGE.END-1; IRANGEEND <0 THEN IRANGEEND: = 0; Wrange: = WDOC.Range (irangeend, irangeend); ELSE BEGIN // At the bookmark Wrange: = WDOC.Range.goto (WDGOTOBOOKMARK,, SBOOKMARK); END; Wtable: = 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 Then Begin IF dbg.usemultititle the Begin Titlelist: = strsplit (dbg.column [j-1] .title.caption, '|); Wtable.cell (1, k) .range.insertafter (titleList.strings [0]); END ELSE Wtable.cell (1, k) .range.insertafter (DBG.COLUMNS [J-1] .title.caption); // Set the unit alignment 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 = TATIHTJUSTIFY THEN Wtable.cell (1, k) .Range.ParagraphFormat.Alignment: = WDALIGNPARAGRAGRAGRIGHT Else if dbg.columns [j-1] .title.Alignment = TALEFTJUSTIFY THEN Wtable.cell (1, k) .range.ParagraphFormat.Alignment: = WDALIGNPARRAGRAGRAUSTIFY; K: = k 1; END; END; // Fill in each row IF iline> 0 thenbegin DBG.DataSource.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 Then Begin If DBG.COLUMNS [J-1] .fieldname <> '' Then // Avoid error due to empty columns Begin // If the column has its own format display function, call the display function to get the display string GetTextText: = ''; IF assigned (dbg.datasource.dataset.fieldbyname (dbg.columns [j-1] .fieldname) .ongetText) THEN 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); ELSE BEGIN // Use the database content display Wtable.cell (i ititleline, k) .range.insertafter (dbg.datasource.dataset.fieldbyname (dbg.columns [j-1] .fieldname) .sstring); END; END; // Set the unit alignment 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: = WDALIGNPARRAGRAGRAUSTIFY; 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 Then Begin Wtable.cell (ILINE 1 I, K) .Range.InsertAfter (DBG.GetfooterValue (I-1, DBG.COLUMNS [J-1])); // Set the unit alignment If DBG.COLUMNS [J-1] .footer.alignment = Tacenter Then Wtable.cell (iline 1 i, k) .Range.ParagraphFormat.Alignment: = WDalignParagraphCentereLse 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: = WDALIGNPARRAGRAGRAUSTIFY; K: = k 1; END; END; END; // Handling multiple lines IF dbg.usemultititle the Begin // First divide the cell, then fill in the second line one by one K: = 1; Titlecol: = 1; Lasttitlesplit: = 1; Subtitle: = 0; Lasttitle: = ''; For j: = 1 to dbg.columns.count do Begin If DBG.COLUMNS [J-1] .visible Then Begin Titlelist: = strsplit (dbg.column [j-1] .title.caption, '|); IF titlelist.count> 1 THEN Begin // Trepate the contents of the second line or more 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 (titlesplit); END; Titlecol: = Titlecol 1; // Treat the first line merge IF (lasttitlesplit = titlelist.count) and (lasttitle = titlelist.strings [0]) THEN Begin // The content is the same, the merging unit 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.mege; Wrange.Paste; Subtitle: = Subtitle 1; END; END; Lasttitle: = TitleList.strings [0]; Lasttitlesplit: = titlelist.count; TitleList.clear; titleList.free; K: = k 1; END; END; END; // Automatic adjustment form Wtable.autofitbehavior (1); // Automatically adjust the table WDAUTOFITCONTENT according to content Wtable.autofitbehavior (2); // Automatically adjust the table WDAUTOFITWINDOW according to the window RESULT: = true; Except Result: = FALSE; END; Try DBG.DataSource.DataSet.enableControls; Except END; END; { Function: Insert text in the Word file (can automatically make wrap processing) Linetext: Text to insert BNEWLINE: True, new line, False is inserted in the current line } Function PRNWORDINSERT (LINETEXT: STRING; BNEWLINE: BOOLEAN = true): boolean; VAR i: integer; Begin Try IF BNewline Then WDOC.RANGE.INSERTAFTER (# 13); // Automatic branch Reword.lines.clear; Reword.Lines.Add (linetext); // Start insertion For i: = 0 to reason.lines.count-1 do Begin // Insert the current line WDOC.Range.Insertafter (Reword.Lines [i]); // In addition to the last line, automatically join the new line IF i WDOC.RANGE.INSERTAFTER (# 13); END; RESULT: = true; Except Result: = FALSE; END; END; { Function: Insert the Timage control included in the SBOOKMARK bookmark at the Word file } Function PRNWORDINSERT (VAR IMGINSERT: TIMAGE; SBOOKMARK: STRING = '): boolean; Var Wrange: IRANGEEND: IRANGEEND: INTEGER; Begin Try IF SBOOKMARK = '' THEN Begin // At the end of the document Irangend: = WDOC.RANGE.END-1; IRANGEEND <0 THEN IRANGEEND: = 0; Wrange: = WDOC.Range (irangeend, irangeend); ELSE BEGIN // At the bookmark Wrange: = WDOC.Range.goto (WDGOTOBOOKMARK,, SBOOKMARK); END; IF imginsert.picture.graphic <> nil dam Begin Clipboard.assign (imginsert.picture); Wrange.Paste; ELSE BEGIN Wrange.Insertafter ('photo'); END; RESULT: = true; Except Result: = FALSE; END; END; { Function: Insert the TCHART control in the bookmark Sbookmark containing charts } Function PRNWORDISERT (VAR Chartinsert: tChart; SBOOKMARK: STRING = '): boolean; Var Wrange: IRANGEEND: IRANGEEND: INTEGER; Begin Try IF SBOOKMARK = '' THEN Begin // At the end of the document Irangend: = WDOC.RANGE.END-1; IRANGEEND <0 THEN IRANGEEND: = 0; Wrange: = WDOC.Range (irangeend, irangeend); ELSE BEGIN // At the bookmark Wrange: = WDOC.Range.goto (WDGOTOBOOKMARK,, SBOOKMARK); END; Chartinsert.copytoclipboardBitmap; Wrange.Paste; RESULT: = true; Except Result: = FALSE; END; END; { Function: Save Word file } 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; Attached: SHFILECOPY source code { Function: Secure copy file SRCFILE, DESTFILE: Source Files and Target Files BDELDEST: If the target file already exists, is it overwritten? Return Value: True is successful, FALSE failed } Function shfilecopy (srcfile, destfile: string; bdeldest: boolean = true): boolean; Begin Result: = FALSE; IF not fileexists (srcfile) THEN Begin GuiInfo ('source file does not exist, can not be copied.' # 10 # 13 srcfile; EXIT; END; If srcfile = destfile kil Begin GuiInfo ('source files and target files can not be copied.'); EXIT; END; If FileExists (Destfile) THEN Begin IF not bdeldest. Begin Guiinfo ('"target file already exists, can not be copied.' # 10 # 13 destfile; EXIT; END; FileSetattr (Destfile, Filegetttr (Destfile) and not $ 00000001); IF not deletefile (Pchar (Destfile)) THEN Begin GuiInfo ('"destined file already exists, and cannot be deleted, copy failed.' # 10 # 13 destfile; EXIT; END; END; IF not CopyFileto (srcfile, destfile) THEN Begin GuiInfo ('The unknown error occurred, the copy file failed.'); EXIT; END; / / The target file removes read-only properties FileSetattr (Destfile, Filegetttr (Destfile) and not $ 00000001); RESULT: = true; END; Attached: GuiInfo source code { Function: Encapsulated various nature prompts SMSG: Message to prompt } Procedure GuiInfo (SMSG: String); Begin Messagedlg (SMSG, Mtinformation, [Mbok], 0); END;
