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.