خطاء في كود للجمع حسب كل مجموعة
#1
السلام عليكم ورحمة الله تعالى وبركاته
حاولت عدة مرات بهذا الكود الا ان الجمع المطلوب ليس مضبوط والمجمع المطلوب هو حسب الصورة المرفقة
والكود المستعمل هو
كود :
procedure TFrmCalc.Button1Click(Sender: TObject);
Var xCda,xCdb,xCdd:string;
Blq:Boolean;
tot:Double;
begin
   with DM do
   begin
   Table1.first;
   xCda:=Table1Cda.asstring;
   xCdb:=Table1Cdb.Asstring;
   xCdd:=Table1Cdd.Asstring;
   Table1.next;
   Table1.First;
   while not (Table1.eof) do
   begin
     If (Table1Cda.asstring=xCda) and (Table1Cdb.Asstring=xCdb) and (Table1Cdd.Asstring=xCdd) then
     begin
       tot:=Table1MT.value+tot;
     end else begin
       Table1.Prior;
       Table1.edit;
       Table1MTot.VALUE:=tot;
       tot:=Table1MT.value;
       Table1.Next;
     end;
     xCda:=Table1Cda.asstring;
     xCdb:=Table1Cdb.Asstring;
     xCdd:=Table1Cdd.Asstring;
     Table1.Next;
   end;
end;
end;

.bmp   resultat.bmp (الحجم : 17.58 KB / التحميلات : 12)

عفوا الكود المستعمل هو
كود :
procedure TFrmCalc.Button1Click(Sender: TObject);
Var xCda,xCdb,xCdd:string;
Blq:Boolean;
tot:Double;
begin
   with DM do
   begin
   Table1.first;
   xCda:=Table1Cda.asstring;
   xCdb:=Table1Cdb.Asstring;
   xCdd:=Table1Cdd.Asstring;
   Table1.next;
   Table1.First;
   while not (Table1.eof) do
   begin
        If Table1Active=False then
        begin  
If (Table1Cda.asstring=xCda) and (Table1Cdb.Asstring=xCdb) and (Table1Cdd.Asstring=xCdd) then
      begin
        tot:=Table1MT.value+tot;
      end else begin
        Table1.Prior;
        Table1.edit;
        Table1MTot.VALUE:=tot;
        tot:=Table1MT.value;
        Table1.Next;
      end;
      end;
     xCda:=Table1Cda.asstring;
     xCdb:=Table1Cdb.Asstring;
     xCdd:=Table1Cdd.Asstring;
     Table1.Next;
   end;
end;
end;
الرد
#2
بعص الملاخظات وليس الحل على الصور الكود
كود :
procedure TFrmCalc.Button1Click(Sender: TObject);
Var
 xCda,xCdb,xCdd:string;
 Blq:Boolean;
 tot:Double;
begin
  with DM do
  begin
  Table1.first;
  xCda:=Table1Cda.asstring;
  xCdb:=Table1Cdb.Asstring;
  xCdd:=Table1Cdd.Asstring;
  Table1.next; // ÎØÃ
  Table1.First;
  while not (Table1.eof) do
  begin
     If Table1.Active=False then
     begin
{
هذا الشرط لن يتحقق
واذا تحقق سيحدث خطأ من البداية
أعتقد أن هذا خطأ برمجي وغير جائز بتاتا
هذا حسب علمي
وظهور هذه الرسالة
Table1 : Imossible d' effectuer cette opération sur un ensembe de données fermé.
من المستحل اسناد هذه العملية الأن المعطيات في حالة اغلاق
وهذا اذا كان تابل غير نشط أي مغلق
واذا كان غير مقلغ لن يحدث شيء
وقيلى انت تسيي في
}
     If (Table1Cda.asstring=xCda) and (Table1Cdb.Asstring=xCdb) and
          (Table1Cdd.Asstring=xCdd) then
       begin
         tot:=Table1MT.value+tot;
       end
       else
       begin
        Table1.Prior;
        Table1.edit;
        Table1MTot.VALUE:=tot;
        tot:=Table1MT.value;
        Table1.Next;
       end;
     end;
    xCda:=Table1Cda.asstring;
    xCdb:=Table1Cdb.Asstring;
    xCdd:=Table1Cdd.Asstring;
    Table1.Next;
  end;
