How to resize bitmaps

Suppose I read a bitmap with GET_DIB_BLOCK and the bitmap had 2000 x 1000 pixel. Then I'd get a PARRAY of that size.

Is there a routine to shrink the picture size e.g. to 500 x 125 pixel (of course with loss of details) or expand the picture size to 4000 x 2000 pixel so that PARRAY2 is smaller or larger?

I suppose Put_DIB_Block cannot do it. There is also a thread at https://forums.silverfrost.com/Forum/Topic/1249&start=0&postdays=0&postorder=asc&highlight=bitmap but is there a more direct way?

Quoted from johannes

Is there a routine to shrink the picture size e.g. to 500 x 125 pixel (of course with loss of details) or expand the picture size to 4000 x 2000 pixel so that PARRAY2 is smaller or larger?

Easiest way to scale bitmap is probably to use offscreen %gr's. You can copy stuff from %gr drawing surface to another %gr drawing surface using COPY_GRAPHICS_REGION@() function.

I have no luck and really don't understand the %gr actions. This is what I tried but get a System.AccessViolationException. Which statements could be missin?

INCLUDE <windows.ins>
integer*4 hDib,hres,vres,nb_colours,ier
character*60 :: bmpfile
 
INTEGER i
INTEGER r_handle
PARAMETER (r_handle=8)                       
! import bmp file and plot
bmpfile='bmpfile.bmp'
hDib = import_bmp@(bmpfile,ier)
  print *,'hdib=',hdib,' error code=',ier
call get_dib_size@(bmpfile,hres,vres,nb_colours,ier) 
  print *,hres,vres,nb_colours,ier

i=create_graphics_region@(r_handle,2*hres,2*vres)
print *,'i=',i    ! result i=0
i=select_graphics_object@(r_handle)
print *,'i=',i    ! result i=0
! next statement crashes: System.AccessViolationException
i=copy_graphics_region@(r_handle,0,0,2*hres,2*vres,hDib,0,0,hres,vres,SRCCOPY)
print *,'i=',i
call export_bmp@(r_handle,'resized.bmp',ier)
print *,'ier'
call release_screen_block@(hDib) 
end

[/code]

Johannes,

I had a printer that did not scale images contained in a gr surface (printer driver bug). To overcome this I painted the image to an off screen surface using:

     call select_graphics_object@(r_handle)
     call dib_paint@(0,0,hDib,0,0) 

I then resized it from hres,vres to hres1,vres1 by copying to a second offscreen surface (rr_handle) using:

    call select_graphics_object@(rr_handle)
    call copy_graphics_region@(rr_handle,0,0,hres1,vres1,r_handle,0,0,hres,vres,SRCCOPY) 

and then I copied it at a 1:1 scale to the on screen region using:

   call select_graphics_object@(g_handle)
   call copy_graphics_region@

(g_handle,x1,y1,hres1,vres1,rr_handle,0,0,hres1,vres1,SRCCOPY)

           where x1 and y1 defined my required postion

I can't remeber why I had to do the double copy but it worked. It would appear that your error lies with the use of hdib rather than a graphics surface handle

Brian

Hi Brian, thanks for response. Probably my problem is, that I don't succeed in bringing a bmpfile into a graphics region r_handle properly.

• Is hDib = import_bmp@(bmpfile,ier) a good start in your seqeuence?
• Did you use any %gr command and how did you put an image from bmp file into a graphics region (e.g. hat happened before the 'call select_graphics_object@(r_handle)' line)?
• How can I bring the result of g_handle back into a new bmpfile?

Johannes PS: I suppose you meant i=call copy_graphics_region@(..) instead of CALL

Johannes

attached is the bit of code that does the scaling. I wrote it over 10 years ago in fortran77 as a means of learning how I could plot data on windows plotters and it probably is not the most elegant piece of work

[code}

     i=winio@('%`gr[white,metafile_resize]&',426L,600L,g_handle)

     call get_graphical_resolution@(xmax,ymax)  
     scale=real(ymax)/297

........ some plotting code in here

     file='logo.bmp'
     call get_dib_size@(file,hres,vres,nb_colours,ier)

     call create_graphics_region@(r_handle,hres,vres)
     call use_rgb_colours@(r_handle,1)  
     call select_graphics_object@(r_handle)
     hdib= import_bmp@('logo.bmp',ierr) 
     call dib_paint@(0,0,hDib,0,0) 

c create a new graphics region larger than image

     call create_graphics_region@(rr_handle,5*hres,5*vres)
     call use_rgb_colours@(rr_handle,1)  
     call select_graphics_object@(rr_handle)

