unit1.pas

word是我们常用的

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, OleServer,shellapi, OleCtnrs,comobj,
  Word2000;

type
  TForm1 = class(TForm)
    WordApplication1: TWordApplication;
    WordDocument1: TWordDocument;
    BitBtn1: TBitBtn;
    Edit1: TEdit;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    Button3: TButton;
    procedure BitBtn1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    function DropFileExt(FileName:String):String;
//    function ReadBusyCount :Integer; stdcall;  far  external 'Tc08a32.dll';
//    int         WINAPI DJCvt_Tiff2Bfx(char *Tifffilename,char *Bfxfilename);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses tc08a32;

{$R *.dfm}
function DJCvt_Tiff2Bfx(tifffilename:pchar;bfxfilename:pchar):Integer;stdcall; far external 'DJ_TIF.dll';
//function StartPlayFile (wChnlNo : WORD;FileName: PCHAR; StartPos: LONGINT ) : BOOLEAN; stdcall; far external 'Tc08a32.dll';

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  msword:variant;
  str,name:string;
begin
  if length(edit1.Text)=0 then
  exit;
  try
    msword:=createoleobject('word.application');
    msword.documents.open(edit1.Text);
    msword.visible:=0;
    str:=wordapplication1.ActivePrinter;       //获取当前打印机
    wordapplication1.ActivePrinter:='I-FaxPrinter';  //选择传真打印机
    wordapplication1.PrintOutOld();  //执行打印命令
  finally
    wordapplication1.ActivePrinter:=str;      //恢复先前设置打印机
    wordapplication1.Disconnect;             //断开连接
    msword.Quit;
    varclear(msword);
    showmessage('完成转换！');
    name:=dropfileext(ExtractFileName(edit1.Text)); //获取当前不带扩展名的文件名
//  Renamefile('c:\Microsoft Word - '+name+'.tif','c:\'+name+'.tif');
    while  true do     //生成文档检验有文档后将文档改名
      begin
        if fileexists('c:\Microsoft Word - '+name+'.tif') then
          begin
            Renamefile('c:\Microsoft Word - '+name+'.tif','c:\'+name+'.tif');
            break;
          end;
      end;
  end;
end;
function tform1.DropFileExt(FileName:String):String;//FileName为带扩展名的文件名
var
 i:Integer;
begin
 for i:=Length(FileName) downto 1 do
   if FileName[i]='.' then break;
 Result:=copy(FileName,1,i-1);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if opendialog1.Execute then
    edit1.Text:=opendialog1.FileName;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  str,name:string;
begin
  if length(edit1.Text)=0 then
  exit;
  str:=edit1.text;
  name:=dropfileext(ExtractFileName(edit1.Text));
  DJCvt_Tiff2Bfx(pchar(edit1.Text),pchar('c:\'+name+'.bfx'));//调用动态链接库转换BFX
  showmessage('完成转换!');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
   Renamefile('c:\Microsoft Word - q.tif','c:\q.tif');
end;

end.