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;