Terminating a print run without output

If I decide to do a graphics print, then I select a menu item that has a double-callback starting with 'GPRINTER_OPEN' and then going on to my routine that does all the graphics. In that routine, if I decide to abort the printing process, I can use:

CALL GET_CURRENT_DC@ (iHDC)
           CALL CLOSE_PRINTER_ONLY@(iHDC)

with GET_CURRENT_DC@ only necessary because it is a way to find the the gprinter handle.

By the same logic, I have elsewhere a choice to print tabulated results, where the menu item selects 'PRINTER_OPEN', then the fortran unit number, and then the routine that does the printing. However, if in the middle of this I decide I don't really want the print, what do I do to cancel it?

There's no point in calling CALL GET_CURRENT_DC@ (iHDC), because that returns the handle of the graphics area on the screen (in my case). It did occur to me that like CLOSE_PRINTER@, giving a handle of 0 to CLOSE_PRINTER_ONLY@ might terminate the printer without output, but it doesn't, and when the program exits, a blank sheet of paper is ejected.

I also tried STATUS='DELETE' on a Fortran CLOSE statement, but that had the effect of making the blank sheet eject immediately.

This is purely cosmetic, because in 99% of runs, no tabulated output is called for, and in 99% of the remaining 1%, the printing isn't aborted.

Does anyone know?

Eddie

Eddie,

I thought that the handle for opening printers was a user supplied handle, so why call get_current_dc@.

is it not just

itest = open_printer@(10)

. . . . call printer_close_only@(10)

for example?

Ian

Ian,

I don't think you are right. OPEN_PRINTER@ is for graphics output. Although the help file for FTN95 says:

The handle is supplied by the programmer and is used in conjunction with SELECT_GRAPHICS_OBJECT@.

I think this means that you declare a variable IHWND, and OPEN_PRINTER@ gives you back a value, not that you write it as you suggested. I find the FTN95.CHM sometimes confusing as to who provides what.

The problem lies with the structure of my code. If you have no data, and therefore can't print, the Windows way of handling things is to grey out the print menu/icon/button or whatever. You un-grey it when there is data that can be printed.

The particular program I am working on was my first serious effort with ClearWin, and it checks as to whether there is anything to print AFTER the user has said 'Print it'. I have two possible routes: firstly to print the image (which is a survey map), secondly to print the underlying readings.

What I ought to do is go back further up the chain and do the greying-out.

Having reflected on it, I think that CLOSE(UNIT=N, STATUS='DELETE') ought NOT to eject a sheet of paper, but since in the rest of my working life this is unlikely to waste more than half a ream of paper, all of which could go back into the printer, why am I bothered? Indeed, I can imagine situations where the existing behaviour is desirable, and changing it could cause inconvenience.

Eddie

OPEN_PRINTER@ takes a VAL and not a REF. The programmer must supply an integer (any value will do, 42 has magical properties and is recommended by many programmers). This integer value identifies the printer in the code.

Eddie,

I do agree with your statement:

I find the FTN95.CHM sometimes confusing as to who provides what.

And I think we know who contributes to that - don't we (Paul)

I think that Paul is actually saying the same as me and a program would look like:

subroutine plotit
include <windows.ins>

itest=open_printer@(42)  ! the answer to life, the universe and everything

if(itest .eq. 1)then

  if(result .eq. rubbish)then
     CALL CLOSE_PRINTER_ONLY@(42)
  else
!carry on plotting  (Oooh Matron!)
.
.
.
.
     itest=close_printer@(42)
  endif

endif

end

Regards

Ian

Hi Paul & Ian,

I was in the throes of checking with FTN95.CHM, only to find that the latest Windows update had disabled HH.EXE because of a security vulnerability with it! Apparently the update is on the MS Website, but SP3 appears to fix it ....

