Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Black and white to data

Status
Not open for further replies.
IslwynDugdale

IslwynDugdale

Programmer
Jul 1, 2010
2
GB
Hi,

Does anyone know a simple way of getting a fortran program to read a black and white bmp (or other format - perhaps there is a commonly used one which is better suited to being read) as a simple list of x,y integer coordinates (or zeros and ones which I can then turn into coordinates)?

Thanks

Is
 
Sort by date Sort by votes
Hi IslwynDugdale

Maybe this program will help you. It reads a BMP file: first the headers and then the data (read into vBits). Note that vBits will overflow for large BMP files (it is actually not necessary to read the whole file into this array, you can just read each scan line). In black and white BMPs, each byte represents 8 pixels. Also note that each scan line is padded to multiple of 4 bytes. For instance, if the image is 274 pixels wide, each scan line is 8*36=288 wide.

Code: 
	Program BMP

	implicit none

	character*24 str
	character*24 file
	integer*4 l,k,i,n,nn
	integer*2 r,g,b,s
	integer*4 dwDibSize
!	integer*4 dwColorTableSize
!	integer*4 sBitmapFileheader

	byte vBits(120000)

	structure /BitmapFileheader/
	   integer*2 bfType
	   integer*4 bfSize
	   integer*2 bfReserved1
	   integer*2 bfReserved2
	   integer*4 bfOffsetBits
	end structure
	record /BitmapFileheader/ bmfH

	structure /BitmapInfoheader/
	   integer*4 biSize
	   integer*4 biWidth
	   integer*4 biHeight
	   integer*2 biPlanes
	   integer*2 biBitCount
	   integer*4 biCompression
	   integer*4 biSizeImage
	   integer*4 biXPixelPerMeter
	   integer*4 biYPixelPerMeter
	   integer*4 biClrUsed
	   integer*4 biClrImportant
	end structure
	record /BitmapInfoheader/ bmiH

	structure /RGBQuad/
	   byte rgbBlue
	   byte rgbGreen
	   byte rgbRed
	   byte rgbReserved
	end structure
	record /RGBQuad/ bmiC(256)

	write(*,'(1x,a,$)') 'BMP-file: '
	read(*,'(a)') file
	k = index(file,'.')
	if(k.eq.0) then
	   str = file
	   l = len_trim(str)
	   file = str(1:l)//'.BMP'
	endif

	open(unit=1,file=file,form='binary',status='old')

	read(1) bmfH
	read(1) bmiH

	if(bmfH.bfType.ne.'BM') then			! 'BM' = 19778
	   write(*,'(1x,a)') 'Not BMP-file'
	   goto 50
	endif

	write(*,'(1x)')

	write(*,'(1x,a,i10)') 'Type:           ',bmfH.bfType
	write(*,'(1x,a,i10)') 'Size:           ',bmfH.bfSize
	write(*,'(1x,a,i10)') 'Reserved1:      ',bmfH.bfReserved1
	write(*,'(1x,a,i10)') 'Reserved2:      ',bmfH.bfReserved2
	write(*,'(1x,a,i10)') 'OffsetBits:     ',bmfH.bfOffsetBits
	write(*,'(1x)')

	write(*,'(1x,a,i10)') 'Size:           ',bmiH.biSize
	write(*,'(1x,a,i10)') 'Width:          ',bmiH.biWidth
	write(*,'(1x,a,i10)') 'Height:         ',bmiH.biHeight
	write(*,'(1x,a,i10)') 'Planes:         ',bmiH.biPlanes
	write(*,'(1x,a,i10)') 'BitCount:       ',bmiH.biBitCount
	write(*,'(1x,a,i10)') 'Compression:    ',bmiH.biCompression
	write(*,'(1x,a,i10)') 'SizeImage:      ',bmiH.biSizeImage
	write(*,'(1x,a,i10)') 'XPixelPerMeter: ',bmiH.biXPixelPerMeter
	write(*,'(1x,a,i10)') 'YPixelPerMeter: ',bmiH.biYPixelPerMeter
	write(*,'(1x,a,i10)') 'ClrUsed:        ',bmiH.biClrUsed
	write(*,'(1x,a,i10)') 'ClrImportant:   ',bmiH.biClrImportant
	write(*,'(1x)')

	if(bmiH.biBitCount.eq.24) goto 50	! 24
	n = 2**bmiH.biBitCount			! 1, 4 ,8

	write(*,'(1x,a,i10)') 'n:              ',n

	write(*,'(1x)')
	pause
	write(*,'(1x)')

	do i=1,n
	   read(1) bmiC(i)
	   b = bmiC(i).rgbBlue .and. #ff
	   g = bmiC(i).rgbGreen .and. #ff
	   r = bmiC(i).rgbRed .and. #ff
	   s = bmiC(i).rgbReserved .and. #ff
	   write(*,'(1x,a,4i10)') 'RGB:            ',b,g,r,s
	enddo

	write(*,'(1x)')
	pause
	write(*,'(1x)')

