replica nfl jerseysreplica nfl jerseyssoccer jerseyreplica nfl jerseys forums.silverfrost.com :: View topic - How to export 1-bit bitmap files
forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

How to export 1-bit bitmap files

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> General
View previous topic :: View next topic  
Author Message
johannes



Joined: 21 Jan 2011
Posts: 65
Location: Leimen, Germany
PostPosted: Fri Aug 24, 2012 2:47 pm    Post subject: How to export 1-bit bitmap files Reply with quote
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
Back to top
View user's profile Send private message
Wilfried Linder



Joined: 14 Nov 2007
Posts: 314
Location: D�sseldorf, Germany
PostPosted: Fri Aug 24, 2012 6:34 pm    Post subject: Reply with quote
Johannes, you may try something like this - I send it in two posts due to the known limitations:

Code:
      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
Back to top
View user's profile Send private message
Wilfried Linder



Joined: 14 Nov 2007
Posts: 314
Location: D�sseldorf, Germany
PostPosted: Fri Aug 24, 2012 6:34 pm    Post subject: Reply with quote
Code:
      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
Back to top
View user's profile Send private message
johannes



Joined: 21 Jan 2011
Posts: 65
Location: Leimen, Germany
PostPosted: Sat Aug 25, 2012 9:37 am    Post subject: Reply with quote
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
Back to top
View user's profile Send private message
DanRRight



Joined: 10 Mar 2008
Posts: 2923
Location: South Pole, Antarctica
PostPosted: Sat Aug 25, 2012 11:03 am    Post subject: Reply with quote
Here gathered really helpful community
Back to top
View user's profile Send private message
Wilfried Linder



Joined: 14 Nov 2007
Posts: 314
Location: D�sseldorf, Germany
PostPosted: Sat Aug 25, 2012 11:55 am    Post subject: Reply with quote
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
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> General All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group