Write graphics to file

[Chofo]

I'm using Fortran extensively to draw graphics on the screen, mostly consisting of lines, boxes, circles and text. I'm searching for a way to save these graphics in a file, which could be a .gif, .jpg, .wpg, .pdf, or any other format that can store graphics. Or a screenshot would do it. Any idea how I can do that in Fortran?

Thanks!

 

[Chofo]

Here's the solution to get a screenshot:

USE IFQWIN

result = SAVEIMAGE (filename,ulxcoord,ulycoord, lrxcoord,lrycoord)

or

result = SAVEIMAGE_W (filename,ulwxcoord,ulwycoord, lrwxcoord,lrwycoord)

 

[xwb]

If depends on which compiler you're using. Looks like you are using either Powerstation, CVF or IVF.

 

[Chofo]

I'm using Visual Studio 2008 with with Intel Visual Fortran Compiler.

 

[xwb]

The difference between the two calls is whether you have built it using Unicode or not. saveimage is the MBCS version, saveimage_w is the Unicode version. If you use saveimage_w, it expects the filename to be an array of unicode characters.

 

[gullipe]

Hi Chofo and xwb

I know it may be rather late to reply to this post, but I have used Fortran programs to create a "copy" of the screen and independent graphics in two ways:

1) creating a Windows metafile (*.WMF).
2) creating a postscript file (*.EPS).

WMF files can be imported directly into WORD and opened in some graphic programs.

EPS files can be imported into WORD, but no graphic appears unless there in a preview in the file (TIFF, WMF etc). Other program can display the graphics without a preview in the file, such as InDesign and PhotoShop. In fact, EPS files are (or were at least) widely used in the publishing business.

If you write your graphics on the screen with the Windows functions (TextOut, MoveTo, LineTo, Ellipse etc.), it is easy to write to a WMF file, because you simply use the same functions with a different HDC. A short example is here:

tmpWMF = 'FILE.wmf'//char(0)
hdcMeta = CreateMetaFile(tmpWMF)

status = SetWindowOrgEx(hdcMeta,null,null,NULL)
status = SetWindowExtEx(hdcMeta,xP,yP,NULL)

hBru = CreateSolidBrush(Ocol)
hBruOld = SelectObject(hdcMeta,hBru)
hPen = CreatePen(PS_SOLID,int2(0),Ocol)
hPenOld = SelectObject(hdcMeta,hPen)

status = SelectObject(hdcMeta,hBru)
status = SelectObject(hdcMeta C,hPen)

TLX = xpos - iradi
TLY = ypos - iradi
TRX = xpos + iradi
TRY = ypos + iradi

status = Ellipse(hdcMeta,TLX,TLY,TRX,TRY)

hBru = SelectObject(hdcMeta,hBruOld)
status = DeleteObject(hBru)
hPen = SelectObject(hdcMeta,hPenOld)
status = DeleteObject(hPen)

hMF = CloseMetaFile(hdcMeta)
status = DeleteMetaFile(hMF)

Creating a Postscript file is a bit more complicated. You both have to make a header and a trailer. But in fact it turns out to be relatively easy. The example below draws X and Y-axis, writes months at the X-axis, draws some red columns (histograms), draws a blue filled circle and writes some text. Can be opened in PhotoShop, IrfanWiew etc.

%!PS-Adobe-3.0 EPSF-3.0
%%BoundingBox: 0 0 239 168
%%LanguageLevel: 2
%%Creator: Map 2.00
%%Title: ACCNIS.eps
%%CreationDate: 13.10.2010
%%Pages: 1
%%DocumentProcessColors: Cyan Magenta Yellow Black
%%DocumentNeededResources: font Times-Roman
%%+ font Times-Italic
%%+ font Helvetica
%%EndComments
%%BeginSetup
%%EndSetup

/circle {0 360 arc gsave stroke grestore fill} bind def
/M {moveto} def
/L {lineto} def
/S {stroke} def

