Delphi_Doc or Wps文档转PDF

 

Delphi_Doc or Wps文档转PDF  

来源：http://anbangs.blog.163.com/blog/static/32182782009764348248/

1、简单调用
function doc2pdf(strdoc,strpdf :string) :boolean;
var wpsapp,wpsdoc :OleVariant;
begin
  wpsapp :=CreateOleObject('Wps.Application');
  wpsdoc :=CreateOleObject('Wps.Document');
  wpsapp.Documents.Open(strdoc);
  wpsdoc :=wpsapp.ActiveDocument;
  wpsdoc.ExportPdf(strpdf);
  wpsapp.Quit;
  wpsapp := Unassigned;
  wpsdoc :=Unassigned;
end;

2、Delphi二次开发示例包之WpsObj小改
增加输出PDF文件代码，见附件。
调用示例：
procedure TForm1.Button1Click(Sender: TObject);
begin
  WpsObj := TWpsObject.Create;
  WpsObj.Visible := True;
  WpsObj.OpenDoc(Extractfilepath(Paramstr(0))+'test.wps');
  WpsObj.ExportPdf(Extractfilepath(Paramstr(0))+'test.pdf');
end;

=================
unit WpsObjs;

interface

// This Demo excersises the use of ActiveX Automation using Early Binding.
(*ExportPdf added by Sane*)
uses
  Windows, Classes, ActiveX, WPS_TLB;

