#post-id: 3309-17-15 #original-date: 17.08.2009 Mon #original-time: 5:15 PM #original-day: &#160;3309 #original-host: WinXP Prof SP1 (Build 2600) Моя ре...

вторник, 18 августа 2009

18:17

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3309-17-15
#original-date: 17.08.2009 Mon
#original-time: 5:15 PM
#original-day: 3309
#original-host: WinXP Prof SP1 (Build 2600)

Моя реализация. Малость переделанная.

Option Explicit

Private Type BITMAPINFOHEADER
  biSize As Long
  biWidth As Long
  biHeight As Long
  biPlanes As Integer
  biBitCount As Integer
  biCompression As Long
  biSizeImage As Long
  biXPelsPerMeter As Long
  biYPelsPerMeter As Long
  biClrUsed As Long
  biClrImportant As Long
End Type

Private Type RGBQUAD
  rgbBlue As Byte
  rgbGreen As Byte
  rgbRed As Byte
  rgbReserved As Byte
End Type

Private Type BITMAPINFO
  bmiHeader As BITMAPINFOHEADER
  bmiColors As RGBQUAD
End Type

Private Declare Function GetDIBits Lib "gdi32" (ByVal hDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long

'====================================================================
Public Function IsImagesSame(ByVal hDC1 As API_HANDLE, _
                             ByRef hPicture1 As API_HANDLE, _
                             ByVal Picture1Width As Long, _
                             ByVal Picture1Height As Long, _
                             ByVal hDC2 As API_HANDLE, _
                             ByRef hPicture2 As API_HANDLE, _
                             ByVal Picture2Width As Long, _
                             ByVal Picture2Height As Long) As Boolean
  Dim BIH1 As BITMAPINFOHEADER
  Dim BIH2 As BITMAPINFOHEADER
  Dim RC As Long
  
  If Picture1Height <> Picture2Height Then Exit Function
  If Picture1Width <> Picture2Width Then Exit Function
  
  BIH1.biSize = Len(BIH1)
  BIH1.biPlanes = 1
  BIH1.biWidth = Picture1Width
  BIH1.biHeight = Picture1Height
  BIH1.biBitCount = 32
  BIH1.biClrUsed = DIB_RGB_COLORS
  BIH1.biCompression = BI_RGB
  
  BIH2 = BIH1
  
  Dim BitmapData1() As Long
  Dim BitmapData2() As Long
  
  ReDim BitmapData1(0 To (BIH1.biWidth * BIH1.biHeight) - 1)
  ReDim BitmapData2(0 To (BIH2.biWidth * BIH2.biHeight) - 1)
  
  RC = GetDIBits(hDC1, hPicture1, 0&, BIH1.biHeight, BitmapData1(0), BIH1, DIB_RGB_COLORS)
  If RC = 0 Then Exit Function 'MsgBox "1: " & asGetAPIErrorMessage(Err.LastDllError)
  RC = GetDIBits(hDC2, hPicture2, 0&, BIH2.biHeight, BitmapData2(0), BIH2, DIB_RGB_COLORS)
  If RC = 0 Then Exit Function 'MsgBox "2: " & asGetAPIErrorMessage(Err.LastDllError)
  
  IsImagesSame = IsBuffersEqual(BitmapData1, BitmapData2)
End Function

Private Function IsBuffersEqual(ByRef BitmapData1() As Long, _
                                ByRef BitmapData2() As Long) As Boolean
  Dim TMP As Long
  
  If UBound(BitmapData1) <> UBound(BitmapData2) Then Exit Function
  If LBound(BitmapData1) <> LBound(BitmapData2) Then Exit Function
  
  For TMP = LBound(BitmapData1) To UBound(BitmapData1)
    If BitmapData1(TMP) <> BitmapData2(TMP) Then Exit Function
  Next TMP
  
  IsBuffersEqual = True
End Function

Честно говоря, я так и не поняла, нафига hDC в GetDIBits(). Может быть для преобразования формата?

URL

Поделиться

Весь день продолбался с установкой 2000-х виндов, запарил... Вот ведь не везет, так одно за другим, переставил 2000-ый... "Тридцать спиц сходятся в ступице, но как раз промеж...

http://www.rough54.com/banners/single/murphy/murphy.htm ... Приехал. - Много ли нужно человеку для полного счастья? - Мало! ...

Комментарии


Запомнить

Лингрин :: Резиденция Линды Кайе