% true setstrokeadjust

   0  168 translate
0.1495 -0.1495 scale

 3.35 setlinewidth
 0.00 0.00 0.00 1.00 setcmykcolor

    4.82    4.82 M
 1596.02    4.82 L
S
    4.82 1120.75 M
 1596.02 1120.75 L
S
    4.82    4.82 M
    4.82 1120.75 L
S
 1596.02    4.82 M
 1596.02 1120.75 L
S
  939.31  995.50 M
  939.31 1120.75 L
S
  939.31  995.50 M
 1596.02  995.50 L
S

/Helvetica findfont
dup length dict begin
  {1 index /FID ne {def} {pop pop} ifelse}
     forall
  /Encoding ISOLatin1Encoding def
  currentdict
end
/Helvetica-ANSI exch definefont pop

gsave

 0.00 0.00 0.00 1.00 setcmykcolor

/Helvetica-ANSI findfont 36.0   scalefont setfont


% X and Y Axis
 1.34 setlinewidth
 0.00 0.00 0.00 1.00 setcmykcolor

  192.68  786.77 M
  216.76  786.77 L
S
  192.68  780.35 M
  192.68  791.59 L
S
  216.76  786.77 M
  242.45  786.77 L
S
  216.76  780.35 M
  216.76  791.59 L
S
  242.45  786.77 M
  266.54  786.77 L
S
  242.45  780.35 M
  242.45  791.59 L
S
  266.54  786.77 M
  292.23  786.77 L
S
  266.54  780.35 M
  266.54  791.59 L
S
  292.23  786.77 M
  316.31  786.77 L
S
  292.23  780.35 M
  292.23  791.59 L
S
  316.31  786.77 M
  342.00  786.77 L
S
  316.31  780.35 M
  316.31  791.59 L
S
  342.00  786.77 M
  367.69  786.77 L
S
  342.00  780.35 M
  342.00  791.59 L
S
  367.69  786.77 M
  391.78  786.77 L
S
  367.69  780.35 M
  367.69  791.59 L
S
  391.78  786.77 M
  417.47  786.77 L
S
  391.78  780.35 M
  391.78  791.59 L
S
  417.47  786.77 M
  441.55  786.77 L
S
  417.47  780.35 M
  417.47  791.59 L
S
  441.55  786.77 M
  467.24  786.77 L
S
  441.55  780.35 M
  441.55  791.59 L
S
  467.24  786.77 M
  491.33  786.77 L
S
  467.24  780.35 M
  467.24  791.59 L
S
  491.33  786.77 M
  517.02  786.77 L
S
  491.33  780.35 M
  491.33  791.59 L
S
  517.02  786.77 M
  542.71  786.77 L
S
  517.02  780.35 M
  517.02  791.59 L
S
  542.71  786.77 M
  566.80  786.77 L
S
  542.71  780.35 M
  542.71  791.59 L
S
  566.80  786.77 M
  592.49  786.77 L
S
  566.80  780.35 M
  566.80  791.59 L
S
  592.49  786.77 M
  616.57  786.77 L
S
  592.49  780.35 M
  592.49  791.59 L
S
  616.57  786.77 M
  642.26  786.77 L
S
  616.57  780.35 M
  616.57  791.59 L
S
  642.26  786.77 M
  666.35  786.77 L
S
  642.26  780.35 M
  642.26  791.59 L
S
  666.35  786.77 M
  692.04  786.77 L
S
  666.35  780.35 M
  666.35  791.59 L
S
  692.04  786.77 M
  717.73  786.77 L
S
  692.04  780.35 M
  692.04  791.59 L
S
  717.73  786.77 M
  741.81  786.77 L
S
  717.73  780.35 M
  717.73  791.59 L
S
  741.81  786.77 M
  767.50  786.77 L
S
  741.81  780.35 M
  741.81  791.59 L
S
  767.50  786.77 M
  791.59  786.77 L
S
  767.50  780.35 M
  767.50  791.59 L
