ahword97.pas

一个好的word的控件

  except
    raise Exception.Create ('Word not active in OLE container');
  end;
  if Sink then
    FEventSink := TWordEventSink.Create(Self,FComApp,ApplicationEvents,DocumentEvents)
  else
    FEventSink := nil;
  FDocuments := TList.Create;
  if FUsedExisting then SyncWithWord;
end;

procedure TWordApp.FreeDocumentsAndSink;
var
  i : Integer;
begin
  // faster to free if we go backward
  // also when a document is destroyed it removes itself from this list
  if FDocuments.Count > 0 then
    for i := FDocuments.Count - 1 downto 0 do
      if Assigned (FDocuments [i]) then
        TWordDoc (FDocuments [i]).Free;
  FEventSink := nil;
  FDocuments.Free;
  FDocuments := nil;
end;

destructor TWordApp.Destroy;
begin
  FreeDocumentsAndSink;
  inherited Destroy;
end;

destructor TWordApp.CloseApp(oeSaveChanges: TOleEnum);
var
  ovSaveChanges,
  OriginalFormat,
  RouteDocument  : OleVariant;
begin
  ovSaveChanges := oeSaveChanges;
  OriginalFormat := EmptyParam;
  RouteDocument := EmptyParam;
  FComApp.Quit (ovSaveChanges, OriginalFormat, RouteDocument);
  FreeDocumentsAndSink;
  inherited Destroy;
end;

procedure TWordApp.SetCaption(Value : String);
begin
  FComApp.Caption := Value;
end;

function TWordApp.GetCaption : String;
begin
  Result := FComApp.Caption;
end;

procedure TWordApp.SetVisible(Value : Boolean);
begin
  FComApp.Visible := Value;
end;

function TWordApp.GetVisible : Boolean;
begin
  Result := FComApp.Visible;
end;

function TWordApp.GetDocument(Index : Integer) : TWordDoc;
begin
  Assert ((Index >= 0) and (Index < FDocuments.Count),
          'Index out of range for GetDocument (' + IntToStr (Index) + ')');
  GetDocument := TWordDoc (FDocuments [Index]);
end;

function TWordApp.GetNoOfDocuments : Integer;
begin
  GetNoOfDocuments := FDocuments.Count;
end;

procedure TWordApp.RemoveDoc(Index : Integer);
// remove Document object from list (but do not free it)
// should rarely be used as onus then on developer to free this Document object
var
  i : Integer;
  wd : TWordDoc;
begin
  Assert ((Index >= 0) and (Index < FDocuments.Count),
          'Index out of range for RemoveDocument (' + IntToStr (Index) + ')');
  FDocuments.Delete (Index);
  i := Index;
  while i < FDocuments.Count do
  begin
    wd := TWordDoc (FDocuments [i]);
    if Assigned (wd) then wd.FItemIndex := i;
    inc (i);
  end;
end;

function TWordApp.GetOnQuit : TNotifyEvent;
begin
  Result := FOnQuit;
end;

procedure TWordApp.SetOnQuit(Value : TNotifyEvent);
begin
  FOnQuit := Value;
end;

function TWordApp.GetOnChangeDocument : TWordDocEvent;
begin
  Result := FOnChangeDocument;
end;

procedure TWordApp.SetOnChangeDocument(Value : TWordDocEvent);
begin
  FOnChangeDocument := Value;
end;

function TWordApp.GetOnOpenDocument : TWordDocEvent;
begin
  Result := FOnOpenDocument;
end;

procedure TWordApp.SetOnOpenDocument(Value : TWordDocEvent);
begin
  FOnOpenDocument := Value;
end;

function TWordApp.GetOnPreCloseDocument : TNotifyEvent;
begin
  Result := FOnPreCloseDocument;
end;

procedure TWordApp.SetOnPreCloseDocument(Value : TNotifyEvent);
begin
  FOnPreCloseDocument := Value;
end;

function TWordApp.GetOnCloseDocument : TWordDocEvent;
begin
  Result := FOnCloseDocument;
end;

procedure TWordApp.SetOnCloseDocument(Value : TWordDocEvent);
begin
  FOnCloseDocument := Value;
end;

procedure TWordApp.InsertText(Text : String);
begin
  FComApp.Selection.TypeText(Text);
end;

function TWordApp.AddNewDoc(Template : String) : TWordDoc;
var
  wd : TWordDoc;
begin
  wd := TWordDoc.CreateNewDoc (Self, Template);
  AddNewDoc := wd;
end;

function TWordApp.AddOpenDoc (DocName : String) : TWordDoc;
var
  wd : TWordDoc;
begin
  wd := TWordDoc.CreateOpenDoc (Self, DocName);
  AddOpenDoc := wd;
end;

