جستجوی در Memo با امکان Down و Up

[solook]

با سلام
با این کد میشه در Memo جستجو کرد :


Memo.SelStart := pos(Edit1.Text, Memo.Lines.Text) -1;
Memo.SelLength := length(Edit1.Text);
Memo.Perform(EM_SCROLLCARET, 0, 0);
Memo.SetFocus;
اما می خوام جوری بشه مانند FindDialog بتونیم با زدن دکمه Next مثلا به نتیجه بعدی بصورت
Down یا Up برویم..

[taha]

سلام

اینجا (http://www.delphi3000.com/articles/article_3098.asp) رو ببین

[Hsimple11]

قبلا در مورد RichEdit مثال کامل این مسئله ذکر شده است. در سایت جستجو کنید.

[solook]

چیزی خاصی پیدا نکردم
تنها چیزی که به درد بخور بود یکی موردی که کل کلمات رو قرمز میکرد که من اینو نمی خوام می خوام جوری باشه مثل FindDialod طبق یکی یکی نتیجه بره پایین یا بالا

[Hsimple11]

با استفاده از FindDialog؟؟
اگر بله :
لینک 1 (http://barnamenevis.org/forum/%D9%85%D8%A8%D8%A7%D8%AD%D8%AB-%D9%85%D8%B1%D8%A8%D9%88%D8%B7-%D8%A8%D9%87-%D8%A8%D8%B1%D9%86%D8%A7%D9%85%D9%87-%D9%86%D9%88%DB%8C%D8%B3%DB%8C-%D8%AF%D8%B1-delphi/1062-%D8%AC%D8%B3%D8%AA%D8%AC%D9%88-%D8%AF%D8%B1-%D8%AF%D8%B1%D9%88%D9%86-%D9%85%D8%AA%D9%86.html)
لینک 2 (http://barnamenevis.org/forum/%D9%85%D8%A8%D8%A7%D8%AD%D8%AB-%D9%85%D8%B1%D8%A8%D9%88%D8%B7-%D8%A8%D9%87-%D8%A8%D8%B1%D9%86%D8%A7%D9%85%D9%87-%D9%86%D9%88%DB%8C%D8%B3%DB%8C-%D8%AF%D8%B1-delphi/103184-%D8%A7%D8%B3%D8%AA%D9%81%D8%A7%D8%AF%D9%87-%D8%A7%D8%B2-printdialog-%D9%88-finddialog-%D8%A8%D8%B1%D8%A7%DB%8C-memo.html)

اگر نه میتوانید به آخر Selection مربوط به نتیجه جستجوی فعلی رفته و دوباره روند را تکرار کنید (SelStart و SelLength) :


var
Form1: TForm1;
x: Integer;
find: Boolean = False;

implementation

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
a: string;
begin
Memo1.Lines.Add('');
Memo1.Lines.Text := ' ' + Memo1.Lines.Text;
for i := 0 to Length(Memo1.Lines.Text) - Length(edit1.Text) do
begin
a := Copy(Memo1.Lines.Text, i, Length(edit1.Text));
if CheckBox1.Checked = True then
begin
if a = edit1.Text then
begin
find := True;
x := 2;
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
Memo1.SetFocus;
Memo1.SelStart := i - 2;
Memo1.SelLength := Length(edit1.Text);
break;
end;
end
else
begin
if lowercase(a) = lowercase(edit1.Text) then
begin
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
find := True;
x := 2;
Memo1.SetFocus;
Memo1.SelStart := i - 2;
Memo1.SelLength := Length(edit1.Text);
break;
end;
end;
end;
if find = False then ShowMessage('SuchString not found')
else
find := False;
end;


procedure TForm1.Button2Click(Sender: TObject);
var
i: Integer;
a: string;
d: Integer;
begin
d := 0;
for i := 0 to Length(Memo1.Lines.Text) - Length(edit1.Text) do
begin
a := Copy(Memo1.Lines.Text, i, Length(edit1.Text));
if CheckBox1.Checked = True then
begin
if a = edit1.Text then
begin
d := d + 1;
if d = x then
begin
find := True;
x := x + 1;
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
Memo1.SetFocus;
Memo1.SelStart := i - 1;
Memo1.SelLength := Length(edit1.Text);
break;
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
end;
end;
end
else
begin
if lowercase(a) = lowercase(edit1.Text) then
begin
d := d + 1;
if d = x then
begin
find := True;
x := x + 1;
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
Memo1.SetFocus;
Memo1.SelStart := i - 1;
Memo1.SelLength := Length(edit1.Text);
break;
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
end;
end;
end;
end;
if find = False then ShowMessage('SuchString not found')
else
find := False;
end;

[solook]

با تشکر از کدتون


کار میکنه ولی یه خورده با اشکال روبروست

فایل الحاقی رو تست کنید