S
  791.59  786.77 M
  817.28  786.77 L
S
  791.59  780.35 M
  791.59  791.59 L
S
  817.28  786.77 M
  841.36  786.77 L
S
  817.28  780.35 M
  817.28  791.59 L
S
  841.36  786.77 M
  867.05  786.77 L
S
  841.36  780.35 M
  841.36  791.59 L
S
  867.05  786.77 M
  892.74  786.77 L
S
  867.05  780.35 M
  867.05  791.59 L
S
  892.74  786.77 M
  916.83  786.77 L
S
  892.74  780.35 M
  892.74  791.59 L
S
  916.83  786.77 M
  942.52  786.77 L
S
  916.83  780.35 M
  916.83  791.59 L
S
  942.52  786.77 M
  966.60  786.77 L
S
  942.52  780.35 M
  942.52  791.59 L
S
  966.60  786.77 M
  992.29  786.77 L
S
  966.60  780.35 M
  966.60  791.59 L
S
  992.29  786.77 M
 1016.38  786.77 L
S
  992.29  780.35 M
  992.29  791.59 L
S
 1016.38  786.77 M
 1042.07  786.77 L
S
 1016.38  780.35 M
 1016.38  791.59 L
S
 1042.07  786.77 M
 1067.76  786.77 L
S
 1042.07  780.35 M
 1042.07  791.59 L
S
 1067.76  786.77 M
 1091.84  786.77 L
S
 1067.76  780.35 M
 1067.76  791.59 L
S
 1091.84  786.77 M
 1117.53  786.77 L
S
 1091.84  780.35 M
 1091.84  791.59 L
S
 1117.53  786.77 M
 1141.62  786.77 L
S
 1117.53  780.35 M
 1117.53  791.59 L
S
 1141.62  786.77 M
 1167.31  786.77 L
S
 1141.62  780.35 M
 1141.62  791.59 L
S
 1167.31  786.77 M
 1191.39  786.77 L
S
 1167.31  780.35 M
 1167.31  791.59 L
S
 1191.39  786.77 M
 1217.08  786.77 L
S
 1191.39  780.35 M
 1191.39  791.59 L
S
 1217.08  786.77 M
 1242.77  786.77 L
S
 1217.08  780.35 M
 1217.08  791.59 L
S
 1242.77  786.77 M
 1266.86  786.77 L
S
 1242.77  780.35 M
 1242.77  791.59 L
S
 1266.86  786.77 M
 1292.55  786.77 L
S
 1266.86  780.35 M
 1266.86  791.59 L
S
 1292.55  786.77 M
 1316.63  786.77 L
S
 1292.55  780.35 M
 1292.55  791.59 L
S
 1316.63  786.77 M
 1342.32  786.77 L
S
 1316.63  780.35 M
 1316.63  791.59 L
S
 1342.32  786.77 M
 1366.41  786.77 L
S
 1342.32  780.35 M
 1342.32  791.59 L
S
 1366.41  786.77 M
 1392.10  786.77 L
S
 1366.41  780.35 M
 1366.41  791.59 L
S
 1392.10  786.77 M
 1417.79  786.77 L
S
 1392.10  780.35 M
 1392.10  791.59 L
S
 1417.79  786.77 M
 1441.88  786.77 L
S
 1417.79  780.35 M
 1417.79  791.59 L
S
 1441.88  786.77 M
 1467.57  786.77 L
S
 1441.88  780.35 M
 1441.88  791.59 L
S
 1467.57  786.77 M
 1491.65  786.77 L
S
 1467.57  780.35 M
 1467.57  791.59 L
S
 1491.65  786.77 M
 1491.65  786.77 L
S
 1491.65  780.35 M
 1491.65  791.59 L
S
  192.68  802.83 M
  192.68  818.88 L
S
  192.68  810.85 M
  301.86  810.85 L
S
  301.86  802.83 M
  301.86  818.88 L
