Using a metafile to print multiple copies

In this section:

Here is another sample program which (like the above example) shows how to draw to a screen drawing surface in parallel with output to a graphics printer or plotter. In this case the image is scaled according to which device is used. Multiple copies are printed by calling DO_COPIES@ but this routine requires a metafile recording of the current image before it is called.

      INCLUDE <windows.ins>
      REAL scaling
      INTEGER i,wc,res,ncopies
      INTEGER screen_height,printer_height
      INTEGER screen_width,printer_width
      INTEGER screen_id,printer_id
      EXTERNAL graphics
      COMMON scaling,screen_id,printer_id
      CALL set_rgb_colours_default@(1)
c---  Give id numbers to the screen and printer
      i=winio@('%ww%ca[Salford graphics]&')
      CALL graphics()
      CALL get_graphical_resolution@(screen_width,
     +          screen_height)
c---  Select printer and start document
        CALL use_rgb_colours@(printer_id,.true.)
        CALL get_graphical_resolution@(printer_width,
     +                                 printer_height)
c---    Scaling factor for printer
c---    Open metafile to record printer drawing
        CALL open_metafile@(printer_id)
        CALL graphics()
c---    Stop recording
        CALL close_metafile@(printer_id)
c---    Make copies of the page
        CALL do_copies@(printer_id,ncopies)
c---    Print document
        CALL select_graphics_object@(screen_id)

      SUBROUTINE graphics()
      INCLUDE <windows.ins>
      INTEGER x(10),y(10)
      INTEGER hpol,z,xa,xb,err
      REAL scaling
      INTEGER screen_id,printer_id
      COMMON scaling,screen_id,printer_id
      CALL set_line_width@(3)
c---  Select font
      CALL set_text_attribute@(101,3*scaling,0,0)
      CALL draw_characters@('HELLO',xa,xb,RGB@(255,255,255))
      CALL set_line_width@(1)
      CALL draw_line_between@(0,0,z,z,RGB@(255,0,0))
      CALL draw_line_between@(0,z,z,0,RGB@(0,255,0))
c---  Ellipse
      CALL draw_ellipse@(z,z,xa,xb,RGB@(255,0,0))
      CALL draw_filled_ellipse@(z,z,xa,xb,RGB@(0,0,255))
c---  Polyline
c---  .... Code for x(2..4) and y(2..4)
      CALL draw_polyline@(x,y,5,RGB@(255,0,0))
c---  Polygon
c---  .... Code for x(2..4) and y(2..4)
      CALL draw_filled_polygon@(x,y,5,RGB@(255,0,0))



Copyright © 1999-2024 Silverfrost Limited