c bscale is defined by size of graphics region ie screen or plotter

     hres1=bscale
     vres1=bscale*vres/hres 
            
     call copy_graphics_region@
 +(rr_handle,0,0,hres1,vres1,r_handle,0,0,hres,vres,SRCCOPY) 

     offsetx=19
     offsety=262  
     x1=((offsetx)*scale+.5)
     y1=((offsety)*scale+.5)

     call select_graphics_object@(g_handle)
     call copy_graphics_region@
 +(g_handle,x1,y1,hres1,vres1,rr_handle,0,0,hres1,vres1,SRCCOPY) 

[/code]

I have never dumped out into a bmp but I guess that you use export_image@ or if need be an image printer like pdfcreator that will create a bitmap file

Cheers

Brian

Brian, as in my own previos tests, finally I get an error message: 'Invalid handle passed to EXPORT_BMP@'. I compiled your code (without attempt to resize) and put it into a modern form:

winapp   
program resize
use mswin  
IMPLICIT NONE   
!INCLUDE <windows.ins>    ! wie winapp und mswin
character*60 :: bmpfile
integer*4 :: hDib,res,hres,vres,nb_colours,ier,hres2,vres2,hres1,vres1,ixpos,iypos
INTEGER i
real :: scale,bscale
INTEGER*4 :: r_handle ,rr_handle,g_handle 
Integer :: x1,y1,offsetx,offsety,xmax,ymax
bmpfile='trm_hex.bmp'
r_handle=888                       
rr_handle=999
g_handle=123

!Brian:
i=winio@('%`gr[white,metafile_resize]&',426L,600L,g_handle)
  print *,'%gr: g_handle,i=',g_handle,i
call get_graphical_resolution@(xmax,ymax)
  print *,'xmax,ymax=',xmax,ymax
scale=1.
!file='logo.bmp'
bmpfile='trm_hex.bmp'
call get_dib_size@(bmpfile,hres,vres,nb_colours,ier)
  print *,'hres,vres,nb_colours,ier=',hres,vres,nb_colours,ier
i= create_graphics_region@(r_handle,hres,vres)
  print *,'create_ : i=',i
call use_rgb_colours@(r_handle,1)
i= select_graphics_object@(r_handle)
  print *,'select: i=',i
hdib= import_bmp@(bmpfile,ier)
if (ier==0) print *,'import_bmp : hdib,ier=',hdib,ier, ' sucess'
call dib_paint@(0,0,hDib,0,0) 

i= create_graphics_region@(rr_handle,5*hres,5*vres)
  print *,'create_ : i=',i
call use_rgb_colours@(rr_handle,1)
i= select_graphics_object@(rr_handle)
  print *,'select_ : rr_handle,i=',rr_handle,i

! bscale is defined by size of graphics region ie screen or plotter
   bscale=1.
hres1=bscale*hres
vres1=bscale*vres

i= copy_graphics_region@(rr_handle,0,0,hres1,vres1,r_handle,0,0,hres,vres,SRCCOPY)
if (i==1) print *,'copy_ : i=',i, ' success'
offsetx=0
offsety=0
x1=((offsetx)*scale+.5)
y1=((offsety)*scale+.5)

i= select_graphics_object@(g_handle)
  print *,'select_ : i=',i
i= copy_graphics_region@(g_handle,x1,y1,hres1,vres1,rr_handle,0,0,hres1,vres1,SRCCOPY) 
  if (i==1) print *,'copy_ : g_handle,i=',g_handle,i,' success'
  if (i/=1) print *,'copy_ : g_handle,i=',g_handle,i,' no success'
  i= select_graphics_object@(g_handle)
call export_bmp@(g_handle,'resized.bmp',ier)
  print *,'ier' 

STOP

The testprints look good, except the first returning i=-1. Why?

&',426L,600L,g_handle) print *,'%gr: g_handle,i=',g_handle,i call get_graphical_resolution@(xmax,ymax) print *,'xmax,ymax=',xmax,ymax scale=1. !file='logo.bmp' bmpfile='trm_hex.bmp' call get_dib_size@(bmpfile,hres,vres,nb_colours,ier) print *,'hres,vres,nb_colours,ier=',hres,vres,nb_colours,ier i= create_graphics_region@(r_handle,hres,vres) print *,'create_ : i=',i call use_rgb_colours@(r_handle,1) i= select_graphics_object@(r_handle) print *,'select: i=',i hdib= import_bmp@(bmpfile,ier) if (ier==0) print *,'import_bmp : hdib,ier=',hdib,ier, ' sucess' call dib_paint@(0,0,hDib,0,0)

i= create_graphics_region@(rr_handle,5*hres,5*vres)
  print *,'create_ : i=',i
call use_rgb_colours@(rr_handle,1)
i= select_graphics_object@(rr_handle)
  print *,'select_ : rr_handle,i=',rr_handle,i

! bscale is defined by size of graphics region ie screen or plotter
   bscale=1.
hres1=bscale*hres
vres1=bscale*vres