S
  301.86  810.85 M
  401.41  810.85 L
S
  401.41  802.83 M
  401.41  818.88 L
S
  401.41  810.85 M
  512.20  810.85 L
S
  512.20  802.83 M
  512.20  818.88 L
S
  512.20  810.85 M
  619.78  810.85 L
S
  619.78  802.83 M
  619.78  818.88 L
S
  619.78  810.85 M
  730.57  810.85 L
S
  730.57  802.83 M
  730.57  818.88 L
S
  730.57  810.85 M
  838.15  810.85 L
S
  838.15  802.83 M
  838.15  818.88 L
S
  838.15  810.85 M
  948.94  810.85 L
S
  948.94  802.83 M
  948.94  818.88 L
S
  948.94  810.85 M
 1059.73  810.85 L
S
 1059.73  802.83 M
 1059.73  818.88 L
S
 1059.73  810.85 M
 1167.31  810.85 L
S
 1167.31  802.83 M
 1167.31  818.88 L
S
 1167.31  810.85 M
 1276.49  810.85 L
S
 1276.49  802.83 M
 1276.49  818.88 L
S
 1276.49  810.85 M
 1384.07  810.85 L
S
 1384.07  802.83 M
 1384.07  818.88 L
S
 1384.07  810.85 M
 1494.86  810.85 L
S
 1494.86  802.83 M
 1494.86  818.88 L
S
   246   846 translate
1 -1 scale
(Jan) dup stringwidth pop 2 div  0 exch sub   0.0 moveto show
1 -1 scale
  -246  -846 translate

   351   846 translate
1 -1 scale
(Feb) dup stringwidth pop 2 div  0 exch sub   0.0 moveto show
1 -1 scale
  -351  -846 translate

   457   846 translate
1 -1 scale
(Mar) dup stringwidth pop 2 div  0 exch sub   0.0 moveto show
1 -1 scale
  -457  -846 translate

   566   846 translate
1 -1 scale
(Apr) dup stringwidth pop 2 div  0 exch sub   0.0 moveto show
1 -1 scale
  -566  -846 translate

   674   846 translate
1 -1 scale
(May) dup stringwidth pop 2 div  0 exch sub   0.0 moveto show
1 -1 scale
  -674  -846 translate

   783   846 translate
1 -1 scale
(Jun) dup stringwidth pop 2 div  0 exch sub   0.0 moveto show
1 -1 scale
  -783  -846 translate

   892   846 translate
1 -1 scale
(Jul) dup stringwidth pop 2 div  0 exch sub   0.0 moveto show
1 -1 scale
  -892  -846 translate

  1003   846 translate
1 -1 scale
(Aug) dup stringwidth pop 2 div  0 exch sub   0.0 moveto show
1 -1 scale
 -1003  -846 translate

  1112   846 translate
1 -1 scale
(Sep) dup stringwidth pop 2 div  0 exch sub   0.0 moveto show
1 -1 scale
 -1112  -846 translate

  1221   846 translate
1 -1 scale
(Oct) dup stringwidth pop 2 div  0 exch sub   0.0 moveto show
1 -1 scale
 -1221  -846 translate

  1330   846 translate
1 -1 scale
(Nov) dup stringwidth pop 2 div  0 exch sub   0.0 moveto show
1 -1 scale
 -1330  -846 translate

  1439   846 translate
1 -1 scale
(Dec) dup stringwidth pop 2 div  0 exch sub   0.0 moveto show
1 -1 scale
 -1439  -846 translate

  165.38   93.13 M
  165.38  762.68 L
S
  160.57   93.13 M
  171.80   93.13 L
S
  160.57  160.57 M
  171.80  160.57 L
S
  160.57  226.40 M
  171.80  226.40 L
S
  160.57  293.83 M
  171.80  293.83 L
S
  160.57  361.27 M
  171.80  361.27 L
S
  160.57  428.71 M
  171.80  428.71 L
