Date: 02-16-2022
Return to Index
created by gbSnippets
'Primary Code:
'This code revolves around using GET and PUT to read/write the two
'header structures (BITMAPFILEHEADER and BITMAPINFOHEADER). It also
'shows how to create and use a Byte array to hold the image color data.
'Create Buffer array to hold image color data
Dim Buffer(w*3+padding-1,h-1) As Byte 'pixel color array data (0-based array)
'Open input file
Open fSource For Binary as #1
Get #1, , bmpheader 'get BITMAPFILEHEADER
Get #1, , bmpinfo 'get BITMAPINFOHEADER
Get #1, bmpheader.bfOffBits+1, Buffer() 'read image data into structure start,length,variable
Close #1
'Open output file
Open fTarget For Binary as #1
Put #1,, bmpheader 'BITMAPFILEHEADER
Put #1,, bmpinfo 'BITMAPINFOHEADER
Put #1,, Buffer() 'image data (size is paddesize)
Close #1
'Compilable Example: (Jose Includes)
'This example uses GET to read the file header, info header, and image
'color data. The two headers are not modified (written as-is when
'the file is saved. The primary task here is to capture the color
'data, edit it, then write the edited information (and unchanged
'headers) as a different file. The original file is unchanged. The
'new file is displayed to see the results of the editing.
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Debug Error On 'catch array/pointer errors - OFF in production
#Debug Display On 'display untrapped errors - OFF in production
#Include "Win32API.inc"
#Resource "gbsnippets.pbr"
Global hDlg, hGraphic, hBMP, DC_graphic, DC_BMP as DWord
Function PBMain() As Long
Dialog New Pixels, 0, "Test Code",300,300,200,200, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, 100,"ReadEditSave", 20,10,150,20
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
Local w,h As Long
ReadEditSaveBitmapFile("cowgirl.bmp", "test.bmp", w, h)
'display the results in a Graphic Control
Control Add Graphic, hDlg, 900, "", 50,50,w,h
Graphic Attach hDlg, 900 : Graphic Render "test.bmp", (0,0)-(w-1,h-1) :
End If
End Function
Sub ReadEditSaveBitmapFile (fSource As String, fTarget As String, w As Long, h as Long) 'w,h are returned values
Local bmpheader As BITMAPFILEHEADER, bmpinfo As BITMAPINFOHEADER, padding, x, y As Long
'Open the file
Open fSource For Binary as #1
Get #1, , bmpheader 'get BITMAPFILEHEADER
Get #1, , bmpinfo 'get BITMAPINFOHEADER
'Optionally verify the file is of interest - Bitmap, 24bit, non-compressed
If bmpheader.bfType <> CVI("BM") Then MsgBox ("bad file - ") + Mks$(bmpheader.bfType) : Exit Sub 'want bitmap file
If bmpInfo.biCompression <> %BI_RGB Then MsgBox ("bad file - compressed") : Exit Sub 'want uncompressed
If bmpInfo.biBitcount <> 24 Then MsgBox ("bad file - " + Str$(bmpInfo.biBitCount)) : Exit Sub 'want 24bit only
'Create buffer for bitmap color data (BGR data + padding)
'Options are: single dimension array (Bytes or BGRTriplets) - includes padding bytes
' two-dimension array (Bytes or BGR Triplets) - includes padding bytes
'Here, a two-dimension Byte array is used.
w = bmpinfo.biWidth
h = bmpinfo.biHeight
padding = (4 - (w*3) Mod 4) Mod 4
Dim Buffer(w*3+padding-1,h-1) As Byte 'pixel color array data (0-based array)
'read the buffer - padded, upside-down, BGR image color data
Get #1, bmpheader.bfOffBits+1, Buffer() 'read image data into structure start,length,variable
Close #1
'Example of modifying the image color data within the Buffer() array
For y = 0 to h-1 'each row
For x = 0 To w*3-1 '1 byte at a time, 1 pixel = 3 bytes, BGR byte order, ignores padding bytes
If y <= (h-1)/2 Then Buffer(x,y) = 64 Else Buffer(x,y) = 128 'top half darker RGB = 64,64,64 vs 128,128,128
Next x
Next y
'Open output file
Open fTarget For Binary as #1
Put #1,, bmpheader 'BITMAPFILEHEADER
Put #1,, bmpinfo 'BITMAPINFOHEADER
Put #1,, Buffer() 'image data (size is paddesize)
Close #1
End Sub
'gbs_00516
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm