تطبيق للرسم و الإضافة على الصور - مستوى مبتدئ -

[merouane]

بسم الله الرحمن الرحيم

والصلاة والسلام على خير البرية رسول الله

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

*************************************** الدرس ***************************************

MyPaint

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

البداية:

سنبدأ بتهيئة الواجهة بحيث في النهاية سنحصل على التالي

1. ننشئ مشروع دلفي جديد نسميه MyPaint.dpr

2. نضع مكون ToolBar



3. على التوالي: - نضغط بيمين الفأرة ونختار فراغ (فاصل) جديد

• نضع SpeedButton نسميه SBNew ، ثم Caption تأخذ "جديد"
  
• نضع SpeedButton نسميه SBOpen ، ثم Caption تأخذ " افتح صورة"
  
• نضع SpeedButton نسميه SBSave ، ثم Caption تأخذ " احفظ الصورة"
  
• نضع SpeedButton نسميه SBSave ، ثم Caption تأخذ "امسح المحتوى"
  

4. نضع Panel، ثم Align تأخذ alBottom ، ثم في وسطه
- نضع Panel، ثم Align تأخذ alLeft ، ثم في وسطه
. نضع Panel، ثم BevelOuter تأخذ bvLowered، ثم في وسطه
. نضع اثنين (02) Panel. حيث نسمي الذي في الأعلى بـ PBackGr و الذي في الأسفل PForGr


5. نضع ColorGrid، نجدها في الطرف Exemple
6. نضغط على Form1 ثم نضع Panel، ثم Align تأخذ alLeft، و Width تأخذ القيمة 88، ثم في وسطه

• نضع Panel، ثم Align تأخذ alTop ، ثم في وسطه
  نضع 08 SpeedButton (الصور مرفقة وتضاف بواسطة Gliph لكل SpeedButton)
  
• نضع Panel، و Width تأخذ القيمة 80 ، ثم في وسطه
  نضع 06 Label حيث Tag و Height لكل من Label1 حتى Label5 تأخذ على التوالي: 1، 2، 4، 6، 8
  
• Color لكل من Label1 حتى Label5 تأخذ clBlack
  
• Colorللـ Label6 تأخذ clBlue
  
• Top لكل من Label1 حتى Label5 تأخذ على التوالي: 5، 14، 23، 32، 41
  
• Width لكل من Label1 حتى Label5 تأخذ 70
  
• Left لكل من Label1 حتى Label5 تأخذ 5
  
• نضغ يمينا بالفأرة على Label6 ونضغط على Options de Contrôle -> Mettre en arrière plan
  (النسخة الانجليزية : )Control Options -> Set in the background
  

7. نضغط على Form1 ثم نضع Panel، ثم Align تأخذ alClient، ثم في وسطه
- نضع Image ، ثم Align تأخذ alClient
بهذا سنتحصل على الواجهة مثل ما هو موضح أعلاه

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

كود :

Mode: integer = 0;                // نوع الرسم :قلم، ممحاة، مربع، دائرة
  xB, yB, x0, y0: integer         ; // المتغيرات لحفظ نقطة الفأرة عند المرور أو الرسم
  CanPaint: Boolean = false   ; // بعد انشاء الصورة أو فتح الصورة يسمح بالرسم

الكود:

بالضغط على جديد:

كود :

procedure TForm1.SBNewClick(Sender: Tobject) ;
begin
image1.Visible:=true;                            // نظهر الصورة
  with Image1.Canvas do
   begin
     Brush.Color:=clWhite;                     // اللون الذي سيملء الصورة الجديدة
     FillRect(rect(0,0,Width,Height)); //نملء الصورة من أول نقطة إلى آخر نقطة فيها
     Brush.Color:=clBlack;                   //لا ننسى إعادة اللون الأسود للرسم
   end;
SBErease.Enabled:=true;                  //تفعيل زر "امسح المحتوى"
CanPaint:=True;                                  //تفعيل استطاعة الرسم
end;

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

كود :

procedure TForm1.SBOpenClick(Sender: Tobject) ;
begin
  if OpenPic1.Execute then
   begin
    image1.Visible:=true;
    Image1.Picture.LoadFromFile(OpenPic1.FileName ) ; // تحميل الصورة من الملف المختار
    SBErease.Enabled:=true;
    CanPaint:=True;
end;
end;

بالضغط على "احفظ الصورة"
قبل ذلك نضع مكون SavePictureDialog الذي نجده في الطرف Dialogs نسميه SavePic1

كود :

procedure TForm1.SBSaveClick(Sender: Tobject) ;
begin
   if SavePic1.Execute then
  begin
    Image1.Picture.SaveToFile(SavePic1.FileName) ;  // نحفظ الصورة في الملف المراد
end;
end;

بالضغط على "امسح المحتوى"
في الحقيقة اكتفيت بمناداة الزر "جديد"، و ذلك بالذهاب إلى أحداث الزر "امسح المحتوى" وبالضبط عند OnClick ونعطيها القيمة SBNewClick.


