مساعدة في المقارنة بين صورتين في الفحوال 6

كود زر المقارنة :

Dim I As Long
Dim N As Long


For I = 1 To Picture1.ScaleHeight


    For N = 1 To Picture1.ScaleWidth


        If Picture1.Point(N, I) <> Picture2.Point(N, I) Then
           Picture3.PSet (N, I), Picture2.Point(N, I)
           DoEvents
        Else
           Picture3.PSet (N, I), vbWhite
           DoEvents
        End If
        
    Next
    
    DoEvents
    
Next

السلام عليكم...

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

هناك طريقة أسرع، و هي باستعمال دوال API الخاصة بمعالجة الرسوميات (GDI)، و هي أيضاً أقل في الكود:

Private Sub Command3_Click()
    On Error GoTo Command3_Click_Err
    
    Set Picture4.Picture = Picture1.Picture
    Picture3.Width = Picture4.Width
    Picture3.Height = Picture4.Height
    Picture3.BackColor = vbWhite
    BitBlt Picture4.hDC, 0, 0, Picture4.ScaleWidth, Picture4.ScaleHeight, Picture2.hDC, 0, 0, SRCINVERT
    BitBlt Picture3.hDC, 0, 0, Picture3.ScaleWidth, Picture3.ScaleHeight, Picture4.hDC, 0, 0, SRCINVERT
    Exit Sub
    
Command3_Click_Err:
    MsgBox "خطأ" & vbCrLf & Err.Description, vbCritical, "خطأ في المقارنة"
End Sub

* الكود السابق يعمل على إطهار خلفية الصورة باللون الأبيض، و نقاط الاختلاف تظهر ملونة بألوان مختلفة. يمكنك الاطلاع على المزيد من غمل دوال معالجة الرسوميات (GDI APIs) لجعل جميع نقاط الاختلاف تظهر باللون الأسود.

في المرفقات البرنامج بعد التعديل. ستجد أننا أضفنا PictureBox آخر من أجل المعالجة الوسيطة للصورة.

ComparePictures.rar

نرجو الاستفادة و السلام.