کمک- شمارش تعداد کلمات

[masoud_jaaan]

سلام. دوستان ممکنه بگید چطوری میشه تعداد کلمات رو در یک Memo یا RichEdit شمارش کرد؟ آیا خاصیت خاصی برای اینکار هست؟ یا باید با کد نویسی اینکار رو کرد؟ ممنون میشم اگه ساده جواب بدید چون من تازه دلفی شروع کردم (دلفی 7). مرسی

[حمیدرضاصادقیان]

فکر کنم باید با برنامه نویسی این کارو بکنید.شما میتونی پایان کلماتت رو با space بسنجی و وقتی به اون رسیدی به counter که گرفتی یک واحد اضافه کنی.

[kamal_habibi]

سلام. دوستان ممکنه بگید چطوری میشه تعداد کلمات رو در یک Memo یا RichEdit شمارش کرد؟ آیا خاصیت خاصی برای اینکار هست؟ یا باید با کد نویسی اینکار رو کرد؟ ممنون میشم اگه ساده جواب بدید چون من تازه دلفی شروع کردم (دلفی 7). مرسی


مسعود جون من یک مثال جالب دارم واست میتونی ببینی این کارتو راه میندازه

[Batman]

با سلام

ShowMessage(inttostr(length(memo1.Text)));

[حمیدرضاصادقیان]

آقای batman عزیز این دستوری که شما نوشتید فقط طول رشته رو به ما میده.ایشون میخوان بدونن در یک جمله چند تا کلمه وجود داره.

[Batman]

آقای batman عزیز این دستوری که شما نوشتید فقط طول رشته رو به ما میده.ایشون میخوان بدونن در یک جمله چند تا کلمه وجود داره.
اگه منظورتون کلمه هستش حرف شما درست اما اگه منظورتون حرف هستش کدی که نوشتم هیچ اشکالی نداره

[masoud_jaaan]

خیلی از لطف شما دوستان ممنونم . منظور من همونطور که گفتم تعداد کلمه ها بود نه حروف.

[masoud_jaaan]

مسعود جون من یک مثال جالب دارم واست میتونی ببینی این کارتو راه میندازه
مرسی ولی این کد مربوط به Edit بود (یعنی یه خطی). من هم یه کد کوچیک نوشتم برای Memo ولی مشکلی که اینها دارن اینه که اگه چند تا space پشت سر هم بزنیم شمرده میشه در حالی که هیچ کلمه ای تایپ نشده.

[masoud_jaaan]

کدی که من نوشتم اینه ولی مشکلی رو که توی پست قبل گفتم کماکان داره




