{     SAPI4 / SAPI5 СОВМЕСТИМЫЙ, ГОВОРЯЩИЙ ТЕКСТОВЫЙ РЕДАКТОР "ДЕМАГОГ"
                      (проект с открытым исходным кодом)
 В основу речевой части программы положен низкоуровневый (COM) интервейс SAPI4,
 хорошо описанный в книге Дениса Буторина "MS Agent и Speech API в Delphi"
 (http://subritto.h1.ru); и стандартный иxнтерфейс SAPI5 - как им пользоваться
 рассказано в статье Брайана Лонга (http://www.blong.com).
 Идея загружать файл во временный TStringList для предварительной обработки,
 а также способ построения меню Recent Files почерпнуты из открытого проекта
 IXREADER - текст-вьюера Дмитрия Кирсанова (http://ixite.ru/exe/ixreader).
 Текст читается последовательными фрагментами, хранимыми в TStringList, как в
 открытом проекте EXO Игоря Паламара (http://spacelib.narod.ru)
 Упомянутым товарищам - большой респект :).
 1) Вокруг "речевого ядра" наращен  интерфейс полнофункционального редактора
 плоских текстов (в Win-кодировке, само собой).
 2) Я отказался от занимающих много места ползунковых регуляторов TTrackBar и
 заменил их на TEdit+TUpDown.
 3) Графический интерфейс организован через Action List и Image List.
 4) К стандартному интерфейсу текстового редактора добавлены  функции:
 удаления знаков переноса на концах строк; приведения текста к удобочитаемому
 "литературному" виду, записи в аудиофайл; вставки  тегов для акцентирования
 диалогов и т.п.
 5) Поддерживаются словари произношения в популярном формате DIC. Используется
 изобретенный мною быстрый алгоритм словарных замен :).
 6) Останов чтения в SAPI5 у Б.Лонга запрограммирован не совсем удачно.
 Для движка Алена - это не работает вообще, для Катерины-1 вызывает подвисание
 движка на больших текстах на 1-2 минуты. Так что списывать процедуру TTSStop
 надо не у Лонга, а у меня :).
 7) Чтобы при длительных процедурах, вроде форматирования текста и т.п.,
 окно программы после перекрытия окнами других приложений корректно
 перерисовывалось, за оператором ProgressBar1.Position := i следует
 Application.ProcessMessages;
 8) Но... под Win Vista функция Timer1Timer(), копирующая на форму Zoom некую
 область экрана, и прицепленная к таймеру экранной лупы, намертво замораживает
 ProgressBar1.Position := i, если за ним следует Application.ProcessMessages!
 При закрытии лупы таймер выключается и бегущая строка "оттаивает".
 А под XP проблем не возникало.
 ??? Кто поймет в чем тут дело - будет молодец :)

 Венедикт Ли, 2007-2010 г. http://aloys.narod.ru}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, ToolWin, ComCtrls, ExtCtrls, StdCtrls, Speech, ActiveX, ComObj, Menus,
  ActnList, ImgList, StdActns, mmSystem, inifiles, shellAPI, ClipBrd, MyFunc,
  OleServer, SpeechLib_TLB, ExtDlgs, Jpeg, PngImage, GifImg;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    ToolBar1: TToolBar;
    ToolBar2: TToolBar;
    MainMenu1: TMainMenu;
    NFile: TMenuItem;
    NEdit: TMenuItem;
    NFormat: TMenuItem;
    NSpeak: TMenuItem;
    NHelp: TMenuItem;
    NSpeakSpeak: TMenuItem;
    NSpeakPause: TMenuItem;
    NSpeakStop: TMenuItem;
    NFileCreate: TMenuItem;
    NFileOpen: TMenuItem;
    NFileSave: TMenuItem;
    NFileSaveAs: TMenuItem;
    NFileSep2: TMenuItem;
    NFileExit: TMenuItem;
    NEditUndo: TMenuItem;
    NEditSep1: TMenuItem;
    NEditCut: TMenuItem;
    NEditCopy: TMenuItem;
    NEditPaste: TMenuItem;
    NEditSep2: TMenuItem;
    NEditSeleAll: TMenuItem;
    NEditSep3: TMenuItem;
    NEditFind: TMenuItem;
    NEditRepl: TMenuItem;
    NEditSep4: TMenuItem;
    NEditBreaks: TMenuItem;
    NFormatFont: TMenuItem;
    NSpeakSep2: TMenuItem;
    NHelpHelp: TMenuItem;
    NHelpAbout: TMenuItem;
    OpenDialog1: TOpenDialog;
    StatusBar1: TStatusBar;
    SaveDialog1: TSaveDialog;
    FindDialog1: TFindDialog;
    ReplaceDialog1: TReplaceDialog;
    FontDialog1: TFontDialog;
    PopupMenu1: TPopupMenu;
    NPopSave: TMenuItem;
    NPopSaveAs: TMenuItem;
    NPopSep1: TMenuItem;
    NPopCut: TMenuItem;
    NPopCopy: TMenuItem;
    NPopPaste: TMenuItem;
    NPopSep2: TMenuItem;
    NPopFind: TMenuItem;
    NPopRepl: TMenuItem;
    ActionList1: TActionList;
    ACreate: TAction;
    TBCreate: TToolButton;
    ImageList1: TImageList;
    TBOpen: TToolButton;
    AOpen: TAction;
    ASave: TAction;
    TBSave: TToolButton;
    ASaveAs: TAction;
    AExit: TAction;
    TBDic: TToolButton;
    AFont: TAction;
    TBFont: TToolButton;
    AFind: TAction;
    AReplace: TAction;
    EditCut: TEditCut;
    EditCopy: TEditCopy;
    EditPaste: TEditPaste;
    EditUndo: TEditUndo;
    EditSelectAll: TEditSelectAll;
    ADeleBreaks: TAction;
    ASpeak: TAction;
    APause: TAction;
    AStop: TAction;
    TBSpeak: TToolButton;
    TBPause: TToolButton;
    TBStop: TToolButton;
    Label1: TLabel;
    Edit1: TEdit;
    trSpeed: TUpDown;
    Label2: TLabel;
    Edit2: TEdit;
    trPitch: TUpDown;
    TBUnDo: TToolButton;
    TBCut: TToolButton;
    TBCopy: TToolButton;
    TBPaste: TToolButton;
    TBFind: TToolButton;
    TBRepl: TToolButton;
    TBDeleBreaks: TToolButton;
    TBFormat: TToolButton;
    EditDelete: TEditDelete;
    TBDelete: TToolButton;
    NEditDelete: TMenuItem;
    AParag: TAction;
    NFormatParag: TMenuItem;
    NPopDel: TMenuItem;
    ToolButton1: TToolButton;
    ToolButton3: TToolButton;
    ProgressBar1: TProgressBar;
    TBMP3: TToolButton;
    NFileSep3: TMenuItem;
    ABackGround: TAction;
    NFormatSep2: TMenuItem;
    NFormatBack: TMenuItem;
    ColorDialog1: TColorDialog;
    NPrefs: TMenuItem;
    ASetPrefs: TAction;
    AEditDic: TAction;
    TBHelp: TToolButton;
    AHelp: TAction;
    AAbout: TAction;
    NPrefsCom: TMenuItem;
    NPrefstDic: TMenuItem;
    OpenDialog3: TOpenDialog;
    ADic: TAction;
    NSpeakDic: TMenuItem;
    AChangeText: TAction;
    NPrefsChangeText: TMenuItem;
    AMP3: TAction;
    NPrefsSep2: TMenuItem;
    NFileMP3: TMenuItem;
    ASeries: TAction;
    NPrefsSeries: TMenuItem;
    NPrefsSep1: TMenuItem;
    AWrapText: TAction;
    NFormatWrap: TMenuItem;
    NFormatSep1: TMenuItem;
    NFileRecent: TMenuItem;
    NSpeakSep1: TMenuItem;
    ACBSpeak: TAction;
    NSpeakSpeakCB: TMenuItem;
    APrintNP: TAction;
    NFileSep1: TMenuItem;
    PrintDialog1: TPrintDialog;
    SpVoice: TSpVoice;
    TimerNextFragment: TTimer;
    SpFileStream: TSpFileStream;
    ToolButton4: TToolButton;
    TBSAPI: TToolButton;
    lbSAPI: TLabel;
    NSpeakSep3: TMenuItem;
    NSpeakSAPI: TMenuItem;
    ASAPI: TAction;
    OpenDialog4: TOpenDialog;
    ABatch: TAction;
    ANames: TAction;
    ARulesFull: TAction;
    NPrefsSep4: TMenuItem;
    NPrefsStat: TMenuItem;
    NPrefsStat2: TMenuItem;
    AChangeTextFull: TAction;
    N2: TMenuItem;
    NPopUndo: TMenuItem;
    N4: TMenuItem;
    NPopSeleAll: TMenuItem;
    RichEdit2: TRichEdit;
    PopupMenu2: TPopupMenu;
    NPop2SaveAs: TMenuItem;
    MenuItem5: TMenuItem;
    NPop2Copy: TMenuItem;
    NPop2SeleAll: TMenuItem;
    AStatClose: TAction;
    NPop2Close: TMenuItem;
    NPrefsStat1: TMenuItem;
    NPrefsStat3: TMenuItem;
    AStatSaveAs: TAction;
    AFMinus: TAction;
    NPrefsStat4: TMenuItem;
    AHunt: TAction;
    N3: TMenuItem;
    AFMutual: TAction;
    AFUnion: TAction;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    NPop2CBAloud: TMenuItem;
    N10: TMenuItem;
    NPopCBAloud: TMenuItem;
    NPopRulesToText: TMenuItem;
    N13: TMenuItem;
    NPopChangeText: TMenuItem;
    N15: TMenuItem;
    AFreshEye: TAction;
    N16: TMenuItem;
    AOrfo: TAction;
    AEditOrfo: TAction;
    AZoom: TAction;
    NPrefsSep5: TMenuItem;
    NPrefsZoom: TMenuItem;
    ARulesToText: TAction;
    NPrefsRulesToText: TMenuItem;
    NPopEditDic: TMenuItem;
    NZaklad: TMenuItem;
    AZakAdd: TAction;
    AZakGo: TAction;
    NZakladAdd: TMenuItem;
    NZakladGo: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N14: TMenuItem;
    NPrefsOrfo: TMenuItem;
    NPrefsOrfo1: TMenuItem;
    NPrefsOrfo2: TMenuItem;
    AProfileSave: TAction;
    AProfileLoad: TAction;
    NPrefsProfiles: TMenuItem;
    N9: TMenuItem;
    N17: TMenuItem;
    AProfileDefault: TAction;
    N18: TMenuItem;
    ASelSpeak: TAction;
    NSpeakSpeakSel: TMenuItem;
    NPopSpeakSel: TMenuItem;
    AUpperCase: TAction;
    ALowerCase: TAction;
    NEditChangeSel: TMenuItem;
    NEditChangeSel1: TMenuItem;
    NEditChangeSel2: TMenuItem;
    NPopChangeSel: TMenuItem;
    NPopChangeSel1: TMenuItem;
    NPopChangeSel2: TMenuItem;
    ANumToPhrase: TAction;
    NEditChangeSel3: TMenuItem;
    N19: TMenuItem;
    AMSWord: TAction;
    MSWord1: TMenuItem;
    Splitter1: TSplitter;
    Panel1: TPanel;
    Image1: TImage;
    APicLargeSmall: TAction;
    NPrefsPic: TMenuItem;
    ToolBar3: TToolBar;
    TBPrev: TToolButton;
    TBNext: TToolButton;
    TBDele: TToolButton;
    TBDeleAll: TToolButton;
    cbX: TComboBox;
    ComboBox1: TComboBox;
    N1: TMenuItem;
    ATxtProp: TAction;
    N20: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure FormHeadSAPI4(Sender: TObject);
    procedure FormHeadSAPI5(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ACreateExecute(Sender: TObject);
    procedure AOpenExecute(Sender: TObject);
    procedure XOpen(Sender: TObject; var sFileName: string);
    procedure APicLargeSmallExecute(Sender: TObject);
    procedure PicLarge(Sender: TObject);
    procedure PicSmall(Sender: TObject);
    procedure PicShow(Sender: TObject);
    procedure PrevClick(Sender: TObject);
    procedure NextClick(Sender: TObject);
    procedure DeleClick(Sender: TObject);
    procedure DeleAllClick(Sender: TObject);
    procedure ASaveExecute(Sender: TObject);
    procedure ASaveAsExecute(Sender: TObject);
    procedure AStatSaveAsExecute(Sender: TObject);
    procedure APrintNPExecute(Sender: TObject);
    procedure AMSWordExecute(Sender: TObject);
    procedure AMP3Execute(Sender: TObject);
    procedure ABatchMP3Execute(Sender: TObject);
    procedure MP3(Sender: TObject);
    procedure BatchMP3(Sender: TObject; var FList: TStringList);
    procedure AExitExecute(Sender: TObject);
    procedure AResizeExecute(Sender: TObject);
    procedure AFindExecute(Sender: TObject);
    procedure FindDialog1Find(Sender: TObject);
    procedure AReplaceExecute(Sender: TObject);
    procedure ReplaceDialog1Replace(Sender: TObject);
    procedure ADeleBreaksExecute(Sender: TObject);
    procedure AUpperCaseExecute(Sender: TObject);
    procedure ALowerCaseExecute(Sender: TObject);
    procedure ANumToPhraseExecute(Sender: TObject);
    procedure ASpeakExecute(Sender: TObject);
    procedure TimerNextFragmentTimer(Sender: TObject);
    procedure ASelSpeakExecute(Sender: TObject);
    procedure ACBSpeakExecute(Sender: TObject);
    procedure APauseExecute(Sender: TObject);
    procedure AStopExecute(Sender: TObject);
    procedure AParagExecute(Sender: TObject);
    procedure AFontExecute(Sender: TObject);
    procedure ABackGroundExecute(Sender: TObject);
    procedure AWrapTextExecute(Sender: TObject);
    procedure RichEdit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure RichEdit1KeyPress(Sender: TObject; var Key: Char);
    procedure RichEdit1SelChange(Sender: TObject);
    procedure RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure EditKeyPress(Sender: TObject; var Key: Char);
    procedure StatusExecute(Sender: TObject);
    procedure DisplayHint(Sender: TObject);
    function RunExtern(App: string; Left,Top,W,H: integer; WinState: word): THandle;
    function DeleteDirectory(DirPath: string): boolean;
    procedure ConvertWav(InputWAV, OutputAudio: string);
    procedure AAboutExecute(Sender: TObject);
    procedure ASetPrefsExecute(Sender: TObject);
    procedure GetGeneralPrefs(Sender: TObject);
    procedure GetOtherPrefs(Sender: TObject);
    procedure SavePrefs(Sender: TObject);
    procedure ADicExecute(Sender: TObject);
    procedure TBDicOpen(Sender: TObject);
    procedure TBDicShut(Sender: TObject);
    procedure DicPrepare(Sender: TObject);
    procedure GetTags(Sender: TObject);
    procedure AZakAddExecute(Sender: TObject);
    procedure AZakGoExecute(Sender: TObject);
    procedure AHelpExecute(Sender: TObject);
    procedure ASAPIExecute(Sender: TObject);
    procedure Filter(Sender: Tobject; var BufRich: string; IgnRul: boolean;
                     Fancy: boolean = False);
    procedure CheckWord(Sender: TObject; var Words: TStringList;
                        var j: integer; N: integer; var RuleUsed: string);
    procedure AChangeTextExecute(Sender: TObject);
    procedure ARulesToTextExecute(Sender: TObject);
    procedure AOrfoExecute(Sender: TObject);
    procedure AEditOrfoExecute(Sender: TObject);
    procedure ASeriesExecute(Sender: TObject);
    procedure MakeSeries(Sender: TObject; var FList: TStringList; DirExt: string = '');
    procedure REAppFromTS(var RE: TRichEdit; var TS: TStringList);
    procedure NameFromFirstLines(var RE: TRichEdit; var Name: string);
    procedure ANamesExecute(Sender: TObject);
    procedure ARulesFullExecute(Sender: TObject);
    procedure AChangeTextFullExecute(Sender: TObject);
    procedure AFMinusExecute(Sender: TObject);
    procedure AFMutualExecute(Sender: TObject);
    procedure AFUnionExecute(Sender: TObject);
    procedure FOper(Sender: TObject; Mode: integer);
    procedure AHuntExecute(Sender: TObject);
    procedure AFreshEyeExecute(Sender: TObject);
    procedure ATxtPropExecute(Sender: TObject);
    procedure AStatCloseExecute(Sender: TObject);
    procedure AProfileSaveExecute(Sender: TObject);
    procedure AProfileLoadExecute(Sender: TObject);
    procedure AProfileDefaultExecute(Sender: TObject);
    procedure trSpeedChange(Sender: TObject);
    procedure trPitchChange(Sender: TObject);
    procedure AEditDicExecute(Sender: TObject);
    procedure JoinList(var Words: TStringList; var S: string; IgnRul: boolean;
                       Fancy: boolean = False);
    procedure AddRecentClearItem(Sender: TObject);
    procedure RecentLoad(Sender: TObject);
    procedure RecentSave(Sender: TObject);
    procedure RecentChange(Sender: TObject);
    procedure RecentClick(Sender: TObject);
    procedure ForbidUserFeatures(Sender : TObject);
    procedure UnForbidUserFeatures(Sender : TObject);
    procedure GetSAPI(Sender: TObject);
    procedure VoicesListCreate(Sender: TObject);

    procedure SpVoiceStartStream(Sender: TObject; StreamNumber: Integer;
      StreamPosition: OleVariant);
    procedure SpVoiceEndStream(Sender: TObject; StreamNumber: Integer;
      StreamPosition: OleVariant);
//  procedure SpVoiceSentence(Sender: TObject; StreamNumber: Integer;
//    StreamPosition: OleVariant; CharacterPosition, Length: Integer);
    procedure SpVoiceWord(Sender: TObject; StreamNumber: Integer;
      StreamPosition: OleVariant; CharacterPosition, Length: Integer);
    procedure AZoomExecute(Sender: TObject);

    procedure AlternatePaste(Sender: TObject);

  private
    { Private declarations }
//  OldSentencePos, OldSentenceLen: Integer;
    GlobalStartPos: Integer;         {Начальная позиция для слежения за чтением}
    Frag: TStringList;               {Элементы списка - последовательные
                                      фрагменты текста}
    FragPos: TStringList;            {Начальные позиции фрагментов}
    TF: integer;                     {Порядковый номер фрагмента}
    WaitNextFragment: boolean;       {Флаг перехода к чтению следующего фрагмента}
    AudioStop: boolean;              {Флаг экстренного прерывания записи аудио}

    /////////////////////////////////// SAPI4 //////////////////////////////////
    fITTSCentral: ITTSCentral;       {Центральный интерфейс, через который
                                      производится все дейстивия с речью}
    fTTSNotifySink : ITTSNotifySink; {Уведомления о состоянии чтения}
    fTTSBufNotifySink : ITTSBufNotifySink; {уведомления о состоянии буфера чтения}
    fIAMM: IAudioMultimediaDevice;   {Интерфейс для связи с аудио устройством}
    fIAF: IAudioFile;                {Интерфейс для связи с аудиофайлом}
    aTTSEnum: ITTSEnum;              {Интерфейс для перебора движков}
    fpModeInfo: PTTSModeInfo;        {Указатель на параметры движка}
    fITTSAttributes: ITTSAttributes; {Интерфейс для работы с атрибутами речи -
                                      скоростью, высотой и т.д.}
    fITTSDialogs: ITTSDialogs;       {Интерфейс для работы со стандартными
                                      диалогами движков}
    fhKey: Cardinal;
    fdwKey: DWord;
    ////////////////////////////////////////////////////////////////////////////

//  procedure SetTextHilite(FirstChar, Len: Integer);
//  procedure SetTextStyle(FirstChar, Len: Integer; Styles: TFontStyles);
    procedure TTSStart(S: string);
    procedure TTSPause;
    procedure TTSResume;
    procedure TTSStop;
    procedure TTSGoToNextFragment;
    procedure WriteSAPI5Audio(wFile: string);

    procedure DragText(var Message: TWMDROPFILES); message WM_DROPFILES;

    procedure OnFormMinimize(var Msg: TMessage); message WM_SYSCOMMAND;
    procedure OnMinimizeProc(Sender:TObject);
    procedure OnRestoreProc(Sender:TObject);

    procedure AutoCap;
    procedure AutoAloud;
    procedure AutoRepl(Mode: integer);

    function GetScale: Integer;
    procedure SetScale(Value: Integer);
    property Scale: integer read GetScale write SetScale;

    procedure OnHotKey(var Msg: TWMHotKey); message WM_HOTKEY;

  public
    { Public declarations }
    Speak: boolean;
    CBSpeak: boolean;         {True - если надо отключить слежение за текстом}
    Pause: Boolean;
    ModeIO: Byte;             {0 - звуковая карта; 1 - аудиофайл}
    WaveFile: String;
    SpeedAudio: integer;
    MaxSpeedVoice: DWord;
    MinSpeedVoice: DWord;
    MaxPitchVoice: Word;
    MinPitchVoice: Word;
    MaxVolumeVoice: DWord;
    MinVolumeVoice: DWord;
    SpeedVoice: DWord;        {скорость речи, установленная в движке по умолчанию}
    SelSpeedVoice: DWord;     {а это - взятая из ini-файла}
    PitchVoice: Word;         {высота (тембр) речи - по умолчанию}
    SelPitchVoice: Word;      {из ini-файла}
    SelVoice: Word;           {собственно, номер выбранного движка}
    P: DWord;
    LineNum: integer;
    CharPos: integer;
    SelColor: integer;
    FontStyleInt: byte;
    FS: TFontStyles;
    Dic: TStringList;
    PubDicName: string;       {Это всего-лишь глоабльное имя словаря = sDicName}
    StartDir: string;         {Каталог запуска программы}
    BookMarks: string;        {Хранит позиции закладок в тексте}
    AudioConverter: integer;  {Аудио-конвертер: 0 - нет, 1 - LAME, 2 - OGG}
  end;

//////////////////////////////////// SAPI4 /////////////////////////////////////
TTSBufNotifySink = class(TInterfacedObject, ITTSBufNotifySink)
  private
    FForm: TForm1;
    //FOldPos: DWord;
    FinishedTalking: Boolean;
  protected
    function TextDataDone(qTimeStamp: QWORD; dwFlags: DWORD): HResult; stdcall;
    function TextDataStarted(qTimeStamp: QWORD): HResult; stdcall;
    function BookMark(qTimeStamp: QWORD; dwMarkNum: DWORD): HResult; stdcall;
    function WordPosition(qTimeStamp: QWORD; dwByteOffset: DWORD): HResult; stdcall;
  public
    constructor Create(Form: TForm1);
  end; {конец объявления класса TTSBufNotifySink}

TTSNotifySink = class(TInterfacedObject, ITTSNotifySink)
  private
    FForm : TForm1;
  protected
   function AttribChanged(dwAttribute: DWORD) : HResult; stdcall;
   function AudioStart(qTimeStamp: QWORD) : HResult; stdcall;
   function AudioStop(qTimeStamp: QWORD) : HResult; stdcall;
   function Visual(qTimeStamp: QWORD;
                   cIPAPhoneme: Char;
                   cEnginePhoneme: Char;
                   dwHints: DWORD;
                   apTTSMouth: PTTSMouth) : HResult; stdcall;
  public
    constructor create(Form : TForm1);
  end; {конец объявления класса TTSNotifySink}
////////////////////////////////////////////////////////////////////////////////

const
  EM_GETSCALE = (WM_USER + 224);
  EM_SETSCALE = (WM_USER + 225);

var
  Form1: TForm1;
  abuffer: array[0..255] of char;  {Здесь запоминается имя перетаскиваемого ф-ла}

implementation

uses About, Prefs, EDic, EOrfo, Lens, Zaklad;

{$R *.DFM}

var
  sFileName: string = '';                       {Имя текстового файла}
  GalleryFolder: string ='';                    {Папка для картинок к этому тексту}
  Pictures: TStringList;                        {Список всех картинок для данного текста}
  IPic: integer = 0;                            {Номер главной картинки в списке}
  PicImport: boolean = False;                   {Извлекать и показывать картинки из doc, rtf, fb2, html?}
  NPicMargin: integer = 550;                    {Отступ графической области от левого края текстового окна}
  wFileName: PWideChar;                         {Имя выходного аудиофайла}
  BufRich: string = '';                         {Буфер чтения}
  XXX: TStringList;                             {Словарная хеш-таблица}
  Delta: real = 1;                              {!Поправка для слежения за чтением, когда включен словарь}
  sDicName: string = '';                        {Имя файла словаря}
  BRate, Qual: integer; AllPar: string;         {Параметры аудио-конвертера}
  ConvMinimize: boolean = False;                {Запускать конвертер, свернутым в значок}
  AudioFromTop: boolean = True;                 {Записывать аудио с начала текста, где бы ни был курсор}
  AudioSplit: boolean = True;                   {Записывать аудио частями (как сериал)}
  Abzac, MaxL, HugeL: integer;                  {Параметры литературного текста}
  RJust: boolean;                               {Флаг выравнивания текста справа}
  _E_, _Z_, _S_, _D_, _XD_, _C_, _XC_: string;  {Теги "стильной речи"}
  _CENZ_, _INIT_: string;
  IgnRul: boolean;                              {Игнорировать ли их?}
  IgnPrev: boolean;                             {Открывать ли предыдущий файл?}
  NB: integer;                                  {Размер блока для создании сериала}
  Bheader: boolean;                             {Вставлять ли вверху номер блока}
  NewChap: boolean;                             {Флаг строки - начала главы}
  MRecent: array[0..15] of TMenuitem;           {Недавно открытые файлы}
  SAPI5_Flag: boolean = False;                  {Какой SAPI использовать}
  SAPIChanged: boolean = False;                 {Флаг смены SAPI}
  Happy: boolean;                               {SAPI5 - OK?}
  FragSize: integer;                            {Размер читаемого фрагмента текста}
  BatGo: boolean = False;                       {Выполняется ли пакетная запись аудио...}
  IBat: integer = 0;                            {...для пакета с этим номером...}
  NBat: integer = 0;                            {...из общего числа пакетов}
  BatNext: boolean = False;                     {...Начать запись следующего ф-ла пакета}
  FEDeep: integer;                              {Глубина контекста в режиме "Свежий взгляд"}
  FESim: real;                                  {Там же: мин. уровень схожести слов}
  XML: boolean;                                 {Обрабатывать ли теги SAPI5?}
  Form_Status: word = SW_SHOWNORMAL;            {Окно свернуто или нет? Параметр для RunExtern()}
  SafeExit: boolean = True;                     {Сохранять текущие настройки при выходе?}
  AutoCapFlag: boolean = False;                 {Флаг автокапитализации}
  AutoReplFlag: boolean = False;                {Флаг автозамены минуса на тире,
                                                 обычных кавычек на книжные,
                                                 3- точек подряд на символ многоточия}
  AutoParagFlag: boolean = False;               {Вставлять абзацный отступ по "Enter" и "пробел"}
  AutoAloudFlag: boolean = False;               {Читать ли введенный текст:}
  AutoAloudPredl: boolean = True;               {предложениями}
  AutoAloudAbzac: boolean = False;              {абзацами}
  NRepeat: integer = 1;                         {повторяя несколько раз}
  PrevKey: char;                                {Предпоследняя нажатая при вводе текста клавиша}
  NScale: integer = 100;                        {Масштаб текста}
  OopsMsg: string = 'Неудачная попытка распределения динамической памяти. '+
                    'Причина: загруженные текст и словарь слишком велики. '+
                    'Работа программы сейчас будет завершена. Рекомендуется: '+
                    '1) разбить текст на части или задать его чтение блоками;; '+
                    '2) воспользоваться словарем меньшего размера.';
  Dollar, Star: boolean;                        {Флаги наличия в словаре управляющих символов $ и *}


{Вставка в текст из буфера обмена по глобальной горячей клавише,
нажатой в ЛЮБОМ Windows-приложении при запущенном Demagog'e}
procedure TForm1.OnHotKey(var Msg: TWMHotKey);
begin
  inherited;
  AlternatePaste(nil);
end;


{Стандартное действие Paste из ActionList НЕ требует обработчика для события
OnExecute! Но если прицепить вот этот, то вставка из буфера всегда выполняется
без лишних тегов, только текст и тем же шрифтом, что установлен в RichEdit}
procedure TForm1.AlternatePaste(Sender: TObject);
var
  Clipboard: TClipboard;
begin
  Clipboard := TClipboard.Create;
  Clipboard.AsText := Clipboard.AsText;  {!}
  RichEdit1.PasteFromClipboard;
end;


{Отлов масштаба текста, установленного  в RichEdit нажатием левой клавиши
мыши с одновременным вращением колесика}
function TForm1.GetScale: Integer;
var wp,lp: Integer;
begin
  Result := 100;
  SendMessage(Richedit1.Handle, EM_GETSCALE, Integer(@wp), Integer(@lp));
  if (lp > 0) then Result := MulDiv(100,wp,lp);
end;

{А это наоборот: для задания масштаба, прочитанного ранее из настроек}
procedure TForm1.SetScale(Value: Integer);
begin
  if Value = 0 then SendMessage(Richedit1.Handle, EM_SETSCALE, 0, 0)
               else SendMessage(Richedit1.Handle, EM_SETSCALE, Value, 100);
end;


{Отлов событий минимизации/восстановления/максимизации главной формы}
procedure TForm1.OnFormMinimize(var Msg: TMessage);
begin
  inherited;
  if Msg.WParam = SC_MINIMIZE then begin  {Отловили минимизацию}
    Form_Status := SW_MINIMIZE;
  end;
  if Msg.WParam = SC_RESTORE then begin   {Отловили восстановление}
    Form_Status := SW_SHOWNORMAL;
  end;
  if Msg.WParam = SC_MAXIMIZE then begin  {Отловили максимизацию}
    //не используется
  end;
end;

{Чтобы срабатывало через кнопку на панели задач}
procedure TForm1.OnMinimizeproc(Sender: TObject);
begin
  PostMessage( Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0 );
end;

procedure TForm1.OnRestoreProc(Sender: TObject);
begin
  PostMessage( Handle, WM_SYSCOMMAND, SC_RESTORE, 0 );
end;


procedure TForm1.GetSAPI(Sender: TObject);
var
  Ini: TIniFile;
begin
  Ini:=TiniFile.Create(extractfilepath(Application.ExeName)+'$.ini');
  SAPI5_Flag := Ini.ReadBool('SAPI','SAPI5',False);
  Ini.Free;
end;


procedure TForm1.VoicesListCreate(Sender: TObject);
var
  //////////// SAPI4 ///////////
  NumFound : DWord;
  ModeInfo : TTSModeInfo;
  //////////////////////////////
  i: integer;
  SOToken: ISpeechObjectToken;
  SOTokens: ISpeechObjectTokens;
begin
  ComboBox1.Clear;
  if SAPI5_Flag then begin   {SAPI5}
    Happy := True;
    try
      {Инициализация аудио устройства}
      SOTokens := SpVoice.GetVoices('', '');
    except
      Application.MessageBox('Не найден речевой драйвер Microsoft SAPI5',
                             'Demagog',MB_ICONINFORMATION);
      Happy := False;
    end;
    if Happy then begin
      {Перебор всех движков в системе}
      SpVoice.EventInterests := SVEAllEvents;
      for I := 0 to SOTokens.Count - 1 do begin
        {Дескриптор каждого голоса запоминаем в TStrings list}
        SOToken := SOTokens.Item(I);
        ComboBox1.Items.AddObject(SOToken.GetDescription(0), TObject(SOToken));
        {Увеличиваем счетчик ссылок на дескриптор, чтобы гарантировать что он не разрушен}
        SOToken._AddRef;
      end;
      if ComboBox1.Items.Count > 0 then begin
        ComboBox1.ItemIndex := 0; {Выбираем 1-й голос}
        ComboBox1.OnChange(ComboBox1); {Гарантируем срабатывание OnChange триггеров}
      end;
      trSpeed.Position := SpVoice.Rate;
    end;
  end else begin   {SAPI4}
  //////////////////////////////////////////////////////////////////////////////
    try
      {Инициализация аудио устройства}
      OleCheck(CoCreateInstance(CLSID_MMAudioDest, Nil, CLSCTX_ALL, IID_IAudioMultiMediaDevice, fIAMM));
      OleCheck(fIAMM.DeviceNumSet(WAVE_MAPPER));
    except
    end;
    {Создание перечисляемого объекта для перебора движков с помощью интерфейса ITTSEnum}
    CoCreateInstance(CLSID_TTSEnumerator, Nil, CLSCTX_ALL, IID_ITTSEnum, aTTSEnum);
    if aTTSEnum <> nil then begin
      aTTSEnum.Reset;  {Сбрасываем на первый}
      aTTSEnum.Next(1, ModeInfo, @NumFound); {Получаем первый движок}
      while NumFound > 0 do begin
         ComboBox1.Items.Add(String(ModeInfo.szModeName));
         aTTSEnum.Next(1, ModeInfo, @NumFound); {Получаем остальные}
      end;
      ComboBox1.ItemIndex := 0;
      ComboBox1.OnChange(ComboBox1);
    end
    else Application.MessageBox('Не найден речевой драйвер Microsoft SAPI4',
                                'Demagog',MB_ICONINFORMATION);
  //////////////////////////////////////////////////////////////////////////////
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  Pictures := TStringList.Create;
  Pictures.Sorted := True;
  RegisterHotKey(Handle, 1, MOD_CONTROL, VK_ADD); {Ctrl+"плюс на Num-клавиатуре"}
  RegisterHotKey(Handle, 2, MOD_CONTROL, 187); {Ctrl+"плюс или ="}
  Application.onMinimize := OnMinimizeProc;  {Чтобы срабатывало по нажатию}
  Application.onRestore := OnRestoreProc;    {кнопки в панели задач}
  //GetDir(0,StartDir);
  StartDir := ExtractFilePath(PChar(Application.ExeName));
  Application.OnHint := DisplayHint;
  RecentLoad(Sender);
  StatusExecute(Sender);
  RichEdit1SelChange(Sender);
  if not FileExists(StartDir+'\~orfo~') then begin
    NPrefsOrfo.Enabled := False;
    NPrefsOrfo.Visible := False;
  end;
  Speak := False;
  CBSpeak := False;
  Pause := False;
  Frag := TStringList.Create;
  FragPos := TStringList.Create;
  TF := 0;
  GetSAPI(Sender);  {Устанавливаем SAPI5_Flag и от него танцуем дальше}
  VoicesListCreate(Sender);
  ModeIO := 0; {По умолчанию - чтение вслух}
  GetOtherPrefs(Sender);   {LAME, лит.текст, стильная речь}
  GetGeneralPrefs(Sender); {Положение и размеры окна, шрифт, фон}
  Form1.Scale := NScale;   {Назначаем масштаб текста в окне}
  RichEdit1.Modified := False;
  if sDicName = ''  {Вид кнопки словаря}
    then TBDicShut(Sender)
    else TBDicOpen(Sender);
  if BookMarks = '' then NZakladGo.Enabled := False;
  if sFileName = '' then NPrefsSeries.Enabled := False;
  Splitter1.Enabled := False;
  if (SAPI5_Flag and Happy) or (not SAPI5_Flag and (aTTSEnum <> nil)) then ComboBox1Change(Self);
  StatusExecute(Sender);
  DragAcceptFiles(Form1.Handle,True); {сообщаем, что готовы к приему файлов Drag&Drop}
end;


procedure TForm1.FormDestroy(Sender: TObject);
var
  i: integer;
begin
  UnregisterHotKey(Handle, 1); {Снятие регистрации глобальной горячей клавиши}
  UnregisterHotKey(Handle, 2); 
  Frag.Free;
  FragPos.Free;
  Pictures.Free;
  if SAPI5_Flag then  {Освободить все голосовые объекты SAPI5}
    for i := 0 to ComboBox1.Items.Count - 1 do
      if ComboBox1.Items.Objects[i] <> nil then
        ISpeechObjectToken(Pointer(ComboBox1.Items.Objects[i]))._Release;
  if SafeExit then SavePrefs(Sender);
end;


procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean);
var
  res: integer;
begin
  if (RichEdit1.Modified) then begin
    res:=Application.MessageBox('Текст в окне был изменен. Сохранить?',
                                'Demagog',MB_YESNOCANCEL);
    case (res) of
      IDYES:    begin ASaveExecute(Sender); AExitExecute(Sender); end;
      IDCANCEL: CanClose := False;
    end;
  end;
end;


procedure TForm1.FormHeadSAPI4(Sender: TObject);
begin
  Label2.Visible := True;
  Edit2.Visible := True;
  trPitch.Visible := True;
  cbX.Width := 70;
  Label1.Left := 408;
  Edit1.Left := 471;
  trSpeed.Left := 521;
  Label2.Left := 537;
  Edit2.Left := 585;
  trPitch.Left := 635;
  cbX.Items.SetText(PChar(SAPI4cbX()));
  if SpeedAudio < 0 then cbX.ItemIndex := 7 //2
                    else cbX.ItemIndex := SpeedAudio;
end;


procedure TForm1.FormHeadSAPI5(Sender: TObject);
begin
  Label2.Visible := False;
  Edit2.Visible := False;
  trPitch.Visible := False;
  cbX.Width := 184;
  Label1.Left := 522;
  Edit1.Left := 585;
  trSpeed.Left := 635;
  trSpeed.Position := 0;
  cbX.Items.SetText(PChar(SAPI5cbX()));
  if SpeedAudio < 0 then cbX.ItemIndex := 18
                    else cbX.ItemIndex := SpeedAudio;
end;


{Здесь инициализируется TTS-интерфейс}
procedure TForm1.ComboBox1Change(Sender: TObject);
var
  /////////// SAPI4 //////////
  NumFound: DWord;
  ModeInfo : TTSModeInfo;
  ////////////////////////////
  SOToken: ISpeechObjectToken;
begin
  if SAPI5_Flag then begin  {SAPI5}
    try
      FormHeadSAPI5(Sender);
      trSpeed.Min := -10;  {в SAPI5 ВСЕ движки имеют одинаковые..}
      trSpeed.Max := 10;   {..диапазоны скорости [-10,10] и громкости [0,100]}
      {Регулировку громкости отдаем системе, а Pitch (Тембр) движка в SAPI5 отсутствует}
      SOToken := ISpeechObjectToken(Pointer(
                                    ComboBox1.Items.Objects[ComboBox1.ItemIndex]));
      SpVoice.Voice := SOToken;
    except
    end;
  end else begin  {SAPI4}
  //////////////////////////////////////////////////////////////////////////////
  try
    FormHeadSAPI4(Sender);
    if ModeIO = 0  {0-речь, 1-аудио}
      then CoCreateInstance(CLSID_MMAudioDest, Nil, CLSCTX_ALL, IID_IAudioMultiMediaDevice, fIAMM)
      else CoCreateInstance(CLSID_AudioDestFile, Nil, CLSCTX_ALL, IID_IAudioFile, fIAF);
    CoCreateInstance(CLSID_TTSEnumerator, Nil, CLSCTX_ALL, IID_ITTSEnum, aTTSEnum);
    aTTSEnum.Reset;
    Form1.aTTSEnum.skip(ComboBox1.ItemIndex); {Переходим на нужный движок}
    aTTSEnum.Next(1, ModeInfo, @NumFound);
    if assigned(fpModeInfo) then dispose(fpModeInfo);
    new(fpModeInfo);
    fpModeInfo^:=ModeInfo;
    //--------- Обход фатальной ошибки движка Loquento Olga под SAPI4 ----------
    if (ComboBox1.Items[ComboBox1.ItemIndex] = 'Olga 8000 A') or
       (ComboBox1.Items[ComboBox1.ItemIndex] = 'Olga 8000 U') then begin
       fITTSCentral := nil;
       exit; {иначе нижеследующий aTTSEnum.Select завалит прогу через division by zero}
    end;
    //--------------------------------------------------------------------------
    if ModeIO = 0  {Загружаем движок для чтения вслух или выдачи в аудио}
      then aTTSEnum.Select(fpModeInfo^.gModeID, fITTSCentral, IUnknown(fIAMM))
      else aTTSEnum.Select(fpModeInfo^.gModeID, fITTSCentral, IUnknown(fIAF));
    try {Создаем объект уведомлений о состоянии буфера чтения. Для организации "слежения" за читаемым текстом}
      fTTSBufNotifySink := TTSBufNotifySink.Create(Self);
    except
    end;
    try {Создаем объект уведомлений о состоянии чтения. Например, чтобы погасить выделение текста по окончании чтения}
      fTTSNotifySink := TTSNotifySink.Create(Self);
      if assigned(fITTSCentral) then  {!Иначе раздражающее AV при старте, если нет ни одного установленного движка}
      try
        OleCheck(fITTSCentral.Register(pointer(fTTSNotifySink), IID_ITTSNotifySink, fdwKey));
      except
        fTTSNotifySink := nil;
      end;
    except
    end;
    if assigned(fITTSCentral) then begin  {Проверяем связь переменной fITTSCentral с интерфейсом}
      if (TTSI_ITTSATTRIBUTES and fpModeInfo^.dwInterfaces) <> 0 then begin  {и поддержку атрибутов побитовым умножением}
        try  {Получаем интерфейс управления атрибутами чтения и проверяем..}
          OleCheck(fITTSCentral.QueryInterface(IID_ITTSAttributes, fITTSAttributes));
          if (TTSFEATURE_SPEED and fpModeInfo.dwFeatures) <> 0 then begin  {..поддержку изм. скорости побитовым умножением}
            if not(TTSERR_NOTSUPPORTED = fITTSAttributes.SpeedGet(SpeedVoice)) then begin {поддерживается ли получение скорости..}
              if not(TTSERR_NOTSUPPORTED = fITTSAttributes.SpeedSet(P)) then begin  {..и ее изменение}
                fITTSAttributes.SpeedSet(TTSATTR_MINSPEED);  {Узнаём диапазон изменени скорости, переключая движок на min..}
                fITTSAttributes.SpeedGet(MinSpeedVoice);
                fITTSAttributes.SpeedSet(TTSATTR_MAXSPEED);  {..max и читаем в MinSpeedVoice, MaxSpeedVoice}
                fITTSAttributes.SpeedGet(MaxSpeedVoice);
                fITTSAttributes.SpeedSet(SpeedVoice);  {восстанавливаем текущее значение скорости}
                trSpeed.Enabled := True;
                trSpeed.Max := MaxSpeedVoice;
                trSpeed.Min := MinSpeedVoice;
              end;
            end;
          end
          else begin
            trSpeed.Enabled := False;
          end;
          {С тембром - аналогично!}
          if (TTSFEATURE_PITCH and fpModeInfo.dwFeatures) <> 0 then begin
            if not(TTSERR_NOTSUPPORTED = fITTSAttributes.PitchGet(PitchVoice)) then begin
              if not(TTSERR_NOTSUPPORTED = fITTSAttributes.PitchSet(P)) then begin
                fITTSAttributes.PitchSet(TTSATTR_MINPITCH);
                fITTSAttributes.PitchGet(MinPitchVoice);
                fITTSAttributes.Pitchset(TTSATTR_MAXPitch);
                fITTSAttributes.PitchGet(MaxPitchVoice);
                fITTSAttributes.PitchSet(PitchVoice);
                trPitch.Enabled := True;
                trPitch.Max := MaxPitchVoice;
                trPitch.Min := MinPitchVoice;
              end;
            end;
          end
          else begin
            trPitch.Enabled := False;
          end;
        except
        end;
      end {if (TTSI_ITTSATTRIBUTES}
      else begin  {Иначе если атрибуты не поддерживаются, то...}
        try
          if assigned(fITTSAttributes) then fITTSAttributes := Nil;
          trSpeed.Enabled:=false;
          trPitch.Enabled:=false;
        except
          fITTSAttributes := Nil;
        end;
      end;
      {Проверяем поддержку движковых диалогов, и получаем ссылку на интерфейс, если поддерживается}
      if (TTSI_ITTSDIALOGS and fpModeInfo^.dwInterfaces) <> 0 then
        OleCheck(fITTSCentral.QueryInterface(IID_ITTSDialogs, fITTSDialogs));
    end; {end if assigned(fITTSCentral)}
  except
  end;
  //////////////////////////////////////////////////////////////////////////////
  end;
  {Если сменен движок в Combobox1 или смена SAPI, то скорость и тембр ставим по
  умолчанию и отключаем словарь. Иначе - параметры из настроек}
  if (SelVoice <> ComboBox1.ItemIndex) or SAPIChanged
    then begin
      if sDicName <> '' then begin
        sDicName := '';
        TBDicShut(Sender);
      end;
      SelVoice := ComboBox1.ItemIndex;
      if SAPI5_Flag and (SpeedVoice > 10) then SpeedVoice := 0;
      trSpeed.Position := SpeedVoice;
      trPitch.Position := PitchVoice;
      SAPIChanged := False;
    end
    else begin
      if SelSpeedVoice > 0 then trSpeed.Position := SelSpeedVoice
                           else trSpeed.Position := SpeedVoice;
      if SelPitchVoice > 0 then trPitch.Position := SelPitchVoice
                           else trPitch.Position := PitchVoice;
    end;
end;


{Изменение скорости чтения}
procedure TForm1.trSpeedChange(Sender: TObject);
begin
  if SAPI5_Flag then begin  {SAPI5}
    if not Happy then exit;
    SpVoice.Rate := trSpeed.Position;
  end else begin  {SAPI4}
    ///////////////////////////////////////////
    if not assigned(fITTSCentral) then exit;
    if aTTSEnum = nil then exit;
    fITTSAttributes.Speedset(trSpeed.Position);
    ///////////////////////////////////////////
  end;
  SelSpeedVoice := trSpeed.Position;  {Обновляем скорость, взятую из настроек}
end;

{Изменение тембра голоса}
procedure TForm1.trPitchChange(Sender: TObject);
begin
  if SAPI5_Flag then begin  {SAPI5}
    exit;
  end else begin  {SAPI4}
    /////////////////////////////////////////////////////////////////////////
    if not assigned(fITTSCentral) then exit;
    if aTTSEnum = nil then exit;
    fITTSAttributes.PitchSet(trPitch.Position);
    SelPitchVoice := trPitch.Position;  {Обновляем тембр, взятый из настроек}
    /////////////////////////////////////////////////////////////////////////
  end;
end;

procedure TForm1.TTSStart(S: string);
/////// SAPI4 //////
var SData: TSData;
////////////////////
begin
  if S = '' then exit;
  WaitNextFragment := False;
  if Speak then begin
    TTSStop;
    Speak := False;
    Frag.Clear;
    FragPos.Clear;
    TF := 0;
  end;
  Fragments(S,FragSize,Frag,FragPos);
  TF := 0;
  BufRich := Frag[TF];
  if sDicName <> '' then begin  {ИМЕЕТСЯ ЗАГРУЖЕННЫЙ СЛОВАРЬ!}
    Filter(nil,BufRich,IgnRul);
    if BufRich <> '' then Delta := (Length(Frag[TF]))/Length(BufRich);
  end;
  try
    if SAPI5_Flag then begin  {SAPI5}
      if XML then SpVoice.Speak(BufRich,SVSFlagsAsync+SVSFPurgeBeforeSpeak+SVSFIsXML)
             else SpVoice.Speak(BufRich,SVSFlagsAsync+SVSFPurgeBeforeSpeak+SVSFIsNotXML);
      Speak := True;
    end else begin  {SAPI4}
    ////////////////////////////////////////////////////////////////////////////
    if (ModeIO = 1) and (not Pause) and (TF = 0) then fIAF.DoSet(wFileName, fhKey);
    SData.dwSize := length(BufRich)+1;
    SData.pData := pChar(BufRich);
    {2-й параметр = 1, чтобы обрабатывались теги}
    fITTSCentral.TextData(CHARSET_TEXT, 1, SData, pointer(fTTSBufNotifySink),IID_ITTSBufNotifySink);
    Speak := True;
    ////////////////////////////////////////////////////////////////////////////
    end;
  except
    Application.MessageBox('Ошибка голосового движка','Demagog',MB_ICONERROR);
  end;
end;

procedure TForm1.TTSPause;
begin
  if SAPI5_Flag then SpVoice.Pause else fITTSCentral.AudioPause;
  Pause := True;
end;

procedure TForm1.TTSResume;
begin
  if SAPI5_Flag then SpVoice.Resume else fITTSCentral.AudioResume;
  Pause := False;
end;

procedure TForm1.TTSStop;
begin
 if Speak then begin
   Speak := False;
   if SAPI5_Flag then SpVoice.Speak('',SVSFPurgeBeforeSpeak)  {!!!}
                 else fITTSCentral.AudioReset;
   WaitNextFragment := False;
 end;
end;

procedure TForm1.TTSGoToNextFragment;
/////// SAPI4 //////
var SData: TSData;
////////////////////
begin
  WaitNextFragment := False;
  if (TF < Frag.Count-1) and Speak then begin  {Прочесть следующий фрагмент}
    Inc(TF);
    BufRich := Frag[TF];
    if sDicName <> '' then begin
      Filter(nil,BufRich,IgnRul);
      if BufRich <> '' then Delta := (Length(Frag[TF]))/Length(BufRich);
    end;
    try
      if SAPI5_Flag then begin  {SAPI5}
        if XML then SpVoice.Speak(BufRich,SVSFlagsAsync+SVSFPurgeBeforeSpeak+SVSFIsXML)
               else SpVoice.Speak(BufRich,SVSFlagsAsync+SVSFPurgeBeforeSpeak+SVSFIsNotXML);
      end else begin  {SAPI4}
        ////////////////////////////////////////////////////////////////////////
        SData.dwSize := length(BufRich)+1;
        SData.pData := pChar(BufRich);
        fITTSCentral.TextData(CHARSET_TEXT,1,SData,pointer(fTTSBufNotifySink),IID_ITTSBufNotifySink);
        ////////////////////////////////////////////////////////////////////////
      end;
    except
      Application.MessageBox('Ошибка голосового движка','Demagog',MB_ICONERROR);
    end;
  end
  else begin  {Все фрагменты прочитаны}
    TF:=0;
    Speak := False;
  end;
end;


procedure TForm1.WriteSAPI5Audio(wFile: string);
var
  i: integer;
  tp: OleVariant;
  OldSpeechBaseStream: ISpeechBaseStream;
  SpFileStreamOpen: boolean;
  AudioName: string;
begin
  WaitNextFragment := False;
  if Speak then begin
    if Pause then TTSResume;
    TTSStop;
    Frag.Clear;
    FragPos.Clear;
    TF:=0;
  end;
  Speak := True;
  StatusExecute(nil);
  SpFileStream.Format.type_ := cbX.ItemIndex+$00000004;  {!!!}
  TimerNextFragment.Enabled:=False;
  Speak := False;
  OldSpeechBaseStream := SpVoice.AudioOutputStream;
  BufRich:=Copy(RichEdit1.Text, RichEdit1.SelStart+1,
                          Length(RichEdit1.Text)-RichEdit1.SelStart);
  Fragments(BufRich,FragSize,Frag,FragPos);
  if Frag.Count = 0 then begin
    WaveFile := '';
    StatusExecute(nil);
    exit;
  end;
  ForbidUserFeatures(nil); TBPause. Enabled := False; NSpeakPause.Enabled := False;
  Application.ProcessMessages;
  TF:=0;
  SpFileStream.Open(wFile,SSFMCreateForWrite,False);
  SpFileStreamOpen:=True;
  tp:=SpFileStream.Seek(0,SSSPTRelativeToEnd);
  SpVoice.AllowAudioOutputFormatChangesOnNextSet := False;
  AudioStop := False;
  for i := 0 to Frag.Count-1 do begin
    TF := i;
    RichEdit1.SelLength := StrToInt(FragPos[i])+Length(Frag[i]);  {Прокрутка текста - для визуализации}
    RichEdit1.Perform(EM_SCROLLCARET,0,0);
    RichEdit1.SetFocus;
    BufRich := Frag[TF];
    if sDicName <> '' then Filter(nil,BufRich,IgnRul);  {Словарные замены}
    SpVoice.AudioOutputStream := SpFileStream.DefaultInterface;
    SpFileStream.Seek(tp, SSSPTRelativeToStart);
    try
      if XML then SpVoice.Speak(BufRich,SVSFPurgeBeforeSpeak+SVSFIsXML)
             else SpVoice.Speak(BufRich,SVSFPurgeBeforeSpeak+SVSFIsNotXML);
    except
      Application.MessageBox('Ошибка голосового движка','Demagog',MB_ICONERROR);
      break;
    end;
    tp := SpFileStream.Seek(0, SSSPTRelativeToCurrentPosition);
    Application.ProcessMessages;
    if AudioStop then break;
    Application.ProcessMessages;
  end;
  RichEdit1.SelLength := 0;
  if SpFileStreamOpen then SpFileStream.Close;
  SpVoice.AudioOutputStream := OldSpeechBaseStream;
  {Если был вывод в аудиофайл с автоконвертацией}
  case (AudioConverter) of
    1: AudioName := ChangeFileExt(WaveFile,'.mp3');
    2: AudioName := ChangeFileExt(WaveFile,'.ogg');
  end;
  //if AudioConverter > 0 then ConvertWav(WaveFile,AudioName);
  if AudioConverter > 0 then begin
    TBStop.Enabled := False;
    ConvertWav(WaveFile,AudioName);
    TBStop.Enabled := True;
  end;
  ModeIO := 0; 
  WaveFile := '';
  StatusExecute(nil);
  UnforbidUserFeatures(nil); TBPause. Enabled := True; NSpeakPause.Enabled := True;
  Speak := False;
  Pause := False;
end;



procedure TForm1.ASpeakExecute(Sender: TObject);
begin
  GlobalStartPos := RichEdit1.SelStart+1;
  CBSpeak := False;
  TimerNextFragment.Enabled := False;
  if (SAPI5_Flag and not Happy) or (not SAPI5_Flag and not assigned(fITTSCentral)) then begin
    Application.MessageBox('Не найден голосовой движок','Demagog',MB_ICONINFORMATION);
    exit;
  end;
  if Pause then begin
    TTSResume;
  end
  else begin
    {Формируем данные для чтения}
    BufRich:=Copy(RichEdit1.Text, RichEdit1.SelStart+1,
                          Length(RichEdit1.Text)-RichEdit1.SelStart);
    TTSStart(BufRich);
  end;
  TimerNextFragment.Enabled:=True;
  ForbidUserFeatures(Sender);
end;


procedure TForm1.TimerNextFragmentTimer(Sender: TObject);
begin
  TimerNextFragment.Enabled := False;
  if  Speak and WaitNextFragment then TTSGoToNextFragment;
  if  not Speak then begin
    UnForbidUserFeatures(Self);
    exit;
  end;
  TimerNextFragment.Enabled:=True;
end;


procedure TForm1.ASelSpeakExecute(Sender: TObject);
var
  S: string;
begin
  if (SAPI5_Flag and not Happy) or (not SAPI5_Flag and not assigned(fITTSCentral))
                                or (ModeIO = 1) then exit;
  if Pause then begin
    TTSResume;
  end
  else begin
    S := RichEdit1.SelText;
    if Length(S) > 65535 then exit;
    TTSStart(S);
    CBSpeak := True;  {Выключаем слежения за текстом}
  end;
  TimerNextFragment.Enabled:=True;
  StatusExecute(Sender);
  ForbidUserFeatures(Sender);
end;


procedure TForm1.ACBSpeakExecute(Sender: TObject);
var
  S: string;
  Clipboard: TClipboard;
begin
  if (SAPI5_Flag and not Happy) or (not SAPI5_Flag and not assigned(fITTSCentral))
                                or (ModeIO = 1) then exit;
  if Pause then begin
    TTSResume;
  end
  else begin
    Clipboard := TClipboard.Create;
    S := Clipboard.AsText;
    if Length(S) > 65535 then exit;
    TTSStart(S);
    CBSpeak := True;  {Выключаем слежения за текстом}
  end;
  TimerNextFragment.Enabled:=True;
  StatusExecute(Sender);
  ForbidUserFeatures(Sender);
end;


procedure TForm1.APauseExecute(Sender: TObject);
begin
  if Speak and not Pause then begin
    if (SAPI5_Flag and not Happy) or (not SAPI5_Flag and not assigned(fITTSCentral)) then begin
      Application.MessageBox('Не найден голосовой движок','Demagog',MB_ICONINFORMATION);
      exit;
    end;
    TimerNextFragment.Enabled := False;
    TTSPause;
    StatusExecute(Sender);
    UnForbidUserFeatures(Sender);
  end;
end;


procedure TForm1.AStopExecute(Sender: TObject);
begin
  AudioStop := True;
  if SAPI5_Flag and (ModeIO = 1) then exit;
  if Speak then begin
    if (SAPI5_Flag and not Happy) or (not SAPI5_Flag and not assigned(fITTSCentral)) then begin
      Application.MessageBox('Не найден голосовой движок','Demagog',MB_ICONINFORMATION);
      exit;
    end;
    TimerNextFragment.Enabled:=False;
    if Pause then TTSResume;
    TTSStop;
    {Как-то странно здесь работает caretpos.X - выдает позицию символа не от
     начала строки, а от начала выделения... Ну и хрен с ним. Достаточно строки}
    LineNum := RichEdit1.CaretPos.Y;
    CharPos := 0;
//    StatusExecute(Sender);
    UnForbidUserFeatures(Sender);
  end;
end;

{Во время чтения текста некоторые действия пользователя должны быть запрещены}
procedure TForm1.ForbidUserFeatures(Sender: TObject);
begin
  TBSpeak.Enabled := False;
  NSpeakSpeak.Enabled := False;
  TBDic.Enabled := False;
  NSpeakDic.Enabled := False;
  NSpeakSpeakCB.Enabled := False;
  TBPause. Enabled := True;
  NSpeakPause.Enabled := True;
  TBStop.Enabled := True;
  NSpeakStop.Enabled := True;
  TBFind.Enabled := False;
  NEditFind.Enabled := False;
  TBRepl.Enabled := False;
  TBDeleBreaks.Enabled := False;
  TBFormat.Enabled := False;
  NFormatParag.Enabled := False;
  TBFont.Enabled := False;
  RichEdit1.ReadOnly := True;
  TBMP3.Enabled := False;
  NFileMP3.Enabled := False;
  TBOpen.Enabled := False;
  NFileOpen.Enabled := False;
  TBCreate.Enabled := False;
  NFileCreate.Enabled := False;
end;

procedure TForm1.UnForbidUserFeatures(Sender: TObject);
begin
  TBSpeak.Enabled := True;
  NSpeakSpeak.Enabled := True;
  TBDic.Enabled := True;
  NSpeakDic.Enabled := True;
  NSpeakSpeakCB.Enabled := True;
  TBPause. Enabled := False;
  NSpeakPause.Enabled := False;
  TBStop.Enabled := False;
  NSpeakStop.Enabled := False;
  TBFind.Enabled := True;
  NEditFind.Enabled := True;
  TBRepl.Enabled := True;
  TBDeleBreaks.Enabled := True;
  TBFormat.Enabled := True;
  NFormatParag.Enabled := True;
  TBFont.Enabled := True;
  RichEdit1.ReadOnly := False;
  TBMP3.Enabled := True;
  NFileMP3.Enabled := True;
  TBOpen.Enabled := True;
  NFileOpen.Enabled := True;
  TBCreate.Enabled := True;
  NFileCreate.Enabled := True;
end;


{Кто объяснит мне, почему RichEdit.Lines.LoadFromFile() грузит DOS-текст
страшно медленно: 500кб за 2 минуты, а win-текст или KOI8-R - мгновенно?
А TStringList из файла грузится мгновенно, независимо от кодировки...}
procedure TForm1.XOpen(Sender: TObject; var sFileName: string);
var
  buf, ext, tmp, btyp, b, ImgFolder: string;
  txt, Bin, Img: TStringList;
  ms: TMemoryStream;
  CPModify: boolean;
  i,k: integer;
//  CurFont : TFont;
begin
  Bin := TStringList.Create;
  Img := TStringList.Create;
  CPModify := False;
  ext := AnsiLowerCase(ExtractFileExt(sFileName));
  //////////// Этот фрагмент извлекает рисунки из документов MS Word ///////////
  if PicImport and ((ext = '.doc') or (ext = '.docx') or (ext = '.rtf')) then begin
    tmp := sFileName;  {Запоминаем имя исходного документа Word}
    tmp := Doc2Htm(tmp);  {Возвращено имя сконвертированного htm-файла...}
    if tmp <> '' then DeleteFile(tmp);  {...и тут его удаляем. Но после него остается папка}
                                        {с тем же именеми и расширением .files, содержащая рисунки!}
  end;
  //////////////////////////////////////////////////////////////////////////////
  if (ext = '.doc') or (ext = '.docx') then begin  {Тут заведомо будет Win-кодировка!}
    sFileName := Doc2Txt(sFileName);  {Возвращено имя сконвертированного текстового ф-ла}
    if sFileName = '' then begin
      Application.MessageBox('Не найден Microsoft Word',
                             'Demagog',MB_ICONINFORMATION);
      exit;
    end;
    RichEdit1.Lines.LoadFromFile(sFileName);
    StatusExecute(Sender);
    exit;
  end;
  {Иначе грузим файл хитрым способом}
  txt := TStringList.Create;
  ms := TMemoryStream.Create;
  try
    txt.LoadFromFile(sFileName);
  except
    exit;
  end;
  buf := txt.GetText;
  if ext = '.rtf' then begin  {Тоже Win-кодировка. Но rtf надо почистить}
    RichEdit1.Text := buf;
    RichEdit1.Lines.SaveToStream(ms);
    RichEdit1.Clear;  {!}
    ms.Seek(0, soFromBeginning);
    RichEdit1.Lines.LoadFromStream(ms);
//    with RichEdit1 do begin   //Альтернативный метод, позволяет обработать
//      CurFont := Font;        //даже rtf, записанный "неправильным" ttf-шрифтом
//      PlainText := False;     //(вроде PragmaticaCTT и т.п.)
//      Text := buf;
//      Lines.BeginUpdate;
//      SelStart := 0;
//      SelLength := Length(RichEdit1.Text);
//      SelAttributes.Assign(CurFont);
//      SelLength := 0;
//      Lines.EndUpdate;
//      PlainText := True;
//    end;
    sFileName := ChangeFileExt(sFileName,'.txt');
  end
  else begin  {Эмпирический анализ и перекодировка}
    if IsDos(buf) then begin
      OemToChar(PChar(buf),PChar(buf));
      sFileName := ChangeFileExt(sFileName,'')+'(Win).txt';
      CPModify := True;
    end
    else if IsKoi(buf) then begin
      buf := KOI8ToWin(buf);
      sFileName := ChangeFileExt(sFileName,'')+'(Win).txt';
      CPModify := True;
    end;
    {Удаление тегов в html-подобном файле, и вычленение из него бинарных блоков}
    if (ext = '.htm') or (ext = '.html') or (ext = '.shtml') or (ext = '.fb2')
      then begin
        if IsUTF(buf) then buf := UTF8ToStrSmart(buf);  {!}
        buf := KillTags(buf,Bin);
        sFileName := ChangeFileExt(sFileName,'.txt');
        if PicImport and (ext = '.fb2') and (Bin.Count > 0) then  begin   {Обнаружены блоки бинарного кода}
          ImgFolder := ChangeFileExt(sFileName,'.files');
          if not DirectoryExists(ImgFolder) then MkDir(ImgFolder);
          for i := 0 to Bin.Count-1 do begin
            Img.Clear;
            btyp := '.???';
            if Pos('image/jpg',Bin[i]) > 0 then btyp := '.jpg';
            if Pos('image/jpeg',Bin[i]) > 0 then btyp := '.jpeg';
            if Pos('image/bmp',Bin[i]) > 0 then btyp := '.bmp';
            if Pos('image/png',Bin[i]) > 0 then btyp := '.png';
            if Pos('image/gif',Bin[i]) > 0 then btyp := '.gif';
            k := Pos('>',Bin[i]);
            if (k > 0) and (Pos(btyp,'.jpg|.jpeg|.bmp|.png|.gif') > 0) then  begin
              b := Copy(Bin[i],k+1,Length(Bin[i])-k);  {Вырезаем бинарный блок}
              b := DecodeBase64(b);  {Декодируем, без этого никак!}
              Img.Add(b);  {В этом списке никогда не будет больше одной строки...}
              Img.SaveToFile(ImgFolder+'\Image-'+IntToStr(i+1)+btyp); {...которую и запишем в файл}
            end;
          end;
        end;
      end;
    txt.SetText(PChar(buf));
    txt.SaveToStream(ms);
    ms.Seek(0, soFromBeginning);
    RichEdit1.Lines.LoadFromStream(ms);
  end;
  ms.Free;
  txt.Free;
  Bin.Free;
  Img.Free;
  buf := '';
  if (Pos(ext,'.htm|.html|.shtml|.fb2|.|.rtf|.doc') > 0) or CPModify then
    RichEdit1.Lines.SaveToFile(sFileName);
  StatusExecute(Sender);
end;


procedure TForm1.AOpenExecute(Sender: TObject);
begin
  OpenDialog1.FileName := sFileName;
 if (OpenDialog1.Execute) then begin
   sFileName := OpenDialog1.FileName;
   XOpen(Sender,sFileName);
   AStatCloseExecute(Sender);
   RichEdit1.Modified := False;
   RecentChange(Sender);
   BookMarks := '';
   NZakladGo.Enabled := False;
   NPrefsSeries.Enabled := True;
   PicShow(Sender);
 end;
end;


{Удалить каталог со всем содержимым}
function TForm1.DeleteDirectory(DirPath: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory(@fos, SizeOf(fos));
  with fos do begin
    wFunc := FO_DELETE;
    fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
    pFrom := PChar(DirPath + #0);
  end;
  Result := (0 = ShFileOperation(fos));
end;

{Показать картинку, если сие возможно}
procedure TForm1.PicShow(Sender: TObject);
var
  ext: string;
label
  fin;
begin
  if not PicImport then goto fin;
  GalleryFolder := '';
  if DirectoryExists(ChangeFileExt(sFileName,'.files'))
    then GalleryFolder := ChangeFileExt(sFileName,'.files');
  {Файлы веб-страницы могут находиться в папке с немного другим именем...}
  if DirectoryExists(ChangeFileExt(sFileName,'')+'_files')
    then GalleryFolder := ChangeFileExt(sFileName,'')+'_files';
  {Итак, если каталог-галерея существует...}
  if GalleryFolder <> '' then begin
    AllPictures(GalleryFolder,Pictures);  {Получили список всех картинок в галерее}
    if Pictures.Count > 0 then begin
      if PicImport then Panel1.Visible := True;  {!}
      PicLarge(Sender);  {Обеспечили достойный показ}
      if (IPic < 0) or (IPic > Pictures.Count-1) then IPic := 0;
      ext := ExtractFileExt(Pictures[IPic]);
      if (ext = '.jpg') or (ext = '.jpeg') or (ext = '.bmp')
                        or (ext = '.png') or (ext = '.gif')
        then begin  {Можно показывать}
          Image1.Picture.LoadFromFile(Pictures[IPic]);
          StatusExecute(Sender);
        end else goto fin;
    end else begin  {Галерею без картинок - удалить!}
      DeleteDirectory(GalleryFolder);
      goto fin;
    end;
  end else goto fin;
  exit;
  fin:
    Image1.Picture.Assign(nil);
    Panel1.Visible := False;
    ToolBar3.Visible := False;
    StatusExecute(Sender);
end;

procedure TForm1.PicLarge(Sender: TObject);
begin
  Panel1.Align := alCustom;
  Panel1.Anchors := [akLeft,akTop,akRight,akBottom];
  Panel1.Height := Form1.ClientHeight-94;
  Panel1.Left := NPicMargin;
  Panel1.Width := Form1.ClientWidth-Panel1.Left-21;
  ToolBar3.Left := Panel1.Left;
  ToolBar3.Top := Form1.ClientHeight-51;
  ToolBar3.Visible := True;
  Image1.Hint := 'Свернуть Ctrl+K или MouseClick|Свернуть в пиктограмму Ctrl+K или MouseClick';
end;

procedure TForm1.PicSmall(Sender: TObject);
begin
  Panel1.Align := alNone;
  Panel1.Height := 32;
  Panel1.Width := 32;
  Panel1.Left := NPicMargin;
  ToolBar3.Visible := False;
  Image1.Hint := 'Развернуть Ctrl+K или MouseClick|Развернуть в картинку Ctrl+K или MouseClick';
end;

procedure TForm1.APicLargeSmallExecute(Sender: TObject);
begin
  if Panel1.Height > 32 then PicSmall(Sender)
                        else PicLarge(Sender);
  StatusExecute(Sender);
end;


procedure TForm1.PrevClick(Sender: TObject);
begin
  Dec(IPic);
  if IPic < 0 then IPic := Pictures.Count-1;
  Image1.Picture.LoadFromFile(Pictures[IPic]);
  StatusExecute(Sender);
end;

procedure TForm1.NextClick(Sender: TObject);
begin
  Inc(IPic);
  if IPic > Pictures.Count-1 then IPic := 0;
  Image1.Picture.LoadFromFile(Pictures[IPic]);
  StatusExecute(Sender);
end;

procedure TForm1.DeleClick(Sender: TObject);
var res: integer;
begin
  res := Application.MessageBox('Удалить картинку?','Demagog',
                                MB_OKCANCEL);
  case (res) of
    IDOK:     begin
                DeleteFile(Pictures[IPic]);
                PicShow(Sender);
              end;
    IDCANCEL: exit;
  end;
end;

procedure TForm1.DeleAllClick(Sender: TObject);
var res: integer;
begin
  res := Application.MessageBox('Удалить ВСЕ картинки к этому тексту??','Demagog',
                                MB_OKCANCEL+MB_ICONWARNING);
  case (res) of
    IDOK:     begin
                DeleteDirectory(GalleryFolder);
                GalleryFolder := '';
                Image1.Picture.Assign(nil);
                Panel1.Visible := False;
                ToolBar3.Visible := False;
                StatusExecute(Sender);
              end;
    IDCANCEL: exit;
  end;
end;


procedure TForm1.NameFromFirstLines(var RE: TRichEdit; var Name: string);
var
  N, k, i: integer;
  L: string;
begin
  N := RichEdit1.Lines.Count;
  for i := 0 to N-1 do begin
    L := Trim(RichEdit1.Lines[i]);
    if L <> '' then break;
  end;
  for k := 1 to Length(L) do if IsDelimiter('.,;:!?',L,k) then begin
    L := Copy(L,1,k-1);
    break;
  end;
  L := Repress(L);
  L := Copy(L,1,64);
  if Trim(L) <> '' then Name := L
             else Name := 'Untitled';
end;


procedure TForm1.ASaveAsExecute(Sender: TObject);
var
  NewName: string;
begin
  if sFileName = '' then begin
    NameFromFirstLines(RichEdit1,NewName);
    SaveDialog1.InitialDir := StartDir;
  end else NewName := sFileName;
  SaveDialog1.FileName := NewName;
  if (SaveDialog1.Execute) then begin
    sFileName := SaveDialog1.FileName;
    RichEdit1.Lines.SaveToFile(SaveDialog1.FileName);
    RichEdit1.Modified:=false;
  end;
  StatusExecute(Sender);
  RecentChange(Sender);
end;


procedure TForm1.ASaveExecute(Sender: TObject);
begin
 if (sFileName = '')
 then ASaveAsExecute(Sender)
 else RichEdit1.Lines.SaveToFile(sFileName);
 RichEdit1.Modified:=false;
end;


{Процедуры Recent... - управление динамическим субменю 'Файл - Недавние >'}
{0. Добавляем в конце сформированного меню сепаратор и последний, особый пункт}
procedure TForm1.AddRecentClearItem(Sender: TObject);
var
  x: TMenuItem;
begin
  x := TMenuItem.Create(NFileRecent);
  x.Caption := '-';
  NFileRecent.Add(x);
  x := TMenuItem.Create(NFileRecent);
  x.Hint := 'Удалить информацию о ранее открытых файлах';
  x.Caption := 'ОЧИСТИТЬ СПИСОК';
  x.OnClick:=RecentClick;
  NFileRecent.Add(x);
end;

{1. Читаем строки из служебного файла и создаем субменю}
procedure TForm1.RecentLoad(Sender: TObject);
var
  R: TStringList;
  i, m: integer;
begin
  if not FileExists(extractfilepath(Application.ExeName)+'$.rec') then exit;
  R := TStringList.Create;
  R.LoadFromFile(extractfilepath(Application.ExeName)+'$.rec');
  m := R.Count;
  for i := m-1 downto 0 do
    if (Trim(R[i]) = '') or (not FileExists(StringReplace(R[i],'&','',[]))) then R.Delete(i);
  if High(MRecent) < R.Count then m := High(MRecent)
                             else m := R.Count;
  for i := 0 to m-1 do begin
    MRecent[i] := TMenuitem.Create(NFileRecent);
    MRecent[i].Caption := R[i];
    MRecent[i].Hint := 'Открыть недавний';
    MRecent[i].OnClick:=RecentClick;
    NFileRecent.Add(MRecent[i]);
  end;
  R.Free;
  if m > 0 then AddRecentClearItem(Sender);   {!}
end;

{2. Добавляем новый пункт вверху, если нет; или перемещаем уже имеющийся наверх}
procedure TForm1.RecentChange(Sender: TObject);
var
  found: boolean;
  i: integer;
begin
  with NFileRecent do begin
    found := False;
    if Count > 0 then
      for i := 0 to Count-1 do begin
        if StringReplace(Items[i].Caption,'&','',[]) = sFileName then begin
          Items[i].MenuIndex := 0;
          found := True;
        end;
      end;
      if not found
        then begin
          if Count-1 < High(MRecent)
            then begin
              MRecent[Count] := TMenuitem.Create(self);
              Insert(0,MRecent[Count]);
              Items[0].Caption := sFileName;
              Items[0].OnClick := RecentClick;
            end
        else begin
          Items[Count-1].Caption := sFileName;
          Items[Count-1].MenuIndex := 0;
        end;
      end;
    if Count = 1 then AddRecentClearItem(Sender);  {!}  
  end;
end;

{3. Пишем меню в служебный файл}
procedure TForm1.RecentSave(Sender: TObject);
var
  R: TStringList;
  i: integer;
begin
  R := TStringList.Create;
  with NFileRecent do begin
    //for i := 0 to Count-1 do R.Add(Items[i].Caption);
    for i := 0 to Count-3 do R.Add(Items[i].Caption);
    R.SaveToFile(extractfilepath(Application.ExeName)+'$.rec');
  end;
  R.Free;
end;

{4. Отрабатываем п-т меню - открываем выбранный файл,
или удаляем п-т меню, если такой файл уже не существует}
procedure TForm1.RecentClick(Sender : TObject);
var
  i: integer;
  Tmp: string;
begin
  Tmp := sFileName;
  sFileName := StringReplace((sender as TMenuItem).Caption,'&','',[]);
  if sFileName = 'ОЧИСТИТЬ СПИСОК' then begin
    NFileRecent.Clear;
    sFileName := Tmp;
    exit;
  end;
  if FileExists(sFileName) then begin
    RichEdit1.Lines.LoadFromFile(sFileName);
    RichEdit1.Modified := False;
    AStatCloseExecute(Sender);
    StatusExecute(Sender);
    RecentChange(Sender);
    PicShow(Sender);
  end else begin
    if NFileRecent.Count > 0 then
      //for i := 0 to NFileRecent.Count-1 do
      for i := 0 to NFileRecent.Count-3 do
        if StringReplace(NFileRecent.Items[i].Caption,'&','',[]) = sFileName then begin
          NFileRecent.Delete(i);
          break;
        end;
    sFileName := Tmp;
  end;
  BookMarks := '';
  NZakladGo.Enabled := False;  
  NPrefsSeries.Enabled := True;
end;
{Конец группы процедур 'Recent...'}


procedure TForm1.ACreateExecute(Sender: TObject);
var
  res: integer;
begin
 if (RichEdit1.Modified) then begin
   res:=Application.MessageBox('Текст в окне был изменен. Сохранить?',
                               'Demagog',MB_YESNOCANCEL);
   case (res) of
     IDYES:    ASaveExecute(Sender);
     IDCANCEL: Exit;
   end;
 end;
 RichEdit1.Clear;
 AStatCloseExecute(Sender);
 Form1.Scale := NScale;
 sFileName:='';
 Panel1.Visible := False;
 ToolBar3.Visible := False;
 NPrefsSeries.Enabled := False;
 StatusExecute(Sender);
end;


procedure TForm1.APrintNPExecute(Sender: TObject);
var i:integer;
begin
  if(PrintDialog1.Execute) then  {обращаясь к Блокноту Windows или тому, кто вместо него :)}
    for i := 0 to PrintDialog1.Copies-1
      do ShellExecute(handle,'print',PChar(sFileName),nil,nil,SW_HIDE);
end;


procedure TForm1.AMSWordExecute(Sender: TObject);
var
  b: boolean;
begin
  b := Demagog2MSWord(RichEdit1.Text);
  if not b then begin
    Application.MessageBox('Не найден Microsoft Word',
                           'Demagog',MB_ICONINFORMATION);
    exit;
  end;
end;


{Строго говоря, название ..MP3.. не соответствует содержанию, но менять
не буду. В общем, запись аудио в формате, заявленном в настройках программы}
procedure TForm1.AMP3Execute(Sender: TObject);
var
  FList: TStringList;
  i: integer;
begin
  FList := TStringList.Create;
  {Когда в настройках не задана запись аудио частями, то все просто}
  if not AudioSplit then MP3(Sender)
  else begin  {Создаем сериал для исходного текстового файла}
    MakeSeries(Sender,FList,'.audio');
    if FList.Count <= 1 then MP3(Sender)  {Ну, не бьющийся на части файл попался...}
    else begin
      BatchMP3(Sender,FList);
      {Удалим уже ненужные текстовые файлы сериала}
      for i := 0 to FList.Count-1 do DeleteFile(FList[i]);
    end;
  end;
  FList.Free;
end;

procedure TForm1.ABatchMP3Execute(Sender: TObject);
var
  FList: TStringList;
begin
  FList := TStringList.Create;
  OpenDialog4.FileName := '';  {Этот диалог разрешает множественный выбор файлов}
  if (OpenDialog4.Execute) then begin
    FList.AddStrings(OpenDialog4.Files);
  end;
  BatchMP3(Sender,FList);
  if sFileName <> '' then NPrefsSeries.Enabled := True;
  FList.Free;
end;

{А вот рабочая лошадка, которая собственно-то и пашет (пишет) аудио :).
Для SAPI5 выполняется отдельная ф-ция - создает wav и конвертит его, если
надо. Для SAPI4 - "перевод стрелок" - задание вывода НЕ на ЗВУКОВУЮ КАРТУ,
а в wav-файл. После чего вызывается функция чтения. Когда оное закончится,
TTSNotifySink.AudioStop изменит глобальные флаги, чтобы вернулись прежние
установки - чтение вслух}
procedure TForm1.MP3(Sender: TObject);
var
  RTime: Word;
  spd: integer;
begin
  ModeIO := 1;
  if AudioFromTop then begin
    RichEdit1.SelStart := RichEdit1.Perform(EM_LINEINDEX, 0, 0);
    RichEdit1.Perform( EM_SCROLLCARET, 0, 0 );
  end;
  SpeedVoice := trSpeed.Position;
  SpeedAudio := cbX.ItemIndex;
  ComboBox1Change(Sender);
  WaveFile := ChangeFileExt(sFileName,'.wav');
  {Если скопированный в окно редактора текст не был сохранен, то имя аудиофайла - пусто!}
  if WaveFile = '.wav' then WaveFile := StartDir+'\_.wav';
  StatusExecute(Sender);
  wFileName:=StringToOleStr(WaveFile);
  if SAPI5_Flag then begin  {SAPI5}
    trSpeed.Position := SpeedVoice;
    WriteSAPI5Audio(wFileName);
    if IBat = NBat-1 then BatGo := False;
    if (not BatGo) or (IBat = NBat-1) then PlaySound(PChar(StartDir+'\sounds\complete.wav'),0,SND_NOSTOP+SND_ASYNC);
  end else begin  {SAPI4}
    ////////////////////////////////////////////////////////////////////////////
    {для вывода в аудио: подтвердить ранее выбранные параметры...}
    fITTSAttributes.Speedset(trSpeed.Position);
    fITTSAttributes.PitchSet(trPitch.Position);
    spd := Form1.cbX.ItemIndex;
    if spd = Form1.cbX.Items.Count-1 then RTime := MAXWORD
                                     else RTime := 256 shl spd;
    fIAF.RealTimeSet(RTime);
    ASpeakExecute(Sender);
    {NB! Ждем, пока загорится зеленый свет - TTSNotifySink.AudioStop установит
    флаги, дав сигнал к реинициализации TTS-интерфейса ПОСЛЕ записи аудио.
    (Условно считаем, что это запись ПАКЕТА из ОДНОГО файла)}
    BatNext := False; BatGo := True;
    while not BatNext do begin
      sleep(1);
      Application.ProcessMessages;
      if BatNext then break;
      if not BatGo then break;
    end;
    BatGo := False;
    ComboBox1Change(Sender);  {Реинициализация}
    ////////////////////////////////////////////////////////////////////////////
  end;
end;

{Гоняем лошадь по кругу :). Запись в цикле множества аудиофайлов}
procedure TForm1.BatchMP3(Sender: TObject; var FList: TStringList);
var
  i: integer;
begin
  if SAPI5_Flag then begin  {SAPI5}
    ACreateExecute(Sender);
    BatGo := True;
    NBat := FList.Count;
    for i := 0 to NBat-1 do begin  {пишем в MP3 все файлы пакета}
      IBat := i;
      sFileName := FList[i];
      XOpen(Sender,sFileName);
      RichEdit1.Modified := False;
      MP3(Sender);
      if AudioStop then begin AudioStop := False; break; end;  {! Если была нажата кнопка "Стоп"}
      Application.ProcessMessages;
    end;
  end else begin  {SAPI4}
    ////////////////////////////////////////////////////////////////////////////
    ACreateExecute(Sender);
    BatGo := True;
    NBat := FList.Count;
    AudioStop := False;
    for i := 0 to NBat-1 do begin
      if AudioStop then begin ModeIO := 0; AudioStop := False; break; end;  {! Если была нажата кнопка "Стоп"}
      Application.ProcessMessages;
      IBat := i;
      sFileName := FList[i];
      XOpen(Sender,sFileName);
      RichEdit1.Modified := False;
      MP3(Sender);
      {NB! Ждем у светофора сигнала от TTSNotifySink.AudioStop.
      Пока не записан текущий файл пакета, нельзя грузить следующий}
      BatNext := False;
      while not BatNext do begin
        sleep(1);
        Application.ProcessMessages;
        if BatNext then break;
        if not BatGo then break;
      end;
    end;
    ComboBox1Change(Sender);  {Реинициализация}
    Application.ProcessMessages;
    ////////////////////////////////////////////////////////////////////////////
  end;
end;

procedure TForm1.SavePrefs(Sender: TObject);
var
  Ini: Tinifile;
  FontStyleInt: byte;
  FS: TFontStyles;
begin
  Ini:=TiniFile.Create(extractfilepath(Application.ExeName)+'$.ini');
  NScale := GetScale;
  {записываем текущие настройки}
  Ini.WriteInteger('SpeechEngine','Number',ComboBox1.ItemIndex);
  Ini.WriteInteger('SpeechEngine','Speed',trSpeed.Position);
  Ini.WriteInteger('SpeechEngine','Pitch',trPitch.Position);
  Ini.WriteString('SpeechEngine','Dictionary',sDicName);
  Ini.WriteInteger('Audio','XNumber',cbX.ItemIndex);
  Ini.WriteString('Text','FileName',sFileName);
  Ini.WriteInteger('Text','LineNum',LineNum);
  Ini.WriteInteger('Text','CharPos',CharPos);
  Ini.WriteInteger('Text','PicNumber',IPic);
  Ini.WriteInteger('Text','PicMargin',NPicMargin);
  Ini.WriteBool('Text','WordWrap',RichEdit1.WordWrap);
  Ini.WriteBool('Text','AutoCap',AutoCapFlag);
  Ini.WriteBool('Text','AutoRepl',AutoReplFlag);
  Ini.WriteBool('Text','AutoParag',AutoParagFlag);
  Ini.WriteBool('Text','AutoAloud',AutoAloudFlag);
  Ini.WriteBool('Text','AutoAloudP',AutoAloudPredl);
  Ini.WriteBool('Text','AutoAloudA',AutoAloudAbzac);
  Ini.WriteInteger('Text','AutoRepeat',NRepeat);
  Ini.WriteBool('Text','PicImport',PicImport);
  Ini.WriteInteger('Text','Scale',NScale);
  Ini.WriteString('Text','BookMarks',BookMarks);
  Ini.WriteInteger('Form','LeftCorner',Form1.Left);
  Ini.WriteInteger('Form','TopCorner',Form1.Top);
  Ini.WriteInteger('Form','Width',Form1.Width);
  Ini.WriteInteger('Form','Height',Form1.Height);
  Ini.WriteInteger('AudioConverter', 'ACNumber', AudioConverter);
  Ini.WriteInteger('AudioConverter','BRNumber',Brate);
  Ini.WriteInteger('AudioConverter','QNumber',Qual);
  Ini.WriteString('AudioConverter','AllParam',AllPar);
  Ini.WriteBool('AudioConverter','ConverterMinimize',ConvMinimize);
  Ini.WriteBool('AudioConverter','AudioFromTop',AudioFromTop);
  Ini.WriteBool('Series','AudioSplit',AudioSplit);
  Ini.WriteInteger('LitText','Parag',Abzac);
  Ini.WriteInteger('LitText','MaxLen',MaxL);
  Ini.WriteInteger('LitText','MaxHugeLen',HugeL);
  Ini.WriteBool('LitText','RightJustify',RJust);
  Ini.WriteInteger('Series','BytesInBlock',NB);
  Ini.WriteBool('Series','ChapHeadSencitive',NewChap);
  Ini.WriteBool('Series','Header',BHeader);
  Ini.WriteBool('SAPI','SAPI5',SAPI5_Flag);
  Ini.WriteInteger('FreshEye','Deep',FEDeep);
  Ini.WriteFloat('FreshEye','Similarity',FESim);
  Ini.WriteString('Others','BytesInFrag',IntToStr(FragSize));
  Ini.WriteBool('Others','IgnoreRules',IgnRul);
  Ini.WriteBool('Others','IgnorePrev',IgnPrev);
  Ini.WriteBool('Others','IsXML',XML);

  try
    with RichEdit1 do begin
      FS := Font.Style;
      Move(FS, FontStyleInt, 1);
      Ini.WriteString('Font','Name',Font.Name);
      Ini.WriteInteger('Font','Size',Font.Size);
      Ini.WriteInteger('Font','CharSet',Font.CharSet);
      Ini.WriteInteger('Font','Color',Font.Color);
      Ini.WriteInteger('Font','Style',FontStyleInt);
    end;
  finally
  end;
  Ini.WriteInteger('Background','Color',RichEdit1.Color);
  Ini.UpdateFile;
  Ini.Free;
  RecentSave(Sender);
end;


procedure TForm1.AExitExecute(Sender: TObject);
begin
  if Speak then AStopExecute(Sender); {вдруг выход во время чтения?}
  Close;
end;


procedure TForm1.AResizeExecute(Sender: TObject);
begin
 if RichEdit1.Height < RichEdit2.Height
    then RichEdit2.Height := (Form1.Height-144) div 2;
 if Panel1.Height > 32 then begin
   Panel1.Height := Form1.ClientHeight-94;
   //Panel1.Width := Form1.ClientWidth-571;
   Panel1.Left := NPicMargin;
   Panel1.Width := Form1.ClientWidth-Panel1.Left-21;
   ToolBar3.Left := Panel1.Left;
   ToolBar3.Top := Form1.ClientHeight-51;
 end;
end;


procedure TForm1.AFindExecute(Sender: TObject);
begin
  with FindDialog1 do begin
    //{начальное значение текста поиска - текст, выделенный в RichEdit1}
    FindText := RichEdit1.SelText;
    {позиционирование окна диалога}
    //Position := Point((Form1.Left+(Form1.Width-374) div 2),
    //                   Form1.Top+(Form1.Height-133) div 2);
    {удаление из диалога кнопок "Вверх", "Вниз",
     "Только  слово целиком" и выполнение}
    Options:=Options + [frHideUpDown,frHideWholeWord];
    Execute;
  end;
end;


procedure TForm1.FindDialog1Find(Sender: TObject);
var SPos: integer;
begin
  {если было выделение, то поиск идет, начиная с его
   последнего символа, иначе - с позиции курсора}
  SPos := RichEdit1.SelStart;
  if RichEdit1.SelLength > 0 then SPos := SPos + RichEdit1.SelLength;
  with (Sender as TFindDialog) do begin
  if frMatchCase in Options  {поиск с учетом или без учета регистра}
    then RichEdit1.SelStart := RichEdit1.FindText(FindText, SPos, Length(RichEdit1.Text)-SPos,[stMatchCase])
    else RichEdit1.SelStart := RichEdit1.FindText(FindText, SPos, Length(RichEdit1.Text)-SPos, []);
  if RichEdit1.SelStart >= Spos
    then begin
    {выделяем найденный текст и сдвигаем начальную позицию поиска}
    RichEdit1.SelLength := Length(FindText);
    SPos := RichEdit1.SelStart+RichEdit1.SelLength+1;
  end
    else
    if MessageDlg('Текст "'+FindText+'" далее не найден. Продолжать?',
                   mtConfirmation,mbYesNoCancel,0) <> mrYes
    then begin
       CloseDialog;
       exit;
    end;
  end;
  {Если нажата кнопка "Заменить все", то уход на замену}
  if frReplaceAll in (Sender as TFindDialog).Options
    then begin
      RichEdit1.Lines.BeginUpdate;
      if frMatchCase in ReplaceDialog1.Options
        then RichEdit1.Text := StringReplace(RichEdit1.Text,ReplaceDialog1.FindText,
                               ReplaceDialog1.ReplaceText,[rfReplaceAll])
        else RichEdit1.Text := StringReplace(RichEdit1.Text,ReplaceDialog1.FindText,
                               ReplaceDialog1.ReplaceText,[rfReplaceAll,rfIgnoreCase]);
    end;
    RichEdit1.Lines.EndUpdate;
  {прокручиваем (при необходимости) текст, чтобы стал виден курсор}
  RichEdit1.Perform(EM_SCROLLCARET,0,0);
  RichEdit1.SetFocus;
end;


procedure TForm1.AReplaceExecute(Sender: TObject);
begin
  with ReplaceDialog1 do begin
    {начальное значение текста поиска - текст, выделенный в RichEdit1}
    FindText:=RichEdit1.SelText;
    {позиционирование окна диалога внизу RichEdit1}
    //Position:=Point(Form1.Left,Form1.Top+RichEdit1.Top+RichEdit1.Height);
    {удаление из диалога кнопок "Вверх", "Вниз", "Только  слово целиком"}
    Options:=Options + [frHideUpDown,frHideWholeWord];
    {выполнение}
    Execute;
  end;
end;


procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
begin
  if RichEdit1.SelText<>''
    then RichEdit1.SelText:=ReplaceDialog1.ReplaceText;
  if frReplaceAll in ReplaceDialog1.Options
    then FindDialog1Find(ReplaceDialog1)
    else RichEdit1.SetFocus;
end;


{Форматирование литературного текста. На Pentium-4 3.2 GHz текст в 1.5 мб
причесывает за 45 сек}
procedure TForm1.AParagExecute(Sender: TObject);
var
  i, k, ls, Marg, M, N: integer;
  S, L, L1, Z, Eol: string;
  W: TStringList;
begin
  ForbidUserFeatures(Sender);
  try
    S := '';
    Z := StringOfChar(' ',Abzac);
    Eol := #13#10;
    N := RichEdit1.Lines.Count;
    ProgressBar1.Min := 0;
    ProgressBar1.Max := 3*N;
    RichEdit1.Lines.BeginUpdate;
    {Фаза 0. Заменяем в тексте "нестандартные" символы}
    for i := 0 to N-1 do begin
      L := RichEdit1.Lines[i];
      L := StringReplace(L, #9,'    ',[rfReplaceAll]);   {табуляция}
      L := StringReplace(L, #151,'-',[rfReplaceAll]);    {длинное тире}
      L := StringReplace(L, #150,'-',[rfReplaceAll]);    {тире}
      L := StringReplace(L, #160,' ',[rfReplaceAll]);    {неразрывный пробел - "ПРОСТРАНСТВО"}
      L := StringReplace(L, #132,'"',[rfReplaceAll]);    {нижние кавычки}
      L := StringReplace(L, #147,'"',[rfReplaceAll]);    {верхние кавычки}
      L := StringReplace(L, #171,'"',[rfReplaceAll]);    {левые "книжные" кавычки}
      L := StringReplace(L, #187,'"',[rfReplaceAll]);    {правые "книжные" кавычки}
      L := StringReplace(L, #133,'...',[rfReplaceAll]);  {многоточие}
      L := StringReplace(L, #169,'(c)',[rfReplaceAll]);  {копирайт}
      RichEdit1.Lines[i] := L;
      ProgressBar1.Position := i;
      Application.ProcessMessages;  //*//
    end;
    {Фаза 1. Определяем, имеется ли у текста поле слева}
    Marg := 999;
    for i:=0 to N-1 do begin
      L := RichEdit1.Lines[i];
      if Length(L) > 0 then begin
        M := 0;
        k := 1;
        while L[k] = ' ' do begin
          Inc(M);
          Inc(k);
        end;
        if M < Marg then Marg := M;
      end;
      ProgressBar1.Position := N+i;
      Application.ProcessMessages;  //*//
    end;
    {Фаза 2. Удаляем из текста левое поле. Добавляем абзацные отступы к
    чрезмерно длинным строкам; и строкам, содержащим в первой позиции "-",
    как правило - это прямая речь, в которой не сделан отступ}
    for i:=0 to N-1 do begin
      L := RichEdit1.Lines[i];
      if L <> '' then begin
        if Marg > 0 then Delete(L,1,Marg);
        if (L <> '') and (L[1] in ['-',#150]) or (Length(L)>HugeL) then L := Z+L;
        RichEdit1.Lines[i] := L;
      end;
      ProgressBar1.Position := 2*N+i;
      Application.ProcessMessages;  //*//
    end;
    {Фаза 3. Разбираем текст на слова, включая псевдослова: абзацы и
    пустые строки, и собираем заново}
    W := TStringList.Create;
    ls := 0;   {Число символов в формируемой строке}
    k := 0;    {Сколько обнаружено пустых строк подряд}
    SplitText(RichEdit1.Text,W);
    N := W.Count;
    ProgressBar1.Min := 0;
    ProgressBar1.Max := N;
    for i := 0 to N-1 do begin
      if W[i] = '_E_' then begin
        ls := 0;
        if k < 2 then begin   {Разрешены лакуны не более 2 пустых строк}
          if i > 1 then S := S+Eol;
          Inc(k);
        end;
      end;
      if W[i] = '_Z_' then begin
        S := S+Eol+Z;
        ls := Abzac;
      end;
      if (W[i] <> '_E_') and (W[i] <> '_Z_') then begin
        k := 0;
        if (i > 1) and (W[i-1]='_E_') then S := S+Eol;  {Иначе съедается одна пустая строка}
        if (ls+Length(W[i])+1 <= MaxL) or (MaxL = 0)
          then begin
            S := S+W[i]+' ';
            Inc(ls,Length(W[i])+1);
          end
          else begin
            S := S+Eol+W[i]+' ';
            ls := Length(W[i])+1;
          end;
      end;
      ProgressBar1.Position := i;
      Application.ProcessMessages;  //*//
    end;
    W.Free;
    RichEdit1.Text := S;
    S := '';
    {Вставляем пробелы, если включено выравнивание. Оно имеет смысл только
    для пропорциональных шрифтов, вроде Courier New или Lucinda Console}
    if RJust and (MaxL > Abzac) then begin
      N := RichEdit1.Lines.Count;
      ProgressBar1.Min := 0;
      ProgressBar1.Max := N;
      for i :=0 to N-1 do begin
        L := RichEdit1.Lines[i];
        L1 := '';
        if (L <> '') then begin
          if i < N-1 then L1 := RichEdit1.Lines[i+1];
          if (L[1] = ' ') then begin
            if (L1 <> '') and (L1[1] <> ' ') then RichEdit1.Lines[i] := Z+Puff(TrimLeft(L),MaxL-Abzac)
          end
          else begin
            if (L1 <> '') and (L1[1] <> ' ') then RichEdit1.Lines[i] := Puff(L,MaxL);
          end;
        end;
        ProgressBar1.Position := i;
        Application.ProcessMessages;  //*//
      end;
    end;
    RichEdit1.SelStart := RichEdit1.Perform(EM_LINEINDEX, 0, 0);
    RichEdit1.perform( EM_SCROLLCARET, 0, 0 );
    RichEdit1.SetFocus;
    Form1.Scale := NScale;
    RichEdit1.Lines.EndUpdate;
    ProgressBar1.Position := 0;
    StatusExecute(Sender);
  finally
    UnForbidUserFeatures(Sender);
  end;
end;


procedure TForm1.AFontExecute(Sender: TObject);
begin
 {1-я строчка - чтобы в диалоге выбора шрифта сразу показывался текущий}
 FontDialog1.Font.Assign(RichEdit1.SelAttributes);
 if FontDialog1.Execute then begin
   RichEdit1.Lines.BeginUpdate;
   RichEdit1.SelStart := 0;
   RichEdit1.SelLength := Length(RichEdit1.Text);
   RichEdit1.SelAttributes.Assign(FontDialog1.Font);
   RichEdit1.Font.Name := FontDialog1.Font.Name;
   RichEdit1.Font.Size := FontDialog1.Font.Size;
   RichEdit1.Font.CharSet := FontDialog1.Font.CharSet;
   RichEdit1.Font.Color := FontDialog1.Font.Color;
   RichEdit1.Font.Style := FontDialog1.Font.Style;
   RichEdit1.SelLength := 0;
   RichEdit1.Lines.EndUpdate;
   RichEdit1.Modified := False;
 end;
 RichEdit1.SetFocus;
end;


procedure TForm1.ABackGroundExecute(Sender: TObject);
begin
  if ColorDialog1.Execute then
    RichEdit1.Color := ColorDialog1.Color;
end;

procedure TForm1.AWrapTextExecute(Sender: TObject);
begin
  RichEdit1.Lines.BeginUpdate;
  RichEdit1.WordWrap := not RichEdit1.WordWrap;
  NFormatWrap.Checked := RichEdit1.WordWrap;
  {!! В Object Inspector свойство RichEdit1.MaxLength вместо 0 по умолчанию
  я выставил 2147483632. Иначе изменение свойства wordwrap "замораживает"
  тексты, большие 64kb. В текст будет невозможно ввести ни одного символа!}
  Form1.Scale := NScale;
  RichEdit1.Lines.EndUpdate;
end;

{Удаление знаков переноса (дефисов) на концах строк}
procedure TForm1.ADeleBreaksExecute(Sender: Tobject);
var
  StartPos, LineNum, CharPos, k, k1, k2, k2_: integer;
  Eol, S: string;
begin
  Eol := #13#10;
  StartPos := 1;
  with RichEdit1 do begin
    S := Text;
    LineNum := caretpos.Y;
    CharPos := caretpos.X;
    ProgressBar1.Min := 0;
    ProgressBar1.Max := Length(Text);
    Lines.BeginUpdate;
    while True do begin
      k := PosN('-',S,StartPos);
      if k = 0 then break;
      if (k > 1) and not (S[k-1] in ['А'..'Я','Ё','а'..'я','ё','A'..'Z','a'..'z'])
        then begin  {"-" идет сразу после буквы, предположительно - это перенос}
          StartPos := k+1;
          continue;
        end else begin
          k1 := PosN(Eol,S,k+1);
          if k1 = 0 then break;
          {Если после "-" сразу идет конец строки, то - точно перенос!}
          if (Trim(Copy(S,k,k1-k)) = '-') then begin
            Inc(k1,2);
            while S[k1] = ' ' do Inc(k1);  {Пропустим возможные пробелы после конца строки}
            Delete(S,k,k1-k);  {Убиваем всё от переноса включительно, до первого не пробела}
            {Разорванное слово склеено, после него - либо пробел, либо конец строки}
            k2 := PosN(' ',S,k+1);
            k2_ := PosN(Eol,S,k+1);
            if k2 = 0 then break;
            if k2 < k2_ then begin
              {Вместо пробела за словом вставяем конец строки, обеспечивая перенос без разрыва}
              Delete(S,k2,1);
              Insert(Eol,S,k2);
              k := k2;
            end;
          end;
        end;
      StartPos := k+1;
      ProgressBar1.Position := k;
      Application.ProcessMessages;  //*//
    end;
    Text := S;
    S := '';
    ProgressBar1.Position := 0;
    Lines.EndUpdate;
    {При удалении переносов кол-во строк практически не меняется.
    Поэтому пытаемся выставить курсор на прежнее место в тексте.
    Не всегда получится точно, но довольно близко}
    SelStart := perform(EM_LineIndex,LineNum,0)+CharPos;
    perform(EM_ScrollCaret,0,0);
    SetFocus;
  end;
  StatusExecute(Sender);
end;

procedure TForm1.AUpperCaseExecute(Sender: TObject);
begin
  with RichEdit1 do begin
    SelText := AnsiUpperCase(SelText);
  end;
end;

procedure TForm1.ALowerCaseExecute(Sender: TObject);
begin
  with RichEdit1 do begin
    SelText := AnsiLowerCase(SelText);
  end;
end;

procedure TForm1.ANumToPhraseExecute(Sender: TObject);
  function MultiDotRepl(c: string): string;
  var
    k: integer;
  begin
    Result := c;
    k := PosN('.',c);
    if k > 0 then k := PosN('.',c,k+1);
    if k > 0 then Result := StringReplace(c,'.','-',[rfReplaceAll]);;
  end;
begin
  with RichEdit1 do begin
    SelText := AllNumToPhr(MultiDotRepl(SelText));
  end;
end;


procedure TForm1.EditKeyPress(Sender: TObject; var Key: char);
begin
  if not (Key in ['0'..'9',#8]) then Key := #0;
end;

procedure TForm1.RichEdit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  StatusExecute(Sender);
  LineNum := RichEdit1.CaretPos.Y;
  CharPos := RichEdit1.CaretPos.X;
  if Key in [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT] then PrevKey := #0;
end;

procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);
begin
  {Подставлять большую букву в начале предложения}
  if AutoCapFlag and (Key in [' ',#13]) then AutoCap;
  {Заменять некоторые знаки пунктации на т.н. "книжные"}
  if AutoReplFlag and (PrevKey = '-') and (Key = ' ') then AutoRepl(1);
  if AutoReplFlag and (PrevKey = '"') and not (Key in [' ',#13]) then AutoRepl(2);
  if AutoReplFlag and (PrevKey = '"') and (Key in [' ','.',#13]) then AutoRepl(3);
  if AutoReplFlag and (PrevKey = '.') and (Key <> #0) then AutoRepl(4);
  {Вставлять абзацный отступ}
  if AutoParagFlag and (PrevKey = #13) and (Key = ' ') then AutoRepl(5);
  {Проговаривать набранный текст}
  if AutoAloudFlag and AutoaloudPredl and (Key in ['.','!','?']) then AutoAloud;
  if AutoAloudFlag and AutoaloudAbzac and (PrevKey = #13) and (Key in [' ',#13]) then AutoAloud;
  PrevKey := Key;
end;

procedure TForm1.RichEdit1SelChange(Sender: TObject);
begin
  if RichEdit1.SelLength > 0 then begin
    NSpeakSpeakSel.Enabled := True;
    NPopSpeakSel.Enabled := True;
    NEditChangeSel.Enabled := True;
    NPopChangeSel.Enabled := True;
  end else begin
    NSpeakSpeakSel.Enabled := False;
    NPopSpeakSel.Enabled := False;
    NEditChangeSel.Enabled := False;
    NPopChangeSel.Enabled := False;
  end;
end;

procedure TForm1.AutoRepl(Mode: integer);
var
  k: integer;
begin
  with RichEdit1 do begin
    if Mode = 1 then begin  {Замена минуса на тире}
      k := SelStart;
      SelStart := k-1;
      SelLength := 1;
      SelText := #150;
      SelStart := k;
    end;
    if Mode = 2 then begin  {Замена простой кавычки на открывающую книжную}
      k := SelStart;
      SelStart := k-1;
      SelLength := 1;
      SelText := #171;
      SelStart := k;
    end;
    if Mode = 3 then begin  {Замена простой кавычки на закрывающую книжную}
      k := SelStart;
      SelStart := k-1;
      SelLength := 1;
      SelText := #187;
      SelStart := k;
    end;
    if Mode = 4 then begin  {Замена 3-х точек подряд на символ многоточия}
      k := SelStart;
      SelStart := k-3;
      SelLength := 3;
      if SelText = '...' then begin
        SelText := #133;
        SelStart := k-2;
      end else SelStart := k;
    end;
    if Mode = 5 then begin  {Абзацный отступ}
      k := SelStart;
      SelStart := k-2;
      SelLength := 2;
      SelText := #13#10+StringOfChar(' ',Abzac-1);
      SelStart := k+Abzac-1;
    end;
  end;
end;

{Автокапитализация. Делаем 1-ю букву в предложении прописной.
Предполагаем, что разделителем строк м.б. как пара #13#10, так и каждый
их этих символов по отдельности}
procedure TForm1.AutoCap;
var
  k, i, j: integer;
  tmp: string;
begin
with RichEdit1 do begin
  k := SelStart;
  i := k;
  if i > 0 then
    while not (Text[i] in [' ',#10,#13]) do begin  {Ищем начало текущего слова...}
      if i = 1 then break;
      Dec(i);
    end;
  if i = 1 then tmp := Copy(Text,i,k-i+1)          {...получаем его}
           else tmp := Copy(Text,i+1,k-i+1);
  tmp := StringReplace(tmp,#13,'',[]);             {!}
  if IsBB(tmp) then exit;                          {Проверяем на 1-ю большую букву}
  {Капитализируем}
  j := i;
  if j > 0 then
    while Text[j] in [' ',#13,#10] do begin
      if j = 1 then break;
      Dec(j);
    end;
  if (i > 1) and (Text[j] in ['.','!','?',#133,#13,#10,' ']) then begin
    SelStart := i;
    SelLength := k-i+1;
    SelText := BB(tmp);
    SelLength := 0;
    SelStart := k;
  end;
  if i = 1 then begin
    SelStart := 0;
    SelLength := k;
    SelText := BB(tmp);
    SelLength := 0;
    SelStart := k;
  end;
end;
end;

{Чтение вслух набираемого на клавиатуре текста!}
procedure TForm1.AutoAloud;
var
  k, i, j: integer;
  tmp, S: string;
begin
if (SAPI5_Flag and not Happy) or (not SAPI5_Flag and not assigned(fITTSCentral))
                              or (ModeIO = 1) then exit;
with RichEdit1 do begin
  k := SelStart;
  i := k;
  if AutoAloudPredl then begin
    if i > 0 then
     {Едем назад - ищем начало текущего предложения}
      while not (Text[i] in ['.','!','?']) do begin
        if i = 1 then break;
        Dec(i);
      end;
  end;
  if AutoAloudAbzac then begin
    if i > 0 then
      {Едем назад - ищем начало текущего абзаца: ' '+#13#10 или #13#10#13#10}
      while (not ((Text[i] in [' ', #13]) and (Text[i-1] = #10))) do begin
        if i = 1 then break;
        Dec(i);
      end;
  end;
  {Получаем предложение или абзац}
  if i = 1 then tmp := ' '+Copy(Text,i,k-i+1)  {!}
           else tmp := Copy(Text,i+1,k-i+1);
  {!}
  tmp := StringReplace(tmp, #13,' ',[rfReplaceAll]);
  tmp := StringReplace(tmp, #10,' ',[rfReplaceAll]);
  S := tmp;
  for j := 1 to NRepeat-1 do S := S+' '+tmp;
  if Pause then begin
    TTSResume;
  end
  else begin
    TTSStart(S);
    CBSpeak := True;  {Выключаем слежение за текстом}
  end;
  TimerNextFragment.Enabled:=True;
  StatusExecute(nil);
end;
end;

procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not Speak then begin
    StatusExecute(Sender);
    LineNum := RichEdit1.CaretPos.Y;
    CharPos := RichEdit1.CaretPos.X;
    PrevKey := #0;
    NScale := GetScale;
  end else begin
    RichEdit1.SelStart := GlobalStartPos-1;
  end;
end;

procedure TForm1.StatusExecute(Sender: TObject);
var
  CharInd: integer;
  Info: string;
  Kbs, AL: real;
begin
  if SAPI5_Flag then lbSAPI.Caption := '    SAPI5'
                else lbSAPI.Caption := '    SAPI4';
  StatusBar1.Panels.Items[0].Text:=
                    IntToStr(RichEdit1.CaretPos.y+1) +
                    ': '+IntToStr(RichEdit1.CaretPos.x+1);
  CharInd := RichEdit1.SelStart+1;
  if RichEdit1.Text <> ''
    then StatusBar1.Panels.Items[1].Text := IntToStr(Ord(RichEdit1.Text[CharInd]));
  if Speak then begin
    if ModeIO = 1 then Info := 'Аудио'
                  else Info := 'Чтение';
    StatusBar1.Panels.Items[2].Text := Info;
    Application.Title := 'Demagog - '+Info+': '+ExtractFileName(sFileName);
  end;
  if Pause then begin
    StatusBar1.Panels.Items[2].Text:='Пауза';
    Application.Title := 'Demagog - Пауза: '+ExtractFileName(sFileName);
  end;
  if not Speak and not Pause then begin
    StatusBar1.Panels.Items[2].Text:='';
    Application.Title := 'Demagog';
  end;
  if (WaveFile <> '') and (ModeIO = 1) then begin
    case (AudioConverter) of
      0: StatusBar1.Panels.Items[3].Text := ExtractFileName(WaveFile);
      1: StatusBar1.Panels.Items[3].Text := ExtractFileName(ChangeFileExt(WaveFile,'.mp3'));
      2: StatusBar1.Panels.Items[3].Text := ExtractFileName(ChangeFileExt(WaveFile,'.ogg'));
    end;
  end else if ToolBar3.Visible
             then StatusBar1.Panels.Items[3].Text := '('+IntToStr(IPic+1)+'/'+IntToStr(Pictures.Count)+') '+ExtractFileName(Pictures[IPic])
             else StatusBar1.Panels.Items[3].Text := '';
  if sFileName <> '' then Form1.Caption := 'Demagog'+' - '+ExtractFileName(sFileName)
                     else Form1.Caption := 'Demagog';
  with RichEdit1 do begin
    Kbs := Round(Length(Text))/1024;
    AL :=  Round(Length(Text))/40000;
    Hint := RoundFloat(Kbs,0)+' Кб, '+RoundFloat(AL,1)+' а.л.';
  end;
  StatusBar1.Panels.Items[4].Text := IntToStr(NScale)+'%';
end;


procedure TForm1.DisplayHint(Sender: TObject);
begin
  StatusBar1.Panels.Items[5].Text:=Application.Hint;
end;


procedure TForm1.ConvertWav(InputWAV, OutputAudio: string);
var
  App, SourseWAV: string;
  Left, Top, W, H: integer;
  hProcess: THandle;
  ptx: string;
begin
  SourseWAV := InputWAV; {Имя InputWAV м.б. искажено добавлением кавычек!}
  if Pos(' ',InputWAV) <> 0 then InputWAV := '"'+InputWAV+'"';
  if Pos(' ',OutputAudio) <> 0 then OutputAudio := '"'+OutputAudio+'"';
  case (AudioConverter) of
    1: App := 'lame.exe '+AllPar+' '+InputWAV+' '+OutputAudio;
    2: App := 'oggenc2.exe '+AllPar+' '+InputWAV+' '+OutputAudio;
  end;
  Left := Form1.Left+4;
  Top := Form1.Top+123;
  W := Form1.Width-52;  //32;
  H := Form1.Height-200;  //158;
  ptx := StatusBar1.Panels.Items[3].Text;
  StatusBar1.Panels.Items[3].Text := 'РАБОТАЕТ АУДИО-КОНВЕРТЕР. ЖДИТЕ...';
  Application.ProcessMessages;
  if ConvMinimize then hProcess := RunExtern(App,Left,Top,W,H,SW_MINIMIZE)
                  else hProcess := RunExtern(App,Left,Top,W,H,Form_Status);
  {Ожидаем завершения работы конвертера, прежде чем удалять исходный файл!}
  WaitForSingleObject(hProcess, INFINITE);
  CloseHandle(hProcess);
  if AudioConverter > 0 then DeleteFile(SourseWAV);
  StatusBar1.Panels.Items[3].Text := ptx;
end;

function TForm1.RunExtern(App: string; Left,Top,W,H: integer; WinState: word): THandle;
var
  ErrStr: string;
  PMSI: TStartupInfo;
  PMPI: TProcessInformation;
begin
  FillChar(PMSI,SizeOf(PMSI),#0);
  PMSI.cb := SizeOf(PMSI);
  PMSI.dwFlags := STARTF_USESHOWWINDOW+STARTF_USEPOSITION+STARTF_USESIZE;
  PMSI.wShowWindow := WinState;  //SW_SHOWNORMAL;
  PMSI.dwX := Left;
  PMSI.dwY := Top;
  PMSI.dwXSize := W;
  PMSI.dwYSize := H;
  //PMSI.wShowWindow := SW_Hide;  // просто невидимое
  //SW_SHOWMINNOACTIVE - не активное
  //SW_MAXIMIZE - на весь экран
  //SW_MINIMIZE - свернутое в значок
  try
    CreateProcess(nil, PChar(App), nil, nil, False, NORMAL_PRIORITY_CLASS,
                  nil, nil, PMSI, PMPI);
  except
    ErrStr := 'Не удалось выполнить процесс ' + App;
    Application.MessageBox(@ErrStr[1], 'Опаньки!', MB_OK + MB_ICONERROR);
  end;
  Result := PMPI.hProcess;
end;


{Разделить большой текст на серию малых}
procedure TForm1.MakeSeries(Sender: TObject; var FList: TStringList; DirExt: string = '');
function NextChap(S: string): boolean;
var
  ST, Num, Nazv: string;
  m, l: integer;
begin
  Result := False;
  if not NewChap then exit;
  ST := Trim(S);
  if ST = '' then exit;
  {Вариант: ! в начале строки. Имеет превосходство над
  всеми остальными и проверяется первым}
  if (Length(ST) > 0) and (ST[1] = '!') then begin
    Result := True;
    exit;
  end;
  {Реальные названия глав НЕ заканчиваются . : ;
  А запятой могут! Тогда со след. строки идет краткое содержание главы}
  if (Tail(ST) ='.') or (Tail(ST) =':') or (Tail(ST) =';')then exit;
  {Вариант: Глава ХХХ, где XXX - номер цифрами или буквами}
  //Анализ "номера" отсутствует! Просто ограничение по длине! Исправить!?
  if AnsiLowerCase(Copy(ST,1,6)) = 'глава ' then begin
    if (Length(ST)>=7) and (Length(ST)<40) then begin
      Result := True;
      exit;
    end;
  end;
  {Вариант: Chapter ХХХ}
  if AnsiLowerCase(Copy(ST,1,8)) = 'chapter ' then begin
    if (Length(ST)>=9) and (Length(ST)<40) then begin
      Result := True;
      exit;
    end;
  end;
  {Варианты: N. НАЗВАНИЕ ГЛАВЫ и N. CHAPTER NAME}
  if (Length(ST) > 3) then begin
    m := Pos('. ',ST);
    if m > 1 then begin
      Num := Copy(ST,1,m-1);
      Nazv := Copy(ST,m+2,Length(ST)-m-1);
      for l := 1 to Length(Num) do
        if not (Num[l] in ['0'..'9','I','V','X']) then exit;
      for l := 1 to Length(Nazv) do
        if not (Nazv[l] in ['А'..'Я','Ё','A'..'Z','0'..'9','I','V','X','-',',','.','!','?','"',' '])
          then exit;
    end
    else exit;
    Result := True;
    exit;
  end;
end;
var
  Small: TStringList;
  i, j, k, N, NBlocks: integer;
  L, Name, sn, NewDir, TmpName: string;
begin
  if NB > 0 then NBlocks := NB
            else NBlocks := 999999999;
  Small := TStringList.Create;
  FList := TStringList.Create;
  if Length(RichEdit1.Text) <= NB then begin
    {Текст слишком короткий для деления на части! Вернем пустой FList и все}
    Small.Free;
    exit;
  end;
  NameFromFirstLines(RichEdit1,TmpName);
  if sFileName <> '' then TmpName := sFileName
                     else TmpName := StartDir+TmpName;
  if BHeader then begin
    Small.Add('Текст "'+ChangeFileExt(ExtractFileName(TmpName),'')+'". Серия 1.');
    Small.Add('');
  end;
  ChDir(ExtractFilePath(TmpName));
  NewDir := ChangeFileExt(ExtractFileName(TmpName),DirExt);
  if DirectoryExists(NewDir) then DeleteDirectory(NewDir);
  MkDir(NewDir);
  N := RichEdit1.Lines.Count;
  ProgressBar1.Min := 0;
  ProgressBar1.Max := N;
  i := 0;
  j := 0;  {Размер очередного блока в байтах с учетом знаков EOL}
  k := 0;
  while i < N do begin
    L := RichEdit1.Lines[i];
    if (j > NBlocks-Length(L)-2) or (i = N-1) or (NextChap(L) and (j > 0))
    then begin  {Больше нельзя добавлять строки в блок}
      if i = N-1 then Small.Add(L);  {Чтоб не потерять последнюю строку}
      sn := inttostr(k+1);
      j := 0;
      Inc(k);
      while Length(sn) < 4 do sn := '0'+sn;
      Name := ExtractFilePath(TmpName)+
        ChangeFileExt(ExtractFileName(TmpName),DirExt)+'\'+sn+'_';
      Name := Name+ExtractFileName(TmpName);
      if (Small.Count > 0) and (Small[0] <> '') and (Small[0][1] = '!')
        then Small[0] := StringReplace(Small[0],'!',' ',[]);
      Small.SaveToFile(Name);
      Small.Clear;
      if BHeader then begin
        Small.Add('Продолжение текста "'+ChangeFileExt(ExtractFileName(TmpName),'')+'". Серия '+IntToStr(k+1)+'.');
        Small.Add('');
      end;
      Small.Add(L);
      FList.Add(Name);  {Список имен файлов сериала}
    end
    else begin
      Small.Add(L);
      Inc(j,Length(L)+2);  {Добавить текущую строку в блок}
    end;
    ProgressBar1.Position := i;
    Application.ProcessMessages;  //*//
    Inc(i);
  end;
  ProgressBar1.Position := 0;
  Small.Free;
end;

procedure TForm1.ASeriesExecute(Sender: TObject);
var
  k: integer;
  Mess, T: string;
  FList: TStringList;
begin
  FList := TStringList.Create;
  MakeSeries(Sender,FList);
  k := FList.Count;
  if k > 1 then begin
      Mess := 'Для текста "'+sFileName+
               '" cоздан и помещен в одноименный подкаталог сериал из '+
               inttostr(k)+' частей';
      T := 'Сериал для '+ExtractFileName(sFileName);
      Application.MessageBox(PChar(Mess), PChar(T), MB_OK);
  end else begin
      Mess := 'Не удалось разбить на части текст "'+sFileName+
              '". Проверьте настройки в меню "Сервис - Сериалы" '+
              'и повторите попытку';
      T := 'Сериал для '+ExtractFileName(sFileName);
      Application.MessageBox(PChar(Mess), PChar(T), MB_ICONWARNING);
    end;
  FList.Free;
end;


{Редактировать орфотаблицу}
procedure TForm1.AEditOrfoExecute(Sender: TObject);
begin
  OrfoBox.ShowModal;
end;

{Простейшая проверка орфографии. Используется орфотаблица 1-2-3-4-5-буквенных
слов русского языка и 5-буквенных подслов. Против каждого буквосочетания
в орфотаблице указан его код. 100x - встречается только в начале слова; 010x -
только в середине; 001x - только в конце. Возможны комбинации: 110x, 011x, 101x,
111x. Слова короче 5 букв имеют особый код 000x. x = 1 - если сочетание может
быть самостоятельным словом и 0 в противном случае. Проверяется ВЫДЕЛЕННЫЙ
фрагмент текста. Слова с цифрами и нерусскими буквами игнорируются.}
procedure TForm1.AOrfoExecute(Sender: TObject);
var
  Orfo, W, zzz, Err: TStringList;
  S, T, c, b, Eol: string;
  i, j, m, i0, N, ts: integer;
begin
  if not FileExists(StartDir+'\~orfo~') then exit;
  try
    Eol := #13#10;
    T := '??? НЕ ВЫДЕЛЕН ТЕКСТ ДЛЯ ПРОВЕРКИ ???'+Eol+Eol+
          'Для проверки орфографии выделите нужный фрагмент текста и нажмите F4';
    Orfo := TStringList.Create;
    Orfo.LoadFromFile(StartDir+'\~orfo~');
    ts := FirstSimpleAfter(2*Orfo.Count);
    zzz := TStringList.Create;
    Err := TStringList.Create; Err.Sorted := True; Err.Duplicates := dupIgnore;
    for i := 0 to ts-1 do zzz.Add('');
    for i := 0 to Orfo.Count-1 do begin
      HFind(zzz,FirstWord(Orfo[i]),ts,i0);
      zzz[i0] := Orfo[i];
    end;
    RichEdit2.Visible := True; Splitter1.Enabled := True;
    RichEdit2.Text := 'Немного подождите...';
    Application.ProcessMessages;
    S := Copy(RichEdit1.Text, RichEdit1.SelStart+1, RichEdit1.SelLength);
    S := StringReplace(S,'-',' ',[rfReplaceAll]);
    W := TStringList.Create;
    SplitText(S,W);
    RichEdit2.Lines.BeginUpdate;
    if RichEdit1.SelLength = 0 then RichEdit2.Text := T
                               else RichEdit2.Text := '';
    N := W.Count;
    ProgressBar1.Min := 0;
    ProgressBar1.Max := N;
    for i := 0 to N-1 do begin
      if (W[i] = '_Z_') or (W[i] = '_E_') or (W[i] = '-') or (W[i] = #150) then continue;
      c := W[i];
      c := StringReplace(c,'"','',[rfReplaceAll]);
      c := StringReplace(c,'(','',[]);
      c := StringReplace(c,')','',[]);
      c := StringReplace(c,'<','',[]);
      c := StringReplace(c,'>','',[]);
      c := StringReplace(c,'ё','е',[rfReplaceAll]);
      c := StringReplace(c,'Ё','Е',[rfReplaceAll]);
      c := Body(c);
      if not RusWord(c) then continue;
      if IsBB(c) and HFind(zzz,c,ts,i0,' ') then continue;  {Имя собственное}
      c := AnsiLowerCase(c);
      m := Length(c);
      if (m < 5) and not HFind(zzz,c,ts,i0,' ') then begin  {Слово короче 5 букв}
        Err.Add(Body(W[i]));
        continue;
      end;
      j := 1;
      while j+4 <= m do begin  {Проверка по пятеркам}
        b := Copy(c,j,5);
        if HFind(zzz,b,ts,i0,' ') then begin
          if ((j = 1) and (j < m-4) and (WCod(zzz[i0])[1] = '0')) or
             ((1 < j) and (j < m-4) and (WCod(zzz[i0])[2] = '0')) or
             ((1 < j) and (j = m-4) and (WCod(zzz[i0])[3] = '0')) or
             ((m = 5) and (WCod(zzz[i0])[4] <> '1'))
             then begin Err.Add(Body(W[i])); break; end;
        end else begin Err.Add(Body(W[i])); break; end;
        Inc(j);
      end;
      ProgressBar1.Position := i;
      Application.ProcessMessages;  //*//
    end;
    ProgressBar1.Position := 0;
    if Err.Count = 0 then RichEdit2.Text := '# Орфография'+Eol+Eol+'Правильно'
                     else begin
                       REAppFromTS(RichEdit2,Err);
                       RichEdit2.Text := '# Орфография'+Eol+Eol+RichEdit2.Text;
                     end;
    RichEdit2.Lines.EndUpdate;
  finally
    FreeAndNil(zzz);
    FreeAndNil(Orfo);
    FreeAndNil(W);
    FreeAndNil(Err);
  end;
end;


{Процедуры статистики/анализа текста}
procedure TForm1.REAppFromTS(var RE: TRichEdit; var TS: TStringList);
var
  i, n: integer;
begin
  ProgressBar1.Position := 0;
  RichEdit2.Lines.BeginUpdate;
  n := TS.Count;
  for i := 0 to n-1 do begin
    RE.Lines.Append(TS[i]);
    ProgressBar1.Position := i;
    Application.ProcessMessages;  //*//
  end;
  RichEdit2.Lines.EndUpdate;
  ProgressBar1.Position := 0;
end;

{Текст со словарными заменами}
procedure TForm1.AChangeTextFullExecute(Sender: TObject);
var
  S: string;
begin
  if sDicName <> '' then begin
    RichEdit2.Visible := True; Splitter1.Enabled := True;
    RichEdit2.Text := 'Немного подождите...';
    Application.ProcessMessages;
    S := RichEdit1.Text;
    Filter(Sender,S,IgnRul,True);
    RichEdit2.Text := '# Tекст "'+ExtractFileName(sFileName)+
                      '", измененный по словарю "'+ExtractFileName(sDicName)+'"'+#13#10+S;
    S := '';
  end;
end;

{Список примененных словарных замен}
procedure TForm1.ARulesFullExecute(Sender: TObject);
var
  j, k, N, NR, NW: integer;
  W, Rules, Tmp: TStringList;
  RuleUsed, Eol: string;
begin
try
  W := TStringList.Create;
  Rules := TStringList.Create; Rules.Sorted := True;
  Tmp := TStringList.Create;
  XXX := TStringList.Create;
  SplitText(RichEdit1.Text,W);
  N := W.count;
  NW := 0;
  for j := 0 to N - 1 do
    if (W[j] <>'_Z_') and (W[j] <> '_E_') and (W[j] <> '') then Inc(NW);
  ProgressBar1.Min := 0;
  ProgressBar1.Max := N;
  DicPrepare(Sender);
  RichEdit2.Visible := True; Splitter1.Enabled := True;
  RichEdit2.Text := 'Немного подождите...';
  Application.ProcessMessages;
  Eol := #13#10;
  try
    RuleUsed := '';  {При успешном поиске - будет содержать примененное правило}
    NR := 0;
    j := 0;
    while j < N do begin
      if (W[j] <>'_Z_') and (W[j] <> '_E_') then begin
        CheckWord(Sender, W, j, N, RuleUsed);
        if RuleUsed <> '' then begin
          SplitStr(RuleUsed,Tmp,'|');
          for k := 0 to Tmp.Count-1 do begin
            Rules.Append(Tmp[k]);
            Inc(NR);
          end;
        end;
      end;
      Inc(j);
      ProgressBar1.Position := j;
      Application.ProcessMessages;  //*//
    end;
    Rules.Append('# Список замен. Правил: '+IntToStr(Rules.Count)+
                 ', применены: '+IntToStr(NR)+' раз к тексту из '+
                 IntToStr(NW)+' слов'+#13#10);
    RichEdit2.Text := '';
    REAppFromTS(RichEdit2,Rules);
  except
    on EOutOfMemory do begin
      Application.MessageBox(PChar(OopsMsg),'Опаньки!', MB_ICONERROR);
      Close;
    end;
  end;
finally
  FreeAndNil(XXX);
  FreeAndNil(Tmp);
  FreeAndNil(Rules);
  FreeAndNil(W);
end;
end;

{Имена и аббревиатуры в тексте}
procedure TForm1.ANamesExecute(Sender: TObject);
var
  N, j: integer;
  Words, Names: TStringList;
  w: string;
begin
try
  Words := TStringList.Create;
  Names := TStringList.Create; Names.Sorted := True;
  SplitText(RichEdit1.Text,Words);
  n := Words.Count;
  ProgressBar1.Min := 0;
  ProgressBar1.Max := N;
  RichEdit2.Visible := True; Splitter1.Enabled := True;
  RichEdit2.Text := 'Немного подождите...';
  Application.ProcessMessages;
  for j := 2 to N-1 do begin
    if (Words[j] ='_Z_') or (Words[j] ='_E_') then continue;
    if (Words[j-1] ='_Z_') or (Words[j-1] ='_E_') then continue;
    if (Words[j-1][Length(Words[j-1])] = '"') then continue;
    if ((Words[j-2] ='_Z_') or (Words[j-2] ='_E_'))
                           and ((Words[j-1] = '-') or (Words[j-1] = #150)) then continue;
    if (Tail(Words[j-2]) <> '') and (Words[j-1] = '-') then continue;
    if (Tail(Words[j-1]) <> '') and (Tail(Words[j-1]) <> ',') and
       (Tail(Words[j-1]) <> ';') then continue;
    if IsBB(Words[j]) then begin
      w := Words[j];
      w := StringReplace(w,'"','',[rfReplaceAll]);
      w := StringReplace(w,'(','',[rfReplaceAll]);
      w := StringReplace(w,')','',[rfReplaceAll]);
      w := Body(w);
      if not IsBadAbb(w,5) then Names.Append(w);
    end;
    ProgressBar1.Position := j;
    Application.ProcessMessages;  //*//
  end;
  RichEdit2.Clear;
  Names.Append('# Имен и аббревиатур: '+IntToStr(Names.Count)+#13#10);
  REAppFromTS(RichEdit2,Names);
finally
  FreeAndNil(Names);
  FreeAndNil(Words);
end;
end;

{Сравнение файлов}
procedure TForm1.AFMinusExecute(Sender: TObject);
begin
  FOper(Sender,1);
end;

procedure TForm1.AFMutualExecute(Sender: TObject);
begin
  FOper(Sender,2);
end;

procedure TForm1.AFUnionExecute(Sender: TObject);
begin
  FOper(Sender,3);
end;

procedure TForm1.FOper(Sender: TObject; Mode: integer);
var
  File1, File2, tmp, tmp1, T, Eol: string;
  TF1, TF2, TCmp: TStringList;
  i, n, j, m: integer;
begin
try
  Eol := #13#10;
  TF1 := TStringList.Create;
  TF2 := TStringList.Create;
  TF2.Sorted := True;   {! Весьма ускоряет выполнение поиска: TF2.IndexOf(TF1[i])}
  TCmp := TStringList.Create;
  TCmp.Sorted := True;  {Для придания результату благородного вида}
  tmp := OpenDialog1.Title;
  tmp1 := OpenDialog1.Filter;
  OpenDialog1.Title := 'Выберите ПЕРВЫЙ файл';
  OpenDialog1.FileName := '';
  OpenDialog1.Filter := 'Текстовые файлы (.txt)|*.txt|Словари произношения (.dic)|*.dic|Все файлы|*.*';
  if (OpenDialog1.Execute) then begin
    File1 := OpenDialog1.FileName;
    if File1 <> '' then begin
      OpenDialog1.Title := 'Выберите ВТОРОЙ файл';
      OpenDialog1.FileName := '';
      OpenDialog1.Filter := 'Текстовые файлы (.txt)|*.txt|Словари произношения (.dic)|*.dic|Все файлы|*.*';
      if (OpenDialog1.Execute) then begin
        File2 := OpenDialog1.FileName;
      end;
    end;
  end;
  OpenDialog1.Title := tmp;
  OpenDialog1.Filter := tmp1;
  if (File1 <> '') and (File2 <> '') then begin
    TF1.LoadFromFile(File1);
    TF2.LoadFromFile(File2);
    n := TF1.Count;
    ProgressBar1.Min := 0;
    ProgressBar1.Max := n;
    RichEdit2.Visible := True; Splitter1.Enabled := True;
    RichEdit2.Text := 'Немного подождите...';
    Application.ProcessMessages;
    if Mode = 1 then begin
      T := '# Разность файлов. Строк ПЕРВОГО файла, отсутствующих во ВТОРОМ: ';
      for i := 0 to n-1 do begin
        if TF2.IndexOf(TF1[i]) = -1 then TCmp.Append(TF1[i]);
        ProgressBar1.Position := i;
        Application.ProcessMessages;  //*//
      end;
    end;
    if Mode = 2 then begin
      T := '# Пересечение файлов. Строк, общих для ПЕРВОГО и ВТОРОГО файлов: ';
      for i := 0 to n-1 do begin
        if TF2.IndexOf(TF1[i]) >= 0 then TCmp.Append(TF1[i]);
        ProgressBar1.Position := i;
        Application.ProcessMessages;  //*//
      end;
    end;
    if Mode = 3 then begin
      T := '# Объединение файлов. Строк (без дубликатов) из ПЕРВОГО и ВТОРОГО файлов: ';
      {Ищем все строки 1-го, которых нет во 2-м, затем добавляем все строки из 2-го!}
      for i := 0 to n-1 do begin
        if TF2.IndexOf(TF1[i]) = -1 then TCmp.Append(TF1[i]);
        ProgressBar1.Position := i;
        Application.ProcessMessages;  //*//
      end;
      m := TF2.Count;
      for j := 0 to m-1 do TCmp.Append(TF2[j]);
    end;
    RichEdit2.Text := '# 1. '+File1+Eol+
                      '# 2. '+File2+Eol+T+IntToStr(TCmp.Count)+Eol+Eol;
    REAppFromTS(RichEdit2,TCmp);
  end;
finally
  FreeAndNil(TCmp);
  FreeAndNil(TF2);
  FreeAndNil(TF1);
end;
end;

{Выборка фрагментов текста по списку ключевых слов.
Поиск регистронезависим, ключ может содержать * в начале и/или конце}
procedure TForm1.AHuntExecute(Sender: TObject);
var
  HuntFile, tmp, L: string;
  TF, W, TCmp, WSub: TStringList;
  i, n, j: integer;
begin
try
  TF := TstringList.Create;
  TF.Sorted := True;
  W := TstringList.Create;
  WSub := TstringList.Create;
  TCmp := TstringList.Create;
  TCmp.Sorted := True;
  tmp := OpenDialog1.Title;
  OpenDialog1.Title := 'Выберите файл проверочного списка';
  OpenDialog1.FileName := '';
  if (OpenDialog1.Execute) then begin
    HuntFile := OpenDialog1.FileName;
    SplitText(RichEdit1.Text,W);
    TF.LoadFromFile(HuntFile);
    n := W.Count;
      ProgressBar1.Min := 0;
      ProgressBar1.Max := n;
      RichEdit2.Visible := True; Splitter1.Enabled := True;
      RichEdit2.Text := 'Немного подождите...';
      Application.ProcessMessages;
      for i := 0 to n-1 do begin
        if (W[i] = '') or (W[i] = '_E_') or (W[i] = '_Z_') then continue;
        Trunks(Body(W[i]),WSub,Star,Dollar);
        for j := 0 to WSub.Count-1 do begin
          if WSub[j][1] = '$' then continue;          
          if TF.IndexOf(WSub[j]) >= 0 then begin
             L := '';
             if i > 0 then if i > 1 then L := W[i-2]+' '+W[i-1]
                                    else L := W[i-1];
             if i < n-4 then L := L+' '+W[i]+' '+W[i+1]+' '+W[i+2]+' '+W[i+3]+' '+W[i+4]
                        else
             if i < n-3 then L := L+' '+W[i]+' '+W[i+1]+' '+W[i+2]+' '+W[i+3]
                        else
             if i < n-2 then L := L+' '+W[i]+' '+W[i+1]+' '+W[i+2]
                        else
             if i < n-1 then L := L+' '+W[i]+' '+W[i+1]
                        else if i < n then L := L+W[i];
             Tcmp.Append(WSub[j]+' | '+L);
             break;
          end;
        end;
        ProgressBar1.Position := i;
        Application.ProcessMessages;  //*//
      end;
      end;
      RichEdit2.Text := '# Выборка из текста "'+ExtractFileName(sFileName)+
                        '" по списку "'+ExtractFileName(HuntFile)+'"'+#13#10+#13#10;
      REAppFromTS(RichEdit2,TCmp);
    OpenDialog1.Title := tmp;
finally
  FreeAndNil(TCmp);
  FreeAndNil(W);
  FreeAndNil(WSub);
  FreeAndNil(TF);
end;
end;

{Свежий взгляд. Поиск в тексте одинаковых или похожих близко-стоящих слов.
Вдохновлено утилитой Fresh Eye Д.Кирсанова (http://www.kirsanov.com/fresheye)}
procedure TForm1.AFreshEyeExecute(Sender: TObject);
var
  Slovo, tmp, L, Eol, Freqs, Pairs: string;
  W, TCmp: TStringList;
  i, n, j, nw: integer;
begin
try
  {Наиболее часто встречающиеся 3-буквеннве слова. (90%) Сам считал :)}
  Freqs := 'что|как|его|все|это|так|еще|был|она|уже|мне|для|они|или|ему|под|'+
           'вот|чем|где|нас|раз|там|нет|кто|без|тут|при|них|вас|лет|том|сам|'+
           'ним|над|вам|два|тем|нам|тот|нее|ней|эти|мог|три|про|мой|эту|нем|'+
           'всю|тех|эта|две|оно|год|дня|дом|наш|моя|пор|той|мои|вся|мир|шел|'+
           'час|сил'+
           'the|and|you|not|was|his|she|say|her|for|are|but|can|him|out|get|'+
           'all|one|see|man|now|who|off|two|eye|how|day|way|ask|try|too|sit|'+
           'let|why|car|any|run|put|yes|old|may|cut|our|its|arm|use|big|new|'+
           'had|own';
  {Типичные пары слов. На основе исходника Д.Кирсанова + мои изыски}
  Pairs := 'белым бело|больше больше|больше более|более больше|больше меньше|'+
           'вины виноватый|волей неволей|время времени|всего навсего|даже уже|'+
           'друг друга|друг друге|друг другом|друг другу|дурак дураком|если если|'+
           'звонка звонка|конце концов|корки корки|либо либо|мало помалу|'+
           'меньше больше|начать сначала|новые новые|объять необъятное|одному тому|'+
           'полным полно|постольку поскольку|тогда когда|чуть чуть|шаг шагом'+
           'more more|better better|here there|again again|round round|'+
           'little little';
  Eol := #13#10;
  W := TstringList.Create;
  TCmp := TstringList.Create;
  SplitText(RichEdit1.Text,W);
  RichEdit2.Visible := True; Splitter1.Enabled := True;
  RichEdit2.Text := 'Немного подождите...';
  Application.ProcessMessages;
  for i := 0 to FEDeep-1 do W.Append('');  {!}
  n := W.Count;
  nw := 0;
  ProgressBar1.Min := 0;
  ProgressBar1.Max := n;
  for i := 0 to n-FEDeep do begin
    if (W[i] ='_Z_') or (W[i] ='_E_') then continue;
    if W[i] <> '' then Inc(nw);
    Slovo := AnsiLowerCase(Body(W[i]));
    L := W[i];
    for j := i+1 to i+FEDeep-1 do begin
      tmp := AnsiLowerCase(Body(W[j]));
      {Сравниваем слова, не короче 3-буквенных и не входящие во Freq и Pairs}
      if (100*Similarity(Slovo,tmp,3) > FESim-0.001)
         and (Length(Slovo) >= 3) and (Length(tmp) >= 3)
         and (Pos(Slovo,Freqs) = 0) and (Pos(tmp,Freqs) = 0)
         and (Pos(Slovo+' '+tmp,Pairs) = 0)
        then L := L +' {'+W[j]+'}'
        else L := L+' '+W[j];
    end;
    if Pos('{',L) > 0 then TCmp.Append(L+Eol);
    ProgressBar1.Position := i;
    Application.ProcessMessages;  //*//
  end;
  RichEdit2.Text := '# Свежий взгляд на текст "'+ExtractFileName(sFileName)+'"'+Eol+
                    '# Слов: '+IntToStr(nw)+'. Найдено повторов, тавтологий и созвучий: '+IntToStr(TCmp.Count)+Eol+Eol;
  REAppFromTS(RichEdit2,TCmp);finally
  FreeAndNil(TCmp);
  FreeAndNil(W);
end;
end;

procedure TForm1.ATxtPropExecute(Sender: TObject);
var
  j, N, NS, NW, AN, NL, YO, LAT: integer;
  W, R: TStringList;
  Eol, Yofication: string;
  Kbs, AL, AveWL, YOdelta: real;
begin
try
  Eol := #13#10;
  W := TStringList.Create;
  R := TStringList.Create;
  SplitText(RichEdit1.Text,W);
  N := W.Count;
  NL := RichEdit1.Lines.Count;
  NW := 0;
  NS := 0;
  AN := 0;
  YO := 0;
  LAT := 0;
  ProgressBar1.Min := 0;
  ProgressBar1.Max := N;
  for j := 0 to N - 1 do begin
    if (W[j] <>'_Z_') and (W[j] <> '_E_') and (W[j] <> '') then begin
      Inc(NW);
      Inc(NS,Length(W[j]));
      if Pos('ё',W[j]) > 0 then Inc(YO);
      if Pos('Ё',W[j]) > 0 then Inc(YO);
      if EngWord(Body(W[j])) then Inc(LAT);
      ProgressBar1.Position := j;
      Application.ProcessMessages;  //*//
    end;
    if j < N-1 then begin
      if (W[j] ='_Z_') and (W[j+1] <> '_Z_') and (W[j+1] <> '_E_') then Inc(AN);
      if (W[j] ='_E_') and (W[j+1] <> '_E_') and (W[j+1] <> '_Z_') then Inc(AN);
    end;
  end;
  RichEdit2.Visible := True; Splitter1.Enabled := True;
  RichEdit2.Text := 'Немного подождите...';
  Application.ProcessMessages;
  try
    R.Append('# Свойства текста "'+ExtractFileName(sFileName)+'"'+Eol);
    Kbs := Round(Length(RichEdit1.Text))/1024;
    AL :=  Round(Length(RichEdit1.Text))/40000;
    R.Append('Размер: '+RoundFloat(Kbs,0)+' Кб = '+RoundFloat(AL,1)+' авторских листов');
    R.Append('Знаков (без пробелов): '+IntToStr(NS));
    R.Append('Знаков (с пробелами): '+IntToStr(Length(RichEdit1.Text)-2*NL));
    R.Append('Слов: '+IntToStr(NW));
    AveWL := Round(NS)/NW;
    R.Append('Средняя длина слова: '+RoundFloat(AveWL,3));
    R.Append('Абзацев: '+IntToStr(AN));
    R.Append('Строк: '+IntToStr(NL));
    {!Доля "ё" в текстах в среднем: 0,000133}
    YOdelta := Round(YO)/NS;
    if (YOdelta >= 0.000005) and (YOdelta < 0.00005) then Yofication := 'частичная';
    if YOdelta > 0.00005 then Yofication := 'ДА';
    if YOdelta < 0.000005 then YOfication := 'нет';
    R.Append('Ёфикация: '+Yofication+' ('+IntToStr(YO)+' слов)');
    R.Append('Латиница: '+RoundFloat(100*Round(LAT)/NW,3)+'% ('+IntToStr(LAT)+' слов)');
    RichEdit2.Text := '';
    REAppFromTS(RichEdit2,R);
  except
    on EOutOfMemory do begin
      Application.MessageBox(PChar(OopsMsg),'Опаньки!', MB_ICONERROR);
      Close;
    end;
  end;
finally
  FreeAndNil(R);
  FreeAndNil(W);
end;

end;

procedure TForm1.AStatSaveAsExecute(Sender: TObject);
begin
  SaveDialog1.FileName := 'Untitled';
  if (SaveDialog1.Execute) then begin
    RichEdit2.Lines.SaveToFile(SaveDialog1.FileName);
  end;
  StatusExecute(Sender);
  RecentChange(Sender);
end;

{Закрыть окно статистики}
procedure TForm1.AStatCloseExecute(Sender: TObject);
begin
  RichEdit2.Clear;
  RichEdit2.Visible := False; Splitter1.Enabled := False;
end;
{Конец группы процедур статистики/анализа}


{Работа с профилями}
procedure TForm1.AProfileSaveExecute(Sender: TObject);
var
  CurProfile, tmp, tmp1: string;
  Small: TStringList;
begin
  SavePrefs(Sender);
  Small := TStringList.Create;
  CurProfile := extractfilepath(Application.ExeName)+'$.ini';
  Small.LoadFromFile(CurProfile);
  tmp := SaveDialog1.Title;
  tmp1 := SaveDialog1.Filter;
  SaveDialog1.Title := 'Сохранить профиль как';
  SaveDialog1.FileName := '';
  SaveDialog1.Filter := 'Файлы конфигурации (.ini)|*.ini|Все файлы|*.*';
  SaveDialog1.InitialDir := StartDir+'profiles\';
  if (SaveDialog1.Execute) then begin
    Small.SaveToFile(SaveDialog1.FileName);
  end;
  SaveDialog1.Title := tmp;
  SaveDialog1.FileName;
  Small.Free;
end;

procedure TForm1.AProfileLoadExecute(Sender: TObject);
var
  NewProfile, tmp, tmp1: string;
  Small: TStringList;
begin
  Small := TStringList.Create;
  NewProfile := extractfilepath(Application.ExeName)+'$.ini';
  tmp := OpenDialog1.Title;
  tmp1 := OpenDialog1.Filter;
  OpenDialog1.Title := 'Загрузить профиль';
  OpenDialog1.FileName := '';
  OpenDialog1.Filter := 'Файлы конфигурации (.ini)|*.ini|Все файлы|*.*';
  OpenDialog1.InitialDir := StartDir+'profiles\';
  if (OpenDialog1.Execute) then begin
    Small.LoadFromFile(OpenDialog1.FileName);
    Small.SaveToFile(NewProfile);
  end;
  OpenDialog1.Title := tmp;
  OpenDialog1.FileName;
  Small.Free;
  if OpenDialog1.FileName <> '' then begin
    RecentSave(Sender);
    SafeExit := False;
    ProgramRestart;
  end;
end;

procedure TForm1.AProfileDefaultExecute(Sender: TObject);
var
  CurProfile: string;
begin
  CurProfile := extractfilepath(Application.ExeName)+'$.ini';
  DeleteFile(CurProfile);
  SafeExit := False;
  ProgramRestart;
end;
{Конец группы работы с профилями}


procedure TForm1.AAboutExecute(Sender: TObject);
begin
  AboutBox.ShowModal;
end;


procedure TForm1.AZoomExecute(Sender: TObject);
begin
  Zoom.Timer1.Enabled := True;
  Zoom.Show;
end;


{LAME, лит.текст, стильная речь и пр.}
procedure TForm1.ASetPrefsExecute(Sender: TObject);
begin
  {запихиваем в эту форму значения имеющихся настроек}
  GetOtherPrefs(Sender);
  PrefsBox.cbConverter.ItemIndex := AudioConverter;
  PrefsBox.cbBitRate.ItemIndex := BRate;
  PrefsBox.cbQuality.ItemIndex := Qual;
  PrefsBox.eAllParam.Text := AllPar;
  PrefsBox.chkbConvMinimize.Checked := ConvMinimize;
  PrefsBox.chkbAudioFromTop.Checked := AudioFromTop;
  PrefsBox.chkbAudioSplit.Checked := AudioSplit;
  PrefsBox.chkbHeader.Checked := BHeader;
  PrefsBox.eAbzac.Text := IntToStr(Abzac);
  PrefsBox.eMaxLen.Text := IntToStr(MaxL);
  PrefsBox.eHugeLen.Text := IntToStr(HugeL);
  PrefsBox.chkbRJust.Checked := RJust;
  PrefsBox.chkbStyle.Checked := IgnRul;
  PrefsBox.chkbPrev.Checked := IgnPrev;
  if (NB > 0) and (NB < 500)  then NB := 500;
  PrefsBox.eNB.Text := inttostr(NB);
  PrefsBox.chkbChap.Checked := NewChap;
  {Кстати, при ОЧЕНЬ МАЛОМ размере фрагмента - чтение будет отдельными абзацами!}
  if FragSize = 1 then FragSize := 2;
  PrefsBox.eNF.Text := IntToStr(FragSize);
  if FEDeep = 0 then FEDeep := 1;
  if FEDeep > 20 then FEDeep := 20;
  if FESim < 1 then FESim := 1;
  if FESim > 100 then FESim := 100;
  PrefsBox.eFE1.Text := IntToStr(FEDeep);
  PrefsBox.eFE2.Text := FloatToStr(FESim);
  PrefsBox.chkbTags.Checked := not XML;
  PrefsBox.AutoCap.Checked := AutoCapFlag;
  PrefsBox.AutoRepl.Checked := AutoReplFlag;
  PrefsBox.AutoParag.Checked := AutoParagFlag;
  PrefsBox.AutoAloud.Checked := AutoAloudFlag;
  PrefsBox.AutoAloudP.Checked := AutoAloudPredl;
  PrefsBox.AutoAloudA.Checked := AutoAloudAbzac;
  PrefsBox.chkbPicImport.Checked := PicImport;
  if (NRepeat = 0) then NRepeat := 1;
  if (NRepeat > 10) then NRepeat := 10;
  PrefsBox.eRepeat.Text := IntToStr(NRepeat);
  if NPicMargin < 100 then NPicMargin := 100;
  if NPicMargin > Screen.Width-200 then NPicMargin := Screen.Width-100;
  PrefsBox.ePicMargin.Text := IntToStr(NPicMargin);
  {А теперь: открываем окно настроек, запретив доступ к главному
  окну, пока окно настроек не будет закрыто пользователем. Сработает
  только при PrefsBox.Visivle = False - но это так и есть}
  PrefsBox.ShowModal;
  GetOtherPrefs(Sender);  {Уже измененные настройки!}
  if PicImport then begin
    if NPicMargin < 100 then NPicMargin := 100;
    if NPicMargin > Form1.ClientWidth-146 then NPicMargin := Form1.ClientWidth-146;
    PicShow(Sender);
  end else begin
    Form1.Panel1.Visible := False;
    ToolBar3.Visible := False;
  end;
  StatusExecute(sender);
end;


procedure TForm1.GetGeneralPrefs(Sender: TObject);
var
  Ini: TIniFile;
  DefaultSpeedAudio: integer;
begin
   if not FileExists('$.ini') then Form1.Position := poDesktopCenter;
   {--- Читаем настройки окна программы, движка и RichEdit из ini-файла ---}
   Ini:=TiniFile.Create(extractfilepath(Application.ExeName)+'$.ini');
   if SAPI5_Flag then DefaultSpeedAudio := 18
                 else DefaultSpeedAudio := 7; //2;
   SpeedAudio := Ini.ReadInteger('Audio','XNumber',DefaultSpeedAudio);
   ComboBox1.ItemIndex := Ini.ReadInteger('SpeechEngine','Number',0);
   if ComboBox1.ItemIndex < 0 then ComboBox1.ItemIndex := 0;
   SelVoice := ComboBox1.ItemIndex;
   SelSpeedVoice := Ini.ReadInteger('SpeechEngine','Speed',0);
   SelPitchVoice := Ini.ReadInteger('SpeechEngine','Pitch',0);
   sDicName := Ini.ReadString('SpeechEngine','Dictionary','');
   if not FileExists(sDicName) then begin
     sDicName := '';
     TBDicShut(Sender);
   end;
   Form1.Left :=  Ini.ReadInteger('Form','LeftCorner',-1);
   Form1.Top :=  Ini.ReadInteger('Form','TopCorner',-1);
   Form1.Width :=  Ini.ReadInteger('Form','Width',714);
   Form1.Height :=  Ini.ReadInteger('Form','Height',584);
   if ParamCount = 0 then sFileName := Ini.ReadString('Text','FileName','')
                     else sFileName := ParamStr(1);
   try
     with RichEdit1 do begin
       Font.Name := Ini.ReadString('Font','Name','');
       Font.Size := Ini.ReadInteger('Font','Size',10);
       Font.CharSet := Ini.ReadInteger('Font','CharSet',1);
       Font.Color := Ini.ReadInteger('Font','Color',0);
       FontStyleInt := Ini.ReadInteger('Font','Style',0);
       Move(FontStyleInt, FS, 1);
       Font.Style := FS;
     end;
   finally
   end;
   SelColor := Ini.ReadInteger('Background','Color',-16777211);
   ColorDialog1.Color := SelColor;
   RichEdit1.Color := SelColor;
   if not IgnPrev then begin
     RichEdit1.WordWrap := Ini.ReadBool('Text','WordWrap',False);
     NFormatWrap.Checked := RichEdit1.WordWrap;
   end;
   NPicMargin := Ini.ReadInteger('Text','PicMargin',550);
   if NPicMargin < 100 then NPicMargin := 100;
   if NPicMargin > Form1.ClientWidth-146 then NPicMargin := Form1.ClientWidth-146;
   if (sFileName <> '') and (not IgnPrev) then begin
     LineNum := Ini.ReadInteger('Text','LineNum',0);
     CharPos := Ini.ReadInteger('Text','CharPos',0);
     if ParamCount > 0 then begin
       LineNum := 0;
       CharPos := 0;
     end;
     IPic := Ini.ReadInteger('Text','PicNumber',0);
     BookMarks := Ini.ReadString('Text','BookMarks','');
     if FileExists(sFileName) then begin
       XOpen(Sender,sFileName);
       RecentChange(Sender);
     end else begin
       sFileName := '';
       StatusExecute(Sender);
     end;
     PicShow(Sender);
     with RichEdit1 do
     begin
       SelStart := 0;
       SelLength := Length(Text);
       SelAttributes.Assign(Font);
       SelLength := 0;
       SelStart:=perform(EM_LineIndex,LineNum,0)+CharPos;
       perform(EM_ScrollCaret,0,0);
       StatusExecute(Sender);
     end;
   end;
end;


procedure TForm1.GetOtherPrefs(Sender: TObject);
var
  Ini: TIniFile;
begin
  Ini:=TiniFile.Create(extractfilepath(Application.ExeName)+'$.ini');
  AudioConverter := Ini.ReadInteger('AudioConverter','ACNumber', 1);
  if AudioConverter < 0 then AudioConverter := 1;  
  BRate := Ini.ReadInteger('AudioConverter','BRNumber',4);
  Qual := Ini.ReadInteger('AudioConverter','QNumber',2);
  AllPar := Ini.ReadString('AudioConverter','AllParam','-b64 -h');
  ConvMinimize := Ini.ReadBool('AudioConverter','ConverterMinimize',False);
  AudioFromTop := Ini.ReadBool('AudioConverter','AudioFromTop',True);
  AudioSplit := Ini.ReadBool('Series','AudioSplit',False);
  Abzac := Ini.ReadInteger('LitText','Parag',4);
  MaxL := Ini.ReadInteger('LitText','MaxLen',76);
  HugeL := Ini.ReadInteger('LitText','MaxHugeLen',228);
  RJust := Ini.ReadBool('LitText','RightJustify',False);
  NB := Ini.ReadInteger('Series','BytesInBlock',32768);
  NewChap := Ini.ReadBool('Series','ChapHeadSencitive',True);
  BHeader := Ini.ReadBool('Series','Header',False);
  FEDeep := Ini.ReadInteger('FreshEye','Deep',11);
  FESim := Ini.ReadInteger('FreshEye','Similarity',50);
  FragSize := Ini.ReadInteger('Others','BytesInFrag',4096);
  IgnRul := Ini.ReadBool('Others','IgnoreRules',False);
  IgnPrev := Ini.ReadBool('Others','IgnorePrev',False);
  XML := Ini.ReadBool('Others','IsXML',False);
  AutoCapFlag := Ini.ReadBool('Text','AutoCap',False);
  AutoReplFlag := Ini.ReadBool('Text','AutoRepl',False);
  AutoParagFlag := Ini.ReadBool('Text','AutoParag',False);
  AutoAloudFlag := Ini.ReadBool('Text','AutoAloud',False);
  AutoAloudPredl := Ini.ReadBool('Text','AutoAloudP',True);
  AutoAloudAbzac := Ini.ReadBool('Text','AutoAloudA',False);
  NRepeat := Ini.ReadInteger('Text','AutoRepeat',1);
  PicImport := Ini.ReadBool('Text','PicImport',False);
  NPicMargin := Ini.ReadInteger('Text','PicMargin',550);
  NScale := Ini.ReadInteger('Text','Scale',100);
end;


{Добавление закладки в текст. Позиции закладок хранятся в строке BookMarks}
procedure TForm1.AZakAddExecute(Sender: TObject);
begin
  if BookMarks <> '' then BookMarks := BookMarks+'|'+IntToStr(RichEdit1.SelStart)
                     else BookMarks := IntToStr(RichEdit1.SelStart);
  NZakladGo.Enabled := True;
end;

{Составление и показ списка закладок. Переход по выбранной или редактирование списка}
procedure TForm1.AZakGoExecute(Sender: TObject);
var
   Tmp: TStringList;
   i, m, n, p: integer;
   bmt, sn, c: string;
begin
try
  ZakBox.ListBox1.Items.Clear;
  Tmp := TStringList.Create;
  SplitStr(BookMarks,Tmp,'|');
  m := Length(RichEdit1.Text);
  n := Tmp.Count;
  for i := 0 to n-1 do begin
    p := StrToInt(Tmp[i]);
    if m > 0 then c := IntToStr(100*p div m)
             else c := '0';
    if c = '0' then c := '1';                                                     
    while Length(c) < 2 do c := '0'+c;
    sn := IntToStr(i+1);
    while Length(sn) < 3 do sn := '0'+sn;
    {Позицию закладки храним в конце строки, так далеко, что в окне не видать :)}
    bmt := Copy(RichEdit1.Text,p,115)+StringOfChar(' ',200)+'_#_'+Tmp[i];
    bmt := StringReplace(bmt,#13,' ',[rfReplaceAll]);
    bmt := StringReplace(bmt,#10,' ',[rfReplaceAll]);
    ZakBox.ListBox1.Items.Add(sn+'  ('+c+')  '+bmt);
  end;
  ZakBox.ListBox1.ItemIndex := 0;
  ZakBox.ShowModal;
finally
  Tmp.Free;
end;
end;


procedure TForm1.AHelpExecute(Sender: TObject);
var
  HelpFile: string;
begin
  Helpfile := StartDir+'\Demagog.chm';
  if FileExists(HelpFile) then begin
    ShellExecute(handle,nil,PChar(HelpFile),nil,nil,SW_RESTORE);
  end
  else Application.MessageBox(PChar('Не найден файл помощи '+HelpFile),'Demagog',MB_ICONWARNING);
end;


{Переключение SAPI4 / SAPI5}
procedure TForm1.ASAPIExecute(Sender: TObject);
var
  i: integer;
begin
  if Pause then TTSResume;
  TTSStop;
  if SAPI5_Flag then
    for i := 0 to ComboBox1.Items.Count - 1 do
      if ComboBox1.Items.Objects[i] <> nil then
        ISpeechObjectToken(Pointer(ComboBox1.Items.Objects[i]))._Release;
  ComboBox1.ItemIndex := 0;
  SAPI5_Flag := not SAPI5_Flag;
  SAPIChanged := True;
  if sDicName <> '' then begin
    sDicName := '';
    TBDicShut(Sender);
  end;
  if SAPI5_Flag then SpeedAudio := 18
                else SpeedAudio := 7; //2;
  VoicesListCreate(Sender);
  ComboBox1Change(Sender);
  StatusExecute(Sender);
end;


{Редактировать словарь}
procedure TForm1.AEditDicExecute(Sender: TObject);
begin
  if sDicName = '' then begin
    OpenDialog3.FileName := '';
    if (OpenDialog3.Execute) then begin
      PubDicName := OpenDialog3.FileName;
    end;
  end
  else PubDicName := sDicName;
  if PubDicName <> '' then begin
    with RichEdit1 do begin  {Шрифт словаря - такой же, как в основном окне}
      DicBox.Dict.Font.Name := Font.Name;
      DicBox.Dict.Font.Size := Font.Size;
      DicBox.Dict.Font.CharSet := Font.CharSet;
      DicBox.Dict.Font.Color := Font.Color;
      DicBox.Dict.Font.Style := FS;
    end;
    DicBox.Caption := 'Редактировать словарь '+ExtractFileName(PubDicName);
    DicBox.Dict.Lines.LoadFromFile(PubDicName);
    DicBox.ShowModal;
  end;
end;


{Прочесть из хеш-таблицы теги стильной речи для: пустой строки; абзаца; кратных
препинаний; прямой речи; конца прямой речи; комментария; конца комментария.
А также обработать правило для запрещенных к произнесению слов.
Кратные препинания: ... !.. ?? !? !!! и т.п. с числом символов > 1.
Прямая речь: "- Элементарно, Ватсон!". Комментарий: " - рассмеялся Холмс".
Запрещающее правило: _CENZ_=маска1 маска2 ...
Например: _CENZ_=[*] <*>- не произносить слова в квадратных и угловых скобках}
procedure TForm1.GetTags(Sender: TObject);
  function TagFrom(const S: string): string;
  var
    k: integer;
  begin
    k := PosCh('=',S);
    if k > 0 then Result := Copy(S,k+1,Length(S)-k)
             else Result := '';
  end;
var
  i0, N: integer;
begin
  N := XXX.Count;
  _E_ := ''; _Z_ := ''; _S_ := ''; _D_ := ''; _XD_ := ''; _C_ := ''; _XC_ := '';
  _CENZ_ := ''; _INIT_ := '';
  HFind(xxx,'_E_',N,i0); _E_ := TagFrom(xxx[i0]);
  HFind(xxx,'_Z_',N,i0); _Z_ := TagFrom(xxx[i0]);
  HFind(xxx,'_S_',N,i0); _S_ := TagFrom(xxx[i0]);
  HFind(xxx,'_D_',N,i0); _D_ := TagFrom(xxx[i0]);
  HFind(xxx,'_XD_',N,i0); _XD_ := TagFrom(xxx[i0]);
  HFind(xxx,'_C_',N,i0); _C_ := TagFrom(xxx[i0]);
  HFind(xxx,'_XC_',N,i0); _XC_ := TagFrom(xxx[i0]);
  HFind(xxx,'_CENZ_',N,i0); _CENZ_ := TagFrom(xxx[i0]);
  HFind(xxx,'_INIT_',N,i0); _INIT_ := TagFrom(xxx[i0]);
end;


{Подключение/(отключение) словаря произношения.
Получим заполненный TStringList, в котором строки
(кроме комментариев) имеют вид Mask=Dest}
procedure TForm1.ADicExecute(Sender: TObject);
begin
  if sDicName = '' then begin   {подключаем}
    {По умолчанию искать словарь в подкаталоге dic каталога программы}
    OpenDialog3.InitialDir := StartDir+'dic\';
    //OpenDialog3.FileName := '';
    if (OpenDialog3.Execute) then begin
      sDicName := OpenDialog3.FileName;
      TBDicOpen(Sender);
    end;
    PubDicName := sDicName;
    exit;
  end;
  if sDicName <> '' then begin  {отключаем}
    sDicName := '';
    TBDicShut(Sender);
    PubDicName := '';
    exit;
  end;
end;


procedure TForm1.TBDicOpen(Sender: TObject);
begin
  TBDic.ImageIndex := 8;
  NSpeakDic.ImageIndex := 8;
  TBDic.Hint := 'Словарь|'+ExtractFileName(sDicName);
  NSpeakDic.Hint := 'Словарь|'+ExtractFileName(sDicName);
  NPrefsChangeText.Enabled := True;
  NPrefsRulesToText.Enabled := True;
  NPrefsStat1.Enabled := True;
  NPrefsStat2.Enabled := True;
  NPopChangeText.Enabled := True;
  NPopRulesToText.Enabled := True;
end;


procedure TForm1.TBDicShut(Sender: TObject);
begin
  TBDic.ImageIndex := 20;
  NSpeakDic.ImageIndex := 20;
  TBDic.Hint := 'Словарь|Подключить словарь произношения';
  NSpeakDic.Hint := 'Словарь|Подключить словарь произношения';
  NPrefsChangeText.Enabled := False;
  NPrefsRulesToText.Enabled := False;
  NPrefsStat1.Enabled := False;
  NPrefsStat2.Enabled := False;
  NPopChangeText.Enabled := False;
  NPopRulesToText.Enabled := False;
end;


{Заполнение хеш-таблицы с линейным зондированием. Ее размер - всегда простое
число, первое, следующее за утроенным размером словаря. Таблица заполняется
"вразброс" всего на 1/3, что практически избавляет от коллизий, и обеспечивает
быстрый поиск. Кстати, и множитель 2 вполне хорош, и даже 3/2 - неплох! А если
взять 1 (полное заполнение хеш-таблицы - теорией НЕ рекомендуется), то время
поиска в словаре будет на 60-65% больше по сравнению с множителем 3}

//function SortByLenDegrad(List: TStringList; I1, I2: integer): integer;
//begin
//  if Length(List[i1]) > Length(List[i2]) then Result := -1;
//  if Length(List[i1]) < Length(List[i2]) then Result := 1;
//  if Length(List[i1]) = Length(List[i2]) then Result := 0;
//end;

{Отсортировать список по убыванию длины строк, сохранив взаимный порядок строк одинаковой длины}
procedure SortByLenDegrad(var G: TStringList);
var
  i, i0, j, MaxLen: integer;
  tmp: TStringList;
begin
  tmp := TStringList.Create;
  for j := 0 to G.Count-1 do begin;
    MaxLen := 0;
    for i := 0 to G.Count-1 do begin
      if Length(G[i]) > MaxLen then begin  {СТРОГОЕ неравенство - это важно!}
        MaxLen := Length(G[i]);
        i0 := i;
      end;
    end;
    tmp.Add(G[i0]); G[i0] := '';
  end;
  G.Clear; G.AddStrings(tmp);
  tmp.Free;
end;

procedure TForm1.DicPrepare(Sender: TObject);
var
  i, ts, i0, l, k: integer;
  first, others, tmp, left: string;
  Dic, G: TStringList;
begin
try
  Dollar := False;
  Star := False;
  Dic := TStringList.Create;
  G := TStringList.Create;
  Dic.LoadFromFile(sDicName);
  ts := FirstSimpleAfter(3*Dic.Count);
  for i := 0 to ts-1 do xxx.Add('');
  for i := 0 to Dic.Count-1 do begin
    if Dic[i] = '' then continue;
    if (Pos('##',Dic[i]) = 0) and (Dic[i][1] = '#') then continue;
    left := RuleLeft(Dic[i]);
    if (left <> '') then begin
      if not Star then if PosCh('*',left) > 0 then Star := True;
      if not Dollar and (Length(left) > 1) then if (left[1] = '$') and (left[2] <> '$') then Dollar := True;
      first := FirstWord(left);
      if Dic[i][1] ='#' then begin
                          tmp := Copy(Dic[i],2,Length(Dic[i])-1);
                          first := Copy(first,2,Length(first)-1)
                        end
                        else tmp := Dic[i];
      {игнорируем странные правила вида: *пробел(ы)=}
      if (Pos('* ',tmp) = 1) and (Trim(Copy(tmp,2,PosCh('=',tmp)-2)) = '') then continue;
      {Левая часть правил без $ должна быть в нижнем регистре}
      if not (tmp[1] in ['$','_']) then begin
        k := LastPosCh('=',tmp);
        tmp := AnsiLowerCase(Copy(tmp,1,k))+Copy(tmp,k+1,Length(tmp)-k);
        first := AnsiLowerCase(first);
      end;
      //////////////////////////////////////////////////////////////////////////
      //В словарях принято удваивать 1-ю и последнюю звездочки в маске, чтобы
      //они считались ПРОСТО СИМВОЛАМИ и участвовали в заменах. Чистим правила,
      //но не сам ключ first. Потом станет понятно, почему этого достаточно :)
      if Length(tmp) > 2 then begin
        if Copy(tmp,1,2) = '**' then Delete(tmp,1,1);
        k := PosCh('=',tmp);
        if Copy(tmp,k-2,2) = '**' then Delete(tmp,k-1,1);
      end;
      //////////////////////////////////////////////////////////////////////////
      HFind(xxx,first,ts,i0);  {Адрес (i0), куда пихать очередную строку}
      if xxx[i0] = '' then xxx[i0] := first+'|'+tmp
                      else xxx[i0] := xxx[i0]+'|'+tmp;
    end;
  end;
finally
  FreeAndNil(Dic);
end;
{Получили хеш-таблицу. В тех ее строках, где сидит несколько правил -
сортируем правила в порядке убывания длины}
try
  for i := 0 to ts-1 do if xxx[i] <> '' then begin
    k := PosCh('|',xxx[i]);
    first := Copy(xxx[i],1,k-1);
    others := Copy(xxx[i],k+1,Length(xxx[i]));
    SplitStr(others,G,'|');
//    G.CustomSort(SortByLenDegrad);
    SortByLenDegrad(G);
    tmp := first;
    for l := 0 to G.Count-1 do begin
      tmp := tmp+'|'+G[l];
    end;
    xxx[i] := tmp;
  end;
finally
  FreeAndNil(G);
end;
end;


{Замены в строке BufRich по словарю формата Dic}
procedure TForm1.Filter(Sender: Tobject; var BufRich: string; IgnRul: boolean;
                        Fancy: boolean = False);
var
  j, N: integer;
  Words: TStringList;
  RuleUsed: string;
  MustDie: boolean;
begin
try
  Words := TStringList.Create;
  XXX := TStringList.Create;
  SplitText(BufRich,Words);  {Список всех слов текста}
  N := Words.count;
  ProgressBar1.Min := 0;
  ProgressBar1.Max := N;
  DicPrepare(Sender);  {Заполняем словарную хеш-таблицу XXX}
  GetTags(Sender);  {Читаем из нее теги стильной речи}

  //xxx.SaveToFile('xxx');  //отладочный вывод

  {Идем по тексту, слово за словом}
  try
    MustDie := False;
    RuleUsed := '';  {Здесь - не используется, но параметр должен быть указан}
    j := 0;
    while j < N do begin
      if not IgnRul and Cenzored(Words[j],_CENZ_,MustDie) then Words[j] := '';
      if (Words[j] <>'_Z_') and (Words[j] <> '_E_') then CheckWord(Sender, Words, j, N, RuleUsed);
      Inc(j);
      ProgressBar1.Position := j;
      Application.ProcessMessages;  //*//
    end;
    ProgressBar1.Position := 0;
    JoinList(Words,BufRich,IgnRul,Fancy);
  except
    on EOutOfMemory do begin
      Application.MessageBox(PChar(OopsMsg), 'Опаньки!', MB_ICONERROR);
      Close;
    end;
  end;
finally
  {Зачистка всех TStringList, иначе получим утечку памяти!}
  FreeAndNil(XXX);
  FreeAndNil(Words);
end;
end;


{Проверка, есть ли j-е слово текста в словарной хеш-таблице, если да, то замена.
Строка таблицы: слово|слово(сочетание)=замена1|слово(сочетание)=замена2|...
Примеры: все|всё равно<|всё верно|всё обман|всё дозволено|всё пройдет
         космопорт*|космопорт*=космопо<рт
         *ей|*ей руки=ей руки<|*ей свечи=ей свечи<|*ей орды=ей орды<
Слово ищем в хеш-таблице в вариантах:
'$'+слово; 'слово'; $+'очередной огрызок слова'; 'очередной огрызок слова'
Огрызки (со * слева, справа, с обеих сторон) перебираются по убыванию длины}
procedure TForm1.CheckWord(Sender: TObject;
    var Words: TStringList; var j: integer; N: integer; var RuleUsed: string);
var
  t, i0, i, k, l, M, M1, z, ts: integer;
  Mask, Dest, Tmp, w, w0: string;
  wsub, G, WS, WD: TStringList;
  Caps, Success, Proba, CaseSensitive, NakedStars: boolean;
begin
try
  if Words[j] = '' then exit;
  Wsub := TStringlist.Create;
  G := TStringList.Create;
  WS := TStringList.Create;
  WD := TStringList.Create;
  ts := xxx.Count;
  Trunks(Words[j],Wsub,Star,Dollar);
  RuleUsed := '';
  for t := 0 to Wsub.Count-1 do begin   {ЦИКЛ по огрызкам слова. 1-й - само слово}
    if not HFind(xxx,Wsub[t],ts,z) then continue;
    if (wsub[t][1] <> '$') then begin  {Слово проверяется без учета регистра}
      if IsBB(words[j]) {и, если оно с большой буквы...}
        then Caps := True
        else Caps := False;
      w := AnsiLowerCase(Words[j]);  w0 := Words[j];
      CaseSensitive := False;
    end else begin
      w := '$'+Words[j]; w0 := w;
      Caps := False;
      CaseSensitive:=True;
    end;
    Success := False;
    SplitStr(xxx[z],G,'|');  {G[0] - ключ (нам не нужен), остальное - правила}
    for i := 1 to G.Count-1 do begin  {Ищем в строке подходящее правило}
      Mask := TrimRight(RuleLeft(G[i]));
      {!!! Флаг сравнения не по маске, а на простое равенство строк}
      if IsNakedStars(Mask) then NakedStars := True else NakedStars := False;
      SplitStr(Mask,WS);
      M := WS.Count;  {В маске может быть больше одного слова!}
      if M = 0 then exit;  {А в словаре м.б. ошибки :)}
      Tmp := w; if (w <> '') and (w[1] = '$') then Tmp := '$'+Body(Copy(w,2,Length(w)-1))+Tail(w);
      if (M > 1) and (j <= N-M) then for k := j+1 to j+M-1 do Tmp := Tmp+' '+Words[k];
      if not CaseSensitive then Tmp := AnsiLowerCase(Tmp);
      if not NakedStars then begin
        if StarTail(Mask) <> '' then Proba := MatchStrings(Tmp,Mask)
                                else
        if Tail(Mask) = '' then Proba := MatchStrings(Body(Tmp),Mask)
                           else if Quotes(Mask) <> '' then Proba := MatchStrings(Tmp,Mask)
                                                      else Proba := MatchStrings(KillRQuotes(Tmp),Mask);
        end else Proba := (Body(Tmp) = Mask);  {!!!}
      if Proba then begin
        Success := True;
        i0 := i;
        break;
      end;
    end;
    {Если слово(сочетание) найдено, то замена}
    if Success then begin
      Dest := RuleRight(G[i0]);
      if M = 1 then begin
        Words[j] := FilterByMask(w0,Mask,Dest);
        {"Восстанавливаем" большую 1-ю букву в слове}
        if Caps then Words[j] := BB(Words[j]);
        {Правила, примененные к данному слову}
        if RuleUsed = '' then RuleUsed := Mask+'='+Dest else RuleUsed := RuleUsed+'|'+Mask+'='+Dest;
      end;
      if (M > 1) and (j <= N-M) then begin
        SplitStr(Dest,WD);
        {! Приводим в равновесие левую и правую части}
        for l := 0 to M-1 do begin
          if l > WD.Count-1 then WD.Add('');
          if (WS[l] ='*') and (WD[l] <> '') then WD.Insert(l,'');
        end;
        M1 := WD.Count;
        for l := M1-1 downto M do begin
          WD[l-1] := WD[l-1]+' '+WD[l];
          WD[l] := '';
        end;
        {Замена M слов, начиная с j-го}
        Words[j] := FilterByMask(w0,WS[0],WD[0]);
        if CaseSensitive
          then for k := j+1 to j+M-1 do Words[k] := FilterByMask(Words[k],WS[k-j],WD[k-j])
          else for k := j+1 to j+M-1 do Words[k] := FilterByMask(AnsiLowerCase(Words[k]),WS[k-j],WD[k-j]);
        if Caps then Words[j] := BB(Words[j]);
        if RuleUsed = '' then RuleUsed := Mask+'='+Dest else RuleUsed := RuleUsed+'|'+Mask+'='+Dest;
      end;
    end;
  end;  {ЦИКЛ по огрызкам}
finally
  FreeAndNil(Wsub);
  FreeAndNil(G);
  FreeAndNil(WS);
  FreeAndNil(WD);
end;
end;


{Склеивает список в строку с разделителем слов - пробелом и вставляет теги
стильной речи. Единственное место в програме, где употребен оператор goto :)
P.S. Переменная br использована красоты ради, а не пользы для}
procedure TForm1.JoinList(var Words: TStringList; var S: string; IgnRul: boolean;
                          Fancy: boolean = False);
var
  N, j: integer;
  w, br, Stops: string;
  flagD, flagC: boolean;
label
  fin;
begin
  if Fancy then br := #13#10
           else br := '';
  N := Words.Count;
  if IgnRul then begin  {Все делаем по рабоче-крестьянски: раз-два и готово...}
    S := '';
    for j := 0 to N-1 do begin
      if (Words[j] = '_E_') or (Words[j] = '_Z_') then Words[j] := br;
      S := S+' '+Words[j];
    end;
    exit;
  end;
  {...Иначе разбираем текст по серьезному}
  S := _INIT_;
  flagD := False;
  flagC := False;
  Words.Add(' '); {Проверки комбинаций идут по 3 или по 2 слова подряд...}
  Words.Add(' '); {...и мы подстраховались :)}
  for j := 0 to N-1 do begin
    w := '';
    {Начало прямой речи (если НЕ было): абзац или пустая строка, тире, большая
    буква. Если строки прямой речи идут подряд без комментариев, то так мы
    избегаем вставок лишних пар "конецПР"+"началоПР"}
    if ((Words[j] ='_Z_') or (Words[j] ='_E_')) and ((Words[j+1] = '-') or (Words[j+1] = #150))
          and IsBB(Words[j+2]) then begin
      w := w+br;
      if not flagD then begin
        flagD := True;
        w := br+_Z_+' '+_D_;
      end;
      goto fin;
    end;
    {Конец прямой речи, (если была): абзац или пустая строка, большая буква}
    if flagD and ((Words[j] ='_Z_') or (Words[j] ='_E_'))
          and IsBB(Words[j+1]) then begin
      flagD := False;
      w := _XD_+' '+br+_Z_;
      goto fin;
    end;
    {Конец прямой речи, (если была) и начало комментария:
    препинание, тире}
    if flagD and (Tail(Words[j]) <> '') and ((Words[j+1] = '-') or (Words[j+1] = #150)) then begin
      flagD := False;
      flagC := True;
      w := Words[j];
      Stops := Tail(KillRQuotes(w));
      if (Length(Stops) > 1) or (Stops = #133) then w := w+' '+_S_;  {Кратное препинание!}
      w := w+' '+_XD_+' '+_C_;
      goto fin;
    end;
    {Конец комментария, (если был) и начало прямой речи:
    препинание, тире}
    if flagC and (Tail(Words[j]) <> '') and ((Words[j+1] = '-') or (Words[j+1] = #150)) then begin
      flagD := True;
      flagC := False;
      w := Words[j];
      if Length(Tail(w)) > 1 then w := w+' '+_S_;
      w := w+' '+_XC_+' '+_D_;
      goto fin;
    end;
    {Конец комментария, (если был): абзац, большая буква}
    if flagC and (Words[j] ='_Z_') and IsBB(Words[j+1]) then begin
      flagC := False;
      w := _XC_+' '+br+_Z_;
      goto fin;
    end;
    {Раз мы здесь, то ни одна из проверок не сработала, вставок не сделано}
    w := Words[j];
    Stops := Tail(KillRQuotes(w));
    if (Length(Stops) > 1) or (Stops = #133) then w := w+' '+_S_;
    {Пустые и красные строки}
    if w = '_E_' then w := br+_E_;
    if w = '_Z_' then w := br+_Z_;
    fin:
    if Body(w) = '' then S := S+w  {Лепим вплотную пустые слова, м.б. с препинаниями...}
                    else if IsMarked(w) then S := S+UnMark(w)  {...и "охвостки"}
                                        else S := S+' '+w;
  end;
end;


{Показывает фрагмент преобразованного текста. Либо выделенного,
либо от позиции курсора; но, в обоих случаях, не более 1024 символов}
procedure TForm1.AChangeTextExecute(Sender: TObject);
var
  S, T: string;
begin
  if sDicName = '' then exit;
  if RichEdit1.SelLength > 0
    then S := Copy(RichEdit1.SelText, 1,1024)
    else S := Copy(RichEdit1.Text, RichEdit1.SelStart+1,1024);
  T := 'Текст, измененный по '+ExtractFileName(sDicName);
  Filter(Sender,S,IgnRul,True);
  Application.MessageBox(PChar(S), PChar(T), MB_OK);
end;


{Аналогично. Показывает правила произношения, примененые к фрагменту текста}
procedure TForm1.ARulesToTextExecute(Sender: TObject);
var
  j, N: integer;
  W: TStringList;
  RuleUsed, Tmp, Eol, S, T: string;
begin
  if sDicName = '' then exit;
  try
    Eol := #13#10;
    W := TStringList.Create;
    XXX := TStringList.Create;
    if RichEdit1.SelLength > 0
      then S := Copy(RichEdit1.SelText,1,1024)
      else S := Copy(RichEdit1.Text,RichEdit1.SelStart+1,1024);
    SplitText(S,W);
    N := W.count;
    ProgressBar1.Min := 0;
    ProgressBar1.Max := N;
    DicPrepare(Sender);
    try
      Tmp := '';
      RuleUsed := '';
      j := 0;
      while j < N do begin
        if (W[j] <>'_Z_') and (W[j] <> '_E_') then begin
          CheckWord(Sender, W, j, N, RuleUsed);
          if (RuleUsed <> '') and (Pos(RuleUsed,Tmp) = 0) then begin
            if tmp = '' then Tmp := Tmp+RuleUsed
                        else Tmp := Tmp+Eol+RuleUsed;
          end;
        end;
        Inc(j);
        ProgressBar1.Position := j;
        Application.ProcessMessages;  //*//
      end;
      Tmp := StringReplace(Tmp,'|',Eol,[rfReplaceAll]);
      ProgressBar1.Position := 0;
      T := 'Правила по '+ExtractFileName(sDicName);
      Application.MessageBox(PChar(Tmp), PChar(T), MB_OK);
   except
      on EOutOfMemory do begin
        Application.MessageBox(PChar(OopsMsg), 'Oпаньки!', MB_ICONERROR);
        Close;
      end;
    end;
  finally
    FreeAndNil(XXX);
    FreeAndNil(W);
  end;
end;


{Прием файлов в окно редактора методом Drag&Drop (перетаскиванием)}
procedure TForm1.DragText(var Message: TWMDROPFILES);
begin
  DragQueryFile(Message.Drop, 0, @abuffer, sizeof(abuffer));
  try
    sFileName := abuffer;
    XOpen(nil,sFileName);
    RecentChange(nil);
  except
  end;
end;

{ ------------- SAPI5. Здесь описаны функции слежения за чтением ------------- }

{Я грубо разделался с изысками Б.Лонга :). Мне из 6 функций нужны лишь 2}
//procedure TForm1.SetTextHilite(FirstChar, Len: Integer);
//begin
//  RichEdit1.SelStart := FirstChar + StartPos-1;  {Выделяем с заданной позиции}
//  RichEdit1.SelLength := Len;
//  RichEdit1.Perform(EM_SCROLLCARET,0,0);
//end;

//procedure TForm1.SetTextStyle(FirstChar, Len: Integer; Styles: TFontStyles);
//begin
//  with RichEdit1 do begin
//    Lines.BeginUpdate;
//    try
//      SelStart := FirstChar;  {Выделяем с заданной позиции...}
//      SelLength := Len;
//      SelAttributes.Style := Styles;  {Применяем к выделенному требуемый стиль}
//      SelLength := 0;  {Гасим выделение}
//    finally
//      Lines.EndUpdate
//    end
//  end
//end;

procedure TForm1.SpVoiceStartStream(Sender: TObject;
  StreamNumber: Integer; StreamPosition: OleVariant);
begin
  {}
end;

procedure TForm1.SpVoiceEndStream(Sender: TObject;
  StreamNumber: Integer; StreamPosition: OleVariant);
//var
//  p: integer;
begin
  if (not Pause) and (TF = Frag.Count-1) then StatusBar1.Panels.Items[2].Text:='';
  WaitNextFragment := True;
  if (not Speak) or (TF = Frag.Count-1) then RichEdit1.SelLength:=0; {курсор вернется туда, откуда начали!}
//  if not CBSpeak then begin   {Если читается Clipboard, то НЕ следить за текстом!}
//    p := StrToInt(FragPos[TF])-1;
//    SetTextHilite(0, 0);
//    SetTextStyle(p+OldSentencePos, p+OldSentenceLen, []);
//  end;
end;

procedure TForm1.SpVoiceWord(Sender: TObject;
  StreamNumber: Integer; StreamPosition: OleVariant; CharacterPosition,
  Length: Integer);
var
  p: integer;
begin
  if Speak and not CBSpeak then begin
    p := StrToInt(FragPos[TF])-1;
    //SetTextHilite(p+CharacterPosition, Length);
    if sDicName = ''   {добавлено}
      then RichEdit1.SelLength := p+CharacterPosition+Length
      else RichEdit1.SelLength := p+Round((CharacterPosition+Length)*Delta);
    RichEdit1.Perform(EM_SCROLLCARET,0,0);  {добавлено}
  end;
end;

//procedure TForm1.SpVoiceSentence(Sender: TObject;
//  StreamNumber: Integer; StreamPosition: OleVariant; CharacterPosition,
//  Length: Integer);
//var
//  p: integer;
//begin
//  if Speak and not CBSpeak then begin
//    p := StrToInt(FragPos[TF])-1;
//    SetTextStyle(OldSentencePos, OldSentenceLen, []);
//    SetTextStyle(p+CharacterPosition, Length, [fsItalic]);
//    OldSentencePos := p+CharacterPosition;
//    OldSentenceLen := Length;
//  end;
//end;
{------------------------------------------------------------------------------}


////////////// SAPI4. Здесь описаны уведомления TTTSBufNotifySink //////////////

constructor TTSBufNotifySink.Create(Form: TForm1);
begin
  inherited Create;
  FForm := Form;
end;

function TTSBufNotifySink.BookMark(qTimeStamp: QWORD;
  dwMarkNum: DWORD): HResult;
begin
  Result := S_OK;
end;

function TTSBufNotifySink.TextDataDone(qTimeStamp: QWORD; dwFlags: DWORD): HResult;
begin
  Result := S_OK;
  FinishedTalking := True;
  fForm.WaitNextFragment := True;
end;

function TTSBufNotifySink.TextDataStarted(qTimeStamp: QWORD): HResult;
begin
  Result := S_OK;
  if FinishedTalking then FinishedTalking := False;
end;

function TTSBufNotifySink.WordPosition(qTimeStamp: QWORD; dwByteOffset: DWORD): HResult;
var
  p: integer;
begin
  result := S_OK;
  if fForm.CBSpeak then exit;  {Читается Clipboard, слежение за текстом не нужно}
  p := StrToInt(fForm.FragPos[fForm.TF])-1;
  if sDicName = ''
    then fForm.RichEdit1.SelLength := p+dwByteOffset
    else fForm.RichEdit1.SelLength := p+Round(dwByteOffset*Delta);
  //fForm.StatusBar1.Panels.Items[0].Text :=
  //                  IntToStr(fForm.RichEdit1.CaretPos.y+1) + ': 1';
  fForm.RichEdit1.Perform(EM_SCROLLCARET,0,0);
  if fForm.Visible then fForm.RichEdit1.SetFocus;
end;

////////////////////////////////////////////////////////////////////////////////

//////////////// SAPI4. Здесь описаны уведомления TTSNotifySink ////////////////

constructor TTSNotifySink.Create(Form : TForm1);
begin
  FForm := Form;
end;

{Не используется, но должна быть, хотя бы пустая :)}
function TTSNotifySink.AttribChanged(dwAttribute: DWORD): HResult;
//var
// S:String;
begin
  result := S_OK;
end;

function TTSNotifySink.AudioStart(qTimeStamp: QWORD): HResult;
var
  Info: string;
begin
  result := S_OK;
  if fForm.ModeIO = 0 then Info := 'Чтение'
                      else Info := 'Аудио';
  fForm.StatusBar1.Panels.Items[2].Text := Info;
  Application.Title := 'Demagog - '+Info+': '+ExtractFileName(sFileName);
end;

function TTSNotifySink.AudioStop(qTimeStamp: QWORD): HResult;
var
  AudioName: string;
begin
  result := S_OK;
  {Если был конец чтения, то обновить строку состояния; вернуть курсор туда,
  откуда чтение начиналось; восстановить доступность нек-рых кнопок и п-тов меню}
  if (not fForm.Pause) and (fForm.TF = fForm.Frag.Count-1) then fForm.StatusBar1.Panels.Items[2].Text:='';
  if fForm.TF = fForm.Frag.Count-1 then fForm.UnForbidUserFeatures(nil);
  if (not fForm.Speak) or (fForm.TF = fForm.Frag.Count-1) then fForm.RichEdit1.SelLength:=0;
  {Если был назначен вывод в аудиофайл...}
  if (fForm.ModeIO = 1) and (not fForm.Pause)
      and (not fForm.Speak or (fForm.TF = fForm.Frag.Count-1)) then begin
    fForm.fIAF.Flush;
    case (fForm.AudioConverter) of
      1: AudioName := ChangeFileExt(fForm.WaveFile,'.mp3');
      2: AudioName := ChangeFileExt(fForm.WaveFile,'.ogg');
    end;
    if fForm.AudioConverter > 0 then fForm.ConvertWav(fForm.WaveFile,AudioName);
    {NB! Установить флаги реинициализации TTS-интерфейса в MP3() и BatchMP3()}
    if BatGo and (IBat < NBat-1) then BatNext := True
                                 else BatGo := False;
 end;
  {Если с записью аудио покончили, то опустить флаг вывода в аудио}
  if not BatGo and ((not fForm.Speak) or (fForm.TF = fForm.Frag.Count-1)) then begin
    if (fForm.ModeIO = 1) then PlaySound(PChar(fForm.StartDir+'\sounds\complete.wav'),0,SND_NOSTOP+SND_ASYNC);
    fForm.ModeIO := 0;
    fForm.WaveFile := '';
  end;
end;

{Не используется, но должна быть, хотя бы пустая}
function TTSNotifySink.Visual(qTimeStamp: QWORD; cIPAPhoneme: Char;
         cEnginePhoneme: Char; dwHints: DWORD; apTTSMouth: PTTSMouth) : HResult;
begin
  result := S_OK;
end;

////////////////////////////////////////////////////////////////////////////////


end.