S
  160.57  494.54 M
  171.80  494.54 L
S
  160.57  561.98 M
  171.80  561.98 L
S
  160.57  629.42 M
  171.80  629.42 L
S
  160.57  695.25 M
  171.80  695.25 L
S
  160.57  762.68 M
  171.80  762.68 L
S
  154.14   93.13 M
  178.23   93.13 L
S
  154.14  160.57 M
  178.23  160.57 L
S
  154.14  226.40 M
  178.23  226.40 L
S
  154.14  293.83 M
  178.23  293.83 L
S
  154.14  361.27 M
  178.23  361.27 L
S
  154.14  428.71 M
  178.23  428.71 L
S
  154.14  494.54 M
  178.23  494.54 L
S
  154.14  561.98 M
  178.23  561.98 L
S
  154.14  629.42 M
  178.23  629.42 L
S
  154.14  695.25 M
  178.23  695.25 L
S
  154.14  762.68 M
  178.23  762.68 L
S
   141    71 translate
1 -1 scale
(  10) dup stringwidth pop  0 exch sub -36.0 moveto show
1 -1 scale
  -141   -71 translate

   141   138 translate
1 -1 scale
(   9) dup stringwidth pop  0 exch sub -36.0 moveto show
1 -1 scale
  -141  -138 translate

   141   205 translate
1 -1 scale
(   8) dup stringwidth pop  0 exch sub -36.0 moveto show
1 -1 scale
  -141  -205 translate

   141   272 translate
1 -1 scale
(   7) dup stringwidth pop  0 exch sub -36.0 moveto show
1 -1 scale
  -141  -272 translate

   141   339 translate
1 -1 scale
(   6) dup stringwidth pop  0 exch sub -36.0 moveto show
1 -1 scale
  -141  -339 translate

   141   406 translate
1 -1 scale
(   5) dup stringwidth pop  0 exch sub -36.0 moveto show
1 -1 scale
  -141  -406 translate

   141   473 translate
1 -1 scale
(   4) dup stringwidth pop  0 exch sub -36.0 moveto show
1 -1 scale
  -141  -473 translate

   141   540 translate
1 -1 scale
(   3) dup stringwidth pop  0 exch sub -36.0 moveto show
1 -1 scale
  -141  -540 translate

   141   607 translate
1 -1 scale
(   2) dup stringwidth pop  0 exch sub -36.0 moveto show
1 -1 scale
  -141  -607 translate

   141   674 translate
1 -1 scale
(   1) dup stringwidth pop  0 exch sub -36.0 moveto show
1 -1 scale
  -141  -674 translate

   141   741 translate
1 -1 scale
(   0) dup stringwidth pop  0 exch sub -36.0 moveto show
1 -1 scale
  -141  -741 translate

% Circle
0.67 setlinewidth
  900  400 M
1.00 1.00 0.00 0.00 setcmykcolor
 900  400 20 circle

% Columns
 1.00 setlinewidth
 0.00 1.00 1.00 0.00 setcmykcolor

  571.00  696.00   17.00   67.00 rectfill
 1221.00  696.00   17.00   67.00 rectfill
 1246.00  629.00   17.00  134.00 rectfill

1.00 setlinewidth

% Some text
 0.00 0.00 0.00 1.00 setcmykcolor

    50  1005 translate
1 -1 scale
     0 -36.0 M
(R:     3) show
1 -1 scale
   -50 -1005 translate

    50  1055 translate
1 -1 scale
     0 -36.0 M
(N:     4) show
1 -1 scale
   -50 -1055 translate

grestore

/Times-Roman findfont
dup length dict begin
  {1 index /FID ne {def} {pop pop} ifelse}
     forall
  /Encoding ISOLatin1Encoding def
  currentdict
end
/Times-Roman-ANSI exch definefont pop

/Times-Italic findfont
dup length dict begin
  {1 index /FID ne {def} {pop pop} ifelse}
     forall
  /Encoding ISOLatin1Encoding def
  currentdict
