delphi4arab منتديات دلفي للعرب - خطاء في كود للجمع حسب كل مجموعة

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

كود :
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;
[attachment=3491]

عفوا الكود المستعمل هو

كود :
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;

بعص الملاخظات وليس الحل على الصور الكود

كود :
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;

يتم أخذ القرار حسب القيم الموجوده في المتغيرات الثلاث
xCda,xCdb,xCdd
مع سابقهم من القيم الموجودة في الحقول والتي أسندت اليهة فيما سبق

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

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

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

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
// اذا تساو ى القيم الثلاث مع سابقهم من القيم وهم
//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 

;

(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

سلام عليكم
ربما لم افهم ما تريد بالضبط ... لكن
لكن نصيحتي كاتالي :
- عدل على تصميم الجدول بما يتناسب مع طلباتك (يجب ان تكون لديك نضرة مستقبلية لتصميم الجدول)
- استعمل جمل الاستعلام (sql query) بدل (table و المتغيرات ...)

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

كود :
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;

(10-05-2017, 09:09 AM)sabre كتب : [ -> ]أعتقد لأن مطابقت الصورة مع نتيجة تنفيذ الكود قد تمت فعلا
ودليل هناك صورة مرفقة تثبت ذلك
بارك الله فيك اهي صابر لكن حاول تغيير القيمة false الى true في السجل الاول واحسب
من المفروض تكون النتيجة 2000
وحاول تغيير القيمة false الى true في السجل الثاني و ارجع القيمة false في السجل الاول واحسب وانظر ماذا يحصل
من المفروض النتيجة تكون
وهكذا على باقي السجلات
ملاجظة
يجب ان تكون النتيجة في الصف الاخير للفرقة وليس في الصف الاول للفرقة الموالية
وبالتوفيق

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

[attachment=3501]

(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;