الأن ننتقل إلى الأزرار التي في Panel في الطرف الأيسر، نضغط مرتين على الزر الأول (في حالتي SpeedButton5) و نكتب :

كود :

procedure TForm1.SpeedButton5Click(Sender: Tobject) ;
begin
Mode:=(Sender as TSPeedButton).Tag;
end;

ثم لكل SpeedButton من المجموعة، OnClick يأخذ SpeedButton5Click،
و GroupIndex يأخذ 1

الأن نذهب إلى Panel أين وضعنا 06 Label، و نضغط على Label1 مرتين متتاليتين ونكتب في الكود مايلي:

كود :

procedure TForm1.Label1Click(Sender: Tobject) ;
begin
   Label6.Top:=(Sender as TLabel).Tag;
   Image1.Canvas.Pen.Width := (Sender as TLabel).Tag; // عرض أداة الرسم
end;

ثم لكل Label من Label2 حتى Label5، OnClick يأخذ Label1Click ،
في نفس Panel نضغك على OnMouseDown و نكتب:

كود :

procedure TForm1.Panel8MouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer) ;
begin
  case y of
    0..9   : Label1Click(Label1) ;  // نستدعي الزر كل حسب موقع الفأرة حيت الضغط
  19..10 : Label1Click(Label2) ;
    20..29 : Label1Click(Label3) ;
    30..39 : Label1Click(Label4) ;
    40..55 : Label1Click(Label5) ;
  end;
end;

الآن بالضغط على OnClick الخاص بـ ColorGrid1 ثم نكتب

كود :

procedure TForm1.ColorGrid1Click(Sender: Tobject);
begin
  PBackGr.Color := ColorGrid1.BackgroundColor;
  PForGr.Color := ColorGrid1.ForegroundColor;
  end;

الآن يأتي دور Image1، وهنا سنتعامل مع تحركات الفأرة والضغط عليها
نضغط على Image1 ثم نذهب إلى الأحداث (Evenement)، ثم نضغط على OnMouseDown مرتين ونكتب:

كود :

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
            Shift: TShiftState; X, Y: Integer) ;
begin
   image1.Canvas.MoveTo(x,y) ;  // نوجه أداة الرسم نحو تواجد الفأرة
   xB := x;                                            // نحتفظ بالقيمة الحالية لتواجد الفأرة
   yB := y;                     // نحتفظ بالقيمة الحالية لتواجد الفأرة
end;

ثم نضغط على OnMouseMove مرتين ونكتب:

كود :

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
                     Y: Integer) ;
var C: TColor;
begin
if CanPaint = true then
with Image1.Canvas do
begin
if (ssleft in Shift)or (ssRight in Shift) then
begin
  if (ssleft in Shift) then
    begin
    Pen.Color:=PBackGr.Color;
    Brush.Color:= PForGr.Color;
    end
    else if (ssRight in Shift) then
           begin
           Pen.Color:=PForGr.Color;
           Brush.Color:=PBackGr.Color;
           end;
  case mode of
    0: LineTo(x,y);  // Pen
    1: begin          // Erease  عملية المسح الجزئي
        C := pen.Color;
        pen.Color:=clWhite;
        lineto(x,y) ;
        pen.Color := C;
       end;
    2: FillRect(rect(0,0,Width,Height));  // Fill
    3: Pixels[x0+random(x0),y0+random(y0)]:=Pen.Color; // هذا الإجراء ناقص للتعدبل مستقبلا
  4: begin          // Rectangle
        pen.Mode:=pmXor;
        Rectangle (xB,yB,x0,y0) ;
        Rectangle (xB,yB,x,y) ;
       end;
    5: begin          // Cercle
        pen.Mode:=pmXor;
        Ellipse(xB,yB,x0,y0) ;
        Ellipse(xB,yB,x,y) ;
       end;
  end;
end;
end;
  x0:=x ;
  y0:=y;
  Image1.Canvas.Pen.Mode:=pmCopy;
end;

ثم نضغط على OnMouseUp مرتين ونكتب:

كود :

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
                 Shift: TShiftState; X, Y: Integer) ;
begin
if CanPaint = true then
with Image1.Canvas do
  case mode of
    4: begin          // Rectangle
        pen.Mode:=pmCopy;
        Rectangle (xB,yB,x,y) ;
       end;
    5: begin          // Cercle
        pen.Mode:=pmCopy;
        Ellipse(xB,yB,x,y) ;
       end;
  end;
end;

و أخيرا نذهب للـ OnCreate التابعة للـ Form1 :

كود :

procedure TForm1.FormCreate(Sender: Tobject) ;
begin
   ColorGrid1Click(Self) ;
end;

انتهى الدرس ، التطبيق مع الكود في المرفقات

لمن أراد التعمق ليبحث كيف يضيف نص إلى الصورة (مع أنها سهلة)، وكذلك Zoom

آمل أنه مفيد

تحياتي