u_d_word.pas

来自「人事管理程序源码」· PAS 代码 · 共 236 行

PAS
236
字号
unit U_d_word;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Word2000, OleServer,QComCtrls,StdCtrls, Buttons,ADODB, ComCtrls;

type
  TForm_d_word = class(TForm)
    WordDocument1: TWordDocument;
    WordApplication1: TWordApplication;
    procedure open_doc;
    procedure replace_str(Mak_text,rep_str:string);
    procedure close_doc;
    procedure copyFile(S_file,D_file:string);
    procedure insert_grid(Dbset:TadoDataset);
    procedure locate(Mak_text:string);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form_d_word: TForm_d_word;
implementation

{$R *.dfm}
procedure TForm_d_word.replace_str(Mak_text,rep_str:string);
var
  doc_file,exepath:string;
  i,index:integer;
  findtext, matchcase, matchwholeword, matchwildcards, matchsoundslike,
  matchallwordforms, forward, wrap, format, replacewith, replace,matchkashida,matchdiacritics,matchalefhamza,matchcontrol: olevariant;
begin
  findtext := '<#'+mak_text+'>';
  matchcase := false;
  matchwholeword := true;
  matchwildcards := false;
  matchsoundslike := false;
  matchallwordforms := false;
  forward := true;
  wrap := wdfindcontinue;
  format := false;
  replacewith := rep_str;
  replace := true;
  worddocument1.range.find.execute( findtext, matchcase, matchwholeword,matchwildcards, matchsoundslike, matchallwordforms, forward,wrap, format, replacewith, replace,matchkashida,matchdiacritics,matchalefhamza,matchcontrol);
end;

procedure TForm_d_word.open_doc;
var
  sf,df,doc_file,exepath:string;
  i,index:integer;
  itemindex :olevariant;
  filename, confirmconversions, readonly, addtorecentfiles,
  passworddocument, passwordtemplate, revert,writepassworddocument, writepasswordtemplate, format,Encoding,Visible: olevariant;
begin
  exepath:=application.ExeName;
  for index:=1 to length(exepath) do
      if exepath[index]='\' then
         i:=index;
  exepath:=copy(exepath,1,i);
  doc_file:=exepath+'zgdaxxk.dak';//以标题字段“mc”命名Word文件
  sf:=doc_file;
  df:=exepath+'zgxxk.doc';
  try
    Wordapplication1.connect;
  except
    messagedlg('没有安装Word',mterror,[mbok],0);
    abort;
  end;
  if wordapplication1.Visible then close_doc;
  {open document}
  copyFile(Sf,Df);
  filename :=df;
  confirmconversions := false;
  readonly := false;
  addtorecentfiles := false;
  passworddocument := '';
  passwordtemplate := '';
  revert := true;
  writepassworddocument := '';
  writepasswordtemplate := '';
  format := wdopenformatdocument;
  encoding:='';
  Visible:=true;
  wordapplication1.documents.open( filename, confirmconversions,readonly, addtorecentfiles, passworddocument, passwordtemplate,revert, writepassworddocument, writepasswordtemplate, format,Encoding,Visible);
  {assign worddocument component}
  itemindex := 1;
  worddocument1.connectto(wordapplication1.documents.item(itemindex));
  {turn spell checking of because it takes a long time if enabled and slows down winword}
  wordapplication1.options.checkspellingasyoutype := false;
  wordapplication1.options.checkgrammarasyoutype := false;
  wordapplication1.WindowState:=wdWindowStateMinimize;
  wordapplication1.Visible:=true;
  worddocument1.Activate;
end;

procedure TForm_d_word.close_doc;
var
  savechanges, originalformat, routedocument: olevariant;
begin
  if wordapplication1.Visible then
     begin
        savechanges := wddonotsavechanges;
        originalformat := unassigned;
        routedocument := unassigned;
        try
          worddocument1.Close;
          wordapplication1.quit(savechanges, originalformat, routedocument);
          wordapplication1.disconnect;
        except
          on e:exception do begin
            showmessage(e.message);
            wordapplication1.disconnect;
          end;
        end;
     end;
end;

procedure TForm_d_word.copyFile(S_file,D_file:string);
var
  s,d:string;
  SrcFile,DestFile:File;
  BytesRead,BytesWritten,ToTalRead:Integer;
  Buffer:Array[1..500] of byte;
  Fsize:integer;
begin
  s:=S_file;
  d:=D_file;
  AssignFile(SrcFile,S);
  AssignFile(DestFile,D);
  ReSet(SrcFile,1);
  try
    Rewrite(destFile,1);
    try
      try
        TotalRead:=0;
        Fsize:=filesize(SrcFile);
        repeat
          BlockRead(SrcFile,Buffer,Sizeof(Buffer),BytesRead);
          if BytesRead>0 then
             begin
               BlockWrite(DEStFile,Buffer,BytesRead,BytesWritten);
               if BytesRead<>BytesWritten then
                  Raise Exception.Create('文件拷贝出错!!')
               else
                 begin
                   ToTalRead:=ToTalRead+BytesRead;
                 end;
             end ;
          until bytesRead=0;
      except
        Erase(DestFile);
        Raise;
      end;
    finally
      CloseFile(DestFile);
    end;
  Finally
    CloseFile(SrcFile);
  end;
end;
//==
procedure TForm_d_word.insert_grid(Dbset:TadoDataset);
var
 t,doc:olevariant;
 counts:integer;
begin
    Wordapplication1.Selection.Font.Size :=10;
    doc:=Wordapplication1.activedocument;
    counts:=dbset.RecordCount;  //记录数决定表格的行数
    t:=doc.tables.Add(Wordapplication1.selection.range,counts+1,5);//5列
    t.cell(1,1).range.text:= '单位';
    t.Cell(1,1).Width:=120;
    t.cell(1,1).range.Paragraphs.Alignment:= wdAlignParagraphCenter;
    t.cell(1,2).range.text:= '姓名';
    t.cell(1,2).range.text:= '单位';
    t.Cell(1,2).Width:=120;
    t.cell(1,2).range.Paragraphs.Alignment:= wdAlignParagraphCenter;
{
   ... ...

  //依次写入其他字段的表头

  for i:=2 to counts+1 do

  begin

  t.cell(i,1).range.text:=adoquery2.field

  byname('dw').asstring;

  t.Cell(i,1).Width:=120;

  t.cell(i,1).range.Paragraphs.Alignment:=

   wdAlignParagraphCenter;

  t.cell(i,2).range.text:=adoquery2.field

  byname('xm').asstring;

  ... ...

  Adoquery2.next;

  End;           }
end;
//==
procedure TForm_d_word.locate(Mak_text:string);
var
  doc_file,exepath:string;
  i,index:integer;
  findtext, matchcase, matchwholeword, matchwildcards, matchsoundslike,
  matchallwordforms, forward, wrap, format, replacewith, replace,matchkashida,matchdiacritics,matchalefhamza,matchcontrol: olevariant;
begin
  findtext := '<#'+mak_text+'>';
  matchcase := false;
  matchwholeword := true;
  matchwildcards := false;
  matchsoundslike := false;
  matchallwordforms := false;
  forward := true;
  wrap := wdFindStop;
  format := false;
  replacewith :='';
  replace := false;

  worddocument1.range.find.execute( findtext, matchcase, matchwholeword,matchwildcards, matchsoundslike, matchallwordforms, forward,wrap, format, replacewith, replace,matchkashida,matchdiacritics,matchalefhamza,matchcontrol);
end;

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?