end;
end;


الملفات المرفقة
.jpg   medd.JPG (الحجم : 27.54 KB / التحميلات : 18)
الرد
#3
يتم أخذ القرار حسب القيم الموجوده في المتغيرات الثلاث
xCda,xCdb,xCdd
مع سابقهم من القيم الموجودة في الحقول والتي أسندت اليهة فيما سبق

بمعنى أننا نقارن القيمة الاولى مع الثانية في نفس الحقل وهكذا مع القيم الباقية

وهذا حسب الكود الذي وضعته


PHP كود :
===================================================

procedure TFrmCalc.Button1Click(SenderTObject);
Var
  xCda,xCdb,xCdd:string;
  Blq:Boolean;
  tot:Double;

begin
   with DM 
do
   begin
   Table1
.first;
   xCda:=Table1Cda.asstring;
   xCdb:=Table1Cdb.Asstring;
   xCdd:=Table1Cdd.Asstring;
   //Table1.next; //  ليس له أهية
   
   
//Table1.First; //  ليس له أهية
   while not (Table1.eof) do
   begin
 
//     If Table1.Active=False then   // غير ممكن
 //     begin
{

هذا الشرط لن يتحقق
واذا تحقق سيحدث خطأ من البداية
أعتقد أن هذا خطأ برمجي وغير جائز بتاتا
هذا حسب علمي

وظهور هذه الرسالة
Table1 
Imossible d' effectuer cette opération sur un ensembe de données fermé.
من المستحل اسناد هذه العملية الأن المعطيات في حالة اغلاق

وهذا اذا كان تابل غير نشط أي مغلق
واذا كان غير مقلغ لن يحدث شيء

}
      If(Table1Cda.asstring=xCda)and(Table1Cdb.Asstring=xCdb)and
           (Table1Cdd.Asstring=xCdd)then
        begin
// اذا تساو ى القيم الثلاث مع سابقهم من القيم وهم
//Table1Cda.Asstring=xCda و Table1Cdb.Asstring=xCdb و Table1Cdd.Asstring=xCdd
// قم بعملية الجمع
           tot:=Table1MT.value+tot;
        end
        else If((Table1Cda.asstring=xCda)and(Table1Cdb.Asstring=xCdb))or
        (Table1Cdd.Asstring<>xCdd)then
        begin
// اذا تساوت القيمتان مع سابقهما  وهما
// Table1Cda.Asstring=xCda و Table1Cdb.Asstring=xCdb
// اسند القيمة الحالية للحقل  ام تي الى المتغير توت
           tot:=Table1MT.value;
           Table1.Next;
        end
        else
        begin
          // Table1.Prior;  //  ليس له أهية
           Table1.edit;
           Table1MTot.VALUE:=tot;
           tot:=Table1MT.value;
           Table1.Next; 
        end;
      //end;
     xCda:=Table1Cda.asstring;
     xCdb:=Table1Cdb.Asstring;
     xCdd:=Table1Cdd.Asstring;
     Table1.Next;
   end;
 end;
end 
;