!!	sBitmapFileheader = sizeof(bmfH)
!	sBitmapFileheader = 56
!	dwColorTableSize = 4*n
!	dwDibSize = bmfH.bfSize - sBitmapFileheader - dwColorTableSize

	dwDibSize = bmiH.biSizeImage

	nn = 0
	do i=1,dwDibSize
	   nn = nn+1
	   read(1,end=50) vBits(nn)
	   write(*,'(i10,2x,i10)') nn,(vBits(nn).and.#ff)
	enddo

50	continue

	close(unit=1)

	end
 
Upvote 0 Downvote
Hi again

... and note also that data in BMP files are stored from bottom and up: The first scan line read is the bottom line of the image, and the last line read is the top line in the image.

... and for B&W images you have to break each byte read into the 8 bits, that each represents white or black (0 or 255 in the color table that is printed on the screen between the two pause statements (actually I guess that it can be some other colors than black and white (0 or 255), but I have never come across such two-color bitmaps).
 
Upvote 0 Downvote
Many thanks for this. It it is way above the basic level of programming for modelling I am used to so it will take me a bit to get my head around it, And I see I'll have to do some reading up on some of the data types etc. I will have a play around with it.

Many thanks again

Is
 
Upvote 0 Downvote
Hi again

Don't give up. BMP-files are one of the easier to read. I modified the program a little bit and now it writes to the file "aa.txt", and each byte in the image is broken down into the 8 bits. These is an empty line in the file after each scan line in the image.

I may have been inaccurate in the last post. Each bit in a B&W image ("on" or "off") points actually to the color table, "off" to first line and "on" to second line (there are only two lines in B&W (or two color) bitmaps). The color in the color table represents the actual color. It is usually either 0,0,0,0 or 255,255,255,0 (the forth byte is reserved), that is: white or black.

Code: 
	Program BMP

	implicit none

	character*24 str
	character*24 file
	integer*4 l,k,i,n,nn,j,jj,biWidth
	integer*2 r,g,b,s
	integer*4 dwDibSize
!	integer*4 dwColorTableSize
!	integer*4 sBitmapFileheader

	character*8 strbyte

	byte vBits(120000)

	structure /BitmapFileheader/
	   integer*2 bfType
	   integer*4 bfSize
	   integer*2 bfReserved1
	   integer*2 bfReserved2
	   integer*4 bfOffsetBits
	end structure
	record /BitmapFileheader/ bmfH

	structure /BitmapInfoheader/
	   integer*4 biSize
	   integer*4 biWidth
	   integer*4 biHeight
	   integer*2 biPlanes
	   integer*2 biBitCount
	   integer*4 biCompression
	   integer*4 biSizeImage
	   integer*4 biXPixelPerMeter
	   integer*4 biYPixelPerMeter
	   integer*4 biClrUsed
	   integer*4 biClrImportant
	end structure
	record /BitmapInfoheader/ bmiH

	structure /RGBQuad/
	   byte rgbBlue
	   byte rgbGreen
	   byte rgbRed
	   byte rgbReserved
	end structure
	record /RGBQuad/ bmiC(256)

	write(*,'(1x,a,$)') 'BMP-file: '
	read(*,'(a)') file
	k = index(file,'.')
	if(k.eq.0) then
	   str = file
	   l = len_trim(str)
	   file = str(1:l)//'.BMP'
	endif

	open(unit=1,file=file,form='binary',status='old')
	open(unit=2,file='aa.txt',status='unknown')

	read(1) bmfH
	read(1) bmiH

	if(bmfH.bfType.ne.'BM') then			! 'BM' = 19778
	   write(*,'(1x,a)') 'Not BMP-file'
	   goto 50
	endif

	write(*,'(1x)')

	write(*,'(1x,a,i10)') 'Type:           ',bmfH.bfType
	write(*,'(1x,a,i10)') 'Size:           ',bmfH.bfSize
	write(*,'(1x,a,i10)') 'Reserved1:      ',bmfH.bfReserved1
	write(*,'(1x,a,i10)') 'Reserved2:      ',bmfH.bfReserved2
	write(*,'(1x,a,i10)') 'OffsetBits:     ',bmfH.bfOffsetBits
	write(*,'(1x)')

	write(*,'(1x,a,i10)') 'Size:           ',bmiH.biSize
	write(*,'(1x,a,i10)') 'Width:          ',bmiH.biWidth
	write(*,'(1x,a,i10)') 'Height:         ',bmiH.biHeight
	write(*,'(1x,a,i10)') 'Planes:         ',bmiH.biPlanes
	write(*,'(1x,a,i10)') 'BitCount:       ',bmiH.biBitCount
	write(*,'(1x,a,i10)') 'Compression:    ',bmiH.biCompression
	write(*,'(1x,a,i10)') 'SizeImage:      ',bmiH.biSizeImage
	write(*,'(1x,a,i10)') 'XPixelPerMeter: ',bmiH.biXPixelPerMeter
	write(*,'(1x,a,i10)') 'YPixelPerMeter: ',bmiH.biYPixelPerMeter
	write(*,'(1x,a,i10)') 'ClrUsed:        ',bmiH.biClrUsed
	write(*,'(1x,a,i10)') 'ClrImportant:   ',bmiH.biClrImportant
	write(*,'(1x)')

	if(bmiH.biBitCount.eq.24) goto 50	! 24
	n = 2**bmiH.biBitCount			! 1, 4 ,8

	write(*,'(1x,a,i10)') 'n:              ',n

	write(*,'(1x)')
	pause

	do i=1,n
	   read(1) bmiC(i)
	   b = bmiC(i).rgbBlue .and. #ff
	   g = bmiC(i).rgbGreen .and. #ff
	   r = bmiC(i).rgbRed .and. #ff
	   s = bmiC(i).rgbReserved .and. #ff
	   write(*,'(1x,a,4i10)') 'RGB:            ',b,g,r,s
	enddo

	write(*,'(1x)')
	pause

!!	sBitmapFileheader = sizeof(bmfH)
!	sBitmapFileheader = 56
!	dwColorTableSize = 4*n
!	dwDibSize = bmfH.bfSize - sBitmapFileheader - dwColorTableSize

	dwDibSize = bmiH.biSizeImage

	biWidth = bmiH.biWidth
	j = bmiH.biWidth/32
	if(32*j.lt.biWidth) biWidth=32*(1+j)
	jj = biWidth/8

	nn = 0
	do i=1,dwDibSize
	   nn = nn+1
	   read(1,end=50) vBits(nn)
	   strbyte = '00000000'
	   if((vBits(nn).and.#80).ne.0) strbyte(1:1)='1'
	   if((vBits(nn).and.#40).ne.0) strbyte(2:2)='1'
	   if((vBits(nn).and.#20).ne.0) strbyte(3:3)='1'
	   if((vBits(nn).and.#10).ne.0) strbyte(4:4)='1'
	   if((vBits(nn).and.#08).ne.0) strbyte(5:5)='1'
	   if((vBits(nn).and.#04).ne.0) strbyte(6:6)='1'
	   if((vBits(nn).and.#02).ne.0) strbyte(7:7)='1'
	   if((vBits(nn).and.#01).ne.0) strbyte(8:8)='1'
	   write(*,'(i10,2x,i10,2x,a)') nn,(vBits(nn).and.#ff),strbyte
	   write(2,'(i10,2x,i10,2x,a)') nn,(vBits(nn).and.#ff),strbyte
	   if(mod(nn,jj).eq.0) write(2,'(1x)')
	enddo

50	continue

	close(unit=1)

	end
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

W
  • Locked
  • Question
Failure to open a file that exists
Replies
7
Views
633
WillBryce
W
virk24
  • Locked
  • Question
Reading character up to ";" from a csv-file
Replies
3
Views
322
virk24
virk24
mollwollfumble
  • Locked
  • Question
Transfer data directly between main and subsubsub program?
Replies
1
Views
95
xwb
xwb
Vahid9
  • Locked
  • Question
Broadcasting a REAL number to another file
Replies
2
Views
332
Vahid9
Vahid9
ASRC8367
  • Locked
  • Question
Fortran code to average hourly data into daily values 1
Replies
2
Views
135
mikrom
mikrom

Part and Inventory Search

Sponsor

Back
Top