在主程序中,演示了读取一个位图文件 1.bmp 并进行左右镜像以后,写入新的 BMP 文件 2.bmp
原始图像:
大图
大图
左右镜像后:
大图
Module fcBMP24Mod
use , INTRINSIC :: ISO_C_Binding
Implicit None
Private
Integer(Kind=C_SHORT) , parameter :: BMP_FLAG = 19778 !"BM"
Integer , parameter , public :: KINDBMP = C_INT8_T
!DEC$ PACK:2
Type , public , Bind(C) :: BITMAPFILEHEADER
Integer(Kind=C_SHORT) :: cfType !//BM
Integer(Kind=C_INT) :: bfSize
Integer(Kind=C_SHORT) :: bfReserved1
Integer(Kind=C_SHORT) :: bfReserved2
Integer(Kind=C_INT) :: bfOffBits
End Type BITMAPFILEHEADER
Type , public , Bind(C) :: BITMAPINFOHEADER
Integer(Kind=C_INT) :: biSize
Integer(Kind=C_INT) :: biWidth
Integer(Kind=C_INT) :: biHeight
Integer(Kind=C_SHORT) :: biPlanes
Integer(Kind=C_SHORT) :: biBitCount
Integer(Kind=C_INT) :: biCompression
Integer(Kind=C_INT) :: biSizeImage
Integer(Kind=C_INT) :: biXPelsPerMeter
Integer(Kind=C_INT) :: biYPelsPerMeter
Integer(Kind=C_INT) :: biClrUsed
Integer(Kind=C_INT) :: biClrImportant
End Type BITMAPINFOHEADER
!DEC$ PACK
Type , public :: fcBMP24
Integer :: fUnit = 0
Type( BITMAPFILEHEADER ) :: FileHeader
Type( BITMAPINFOHEADER ) :: BmpHeader
contains
Procedure :: OpenBMP
Procedure :: ReadBMP
Procedure :: WriteBMP
Procedure :: CloseBMP
End Type
contains
Logical Function OpenBMP( this , cFile , Width , Height )
Class( fcBMP24 ) :: this
Character(len=*) :: cFile
Integer , optional :: Width , Height
integer :: k , u
OpenBMP = .false.
Open( NewUnit = u , File = cFile , access="stream" , ioStat = k , form="unformatted" )
If ( k /= 0 ) Return
If ( present( Width ) ) then
Read( u ) this % FileHeader
If ( this % FileHeader % cfType /= BMP_FLAG ) Return
Read( u ) this % BmpHeader
If ( this % BmpHeader % biBitCount /= 24 ) Return
If ( present( Width ) ) Width = this % BmpHeader % biWidth
If ( present( Height ) ) Height = this % BmpHeader % biHeight
End If
this%fUnit = u
OpenBMP = .true.
End Function OpenBMP
Logical Function ReadBMP( this , iData )
Class( fcBMP24 ) :: this
Integer(Kind=KINDBMP) :: iData(:,:,:)
integer :: i , nScanLine
ReadBMP = .false.
If ( this % fUnit == 0 ) return
If ( size(iData,dim=1) /= 3 ) return
If ( size(iData,dim=2) /= this % BmpHeader % biWidth ) return
If ( size(iData,dim=3) /= this % BmpHeader % biHeight ) return
nScanLine = 4 * ceiling( 3.0 * this % BmpHeader % biWidth / 4.0 )
Do i = 1 , this % BmpHeader % biHeight
Read( this % fUnit , Pos = this % FileHeader % bfOffBits + (i-1)*nScanLine +1 ) iData( : , : , i )
End Do
ReadBMP = .true.
End Function ReadBMP
Logical Function WriteBMP( this , iData )
Class( fcBMP24 ) :: this
Integer(Kind=KINDBMP) :: iData(:,:,:)
integer :: i , nScanLine
WriteBMP = .false.
If ( this % fUnit == 0 ) return
this % BmpHeader % biWidth = size(iData,dim=2)
this % BmpHeader % biHeight= size(iData,dim=3)
nScanLine = 4 * ceiling( 3.0 * this % BmpHeader % biWidth / 4.0 )
If ( size(iData,dim=1) /= 3 ) return
this % FileHeader % cfType = BMP_FLAG
this % FileHeader % bfSize = 54 + this % BmpHeader % biHeight * nScanLine
this % FileHeader % bfReserved1 = 0
this % FileHeader % bfReserved2 = 0
this % FileHeader % bfOffBits = 54
this % BmpHeader % biSize = 40
this % BmpHeader % biPlanes = 1
this % BmpHeader % biBitCount = 24
this % BmpHeader % biCompression = 0
this % BmpHeader % biSizeImage = 0
this % BmpHeader % biXPelsPerMeter = 3780
this % BmpHeader % biYPelsPerMeter = 3780
this % BmpHeader % biClrUsed = 0
this % BmpHeader % biClrImportant = 0
write( this % fUnit ) this % FileHeader
write( this % fUnit ) this % BmpHeader
Do i = 1 , this % BmpHeader % biHeight
Write( this % fUnit , Pos = 54 + (i-1)*nScanLine +1 ) iData( : , : , i )
End Do
If ( mod( this % BmpHeader % biWidth , 4_C_INT ) /= 0 ) &
write( this % fUnit , Pos = 54 + this % BmpHeader % biHeight * nScanLine ) 0_KINDBMP
WriteBMP = .true.
End Function WriteBMP
Subroutine CloseBMP( this )
Class( fcBMP24 ) :: this
If ( this % fUnit /= 0 ) Close( this%fUnit )
End Subroutine CloseBMP
End Module fcBMP24Mod
Program www_fcode_cn
Use fcBMP24Mod
Type( fcBMP24 ) :: myBmp , outBmp
Logical :: b
Integer( KINDBMP ) , allocatable :: D(:,:,:)
integer :: w , h , i , j
b = myBmp % OpenBMP( "1.bmp" , w , h )
write(*,*) "Size:" , w, h
allocate( D( 3 , w , h ) )
b = myBmp % ReadBMP( D )
Open( 13 , File = "color.txt" )
write( 13 , '(a)' ) "Blue Green Red"
Do i = 1 , h
Do j = 1 , w
write( 13 , '(3(i4,1x))' ) D(:,j,i)
End Do
End Do
b = outBmp % OpenBMP( "2.bmp" )
b = outBmp % WriteBmp( D( : , w:1:-1 , : ) )
call myBmp % CloseBMP()
call outBmp % CloseBMP()
End Program www_fcode_cn
