PDA

View Full Version : جستجو در درون متن



Harry
پنج شنبه 12 تیر 1382, 08:20 صبح
می خواستم در دلفی برنامه ای بنویسم تا به وسیله Find Dialog کلمه ای را در درون کنترل Memo جستجو کرده و همچنین به وسیله Replace Dialog کلمه ای را جستجو کرده و با کلمه دیگر آن را جایگزین کند.

phantasm
پنج شنبه 19 تیر 1382, 12:57 عصر
سلام.
این برای finddialog:


unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
FindDialog1: TFindDialog;
procedure FindDialog1Find(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FindDialog1Close(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
var ix,posreturnx,i,posreturn:integer;
procedure TForm1.FindDialog1Find(Sender: TObject);
var
J, SkipChars,i,posreturn: Integer;
begin
for I :=0 to Memo1.Lines.Count do
begin
PosReturn := Pos(FindDialog1.FindText,Memo1.Lines[I]);
if PosReturn <> posreturnx then {found!}
begin
Skipchars := 0;
for J := 0 to I - 1 do
Skipchars := Skipchars + Length(Memo1.Lines[J]);
SkipChars := SkipChars + (I*2);

SkipChars := SkipChars + PosReturn - 1;
Memo1.SetFocus;
Memo1.SelStart := SkipChars;
Memo1.SelLength := Length(FindDialog1.FindText);
Break;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
FindDialog1.Position := Point(memo1.Left +memo1.Width, memo1.Top);
FindDialog1.Execute;

end;

procedure TForm1.FindDialog1Close(Sender: TObject);
begin

end;

procedure TForm1.FormCreate(Sender: TObject);
begin

end;

end.

اینم واسه raplacedialog:


unit Unit1;

interface

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

type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
ReplaceDialog1: TReplaceDialog;
procedure ReplaceDialog1Replace(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
var
SelPos: Integer;
begin
with TReplaceDialog(Sender) do
begin
{ Perform a global case-sensitive search for FindText in Memo1 }
SelPos := Pos(FindText, Memo1.Lines.Text);
if SelPos > 0 then
begin
Memo1.SelStart := SelPos - 1;
Memo1.SelLength := Length(FindText);
{ Replace selected text with ReplaceText }
Memo1.SelText := ReplaceText;
end
else MessageDlg(Concat('Could not find "', FindText, '" in Memo1.'), mtError, [mbOk], 0);

end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
replaceDialog1.Position := Point(memo1.Left + memo1.Width, memo1.Top);
replaceDialog1.Execute;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin

end;

end.

SReza1
پنج شنبه 19 تیر 1382, 23:31 عصر
دوست عزیز یک دستور ساده بنام Ansipos وجود داره که میتونه position یکلمه را در رشته ای رو معین کنه!!مثلاI := Asnpos(MySearchStr,Memo1.Text) این I موقعیته اونو میگه!! بعد میتونی با selstartو Sellength اونو رنگی کنی! :wink:

(امید)
جمعه 20 تیر 1382, 16:28 عصر
دستور
( pos(mystring,memo1.text
که از دستورات پاسکال هست هم همین کار رو انجام می ده.

shareh
چهارشنبه 22 آذر 1385, 19:21 عصر
با سلام به دوستان
از دوستان می خواستم که اگه براشون ممکنه کامل یاد بدن چطور میشه با کامپوننت FindDialog کار کرد.
چطور میشه با اون متنهای داخل dbgrid را جستجو کرد

whitehat006
سه شنبه 05 آذر 1387, 15:19 عصر
سلام اگه میشه سرچ دقیق ترو توضیح بدید به این شکل که من میخوام کلمه ای رو با کلمه ی دیگه عوض کنم به صورتی که Match Whole word only باشه. من از دستور زیر بدون Replace Dialog استفاده میکنم.
begin
SelPos := Pos('MyString', Memo1.Lines.Text);
if SelPos > 0 then
begin
Memo1.SelStart := SelPos - 1;
Memo1.SelLength := Length('MyString');
Memo1.SelText := 'ReplaceString';
end;
end;
لطفا اگه میشه توضیح بدید چیکار کنم مثالا می خوام وقتی کلمه #13 رو با کلمه ای به نام مهرداد تعویض کنم. دست به #3 نزنه و 1 رو در آخر نگه داره یا به قولی همون Match Whole word only باشه
ممنون میشم بتونید جوابمو بدید.