function TWordApp.AddActiveDoc : TWordDoc;
// tries to see if active doc in list & just return it
// else try to get active doc from Word
// if no active doc then return nil and leave list alone
var
  wd : TWordDoc;
  i : Integer;
begin
  wd := nil;
  i := 0;
  while (i < FDocuments.Count) and (wd = nil) do
  begin
    wd := TWordDoc (FDocuments [i]);
    if not wd.Active then wd := nil;
    inc (i)
  end;
  if wd = nil then
  begin
    wd := TWordDoc.CreateFromActiveDoc (Self);
    if wd.FComDoc = nil then
    begin
      wd.Destroy;
      wd := nil
    end
  end;
  AddActiveDoc := wd;
end;
procedure TWordApp.CloseActiveDoc(oeSaveChanges: TOleEnum);
var
	wd : TWordDoc;
begin
  wd := AddActiveDoc;
  if wd <> nil then wd.CloseDoc (oeSaveChanges);
end;

procedure TWordApp.PrintActiveDoc;
begin
  FComApp.PrintOut (EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                    EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                    EmptyParam, EmptyParam, EmptyParam)
end;

procedure TWordApp.SaveActiveDocAs(Filename : String);
var
	wd : TWordDoc;
begin
  wd := AddActiveDoc;
  if wd <> nil then wd.SaveAs (Filename);
end;

procedure TWordApp.QuitAppEvent;
var
  MyDoc : TWordDoc;
  iMyDocs : Integer;
begin
  iMyDocs := FDocuments.Count;
  while iMyDocs > 0 do
  begin
    MyDoc := TWordDoc (FDocuments [iMyDocs - 1]);
    if Assigned (FOnCloseDocument) then FOnCloseDocument (Self, MyDoc);
    if MyDoc.Mode <> wdmDestroying then MyDoc.Free; // will remove document too
    Dec (iMyDocs);
  end;
  if Assigned (FOnQuit) then FOnQuit (Self);
end;

procedure TWordApp.PreCloseDocEvent;
var
	wd : TWordDoc;
begin
  // The pre-close event is really what Word sends as a close event
  // However, it occurs before the document closes. The document is still
  // accessible using COM. If there a changes, Word may display the
  // "Do you want Save ..." dialog
  // If the user cancels, the document won't actually close
  // There is no way to know which document is about to close but usually
  // it is the active document (but not necessarily)
  // If the user tries to quits Word and there are documents present,
  // you will get just one pre-close event and no way to know that actually the
  // whole shebang is about to disappear. Don't you just love Word?
  // This is why no document is passes in this event
  // (Note I update the active document's name here in case this is useful
  //  in the OnClose event, when you can no longer use COM)
  // After such a pre-close event you will get a quit event, however, if
  // there are no documents present when the user quits, you get no events!
  wd := AddActiveDoc;
  if wd <> nil then wd.UpdateFullname;
  if Assigned (FOnPreCloseDocument) then FOnPreCloseDocument (Self);
end;

procedure TWordApp.SyncWithWord;
var
  MyDoc : TWordDoc;
  WdDoc : _Document;
  iWrdDocs, iMyDocs : OleVariant;
begin
  // The change event occurs when many events occur. By looking to see what
  // has actually changed, I can fire off sensible events.
  // First lets see if there are any missing documents
  // If there are, generate a close event for the document and free it
  // NB the COM document is NOT accessible in the close event as Word has
  // already destroyed it by now. To catch a closing document where you can
  // still get at the COM document, see the pre-close event - but NB it is
  // not reliably called by Word
  iMyDocs := 0;
  while iMyDocs < FDocuments.Count do
  begin
    MyDoc := TWordDoc (FDocuments [iMyDocs]);
    iWrdDocs := 1;
    WdDoc := nil;
    while (iWrdDocs <= FComApp.Documents.Count) and (WdDoc = nil) do
    begin
      WdDoc := FComApp.Documents.Item (iWrdDocs);
      if MyDoc.Document <> WdDoc then WdDoc := nil;
      iWrdDocs := iWrdDocs + 1;
    end;
    if WdDoc = nil then
    begin
      if Assigned (FOnCloseDocument) then FOnCloseDocument (Self, MyDoc);
      if MyDoc.Mode <> wdmDestroying then MyDoc.Free;
    end;
    iMyDocs := iMyDocs + 1;
  end;

  // Now lets see if there are any new documents
  // If there are, add them to my list and generate an open doc event
  iWrdDocs := 1;
  while iWrdDocs <= FComApp.Documents.Count do
  begin
    WdDoc := FComApp.Documents.Item (iWrdDocs);
    iMyDocs := 0;
    MyDoc := nil;
    while (iMyDocs < FDocuments.Count) and (MyDoc = nil) do
    begin
      MyDoc := TWordDoc (FDocuments [iMyDocs]);
      if MyDoc.Document <> WdDoc then MyDoc := nil;
      iMyDocs := iMyDocs + 1;
    end;
    if MyDoc = nil then TWordDoc.CreateFromComDoc (Self, WdDoc);
    iWrdDocs := iWrdDocs + 1;
  end;
