Delphi-Word Automation refresh Issues_delphi refresh-CSDN博客

本文链接：https://blog.csdn.net/pgnet/article/details/3201946

borland.public.delphi.oleautomation

History/Archivio

Delphi-Word Automation refresh Issues

2 msg

[borland.public.delphi.oleautomation]

Delphi-Word Automation refresh Issues
Jen Collier [Feb 25 2004, 10:08]

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.

Re: Delphi-Word Automation refresh Issues
Oliver Townshend [Feb 25 2004, 10:35]

> 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'.

Build a stand alone system which is just WinXP and Office (i.e. no Hayex DX,
or any other unnecessary software).  See if you still have the problem.

Oliver