type
  TWpsEventSink = class(TInterfacedObject, IUnknown, IDispatch)
  private
    FOwner:  TObject;
    FAppDispatch: IDispatch;
    FDocDispatch: IDispatch;
    FAppDispIntfIID: TGUID;
    FDocDispIntfIID: TGUID;
    FAppConnection: integer;
    FDocConnection: integer;
    FOnQuit: TNotifyEvent;
    FOnDocumentChange: TNotifyEvent;
    FOnNewDocument: TNotifyEvent;
    FOnOpenDocument: TNotifyEvent;
    FOnCloseDocument: TNotifyEvent;
    FOnSaveDocument: TNotifyEvent;
      FOnExportPdf: TNotifyEvent;
    FOnWindowSelectionChange: TNotifyEvent;
  protected
    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
    function _AddRef: integer; stdcall;
    function _Release: integer; stdcall;
    { IDispatch }
    function GetTypeInfoCount(out Count: integer): HRESULT; stdcall;
    function GetTypeInfo(Index, LocaleID: integer; out TypeInfo): HRESULT; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: integer; DispIDs: Pointer): HRESULT; stdcall;
    function Invoke(DispID: integer; const IID: TGUID; LocaleID: integer;
      Flags: word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; stdcall;
  public
    constructor Create(AnOwner: TObject; AnAppDispatch: IDispatch;
      const AnAppDispIntfIID, ADocDispIntfIID: TGUID);
    destructor Destroy; override;
    property On Quit: TNotifyEvent Read FOnQuit Write FOnQuit;
    property On DocumentChange: TNotifyEvent Read FOnDocumentChange
      Write FOnDocumentChange;
    property On NewDocument: TNotifyEvent Read FOnNewDocument Write FOnNewDocument;
    property On OpenDocument: TNotifyEvent Read FOnOpenDocument Write FOnOpenDocument;
    property On CloseDocument: TNotifyEvent Read FOnCloseDocument Write FOnCloseDocument;
    property On SaveDocument: TNotifyEvent Read FOnSaveDocument Write FOnSaveDocument;
      property On ExportPdf: TNotifyEvent Read FOnExportPdf Write FOnExportPdf;
    property On WindowSelectionChange: TNotifyEvent Read FOnWindowSelectionChange Write FOnWindowSelectionChange;
  end;

  TWpsObject = class
  private
    FWpsApp:    _Application;
    FEventSink: TWpsEventSink;
    function GetVisible: boolean;
    procedure SetVisible(Value: boolean);
    function GetOnQuit: TNotifyEvent;
    procedure SetOnQuit(Value: TNotifyEvent);
    function GetOnDocumentChange: TNotifyEvent;
    procedure SetOnDocumentChange(Value: TNotifyEvent);
    function GetOnNewDocument: TNotifyEvent;
    procedure SetOnNewDocument(Value: TNotifyEvent);
    function GetOnOpenDocument: TNotifyEvent;
    procedure SetOnOpenDocument(Value: TNotifyEvent);
    function GetOnCloseDocument: TNotifyEvent;
    procedure SetOnCloseDocument(Value: TNotifyEvent);
    function GetOnSaveDocument: TNotifyEvent;
    procedure SetOnSaveDocument(Value: TNotifyEvent);
    function GetOnExportPdf: TNotifyEvent;
    procedure SetOnExportPdf(Value: TNotifyEvent);
    function GetOnWindowSelectionChange: TNotifyEvent;
    procedure SetOnWindowSelectionChange(Value: TNotifyEvent);
  public
    constructor Create;
    destructor Destroy; override;
    function NewDoc(Template: string): _Document;
    function OpenDoc(FileName: string): _Document;
    procedure CloseDoc;
    procedure InsertText(Text: string);
    procedure Print; overload;
    procedure Print(Background: boolean; Copies: integer); overload;
    procedure SaveAs(Filename: string);
    procedure ExportPdf(Filename: string);
  published
    property Application: _Application Read FWpsApp;
    property Visible: boolean Read GetVisible Write SetVisible;
    property On Quit: TNotifyEvent Read GetOnQuit Write SetOnQuit;
    property On DocumentChange: TNotifyEvent
      Read GetOnDocumentChange Write SetOnDocumentChange;
    property On NewDocument: TNotifyEvent Read GetOnNewDocument Write SetOnNewDocument;
    property On OpenDocument: TNotifyEvent Read GetOnOpenDocument
      Write SetOnOpenDocument;
    property On CloseDocument: TNotifyEvent Read GetOnCloseDocument
      Write SetOnCloseDocument;
    property On SaveDocument: TNotifyEvent Read GetOnSaveDocument Write SetOnSaveDocument;
    property On ExportPdf: TNotifyEvent Read GetOnExportPdf Write SetOnExportPdf;
    property On WindowSelectionChange: TNotifyEvent Read GetOnWindowSelectionChange Write SetOnWindowSelectionChange;
  end;

implementation

uses
  ComObj, Variants;

{ TWpsEventSink implementation }

constructor TWpsEventSink.Create(AnOwner: TObject; AnAppDispatch: IDispatch;
  const AnAppDispIntfIID, ADocDispIntfIID: TGUID);
begin
  inherited Create;

  FOwner := AnOwner;
  FAppDispIntfIID := AnAppDispIntfIID;
  FDocDispIntfIID := ADocDispIntfIID;
  FAppDispatch := AnAppDispatch;

  // Hook the sink up to the automation server
  InterfaceConnect(FAppDispatch, FAppDispIntfIID, Self, FAppConnection);
end;

destructor TWpsEventSink.Destroy;
begin
  // Unhook the sink from the automation server
  InterfaceDisconnect(FAppDispatch, FAppDispIntfIID, FAppConnection);

  inherited Destroy;
end;

function TWpsEventSink.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
  // We need to return the two event interfaces when they're asked for
  Result := E_NOINTERFACE;
  if GetInterface(IID, Obj) then
    Result := S_OK;
  if IsEqualGUID(IID, FAppDispIntfIID) and GetInterface(IDispatch, Obj) then
    Result := S_OK;
  if IsEqualGUID(IID, FDocDispIntfIID) and GetInterface(IDispatch, Obj) then
    Result := S_OK;
end;

function TWpsEventSink._AddRef: integer;
begin
  // Skeleton implementation
  Result := 2;
end;

function TWpsEventSink._Release: integer;
begin
  // Skeleton implementation
  Result := 1;
end;

function TWpsEventSink.GetTypeInfoCount(out Count: integer): HRESULT;
begin
  // Skeleton implementation
  Count  := 0;
  Result := S_OK;
end;

function TWpsEventSink.GetTypeInfo(Index, LocaleID: integer; out TypeInfo): HRESULT;
begin
  // Skeleton implementation
  Result := E_NOTIMPL;
end;

function TWpsEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: integer; DispIDs: Pointer): HRESULT;
begin
  // Skeleton implementation
  Result := E_NOTIMPL;
