Форум программистов [Powered by Invision Power Board]

Код

{в принципе этот модуль можно применять в своей программе,
только немного необходимо разобраться как эти функции работают.
надеюсь этот модуль Вам чем то поможет.
на событие формы OnCreate необходимо глобальной переменной
tegNum присвоить 1 (то есть первый вопрос).
далее необходимо tegNum присваивать значение функций NextQuestion
и PreviousQuestion.
также необходимо объявить глоб. переменную (у меня kolQ),
которой будет присваиваться значение функции KolTeg,
и в дальнейшем она будет использоваться для функций NextQuestion
и PreviousQuestion.
кстати, эти две глоб. переменные можно объявить прямо в этом модуле
(все равно этот модуль подключается к другим, там где он нужен),
просто я их объявлял в модуле главной формы :-) }
unit UmyWApp;

interface

uses StdCtrls, SysUtils, OleCtnrs, Dialogs, Variants, OleServer, Word2000;

//определяет количество вопросов (тегов <teg>) в документе,
//возвращает это количество
function KolTeg(WApp:TWordApplication; myLabel:TLabel):integer;
//выход из Ворда без сохранений в открытых для данного сервера Ворд документах
function QuitWordAppNotSave(WApp:TWordApplication):boolean;
//переход к следующему вопросу (к следующему <teg>...</teg>) в документе
//необходимо применять эту функцию после функции KolTeg
//возвращает номер вопроса
function NextQuestion(WApp:TWordApplication; myOleContainer:TOleContainer;
                      myLabel:TLabel; tegNum, KolTeg:Integer):integer;
//переход к предыдущему вопросу (к предыдущему <teg>...</teg>) в документе
//необходимо применять эту функцию после функции KolTeg
//возвращает номер вопроса
function PreviousQuestion(WApp:TWordApplication; myOleContainer:TOleContainer;
                          myLabel:TLabel; tegNum, KolTeg:Integer):integer;
//соединение (точнее создание своего нового) с сервером Ворда и открытие нового документа
function WAppConnect_Add(WApp:TWordApplication; myAutoConnect, myAutoQuit:Boolean;
                          myConnectKind:TConnectKind; AddFileName:OleVariant):boolean;
//соединение (точнее создание своего нового) с сервером Ворда
// и открытие уже существующего документа
function WAppConnect_Open(WApp:TWordApplication; myAutoConnect, myAutoQuit:Boolean;
                          myConnectKind:TConnectKind; AddFileName:OleVariant):boolean;
//показывает первый вопрос в документе
//у меня применяется эта функция во время активации формы (OnActivate)
//необходимо (обязательно) применять эту функцию до функции KolTeg
//так как KolTeg вносит изменения в теги, и эта функция будет материться
function ShowFirstQuestion(WApp:TWordApplication; myOleContainer:TOleContainer;
                           ShowNotTegFile:boolean):boolean;
//копирует из документа определенный вопрос в буфер обмена
function CopyQuestionToClipboard(WApp:TWordApplication; tegNum:Integer):boolean;
//вставляет из буфера обмена в любой другой документ (этого сервера Ворд,
//с которым идет работа)
function PasteFromClipboardToFile(WApp:TWordApplication;
                                  IntoWhatItemToInsert, ReturnBackToItem:OleVariant):boolean;
//удаляет определеный вопрос из документа (вместе с тегами <teg>...</teg>)
function DeleteQuestion(WApp:TWordApplication; tegNum:Integer):boolean;

implementation

function KolTeg(WApp:TWordApplication; myLabel:TLabel):integer;
var
  L,d,DD,Templ:OleVariant;
  tr:boolean;
  text_:string;
  kol:integer;
begin
    L:=wdStory;
    WApp.Selection.HomeKey(L,EmptyParam);
    tr:=true;
    kol:=0;
    d:=wdFindStop;
    Templ:='<teg>';
    repeat
    begin
      try
      begin
        kol:=kol+1;
        tr:=WApp.Selection.Find.Execute(Templ,EmptyParam,EmptyParam,EmptyParam,
                                        EmptyParam,EmptyParam,EmptyParam,d,EmptyParam,
                                        EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam);
        if tr=true then
        begin
          text_:='<te'+inttostr(kol)+'>';
          WApp.Selection.Delete(EmptyParam,EmptyParam);
          WApp.Selection.InsertAfter(text_);
        end;
        WApp.Selection.End_;
        WApp.Selection.Collapse(DD);
      end
      except
        tr:=false;
      end;
    end
    until tr=false;
    kol:=kol-1;
    myLabel.Caption:='Всего вопросов: '+inttostr(kol);
    L:=wdStory;
    WApp.Selection.HomeKey(L,EmptyParam);
    Result:=kol;
