Cut Zoom Move

اقتباس

البروسيدجور

ما هذا ؟ ممكن تكتب الكلمة الانجليزية بجانت كل كلمة عربتها!

يمكن يقصد procedures :)

اها شكرا G~M

لم اكن اعرف انه في بعض المناطق العربية D تقرء دج اي dj

B.M.AbdelAziZ كتب:

ما هذا ؟ ممكن تكتب الكلمة الانجليزية بجانت كل كلمة عربتها!

أظن أن هناك خطأ في الكود حسب فهمي للفكرة

قم بالتعديلات الآتية و آخبرني هل النتيجة هي التي تريدها أم لا ...

كود Shape1MouseUp

procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
   var
  MyRect,DestRect: TRect;

begin
if Dragging then
 begin
  canvaS.DrawFocusRect(FocusRect);
  Dragging:=falSe;
  With sender as TShape do
  begin
  left:=(Left+X)-XOffset;
  top:= (Top+y)-yOffset;
  end;
 end;

  //x:=shape1.Left-image2.Left;
  //y:=shape1.Top-image2.top;

  //MyRect := Rect(x,y,x+shape1.ClientWidth,shape1.ClientHeight+y);

 MyRect := Rect(shape1.Left-image1.Left,shape1.Top-image1.Top,
  shape1.Width+shape1.Left-image1.Left,shape1.Height+shape1.Top-image1.Top);

 DestRect:= Rect(0,0,shape1.Width,shape1.Height);

 image2.Canvas.CopyMode:= cmSrcCopy;
 image2.Canvas.CopyRect(DestRect,Image1.Canvas,MyRect);
end;

في كود Zoom

تأكد من

for i:=1 to Timage(Sender).ClientHeight-1 do

و

for j:= 1 to Timage(Sender).ClientWidth-1 do

بالنسبة لفكرة اليمين واليسار هل ما يلي يفي بالغرض ... إن لم تكن ما تريد فمن الأفضل شرح الفكرة التي تريد عملها

لليمين

procedure TForm1.Button4Click(Sender: TObject);
var

   i,j,imgcount:Integer;
   sizeWidth:integer;
   sizeHeight:integer;
   MyRect,DestRect: TRect;
begin
  Shape1.Left:=Shape1.Left+1;

  MyRect := Rect(shape1.Left-image1.Left,shape1.Top-image1.Top,
  shape1.Width+shape1.Left-image1.Left,shape1.Height+shape1.Top-image1.Top);
  DestRect:= Rect(0,0,shape1.Width,shape1.Height);
  image2.Canvas.CopyMode:= cmSrcCopy;
  image2.Canvas.CopyRect(DestRect,Image1.Canvas,MyRect);

  ZoomImage(Image2);
end;

لليسار

procedure TForm1.Button3Click(Sender: TObject);
var
  MyRect,DestRect: TRect;
begin
  Shape1.Left:=Shape1.Left-1;

  MyRect := Rect(shape1.Left-image1.Left,shape1.Top-image1.Top,
  shape1.Width+shape1.Left-image1.Left,shape1.Height+shape1.Top-image1.Top);
  DestRect:= Rect(0,0,shape1.Width,shape1.Height);
  image2.Canvas.CopyMode:= cmSrcCopy;
  image2.Canvas.CopyRect(DestRect,Image1.Canvas,MyRect);

  ZoomImage(Image2);
end;

ملحوظة : حاول تعديل خورازمية التكبير لتكون أسرع ...

*التعديل : في تنسيق الكود

السلام عليكم ورحمة الله وبركاته :

اخي في الله سلمت يداك وجزاك الجنة اللهم آآآآآمين

الكود بإذن الله قيد التجريب وسأخبرك بالنتائج .....

نقطة ثانية مهمة :

فعلا هناك مشكلة كانت تواجهنا في سرعة ظهور الصورة المكبرة وسنحاول بإذنه تعالى إخبارك بالنتائج

بارك الله فيك مرة ثانية ورحم الله والدينا ووالديك

kombarji

آميـــن!

كنت أقصد أن الخطأ في Shape1MouseUp

بالنسبة للتسريع في عملية الـ Zoom , ربما إستعمال scanline سيكون أفضل ...

راجع ما يلي :

http://www.efg2.com/Lab/ImageProcessing/Scanline.htm

http://dn.codegear.com/article/29173

cipher كتب:

آميـــن!

كنت أقصد أن الخطأ في Shape1MouseUp

بالنسبة للتسريع في عملية الـ Zoom , ربما إستعمال scanline سيكون أفضل ...

راجع ما يلي :

http://www.efg2.com/Lab/ImageProcessing/Scanline.htm

http://dn.codegear.com/article/29173

السلام عليكم ورحمة الله تعالى وبركاته بارك الله فيك على الدروس ....

جزاك الله جنان الفردوس اللهم آآآآآآمين تم

عمل البرنامج وسأوافيك به في أقرب فربصة بإدنه تعالى

السلام عليكم ورحمة الله تعالى وبركاته

أخي Cipher كما وعدت أحضرت ملف البرنامج .....

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

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

ثاني نقطة الشكر والتقدير لكل من ساهم في المساعدة في إنجاز المشروع ... (( أسكنكم الله فسيح الجنان اللهم آآآمين )))

ثالث نقطة لاحظت أن بعض المواقع العربية (( والله يسامحهم نسبوا البرنامج لأنفسهم ... ))) الاولى يجب على الاقل ذكر المرجع الذي أخذ منه البرنامج فهو في النهاية جهد الاشخاص اللذين ساهموا في إخراجه والعمل عليه حتى ولو كان البرنامج بسيط .....

لكم مني جزيل الشكر والعرفان إخوتي في الله ....

وهذا هو الملف المرفق .....

Kombarji

CopyRect6.rar