Printable View
HeHi there. I want to read a bitmap file and play aroud with its pixels. I don't want to load it into a picturebox or image control. HAs anyone opened a bitmap file and directly processed it's pixels without loading it into a picture or image control....
Thanks,
allan
Here's an example which I made to get the color under the cursor. It captures the pixel color (of a screenshot) when a shortcut is pressed. Then the color and its code is displayed on the form.
Module1:
---------------------------------------------
Public Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO_24, ByVal wUsage As Long) As Long
Public Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Public 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
Public Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Public Type BITMAPINFO_24
bmiHeader As BITMAPINFOHEADER
End Type
Public Const DIB_RGB_COLORS = 0
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Const VK_F1 = &H70
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
x As Long
y As Long
End Type
Public Const VK_CONTROL = &H11
Public Const VK_MENU = &H12
Public Const VK_SHIFT = &H10
Public Const VK_F10 = &H79
Public Const VK_F11 = &H7A
Public Const VK_F12 = &H7B
Public Const VK_F2 = &H71
Public Const VK_F3 = &H72
Public Const VK_F4 = &H73
Public Const VK_F5 = &H74
Public Const VK_F6 = &H75
Public Const VK_F7 = &H76
Public Const VK_F8 = &H77
Public Const VK_F9 = &H78
Public Type fkey
howmany As Integer
fstkey As Long
scndkey As Long
thrdkey As Long
End Type
Public firstkey As fkey
Public secondkey
Module2:
--------------------------------------------- Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As DEVMODE) As Long
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const HWND_TOP = 0
Const HWND_BOTTOM = 1
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_SHOWWINDOW = &H40
Global Const CF_BITMAP = 2
Global Const SRCCOPY = &HCC0020
Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32
Public Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Public pixelbuf() As RGBQUAD
Public bufsize&
Public BInfo As BITMAPINFO_24
Public Max
Function GetPixels(frm As Form) As Long
Dim dx&, dy&
Dim hSourceDC&, hDestDC&
Dim hBM&
Dim h&
Dim Dev As DEVMODE
dx = Screen.Width / Screen.TwipsPerPixelX
dy = Screen.Height / Screen.TwipsPerPixelY
hSourceDC = CreateDC("DISPLAY", "0", "0", Dev)
hDestDC = CreateCompatibleDC(hSourceDC)
hBM = CreateCompatibleBitmap(hSourceDC, dx, dy)
h = SelectObject(hDestDC, hBM)
Call BitBlt(hDestDC, 0, 0, dx, dy, hSourceDC, 0, 0, SRCCOPY)
retv = DIBits(dx, dy, hDestDC, hBM)
DeleteObject SelectObject(hSourceDC, h)
Call DeleteDC(hDestDC)
Call ReleaseDC(frm.hwnd, hSourceDC)
GetPixels = retv
End Function
Function DIBits(dx, dy, Pdc As Long, PHandle As Long) As Long
On Error Resume Next
With BInfo.bmiHeader
.biSize = 40
.biWidth = Screen.Width / Screen.TwipsPerPixelX
.biHeight = Screen.Height / Screen.TwipsPerPixelY
.biPlanes = 1
.biBitCount = 32
.biCompression = 0
.biClrUsed = 0
.biClrImportant = 0
.biSizeImage = bufsize
End With
bufsize = dx * dy
ReDim pixelbuf(0 To bufsize - 1)
retv = GetDIBits(Pdc, PHandle, 0, BInfo.bmiHeader.biHeight, pixelbuf(0), BInfo, DIB_RGB_COLORS)
Max = (dx) * (dy) - 1
'PB.Max = Max
DIBits = retv
End Function
Form1:
---------------------------------------------Private Sub Combo1_Click()
GetFirstKey
GetSecondKey
If Combo2.Text <> "" Then
Status.Caption = Combo1.Text & " + " & Combo2.Text
End If
End Sub
Private Sub Combo2_Click()
GetSecondKey
GetFirstKey
Frame1.Caption = "Color under Cursor"
Status.Caption = Combo1.Text & " + " & Combo2.Text
End Sub
Private Sub Form_Load()
firstkey.howmany = 0
secondkey = ""
Combo1.AddItem "None"
Combo1.AddItem "STRG"
Combo1.AddItem "ALT"
Combo1.AddItem "SHIFT"
Combo1.AddItem "STRG + SHIFT"
Combo1.AddItem "STRG + ALT"
Combo1.AddItem "STRG + SHIFT + ALT"
For i = 65 To 90
Combo2.AddItem Chr(i)
Next i
For i = 1 To 12
Combo2.AddItem "F" & i
Next i
Combo1.ListIndex = 0
End Sub
Sub ChangeColor()
Dim co As POINTAPI
Dim xmax&, ymax&, pos&
GetCursorPos co
xmax = Screen.Width / Screen.TwipsPerPixelX
ymax = Screen.Height / Screen.TwipsPerPixelY - 1
pos = ((ymax - co.y) * xmax) + co.x
GetPixels Form1
ColorLabel.BackColor = RGB(pixelbuf(pos).rg