Delphi Bod
Newbie
Joined: 02 Jun 2006
Posts: 1
|
 Posted: Fri Jun 02, 2006 6:43 am Post subject: Delphi primer - open, merge (replaceall), and save or print |
 |
|
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 |
|