end;

function QuitWordAppNotSave(WApp:TWordApplication):boolean;
var
  NotSave: OleVariant;
begin
  NotSave:=wdDoNotSaveChanges;
  try
    WApp.Quit(NotSave);
    WApp.Disconnect;
  except
    Result:=false;
    exit;
  end;
  Result:=true;
end;

function NextQuestion(WApp:TWordApplication; myOleContainer:TOleContainer;
                       myLabel:TLabel; tegNum, KolTeg:Integer):integer;
var
  Templ,D,DD:OleVariant;
  Start,End_:Integer;
begin
  try
    tegNum:=tegNum+1;
    if tegNum>KolTeg then tegNum:=1;
    myLabel.Caption:='№ вопроса: '+inttostr(tegNum);
    if tegNum=1 then
    begin
      D:=wdStory;
      WApp.Selection.HomeKey(D,EmptyParam);
    end;
    DD:=wdCollapseEnd;
    Templ:='<te'+inttostr(tegNum)+'>';
    D:=wdFindStop;
    WApp.Selection.Find.Execute(Templ, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, D, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam);
    Start:=WApp.Selection.End_;
    WApp.Selection.Collapse(DD);
    Templ:='<\teg>';
    WApp.Selection.Find.Execute(Templ, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, D, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam);
    End_:=WApp.Selection.Start;
    WApp.Selection.Collapse(DD);
    WApp.Selection.Start:=Start;
    WApp.Selection.End_:=End_;
    WApp.Selection.Select;
//////////////////////////////////////////////////////////////////////////////
    WApp.Selection.Copy;
    WApp.Selection.Collapse(DD);
    myOleContainer.Paste;
  except
    showmessage('в документе нет тегов!');
  end;
  Result:=tegNum;
end;

function PreviousQuestion(WApp:TWordApplication; myOleContainer:TOleContainer;
                          myLabel:TLabel; tegNum, KolTeg:Integer):integer;
var
  Templ,D,DD:OleVariant;
  Start,End_:Integer;
begin
  try
    tegNum:=tegNum-1;
    if tegNum=0 then tegNum:=KolTeg;
    myLabel.Caption:='№ вопроса: '+inttostr(tegNum);
    D:=wdStory;
    WApp.Selection.HomeKey(D,EmptyParam);
    DD:=wdCollapseEnd;
    Templ:='<te'+inttostr(tegNum)+'>';
    D:=wdFindStop;
    WApp.Selection.Find.Execute(Templ, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, D, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam);
    Start:=WApp.Selection.End_;
    WApp.Selection.Collapse(DD);
    Templ:='<\teg>';
    WApp.Selection.Find.Execute(Templ, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, D, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam);
    End_:=WApp.Selection.Start;
    WApp.Selection.Collapse(DD);
    WApp.Selection.Start:=Start;
    WApp.Selection.End_:=End_;
    WApp.Selection.Select;
//////////////////////////////////////////////////////////////////////////////
    WApp.Selection.Copy;
    WApp.Selection.Collapse(DD);
    myOleContainer.Paste;
  except
    showmessage('в документе нет тегов!');
  end;
  Result:=tegNum;
end;

function WAppConnect_Add(WApp:TWordApplication; myAutoConnect, myAutoQuit:Boolean;
                          myConnectKind:TConnectKind; AddFileName:OleVariant):boolean;
begin
  try
    WApp.AutoConnect:=myAutoConnect;
    WApp.AutoQuit:=myAutoQuit;
    WApp.ConnectKind:=myConnectKind;
    //if  ReadStrParam('Сервер')='#' then str:='' else str:=ReadStrParam('Сервер');
    //WordApplication1.RemoteMachineName:=str;
    WApp.Connect;
    //////////////////////отключение проверки на грамматику/////////////////////////
    WApp.Options.CheckSpellingAsYouType:=False;
    WApp.Options.CheckGrammarWithSpelling:=False;
    WApp.Options.CheckGrammarAsYouType:=False;
    ////////////////////////////////////////////////////////////////////////////////
    WApp.Documents.Add(AddFileName,EmptyParam,EmptyParam,EmptyParam);
  except
    Result:=false;
    exit;
  end;
  Result:=true;
end;

function WAppConnect_Open(WApp:TWordApplication; myAutoConnect, myAutoQuit:Boolean;
                          myConnectKind:TConnectKind; AddFileName:OleVariant):boolean;