end;

function TWpsEventSink.Invoke(DispID: integer; const IID: TGUID;
  LocaleID: integer; Flags: word; var Params;
  VarResult, ExcepInfo, ArgErr: Pointer): HRESULT;
begin
  // Fire the different event handlers when
  // the different event methods are invoked
  case DispID of
    2: if Assigned(FOnQuit) then
        FOnQuit(FOwner);
    3:
    begin
      if Assigned(FOnDocumentChange) then
        FOnDocumentChange(FOwner);
      // When we see a document change, we also need to disconnect the
      // sink from the old document, and hook it up to the new document
      InterfaceDisconnect(FDocDispatch, FDocDispIntfIID, FDocConnection);
      try
        if _Application(FAppDispatch).Documents.Count >= 1 then
        begin
          FDocDispatch := _Application(FAppDispatch).ActiveDocument;
          InterfaceConnect(FDocDispatch, FDocDispIntfIID, Self, FDocConnection);
        end;
      except;
      end;
    end;
    4: if Assigned(FOnNewDocument) then
        FOnNewDocument(FOwner);
    5: if Assigned(FOnOpenDocument) then
        FOnOpenDocument(FOwner);
    6: if Assigned(FOnCloseDocument) then
        FOnCloseDocument(FOwner);
    8: if Assigned(FOnSaveDocument) then
        FOnSaveDocument(FOwner);
    12: if Assigned(FOnWindowSelectionChange) then
      FOnWindowSelectionChange(FOwner);
  end;
  Result := S_OK;
end;

{ TWpsObject implementation }

constructor TWpsObject.Create;
begin
  FWpsApp    := CoApplication.Create;
  FEventSink := TWpsEventSink.Create(Self, FWpsApp, ApplicationEvents, DocumentEvents);
end;

destructor TWpsObject.Destroy;
var
  SaveChanges, OriginalFormat, RouteDocument: olevariant;
begin
  SaveChanges    := WpsDoNotSaveChanges;
  OriginalFormat := Unassigned;
  RouteDocument  := Unassigned;
  try
    FWpsApp.Quit(SaveChanges, OriginalFormat, RouteDocument);
  except
  end;
  FEventSink.Free;
  FEventSink := nil;
  inherited Destroy;
end;

function TWpsObject.GetVisible: boolean;
begin
  Result := FWpsApp.Visible;
end;




procedure TWpsObject.SetVisible(Value: boolean);
begin
  FWpsApp.Visible := Value;
end;

function TWpsObject.GetOnQuit: TNotifyEvent;
begin
  Result := FEventSink.On Quit;
end;

procedure TWpsObject.SetOnQuit(Value: TNotifyEvent);
begin
  FEventSink.On Quit := Value;
end;

function TWpsObject.GetOnDocumentChange: TNotifyEvent;
begin
  Result := FEventSink.On DocumentChange;
end;

procedure TWpsObject.SetOnDocumentChange(Value: TNotifyEvent);
begin
  FEventSink.On DocumentChange := Value;
end;

function TWpsObject.GetOnNewDocument: TNotifyEvent;
begin
  Result := FEventSink.On NewDocument;
end;

procedure TWpsObject.SetOnNewDocument(Value: TNotifyEvent);
begin
  FEventSink.On NewDocument := Value;
