首页 > 代码 > 常规代码 > 正文

代码

阅读排行

Fortran读取BMP图像
2016-02-18 15:44:38   来源:Fcode研讨团队   评论:0 点击:

此代码从BMP文件格式层面实现了对BMP格式的读取(仅24位色深),而未调用任何第三方绘图库 语法规范,也可供学习流文件读写和面向对象编程风格

本代码实现了对 24 位色深的 BMP 位图格式进行读写.

在主程序中,演示了读取一个位图文件 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

相关热词搜索:BMP 位图

上一篇:Console界面字符进度条
下一篇:Fortran连接FTP并下载文件

分享到: 收藏