begin
  try
    WApp.AutoConnect:=myAutoConnect;
    WApp.AutoQuit:=myAutoQuit;
    WApp.ConnectKind:=myConnectKind;
    //if  ReadStrParam('Сервер')='#' then str:='' else str:=ReadStrParam('Сервер');
    //WordApplication1.RemoteMachineName:=str;
    WApp.Connect;
    //////////////////////отключение проверки на граматику/////////////////////////
    WApp.Options.CheckSpellingAsYouType:=False;
    WApp.Options.CheckGrammarWithSpelling:=False;
    WApp.Options.CheckGrammarAsYouType:=False;
    ////////////////////////////////////////////////////////////////////////////////
    WApp.Documents.Open(AddFileName,EmptyParam,EmptyParam,EmptyParam,EmptyParam,
                        EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,
                        EmptyParam,EmptyParam);
  except
    Result:=false;
    exit;
  end;
  Result:=true;
end;

function ShowFirstQuestion(WApp:TWordApplication; myOleContainer:TOleContainer;
                           ShowNotTegFile:boolean):boolean;
var
  Templ,D,DD:OleVariant;
  Start,End_:Integer;
begin
  try
    DD:=wdCollapseEnd;
    Templ:='<teg>';
    D:=wdFindStop;
    WApp.Selection.Find.Execute(Templ, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, D, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam);
    Start:=WApp.Selection.End_;
    WApp.Selection.Collapse(DD);
    Templ:='<\teg>';
    WApp.Selection.Find.Execute(Templ, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, D, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam);
    End_:=WApp.Selection.Start;
    WApp.Selection.Collapse(DD);
    WApp.Selection.Start:=Start;
    WApp.Selection.End_:=End_;
    WApp.Selection.Select;
//////////////////////////////////////////////////////////////////////////////
    WApp.Selection.Copy;
    WApp.Selection.Collapse(DD);
    myOleContainer.Paste;
  except
    if ShowNotTegFile=true then
    begin
      WApp.ActiveDocument.Content.Copy;
      WApp.Selection.Collapse(DD);
      myOleContainer.Paste;
    end;
    Result:=false;
    exit;
  end;
  Result:=true;
end;

function CopyQuestionToClipboard(WApp:TWordApplication; tegNum:Integer):boolean;
var
  Templ,D,DD:OleVariant;
  Start,End_:Integer;
begin
  try
    D:=wdStory;
    WApp.Selection.HomeKey(D,EmptyParam);
    DD:=wdCollapseEnd;
    Templ:='<te'+inttostr(tegNum)+'>';
    D:=wdFindStop;
    WApp.Selection.Find.Execute(Templ, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, D, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam);
    Start:=WApp.Selection.End_;
    WApp.Selection.Collapse(DD);
    Templ:='<\teg>';
    WApp.Selection.Find.Execute(Templ, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, D, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam);
    End_:=WApp.Selection.Start;
    WApp.Selection.Collapse(DD);
    WApp.Selection.Start:=Start;
    WApp.Selection.End_:=End_;
    WApp.Selection.Select;
    WApp.Selection.Copy;
    WApp.Selection.Collapse(DD);
  except
    Result:=false;
    exit;
  end;
  Result:=true;
end;

function PasteFromClipboardToFile(WApp:TWordApplication;
                                  IntoWhatItemToInsert, ReturnBackToItem:OleVariant):boolean;
begin
  try
    WApp.Windows.Item(IntoWhatItemToInsert).Activate;
    WApp.Selection.TypeText('<teg>');
    WApp.Selection.TypeParagraph;
    WApp.Selection.Paste;
    WApp.Selection.TypeParagraph;
    WApp.Selection.TypeText('<\teg>');
    WApp.Selection.TypeParagraph;
    WApp.Windows.Item(ReturnBackToItem).Activate;
  except
    Result:=false;
    exit;
  end;
  Result:=true;
end;

function DeleteQuestion(WApp:TWordApplication; tegNum:Integer):boolean;
var
  Templ,D,DD:OleVariant;
  Start,End_:Integer;
begin
  try
    D:=wdStory;
    WApp.Selection.HomeKey(D,EmptyParam);
    DD:=wdCollapseEnd;
    Templ:='<te'+inttostr(tegNum)+'>';
    D:=wdFindStop;
    WApp.Selection.Find.Execute(Templ, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, D, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam);
    Start:=WApp.Selection.Start;
    WApp.Selection.Collapse(DD);
    Templ:='<\teg>';
    WApp.Selection.Find.Execute(Templ, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, D, EmptyParam,
                                EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                                EmptyParam, EmptyParam);
    End_:=WApp.Selection.End_;
    WApp.Selection.Collapse(DD);
    WApp.Selection.Start:=Start;
    WApp.Selection.End_:=End_;
    WApp.Selection.Select;
    D:=wdCharacter;
    Templ:=1;
    WApp.Selection.Delete(D,Templ);
    //WApp.Selection.Collapse(DD);
  except
    Result:=false;
    exit;
  end;
  Result:=true;
end;

end.