delphi4arab منتديات دلفي للعرب

لدي برنامج بسيط يحتوي على editText و زر ، والكود الموجود عند الضغط على الزر هو :

PHP كود :
procedure TForm1.BitBtn1Click(Sender: TObject);
 const tablelettre:Array[1..26] of string = ('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','K','R','S','T','U','V','w','X','Y','Z');
 const tabint:Array[1..26] of integer = (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26);
 var
 i,j,sum: integer ;
 begin
Label1.visible := true ;
sum := 0;
for i := 1 to length(edit1.text) do
for j := 1 to length (tablelettre) do
   if edit1.Text[i]=tablelettre[j] then
      sum:= sum + tabint[j];
       j:=j+1;
       i:=i+1;


label1.caption:= inttostr(sum) ;

end;

end. 

عمل البرنامج انه يقوم بمقارنة حروف الكلمة المدخلة الى Edittext مع جدول الارقام tabint و كل حرف من tablelettre يقابله رقم معين وادا وجد حرف من الكلمة المدخلة في editText يقوم بجمع الرقم الموافق لها مع متغير sum وتظهر النتيجة على 1label .
1-المشكلة انه دائما نتيجة Sum تساوي صفر وهده مشكلة ؟؟
اظن انه يوجد خطا في الكود ما هو لاصححه .
2- كيف يمكن نزع الفراغات المدخلة الى Edit يعني مثلا لو ادخلنا : Delphi for Arabe النتيجة بعد نزع الفراغ هي DelphiforArabe ؟؟

دالة بسيطة لي حذف الفراغ + تصحيح السورس الذي وضعته
function notvid(str Confused

tring)

tring;
var i:integer;
c Confused

tring;
begin
for i:=1 to length(str) do begin
if str[i]<>' ' then c:=c+str[i]; end;
result:=c;
end;
//////////////////////
procedure TForm1.Button1Click(Sender: TObject);
const tablelettre:Array[1..26] of string = ('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','K','R','S','T','U','V','w','X','Y','Z');
const tabint:Array[1..26] of integer = (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26);
var
i,j,sum: integer ;
c Confused

tring;
begin
Label1.visible := true ;
sum := 0;
c:=UpperCase(edit1.text) ;
for i := 1 to length(edit1.text) do
for j := 1 to length (tablelettre) do
if c[i]=tablelettre[j] then
sum:= sum + tabint[j];
label1.caption:= inttostr(sum) ;
end;

تنقصك Begin و end لكل من for الأولى و الثانية

السلام عليكم...

أحد الأسباب هو أن مقارنة النصوص في دلفي هي مقارنة ثنائية، أي حساسة لحالة الأحرف (case-sensitive) يعني مثلاً أن B لا يساوي b. و قد استخدم الأخ "الياس الدويرة" الدالة UpperCase للمطابقة مع محتويات المصفوفة tablelettre على اعتبار أن الحروف التي بها حروف كبيرة (CAPITAL) - لكن - ربما سهواً الحرف w صغير!

*** لإزالة الفراغات أضف الوحدة StrUtils إلى جملة uses (في الـ interface أو الـ implementation):

كود :
uses StrUtils;

ثم استعمل الدالة ReplaceText كما في الكود التالي:

* إذا كانت القيم المقابلة للحروف هي 1، 2، 3، ... ، 26 بالترتيب فلا نحتاج إلى المصفوفة الثانية (tabint) و يكون الكود هكذا:

كود :
procedure TForm1.Button1Click(Sender: TObject);
const
    tablelettre: Array[1..26] of string = ('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','K','R','S','T','U','V','W','X','Y','Z');
var
    i, j, sum: Integer;
    MyStr: string;
begin
    MyStr := ReplaceText(Edit1.Text, ' ', '');
    sum := 0;
    for i := 1 to Length(MyStr) do begin
        for j := 1 to Length(tablelettre) do begin
            if UpperCase(MyStr[i]) = UpperCase(tablelettre[j]) then begin
                sum := sum + j;
                Break;    // إذا وجدت الحرف فاخرج من الحلقة الداخلية
            end;
        end;
    end;
    Label1.Caption := IntToStr(sum);
end;

* أما إذا كانت القيم غير ذلك فالكود يكون هكذا:

كود :
procedure TForm1.Button1Click(Sender: TObject);
const
    tablelettre: Array[1..26] of string = ('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','K','R','S','T','U','V','W','X','Y','Z');
    tabint: Array[1..26] of Integer = (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26);
var
    i, j, sum: Integer;
    MyStr: string;