textlen := Length(Memo1.Lines.Text);
cnt := 0;
for idx:=1 to textlen do if (Memo1.Lines.Text[idx] = ' ') or (Memo1.Lines.Text[idx] = #13) then cnt := cnt+1;
Label6.Caption := IntToStr(cnt);


حالا یه سوال دیگه. البته زیاد ربطی به این نداره ولی گفتم تاپیک جدا باز نکنم. آیا میشه توی برنامه از امکانات check spelling برنامه word استفاده کرد؟ اگه میشه چجوری؟
باز هم ممنونم.

[vcldeveloper]

حالا یه سوال دیگه. البته زیاد ربطی به این نداره ولی گفتم تاپیک جدا باز نکنم. آیا میشه توی برنامه از امکانات check spelling برنامه word استفاده کرد؟ اگه میشه چجوری؟
سلام،
اتفاقا بر اساس قوانین سایت، باید سوالات جداگانه را در تاپیک های مجزا پرسید، پس لطف کنید و این سوال را در یک تاپیک جدید بپرسید و در این تاپیک فقط همان بحث مربوطه به عنوان تاپیک را دنبال کنید.

موفق باشید

[Will_Smith]

کدی که من نوشتم اینه ولی مشکلی رو که توی پست قبل گفتم کماکان داره




textlen := Length(Memo1.Lines.Text);
cnt := 0;
for idx:=1 to textlen do if (Memo1.Lines.Text[idx] = ' ') or (Memo1.Lines.Text[idx] = #13) then cnt := cnt+1;
Label6.Caption := IntToStr(cnt);


با تغییر در خط for



for idx:=1 to textlen do if ((Memo1.Lines.Text[idx] = ' ') or (Memo1.Lines.Text[idx] = #13) )AND((Memo1.Lines.Text[idx+1] <> ' ') or (Memo1.Lines.Text[idx+1] <> #13)) then cnt := cnt+1;

[Batman]

مرسی ولی این کد مربوط به Edit بود (یعنی یه خطی). من هم یه کد کوچیک نوشتم برای Memo ولی مشکلی که اینها دارن اینه که اگه چند تا space پشت سر هم بزنیم شمرده میشه در حالی که هیچ کلمه ای تایپ نشده.
برای عدم شمارش کلید space

ShowMessage(inttostr(length(trim(Edit1.Text))))
موفق باشید

[masoud_jaaan]

با تغییر در خط for



for idx:=1 to textlen do if ((Memo1.Lines.Text[idx] = ' ') or (Memo1.Lines.Text[idx] = #13) )AND((Memo1.Lines.Text[idx+1] <> ' ') or (Memo1.Lines.Text[idx+1] <> #13)) then cnt := cnt+1;



ممنون ولی باز هم همون کار رو میکنه.

[masoud_jaaan]

برای عدم شمارش کلید space

ShowMessage(inttostr(length(trim(Edit1.Text))))
موفق باشید

این تابع trim فقط از سر و ته عبارت میزنه ولی به وسطش کاری نداره.
بهرحال ممنون مشکلم حل شد.

[Batman]

این تابع trim فقط از سر و ته عبارت میزنه ولی به وسطش کاری نداره.
بهرحال ممنون مشکلم حل شد.
با سلام
ببین دوست عزیز من نمیدونم هدف شما از این کار چیه ولی مطمئنا به کار بردن کلید space در بین کلمات برای جدا کردن هستش اگر واقعا به دنبال این هستی که اصلا کلید space کار نکنه بگو تا کد رو برات بذارم
موفق باشید

[Mahmood_M]

سلام

با سلام
ببین دوست عزیز من نمیدونم هدف شما از این کار چیه ولی مطمئنا به کار بردن کلید space در بین کلمات برای جدا کردن هستش اگر واقعا به دنبال این هستی که اصلا کلید space کار نکنه بگو تا کد رو برات بذارم
موفق باشید
دوست عزیز لطفا به سوال دوستمون دقت کنید ...
ایشون نمی خواد که یک من یک خطی رو حروفش رو پیدا کنه ! ، بلکه ایشون می خواد تعداد کلمات موجود در یک TStrings ( یعنی Memo یا ... ) رو پیدا کنه ، کدهایی که شما توی دو تا پستتون گذاشتید برای یک رشته ( String ) هستند ...
---------
و اما جواب دوستمون ...
راستش فکر کنم یکی از دوستان در چند پست قبلی جواب رو دادند باید یکی یکی رشته ها رو گرفته و پیش برید و وقتی به فاصله رسیدید یعنی بعد از اون کلمه بعد هست و نکنه دیگه این که باید چک کنید رشته شما " #13 " ( یعنی کلید Enter یا خط بعدی ) هست یا نه ، با این روش می تونید تعداد کلمات رو بدست بیارید ...
اگه هنوز مشکلتون حل نشده بگید که دقیقا موقع اجرا چه مشکلی پیش میاد یعنی چه موقع کد موفقیت آمیز هست و چه موقع نیست ، تا دوستان هم بتونند جواب بهتری بدند ...

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

[vcldeveloper]

خصوصیت Text در TStringList بهتون امکان میده که کل متن موجود در TStringList را بصورت نوع string داشته باشید، پس اگر کدی دارید که با نوع string درست عمل میکنه، باید بتونید با استفاده از خصوصیت Text از این کد در TStringList هم بدرستی استفاده کنید.

[Mahmood_M]

خصوصیت Text در TStringList بهتون امکان میده که کل متن موجود در TStringList را بصورت نوع string داشته باشید، پس اگر کدی دارید که با نوع string درست عمل میکنه، باید بتونید با استفاده از خصوصیت Text از این کد در TStringList هم بدرستی استفاده کنید.

با سلام
مشکل اصلی اینه که اگه متن دارای چند خط باشه ، دو کلمه به یک کلمه تبدیل میشن ...
مثلا اگه متن اصلی این باشه :

------------
به سایت برنامه نویس خوش آمدید
لطفا قبل از فعالیت قوانین سایت را مطالعه فرمایید.
------------

وقتی از خاصیت Text استفاده می کنیم ، خطوط با هم ترکیب میشن ، یعنی این :

------------
به سایت برنامه نویس خوش آمدیدلطفا قبل از فعالیت قوانین سایت را مطالعه کنید.
------------

در این صورت تعدادی که بدست می یاد 14 تا هست ولی متن ما 15 کلمه داره ...
راستش من که امتحان کردم به این صورت بود ...

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

[vesal]

const
AlphaNumChars=['0'..'9','A'..'Z','_','a'..'z','~'];
allchars=[low(char)..high(char)];
separators=allchars-AlphaNumChars;

function CompareWordCounts(List: TStringList; Index1, Index2: Integer): Integer;
begin
result:=integer(List.Objects[Index2])-integer(List.Objects[Index1]);
end;

procedure TForm1.CountWords;
var
List:TStringList;

procedure incwordcount(wx:string);
var
i:integer;
begin
with List do begin
i:=Add(wx);
Objects[i]:=TObject(integer(Objects[i])+1);
end;
end;

var
n:integer;
InputText:string;
wx:string;
begin
InputText:=memo1.text;
List:=tstringlist.create;
try
List.sorted:=true;
List.Duplicates := dupIgnore;
for n:=1 to length(InputText) do begin
if InputText[n]in separators then begin
incwordcount(wx);
wx:='';
end
else wx:=wx+InputText[n];
end;
if wx<>'' then incwordcount(wx);
List.sorted:=false;
List.CustomSort(CompareWordCounts);
Memo2.clear;
Memo2.Lines.BeginUpdate;
for n:=1 to List.Count-1 do begin
Memo2.Lines.Add(format('%5d :"%s"',[integer(List.Objects[n]),List[n]]));
end;
Memo2.Lines.EndUpdate;
finally
List.free;
end;
end;

[zigleri]

منم اینجوری نوشتم برای memo

- اول تمام لاینها را با فاصله یکی کردم
- دوم همه بلانکها را شموردم
- سوم بلانکهای پشت سر هم را شمردم
- چهارم اگه اول متن بلانک بود را چک کردم
- پنجم منها نمودم و جواب درست را گرفتم

موفق باشید


function shmaresh_kalamat(source: TMemo):integer;
var
k,tedad,menha: integer;
str:string;
begin
menha:=0;
tedad:=0;
str:=source.Lines[0];


for k:=1 to source.Lines.Count do
str:=str+' '+source.Lines[k];


for k:=1 to length(str) do
if str[k]=' ' then
tedad:=tedad+1;


for k:=1 to length(str) do
if str[k]=' ' then
if str[k+1]=' ' then
menha:=menha+1;


if str[1]=' ' then
menha:=menha+1;


tedad:=tedad-menha;


result:=tedad;
end;

[یوسف زالی]

اینم راه من:


var
s: string;
cnt: integer;
begin
s := StringReplace(trim(Memo1.Lines.Text), #13#10, ' ', [rfReplaceAll]);
while Pos(' ', s) > 0 do
s := StringReplace(s, ' ', ' ', [rfReplaceAll]);


cnt := length(s) - length(StringReplace(s, ' ', '', [rfReplaceAll])) +1;
end;

[golbafan]

این هم روش من:
یکی از توابعی که در نرم افزار ترجمه فینگیلیش نوشته بودم....


function WordCount(s:string):Integer;
var SL:TStringList;
begin
SL:=TStringList.Create;
SL.Delimiter:=' ';
SL.DelimitedText:=s;
Result:=SL.Count;
FreeAndNil(SL);
end;


روش استفاده:

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(WordCount(Memo1.Text)));
end;

[zigleri]

جناب golbafan (http://barnamenevis.org/member.php?101169-golbafan)


سلام اگه در متن چندتا بلانک پشت سر هم باشه
بازم کدتون جواب میده؟

[golbafan]

جناب golbafan (http://barnamenevis.org/member.php?101169-golbafan)
سلام اگه در متن چندتا بلانک پشت سر هم باشه
بازم کدتون جواب میده؟

بله حتما
خوبی روش همینه