Paul is right, that it is a VAL not a REF. Whatever it is, it misses the point of the post. Consider the following code:

       WINAPP
       OPTIONS (INTL)
       PROGRAM TESTPRINT
       include <windows.ins> 
       EXTERNAL NPRINT, NEXIT
       IA=WINIO@('%ca[Test print]%ww&')
       IA=WINIO@('%6^bt[Print]  %6^bt[Exit]',NPRINT,NEXIT)
       END

       INTEGER FUNCTION NEXIT()
       NEXIT=0
       RETURN
       END

       INTEGER FUNCTION NPRINT()
       INCLUDE <WINDOWS.INS>
       EXTERNAL KILLIT, KPRINT
       itest=open_printer@(42)  
       IB=WINIO@('%ca[Second thoughts]%ww&')
       IB=WINIO@('%2nlDo you really want to print?%2nl&')
       IB=WINIO@('%6^bt[Yes]  %6^bt[No]', KPRINT, KILLIT)
       RETURN
       END 

       INTEGER FUNCTION KILLIT()
       INCLUDE <WINDOWS.INS>
         CALL CLOSE_PRINTER_ONLY@(42) 
         KILLIT = 0
       RETURN
       END 

       INTEGER FUNCTION KPRINT()
         write(42,*) ' Eddie wrote this'
         itest=close_printer@(42)
         KPRINT = 0
       RETURN
       END

The problem is that 42 is simply an arbitrary number, and has nothing to do with a Fortran unit number. If we decide to abort the print (KILLIT) we don't get a page ejected, because Windows think that we have aborted a graphics print, and that works. So, here is version 2:

       WINAPP
       OPTIONS (INTL)
       PROGRAM TESTPRINT
       include <windows.ins> 
       EXTERNAL NPRINT, NEXIT
       COMMON /DEVICE/ NDEV
       NDEV=42
       IA=WINIO@('%ca[Test print]%ww&')
       IA=WINIO@('%6^bt[Print]  %6^bt[Exit]','PRINTER_OPEN',
     &                      NDEV,NPRINT,NEXIT)
       END

       INTEGER FUNCTION NEXIT()
       NEXIT=0
       RETURN
       END

       INTEGER FUNCTION NPRINT()
       INCLUDE <WINDOWS.INS>
       EXTERNAL KILLIT, KPRINT
       COMMON /DEVICE/ NDEV
       IB=WINIO@('%ca[Second thoughts]%ww&')
       IB=WINIO@('%2nlDo you really want to print?%2nl&')
       IB=WINIO@('%6^bt[Yes]  %6^bt[No]', KPRINT, KILLIT)
       RETURN
       END 

       INTEGER FUNCTION KILLIT()
       INCLUDE <WINDOWS.INS>
       COMMON /DEVICE/ NDEV
         CALL CLOSE_PRINTER_ONLY@(NDEV) 
         KILLIT = 0
       RETURN
       END 

       INTEGER FUNCTION KPRINT()
       INCLUDE <WINDOWS.INS>
       COMMON /DEVICE/ NDEV
         write(NDEV,*) ' Eddie wrote this'
         itest=close_printer@(NDEV)
         KPRINT = 0
       RETURN
       END

This works as it should, and if we really want the print - it prints. If we say 'no, we don't want the print', we don't get a print. But when the program exits, out pops the blank sheet from the printer.

If in KILLIT I replace CALL CLOSE_PRINTER_ONLY@(NDEV) with CLOSE(NDEV,STATUS='DELETE') then I still get the ejected blank page, but immediately.

Eddie

... and really, the whole OPEN_PRINTER@ family of subprograms are 'OPEN_GPRINTER@' subprograms, as they are related to the callback 'GPRINTER_OPEN', not to 'PRINTER_OPEN'.

Eddie

Ah!, The penny drops - You were doing Fortran writes to the printer.

I never even tried that and just printed everthing to a string, and output the string using draw_characters@.

