{            Форма "Шаблон протокола обследования"
 Назначение:
  Форма позволяет
   - сформировать шаблон протокола обследования
   - вести данные протокола обследования по заданному шаблону
 Вызываемый макрос:
  SHOW_WORD -
 Передаваемые параметры:
  @OPERATION=1 - вызов формы в режиме работы с шаблоном протокола обследования.
    @ID - идентификатор шаблона, с которым необходимо вести работу
          (если шаблон новый - не указывается)
    @PARENT_ID - идентификатор вида протокола, для которого формируется шаблон
          (обязателен, если @ID не указан, если @ID указан - не используется)

  @OPERATION=2 - вызов формы в режиме работы с протоколом обследования (ввод в поля протокола).
    TYPE_     - тип протокола. Перечень доступных значений определяется полем PROT_TYPES.INTERNAL_NAME
    REL_ID    - ID связи ПРОТОКОЛ<->СОБЫТИЕ. Если указан, следующий параметр игнорируются
    FOR_ID    - идентификатор объекта, для которого вводится протокол (обязателен)
    PROT_ID   - идентификатор отображаемого протокола
    DATASET   - список протоколов, которые можно перелистывать. Указатель на TDataset.

 Обработка прав доступа:
    Грант INPUT_PROT:
      SELECT - открытие любого протокола. Иначе будет сообщение об отсутствии прав.
      INSERT - создание нового протокола с сохранением как окончательного.
               Проверяется при сохранении клавишей F2 только что созданного или отложенного протокола.
      UPDATE - модификация протокола с сохранением как окончательного.
               Проверяется при сохранении клавишей F2 протокола, созданного ранее (окончательного).
      DELETE - удаление протокола (в списке шаблонов и протоколов)
    Грант DEFER_PROT:
      SELECT - открытие отложенного протокола. Проверяется после проверки права INPUT_PROT-SELECT.
      INSERT - создание нового протокола с сохранением как отложенного.
               Проверяется при сохранении клавишей Shift+F2 только что созданного или отложенного протокола.
      UPDATE - модификация протокола с сохранением как отложенного.
               Проверяется при сохранении клавишей Shift+F2 протокола, созданного ранее (окончательного).

 История модификации:

  Сак А.А.            27-11-2002 Изображения на кнопках пролистывания.
  Сак А.А.            25-11-2002 Команда "Копировать из...".
  Сак А.А.            09-11-2002 Новый параметр: DATASET.
  Сак А.А.            04-11-2002 Ошибка: если для события протокол один, а шаблон моложе события, не находился TEPLATE_ID и получался Unexpected end of SQL command.
  Сак А.А.            02-09-2002 Возможность закрытия окна с протоколом, если WORD не установлен (было "Interface not supported")
                                 Не вставлялись автогенерируемые поля длиной >255 из-за того, что были нередактируемые
  Сак А.А.            29-07-2002 Запрет сохранения ненового протокола как отложенного
  Сак А.А.            01-07-2002 Не открывался автоматически шаблон, если в списке доступных шаблонов и протоколов одна выбираемая запись,
                                 и список иерархический
  Сак А.А.            19-06-2002 Немодифицируемые поля заполнялись неправильно при наличии символов перевода строки.
  Сак А.А.            15-06-2002 Модифицирована обработка прав доступа.
  Сак А.А.            08-04-2002 
  Сак А.А.            07-04-2002 Сделана насильная установка масштаба в 100% и отмена проверок орфографии и грамматики.
                                 Исправлен косяк с обновлением полей, модифицированных в базе.
  Cак А.А.            29-04-2002 Не проверялись права на удаление протокола.
                                 Неправильно проверялось право на отложенный протокол.
  Cак А.А.            27-04-2002 Не менялся размер компонента для ввода через справочник (SprLists.pas)
                                 Поставил StartTrans и CommitTrans. На случай вызова формы из неоткрытой транзакции
                                 Не было $DESCRIPTION в DPK
  Cак А.А.            24-04-2002 SAVEPOINT при создании шаблона.
  Сак А.А.            19-04-2002 При возникновении ошибки во время обновления полей (открытие шаблона)
                                 показывать сообщение и продолжать работу
  Сак А.А.          с 28-02-2002
                   по 08-04-2002 Изменения по договору с ОКД.
  Горбунов И.П.       01-09-2001 Создал
}
unit ProtWord;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  icCustomBlank, Menus, ComCtrls, icButtons, ExtCtrls, StdCtrls,
  icCommon, icParamControls,  icCombo, OleCtnrs, icModuleMain, DB, icDataSet, clipbrd,
  ProtCommon;


type
  TProtWordFrm = class(TicModuleMainForm)
    OleCtrn: TOleContainer;
    N1: TMenuItem;
    SaveMI: TMenuItem;
    N7: TMenuItem;
    RefreshSprMI: TMenuItem;
    SaveSprMIClick: TMenuItem;
    LoadTemplateMI: TMenuItem;
    OpenTeplateDlg: TOpenDialog;
    SaveAsDeferredMI: TMenuItem;
    TemplInfoPMI: TMenuItem;
    BrowseDnMI: TMenuItem;
    BrowseUpMI: TMenuItem;
    UpBtn: TicSpeedBtn;
    DnBtn: TicSpeedBtn;
    CopyFromMI: TMenuItem;
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SaveMIClick(Sender: TObject);
    procedure FindSpr(Sender: TObject);
    procedure RefreshSprMIClick(Sender: TObject);
    procedure SaveSprMIClickClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure LoadTemplateMIClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure SaveAsDeferredMIClick(Sender: TObject);
    procedure TemplInfoPMIClick(Sender: TObject);
    procedure BrowseDnMIClick(Sender: TObject);
    procedure CopyFromMIClick(Sender: TObject);
  private
    { Private declarations }
  protected
    { Protected declarations }
    FID           : Variant;
    FChanged      : boolean;
    FParams       : TmParams;
    IsDesign      : boolean;                    // Признак, что форма находится в режиме создания шаблона
    FDeferred     : boolean;                    // Отложенный ли протокол
    FWasDeferred  : boolean;                    // 
    Pass_Word     : string;                     // Пароль, по которому Word переводится в защищенный режим
    NewProtocol   : boolean;                    // Признак, что форма создает новый протокол
    FieldUpdating : boolean;                    // Признак, что в шаблоне обновилось описание полей
    FCaption      : string;                     // Часть заголовка формы ввода
    FProtType     : RProtType;
    FCanUseTrans  : boolean;                    // TRUE, если макрос вызвался не в открытой транзакции
    FDataset      : TDataset;                   // Список протоколов, которые можно пролистывать
    // Процедуры для работы с шаблонами протоколов
    procedure DesignProtocol;                   // Создание шаблона протокола
    // Процедуры для работы с протоколами
    procedure DisplayProtocol;
    procedure CheckBrowseEnabling;              // Проверить разрешение для команд пролистывания протоколов
    procedure InputProtocol;                    // Создание протокола
    procedure UpdateFields;                     // Обновление описания полей
    procedure FillWordControl(App, AControl:Variant; AValue:string); // В указанный элемент ввода документа Word поместить указанное значение
    procedure GetFieldsValues(AProtID:Variant); // Получение значений вводимых полей
    procedure GetDefaultValues;                 // Получить значения по умолчанию
    procedure GetNoInputValues;                 // Получение значений формируемых полей
    procedure SaveFields;                       // Процедура выделения полей из шаблона и сохранение их в БД
    procedure SaveFieldsValues;                 // Процедура выделения значений полей из шаблона и сохранение их в БД
    procedure UpdateDropDownLists (Cur_field: variant); // Обновление перечня значений заданного поля
    procedure UpdateAllDropDownLists;                   // Обновление перечня значений для всех полей
    procedure SaveDropDownLists (Cur_field: variant);   // Обновление перечня значений заданного поля
    procedure SaveAllDropDownLists;             // Обновление перечня значений для всех полей
    procedure SaveProtocolsHeader;
    procedure DoSave;
    procedure UpdateCaption;
    //  Процедуры для работы с транзакциями
    procedure StartTrans;
    procedure CommitWork;
    procedure RollbackWork;
    function  CanUseTrans:boolean; // TRUE, если разрешена работа с транзакциями
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
  public
    procedure Process (AParams:TmParams); virtual;
  end;

