المشاركات : 543
المواضيع 34
:
: 463
الإنتساب : Apr 2013
لدي برنامج بسيط يحتوي على 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 ؟؟
المشاركات : 24
المواضيع 0
:
: 0
الإنتساب : May 2013
دالة بسيطة لي حذف الفراغ + تصحيح السورس الذي وضعته
function notvid(str  tring)  tring;
var i:integer;
c  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  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;
المشاركات : 38
المواضيع 12
:
: 6
الإنتساب : Sep 2012
تنقصك Begin و end لكل من for الأولى و الثانية
المشاركات : 119
المواضيع 0
:
: 0
الإنتساب : Sep 2012
السلام عليكم...
أحد الأسباب هو أن مقارنة النصوص في دلفي هي مقارنة ثنائية، أي حساسة لحالة الأحرف (case-sensitive) يعني مثلاً أن B لا يساوي b. و قد استخدم الأخ "الياس الدويرة" الدالة UpperCase للمطابقة مع محتويات المصفوفة tablelettre على اعتبار أن الحروف التي بها حروف كبيرة (CAPITAL) - لكن - ربما سهواً الحرف w صغير!
*** لإزالة الفراغات أضف الوحدة StrUtils إلى جملة uses (في الـ interface أو الـ implementation):
ثم استعمل الدالة 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;
* نرجو الاستفادة و السلام.
المشاركات : 975
المواضيع 50
:
: 218
الإنتساب : Feb 2008
السلام عليكم
الأخطاء في الكود
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;
و لرب نازلة يضيق لها الفتى ذرعا و عند الله منها المخرج
ضاقت فلما استحكمت حلقاتها فرجت و كنت اضنها لا تفرج
المشاركات : 543
المواضيع 34
:
: 463
الإنتساب : Apr 2013
الياس الدويرة كتب :دالة بسيطة لي حذف الفراغ + تصحيح السورس الذي وضعته
function notvid(str tring) tring;
var i:integer;
c 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 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;
بارك الله فيك يا اخي الكريم على ال****** لكن في كود دالة حدف الفراغ اظن انه يجب اسناد قيمة ابتدائية للمتغير c ولتكن عبارة عن فراغ ' ' ؟؟؟
المشاركات : 543
المواضيع 34
:
: 463
الإنتساب : Apr 2013
نعم اخي S.FATEH قدا كررت الحرف K سهوا قصدت Q وكدلك الحرف W قصدته كبيرا كما نبهني الاخ Najy Ibraheem
بارك الله فيكم جميعا اتحفتموني بحلول رائعة
تم التعديل على الكود و الاستفاد ان شاء الله
المشاركات : 476
المواضيع 0
:
: 217
الإنتساب : Apr 2011
غيرت CharCase الخاصة بـ EDIT الى ecUpperCase
المشاركات : 29
المواضيع 3
:
: 0
الإنتساب : Mar 2011
S.FATEH كتب :السلام عليكم
الأخطاء في الكود
1) يجب حذف
لا داعي لرفع قيم العدادات الا في حالة استخدمت جملة while
عداد جملة التكرار for لا يزاد إلا بمقدار واحد والتلاعب بمقدار زيادته يؤدي إلى خطأ
كذلك يجب ان يكون متغير محلي والسبب أنه يحفظ في مسجلات المعالج لضمان سرعة في التنفيذ.
|