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