i= copy_graphics_region@(rr_handle,0,0,hres1,vres1,r_handle,0,0,hres,vres,SRCCOPY)
if (i==1) print *,'copy_ : i=',i, ' success'
offsetx=0
offsety=0
x1=((offsetx)*scale+.5)
y1=((offsety)*scale+.5)

i= select_graphics_object@(g_handle)
  print *,'select_ : i=',i
i= copy_graphics_region@(g_handle,x1,y1,hres1,vres1,rr_handle,0,0,hres1,vres1,SRCCOPY) 
  if (i==1) print *,'copy_ : g_handle,i=',g_handle,i,' success'
  if (i/=1) print *,'copy_ : g_handle,i=',g_handle,i,' no success'
  i= select_graphics_object@(g_handle)
call export_bmp@(g_handle,'resized.bmp',ier)
  print *,'ier' 

STOP

The testprints look good, except the first returning i=-1. Why? [quote:ff8b7ac1f6]%gr: g_handle,i= 123 -1 xmax,ymax= 426 600 hres,vres,nb_colours,ier= 200 125 24 0 create_ : i= 1 select: i= 1 import_bmp : hdib,ier= 3446440 0 sucess create_ : i= 1 select_ : rr_handle,i= 999 1 copy_ : i= 1 success select_ : i= 1 copy_ : g_handle,i= 123 1 success

As said, the program aborts with 'Invalid handle passed to EXPORT_BMP@'. An empty file 'resized.bmp' is created. What could be wrong?

I thougt i posted general bmp resize program here many years ago... don't find it. Some example is here for less then 1024x1024 file size, may contain some minor unimportant error, fixed later. Resize by using mouse. You can change array dimensions to the sizes you actually need

winapp 
      use clrwin
      implicit none
      character*50 file
      integer*1 a(3,1024,1024)
      integer*1 b(3,1024,1024)
      common /sdfsdf/a,b

      integer hres,vres,nb_colours,ier,i,k,window_control,red
      common /bbbbbb/hres,vres,nb_colours,ier,i,k,window_control,red

      integer  cb_gr
      external cb_gr
      integer j


      file='init.bmp'
      call get_dib_size@(file,hres,vres,nb_colours,ier)


      if(ier.ne.0.or.hres.gt.1024.or.vres.gt.1024)stop 'TROUBLE'

      call get_dib_block@(file,a,1024,1024,0,0,hres,vres,0,0,ier)
      if(ier.ne.0)stop 'TROUBLE'

      i=winio@('%ww[no_border]%pv%^gr[rgb_colours,user_resize]%lw&',hres,vres, cb_gr, window_control)
      i=winio@('%ac[esc]','exit')

!     Write the image away to another file      
!      file='final.bmp'
!      call put_dib_block@(file,b,1024,1024,0,0,hres,vres,24,ier)

      end

!===============================================!
      integer function cb_gr ()
      use clrwin
      integer*1 a(3,1024,1024)
      integer*1 b(3,1024,1024)
      common /sdfsdf/a,b
 
      integer hres,vres,nb_colours,ier,i,k,window_control,red
      common /bbbbbb/hres,vres,nb_colours,ier,i,k,window_control,red


      call get_graphical_resolution@(ix_GrWindow,iy_GrWindow)
      if(ix_GrWindow.le.0.or.iy_GrWindow.le.0) goto 10000
      if(ix_GrWindow.gt.1024.or.iy_GrWindow.gt.1024) goto 10000
	
	factx = hres/float(ix_GrWindow)
	facty = vres/float(iy_GrWindow)

	do ix=1,ix_GrWindow-1
	  do iy=1,iy_GrWindow-1
	    do i=1,3
	   xInOld = ix*factx 
	  ixInOld = xInOld
	   yInOld = iy*facty
	  iyInOld = yInOld

	  cx1=(xInOld-ixInOld)*a(i,ixInOld+1,iyInOld)  +(ixInOld+1-xInOld)*a(i,ixInOld,iyInOld)
	  cx2=(xInOld-ixInOld)*a(i,ixInOld+1,iyInOld+1)+(ixInOld+1-xInOld)*a(i,ixInOld,iyInOld+1)
	  cyAv= cx1*(iyInOld+1-yInOld) + cx2*(yInOld-iyInOld)
	  b(i,ix,iy)=cyAv
	    enddo
	  enddo
 	enddo

        call display_dib_block@(0,0,b,1024,1024,0,0,ix_GrWindow,iy_GrWindow,0,0,ier)
!       call put_dib_block@(file,b,1024,1024,0,0,ix_GrWindow,iy_GrWindow,24,ier)

10000	cb_gr = 1
	end

Johannes

I added

call export_image@('test.jpg')

to the end of my code and it produced a jpg file equal in size to my screen image

Brian

Brian's method not to use EXPORT_BMP@ worked out.

