OpenOffice.org Forum at OOoForum.orgThe OpenOffice.org Forum
 
 [Home]   [FAQ]   [Search]   [Memberlist]   [Usergroups]   [Register
 [Profile]   [Log in to check your private messages]   [Log in

Delphi primer - open, merge (replaceall), and save or print

 
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Macros and API
View previous topic :: View next topic  
Author Message
Delphi Bod
Newbie
Newbie


Joined: 02 Jun 2006
Posts: 1

PostPosted: Fri Jun 02, 2006 6:43 am    Post subject: Delphi primer - open, merge (replaceall), and save or print Reply with quote

First chance to give something back to this community, especially beginners... thanks to earlier Delphi posters who gave me the foundations for this.

SAMPLE DELPHI CODE

Code:

unit oOoHelpers;

// PURPOSE: Create, open, merge, save and print OpenOffice Writer documents from Delphi

// EXAMPLE USE
{
procedure useOOoHelper;
var
   doc : ToOoDoc;
begin
     doc := ToOoDoc.create('myDoc.odt',false); // opens this file -- use '' for a new file
     with doc do
     try
        addSub('<replace me>', 'replace text');
        addSub('<replace me 2>, 'replace text 2');
        merge;
        saveAs('myDocMerged.odt', true);
        revert;
        substitutions.clear;
        addSub('<replace me>', 'different replace text');
        merge;
        print;
     finally
            free;
     end;
end;
}

interface

uses ComObj, classes, sysUtils, dialogs, controls, windows, oOoConstants, oOoTools, DB, variants, stdCtrls, Forms;

const
     newOOoDoc = 'private:factory/swriter';

type

  ToOoDocHolder = record
                     v : variant;
                     isOpen, wantsClosing : boolean;
                  end;

  ToOoDoc = class(TObject)
  private
    docs : array of ToOoDocHolder; // used to hold documents until they can be closed (sometimes the printer being busy stops this)
    di : integer; // index of the current document, i.e. the one being worked on
    docFileName : string;
    isHidden, isNew : boolean;
    destructor destroy; override;
    procedure openURL(URL : string);
    function doSaveAs( fileName : string; forceOverwrite, snapshot : boolean; var replaceAll : boolean) : boolean;
    procedure close;
    function tryClosingAll( force : boolean) : boolean;
    function docPrinterBusy( docIndex : integer) : boolean;
    procedure closeAll( timeLimit : integer);
    procedure newDoc;
  public
    substitutions : TStringList;
    constructor create( fileName : string; canCreate, hidden : boolean); virtual;
    procedure open( fileName : string; hidden : boolean);
    procedure save;
    function saveAs( fileName : string; snapshot : boolean; var replaceAll : boolean) : boolean; overload;
    function saveAs ( fileName : string; snapshot : boolean) : boolean; overload;
    procedure print;
    procedure revert;
    procedure addSub( targetString, subString : string);
    procedure merge;
  end;

var
  oOoOpen : boolean;

implementation

function ToOoDoc.docPrinterBusy( docIndex : integer) : boolean;
var
   queryPrinter : variant;
   i : integer;
begin
     result := false;
     if not docs[docIndex].isOpen then exit;
     queryPrinter := docs[docIndex].v.getPrinter;
     for i := 0 to tvardata(queryPrinter).vArray^.bounds[0].elementCount-1 do
     if (queryPrinter[i].name = 'IsBusy')
     then begin
          result := queryPrinter[i].value;
          break;
     end;
end;

function ToOoDoc.tryClosingAll( force : boolean) : boolean;
var
   i : integer;
begin
     result := true;
     for i := 0 to high(docs) do
     with docs[i] do
     if isOpen
     then if (wantsClosing or force)
          then if docPrinterBusy(i)
               then result := false
               else begin
                    v.close(true);
                    isOpen := false;
                    wantsClosing := false;
               end
          else result := false;
end;

procedure ToOoDoc.closeAll( timeLimit : integer);
var
   i, stopTime : integer;
begin
     for i := 0 to high(docs) do docs[i].wantsClosing := true;
     stopTime := getTickCount + timeLimit;
     while (not tryClosingAll(true)) and (getTickCount < stopTime) do sleep(200);
end;

procedure ToOoDoc.close;
begin
     with docs[di] do
     begin
          if not isOpen then exit;
          wantsClosing := true;
          tryClosingAll(false);
     end;
     // Create or re-use slot for current doc
     di := 0;
     while (di < length(docs)) and docs[di].isOpen do inc(di);
     if (di = length(docs)) then newDoc;
end;

procedure ToOoDoc.newDoc;
begin
     di := length(docs);
     setLength(docs,di+1);
     docs[di].isOpen := false;
     docs[di].wantsClosing := false;
end;

constructor ToOoDoc.create(fileName : string; canCreate, hidden : boolean);
var
   fileNameParam : string;
   needCreate : boolean;
   wasCursor : TCursor;

begin
     inherited create;
     di := -1; // Current doc index, will be 0 after next call
     newDoc;
     fileName := trim(fileName);
     isNew := (fileName = '');
     isHidden := hidden;
     try
        if not oOoOpen
        then messageDlg('There might be a long pause while OpenOffice is initialized.',mtInformation,[mbOK],0);
        try
           wasCursor := screen.Cursor;
           screen.Cursor := crHourglass;
           ConnectOpenOffice;
           oOoOpen := true;
        finally
               screen.Cursor := wasCursor;
        end;
     except on e : exception do raise exception.Create( 'OpenOffice might not be installed.  Please see message below.'+#13#13+e.Message);
     end;
     substitutions := TStringList.Create;
     docFileName := fileName;
     if not isNew then forceDirectories(extractFilePath(docFileName));
     needCreate := not (isNew or fileExists(docFileName));
     if isNew
     then fileNameParam := newOOoDoc
     else if needCreate
          then if not canCreate
               then raise exception.Create(fileName+#13#13+'File not found.')
               else fileNameParam := newOOoDoc
          else fileNameParam := convertToURL(docFileName);
     openURL(fileNameParam);
     if needCreate
     then saveAs(docFileName,false);
end;

procedure ToOoDoc.openURL(URL : string);
var
   fileProp : variant;
begin
     close;
     if isHidden
     then fileProp:= CreateProperties(['Hidden', True])
     else fileProp := dummyArray;
     docs[di].v := StarDesktop.LoadComponentFromURL(URL, '_blank', 0, fileProp);
     docs[di].isOpen := true;
end;

procedure ToOoDoc.open( fileName : string; hidden : boolean);
var
   fileProp : variant;
begin
     if not fileExists(fileName)
     then raise exception.Create('oOoDoc.open: file not found.'+#13#13+filename);
     isHidden := hidden;
     docFileName := fileName;
     openURL(convertToURL(docFileName));
     isNew := false;
end;

procedure ToOoDoc.revert;
begin
     close;
     if isNew
     then openURL(newOOodoc)
     else openURL(convertToURL(docFileName));
end;

function ToOoDoc.doSaveAs( fileName : string; forceOverwrite, snapshot : boolean; var replaceAll : boolean) : boolean;
var
   fileProp : variant;
   URL : string;
begin
     if not docs[di].isOpen
     then raise exception.Create('oOoDoc: doSaveAs: no document open.');
     result := false;
     if (not forceOverwrite) and (not replaceAll) and fileExists(fileName)
     then case messageDlg( fileName+#13#13+'Replace existing file?',mtConfirmation,[mbYes,mbNo,mbAll],0) of
     mrNo : exit;
     mrAll : replaceAll := true;
     else end;
     URL := convertToURL(fileName);
     fileProp := createProperties(['Overwrite',true]);
     if snapshot
     then docs[di].v.storeToURL(URL,fileProp)
     else begin
          docs[di].v.storeAsURL(URL,fileProp);
          docFileName := fileName;
     end;
     isNew := isNew and snapshot;
     result := true;
end;

function ToOoDoc.saveAs( fileName : string; snapshot : boolean; var replaceAll : boolean) : boolean;
begin
     result := doSaveAs(fileName, false, snapshot, replaceAll);
end;

function ToOoDoc.saveAs ( fileName : string; snapshot : boolean) : boolean;
var
   temp : boolean;
begin
     temp := true;
     result := doSaveAs( fileName, true, snapshot, temp);
end;

procedure ToOoDoc.save;
begin
     if not docs[di].isOpen
     then raise exception.Create('oOoDoc: save: no document open.');
     if isNew
     then raise exception.Create('oOoDoc: save: cannot save new doc.');
     docs[di].v.store;
end;

destructor ToOoDoc.destroy;
begin
     closeAll(15000);
     if assigned(substitutions) then substitutions.Free;
     inherited destroy;
end;

procedure ToOoDoc.merge;
var
  myReplace: Variant;
  i : integer;
begin
  myReplace := docs[di].v.createReplaceDescriptor;
  with substitutions do
  for i := 0 to count-1 do
  begin
       myReplace.setSearchString(names[i]);
       myReplace.setReplaceString(valueFromIndex[i]);
       docs[di].v.replaceAll(myReplace);
  end;
end;

procedure ToOoDoc.print;
var
   printProps : variant;
begin
     printProps := dummyArray;
     docs[di].v.print(printProps);
end;

procedure ToOoDoc.addSub( targetString, subString : string);
begin
     with substitutions do Add(targetString+NameValueSeparator+subString);
end;

begin
     oOoOpen := false;
end.

_________________
Julian Brewer
Back to top
View user's profile Send private message
SergeM
Super User
Super User


Joined: 09 Sep 2003
Posts: 3211
Location: Troyes France

PostPosted: Fri Jun 02, 2006 8:46 am    Post subject: Reply with quote

Thank you for your code.
The "code snippets" forum is better to post working code. "Macros and API" forum is for questions and the corresponding answer if possible.
_________________
Linux & Windows OOo3.0
UNO & C++ : WIKI
http://wiki.services.openoffice.org/wiki/Using_Cpp_with_the_OOo_SDK
In French
http://wiki.services.openoffice.org/wiki/Documentation/FR/Cpp_Guide
Back to top
View user's profile Send private message Visit poster's website
Display posts from previous:   
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Macros and API All times are GMT - 8 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group