Добрый вечер.Есть цель, загрузить текст в RichEdit, и окрасить определённые буквы, сделать это надо так, запомнить позиции в тексте определённой буквы, и по этим позиция окрасить.
Проблема в том, что после первого абзаца раскраска как-бы съезжает , не могу понять почему.
Заранее благодарен за помощь.
П.С. прилагаю текст, который загружают.
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
RichEdit1: TRichEdit;
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
OpenDialog1: TOpenDialog;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Path:string;// путь к текстовому файлу
bufpoiska:string;
positionbukv: array[0..1000] of integer;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);//Загрузка текста
var
UserName : string;
UserNameLen : Dword;
begin
UserNameLen := 255;
SetLength(userName, UserNameLen);
if GetUserName(PChar(UserName), UserNameLen) then
UserName := Copy(UserName,1,UserNameLen - 1);
OpenDialog1.InitialDir:='C:\Users\'+UserName+'\Desktop\';
if OpenDialog1.Execute then
Path:=OpenDialog1.FileName;
RichEdit1.Lines.LoadFromFile(Path);
end;
procedure TForm1.Button2Click(Sender: TObject);//Запоминание позиции
var
n,j,z:Integer;
begin
bufpoiska:=Edit1.Text;
z:=0;
for j := 1 to Length(RichEdit1.text) do
begin
if RichEdit1.text[j]=bufpoiska then
begin
positionbukv[z]:=j;
inc(z);
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject); //Окраска по позициям
var
i: integer;
begin
i:=0;
while positionbukv[i]<>0 do
begin
RichEdit1.SelStart:=positionbukv[i]-1;
Richedit1.SelLength:=1;
Richedit1.SelAttributes.Color:=clRed;
inc(i);
end;
end;
end.