Sometimes direct to a file, and then review on screen and then print using draw_characters@. Note, my files have a FF character at the top of each page.

      integer*4 function review()
      INCLUDE <WINDOWS.INS>
      character*256 print_file_name
      common/print_file/print_file_name
      external iprintout
      call set_clearwin_string@('printer_document','My List file')
      I=WINIO@('%ca[ List file viewer]&')
      I=WINIO@('%mn[E&xit,&Print]%es%sc&',
     &           'EXIT',
     &           iprintout,
     &           'edit_file',print_file_name)
      I=WINIO@('%ww[no_border]%pv%fn[Courier New]'//
     &         '%ts%126.30eb[vscrollbar,hscrollbar,read_only]'
     &         ,0.9d0,'*',0)
      review = 1
      END


      integer*4 function iprintout()
      include <windows.ins>
      integer*4 xres,yres
      real xwl,xwr,ywb,ywt
      character*155 lineout
      real xxx,yyy
      character*256 print_file_name
      common/print_file/print_file_name
      logical windows_printer
      lineout =  ' '
      ipage = 1
      ihandl = 2
      iblack = rgb@(0,0,0)
      call printer_dialog_options@(1,0,1,0,0,0,0,1,0)
      itest = open_printer@(ihandl)
      if(itest .ne. 0)then
        ipage_range = clearwin_info@('printer_pagenumbers')
        if(ipage_range .eq. 1)then
          istart_page = clearwin_info@('printer_first_page')
          ilast_page  = max(istart_page,
     &                      clearwin_info@('printer_last_page'))
        else
          istart_page = 1
          ilast_page  = 32768
        endif
        call set_text_offset(0,0)
        icurrent_page = 1
        ipage_count = 0
        if(istart_page .eq. 1)ipage_count = 1
        open(unit=27,file=print_file_name,status='unknown')
        call GET_GRAPHICAL_RESOLUTION@( ixxx, iyyy )
        ihsize = ixxx
        ivsize = iyyy
c
c set pixel paper size
        call set_paper_size(ixxx,iyyy)
c
c get the text size for the main body of the text
        nrow = 1
        if(ixxx .gt. iyyy)then
c
c landscape
          ncol = 155
        else
c
c portrait
          ncol = 140
        endif
        call get_text_scale(ncol,nrow,scale)
c
c set punching margin in pixels
        if(ixxx .gt. iyyy)then
c
c landscape
          ihoff = ixxx/297.0*6.0
          ivoff = int(ivsize*20.0/200.0)
        else
c
c portrait
          ihoff = int(ihsize*20.0/200.0)
          ivoff = ivsize/297.0*10.0
        endif
        call set_text_offset(ihoff,ivoff)
        irow = 1
c
c get the last text start position to set new offset for bulk of text
        call scale_font@(scale)
        call rotate_font@( 0d0 )
        do 
          read(27,1000,end=9999)lineout
 1000     format(a)
! detect form feed character
          if(lineout(1:1) .eq. char(12))then
            icurrent_page = icurrent_page+1
            if(icurrent_page .ge. istart_page .and.
     &         icurrent_page .le. ilast_page)then
              if(ipage_count .gt. 0)then
                call new_page@
                call set_text_offset(ihoff,ivoff)
                lineout(1:1) = ' '
                irow = 1
              endif
              ipage_count = ipage_count + 1
            endif
          endif

Continued

          if(icurrent_page .ge. istart_page .and.
     &       icurrent_page .le. ilast_page)then
            call DRAW_TEXT_CHAR(lineout,0,irow,scale,iblack)
            irow = irow + 1
          endif
        enddo
 9999   continue
        itest = close_printer@(ihandl)
        close(unit=27)
      endif
      iprintout = 2
      end

      subroutine set_text_offset(ixoff,iyoff)
      common/printer_text_offset/ixpoff,iypoff,ixmax,iymax,ixlast,iylast
      ixpoff = ixoff
      iypoff = iyoff
      end

      subroutine set_paper_size(ixxx,iyyy)
      common/printer_text_offset/ixpoff,iypoff,ixmax,iymax,ixlast,iylast
      ixmax = ixxx
      iymax = iyyy
      ixlast = 0
      iylast = 0
      end

      subroutine get_text_scale(ncol,nrow,scale)
      real*8 scale, scale1, scale2
