Word Automation refresh issues - reposted to Borland server on behalf of Jen C..
Dave Johnson
Can anyone help with a few refresh issues that users are experiencing
when using word automation from Delphi?
When users save documents in Word, the whole screen is refreshed and
the vertical scroll bar at the right hand side of the screen has
duplicated, so there are 2 vertical scroll bars. If the user clicks in
the middle of the outer vertical scroll bar, all of the toolbar
buttons underneath the drop down menus at the top of the screen
completely disappear and the scroll bar changes colour to black.
The work around at the moment is for the users to click on the arrow
at the bottom of the outer vertical scroll bar to correct the scroll
bars so that one remains.
We're using an Ole Container modified to control word, this is the
attached word container.pas. The form we use the container in is the
DocEdit.pas/dfm. If they save a document (in the OLE Container in
Delphi) then we have to clear the document and reload it to make the
flag behave correctly.
Users experiencing the problem are using Win XP Professional SP1,
application written in Delphi 6.0, Office 2000 standard up to SP3.
They are not running Norton anti virus software, but do run an app
called Hayes DX which they have to close down before attempting to
hook into word from the Delphi app otherwise they get the error
message 'call was rejected by callee'.
Any suggestions for the scroll bar phenomenon much appreciated.
Regards
Jennifer Collier
WORDCONTAINER.PAS
{Word Interface Component using VBA and TOleContainer to
allow viewing and editing of Microsoft Word documents.
To open a word doc, set CurrentDocFile := 'C:\Path\Docname.doc';
To edit the document on opening, call WordContainer1.ActivateDocument
from FormShow.
To have the Word toolbar appear where you want it, place 2 panels on
a form. One has TWordContainer and Locked := True. The other has
Locked := False and the toolbar will appear there.
Note that the document is deactivated when any other TWinControl gets
focus. Use the Activate button to reactivate the document. A separate
form is used for control buttons to prevent activate/deactivate of
the document whenever a mode change is made.
This app and component are not all-inclusive nor perfect, but they go
a long way toward having a usable Word container.
Freeware--no support, no warranty, no liability.
}
unit WordContainer;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, ExtCtrls,
OleCtnrs, Dialogs, WinProcs, StdCtrls, Buttons,
{Word_TLB}Word2000, Variants;
type
TWordPageFit = (pfNone, pfFullPage, pfBestFit);
TWordContainer = class(TOleContainer)
private
FDocument: string;
FWordApp: OleVariant;
FCollate, FDisablePrint: Boolean;
FPageFit: TWordPageFit;
FZoom: integer;
function CheckSectionNumber(SecNum: integer): integer;
function GetToolbarIndex(CmdBarName: string): integer;
function GetToolBtnIndex(ToolbarIndex: integer;
ButtonName: string): Integer;
function GetChangesMade: Boolean;
protected
function GetDocumentPrinter : string;
procedure SetDocumentPrinter(const Value : string);
procedure SetDocFile(ADoc: string);
procedure SetWordPageFit(Value: TWordPageFit);
procedure SetDisablePrint(Value: Boolean);
public
constructor Create(AOwner: TComponent); override;
procedure ActivateDocument;
procedure DeactivateDocument;
procedure ClearDocRef;
procedure BeginUpdate;
procedure EndUpdate;
procedure SetFontName(FontName: string);
procedure SetParagraphStyle(StyleName: string);
procedure SetZoom(Percent: integer);
procedure InsertText(SomeText: string);
procedure InsertBlankParagraph;
procedure InsertFile(Filename: string);
procedure InsertTable(RowCount, ColumnCount: integer);
procedure TableNextCell;
procedure TableInsertRows(RowsToAdd: integer);
procedure TableDeleteRow;
procedure FindBookmark(BmName: string);
procedure GoToSection(SectionNumber: integer);
procedure DisableToolbars;
procedure ShowHideToolbar(ToolbarName: string;
ShowToolbar: Boolean);
procedure ActivatePrintButton(MakeActive: Boolean);
procedure ReplaceAllDocument(OldString, NewString :
OleVariant);
procedure AppendDocument(Filename: string);
procedure FirstPageHeaderFooter(SectionNumber:
integer; Different: Boolean);
procedure LinkHFtoPrevious(SameAs: Boolean);
procedure AddNewSection;
procedure MakeNewDocument;
procedure RestartSectionNumbering(SecNum: integer);
procedure PrintDocument(Copies: integer);
procedure PrintDocToFile(Filename: string);
procedure SaveDocumentAs(Filename: string);
procedure SaveAsRTF(Filename: string);
procedure LoadFromFile(Filename: string);
procedure SetMargins(SectionNumber: integer; Left,
Top, Right, Bottom, HdrDist, FtrDist: single);
procedure SetSectionHeaderFooter;
property DocumentPrinter: string read
GetDocumentPrinter write SetDocumentPrinter;
property ChangesMade: Boolean read GetChangesMade;
published
property CollateCopies: Boolean read FCollate write
FCollate default False;
property CurrentDocFile: string read FDocument write
SetDocFile;
property DisablePrint: Boolean read FDisablePrint
write SetDisablePrint default True;
property PageFit: TWordPageFit read FPageFit write
SetWordPageFit default pfBestFit;
property Zoom: integer read FZoom write SetZoom
default 100;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Servers', [TWordContainer]);
end;
constructor TWordContainer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCollate := False;
FDisablePrint := True;
FZoom := 100;
FDocument := '';
VarClear(FWordApp);
AllowActiveDoc := True;
AllowInPlace := True;
AutoActivate := aaManual; // Must set to this
because when the form opens there is nothing to focus on
AutoVerbMenu := False;
BorderStyle := bsNone;
Align := alClient;
Caption := '';
end;
procedure TWordContainer.BeginUpdate;
begin
FWordApp.ScreenUpdating := False;
end;
procedure TWordContainer.EndUpdate;
begin
FWordApp.ScreenUpdating := True;
end;
procedure TWordContainer.SetDocFile(ADoc: string);
var
LoadError: Boolean;
begin
LoadError := False;
try
LoadFromFile(ADoc);
except
LoadError := True;
end;
if LoadError then
begin
if Length(ADoc) > 0 then
ShowMessage('Error loading ' + ADoc);
FDocument := '';
end;
end;
procedure TWordContainer.LoadFromFile(Filename: string);
begin
CreateObjectFromFile(Filename, False);
FDocument := Filename;
end;
procedure TWordContainer.ActivateDocument;
begin
if State <> osEmpty then
begin
DoVerb(ovShow);
if VarIsEmpty(FWordApp) then
FWordApp := OleObject.Application;
if FDisablePrint then
ActivatePrintButton(False); // Print
button on f_Word becomes not available
end;
end;
procedure TWordContainer.DeactivateDocument;
begin
if Showing then
Parent.SetFocus; // Requires an
ActiveControl to be set in owner form
end;
function TWordContainer.CheckSectionNumber(SecNum: integer): integer;
begin
if SecNum = 0 then
Result := FWordApp.ActiveDocument.Sections.Count
else
Result := SecNum;
end;
procedure TWordContainer.GoToSection(SectionNumber: integer);
begin
FWordApp.Selection.GoTo(wdGoToSection, wdGoToFirst,
CheckSectionNumber(SectionNumber), '');
end;
procedure TWordContainer.SetFontName(FontName: string);
begin
FWordApp.Selection.Font.Name := FontName;
end;
procedure TWordContainer.SetParagraphStyle(StyleName: string);
begin
FWordApp.Selection.Range.Style := StyleName;
end;
procedure TWordContainer.SetDisablePrint(Value: Boolean);
begin
FDisablePrint := Value;
ActivatePrintButton(not Value);
end;
procedure TWordContainer.FindBookmark(BmName: string);
begin
//function GoTo_(var What: OleVariant; var Which: OleVariant; var
Count: OleVariant; var Name: OleVariant): Range; safecall;
FWordApp.Selection.GoTo(wdGoToBookmark, EmptyParam,
EmptyParam, BmName);
FWordApp.Selection.Find.ClearFormatting;
end;
procedure TWordContainer.InsertText(SomeText: string);
begin
FWordApp.Selection.TypeText(SomeText);
end;
procedure TWordContainer.InsertBlankParagraph;
begin
FWordApp.Selection.TypeParagraph;
end;
procedure TWordContainer.InsertFile(Filename: string);
begin
{ procedure InsertFile(const FileName: WideString; var Range:
OleVariant;
var ConfirmConversions: OleVariant; var Link: OleVariant;
var Attachment: OleVariant); safecall;}
FWordApp.Selection.InsertFile(Filename);
end;
procedure TWordContainer.InsertTable(RowCount, ColumnCount: integer);
begin
FWordApp.ActiveDocument.Tables.Add(FWordApp.ActiveDocument.Range,
RowCount, ColumnCount);
end;
procedure TWordContainer.TableNextCell;
begin
FWordApp.Selection.MoveRight(wdCell, EmptyParam, EmptyParam);
end;
procedure TWordContainer.TableInsertRows(RowsToAdd: integer);
begin
FWordApp.Selection.InsertRows(RowsToAdd);
end;
procedure TWordContainer.TableDeleteRow;
begin
FWordApp.Selection.Rows.Delete;
end;
procedure TWordContainer.ReplaceAllDocument(OldString, NewString :
OleVariant);
var
iSections, iHFIndex : integer;
begin
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Find.ClearFormatting;
{ function Execute(var FindText: OleVariant; var MatchCase:
OleVariant; var MatchWholeWord: OleVariant;
var MatchWildcards: OleVariant; var MatchSoundsLike: OleVariant; var
MatchAllWordForms: OleVariant;
var Forward: OleVariant; var Wrap: OleVariant; var Format: OleVariant;
var ReplaceWith: OleVariant; var Replace: OleVariant): WordBool;
safecall;
}
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Find.Execute( //Search & Replace Main Document
OldString, False, EmptyParam,
False, False, False,
True, wdFindStop, False,
NewString, wdReplaceAll);
//Search & Replace headers and footers
for iSections := 1 to
FWordApp.ActiveDocument.Range(EmptyParam, EmptyParam).Sections.Count
do
begin
for iHFIndex := 1 to
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(iSections).Footers.Count do
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(iSections).Footers.Item(iHFIndex).Range.Find.Execute(
OldString, False, EmptyParam,
False, False, False,
True, wdFindStop, False,
NewString, wdReplaceAll);
for iHFIndex := 1 to
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(iSections).Footers.Count do
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(iSections).Headers.Item(iHFIndex).Range.Find.Execute(
OldString, False, EmptyParam,
False, False, False,
True, wdFindStop, False,
NewString, wdReplaceAll);
end;
end;
procedure TWordContainer.AppendDocument(Filename: string);
begin
FWordApp.Selection.EndKey(wdStory);
AddNewSection;
LinkHFtoPrevious(False);
InsertFile(FileName);
end;
procedure TWordContainer.AddNewSection;
begin
FWordApp.Selection.InsertBreak(wdSectionBreakNextPage);
end;
procedure TWordContainer.MakeNewDocument;
begin
FWordApp.Documents.Add(EmptyParam, EmptyParam);
end;
procedure TWordContainer.LinkHFtoPrevious(SameAs: Boolean);
var
SecNum: integer;
begin
SecNum := CheckSectionNumber(0);
FWordApp.ActiveDocument.Sections.Item(SecNum).Headers.Item(wdHeaderFooterFirstPage).LinkToPrevious
:= SameAs;
FWordApp.ActiveDocument.Sections.Item(SecNum).Footers.Item(wdHeaderFooterFirstPage).LinkToPrevious
:= SameAs;
FWordApp.ActiveDocument.Sections.Item(SecNum).Headers.Item(wdHeaderFooterPrimary).LinkToPrevious
:= SameAs;
FWordApp.ActiveDocument.Sections.Item(SecNum).Footers.Item(wdHeaderFooterPrimary).LinkToPrevious
:= SameAs;
end;
procedure TWordContainer.RestartSectionNumbering(SecNum: integer);
var
Section: OleVariant;
begin
Section := CheckSectionNumber(SecNum);
FWordApp.ActiveDocument.Sections.Item(Section).Headers.Item(wdHeaderFooterFirstPage).PageNumbers.RestartNumberingAtSection
:= True;
FWordApp.ActiveDocument.Sections.Item(Section).Footers.Item(wdHeaderFooterFirstPage).PageNumbers.RestartNumberingAtSection
:= True;
FWordApp.ActiveDocument.Sections.Item(Section).Headers.Item(wdHeaderFooterFirstPage).PageNumbers.StartingNumber
:= 1;
FWordApp.ActiveDocument.Sections.Item(Section).Footers.Item(wdHeaderFooterFirstPage).PageNumbers.StartingNumber
:= 1;
end;
procedure TWordContainer.FirstPageHeaderFooter(SectionNumber: integer;
Different: Boolean);
var
SecNum: OleVariant;
begin
SecNum := CheckSectionNumber(SectionNumber);
FWordApp.ActiveDocument.Sections.Item(SecNum).PageSetup.DifferentFirstPageHeaderFooter
:= Different;
end;
procedure TWordContainer.SetMargins(SectionNumber: integer; Left, Top,
Right, Bottom, HdrDist, FtrDist: single);
var
InsToPts: single;
begin
if Left <> 0 then
begin
InsToPts := Left * 72.27;
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(SectionNumber).PageSetup.LeftMargin :=
InsToPts;
end;
if Top <> 0 then
begin
InsToPts := Top * 72.27;
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(SectionNumber).PageSetup.TopMargin :=
InsToPts;
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(SectionNumber).PageSetup.HeaderDistance :=
InsToPts;
end;
if Right <> 0 then
begin
InsToPts := Right * 72.27;
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(SectionNumber).PageSetup.RightMargin :=
InsToPts;
end;
if Bottom <> 0 then
begin
InsToPts := Bottom * 72.27;
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(SectionNumber).PageSetup.BottomMargin :=
InsToPts;
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(SectionNumber).PageSetup.FooterDistance :=
InsToPts;
end;
if HdrDist <> 0 then
begin
InsToPts := HdrDist * 72.27;
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(SectionNumber).PageSetup.HeaderDistance :=
InsToPts;
end;
if FtrDist <> 0 then
begin
InsToPts := FtrDist * 72.27;
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(SectionNumber).PageSetup.FooterDistance :=
InsToPts;
end;
{ With ActiveDocument.Range(Start:=Selection.Start,
End:=ActiveDocument.Content.End).PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(0.5)
.BottomMargin = InchesToPoints(0.5)
.LeftMargin = InchesToPoints(0.5)
.RightMargin = InchesToPoints(0.5)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.25)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.GutterPos = wdGutterPosLeft
End With
}
end;
procedure TWordContainer.SetSectionHeaderFooter;
var
iSections, iHFIndex, iSectionCount: integer;
begin
iSectionCount := FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Count;
for iSections := 2 to iSectionCount do
begin
for iHFIndex := 1 to
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(iSections).Footers.Count do
FirstPageHeaderFooter(iHFIndex, False);
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(iSections).PageSetup.DifferentFirstPageHeaderFooter
:= False;
for iHFIndex := 1 to
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(iSections).Headers.Count do
FWordApp.ActiveDocument.Range(EmptyParam,
EmptyParam).Sections.Item(iSections).PageSetup.DifferentFirstPageHeaderFooter
:= False;
end;
end;
procedure TWordContainer.SetWordPageFit(Value: TWordPageFit);
begin
if Value <> FPageFit then
begin
FPageFit := Value;
case FPageFit of
pfNone:
FWordApp.ActiveWindow.ActivePane.View.Zoom.PageFit := wdPageFitNone;
pfFullPage:
FWordApp.ActiveWindow.ActivePane.View.Zoom.PageFit :=
wdPageFitFullPage;
else {pfBestFit:}
FWordApp.ActiveWindow.ActivePane.View.Zoom.PageFit :=
wdPageFitBestFit;
end; // case
end;
end;
function TWordContainer.GetDocumentPrinter: string;
begin
if not (csDesigning in ComponentState) then
Result := FWordApp.ActivePrinter;
end;
procedure TWordContainer.SetDocumentPrinter(const Value : String);
begin
if not (csDesigning in ComponentState) then
FWordApp.ActivePrinter := Value;
end;
procedure TWordContainer.SetZoom(Percent: integer);
begin
FZoom := Percent;
FWordApp.ActiveDocument.ActiveWindow.ActivePane.View.Zoom.Percentage
:= Percent;
end;
procedure TWordContainer.DisableToolbars;
var
ToolbarIndex: integer;
begin
FWordApp.ActiveDocument.ActiveWindow.DisplayRulers := False;
for ToolbarIndex := 1 to
(FWordApp.ActiveDocument.CommandBars.Count) do
FWordApp.ActiveDocument.Commandbars.Item[ToolbarIndex].Enabled :=
False;
end;
function TWordContainer.GetToolbarIndex(CmdBarName: string): integer;
var
ToolbarIndex: integer;
begin
Result := -1;
for ToolbarIndex := 1 to
(FWordApp.ActiveDocument.CommandBars.Count) do
begin
if
FWordApp.ActiveDocument.Commandbars.Item[ToolbarIndex].Name =
CmdBarName then
begin
Result := ToolbarIndex;
break;
end;
end;
end;
function TWordContainer.GetToolBtnIndex(ToolbarIndex: integer;
ButtonName: string): integer;
var
ButtonIndex: integer;
ThisBtn: string;
begin
Result := -1;
for ButtonIndex := 1 to
(FWordApp.ActiveDocument.CommandBars.Item[ToolbarIndex].Controls.Count)
do
begin
ThisBtn :=
FWordApp.ActiveDocument.CommandBars.Item[ToolbarIndex].Controls[ButtonIndex].Caption;
if ThisBtn = ButtonName then
begin
Result := ButtonIndex;
break;
end;
end;
end;
procedure TWordContainer.ShowHideToolbar(ToolbarName: string;
ShowToolbar: Boolean);
begin
FWordApp.ActiveDocument.Commandbars.Item[GetToolbarIndex(ToolbarName)].Visible
:= ShowToolbar;
end;
procedure TWordContainer.ActivatePrintButton(MakeActive: Boolean);
var
TBIndex, BtnIndex, KeyCode: integer;
begin
TBIndex := GetToolbarIndex('Standard');
if TBIndex = -1 then
exit;
BtnIndex := GetToolBtnIndex(TBIndex, '&Print...');
if BtnIndex = -1 then
exit;
KeyCode := FWordApp.BuildKeyCode(wdKeyControl, wdKeyP);
if MakeActive then
begin
FWordApp.ActiveDocument.CommandBars.Item[TBIndex].Controls[BtnIndex].Visible
:= True;
FWordApp.FindKey[KeyCode].Clear;
end else
begin
FWordApp.ActiveDocument.CommandBars.Item[TBIndex].Controls[BtnIndex].Visible
:= False;
end;
end;
procedure TWordContainer.SaveDocumentAs(Filename: string);
begin
FWordApp.Documents.Item(1).SaveAs(Filename);
FDocument := Filename;
end;
procedure TWordContainer.SaveAsRTF(Filename: string);
begin
FWordApp.Documents.Item(1).SaveAs(Filename, wdFormatRTF,
False, '', True, '', False, False, False, False, False);
end;
procedure TWordContainer.PrintDocToFile(FileName : String);
begin
FWordApp.Documents.Item(1).PageSetup.OtherPagesTray :=
wdPrinterAutomaticSheetFeed; // Maybe not necessary...
FWordApp.Documents.Item(1).PageSetup.FirstPageTray :=
wdPrinterAutomaticSheetFeed; // if other bugs are gone
FWordApp.Printout(EmptyParam, EmptyParam, EmptyParam,
FileName, EmptyParam, EmptyParam,
EmptyParam, EmptyParam, EmptyParam,
EmptyParam, True,
EmptyParam, FDocument,// FDocument prints our doc in case Word is
already open
EmptyParam, EmptyParam);
// Check that the print has finished before exiting the procedure
while FWordApp.BackgroundPrintingStatus > 0 do
begin
Sleep(100);
Application.ProcessMessages;
end;
end;
procedure TWordContainer.PrintDocument(Copies: integer);
begin
// FWordApp.Documents.Item(1).PageSetup.OtherPagesTray :=
wdPrinterDefaultBin;// wdPrinterAutomaticSheetFeed;
// FWordApp.Documents.Item(1).PageSetup.FirstPageTray :=
wdPrinterDefaultBin; // wdPrinterAutomaticSheetFeed;
FWordApp.Dialogs.Item(wdDialogFilePrint).Show;
{FWordApp.Printout(EmptyParam, EmptyParam, EmptyParam,
EmptyParam, EmptyParam, EmptyParam,
EmptyParam, Copies, EmptyParam,
EmptyParam, False,
FCollate, FDocument,
EmptyParam, EmptyParam);}
// Check that the print has finished before exiting the procedure
while FWordApp.BackgroundPrintingStatus > 0 do
begin
Sleep(100);
Application.ProcessMessages;
end;
end;
{ ******************* End of TWordContainer ******************}
procedure TWordContainer.ClearDocRef;
begin
VarClear(FWordApp);
end;
function TWordContainer.GetChangesMade: Boolean;
{var
x: TwordApplication;
p: TWordDocument;}
begin
Result := not FWordApp.Documents.Item(1).Saved;
end;
end.
DOCEDIT.PAS
unit DocEdit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
Dialogs, ActnList, Menus, OleCtnrs, WordContainer, OleServer,
Word2000,
ImgList{, WinSpool};
type
TEditFormMode = (efmReadOnly, efmEdit, efmPrint, efmPrintToFile);
type
TfrmDocEdit = class(TForm)
mmMain: TMainMenu;
File1: TMenuItem;
mnuSave: TMenuItem;
N1: TMenuItem;
mnuClose: TMenuItem;
alMain: TActionList;
actSave: TAction;
actClose: TAction;
wcMain: TWordContainer;
actPrint: TAction;
Print1: TMenuItem;
imlMain: TImageList;
actCancel: TAction;
actCancel1: TMenuItem;
procedure actSaveExecute(Sender: TObject);
procedure actCloseExecute(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure actPrintExecute(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure actCancelExecute(Sender: TObject);
private
FFormMode: TEditFormMode;
FDocFile: TFileName;
FDocName: string;
FOutputFileName: string;
function Initialise(const AFileName: TFileName; const ADocName:
string; const AFormMode: TEditFormMode): Boolean;
procedure SetFormMode(const Value: TEditFormMode);
procedure SetDocFile(const Value: TFileName);
procedure SetDocName(const Value: string);
procedure PrintDocument;
procedure CheckActions;
procedure DoSave;
private
property FormMode: TEditFormMode read FFormMode write SetFormMode;
property DocFile: TFileName read FDocFile write SetDocFile;
property DocName: string read FDocName write SetDocName;
property OutputFileName: string read FOutputFileName write
FOutputFileName;
public
function EditFile(const AFileName: TFileName; const ADocName:
string='SBMS DOC'): Boolean;
function ViewFile(const AFileName: TFileName; const ADocName:
string='SBMS DOC'): Boolean;
function PrintFile(const AFileName: TFileName; const ADocName:
string='SBMS DOC'): Boolean;
function PostScriptPrint(const AFileName, PSFileName: TFileName;
const ADocName: string='SBMS DOC'): Boolean;
end;
var
frmDocEdit: TfrmDocEdit;
implementation
{$R *.dfm}
uses Globals;
function TfrmDocEdit.PostScriptPrint(const AFileName, PSFileName:
TFileName; const ADocName: string): Boolean;
begin
OutputFileName := PSFileName;
Result := Initialise(AFileName, ADocName, efmPrintToFile);
end;
function TfrmDocEdit.PrintFile(const AFileName: TFileName; const
ADocName: string): Boolean;
begin
Result := Initialise(AFileName, ADocName, efmPrint);
end;
function TfrmDocEdit.EditFile(const AFileName: TFileName; const
ADocName: string): Boolean;
begin
Result := Initialise(AFileName, ADocName, efmEdit);
end;
function TfrmDocEdit.ViewFile(const AFileName: TFileName; const
ADocName: string): Boolean;
begin
Result := Initialise(AFileName, ADocName, efmReadOnly);
end;
function TfrmDocEdit.Initialise(const AFileName: TFileName; const
ADocName: string;
const AFormMode: TEditFormMode): Boolean;
begin
Result := False;
try
// ALWAYS set FormMode first
FormMode := AFormMode;
DocFile := AFileName; //starts wordcontainer
DocName := ADocName;
case FFormMode of
efmEdit, efmReadOnly:
begin
Self.Width := Screen.Width div 2;
Self.Height := Screen.Height div 2;
Result := (Self.ShowModal = mrOK);
end;
efmPrint, efmPrintToFile:
begin
Self.Show;
Self.Visible := False;
PrintDocument;
Result := True;
Self.Close;
end;
end;
except
on E:Exception do
begin
ShowMessage('' + E.Message);
Result := False;
end;
end;
CheckActions;
end;
procedure TfrmDocEdit.SetDocFile(const Value: TFileName);
begin
FDocFile := Value;
FileSetReadOnly(FDocFile, FFormMode = efmReadOnly);
wcMain.CurrentDocFile := FDocFile;
end;
procedure TfrmDocEdit.SetFormMode(const Value: TEditFormMode);
begin
FFormMode := Value;
case FFormMode of
efmReadOnly:
begin
Self.Caption := 'Viewing Document '+FDocName+' (Read Only)';
end;
efmEdit:
begin
Self.Caption := 'Editing Document '+FDocName;
end;
efmPrint, efmPrintToFile:
begin
Self.Caption := 'Printing Document '+FDocName; { Doesn't really
matter }
end;
end;
end;
procedure TfrmDocEdit.actSaveExecute(Sender: TObject);
begin
DoSave;
wcMain.ClearDocRef;
wcMain.DeactivateDocument;
wcMain.CurrentDocFile := FDocFile;
wcMain.ActivateDocument;
CheckActions;
end;
procedure TfrmDocEdit.actCloseExecute(Sender: TObject);
begin
ModalResult := mrOK;
end;
procedure TfrmDocEdit.FormShow(Sender: TObject);
begin
wcMain.ActivateDocument;
if FFormMode in [efmReadOnly, efmEdit] then Self.WindowState :=
wsMaximized;
CheckActions;
end;
procedure TfrmDocEdit.SetDocName(const Value: string);
begin
FDocName := Value;
end;
procedure TfrmDocEdit.PrintDocument;
var
OldPrinter: string;
begin
with wcMain do
begin
OldPrinter := DocumentPrinter;
try
if FFormMode = efmPrintToFile then
begin
DocumentPrinter := POSTSCRIPT_PRINTER;
PrintDocToFile(FOutputFileName);
end
else
begin
PrintDocument(1);
end;
finally
DocumentPrinter := OldPrinter;
end;
end;
end;
procedure TfrmDocEdit.FormCreate(Sender: TObject);
begin
Self.Height := 0;
Self.Width := 0;
Self.Left := Screen.DesktopLeft;
Self.Top := Screen.DesktopTop;
end;
procedure TfrmDocEdit.CheckActions;
begin
actSave.Enabled := (FFormMode = efmEdit);
actPrint.Enabled := (FFormMode in [efmReadOnly, efmEdit]);
end;
procedure TfrmDocEdit.actPrintExecute(Sender: TObject);
begin
PrintDocument;
end;
procedure TfrmDocEdit.FormClose(Sender: TObject; var Action:
TCloseAction);
begin
if (FFormMode = efmEdit) and wcMain.ChangesMade and
(MsgBox('Changes have been made and not saved.'#13'Do you want to
save now?',
'Save Changes', MB_ICONQUESTION + MB_YESNO +
MB_DEFBUTTON1) = ID_YES) then
begin
DoSave;
end;
wcMain.ClearDocRef;
end;
procedure TfrmDocEdit.actCancelExecute(Sender: TObject);
begin
ModalResult := mrCancel;
end;
procedure TfrmDocEdit.DoSave;
begin
wcMain.SaveDocumentAs(FDocFile);
end;
end.
Deborah Pate (TeamB)
Any suggestions for the scroll bar phenomenon much
appreciated.
>>
There can sometimes be a problem with TOleContainers
resizing slightly. Is this one on a form that has
AutoScroll turned on?
--
Deborah Pate (TeamB) http://delphi-jedi.org
TeamB don't see posts sent via Google or ISPs
Use the real Borland server: newsgroups.borland.com
http://www.borland.com/newsgroups/genl_faqs.html
Dave Johnson
>resizing slightly. Is this one on a form that has
>AutoScroll turned on?
Thanks for the speedy response (will remember to post via Borland
servers in future..)
Yes, this form has AutoScroll=True. Will toggle on Monday, recompile
and see if things improve.
Cheers
Dave J (for Jen C)