borland.public.delphi.oleautomation
History/ArchivioDelphi-Word Automation refresh Issues
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.
|