begin
    MyStr := ReplaceText(Edit1.Text, ' ', '');
    sum := 0;
    for i := 1 to Length(MyStr) do begin
        for j := 1 to Length(tablelettre) do begin
            if UpperCase(MyStr[i]) = UpperCase(tablelettre[j]) then begin
                sum := sum + tabint[j];
                Break;
            end;
        end;
    end;
    Label1.Caption := IntToStr(sum);
end;

* نرجو الاستفادة و السلام.

السلام عليكم

الأخطاء في الكود

1) يجب حذف

PHP كود :
j:=j+1;
       i:=i+1; 

لا داعي لرفع قيم العدادات الا في حالة استخدمت جملة while
2) مقارنة الاحرف الكبيرة و الصغيرة تختلف كما اشار الاخ Najy Ibraheem
3) هناك تكرار للحرف K الا في حالة تعمدت ذلك اعتقد يجب ان يكون Q

PHP كود :
tablelettre: Array[1..26] of string = ('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','K','R','S','T','U','V','W','X','Y','Z'); 

لحذف الفراغات استخم الدالة trim

PHP كود :
Edit1.Text := Trim(Edit1.Text); 

بطريقة اخرى

PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
var
  I, Sum: Integer;
begin
  Sum := 0;
  Edit1.Text := Trim(Edit1.Text);
  Edit1.Text := UpperCase(Edit1.Text);
  for I := 1 to Length(Edit1.Text) do
    case Edit1.Text[i] of
      'A': Sum := Sum + 1;
      'B': Sum := Sum + 2;
      'C': Sum := Sum + 3;
      'D': Sum := Sum + 4;
      'E': Sum := Sum + 5;
      'F': Sum := Sum + 6;
      'G': Sum := Sum + 7;
      'H': Sum := Sum + 8;
      'I': Sum := Sum + 9;
      'J': Sum := Sum + 10;
      'K': Sum := Sum + 11;
      'L': Sum := Sum + 12;
      'M': Sum := Sum + 13;
      'N': Sum := Sum + 14;
      'O': Sum := Sum + 15;
      'P': Sum := Sum + 16;
      'Q': Sum := Sum + 17;
      'R': Sum := Sum + 18;
      'S': Sum := Sum + 19;
      'T': Sum := Sum + 20;
      'U': Sum := Sum + 21;
      'V': Sum := Sum + 22;
      'W': Sum := Sum + 23;
      'X': Sum := Sum + 24;
      'Y': Sum := Sum + 25;
      'Z': Sum := Sum + 26;
    end;
    Label1.Caption := IntToStr(Sum);
end; 

الياس الدويرة كتب :دالة بسيطة لي حذف الفراغ + تصحيح السورس الذي وضعته
function notvid(strtring)tring;
var i:integer;
ctring;
begin
for i:=1 to length(str) do begin
if str[i]<>' ' then c:=c+str[i]; end;
result:=c;
end;
//////////////////////
procedure TForm1.Button1Click(Sender: TObject);
const tablelettre:Array[1..26] of string = ('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','K','R','S','T','U','V','w','X','Y','Z');
const tabint:Array[1..26] of integer = (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26);
var
i,j,sum: integer ;
ctring;
begin
Label1.visible := true ;
sum := 0;
c:=UpperCase(edit1.text) ;
for i := 1 to length(edit1.text) do
for j := 1 to length (tablelettre) do
if c[i]=tablelettre[j] then
sum:= sum + tabint[j];
label1.caption:= inttostr(sum) ;
end;

بارك الله فيك يا اخي الكريم على ال****** لكن في كود دالة حدف الفراغ اظن انه يجب اسناد قيمة ابتدائية للمتغير c ولتكن عبارة عن فراغ ' ' ؟؟؟

نعم اخي S.FATEH قدا كررت الحرف K سهوا قصدت Q وكدلك الحرف W قصدته كبيرا كما نبهني الاخ Najy Ibraheem
بارك الله فيكم جميعا اتحفتموني بحلول رائعة
تم التعديل على الكود و الاستفاد ان شاء الله

غيرت CharCase الخاصة بـ EDIT الى ecUpperCase

S.FATEH كتب :السلام عليكم

الأخطاء في الكود

1) يجب حذف

PHP كود :
j:=j+1; i:=i+1;

لا داعي لرفع قيم العدادات الا في حالة استخدمت جملة while

عداد جملة التكرار for لا يزاد إلا بمقدار واحد والتلاعب بمقدار زيادته يؤدي إلى خطأ
كذلك يجب ان يكون متغير محلي والسبب أنه يحفظ في مسجلات المعالج لضمان سرعة في التنفيذ.

bassem_43

الياس الدويرة

igidher

Najy Ibraheem

S.FATEH

bassem_43

bassem_43

Mr.DOS

Amer12