Silverfrost Forums

Welcome to our forums

How to export 1-bit bitmap files

24 Aug 2012 1:47 #10686

Hi all, I'm creating bitmap drawings from FTN95. I only need black/white, i.e. 1-bit bitmaps and by this also want to reduce the file size.

However, 1-bit bmps seem not to be exportable: 'put_dib_block@ transfers a rectangular block from an array to given file, destroying any previous contents. ... An argument for the number of bits per pixel is currently ignored and should set to 24. This routine always writes BMP files with 24 bits per pixel.'

Who knows some workaround? Johannes

24 Aug 2012 5:34 #10687

Johannes, you may try something like this - I send it in two posts due to the known limitations:

      winapp 
      program test 
      implicit none
      include <windows.ins> 

      integer*2      dummy,handle
      integer*4      i,j,A,B,C,lins,cols,c_eff

      character*1    image(1000000)
      character*1    buffer(100000)

c     create binary test image (replace by your own)

      lins = 1000
      cols = 1000

      do i = 1,lins
        A = (i-1)*cols
        do j = 1,cols
          if (mod(i,50) .eq. 0 .or. mod(j,50) .eq. 0) then
            image(A+j) = char(1)
          else
            image(A+j) = char(0)
          end if
        end do
      end do

c     open BMP file

      call openw@('test.bmp',handle,dummy)
      if (dummy .ne. 0) goto 999
      call w_bmp_head(lins,cols,c_eff,buffer)
      call writef@(buffer,handle,1078L,dummy)
      if (dummy .ne. 0) goto 999

c     write image to BMP file

      do i = 1,lins
        A = (i-1)*cols
        C = 0
        buffer = char(0)
        do j = 1,cols,8
          B = 128*ichar(image(A+j  ))+64*ichar(image(A+j+1))+
     *         32*ichar(image(A+j+2))+16*ichar(image(A+j+3))+
     *          8*ichar(image(A+j+4))+ 4*ichar(image(A+j+5))+
     *          2*ichar(image(A+j+6))+   ichar(image(A+j+7))
          C = C+1
          buffer(C) = char(B)
        end do
        call writef@(buffer,handle,c_eff,dummy)
        if (dummy .ne. 0) goto 999
      end do

999   call closef@(handle,dummy)
      end
24 Aug 2012 5:34 #10688
      subroutine w_bmp_head(lins,cols,c_eff,header)

c     write BMP header

      IMPLICIT NONE
 
      integer*4      A,i,j,l,m,lins,cols,c_eff
      character*1    header(1078)
 
      header = char(0)
      c_eff  = cols/8
      if (4*int(c_eff/4.) .ne. c_eff) c_eff = 4*int(c_eff/4.)+4

      header( 1) = char(66)
      header( 2) = char(77)
      i = lins*c_eff+1078
      j = i/16777216
      header( 6) = char(j)
      l = (i-j*16777216)/65536
      header( 5) = char(l)
      m = (i-j*16777216-l*65536)/256
      header( 4) = char(m)
      header( 3) = char(i-j*16777216-l*65536-m*256)
      header(11) = char(54)
      header(12) = char(4)
      header(15) = char(40)
      A = 8*c_eff
      l = A/256
      m = lins/256
      header(19) = char(A-l*256)
      header(20) = char(l)
      header(23) = char(lins-m*256)
      header(24) = char(m)
      header(27) = char(1)
      header(29) = char(1)

c     Palette

      header(55) = char(255)
      header(56) = char(255)
      header(57) = char(255)

      return
      end
25 Aug 2012 8:37 #10690

Hello Wilfried, wow! I always wondered how a .bmp header works. Did compile your code successfully and will proceed to plug in my own graphics. Thanks a lot, Johannes

25 Aug 2012 10:03 #10692

Here gathered really helpful community

25 Aug 2012 10:55 #10693

Please not that the w_bmp_head routine is only valid for binary files. In case of 8 or 24 bits it must be modified. I can give the code if necessary.

Regards - Wilfried

Please login to reply.