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
Printable View
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
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
click "edit" on my previous post to copy original formatting from the Reply window