Программа-автоцензор

[repik]

Привет) дело такое, надо написать программу автоцензор. Слова записанные в первом файле программа заменит на ***(звёздочки) во втором файле. Исходные данные и результат выводятся на форму. Результат маркируется цветом.

Конечно на сколько мозга было написала сама

unit ieskaite;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Memo2Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
    Fo,Fi :textfile; 
    var s : string; 
    i,k : integer;
    B: array of char;
    J,D,C,G:array of string;
 N,M,L: integer;

implementation

{$R *.dfm}

procedure ReadArray(FileName:string; var A:array of char; var N:integer);
var
 f: text;
begin
 N:= 0;
 AssignFile(f, FileName);
 Reset(f);
 while not eof(f) do
 begin
   readln(f, A[N]);
   N:= N+1;
 end;
 CloseFile(f);
end;

procedure WriteArray(FileName: string; var A: array of integer; N: integer);
var
 f: text;
 i: integer;
begin
 assignFile(f, FileName);
 rewrite(f);
 for i:= 0 to N-1 do
 begin
   writeln(f, A[i]);
 end;
 closefile(f);
end;

function isearch(var A: array of char; var poss:integer; n: integer; var k:string; s: integer):boolean;
var
  l,r:integer;
  i: integer;
begin
  result:= false;
  s:=0;
  l:=0;
  r:= n-1;
  while l<=r do
  begin
    if a[r]= a[l] then
    begin
      if a[r]= k then result:= true
      else result:= false;
      break
    end;
    {poss:= round((l+(r-l)*(k-a[l])/(a[r]-a[l]))) ; }
    inc(s);
    if a[poss]=k then
    begin
      result:= true;
      break
    end;
    inc(s);
    if  a[poss]>k then r:= poss-1
    else l:= poss+1;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
  begin
  assignfile(Fo, 'toctovmemo.txt ' );
  rewrite(Fo);
  for i:=0 to memo1.Lines.Count-1 do 
  writeln(Fo,memo1.Lines[i]);
  closefile(fo);  
  button2.Enabled:=true;
  end;



begin
  ReadArray('PlayIn.txt', C, N);
  ReadArray('toctovmemo.txt', B, M);
  For B[k]=0 to B[n-1] do begin
    For B[i]:=0 to B[M-1] do begin
      isearch(B, p, n, k, s)
      If i:=k then begin
        ReadArray('PlayOut.txt', D, L);
        i:=D[k];

        end; else exit;
      Rewrite(Fo);
    end;
  Memo2.Lines.LoadFromFile('toctovmemo.txt');
  end;
  Readln;


end.

ещё у меня создано 3 файла txt
1ый названия "матных" слов, я использовала названия животных,
2ой туда куда записывается то что пользователь ввёл в memo1
3ий звёздочки

Пробема при открытии файла и ещё я не знаю как маркировать цветом...
Помогите пожалуйста кто чем может)

[Utkin]

Для Мемо изменить можно только цвет всего текста. Если вы хотите раскрашивать только некоторые слова, то можно использовать другой компонент.
Насчет файла:

Memo2.Lines.LoadFromFile('toctovmemo.txt');

В кавычках используйте полный пусть (типа c:\toctovmemo.txt) либо используйте диалог выбора файла.

[repik]

ммм... а какой другой компонент использовать?...
и как в нём открыть txt и загрузить в него txt?/

[Utkin]

Компонент называется RichEdit, посмотрите здесь http://www.beluch.ru/progr/100comp/3_3_4.htm
Загрузка осуществляется аналогичным способом. Сразу предупреждаю - в Дельфи RichEdit немного глючноватый, поэтому не сильно налегайте на раскраску.

[repik]

С ричэдитом ещё не исправляла но исправила код, программа запустилась но не работает, надеюсь кто то сможет чем нибудь помоч.

unit ieskaite;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
   // procedure Button2Click(Sender: TObject);
    //procedure Memo1Change(Sender: TObject);
   // procedure Memo1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
    Fo,Fi :textfile; 
    var s : string;
    k,i,m,o: integer;
    u,p: integer;
  {  B: array of char; }
    J,D,C,G,B:array[0..7] of string;
 N,L: integer;

implementation

{$R *.dfm}

procedure ReadArray(FileName:string; var A:array of string; var N:integer);
var
 f: text;
begin
 N:= 0;
 AssignFile(f, FileName);
 Reset(f);
 while not eof(f) do
 begin
   readln(f, A[N]);
   N:= N+1;
 end;
 CloseFile(f);
end;

procedure WriteArray(FileName: string; var A: array of integer; N: integer);
var
 f: text;
 i: integer;
begin
 assignFile(f, FileName);
 rewrite(f);
 for i:= 0 to N-1 do
 begin
   writeln(f, A[i]);
 end;
 closefile(f);
end;

function isearch(var A: array of string{char}; var poss:integer; n: integer; var k:string ):string;
var
  l,r:integer;
  i: integer;
  s: integer;
begin
  {result:= false; }
  s:=0;
  l:=0;
  r:= n-1;
  
  while l<=r do
  begin
    if a[r]= a[l] then
    begin
      if a[r]= k then a[r]:=find;
      else {result:= false;}
      break
    end;
    {poss:= round((l+(r-l)*(k-a[l])/(a[r]-a[l]))) ; }
    if a[poss]=k then
    begin
      result:= true;
      break
    end;
    inc(s);
    if  a[poss]>k then r:= poss-1
    else l:= poss+1;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
  begin
  assignfile(Fo, 'toctovmemo.txt ' );
  rewrite(Fo);
  for i:=0 to memo1.Lines.Count-1 do 
  writeln(Fo,memo1.Lines[i]);
  closefile(fo);
  button2.Enabled:=true;
  end;



begin
  ReadArray('PlayIn.txt', C,O);
  ReadArray('toctovmemo.txt', B, M);
  For k:=0 to o-1 do begin
    For i:=0 to M-1 do begin
      s:=isearch(B, p, n, C[k]);
      If i=k then begin
        ReadArray('PlayOut.txt', D, L);
        C[i]:=D[k];

        end else exit;
      Rewrite(Fo);
    end;
  Form1.Memo1.Lines.LoadFromFile('toctovmemo.txt');
  end;
  Readln;



end.

[Utkin]

Я же писал, не хотите проблем с файлами указывайте полный путь к ним...

[repik]

unit Unit1play;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    RichEdit2: TRichEdit;
    Button1: TButton;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  i:integer;
  S,Z:TStringList;
begin
  TStringList.Create;
  s:=TStringList.Create;
  S.LoadFromFile('C:\Users\User\Desktop\iepmojo\Playin.txt');
  TStringList.Create;
  Z:=TStringList.Create;
  Z.LoadFromFile('C:\Users\User\Desktop\iepmojo\Playout.txt');
  for i:=0 to S.Count-1 do
  begin
    repeat
       pos(s[i], Form1.RichEdit1.Lines.Text); //iwem v tekste
       Form1.RichEdit1.SelStart:=Pos(s[i],Form1.RichEdit1.Lines.Text)-1; //stavim karetku pered slovom esli nawli
       Form1.RichEdit1.SelLength:=Length(s[i]);    //videljaem
       Form1.RichEdit1.SelText:=Z[i];  //zamenjaem
    until
   Pos(s[i],Form1.RichEdit1.Lines.Text)=0;
  end;

end.

другой вариант всё того же(на форме ричэдит и кнопка), не работает выдаёт при запуске
runtime eror 217 at 00416272
что это такое?

как исправить?

[repik]

[Utkin]

TStringList.Create;

Что это? Вы писали? Попытайтесь объяснить что делает данная строка.