نحوه جستجو در رشته

[جواد فلاح]

سلام به همه دوستان
میخوام کمکم کنید که در یک کادر memo که حاوی متن است یه کاراکتر خاص را جستجو کنم
خواهش میکنم کمک کنید .
ممنون از همه

[دلفــي]

سلام به همه دوستان
میخوام کمکم کنید که در یک کادر memo که حاوی متن است یه کاراکتر خاص را جستجو کنم
خواهش میکنم کمک کنید .
ممنون از همه



unit Unit1;

interface

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

type
TForm1 = class(TForm)
Memo1: TMemo;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private Declarations }
public
{ Public Declarations }
end;

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('String 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('String not found')
else
find := False;
end;

[vcldeveloper]

در راهنمای دلفی برای کامپوننت FindDialog یک نمونه کد برای انجام این کار وجود داره، از همان استفاده کنید.

[جواد فلاح]

چیزی پیدا نکردم
میشه بیشتر توضیح بدی

[vcldeveloper]

چیزی پیدا نکردم
http://docwiki.embarcadero.com/CodeSamples/en/FindText_(Delphi) (http://docwiki.embarcadero.com/CodeSamples/en/FindText_%28Delphi%29)

[جواد فلاح]

دوستان ممنون از کمکتان
ولی فکر کنم منظورم را درست نتونستم بیان کنم طوری دیگه سوالمو بیان می کنم
من با استفاده از Meme به فایل های ورد وصل می شود و مشکلی که الان دارم اینکه می خواهم با استفاده از چند لیبل تعداد شمارش های جستجو برای کاراکتر های & * @ # $ % ^ و غیره را داشته باشم
مثلا برای خروجی
تعداد کاراکترهای & برابر است با 50
تعداد کاراکترهای @ برابر است با 522
تعداد کاراکترهای # برابر است با 454
و الی آخر
دوستم آقای کشاورز کمی کمک کرد ولی ما نمی توانیم با Find Dialog این کار را انجام دهیم لطفا کمکم کنید.
اللهم عجل لولیک الفرج

[دلفــي]

procedure TForm1.Button1Click(Sender: TObject);
var i,j,k:Integer;
S,Str:String;
begin
j := 0;
for i:=0 to Memo1.Lines.Count-1 do
begin
S := '';
Str := Memo1.Lines.Strings[i];
S := StringReplace(Str,'@',' ',[rfReplaceAll]);
if Trim(S) <> Trim(Str) then
for k:=1 to StrLen(PChar(Trim(Str))) do
if Str[k] = '@' then
j := J+1;
end;
Edit2.Text := IntToStr(j);
end;

[جواد فلاح]

دوست عزیز چه جور میتونم این کار را برای 10 تا کاراکتر با text های متفاوت انجام دهم مثل عمل ماکرو.

[Mahmood_M]

مي تونيد از يك حلقه استفاده كنيد يا با استفاده از چند آرايه اين كار رو انجام بديد ...

يك مثال :
قبل از خوندن مثال اين مقاله (http://barnamenevis.org/forum/showthread.php?p=928763) رو بخونيد تا با نحوه ي كار آشنا بشيد ...
..
ابتدا دو آرايه به عنوان Type تعريف كنيد يكي از نوع String شامل حروفي كه مي خوايد جستجو بشه و دومي هم از نوع Integer براي گرفتن مقادير عددي يا همون تعداد رشته ها در متن ، مثلا :
type
TWords = array[1..7] of string;

type
TCounts = array[1..7] of Integer;
TWords براي رشته ها و TCounts براي تعداد رشته ها

تابع شمارنده رو به صورت زير بنويسيد :
function CountStrs(M : TStrings; W : TWords) : TCounts;
var
I, J, K, N : Integer;
S, Str, Ch : String;
begin
for N := 1 to 7 do
begin
Ch := W[N];
J := 0;
for I:=0 to M.Count-1 do
begin
S := '';
Str := Trim(M.Strings[I]);
S := StringReplace(Str, Ch, ' ', [rfReplaceAll]);
if Trim(S) <> Trim(Str) then
for K := 1 to StrLen(PChar(Trim(Str))) do
if Str[K] = Ch then
J := J + 1;
end;
Result[N] := J;
end;
end;
حالا بايد دو متغير از نوع TWords و TCounts تعريف كنيد و يك آرايه شامل حروفي كه مي خوايد جستجو كنيد :
var
MainFrm : TForm;
Words : TWords;
Counts : TCounts;
Chars : array[1..7] of String = ('&', '*', '@', '#', '$', '%', '^');

توجه كنيد كه براي اينكه بتونيد به آرايه ي Chars مقدار اوليه بديد حتما بايد اون رو ب صورت Global ( در قسمت Var اصلي Unit ) تعريف كنيد !
براي استفاده هم به صورت زير عمل كنيد :
procedure TMainFrm.SearchBtnClick(Sender: TObject);
var
I : Integer;
begin
for I := 1 to 7 do
Words[I] := Chars[I];
Counts := CountStrs(TextMemo.Lines, Words);
ResMemo.Lines.Clear;
for I := 1 to 7 do
ResMemo.Lines.Add(IntToStr(I) + ' : ' + ' " ' + Words[I] + ' " ' + ' Count = ' + IntToStr(Counts[I]));
end;
در كد بالا ابتدا مقادير آرايه ي Chars رو درون Words ميريزيم ،‌بعد Words رو به تابع ارسال مي كنيم و خروجي كه يك نوع TCounts هست در متغير Counts قرار مي گيره ، در آخر هم مقادير حاصل رو در يك Memo ي ديگه نمايش مي ديم ...

براي درك بهتر هم مي تونيد مثال ضميمه رو دانلود كنيد ...

نكته ي آخر : سئوال شما مربوط به بخش بانكهاي اطلاعاتي نيست ! ، تاپيك به بخش مباحث عمومي انتقال پيدا كرد ...

موفق باشيد ...

[جواد فلاح]

خیلی ممنون دوست عزیزم
دوست عزیز من میخواهم همین عنصر Memo با استفاده از یک OPen Dialog فایل ورد مورد نظر پر شود و جستجو بر اساس آن باشد دوستان کدی در این زمینه به من دادند که البته زیاد هنگ میکنه نمیدونم برای چی اگر راه حل بهتری دارید لطفا کمک کنید ممنون میشم.


procedure TForm1.Button1Click(Sender: TObject);
var
MSWord:OleVariant;
str:string;
begin
MSWord := CreateOleObject('Word.Application');
OpenDialog1.Execute;
Edit1.Text:=OpenDialog1.FileName;
MSWord.Visible := False;
MSWord.Documents.Open(Edit1.Text);
Memo1.Text := MSWord.ActiveDocument.Content;
end;