var
  ProtWordFrm: TProtWordFrm;

implementation
uses AccessMngr, StdMacros, DBMSMngr, MacroMngr, ImageMngr, DBDlgMngr,
     LVSUtils, icMsgBoxes, StrUtils, GaugeMngr;
{$R *.DFM}

const
  // Типы полей
  wdFieldFormTextInput=Integer(70);         // поле типа TextInput
  wdFieldFormCheckBox=Integer(71);          // поле типа CheckBox
  wdFieldFormDropDown=Integer(83);          // поле типа DropDown

  // Типы вводимых значений в поля типа TextInput
  wdRegularText =Integer(0);                 // Текст
  wdNumberText  =Integer(1);                 // Число
  wdDateText    =Integer(2);                 // Дата
  // Типы защищенных режимов
  wdAllowOnlyFormFields=Integer(2);         // Форма защищена в режиме ввода полей
  wdNoProtection=Integer(-1);               // Форма не защищена

  wdKey1        = Integer(49);
  wdKeyAlt      = Integer(1024);
  wdKeyControl  = Integer(512);
  wdKeyF9       = Integer(122);
  wdWord        = Integer(2);
  wdKeyF2       = Integer(113);

  sqlSavepointStart='SAVEPOINT PROT_SAVEPOINT';
  sqlSavepointEnd  ='ROLLBACK TO SAVEPOINT PROT_SAVEPOINT';

// ==========================================================
// Раздел 1.
//        ПРОЦЕДУРЫ ОБРАБОТКИ ВЫЗВОВ МАКРОСОВ
// ==========================================================
// ==========================================================
// Процедура по обработке макроса вызова формы
// ==========================================================
procedure ShowWord (MName:string; Params:TObject);
var P:TmParams;
begin
 P := Params as TmParams;
 if P.StringValue('@ARM_QUERY')<>'' then Exit;
 if GetOption(optWordAlways,'')='1' then begin
   if not Assigned(ProtWordFrm) then ProtWordFrm:=TProtWordFrm.Create(nil);
   ProtWordFrm.Process(P);
 end else with TProtWordFrm.Create(nil) do
   try if P.FloatValue('@ID')=0 then P['@ID']:=NULL; //Идентификатор - только число
          Process(P);
   finally Free;
   end;
end;

procedure _Monitor(AString:string);
var FN:string;
    FS:TFileStream;
begin
 AString:=FormatDateTime('yyyy-mm-dd hh:nn:ss',Now)+' '+AString+#13#10;
 FN:=GetOption(optLogFile,'');
 if FN<>'' then begin
   try
     try
       FS:=TFileStream.Create(FN,fmOpenReadWrite+fmShareDenyNone);
     except
       FS:=TFileStream.Create(FN,fmCreate);
     end;
     try
       FS.Seek(0,soFromEnd);
       FS.WriteBuffer(PChar(AString)^,Length(AString));
     finally FS.Free;
     end;
   except end;
 end;
end;

procedure _MonitorException(AString:string);
var S:string;
    EO:TObject;
begin
 EO:=ExceptObject;
 if Assigned(EO) then begin
   if EO is Exception
   then S:=Exception(ExceptObject).Message
   else S:='Неизвестная исключительная ситуация';
 end else S:='_MonitorException: нет исключительной ситуации';
 _Monitor(AString+': '+S);
end;

procedure TProtWordFrm.Process (AParams:TmParams);
begin
 FParams.Text := AParams.Text;
 AParams['@RESULT']:=null;
 FChanged:=false;
 FDeferred:=false;
 FWasDeferred:=false;
 FCanUseTrans:=true;
 CopyFromMI.Enabled:=false;
 case FParams.IntValue ('@OPERATION') of
  // Открыть окно в режиме работы с шаблоном
  1:   begin
       IsDesign:= true;
       DesignProtocol;
       if FChanged then AParams['@RESULT']:=1;
       end;
  // Открыть окно в режиме работы с протоколом
  2:   begin
       if CheckAccess(uafSelect,acoInput,0) then begin
         if FParams.StringValue('TYPE_')>'' then GetProtType(FParams.StringValue('TYPE_'),FProtType);
         IsDesign:= false;
         FDeferred:=false;
         FWasDeferred:=false;
         InputProtocol;
         if FChanged then AParams['@RESULT']:=1;
       end else ErrorInf('Вы не имеете право просматривать протокол');
       end;
 end;
end;

procedure TProtWordFrm.UpdateCaption;
var S:string;
begin
 S:=FCaption;
 if FDeferred then S:=S+msgDeferredCaption;
 Caption:=S;
end;

// ==========================================================
// Раздел 2.
//        ПРОЦЕДУРЫ, СВЗЯАННЫЕ С СОБЫТИЯМИ НА ФОРМЕ
// ==========================================================

// При создании формы
procedure TProtWordFrm.FormCreate(Sender: TObject);
begin
  inherited;
  // Создаем необходимые объекты
  FParams := TmParams.Create;
  FieldUpdating:=False;
  Pass_Word:='OKDC';             // Пароль, по которому Word переводится в защищенный режим
  AssignIcon (Icon,imgWordWindow);
  try BrowseDnMI.ShortCut:=TextToShortcut(GetOption(optNextProtKey,'')); except end;
  try BrowseUpMI.ShortCut:=TextToShortcut(GetOption(optPrevProtKey,'')); except end;
  try CopyFromMI.ShortCut:=TextToShortcut(GetOption(optCopyFromKey,'')); except end;
  UpBtn.ImageName:=imgBtnPrev;
  DnBtn.ImageName:=imgBtnNext;
end;

// При удалении формы
procedure TProtWordFrm.FormDestroy(Sender: TObject);
begin
 inherited;
 FParams.Free;
end;

// При закрытии формы
procedure TProtWordFrm.FormClose(Sender: TObject; var  Action: TCloseAction);
begin
// OleCtrn.DestroyObject;
end;

// При показе формы
procedure TProtWordFrm.FormShow(Sender: TObject);
 // Примечание.
 // После считывания шаблона из БД наполнение полей значениями и другие действия с шаблоном
 // могут выполняться, когда OLE-объект активирован, а активироваться OLE может только при
 // отображенной форме. Поэтому в этом методе реализовано большое количество обработки
var
  ActivDoc: Variant;
  aplic: Variant;
