Hiện tại mình có code này dùng BitBlt save thành file ảnh, sau đó hash file ảnh vừa tạo.
Mình muốn lược bỏ bớt bước "lưu ảnh thành file sau đó hash file ảnh" mà muốn hash luôn không cần save file thì làm như thế nào ạ? Kính nhờ mọi người hỗ trợ!
Mã:
Option Explicit
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type PicBmp
Size As Long
Type As Long
hBmp As LongPtr
hPal As LongPtr
'Reserved As Long
End Type
Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr
Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr
Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As Long
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
'Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Public Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Const vbSrcCopy As Long = &HCC0020
Private Const S_OK As Long = 0
Function ScreenCapture( _
ByVal x As Long, _
ByVal y As Long, _
ByVal w As Long, _
ByVal h As Long, _
ByVal fname As String _
) As Boolean
Dim uPic As PicBmp
Dim IPic As IPictureDisp
Dim IID_IDispatch As GUID
Dim hdc As LongPtr, hDcMem As LongPtr, hBmp As LongPtr
Dim hBmpOld As LongPtr, lRes As Long
On Error GoTo Failure
hdc = GetDC(0)
hDcMem = CreateCompatibleDC(hdc)
hBmp = CreateCompatibleBitmap(hdc, w, h)
hBmpOld = SelectObject(hDcMem, hBmp)
lRes = BitBlt(hDcMem, 0, 0, w, h, hdc, x, y, vbSrcCopy)
hBmp = SelectObject(hDcMem, hBmpOld)
Call ReleaseDC(0, hdc)
Call DeleteDC(hDcMem)
With IID_IDispatch
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
With uPic
.Size = Len(uPic)
.Type = 1 'bitmap
.hBmp = hBmp
.hPal = 0
End With
lRes = OleCreatePictureIndirect(uPic, IID_IDispatch, True, IPic)
If lRes = S_OK Then
stdole.SavePicture IPic, fname
ScreenCapture = True
End If
Exit Function
Failure:
End Function
Sub Test()
Dim cTime As String
cTime = "C:\OD\OneDrive\Download\myScreenPic" & Format(Now(), "yyddmmhhmmss") & ".bmp"
If ScreenCapture(x:=0, y:=100, w:=800, h:=800, fname:=cTime) Then
Debug.Print MD5(cTime)
Else
'
End If
End SubMình muốn lược bỏ bớt bước "lưu ảnh thành file sau đó hash file ảnh" mà muốn hash luôn không cần save file thì làm như thế nào ạ? Kính nhờ mọi người hỗ trợ!
