قراءة المسافة كيف تتم؟

السلام عليكم

حل سريع : يمكنك استخدام الدالة Pos لتحديد مكان المسافة مثل

var i : integer
    mys : string;
begin
 mys:='hello arabteam';
 i:=pos(' ',mys);

i تحمل رقم index للمسافة، وبعدها يمكنك استخدام الدوال Copy وdelete لاخذ الكلمات مع كتابة خوارزمية صغيرة

او راجع هذا السؤال ففيها كود اكثر فعالية

http://groups.google.com/groups?hl=ar&lr=&...%3DN%26tab%3Dig

مشكوووور اخي عبد الحفيظ على التجاوب.

لكن الا ترى ان هذا الكود صعب الاستعمال بسبب ان طول الاسماء تختلف كما ان هناك فراغات متعددة في الاسماء.

فهل بالامكان ايجاد حل افضل لهذه المشكلة.

اكرر شكري وفي انتظار الرد

السلام عليكم

يمكنك عمل loop او حتي ان تقوم باخذ اول جزء من الاسم ثم حذفه من المتغير الاصلي ثم حذف الفراغ في البداية وتكرار العملية الخ :)

ان شاء الله اذا اتيحت لي الفرصة سوف احاول اعدل الكود في الرد السابق، او ربما احد الاخوة يعطيك حلا :)

م : إذا لديك وقت فراغ يمكنك التسكع :D في google group عن طريق بحث في عبارة مثل delphi AND parse String او token لتقرا أسئلة وإجابات رائعة جدا يفيدك كثيرا

(f) (f) (f)

السلام عليكم

عدنا :D وتفضل ياخي هذا من عندي ، ان شاء الله تفيدك

[l]

procedure TForm1.Button1Click(Sender: TObject);
var temps,mys : string;
    i : integer;
    done : boolean;
    myl :Tstringlist;
begin
  mys:='الحمد لله رب العالمين';
  myl:=Tstringlist.Create;
  done:=false;
  repeat
   i:=pos(' ',mys);
   temps:=Copy(mys,1,i);
   if temps <>'' then myl.Add(temps);
   delete(mys,1,i);
   if i=0 then done :=true;
  until done;
  myl.Add(mys);
  for i:=0 to myl.Count -1 do showmessage(myl.Strings);
  myl.Free; //don't call destroy directly ;)
end;

[/l]

شكر اخي عبد الحفيظ

هل بالامكان من مساعدتي واكمال الكود بحيث اقوم بتفريغ هذه الاسماء في Edit

اكرر الشكر والعرفان

السلام عليكم

اخي العزيز ابواحمد

هذه دالة كتبتها قبل فترة في هذا المنتدى، واعتقد انها تصلح لمثل ما طلبت

function SeparateString(Str,SubStr :string) : TStringList;
var
  I: Integer;
  SL : TStringList;
begin
  try
    Result := TStringList.Create;
    SL := TStringList.Create;
    while Pos(SubStr,Str) >0 do
    begin
      I := Pos(SubStr,Str);
      SL.Add((Copy(Str,1,I-1)));
      Str := Copy(Str,I+Length(SubStr),Length(Str)-I +1);
    end;
    SL.Add((Str));
    Result.Assign(SL);
  finally
    SL.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  I : Integer;
  SL: TStringList;
begin
  try
    SL := TStringList.Create;
    SL :=  SeparateString(Edit5.Text,' ');
    Edit1.Text := SL[0];
    Edit2.Text := SL[1];
    Edit3.Text := SL[2];
    Edit4.Text := SL[3];
  finally
    SL.Free;
  end;
end;

ارجو ان يكون هذا المطلوب

جزاك الله خير اخي محمد ونفع بعلمك اخوانك المسلمين.

هذا هو المطلوب

بسم الله الرحمن الرحيم

الأخوة

قد يساعدكم هذا الكود مهما كان عدد الكلمات

procedure TForm1.Edit1Exit(Sender: TObject);

var s1,s2:string;

chars:array[1..50]of integer;

c,i:integer;

begin

c:=0;

s1:=Edit1.Text;

Label1.Caption:=Edit1.Text;

for i:=1 to length(s1) do

begin

if s1<>' ' then

begin

c:=c+1;

chars[c]:=i;

if c>1 then

begin

if i-chars[c-1]>1 then

begin

chars[c]:=0;

c:=c+1;

chars[c]:=i;

end;

end;

end;

end;

Label3.Caption := '';

Edit1.Text:='';

for i:=1 to c do

if chars=0 then

begin

Label3.Caption := Label3.Caption+#13;

Edit1.Text:=Edit1.Text+' ';

end

else

begin

Edit1.Text:=Edit1.Text+s1[chars];

Label3.Caption := Label3.Caption+s1[chars];

end;

Label2.Caption:=Edit1.Text;

Edit1.SelectAll;

end;