begin
  with OleCtrn do begin
    DoVerb(PrimaryVerb);                // Активируем OLE-Contaner (без активации с ним нельзя работать)
    try
     OLEObject.Application.ScreenUpdating:=false;
     // Отключаем функциональные клавиши в Worde, совпадающие с моими
     aplic:=OLEObject.Application;
     try aplic.ActiveWindow.ActivePane.View.Zoom.Percentage:=100; except _MonitorException('FormShow: setting zoom'); end;
     try aplic.Options.CheckSpellingAsYouType:=false; except _MonitorException('FormShow: CheckSpellingAsYouType'); end;
     try aplic.Options.CheckGrammarAsYouType:=false; except _MonitorException('FormShow: CheckGrammarAsYouType'); end;
     try aplic.Options.CheckGrammarWithSpelling:=false; except _MonitorException('FormShow: CheckGrammarWithSpelling'); end;
{     try aplic.CustomizationContext := aplic.NormalTemplate;
         aplic.CommandBars['Standard'].Controls[5].Enabled:=false; except _MonitorException('FormShow: Delete print button'); end;}
     try
       try
        aplic.CustomizationContext := aplic.NormalTemplate;
        aplic.FindKey(aplic.BuildKeyCode(wdKey1),  aplic.BuildKeyCode(wdKeyAlt)).Disable;
        aplic.FindKey(aplic.BuildKeyCode(wdKeyF2)).Disable;
        aplic.CustomizationContext := aplic.ActiveDocument;
        aplic.FindKey(aplic.BuildKeyCode(wdKey1),  aplic.BuildKeyCode(wdKeyAlt)).Disable;
        aplic.FindKey(aplic.BuildKeyCode(wdKeyF2)).Disable;
       except _MonitorException('FormShow: disable shortcuts');
       end;
     finally aplic:=Unassigned;
     end;
     // Проверяем, в каком режиме находится форма
     ActivDoc:=OLEObject.Application.ActiveDocument;
     if IsDesign then begin  // ОБРАБОТКА В РЕЖИМЕ СОЗДАНИЯ ШАБЛОНА ПРОТОКОЛА
       if ActivDoc.ProtectionType = wdAllowOnlyFormFields then
        ActivDoc.UnProtect(Password:=Pass_Word);
        // Изменяем описание полей, которые были модифицированы в БД, но не в шаблоне
        UpdateFields;
      end
     else begin  // ОБРАБОТКА В РЕЖИМЕ ШАБЛОНА ПРОТОКОЛА
      // Установление защиты в документе Word
      if ActivDoc.ProtectionType = wdNoProtection then
         ActivDoc.Protect(Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=Pass_Word);
      // Считываем значения полей
      if not NewProtocol then GetFieldsValues(FParams['PROT_ID']) else GetDefaultValues;
      try GetNoInputValues; except Application.HandleException(nil); end;
     end;
    finally
     OLEObject.Application.ScreenUpdating:=true;
     ActivDoc:=Unassigned;
     OLEObject.Application.ActiveDocument.Saved:=not FieldUpdating;
    end;
  end;
  CheckBrowseEnabling;
end;

// ==========================================================
// Раздел 3.
//        ПРОЦЕДУРЫ ПРИ РАБОТЕ В РЕЖИМЕ СОЗДАНИЯ ШАБЛОНА
// ==========================================================

// ==========================================================
//   Процедура обработки вызова формы в режиме работы
// с шаблоном протокола обследования
// ==========================================================
procedure TProtWordFrm.DesignProtocol;
var AID    :Variant;
    wStream:TStream;
    S:string;
begin
  SaveAsDeferredMI.Enabled:=false; SaveAsDeferredMI.Visible:=false; TemplInfoPMI.Visible:=false;
  // Считываем информацию о шаблоне протокола обследования
  FParams['TEMPLATE_ID']:=FParams['@ID'];
  FParams['KIND_PROT_ID']:=FParams['@PARENT_ID'];
  CallSP(dboGetTemplateInfo,FParams);
  // Определяем, на базе чего создавать шаблон - на базе данного или предка
  FID:=FParams['TEMPLATE_ID'];
  AID:=FParams['PARENT_TEMPLATE_ID'];
  FCaption:=FParams.StringValue('PROT_NAME')+': шаблон протокола обследования';
  UpdateCaption;
  if VarToStr(AID)='' then AID:=FParams['TEMPLATE_ID'];
  wStream := CreateBlob('PROT_TEMPLATE_WORD',AID,'TEMPLATE_TXT');
  try
    if wStream.Size>0 then begin              // Если шаблон не пустой,
      SetLength(S,wStream.Size);
      wStream.ReadBuffer (PChar(S)^,wStream.Size);
      OleCtrn.LoadFromStream(wStream);        // то OLE- объект создаем на базе него
    end else begin
      OleCtrn.CreateObject('Word.Document', False);  // иначе создаем новый OLE объект
    end;
  finally wStream.Free;
  end;
  ShowModal;
end;

// ==========================================================
// Процедура выделения полей из шаблона и сохранение их в БД
// ==========================================================
procedure TProtWordFrm.SaveFields;
 var
  i: integer;
  TFParams : TmParams;
  work_id: integer;
  CurField: variant;
  TypeField: variant;
  ActivDoc: variant;
begin
 // Разбор полей документа
 TFParams := TmParams.Create;

 With OleCtrn do try
   ActivDoc:=OLEObject.Application.ActiveDocument;
   OLEObject.Application.ScreenUpdating:=false;
   try
   for i:=1 to ActivDoc.FormFields.Count
    do
    begin
      TFParams.Clear;
      TFParams['KIND_PROT_ID']:=FParams['KIND_PROT_ID'];
      work_id:=0;
      // Выделяем имя поля
      CurField:=ActivDoc.FormFields.Item(i);
      TFParams['FIELD_NAME']:=CurField.Name;
      if CurField.Enabled
        then  TFParams['MAY_CNANGE']:='Y'
        else  TFParams['MAY_CNANGE']:='N';
      case CurField.Type of
       // Разбор полей типа текст ()
       wdFieldFormTextInput:
       begin
         // Определение типа вводимого значения в поле
         TypeField:=CurField.TextInput;
         case TypeField.Type of
           wdRegularText:  TFParams['FIELD_TYPE']:='V';
           wdNumberText:   TFParams['FIELD_TYPE']:='N';
           wdDateText:     TFParams['FIELD_TYPE']:='D';
         end;
         // Определение характеристик поля
         TFParams['FIELD_LENGTH']:=TypeField.Width;
         TFParams['FIELD_MASK']:=TypeField.Format;
         TFParams['DEVAULT_VALUE']:=TypeField.Default;
       end;
       // Разбор полей типа DropDown ()
       wdFieldFormDropDown:
         begin
           TFParams['FIELD_TYPE']:='S';
         end;
       // Разбор полей типа сheckBox (wdFieldFormCheckBox)
       wdFieldFormCheckBox:
         begin
           TFParams['FIELD_TYPE']:='C';
         end;
      end;
       UpdateRecord(dboSaveFieldsFromWord, TFParams,  work_id);
    end;
   Inform ('Шаблон протокола сохранен');
   except on e:Exception do begin
      // Если при обработке поля возникла ошибка - позиционируемся в него
      CurField.Select;
      Application.HandleException(nil);
    end;
   end;
  finally
   TypeField := Unassigned;    CurField := Unassigned;
   ActivDoc := Unassigned;
   OLEObject.Application.ScreenUpdating:=true;
  end;
  TFParams.Free;