end;

procedure TWordApp.ChangeDocEvent;
begin
  SyncWithWord;
  if (FComApp.Documents.Count > 0) and (Assigned (FOnChangeDocument)) then
    FOnChangeDocument (Self, AddActiveDoc);
end;

procedure TWordApp.Move(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1);
var
	ovUnit : OleVariant;
	ovCount : OleVariant;
begin
	ovUnit := oeUnit;
	ovCount := Count;

	FComApp.selection.Move(ovUnit, ovCount);
end;

procedure TWordApp.MoveEnd(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1);
var
	ovUnit : OleVariant;
	ovCount : OleVariant;
begin
	ovUnit := oeUnit;
	ovCount := Count;

	FComApp.selection.MoveEnd(ovUnit, ovCount);
end;

procedure TWordApp.MoveStart(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1);
var
	ovUnit : OleVariant;
	ovCount : OleVariant;
begin
	ovUnit := oeUnit;
	ovCount := Count;

	FComApp.selection.MoveStart(ovUnit, ovCount);
end;

procedure TWordApp.MoveLeft(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1; Extend : TOleEnum = wdMove);
var
	ovUnit : OleVariant;
	ovCount : OleVariant;
	ovExtend : OleVariant;
begin
	ovUnit := oeUnit;
	ovCount := Count;
  ovExtend := Extend;

	FComApp.selection.MoveLeft(ovUnit, ovCount, ovExtend);
end;

procedure TWordApp.MoveRight(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1; Extend : TOleEnum = wdMove);
var
	ovUnit : OleVariant;
	ovCount : OleVariant;
	ovExtend : OleVariant;
begin
	ovUnit := oeUnit;
	ovCount := Count;
  ovExtend := Extend;

	FComApp.selection.MoveRight(ovUnit, ovCount, ovExtend);
end;

procedure TWordApp.MoveUp(oeUnit : TOleEnum = wdLine; Count : Integer = 1; Extend : TOleEnum = wdMove);
var
	ovUnit : OleVariant;
	ovCount : OleVariant;
	ovExtend : OleVariant;
begin
	ovUnit := oeUnit;
	ovCount := Count;
  ovExtend := Extend;

	FComApp.selection.MoveUp(ovUnit, ovCount, ovExtend);
end;

procedure TWordApp.MoveDown(oeUnit : TOleEnum = wdLine; Count : Integer = 1; Extend : TOleEnum = wdMove);
var
	ovUnit : OleVariant;
	ovCount : OleVariant;
	ovExtend : OleVariant;
begin
	ovUnit := oeUnit;
	ovCount := Count;
  ovExtend := Extend;

	FComApp.selection.MoveDown(ovUnit, ovCount, ovExtend);
end;

procedure TWordApp.GoTo_(oeWhat, oeWhich: TOleEnum; oeCount: Integer = 1; oeName: String = '');
var
  ovWhat, ovWhich, ovCount, ovName : OleVariant;
begin
  ovWhat := oeWhat;
  ovWhich := oeWhich;
  ovCount := ovCount;
  if ovName = '' then
    ovName := EmptyParam
  else
    ovName := ovName;
  FComApp.Selection.GoTo_ (ovWhat, ovWhich, ovCount, ovName);
end;

procedure TWordApp.GoToNext(oeWhat: TOleEnum);
var
  ovWhat : OleVariant;
begin
  ovWhat := oeWhat;
  FComApp.Selection.GoToNext (ovWhat);
end;

procedure TWordApp.GoToPrevious(oeWhat: TOleEnum);
var
  ovWhat : OleVariant;
begin
  ovWhat := oeWhat;
  FComApp.Selection.GoToPrevious (ovWhat);
end;

procedure TWordApp.GotoBookmark(Bookmark : string);
var
  What : OLEVariant;
  Which : OLEVariant;
  Count : OLEVariant;
  Name : OLEVariant;
begin
  What := wdGoToBookmark;
  Which := EmptyParam;
  Count := EmptyParam;
  Name := Bookmark;

  FComApp.Selection.GoTo_(What, Which, Count, Name);
end;

procedure TWordApp.Cut;
begin
  FComApp.Selection.Cut;
end;

procedure TWordApp.Copy;
begin
  FComApp.Selection.Copy;
end;

procedure TWordApp.Paste;
begin
  FComApp.Selection.Paste;
end;

procedure TWordApp.Activate;
begin
	FComApp.Activate;
end;

procedure TWordApp.UpdateActiveDocFields;
begin
	FComApp.ActiveDocument.Fields.Update;
end;

procedure TWordApp.RunMacro(MacroName : string);
begin