end;

function TWpsObject.GetOnOpenDocument: TNotifyEvent;
begin
  Result := FEventSink.On OpenDocument;
end;

procedure TWpsObject.SetOnOpenDocument(Value: TNotifyEvent);
begin
  FEventSink.On OpenDocument := Value;
end;

function TWpsObject.GetOnCloseDocument: TNotifyEvent;
begin
  Result := FEventSink.On CloseDocument;
end;

procedure TWpsObject.SetOnCloseDocument(Value: TNotifyEvent);
begin
  FEventSink.On CloseDocument := Value;
end;

procedure TWpsObject.InsertText(Text: string);
begin
  FWpsApp.Selection.TypeText(Text);
end;

function TWpsObject.NewDoc(Template: string): _Document;
var
  DocTemplate, NewTemplate: olevariant;
  DocumentType: integer;
  Visible:      boolean;
begin
  DocTemplate := Template;
  NewTemplate := False;
  DocumentType := wpsTypeDocument;
  Visible := True;
  Result := FWpsApp.Documents.Add(DocTemplate, NewTemplate, DocumentType, Visible);
end;

procedure TWpsObject.CloseDoc;
var
  SaveChanges, OriginalFormat, RouteDocument: olevariant;
begin
  SaveChanges    := WpsDoNotSaveChanges;
  OriginalFormat := Unassigned;
  RouteDocument  := Unassigned;
  FWpsApp.ActiveDocument.Close(SaveChanges, OriginalFormat, RouteDocument);
end;

procedure TWpsObject.Print;
begin
  olevariant(FWpsApp).PrintOut;
end;

procedure TWpsObject.SaveAs(Filename: string);
begin
  olevariant(FWpsApp).ActiveDocument.SaveAs(FileName, wpsFormatDocument);
end;

procedure TWpsObject.ExportPdf(Filename: string);
begin
  olevariant(FWpsApp).ActiveDocument.ExportPdf(Filename);
end;

function TWpsObject.GetOnSaveDocument: TNotifyEvent;
begin
  Result := FEventSink.On SaveDocument;
end;

procedure TWpsObject.SetOnSaveDocument(Value: TNotifyEvent);
begin
  FEventSink.On SaveDocument := Value;
end;

function TWpsObject.GetOnExportPdf: TNotifyEvent;
begin
  Result := FEventSink.On ExportPdf;
end;

procedure TWpsObject.SetOnExportPdf(Value: TNotifyEvent);
begin
  FEventSink.On ExportPdf := Value;
end;

function TWpsObject.GetOnWindowSelectionChange: TNotifyEvent;
begin
  Result := FEventSink.FOnWindowSelectionChange;
end;

procedure TWpsObject.SetOnWindowSelectionChange(Value: TNotifyEvent);
begin
  FEventSink.On WindowSelectionChange := Value;
end;

function TWpsObject.OpenDoc(FileName: string): _Document;
var
  DocName:  WideString;
  myBool:   wordbool;
  myString: WideString;
  myInt:    integer;
begin
  DocName  := FileName;
  myBool   := False;
  myString := '';
  myInt    := 0;
  Result   := FWpsApp.Application.Documents.Open(DocName, myBool, myBool, myBool, myString,
    myString, myBool, myString, myString, myInt, myInt, True, myBool, myInt, myBool);
 { Result :=FWpsApp.Application.Documents.Open(DocName,EmptyParam,EmptyParam,
         EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,
         EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam);}
end;

procedure TWpsObject.Print(Background: boolean; Copies: integer);
var
  ovBackGround, ovCopies: olevariant;
begin
  ovBackGround := BackGround;
  ovCopies     := Copies;
  olevariant(FWpsApp).PrintOut(ovBackGround, EmptyParam, EmptyParam,
    EmptyParam, EmptyParam, EmptyParam,
    EmptyParam, ovCopies);
end;

end.