الملفات المرفقة
.rar   med.rar (الحجم : 2.86 KB / التحميلات : 16)
الرد
#4
(03-05-2017, 06:07 PM)medreg كتب :  السلام عليكم ورحمة الله تعالى وبركاته
حاولت عدة مرات بهذا الكود الا ان الجمع المطلوب ليس مضبوط والمجمع المطلوب هو حسب الصورة المرفقة
والكود المستعمل هو
كود :
procedure TFrmCalc.Button1Click(Sender: TObject);
Var xCda,xCdb,xCdd:string;
Blq:Boolean;
tot:Double;
begin
   with DM do
   begin
   Table1.first;
   xCda:=Table1Cda.asstring;
   xCdb:=Table1Cdb.Asstring;
   xCdd:=Table1Cdd.Asstring;
   Table1.next;
   Table1.First;
   while not (Table1.eof) do
   begin
     If (Table1Cda.asstring=xCda) and (Table1Cdb.Asstring=xCdb) and (Table1Cdd.Asstring=xCdd) then
     begin
       tot:=Table1MT.value+tot;
     end else begin
       Table1.Prior;
       Table1.edit;
       Table1MTot.VALUE:=tot;
       tot:=Table1MT.value;
       Table1.Next;
     end;
     xCda:=Table1Cda.asstring;
     xCdb:=Table1Cdb.Asstring;
     xCdd:=Table1Cdd.Asstring;
     Table1.Next;
   end;
end;
end;

عفوا الكود المستعمل هو
كود :
procedure TFrmCalc.Button1Click(Sender: TObject);
Var xCda,xCdb,xCdd:string;
Blq:Boolean;
tot:Double;
begin
   with DM do
   begin
   Table1.first;
   xCda:=Table1Cda.asstring;
   xCdb:=Table1Cdb.Asstring;
   xCdd:=Table1Cdd.Asstring;
   Table1.next;
   Table1.First;
   while not (Table1.eof) do
   begin
        If Table1Active.value=False then
        begin  
If (Table1Cda.asstring=xCda) and (Table1Cdb.Asstring=xCdb) and (Table1Cdd.Asstring=xCdd) then
      begin
        tot:=Table1MT.value+tot;
      end else begin
        Table1.Prior;
        Table1.edit;
        Table1MTot.VALUE:=tot;
        tot:=Table1MT.value;
        Table1.Next;
      end;
      end;
     xCda:=Table1Cda.asstring;
     xCdb:=Table1Cdb.Asstring;
     xCdd:=Table1Cdd.Asstring;
     Table1.Next;
   end;
end;
end;
عفوا على الخطأ
كود :
        If Table1Active=False then )
       begin   )
الصواب
If Table1Active.value=False then
begin
الرد
#5
سلام عليكم
ربما لم افهم ما تريد بالضبط ... لكن
لكن نصيحتي كاتالي :
- عدل على تصميم الجدول بما يتناسب مع طلباتك (يجب ان تكون لديك نضرة مستقبلية لتصميم الجدول)
- استعمل جمل الاستعلام (sql query) بدل (table و المتغيرات  ...)
الفاشلون نوعان : الأول : فكر ولم يفعل .. والآخر: فعل ولم يفكر
الرد
#6
أعتقد لأن مطابقت الصورة مع نتيجة تنفيذ الكود قد تمت فعلا
ودليل هناك صورة مرفقة تثبت ذلك



كود :
procedure TFrmCalc.Button1Click(Sender: TObject);
Var
    xCda,xCdb,xCdd:string;
    Blq:Boolean;
    tot:Double;

begin
   with DM do
   begin
    Table1.first;
    xCda:=Table1Cda.asstring;
    xCdb:=Table1Cdb.Asstring;
    xCdd:=Table1Cdd.Asstring;
    while not (Table1.eof) do
    begin
      If Table1Active.value=False then
      begin
      If(Table1Cda.asstring=xCda)and(Table1Cdb.Asstring=xCdb) and
         (Table1Cdd.Asstring=xCdd)then
        begin
           tot:=Table1MT.value+tot;
        end
        else
        begin
          Table1.edit;
          Table1MTot.VALUE:=tot;
          Table1.Next;
          tot:=Table1MT.value;
        end;
      xCda:=Table1Cda.asstring;
      xCdb:=Table1Cdb.Asstring;
      xCdd:=Table1Cdd.Asstring;
      end
        else tot:=Table1MT.value;
      Table1.Next;
   end;
 end;
end;