end;

// ==========================================================
// ПРОЦЕДУРА, ОБНОВЛЯЮЩАЯ ОПИСАНИЕ ПОЛЕЙ В ШАБЛОНЕ
// ПО ИЗМЕНЕНИЯМ В БД
// ==========================================================
procedure  TProtWordFrm.UpdateFields;
Var
 FN,S: string;
 D:TDataSet;
 wField,CurField: Variant;
 FieldTypeDB: String;
 FieldTypeWord: Integer;
begin
 S:='SELECT  FIELD_ID, FIELD_NAME, FIELD_TYPE, NOT_EMPTY, TO_NUMBER(DECODE(MAY_CNANGE, ''Y'',1, 0)) MAY_CHANGE, FUNCTION_NAME, FIELD_LENGTH ,FIELD_MASK, DEVAULT_VALUE default_value, TYPE_MODIFY, OLD_FIELD_NAME  '
    + ' FROM  PROT_FIELDS '
    + ' WHERE MAST_CHANGE_WORD=''Y'' AND KIND_PROT_ID = ' + FParams.StringValue('KIND_PROT_ID') ;
 // Считываем поля, описание которых изменилось в БД, но не изменилось в шаблоне
 D:=CreateSQLDataSet(S,true);
 try
  FieldUpdating:=D.RecordCount>0;
  while not D.EOF do begin
   // Выделяем в шаблоне поле, с которым будем работать
   try
     if D.FieldByName('TYPE_MODIFY').AsString='R'
       then FN:='OLD_FIELD_NAME'
       else FN:='FIELD_NAME';
     wField:=D.FieldByName(FN).Value;
     CurField:=OleCtrn.OLEObject.Application.ActiveDocument.FormFields.Item(wField);
   except on e:Exception do begin
         ErrorInf(Format('Ошибка при доступе к полю с именем "%s".'#13#10' %s',[VarToStr(wField),e.Message]));
         CurField:=Unassigned;
         end;     
   end;
   if not VarIsEmpty(CurField) then begin
     if D.FieldByName('TYPE_MODIFY').AsString='R' then CurField.Name:=D.FieldByName('FIELD_NAME').AsString;
     CurField.Enabled:=D.FieldByName('MAY_CHANGE').AsInteger;
     FieldTypeDB:=D.FieldByName('FIELD_TYPE').AsString;
     if  (FieldTypeDB= 'N') OR  (FieldTypeDB= 'V') OR  (FieldTypeDB= 'D')
      then begin
       if FieldTypeDB = 'N' then  FieldTypeWord:=wdNumberText
        else if FieldTypeDB = 'D' then FieldTypeWord:=wdDateText
        else fieldTypeWord:=wdRegularText;
       CurField.TextInput.EditType(type:=FieldTypeWord ,  Format:=D.FieldByName('FIELD_MASK').AsString);
       CurField.TextInput.Width:=D.FieldByName('FIELD_LENGTH').AsString;
       CurField.TextInput.Default:=D.FieldByName('DEFAULT_VALUE').AsString;
     end;
   end;
   D.Next;
   end;
 finally D.Free;
 end;
 CurField := Unassigned;
end;


// ==========================================================
// Раздел 4
//        ПРОЦЕДУРЫ ПРИ РАБОТЕ В РЕЖИМЕ СОЗДАНИЯ ПРОТОКОЛА
// ==========================================================

// ==========================================================
// Процедура обработки вызова формы в режиме работы с протоколом
// ==========================================================
procedure TProtWordFrm.InputProtocol;
var p:TmParams;
    S:string;
    C:boolean;
    wDS:TObject;
begin
  FCanUseTrans:=not InTransaction;
  StartTrans;
  ExecuteServerScript(sqlSavepointStart,nil);
  _Monitor('savepoint created: '+sqlSavepointStart);
  RefreshSprMI.Enabled:=false;    RefreshSprMI.Visible:=false;
  SaveSprMIClick.Enabled:=false;  SaveSprMIClick.Visible:=false;
  LoadTemplateMI.Enabled:=false;  LoadTemplateMI.Visible:=false;
  SaveAsDeferredMI.Enabled:=true; SaveAsDeferredMI.Visible:=true;
  TemplInfoPMI.Visible:=true;
  S:=FParams.StringValue('@ID');
  FDataset:=nil;
  wDS:=TObject(FParams.PointerValue('DATASET'));
  if Assigned(wDS)
  then try
         FDataset:=wDS as TDataset;
       except
         raise Exception.Create('Переданное в параметре DATASET значение не является указателем на объект класса TDataset');
       end;
  if Assigned(FDataset) then FParams['PROT_ID']:=FDataset.Fields[0].Value;
  // Если передали ID события,
  // Определяем, есть ли протокол по указанной услуге
  if FParams.StringValue('REL_ID')<>'' then begin
    // Если передали REL_ID, то PROT_ID и FOR_ID определяем по процедуре
    c:=true;
    CallSP(FProtType.FindRelProc,FParams);
  end else begin
    // Если REL_ID не передали, то обрабатываем FOR_ID
    if FParams.StringValue('FOR_ID')<>'' then begin
      p:=TmParams.Create;
      try
        // Протокол, по которому будет вводится информация
        p['@OPERATION'] := '5';
        p['EVENT_ID'] := FParams['FOR_ID'];
        p['PROT_TYPE']:= FParams['TYPE_'];
        ExecMacro ('LIST_PROT',p);
        C := P.IntValue('@RESULT')=1;
        if c then begin
          FParams['KIND_PROT_ID']:=p['KIND_PROT_ID'];
          FParams['PROT_ID']:=p['PROT_ID'];
          FParams['EVENT_ID']:=FParams['FOR_ID'];
          FParams['REL_ID']:=p['REL_ID'];
        end;
        finally p.free;
      end;
    end else begin
      // Если не передали ни REL_ID ни FOR_ID, то должны передать PROT_ID.
      p:=TmParams.Create;
      try
        p['@OPERATION'] := '7';
        p['PROT_ID'] := FParams['PROT_ID'];
        ExecMacro('LIST_PROT',p);
        C := P.IntValue('@RESULT')=1;
        if FParams.StringValue('PROT_ID')=''
          then raise EInformation.Create(0,'Не вернули PROT_ID');
        if c then begin
          FParams['KIND_PROT_ID']:=p['KIND_PROT_ID'];
          FParams['REL_ID']:=p['REL_ID'];
          FParams['TYPE_']:=p['TYPE_'];
          if FParams.StringValue('TYPE_')=''
            then FParams['TYPE_']:=
                 QueryResult('select internal_name '+
                             ' from prot_types pt, prot_kind pk, protokol p '+
                             ' where pt.prot_type_id=pk.prot_type_id and '+
                             '       p.kind_prot_id=pk.kind_prot_id and '+
                             '       p.prot_id='+FParams.StringValue('PROT_ID')
                            );
          GetProtType(FParams.StringValue('TYPE_'),FProtType);
          CallSP(FProtType.FindRelProc, FParams);
        end;
        finally p.Free;
      end;
    end;
  end;
  if c then begin
    {Сюда должны прийти с параметрами PROT_ID и REL_ID
     Если они отсутствуют, будут вызываться дополнительные процедуры
    }
    NewProtocol:=FParams.IsNULL('PROT_ID');
    CopyFromMI.Enabled:=NewProtocol;
    // Если не указали ID протокола или ID связи, создаем новый протокол
    if NewProtocol or FParams.IsNULL('REL_ID') then begin
      // В процедуру передаются EVENT_ID, KIND_PROT_ID и PROT_ID
      CallSP(FProtType.CreateProc,FParams);
      if FParams.StringValue('PROT_ID')='' then raise Exception.CreateFmt('Процедура %s не вернула идентификатор протокола в параметре PROT_ID',[FProtType.CreateProc]);
      if FParams.StringValue('REL_ID')='' then raise Exception.CreateFmt('Процедура %s не вернула идентификатор связи с протоколом в параметре REL_ID',[FProtType.CreateProc]);
      // В 'PROT_ID' вернется PROTOKOL.PROT_ID созданного шаблона.
      // В 'REL_ID' - ID связи протокола с событием.
    end;
    DisplayProtocol;
  end else begin
  end;
end;

// Показать протокол по указанным параметрам
procedure TProtWordFrm.DisplayProtocol;
var S:string;
    wStream:TStream;
    p:TmParams;
    c:boolean;
begin
  if (FParams.StringValue('KIND_PROT_ID')='') or
     (FParams.StringValue('REL_ID')='') or
     (FParams.StringValue('TYPE_')='')
  then begin
      p:=TmParams.Create;
      try
        p['@OPERATION'] := '7';
        p['PROT_ID'] := FParams['PROT_ID'];
        ExecMacro('LIST_PROT',p);
        C := P.IntValue('@RESULT')=1;
        if FParams.StringValue('PROT_ID')=''
          then raise EInformation.Create(0,'Не вернули PROT_ID');
        if c then begin
          FParams['KIND_PROT_ID']:=p['KIND_PROT_ID'];
          FParams['REL_ID']:=p['REL_ID'];
          FParams['TYPE_']:=p['TYPE_'];
          if FParams.StringValue('TYPE_')=''
            then FParams['TYPE_']:=
                 QueryResult('select internal_name '+
                             ' from prot_types pt, prot_kind pk, protokol p '+
                             ' where pt.prot_type_id=pk.prot_type_id and '+
                             '       p.kind_prot_id=pk.kind_prot_id and '+
                             '       p.prot_id='+FParams.StringValue('PROT_ID')
                            );
          GetProtType(FParams.StringValue('TYPE_'),FProtType);
          CallSP(FProtType.FindRelProc, FParams);
        end;
        finally p.Free;
      end;
  end;
  wStream:=nil;
  CallSP(dboGetProtocolRecord,FParams);
  if FParams.StringValue('TEMPLATE_ID')='' then  raise EInformation.CreateFmt('Отсутствует шаблон для протокола "%s" на %s. ',[FParams.StringValue('PROT_NAME'), FParams.StringValue('PROT_DATE')]);
  {На этот момент имеем следующие параметры в FParams:
   PROT_ID
   PERS_ID
   FOR_ID
   KIND_PROT_ID
   PROT_DATE
   DOC_ID
   IS_DEFERRED
   TEMPLATE_ID
   PROT_NAME
   PROT_TYPE
   REL_ID
  }
  FDeferred:=FParams.IntValue('IS_DEFERRED')=1;
  FWasDeferred:=FDeferred;
  // Если протокол сохранен как отложенный, то проверить право открытия
  if FDeferred and not CheckAccess(uafSelect,acoDefer,0) then raise EInformation.Create(0,msgCantDeferUpdate);
  FCaption:=FParams.StringValue('PROT_NAME')+': Протокол обследования';
  UpdateCaption;
  // Считываем шаблон
  FID := FParams['TEMPLATE_ID'];
  if GetOption(optUseFiles,'')='1' then begin
    // Если стоит флажок, что брать шаблоны из файла, то создать поток по файлу
    S:=GetOption(optStorageDir,'');
    if S<>'' then begin
     if S[Length(S)]<>'\' then S:=S+'\';
     S:=S+ReplaceStr(GetOption(optFileTemplate,'?'),'?',VarToStr(FID));
    end;
    try
       wStream := TFileStream.Create(S,fmOpenRead+fmShareDenyNone);
    except on e:Exception do
      // Если стоит флажок, что надо спрашивать о возможности взятия шаблона из базы, то спросить
      if GetOption(optSupplyBase,'')='1' then begin
        if YNConfirm(msgUseBase) // и если сказали, что брать из базы, то взять
        then wStream := CreateBlob('PROT_TEMPLATE_WORD',FID,'TEMPLATE_TXT');
      end else raise Exception.Create('Ошибка чтения шаблона протокола из файла '+S+#10#10'Ошибка: '+e.Message);
    end;
  end else begin
    // Если нет флажка насчет файла, создать поток по полю из базы
    wStream := CreateBlob('PROT_TEMPLATE_WORD',FID,'TEMPLATE_TXT');
  end;
  // Создаем OLE-объект из шаблона протокола обследования
  if Assigned(wStream) then
     try
       if wStream.Size>0                                    // Если шаблон не пустой,
         then OleCtrn.LoadFromStream(wStream)               // то OLE- объект создаем на базе него
         else OleCtrn.CreateObject('Word.Document', False); // иначе создаем новый (пустой) OLE объект
     finally wStream.Free;
     end;
  if not Visible
    then begin
         ShowModal;
         if not FChanged then begin
            try
              ExecuteServerScript(sqlSavepointEnd,nil);
              _Monitor('rolled back: '+sqlSavepointEnd);
              RollbackWork;
            except
              _MonitorException('Error rolling back');
            end;
         end else CommitWork;
         end
    else FormShow(Self);
end;

// Получение значений формируемых полей (ФИО пациента и т.п)
procedure TProtWordFrm.GetNoInputValues;
 Var
 S: string;
 D:TDataSet;
 ActivDoc:Variant;
 i : INTEGER;
begin
 S:='FOR_ID=' + FParams.StringValue('FOR_ID');
 // Вызываем процедуру, возвращающую значения нередактируемых полей
 ActivDoc:=OleCtrn.OLEObject.Application.ActiveDocument;
 try
   D:=CreateDataset ('',FProtType.GetInfoProc,true,S,'');
   try
     for i:=0 to D.FieldCount-1 do try
       ActivDoc.FormFields.Item(D.Fields[i].FieldName).Enabled:=true;
       FillWordControl(OleCtrn.OLEObject.Application, ActivDoc.FormFields.Item(D.Fields[i].FieldName), D.Fields[i].AsString);
       ActivDoc.FormFields.Item(D.Fields[i].FieldName).Enabled:=false;
      except _MonitorException('GetNoInputValues: field '+D.Fields[i].FieldName);
     end;
   finally D.Free;;
   end;
 finally ActivDoc := Unassigned;
 end;
end;

// Внутренняя мулька: в указанный элемент ввода документа Word поместить указанное значение
procedure TProtWordFrm.FillWordControl(App, AControl:Variant; AValue:string);
var wType:integer;
begin
 AValue:=ReplaceStr(AValue,#13#10,#13);
 wType:=AControl.type;
 if wType=wdFieldFormDropDown then begin
    if AValue='' then begin
      AControl.Result:=' ';
     end else begin
      AControl.Result:=AValue;
     end;
 end else
   if wType=wdFieldFormCheckBox
   then AControl.CheckBox.Value:=AValue='1'
   else begin
        if Length(AValue)>254 
        then begin
             AControl.result:=' ';
             AControl.Select;
             Clipboard.AsText := AValue;
             App.Selection.Paste;
             end
        else begin
             AControl.result:=AValue;
             end;
        end;
{
   else try
    AControl.result:=AValue;
    except on e:exception do begin
     AControl.result:=' ';
     AControl.Select;
     Clipboard.AsText := AValue;
     OleCtrn.OLEObject.Application.Selection.Paste;
   end;
  end;
}
end;

// Получить значения по умолчанию
procedure TProtWordFrm.GetDefaultValues;
var CurField: variant;
    ActivDoc: variant;
    FP: TmParams;
    FC: integer;
    i:  integer;
    DS: TDataset;
begin
 FP := TmParams.Create;
 try
   FP['KIND_PROT_ID']:=FParams['KIND_PROT_ID'];
   DS:=CreateDataset('',dboGetFieldDefaults,false,FP.Text,'');
   try
     ActivDoc:=OleCtrn.OLEObject.Application.ActiveDocument;
     FC:=ActivDoc.FormFields.Count;
     for i:=1 to FC do begin
       CurField:=ActivDoc.FormFields.Item(i);
       if CurField.Enabled then  try // Запрашиваем значения только для вводимых полей
         if DS.Locate('FIELD_NAME', CurField.NAME,[])
            then begin
                 FillWordControl(OleCtrn.OLEObject.Application, CurField, DS.FieldByName('DEFAULT_VALUE').AsString);
                 end;
       except _MonitorException('GetDefaultValues'); end;
     end;
     if FC>0 then ActivDoc.FormFields.Item(1).Select;
   finally DS.Free;
   end;
 finally FP.Free;
 end;
end;

// Процедура считывания значений полей из БД
procedure TProtWordFrm.GetFieldsValues(AProtID:Variant);
Var
 i:        integer;
 count_:   integer;
 TFParams: TmParams;
 P:        TmParams;
 CurField: Variant;
 ActivDoc: Variant;
 wGauge:   TicGaugeWin;
 wOptMin:  integer;
 wApp, wFlds:Variant;
// TS, TE:   TDateTime;
begin
 //TS:=Now;
 wGauge:=nil;
 TFParams := TmParams.Create;
 P:=TmParams.Create;
 // Разбор полей документа
 with OleCtrn do try
   wApp:=OLEObject.Application;
   ActivDoc:=wApp.ActiveDocument;
   count_:= ActivDoc.FormFields.Count;
   wOptMin:=StrToIntDef(GetOption(optGaugeMin,''),100);
   if wOptMin<=0 then wOptMin:=1;
   if count_>wOptMin then begin
     wGauge:=TicGaugeWin.Create(Self);
     wGauge.MinValue:=0;
     wGauge.MaxValue:=count_;
     wGauge.Caption:='Чтение протокола';
     wGauge.Message:='Подождите';
     wGauge.ShowProgress:=true;
     wGauge.Show;
   end;
   Self.Enabled:=false;  // При долгой операции можно было нажимать всякие кнопки
   try
   wFlds:=ActivDoc.FormFields;
   for i:=1 to count_  do begin
    // Выделяем имя поля
    CurField:=wFlds.Item(i);
    if CurField.Enabled  // Запрашиваем значения только для вводимых полей
     then try
      P.Clear;
      TFParams['FIELD_NAME']:=CurField.NAME;
      P['PROT_ID']:=AProtID;
      P['FIELD_NAME']:=TFParams['FIELD_NAME'];
      CallSP(dboGetFieldValue,P);
      if P.StringValue('FIELD_TYPE')='V' then begin
         ReadRecord('PROT_FIELD_LONG_VALUES',TFParams,P['VALUES_ID']);
      end else begin
         TFParams['FIELD_VALUE']:=P['FIELD_VALUE'];
      end;
      FillWordControl(wApp, CurField,TFParams.StringValue('FIELD_VALUE'));
      except _MonitorException('GetFieldsValues (1)');
     end;
     if Assigned(wGauge) then wGauge.IncValue(1);
   end;
   wFlds:=Unassigned;
   //TE:=Now;
   //showmessage (FormatDateTime('hh:nn:ss',TS)+' - '+FormatDateTime('hh:nn:ss',TE));
   except _MonitorException('GetFieldsValues (2)');
   end;
  finally // Освобождаем все переменные
    Self.Enabled:=true;
    TFParams.Free;
    CurField:= Unassigned;    ActivDoc:=Unassigned; wApp:=Unassigned;
    wGauge.Free;
    P.Free;
 end;
end;

// Процедура сохранения заголовка протокола
procedure TProtWordFrm.SaveProtocolsHeader;
begin
 // Сохранить запись
 if FDeferred then FParams['IS_DEFERRED']:=1 else FParams['IS_DEFERRED']:=NULL;
 CallSP(dboSaveProtocol,FParams);
end;

// Процедура выделения значения полей  и сохранение их в БД
procedure TProtWordFrm.SaveFieldsValues;
var
  i: integer;
  fCount: integer;
  TFParams : TmParams;
  CurField: Variant;
  ActivDoc: Variant;
  wApp: Variant;
begin
 // Разбор полей документа
 TFParams := TmParams.Create;
 try
   TFParams['KIND_PROT_ID']:=FParams['KIND_PROT_ID'];
   wApp:=OleCtrn.OLEObject.Application;
   ActivDoc:=wApp.ActiveDocument;
   wApp.ScreenUpdating:=false;
   fCount:=ActivDoc.FormFields.Count;
   try
     for i:=1 to fCount
     do begin
        // Выделяем имя поля
        CurField:=ActivDoc.FormFields.Item(i);
        TFParams['FIELD_NAME']:=CurField.Name;
        TFParams['PROT_ID']:=FParams['PROT_ID'];
        if CurField.Enabled
        then begin
             // Сохраняем только вводимые поля
             TFParams['FIELD_VALUE']:=CurField.Result;
             CallSp(dboSaveFieldValues,TFParams);
             end;
        end;
     wApp.ScreenRefresh;
     if FDeferred
     then Inform (msgDeferred)
     else Inform (msgSaved);
   except
    // Если при обработке поля возникла ошибка - позиционируемся в него
    CurField.Select;
    Application.HandleException(nil);
   end;
  // Освобождаем все переменные
  finally
    wApp.ScreenUpdating:=true;
    TFParams.Free;
    CurField:= Unassigned;
    ActivDoc:= Unassigned;
    wApp    := Unassigned;
  end;
end;


// ==========================================================
// Раздел 3
//        Процедуры по работе со справочниками
// ==========================================================


// Процедура, отрабатывающая вызов справочника стандартных фраз по заданному полю
procedure TProtWordFrm.FindSpr(Sender: TObject);
 var
  current_field_name :string;     // Наименование поля, в котором находился курсор
  p                  :TmParams;
  C : boolean;
  CurField: variant;
//  is_spr_field       :boolean;
  field_find: boolean;
  i, end_:integer;
  CurSelection:Variant;
  WorkField: variant;
  ActivDoc:Variant;
//  field_num: integer;
begin
 try
   OleCtrn.OLEObject.Application.ScreenUpdating:=False;   // Отключаем отображение на экран в Worde
   // ========= ОПРЕДЕЛЯЕМ, В КАКОМ ПОЛЕ НАХОДИТСЯ КУРСОР =====================
   try
     field_find:=false;
     CurSelection:=OleCtrn.OLEObject.Application.Selection;
     if CurSelection.FormFields.Count > 0 then begin
     // Находился ли курсор в поле типа CheckBox или DropDown мы можем определить
     // сразу - при нахождении курсора в них они включаются в набор Selection
        CurField:=OleCtrn.OLEObject.Application.Selection.FormFields.Item(1);
        field_find:=true;
     end else begin
     // Поля типа TextInput приходится искать методом перебора всех полей в документе
      ActivDoc:=OleCtrn.OLEObject.Application.ActiveDocument;
      try
      i:=1;
      end_:=ActivDoc.FormFields.Count;
      while i<=end_  do  begin
        try
        WorkField:=ActivDoc.FormFields.Item(i);
        if WorkField.Type=wdFieldFormTextInput
        then begin
          if CurSelection.InRange(WorkField.Range)
           then begin
             CurField:=ActivDoc.FormFields.Item(i);
             field_find:=true;
             i:= end_;
            end
        end;
        finally WorkField:=Unassigned;
        end;
        inc(i);
      end;
     finally ActivDoc:=Unassigned;
     end;
     end;
    finally CurSelection:=Unassigned;
   end;
   // --------------- ПОЛЕ ОПРЕДЕЛЕНО -------------------------------
   // Вызываем справочник стандартных фраз
   if field_find then try
     current_field_name:=CurField.Name;
     begin
      p :=TmParams.Create;
      try
        p['@OPERATION'] := '4';
        p['KIND_PROT_ID']:= fparams.IntValue('KIND_PROT_ID');
        p['FIELD_NAME']:= current_field_name;
        ExecMacro ('LIST_SPR_PROT',p);
        C := P.IntValue('@RESULT')=1;
        if c then begin
         if CurField.Type <> wdFieldFormDropDown then begin
            if not IsDesign
            then begin
                 Clipboard.AsText := P.StringValue('@SPR_VALUE');
                 if CurField.Result=''
                   then CurField.Result:=P.StringValue('@SPR_VALUE')
                   else OleCtrn.OLEObject.Application.Selection.Paste;
                 end;
         end else
           if not IsDesign then CurField.Result:=P.StringValue('@SPR_VALUE');
        end;
      finally p.free;
      end;
     end;
    finally   CurField:=Unassigned;
   end;
  finally
   OleCtrn.OLEObject.Application.ScreenUpdating:=true;
 end;
end;

// Процедура обновления справочных значений для всех полей
procedure  TProtWordFrm.UpdateAllDropDownLists;
 Var
  i: integer;
 CurField: variant;
 ActivDoc: variant;
Begin
 With OleCtrn     do try
   ActivDoc:=OLEObject.Application.ActiveDocument;
   OLEObject.Application.ScreenUpdating:=false;
   try
    // Пробегаемся по полям шаблона
    for i:=1 to ActivDoc.FormFields.Count
     do begin
      CurField:=OLEObject.Application.ActiveDocument.FormFields.Item(i);
      // Если текущее поле - справочник, то вызываем обновление списка
      if CurField.Type=wdFieldFormDropDown
        then UpdateDropDownLists(CurField);
     end;
   except
    // Если при обработке поля возникла ошибка - позиционируемся в него
    CurField.Select;
    raise;
   end;
  finally
    OLEObject.Application.ScreenUpdating:=true;
 end;
 CurField := Unassigned; ActivDoc := Unassigned;
end;

// Процедура обновления справочных значений для указанного поля
procedure  TProtWordFrm.UpdateDropDownLists (Cur_field:Variant);
 Var
 S: string;
 D:TDataSet;
 CurDropDowns:Variant;
begin
 S:='KIND_PROT_ID=' + FParams.StringValue('KIND_PROT_ID');
 S:=S+#10'FIELD_NAME=' + Cur_field.Name;
 // Вызываем процедуру, возвращающую перечень полей для указанного поля
 D:=CreateDataset ('',dboGetFieldSprValuesList,True,S  ,'');
 CurDropDowns:=Cur_field.DropDown;
 CurDropDowns.ListEntries.Clear;    // Очищаем список
 try
  while not D.EOF do begin
   CurDropDowns.ListEntries.Add(Name:=D.FieldByName('SPR_VALUE').AsString);
   D.Next;
   end;
 finally D.Free;;
 end;
 CurDropDowns := Unassigned;
end;

// Процедура сохранения  справочных значений для всех полей
procedure  TProtWordFrm.SaveAllDropDownLists;
 Var
  i: integer;
 CurField: variant;
 ActivDoc: variant;
begin
 With OleCtrn     do try
   ActivDoc:=OLEObject.Application.ActiveDocument;
   OLEObject.Application.ScreenUpdating:=false;
   try
    // Пробегаемся по полям шаблона
    for i:=1 to ActivDoc.FormFields.Count
     do begin
      CurField:=OLEObject.Application.ActiveDocument.FormFields.Item(i);
      // Если текущее поле - справочник, то вызываем обновление списка
      if CurField.Type=wdFieldFormDropDown
        then SaveDropDownLists(CurField);
     end;
   except
    // Если при обработке поля возникла ошибка - позиционируемся в него
    CurField.Select;
    raise;
   end;
  finally
    OLEObject.Application.ScreenUpdating:=true;
 end;
 CurField := Unassigned; ActivDoc := Unassigned;
end;

// Процедура сохранения справочных знавчений для указанного поля
procedure  TProtWordFrm.SaveDropDownLists (Cur_field:Variant);
var
 i: integer;
 count_: integer;
 CurDropDowns:Variant;
 TFParams : TmParams;
begin
 TFParams := TmParams.Create;
 try
 CurDropDowns:=Cur_field.DropDown;
 TFParams['FIELD_NAME']:=Cur_field.Name;
 TFParams['KIND_PROT_ID']:=FParams['KIND_PROT_ID'];
 count_:=CurDropDowns.ListEntries.Count;
 for i:=1 to count_ do begin
  TFParams['SPR_VALUE']:=CurDropDowns.ListEntries.Item(i).Name;
  CallSP(dboSaveFieldSprValueFromWord,TFParams);
 end;
 finally
 CurDropDowns := Unassigned;
 TFParams.Free;
 end;
end;

// Сохранить как отложенный
procedure TProtWordFrm.SaveAsDeferredMIClick(Sender: TObject);
begin
  if not CheckAccess(uafInsert, acoDefer, 0) then raise EInformation.Create(0,msgCantDeferInsert);
  if not (NewProtocol or FWasDeferred) then raise EInformation.Create(0,msgCantDeferSave);
  if YNConfirm(msgSaveAsDeferred) then begin
    FDeferred:=true;
    DoSave;
    Close;
  end;
end;

// Процедура сохранения
procedure TProtWordFrm.SaveMIClick(Sender: TObject);
begin
 FDeferred:=false;
 DoSave;
 UpdateCaption;
end;

procedure TProtWordFrm.DoSave;
var wStream:TStream;
   procedure _Save;
   begin
    StartTrans;
    SaveProtocolsHeader;
    SaveFieldsValues;
    OleCtrn.OLEObject.Application.ActiveDocument.Saved:=true;
    CommitWork;
    FChanged:=true;
   end;
begin
 if IsDesign then begin
   // Сохранение шаблона протокола
    wStream:=TMemoryStream.Create;
    try
      OleCtrn.SaveToStream(wStream);
      StartTrans;
      wStream.Seek(0,soFromBeginning);
      SaveBlob('PROT_TEMPLATE_WORD',FID,'TEMPLATE_TXT', wStream);
      SaveFields;
      CommitWork;
      FChanged:=true;
    finally wStream.Free;
    end;
 end else begin
   // Сохранение протокола
    if NewProtocol or FWasDeferred then
      if (not FDeferred and CheckAccess(uafInsert,acoInput,0)) or (FDeferred and CheckAccess(uafInsert,acoDefer,0))
      then _Save
      else inform(msgCantCreateProtocol)
    else
      if (not FDeferred and CheckAccess(uafUpdate,acoInput,0)) or (FDeferred and CheckAccess(uafUpdate,acoDefer,0))
      then _Save
      else inform(msgCantUpdateProtocol);
 end;
end;

procedure TProtWordFrm.RefreshSprMIClick(Sender: TObject);
begin
 UpdateAllDropDownLists;
end;

procedure TProtWordFrm.SaveSprMIClickClick(Sender: TObject);
begin
 SaveAllDropDownLists;
end;

procedure TProtWordFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
 Q: integer; //ДА(1)-НЕТ(2)-ОТМЕНИТЬ(3)
 wSaved:boolean;
begin
  inherited;
  // Если Word не установлен, обращение к OLE-объектам приведен к ошибке.
  try    wSaved:=OleCtrn.OLEObject.Application.ActiveDocument.Saved;
  except wSaved:=true;
         RollbackWork;
  end;
  if Not wSaved then begin
   Q := YNCConfirm ('Сохранить изменения?');
   case  q of
   1:  begin
        DoSave;
       end;
   2:  try RollbackWork; except end;
   3:  ;
   end;
   CanClose := Q<>3;
  end;
  CommitWork;
end;

//  Процедуры для работы с транзакциями
procedure TProtWordFrm.StartTrans;
begin
 if CanUseTrans and not InTransaction
 then begin
      StartTransaction;
      end;
end;

procedure TProtWordFrm.CommitWork;
begin
 if CanUseTrans and InTransaction
 then begin
      Commit;
      end;
end;

procedure TProtWordFrm.RollbackWork;
begin
 if CanUseTrans and InTransaction
 then begin
      Rollback;
      end;
end;

// TRUE, если разрешена работа с транзакциями
function  TProtWordFrm.CanUseTrans:boolean;
begin
 Result := FCanUseTrans;
end;

procedure TProtWordFrm.LoadTemplateMIClick(Sender: TObject);
begin
 if OpenTeplateDlg.Execute then          { Display Open dialog box }
  begin
//    if OleCtrn.State <> osEmpty then OleCtrn.DestroyObject;
    OleCtrn.CreateObjectFromFile(OpenTeplateDlg.FileName, False);
    OleCtrn.DoVerb(OleCtrn.PrimaryVerb);
  end;
end;

procedure TProtWordFrm.CMShowingChanged(var Message: TMessage);
begin
  inherited;
  if Visible and (WindowState<>wsMaximized)
    then WindowState:=wsMaximized;
end;

procedure TProtWordFrm.FormActivate(Sender: TObject);
begin
 inherited;
 //if WindowState<>wsMaximized then WindowState:=wsMaximized;
end;

procedure TProtWordFrm.TemplInfoPMIClick(Sender: TObject);
var P:TmParams;
    wClose:boolean;
begin
 P:=TmParams.Create;
 try
   P['@OPERATION']:=6;
   P['PROT_ID']:=FParams['PROT_ID'];
   P['REL_ID']:=FParams['REL_ID'];
   P['PROT_TYPE']:=FParams['PROT_TYPE'];
   ExecMacro('LIST_PROT',P);
   wClose:=P.IntValue('@CLOSE_WINDOW')=1;
 finally P.Free;
 end;
 FChanged:=true;
 if wClose then begin
   CommitWork;
   Close;
 end;
end;

// Проверить разрешение для команд пролистывания протоколов
procedure TProtWordFrm.CheckBrowseEnabling;
var wDn, wUp:boolean;
begin
  wDn:=false;
  wUp:=false;
  if Assigned(FDataset) then begin
    FDataSet.Prior;
    wUp:=not FDataSet.BOF;
    if wUp then FDataSet.Next;
    FDataSet.Next;
    wDn:=not FDataSet.EOF;
    if wDn then FDataSet.Prior;
  end;
  BrowseDnMI.Enabled:=wDn;
  DnBtn.Enabled:=wDn;
  BrowseUpMI.Enabled:=wUp;
  UpBtn.Enabled:=wUp;
end;

// Пролистывание по списку протоколов
procedure TProtWordFrm.BrowseDnMIClick(Sender: TObject);
var wChanged:boolean;
begin
  wChanged:=false;
  if not Assigned(FDataset) then Exit;
  case (Sender as TComponent).Tag
  of 1: begin
        FDataset.Next;
        wChanged:=true;
        end;
     2: begin
        FDataset.Prior;
        wChanged:=true;
        end;
  end;
  if wChanged then begin
    FParams.Clear;
    FParams['PROT_ID']:=FDataset.Fields[0].Value;
    NewProtocol:=false;
    DisplayProtocol;
  end;
end;

procedure TProtWordFrm.CopyFromMIClick(Sender: TObject);
var P:TmParams;
    wNewProtID:Variant;
    //wSel:boolean;
begin
  P:=TmParams.Create;
  try
    P['PROT_ID']:=FParams['PROT_ID'];
    P['@OPERATION']:=8;
    ExecMacro('LIST_PROT', P);
    wNewProtID:=P['PROT_ID'];
    if (P.IntValue('@RESULT')=1) and (P.StringValue('PROT_ID')<>'') then GetFieldsValues(wNewProtID);
  finally P.Free;
  end;
end;

initialization
 ProtWordFrm:=nil;
 RegisterMacro('SHOW_WORD',@ShowWord);
finalization
 UnregisterMacro('SHOW_WORD',@ShowWord);
 ProtWordFrm.Free;
end.

{
НАРАБОТКИ
//    OLEObject.Application.CustomizationContext := OLEObject.Application.ActiveDocument.AttachedTemplate;
//    OLEObject.Application.FindKey(OLEObject.Application.BuildKeyCode(wdKeyF5)).Disable;

}
{    try
    OLEObject.Application.ScreenUpdating:=true;
    start_:=OLEObject.Application.Selection.Start;
    OLEObject.Application.ActiveDocument.Range(start_,start_).Select;
    Inform('Select');
    OLEObject.Application.Selection.Expand(Unit:=wdWord);
    Inform('Expand');
    start_:=OLEObject.Application.Selection.Start+1;
    start1_:=OLEObject.Application.Selection.End-1;
    if start_ >= start1_ then begin
     OLEObject.Application.ActiveDocument.Range(start_,start1_).Select;
      Inform('ToStart');
     end;
    OLEObject.Application.Selection.Copy;
    Inform('Copy');
    except Inform('Error');
    end;
}