Приложение а. Листинг программы

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, ComCtrls, Menus, ImgList, ExtCtrls, jpeg,

ToolWin, ActnMan, ActnCtrls, ActnMenus,ShellAPI,

Math;

type

TForm1 = class(TForm)

Memo3: TMemo; Label1: TLabel; Memo4: TMemo; Memo5: TMemo; Memo6: TMemo; Label2: TLabel;

Label3: TLabel; Memo8: TMemo; Memo9: TMemo;

Label4: TLabel; Memo11: TMemo; Label8: TLabel; Memo13: TMemo; Memo14: TMemo; Label10: TLabel; MainMenu1: TMainMenu;

N1: TMenuItem; N2: TMenuItem; Cleartext1: TMenuItem; N3: TMenuItem;

Memo1: TMemo;

N8: TMenuItem;

N10: TMenuItem;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

N4: TMenuItem;

N6: TMenuItem;

N5: TMenuItem;

N7: TMenuItem;

procedure Cleartext1Click(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure N8Click(Sender: TObject);

procedure N10Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure N6Click(Sender: TObject);

procedure N7Click(Sender: TObject);

procedure FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

private

{ Private declarations }

public

{ Public declarations }

end;

type TWord = record {Тип слово - содержит строку и кол-во встреченных раз}

Count: Word;

Value: String;

end;

const N = 10000; {max-ое кол-во слов в предложении (для частоты) }

Digits : set of char=['0'..'9'];

var

Form1: TForm1;

f:text;

implementation

uses Unit5,Unit6 ,Unit7, Unit8, Unit9;

{$R *.dfm}

{загрузка текста}

procedure TForm1.N2Click(Sender: TObject);

var buf:string;

f_name:string;

begin

if OpenDialog1.Execute and fileexists(opendialog1.filename) then

begin

Memo1.Clear;

Memo1.Enabled:=true;

f_name:=OpenDialog1.FileName;

assignfile(f,f_name);

reset(f);

while not EOF(f) do

begin

readln(f,buf);

if buf <>'' then Memo1.Lines.add(buf);

end;

ShowMessage(' Текст загружен ');

closefile(f);

end

else messageDlg('Текст не загружен',mtInformation,[mbok],0);

end;

{очистка текста}

procedure TForm1.Cleartext1Click(Sender: TObject);

var i:integer;

begin

for i:=0 to Memo1.Lines.Count -1 do

Memo1.Lines.Delete(Memo1.Lines.Count -1);

Memo1.Enabled:=false;

Form8.Memo1.Clear;

Form8.Memo2.Clear;

Form8.BitBtn1.Enabled:=true;

Form8.BitBtn1.Caption:='Анализ текста';

end;

{Частичный разбор предложения}

procedure TForm1.N8Click(Sender: TObject);

begin

if Memo1.Text <>'' then

begin

Form7.Visible:=true;

Form7.SetFocus;

end

else messageDlg('Загрузите текстовый файл',mtInformation,[mbok],0);

end;

procedure TForm1.N10Click(Sender: TObject);

begin

if Memo1.Text <> '' then

begin

Form8.Visible:=true;

Form8.SetFocus;

end

else messageDlg('Загрузите текстовый файл',mtInformation,[mbok],0);

end;

procedure TForm1.N4Click(Sender: TObject);

begin

Application.Initialize;

Form6 := TForm6.Create(Application);

Form6.Show;

Form1.Visible:=false;

end;

procedure TForm1.N6Click(Sender: TObject);

begin

if Memo1.Text <>'' then

begin

Form9.Visible:=true;

Form9.SetFocus;

end

else messageDlg('Загрузите текстовый файл',mtInformation,[mbok],0);

end;

{Вызов справки}

procedure TForm1.N7Click(Sender: TObject);

begin

winhelp(self.Handle,'хелп.hlp',help_contents,0);

end;

{Горячие клавиши}

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if Memo1.Text <> '' then

begin

if (ssCtrl in Shift) and (chr(Key) in ['A', 'a']) then

begin

Form8.Visible:=true;

Form8.SetFocus;

end;

if (ssCtrl in Shift) and (chr(Key) in ['C', 'c']) then

begin

Form7.Visible:=true;

Form7.SetFocus;

end;

if (ssCtrl in Shift) and (chr(Key) in ['S', 's']) then

begin

Form9.Visible:=true;

Form9.SetFocus;

end;

end

else messageDlg('Загрузите текстовый файл',mtInformation,[mbok],0);

end;

end.

unit Unit4;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, ComCtrls;

type

TForm4 = class(TForm)

BitBtn1: TBitBtn;

RichEdit1: TRichEdit;

RichEdit2: TRichEdit;

RichEdit3: TRichEdit;

BitBtn2: TBitBtn;

BitBtn3: TBitBtn;

procedure BitBtn1Click(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

procedure BitBtn3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var Form4: TForm4;

implementation

{$R *.dfm}

procedure TForm4.BitBtn1Click(Sender: TObject);

begin

RichEdit1.Lines.LoadFromFile('Результат\сущ в тексте.txt');

end;

procedure TForm4.BitBtn2Click(Sender: TObject);

begin

RichEdit2.Lines.LoadFromFile('Результат\прилаг в тексте.txt');

end;

procedure TForm4.BitBtn3Click(Sender: TObject);

begin

RichEdit3.Lines.LoadFromFile('Результат\глаг в тексте.txt');

end;

end.

unit Unit5;

interface

uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons;

type

TForm5 = class(TForm)

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

Label1: TLabel;

SaveDialog1: TSaveDialog;

procedure BitBtn1Click(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form5: TForm5;

implementation

uses Unit1, Unit8;

{$R *.dfm}

procedure TForm5.BitBtn1Click(Sender: TObject);

var i:integer;

f_name:string;

ff:textfile;

begin

if savedialog1.Execute and fileexists(savedialog1.filename) then

begin

f_name:=savedialog1.FileName;

assignfile(ff,f_name);

rewrite(ff);

writeln(ff,'===========Подоров Василий СыктГу=======');

writeln(ff,'==================================================');

writeln(ff,'====================Разбор текста ================');

for i:=0 to Form8.Memo2.Lines.Count-1 do

writeln(ff,Form8.Memo2.Lines[i]);

writeln(ff,'==================================================');

for i:=0 to Form8.Memo1.Lines.Count-1 do

writeln(ff,Form8.Memo1.Lines[i]);

closefile(ff);

Form5.Close;

end

else messageDlg('Файл для сохранения не выбран',mtInformation,[mbok],0);

end;

procedure TForm5.BitBtn2Click(Sender: TObject);

begin

Form5.Close;

end;

end.

unit Unit7;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls,Math, Buttons;

type

TForm7 = class(TForm)

Memo1: TMemo;

Memo2: TMemo;

Memo3: TMemo;

Memo4: TMemo;

Memo5: TMemo;

Label5: TLabel;

Label6: TLabel;

Label7: TLabel;

Label9: TLabel;

Label11: TLabel;

BitBtn1: TBitBtn;

procedure BitBtn1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form7: TForm7;

implementation

uses Unit1, Unit8, Unit5;

{$R *.dfm}

function StringToWords(T: string;List: Tstrings = nil; List2: Tstrings = nil): integer;

var i, z: integer;

s: string;

c: Char;

procedure Check;

begin

if (s > '') and (List <> nil) then

begin

List.Add(S);

z := z + 1;

end;

s := '';

end;

begin

i := 0;

z := 0;

s := '';

if t > '' then

begin

while i <= Length(t) + 1 do

begin

c := t[i];

if (c in ['а'..'я']) or (c in ['А'..'Я']) or (c in ['Ё'..'ё']) or (c in ['А'..'Я']+['-'])

and (c <> ' ') then s := s + c

else Check;

i := i + 1;

end;

end;

result := z;

end;

{Перевод заглавных в строчные}

function nepeBog(const s: string): string;

var i: Integer;

begin

Result := s;

for i := 1 to Length(s) do

begin

case s[i] of

'А'..'Я': Result[i] := Chr(Ord(s[i]) + 32);

'Ё': Result[i] := 'ё';

end;

end;

end;

procedure TForm7.BitBtn1Click(Sender: TObject);

var Source, Dest: Tstrings;

i,j: integer;

f1,f2,f3,f4,f5:textfile;

begin

BitBtn1.Enabled:=false;

BitBtn1.Caption:='Идет разбор';

if Form1.Memo1.Text <>'' then

begin

Source := TstringList.Create;

Dest := TstringList.Create;

for i:=0 to Form1.Memo1.Lines.Count-1 do

begin

StringToWords(Form1.Memo1.Lines[i], Dest); //строку разбиваем на слова, слова в список Dest

end;

Dest.SaveToFile('Слова в тексте.txt');

//ShowMessage('В тексте найдено: ' + IntToStr(Dest.Count) + ' слов');

//Местоимения

assignfile(f1,'Результат\местоимения.txt');

rewrite(f1);

for i:=0 to Dest.Count-1 do

for j:=0 to Form1.Memo4.Lines.Count-1 do

if CompareStr(dest[i], Form1.Memo4.Lines[j])=0

then

begin

//Form7.Memo1.Lines.add('#'+inttostr(i+1)+' | '+dest[i]);

Form7.Memo1.Lines.add(' '+dest[i]);

writeln(f1,'# ',inttostr(i+1),' ',dest[i]);

end;

closefile(f1);

//междометия

assignfile(f2,'Результат\междометия.txt');

rewrite(f2);

for i:=0 to Dest.Count-1 do

for j:=0 to Form1.Memo5.Lines.Count-1 do

if CompareStr(dest[i], Form1.Memo5.Lines[j])=0

then

begin

//Form7.Memo2.Lines.add('#'+inttostr(i+1)+' | '+dest[i]);

Form7.Memo2.Lines.add(' '+dest[i]);

writeln(f2,'# ',inttostr(i+1),' ',dest[i]);

end;

closefile(f2);

//Предлоги

assignfile(f3,'Результат\предлоги.txt');

rewrite(f3);

for i:=0 to Dest.Count-1 do

for j:=0 to Form1.Memo8.Lines.Count-1 do

if CompareStr(dest[i],Form1.Memo8.Lines[j])=0

then

begin

//Form7.Memo3.Lines.add('#'+inttostr(i+1)+' | '+dest[i]);

Form7.Memo3.Lines.add(' '+dest[i]);

writeln(f3,'# ',inttostr(i+1),' ',dest[i]);

end;

closefile(f3);

//Числительные

assignfile(f4,'Результат\числительные.txt');

rewrite(f4);

for i:=0 to Dest.Count-1 do

for j:=0 to Form1.Memo11.Lines.Count-1 do

if CompareStr(dest[i], Form1.Memo11.Lines[j])=0

then

begin

//Form7.Memo4.Lines.add('#'+inttostr(i+1)+' | '+dest[i]);

Form7.Memo4.Lines.add(' '+dest[i]);

writeln(f4,'# ',inttostr(i+1),' ',dest[i]);

end;

closefile(f4);

//Союзы

assignfile(f5,'Результат\союзы.txt');

rewrite(f5);

for i:=0 to Dest.Count-1 do

for j:=0 to Form1.Memo13.Lines.Count-1 do

if CompareStr(dest[i],Form1.Memo13.Lines[j])=0

then

begin

// Form7.Memo5.Lines.add('#'+inttostr(i+1)+' | '+dest[i]);

Form7.Memo5.Lines.add(' '+dest[i]);

writeln(f5,'# ',inttostr(i+1),' ',dest[i]);

end;

closefile(f5);

BitBtn1.Caption:='Разбор произведен';

end

else messageDlg('Загрузите текстовый файл',mtInformation,[mbok],0);

end;

end.

unit Unit8;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, Math;

type

TForm8 = class(TForm)

Memo1: TMemo;

Memo2: TMemo;

Label1: TLabel;

BitBtn1: TBitBtn;

Label2: TLabel;

procedure BitBtn1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form8: TForm8;

implementation

uses Unit1, Unit5;

{$R *.dfm}

function StringToWords(T: string;List: Tstrings = nil; List2: Tstrings = nil): integer;

var i, z: integer;

s: string;

c: Char;

procedure Check;

begin

if (s > '') and (List <> nil) then

begin

List.Add(S);

z := z + 1;

end;

s := '';

end;

begin

i := 0;

z := 0;

s := '';

if t > '' then

begin

while i <= Length(t) + 1 do

begin

c := t[i];

if (c in ['а'..'я']) or (c in ['А'..'Я']) or (c in ['Ё'..'ё']) or (c in ['А'..'Я']+['-'])

and (c <> ' ') then s := s + c

else Check;

i := i + 1;

end;

end;

result := z;

end;

function nepeBog(const s: string): string;

var i: Integer;

begin

Result := s;

for i := 1 to Length(s) do

begin

case s[i] of

'А'..'Я': Result[i] := Chr(Ord(s[i]) + 32);

'Ё': Result[i] := 'ё';

end;

end;

end;

procedure TForm8.BitBtn1Click(Sender: TObject);

var i,j, k,Slov_count,g ,C ,Summ : LongInt;

W: String; //для выделения слов

S: String; //Текст предложения

minWord:String; //для сортировки

min,mini:integer;// для сортировки

WordArr: Array [1..N] of TWord; //Массив слов предложения

Dest: Tstrings; //список слов в тексте

otn: Array [1..N] of real; //относительная частота

H: Array [1..N] of real; // удельная энтропия

SumHi : real; //накопленная эндропия

Lf1:integer; // кол-во слов, 1 раз в тексте

Lfn : integer;

IndIskl :real; // иНдекс исключительности

IndPredsk : real; //индекс предсказуемости

s1:string;

cnt,count1,count2,count3,count4,count5,count6:integer;

abzac:char;

D,dd:string;

flag:boolean;

time:cardinal; //время

MaxE: LongInt; //переменная для нах-ия максимума

A:array[1..N] of integer;//массив для нах-ия максимального эл-та

Distr: real; //индекс дистрибуции

IndIter: real; //индекс итерации

{Поиск слова A в Max словах. Если слово было найдено,то результат ф-ии > -1 }

function FindWord(A: String; Max: Integer): Integer;

var i: Integer;

begin

FindWord := -1;

for i:=1 to Max do

if (WordArr[i].Value = nepeBog(A)) or (WordArr[i].Value = A) then

begin

FindWord := i;

exit;

end;

end;

{Нахождение максимального эл-та в массиве частот}

function maxX(A:array of integer):integer;

var i:integer;

maxi:integer;

begin

maxi:=A[0];

for i:=2 to High(A) do

if A[i]>maxi then maxi:=A[i];

maxX:=maxi;

end;

begin

BitBtn1.Enabled:=false;

if Form1.Memo1.Text <> '' then

begin

time:=gettickcount; //засекаем время

Dest := TstringList.Create;

for i:=0 to Form1.Memo1.Lines.Count-1 do

begin

StringToWords(nepeBog(Form1.Memo1.Lines[i]), Dest); //строку в слова

end;

Summ:=0;

SumHi:=0;

S:=Form1.Memo1.Text;

C := 1;

for i:=0 to Dest.Count-1 do

begin

W:=Dest.Strings[i];

k := FindWord(W, Dest.Count);

if k = -1 then //Слово W еще не было встречено

begin

WordArr[C].Value := W;

WordArr[C].Count := 1;

Inc(C);

end else Inc(WordArr[k].Count);

end;

Slov_count:=C-1;

Form8.Memo2.Lines[0]:='Слов в тексте = ' +inttostr(Slov_count);

for i:=1 to C-1 do

begin

//сортировка выбороМ

min:=WordArr[i].Count;

minWord:=WordArr[i].Value;

mini:=i;

for j:=i+1 to C-1 do

if WordArr[j].Count > min then

begin

min:=WordArr[j].Count;

minWord:=WordArr[j].Value;

mini:=j;

end;

WordArr[mini].Count:=WordArr[i].Count;

WordArr[mini].Value:=WordArr[i].Value;

WordArr[i].Count:=min;

WordArr[i].Value:=minWord; //конец сортировки

otn[i]:=( WordArr[i].Count / dest.count) ; //относительная частота Fi = абс. част / обьем текста

H[i]:=(-1)*otn[i]*Log2(otn[i]); // удельная эндропия Hi=-fi*log2(fi)

SumHi:= SumHi + H[i]; //накопленная эндропия Sum(Hi)

Form8.Memo1.Lines.add(WordArr[i].Value+ ' ||| ' + inttostr(WordArr[i].Count)

+ ' ||| '+ copy(FloatTostr(otn[i]),1,5)

+ ' ||| '+ copy(FloatTostr(H[i]),1,5));

Summ:=Summ+WordArr[i].Count; //сумма частот

if WordArr[i].Count = 1 then Lf1:=Lf1+1; // слова, которые встретились в тексте только один раз

if WordArr[i].Count >1 then Lfn:=Lfn+1; //слова, которые встретились в тексте >1 разa

A[i]:=WordArr[i].Count; //массив частот

end;

Label2.Caption:='Максимальная частота = ' + inttostr(maxX(A)); //вывод максимальной частоты

IndIskl := 20* (Lf1 /Dest.Count); // индекс исключительности

IndPredsk := 100 - (Lf1*100)/ Dest.Count; // индекс предсказуемости (чем меньше, тем привлекательнее текст)

Distr:= sqrt( sqr(maxX(A)) + sqr(Memo1.Lines.Count-2) ); //индекс дистрибуциичем (эта величина больше, тем богаче словарь)

IndIter:= Dest.Count / (Memo1.Lines.Count-2); //индекс итерации

Form8.Label1.Caption:='Cумма частот = ' +inttostr(Summ);

{Знаки препинания и подсчет абзацев}

abzac:=#9;

cnt:=0;count1:=0;count2:=0;count3:=0;count4:=0;count5:=0;count6:=0;

for i:=0 to Form1.Memo1.Lines.Count-1 do

begin

if concat(Form1.Memo1.Lines[i][1],Form1.Memo1.Lines[i][2],Form1.Memo1.Lines[i][3])= concat(' ',' ', ' ') then

//если первые три символа равны пробелам, то это абзац...

count6:=count6+1;

for j:=1 to length(Form1.Memo1.Lines[i]) do

begin

s1:=copy(Form1.Memo1.Lines[i],j,1);

if s1=',' then cnt:=cnt+1;

if s1='.' then count1:=count1+1;

if s1=';' then count2:=count2+1;

if s1='!' then count3:=count3+1;

if s1='?' then count4:=count4+1;

if s1=':' then count5:=count5+1;

if (s1= abzac) then count6:=count6+1; // если = TAB

end;

end;

Form8.Memo2.Lines[1]:='Абзацев = ' +inttostr(count6);

Form8.Memo2.Lines[2]:='================ ';

Form8.Memo2.Lines[3]:='Точки = ' +inttostr(count1);

Form8.Memo2.Lines[4]:='Запятые = ' +inttostr(cnt);

Form8.Memo2.Lines[5]:='Восклиц знак = ' +inttostr(count3);

Form8.Memo2.Lines[6]:='Вопрос = ' +inttostr(count4);

Form8.Memo2.Lines[7]:='Двоеточие = ' +inttostr(count5);

Form8.Memo2.Lines[8]:='Точки с зап = ' +inttostr(count2);

Form8.Memo2.Lines[9]:='================ ';

Form8.Memo2.Lines[10]:='Накопленная энтропия = ' + copy(floattostr(SumHi),1,5);

Form8.Memo2.Lines[11]:='Индекс исключительности = ' + copy(floattostr(IndIskl),1,5);

Form8.Memo2.Lines[12]:='Индекс предсказуемости = ' + copy(floattostr(IndPredsk),1,5);

Form8.Memo2.Lines[13]:='Индекс дистрибуции = ' + copy(floattostr(Distr),1,5);

Form8.Memo2.Lines[14]:='Индекс итерации = ' + copy(floattostr(IndIter),1,5);

Form8.Memo2.Lines[15]:='Встреченных >1 разa = ' +inttostr(Lfn) +' слов';

Form8.Memo2.Lines[16]:='Встреченных хотя бы раз = ' +inttostr(Form8.Memo1.Lines.Count-2) +' слов';

Form8.Memo2.Lines[17]:='Встреченных один раз = ' +inttostr(Lf1) +' слов';

Form8.Memo2.Lines[18]:='================ ';

Form8.Memo2.Lines[19]:='Числа в тексте : ' ;

Dest.Free;

{Выделение чисел в тексте}

for k:=0 to Form1.Memo1.Lines.Count-1 do

begin

D:=Form1.Memo1.Lines.Strings[k];

i:=1;

Repeat

while not(D[i] in Digits) and (i<=length(D)) do

inc(i);

dd:='';

while (D[i] in Digits) and (i<=length(D)) do

begin

dd:=dd+D[i];

inc(i);

end;

if length(dd)<>0 then

begin

flag:=true;

Form8.Memo2.Lines.Add(' '+ dd);

end;

Until (i>length(D));

end;

if flag=false then Form8.Memo2.Lines[19]:='Числа в тексте : Не имеется' ;

time:=gettickcount-time;

Showmessage('Время выполнения анализа= ' + floattostr(time/1000) + ' сек');

Application.Initialize;

Form5 := TForm5.Create(Application);

Form5.Show;

end

else messageDlg('Загрузите текстовый файл',mtInformation,[mbok],0);

BitBtn1.Caption:='Анализ произведен';

end;

end.

unit Unit9;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, DB, ADODB, Menus;

type

TForm9 = class(TForm)

Memo1: TMemo;

BitBtn1: TBitBtn;

ADOConnection1: TADOConnection;

ADOTable1: TADOTable;

Memo2: TMemo;

Memo3: TMemo;

ADOTable2: TADOTable;

BitBtn2: TBitBtn;

BitBtn3: TBitBtn;

ADOTable3: TADOTable;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

procedure BitBtn1Click(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

procedure BitBtn3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var Form9: TForm9;

implementation

uses Unit1;

{$R *.dfm}

{Разбор строки на слова}

function StringToWords(T: string;List: Tstrings = nil; List2: Tstrings = nil): integer;

var i, z: integer;

s: string;

c: Char;

procedure Check;

begin

if (s > '') and (List <> nil) then

begin

List.Add(S);

z := z + 1;

end;

s := '';

end;

begin

i := 0;

z := 0;

s := '';

if t > '' then

begin

while i <= Length(t) + 1 do

begin

c := t[i];

if (c in ['а'..'я']) or (c in ['А'..'Я']) or (c in ['Ё'..'ё']) or (c in ['А'..'Я']+['-'])

and (c <> ' ') then s := s + c

else Check;

i := i + 1;

end;

end;

result := z;

end;

{Существительные}

procedure TForm9.BitBtn1Click(Sender: TObject);

var Dest: Tstrings;

i,j:integer;

ffield, fvalue: string;

opts : TLocateOptions;

t:cardinal;// время

begin

BitBtn1.Enabled:=False;

BitBtn1.Caption:='Поиск....';

t:=gettickcount;

Dest := TstringList.Create;

ffield := 'Slova';

opts := [loCaseInsensitive];

for i:=0 to Form1.Memo1.Lines.Count-1 do

StringToWords(Form1.Memo1.Lines[i],Dest);

for j:=0 to Dest.Count-1 do

begin

fvalue:=Dest[j];

if AdoTable1.Locate(ffield, fvalue, opts)=true

then Memo1.Lines.Add(Dest[j]);

end;

t:=gettickcount-t;

BitBtn1.Caption:='Существительные';

Memo1.Enabled:=true;

Showmessage('Время выполнения = ' + floattostr(t/1000) + ' сек');

Memo1.Lines.SaveToFile('Результат\существительные.txt');

Dest.Free;

end;

{Глаголы}

procedure TForm9.BitBtn2Click(Sender: TObject);

var Dest1: Tstrings;

i,j:integer;

ffield, fvalue: string;

opts : TLocateOptions;

t:cardinal; // время

begin

BitBtn2.Enabled:=False;

BitBtn2.Caption:='Поиск....';

t:=gettickcount;

Dest1 := TstringList.Create;

ffield := 'Slova';

opts := [loCaseInsensitive];

for i:=0 to Form1.Memo1.Lines.Count-1 do

StringToWords(Form1.Memo1.Lines[i],Dest1);

for j:=0 to Dest1.Count-1 do

begin

fvalue:=Dest1[j];

if AdoTable2.Locate(ffield, fvalue, opts)=true

then Memo2.Lines.Add(Dest1[j]);

end;

t:=gettickcount-t;

BitBtn2.Caption:='Глаголы';

Memo2.Enabled:=true;

Showmessage('Время выполнения = ' + floattostr(t/1000) + ' сек');

Dest1.Free;

Memo2.Lines.SaveToFile('Результат\глаголы.txt');

end;

{Прилагательные}

procedure TForm9.BitBtn3Click(Sender: TObject);

var Dest: Tstrings;

i,j:integer;

ffield, fvalue: string;

opts : TLocateOptions;

t:cardinal; // время

begin

BitBtn3.Enabled:=False;

BitBtn3.Caption:='Поиск....';

t:=gettickcount;

Dest := TstringList.Create;

ffield := 'Slova';

opts := [loCaseInsensitive];

for i:=0 to Form1.Memo1.Lines.Count-1 do

StringToWords(Form1.Memo1.Lines[i],Dest);

for j:=0 to Dest.Count-1 do

begin

fvalue:=Dest[j];

if AdoTable3.Locate(ffield, fvalue, opts)=true

then Memo3.Lines.Add(Dest[j]);

end;

t:=gettickcount-t;

BitBtn3.Caption:='Прилагательные.';

Memo3.Enabled:=true;

Showmessage('Время выполнения = ' + floattostr(t/1000) + ' сек');

Memo3.Lines.SaveToFile('Результат\прилагательные.txt');

Dest.Free;

end;