Всем привет. Помогите пожалуйста, нужно сделать программу-словарь. То есть я ввожу, например, слово "авто" и мне выводятся все слова, где есть слово "авто", то есть автомобиль, автобус и т.д. Словарь находится в текстовом файле. У меня есть программа, впринципе, но я не знаю как ее можно исправить, потому что я дурак И все это, блин, нужно еще срочно. Помогите, кому не сложно. Если это очень легко для вас/было(я искал, но не смог сделать под себя), прошу, не ругайтесь, просто я сейчас еще занят документацией..
Во что у меня выходит :C
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Memo1: TMemo;
Label2: TLabel;
Edit1: TEdit;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
SaveDialog1: TSaveDialog;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function match(word_init, word_to_check:string):boolean;
var i, j:integer;
found:boolean;
ar:array[1..255] of integer;
begin
match:=true;
for i:=1 to 255 do
ar[i]:=0;
for i:=1 to length(word_to_check) do
begin
if pos(word_to_check[i], word_init)=0 then //проверка существует ли данная буква в слове
begin
match:=false;
exit;
end;
found:=false;//изначальное обозначение того, что буква не найдена
for j:=1 to length(word_init) do //проверка всех букв слова-источника
begin
if ((word_init[j]=word_to_check[i]) and (ar[j]=0)) then
begin
found:=true;
ar[j]:=1;
break;
end;
end;
if found=false then//если буква не найдена в слове-источнике
begin
match:=false;
exit;//выход из процедуры
end;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if edit1.Text='' then BitBtn1.Enabled:=false else BitBtn1.Enabled:=true;
if edit1.Text='' then BitBtn2.Enabled:=false else BitBtn2.Enabled:=true;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
var f:textfile;
s:string;
begin
memo1.Clear;
assignfile(f, 'slova.txt');
reset(f);
while not EOF(f) do //выполнять до конца файла
begin
readln(f, s);
if match(edit1.Text, s) then memo1.Lines.Add(s);
end;
closefile(f);
BitBtn3.Enabled:=true;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var f:textfile;
s:string;
exist:boolean;
begin
assignfile(f, 'slova.txt');
reset(f);
exist:=false;
while not EOF(f) do
begin
readln(f, s);
if edit1.Text=s then exist:=true;
end;
closefile(f);
append(f); //добавление записи в файл
if exist=false then writeln(f, edit1.Text);//если слова в словаре нет, то оно туда добавляется
closefile(f);
if exist=false then showmessage('The word was successfully added to the dictionary!!!')
else showmessage('This word already exists in the dictionary!!!');
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
var f:textfile;
i:integer;
begin
savedialog1.Execute;
assignfile(f, savedialog1.FileName);
rewrite(f);
writeln(f, 'Запрос: '+edit1.text+#13);
for i:=0 to memo1.Lines.Count-1 do
writeln(f, memo1.lines[i]);
closefile(f);
showmessage('Result was successfully saved to the file "'+savedialog1.FileName+'"');
end;
end.
Админ: Пользуемся тегами дял оформления кода!