الملفات المرفقة
.rar   med1.rar (الحجم : 2.95 KB / التحميلات : 12)
.jpg   mad2.JPG (الحجم : 49.72 KB / التحميلات : 6)
الرد
#7
(10-05-2017, 09:09 AM)sabre كتب :  أعتقد لأن مطابقت الصورة مع نتيجة تنفيذ الكود قد تمت فعلا
ودليل هناك صورة مرفقة تثبت ذلك
بارك الله فيك اهي صابر لكن حاول تغيير القيمة false الى true في السجل الاول واحسب
من المفروض تكون النتيجة 2000
وحاول تغيير القيمة false الى true في السجل الثاني و ارجع القيمة false في السجل الاول  واحسب وانظر ماذا يحصل
من المفروض النتيجة تكون
وهكذا على باقي السجلات
ملاجظة
يجب ان تكون النتيجة في الصف الاخير للفرقة وليس في الصف الاول للفرقة الموالية
وبالتوفيق

يجب ان يكون على هذا الشكل


.png   Sans titre.png (الحجم : 11.3 KB / التحميلات : 7)
الرد
#8
(10-05-2017, 01:32 PM)medreg كتب :  
(10-05-2017, 09:09 AM)sabre كتب :  أعتقد لأن مطابقت الصورة مع نتيجة تنفيذ الكود قد تمت فعلا
ودليل هناك صورة مرفقة تثبت ذلك
بارك الله فيك اهي صابر لكن حاول تغيير القيمة false الى true في السجل الاول واحسب
من المفروض تكون النتيجة 2000
وحاول تغيير القيمة false الى true في السجل الثاني و ارجع القيمة false في السجل الاول  واحسب وانظر ماذا يحصل
من المفروض النتيجة تكون
وهكذا على باقي السجلات
ملاجظة
يجب ان تكون النتيجة في الصف الاخير للفرقة وليس في الصف الاول للفرقة الموالية
وبالتوفيق

يجب ان يكون على هذا الشكل

لقد حلت المشكلة وهذا هو الكود لتعم الفائدة
كود :
i: integer;
procedure TFrmCalc.btnCalcClick(Sender: TObject);
type
 TMto = array of Double;
 Tcd = array of String;
var
 Mtot, MT: TMto;
 cdd, cdb, cda: Tcd;
 j: integer; tot: Double;
 Cont: integer;
begin
i := 0;
 with DM do
 begin
 Cont := Table1.RecordCount;
 SetLength(Mtot, Cont);
 SetLength(MT, Cont);
 SetLength(cdd, Cont);
 SetLength(cdb, Cont);
 SetLength(cda, Cont);
 Table1.DisableControls;
 try
 Table1.First;
 while not table1.Eof do
 begin
   if not Table1Active.value then
       MT[i] := Table1mt.Value;
   cdd[i] := Table1cdd.AsString;
   cdb[i] := Table1cdb.AsString;
   cda[i] := Table1cda.AsString;
   i := i + 1;
   Table1.Next;
 end;
   finally
     Table1.EnableControls;
   end;
 end;
 tot := Mt[0];
 for j := 1 to Cont-1 do
 begin
 if(cdd[j-1]=cdd[j])and(cdb[j-1]=cdb[j])and(cda[j-1]=cda[j])then
     tot := tot + MT[j]
   else
   begin
     Mtot[j-1] := tot;
     tot := Mt[j];
   end;
 end;
 Mtot[j-1] := tot;
 with DM do
 begin
 Table1.DisableControls;
 try
 Table1.First;
 for j := 0 to Cont-1 do
 begin
   Table1.Edit;
   if Mtot[j] = 0 then Table1Mtot.Text := ''
   else Table1Mtot.Value := Mtot[j];
   Table1.Next;
 end;
   finally
     Table1.EnableControls;
   end;
 end;
end;
الرد


التنقل السريع :


مستخدمين يتصفحوا هذا الموضوع: 1 ضيف