PDA

Click to See Complete Forum and Search --> : copying pixels from a picture file


dogfish227
Nov 11th, 2002, 10:24 AM
is their a way to copy pixles straight from a picture file? i already know how to load the picture in to a picbox and then use getpixel but i want to know a way to do it with out copying it into a picture box

dafhi
Nov 11th, 2002, 09:57 PM
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 BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type

Dim BMPadBytes&
Dim BMPFileHeader As BITMAPFILEHEADER 'Holds the file header
Dim BMPInfoHeader As BITMAPINFOHEADER 'Holds the info header
Dim BMPData() As Byte 'Holds the pixel data

Private Sub Form_Load()
ScaleMode = vbPixels
End Sub

Private Sub Form_Resize()
TruecolorBmpToArray "Clipboard.bmp"
End Sub

Private Sub TruecolorBmpToArray(strFileName$)
Dim XLng& '1d. XLng marks the position. YLng is a reference.
Dim YLng&
Dim AddDrawWidthBytes&
Dim DrawRight&
Dim TopLeft&
Dim WidthBytes&
Dim X_Max&
Dim Y_Max&
Dim N&
Dim DrawX&, DrawY&
Dim Blue&
Dim Green&
Dim Red&

Open (App.Path & "\" & strFileName) For Binary As #1
Get #1, 1, BMPFileHeader
Get #1, , BMPInfoHeader
With BMPInfoHeader
N = 3 * .biWidth '(red, green, blue) * width
BMPadBytes = ((N + 3) And &HFFFFFFFC) - N
ReDim BMPData(.biHeight * (BMPadBytes + .biWidth * .biBitCount / 8))
End With
Get #1, , BMPData
Close #1

'These are used to reference 1d array file bytes
WidthBytes& = BMPInfoHeader.biWidth * 3& + BMPadBytes

If WidthBytes > 0 Then

If BMPInfoHeader.biWidth > ScaleWidth Then
X_Max = ScaleWidth - 1
Else
X_Max = BMPInfoHeader.biWidth - 1
End If

Y_Max = ScaleHeight - 1
DrawY = Y_Max

DrawRight = X_Max * 3
TopLeft = WidthBytes * Y_Max
For YLng& = 0& To TopLeft Step WidthBytes
DrawX = 0
AddDrawWidthBytes& = YLng& + DrawRight&
For XLng& = YLng& To AddDrawWidthBytes& Step 3&
Blue = BMPData(XLng&)
Green = BMPData(XLng& + 1)
Red = BMPData(XLng& + 2)
PSet (DrawX, DrawY), RGB(Red, Green, Blue)
DrawX = DrawX + 1
Next XLng
DrawY = DrawY - 1
Next YLng

End If 'Widthbytes > 0

End Sub

dafhi
Nov 11th, 2002, 10:13 PM
click "edit" on my previous post to copy original formatting from the Reply window