c
c determines the scale factor for text to fit the printer 
c base on a default 8x14 font
      common/printer_text_offset/ixpoff,iypoff,ixmax,iymax,ixlast,iylast
      scale1 = float(ixmax-ixpoff)/8.0/float(ncol)
      scale2 = float(iymax-iypoff)/14.0/float(nrow)
      scale  = min(scale1,scale2)
      end

      subroutine DRAW_TEXT_CHAR(text,ix,iy,scale,icol)
!ix & iy are column and row number
      real*8 scale
      character*(*) text
      common/printer_text_offset/ixpoff,iypoff,ixmax,iymax,ixlast,iylast
      iy2 = iy*14*scale+iypoff
      ilen = max(1,leng(text))
      do i=1,ilen
        ix2 = (ix+i-1)*7*scale+ixpoff
        call DRAW_characters@(text(i:i),ix2,iy2,icol)
      enddo
      ixlast = ix2
      iylast = iy2
      end

I hope this helps

Ian

Ian,

Wow,

I thought of using DRAW_CHARACTERS@ and gave up ....

This is basically what I'm doing:

      SUBROUTINE DISPLAY_AND_MAYBE_PRINT
      COMMON/TEXTWINDOW/IHWND, KONTROL 
      EXTERNAL IQUIT, IHARD_COPY, MINIM_FUNCTION
      INCLUDE <WINDOWS.INS>

      IA=WINIO@('%ca[Program output]%2nl&')
      IA=WINIO@('%hw&',IHWND)
      IA=WINIO@('%pv%70.40cw[vscroll,hscroll]&',99)
      IA=WINIO@('%mi[ICON_2]&')
      IA=WINIO@('%ww%ff%nl%cn&')
      IA=WINIO@('%6^bt[Clear]%6^bt[Print]%6^bt[Shrink]%lw', 
     &            IQUIT,
     &           'PRINTER_OPEN', 99, IHARD_COPY,
     &            MINIM_FUNCTION,
     &            KONTROL)
      CALL PRINTER_OUTPUT_TO_99
      CLOSE (99)
      RETURN
      END

      INTEGER FUNCTION IHARD_COPY()
      COMMON/TEXTWINDOW/IHWND, KONTROL 
      KONTROL = 1
      CALL WINDOW_UPDATE@(KONTROL)
      INCLUDE <WINDOWS.INS>
      CALL PRINTER_OUTPUT_TO_99
      CLOSE (99)
      IHARD_COPY = 0  ! or use KONTROL ...
      RETURN
      END

      INTEGER FUNCTION IQUIT()
      IQUIT = 0
      RETURN
      END

      INTEGER FUNCTION MINIM_FUNCTION()
      COMMON/TEXTWINDOW/IHWND
      INCLUDE <WINDOWS.INS>    
      LOGICAL Q
      Q=SHOWWINDOW (IHWND, SW_MINIMIZE)
      MINIM_FUNCTION=1
      RETURN
      END

      SUBROUTINE PRINTER_OUTPUT_TO_99
C     loads of formatted WRITE statements to UNIT=99
      RETURN
      END

Basically, I created a window with a scalable ClearWin window in it (%cw - this takes a pivot). I associated UNIT=99 with this inner %cw area, so I can just do formatted Fortran WRITEs to it. The window is left visible (%lw). Pressing the SHRINK button minimises it (although it has a minimise box top-right because of %ww), CLEAR wipes out the window containing the %cw area. PRINT wipes out the text window, allocates UNIT=99 now to a printer, and does the print, finishing off by releasing UNIT=99.

All the WRITE(99 ... statements are in SUBROUTINE PRINTER_OUTPUT_TO_99, whether for use in the %cw or hard copy. My outputs are all short, so I did not need to tinker with the size of buffer for %cw, and I haven't bothered with the ability to cut sections from the results - the top level window could have menus, including an edit menu.

It wouldn't be difficult to add a 'save to file' button to it.

Eddie

Eddie,

There were a few bugs and omisions in my post above, please see my reply to Little-Acorn's question on edit boxes in the 'support' forum section.

Ian