This is my final code to do the job without using a %gr intervention (i.e. silent batch mode).

!winapp   
program resize
use mswin  
IMPLICIT NONE   
!INCLUDE <windows.ins>    ! wie winapp und mswin
character*60 :: bmpfile
integer*4 :: hDib,res,hres,vres,nb_colours,ier,hres1,vres1,hres2,vres2
INTEGER i
real :: scale
INTEGER*4 :: r_handle ,rr_handle,g_handle 

r_handle=888                       
rr_handle=999
g_handle=123

! import a bitmap and restore a resized bitmap w.r.t scale

!Brian:  2x storage needed
scale=0.2		! scale factor

bmpfile='layout.bmp'
! Intermediate handle with source image
call get_dib_size@(bmpfile,hres,vres,nb_colours,ier)
  print *,'result: hres,vres,nb_colours,ier=',hres,vres,nb_colours,ier
i= create_graphics_region@(r_handle,hres,vres)
  print *,'result: create_ : i=',i
call use_rgb_colours@(r_handle,1)
i= select_graphics_object@(r_handle)
  print *,'result: select: i=',i
  
! Import source  
hdib= import_bmp@(bmpfile,ier)
if (ier==0) print *,'result: import_bmp : hdib,ier=',hdib,ier, ' sucess'
call dib_paint@(0,0,hDib,0,0)
  
! Target
hres1=scale*hres
vres1=scale*vres
i= create_graphics_region@(rr_handle,hres1,vres1)
  print *,'result: create_ : i=',i,' hres1,vres1=',hres1,vres1
call use_rgb_colours@(rr_handle,1)
i= select_graphics_object@(rr_handle)
  print *,'result: select_ : rr_handle,i=',rr_handle,i

! copy sequence
i= copy_graphics_region@(rr_handle,0,0,hres1,vres1,r_handle,0,0,hres,vres,SRCCOPY)
if (i==1) print *,'result: copy_ : i=',i, ' success'

i=CREATE_GRAPHICS_REGION@( g_HANDLE, hres1, vres1 )     ! replaces %gr 
  print *,'result: create:_,i=',g_handle,i     

i= select_graphics_object@(g_handle)
  print *,'result. select_ : i=',i
i= copy_graphics_region@(g_handle,0,0,hres1,vres1,rr_handle,0,0,hres1,vres1,SRCCOPY) 
 if (i==1) print *,'result: copy_ : g_handle,i=',g_handle,i,' success'
 if (i/=1) print *,'result: copy_ : g_handle,i=',g_handle,i,' no success'
i= select_graphics_object@(g_handle)
 
!do not use: call export_bmp@(g_handle,'resized.bmp',ier)
call export_image@('resized.bmp')
! control print
call get_dib_size@('resized.bmp',hres2,vres2,nb_colours,ier)
print *,'Final: hres2,vres2,nb_colours,ier=',hres2,vres2,nb_colours,ier 
 PAUSE
STOP

Thanks all.

I have had trouble with exporting images. I wanted a higher resolution jpg than the screen image. I found that if I created a graphic region, the export image would only work for this region if a %gr region on the screen also existed. Any comments?

ClearWin+ has the concept of the current 'drawing surface', A drawing surface can be created using %gr or create_graphics_region@ or open_printer@ etc.

There is a routine set_jpeg_quality@ that takes values in the range 0.0 to 1.0. The default is 0.75.

Thanks Paul, My program was essentially non-graphic, but gave the user the option to view a picture of the work, in this case a pipe and its support. The display was approximately 1/5th of the screen area and was created with %gr. When this was visible, the export_image@ routine could export the graphic window with no problem. Unfortunately, for inclusion in a document the chosen resolution was insufficient. I then used create_graphics_region@ to make an invisible graphic region of size approximately 2000 x 2000, made this the current drawing surface, produced the picture and exported this to a jpg. This would only work if the original screen image existed. I wanted to batch process a series of the calculations to produce jpgs for each pipe/support. In this mode, there is no graphic display on the screen only the invisible region, and the export_image@ did not work.

I am aware of the set_jpeg_quality@ function, but this only sets the extent of compression used in the jpeg algorithm, rather than the width and height. For my uncolourful images, it makes little difference. Ian

Ian,

I do not have the problem you describe, as I also use a %gr screen.

to dump to a file, I select using: hd_handle = 99 i = create_graphics_region@ (hd_handle, w_width, w_depth) i = select_graphics_object@ (hd_handle)

I then draw to this surface. then to dump, I use: error_png = export_image@ (file_png)

where file_png is of the form 'dump001.png'

Are you effectively changing the selection away from the virtual surface, before exporting to file ? I find .png is better for technical drawings.

John

Ian

If the problem persists and you can demonstrate it in a short program, then I would be happy to take a lot at it.