end
/Times-Italic-ANSI exch definefont pop

gsave

 0.00 0.00 0.00 1.00 setcmykcolor

/Times-Roman-ANSI findfont 40.5   scalefont setfont

   965  1005 translate
1 -1 scale
     0 -40.5 M
(Sparrow Hawk) show
1 -1 scale
  -965 -1005 translate

/Times-Italic-ANSI findfont 40.5   scalefont setfont

   965  1055 translate
1 -1 scale
     0 -40.5 M
(Accipiter nisus) show
1 -1 scale
  -965 -1055 translate

grestore

1 0.1495 div 1 0.1495 div scale

showpage

%%Trailer
%%DocumentNeededResources: font Times-Roman
%%+ font Times-Italic
%%+ font Helvetica
%%EOF

 

[GerritGroot]

Is there a actually freeware library to do graphics in Fortran? (For example in combination with gfortran)

 

[Chofo]

Gullipe and xwb,

Thank you so much for your responses. In particular, I'm happy about understanding how WMF files are created, that's the ideal solution as it's vector based.

In the meantime, I found one additional option to create GIF files. The freeware Fly 1.6.0 allows you creating GIF files from ascii text files. For instance,

new
size 128,128
# a black background
fill 1,1,0,0,0
# a diagonal white line top left to bottom right
line 0,0,127,127,255,255,255

is the ascii file for creating a GIF file with 128x128 pixels, a black background and a white diagonal line. Then you can call from Fortran

character*100 txt
integer i(4)
write (txt,'(a)') 'fly -q -i input.asc -o output.gif'
i = system(trim(txt))

and the corresponding GIF file is created. But obviously, Gullipe's WMF file is much more flexible as it creates a vector-based file, and not a raster-based GIF file.

 

[gullipe]

Hi Chofo

Note that WMF files have a header and that must be written to the final WMF file before the data, see below.
It is better to set the checksum also because some programs require correct checksum, others do not care.

! ----- Some definitions -----

	character*80 tmpWMF,skrWMF
	integer*4 hdcMeta,hMF
	integer*4 len
	integer*4 iPix
	integer*4 Bx,By
	integer*4 TLX,TLY,TRX,TRY
	integer*2 i2
	integer*4 status
	integer*4 xP,yP
	character cha

! ----- Write to temorary metafile -----

	tmpWMF = 'Temp.wmf'//char(0)
	hdcMeta = CreateMetaFile(tmpWMF)

	xP = 1024
	yP = 728

	status = SetWindowOrgEx(hdcMeta,null,null,NULL)
	status = SetWindowExtEx(hdcMeta,xP,yP,NULL)

	status = Ellipse(hdcmeta,TLX,TLY,TRX,TRY)

	hMF = CloseMetaFile(hdcMeta)
	status = DeleteMetaFile(hMF)

! ----- Write header to final metafile -----

	iPix = 96
	Bx = 1024
	By = 728

	skrWMF = 'FileName.wmf'
	len = len_trim(skrWMF)
	open(unit=10,file=skrWMF(1:len),form='binary',status='unknown')

	i2 = #CDD7.xor.#9AC6.xor.int2(Bx).xor.int2(By).xor.int2(iPix)

	write(10) char(#D7),char(#CD),char(#C6),char(#9A)       ! Header
	write(10) int2(0)                                       ! (Reserved)
	write(10) int2(0),int2(0),int2(Bx),int2(By)             ! Box
	write(10) int2(iPix)                                    ! pix/inch
	write(10) int2(0),int2(0)                               ! (Reserved)
	write(10) int2(i2)                                      ! Checksum

! ----- Copy data from temorary metafile to final metafile -----

	open(unit=9,file=tmpWMF(1:8),form='binary',status='unknown')

	do while(.true.)
	   read(9,end=89) cha
	   write(10) cha
	enddo

89	continue

	close(unit=10)
	close(unit=9,status='delete')