19 Oct 2016 9:29
#18169
I have written a short program to create a SVG file using the externals 'open_svg@' and 'close_svg@'. I have attached it below. As long i do not create a SVG file i can resize the graphics area and can perform left mouse button clicks in the graphics region as expected. But when i clicked in the graphics region after having created the SVG file ('D:\test_02.svg') using the menuitem 'Save as SVG' a run time error occured with the message 'No graphics window open'. It seems to me that the drawing surface is destroyed by the creation process of the SVG file. Am i right or have i made a mistake in my short program? Thanks in advance for your assistance, Paul.
!===================================================================================================
WINAPP
!===================================================================================================
module dwdata
!===================================================================================================
integer*4, parameter :: npoints = 501
real*8, dimension(npoints) :: real_x, pixel_x
real*8, dimension(npoints) :: real_y, pixel_y
integer :: xres = 480
integer :: yres = 580
integer*4 :: mydc = 10
end module dwdata
!===================================================================================================
program svg_test
!===================================================================================================
use dwdata
implicit none
integer :: a
external plot_graph, store_graph_as_svg
a = winio@('%ww[no_border]&')
a = winio@('%ca[SVG Test]&')
a = winio@('%mn[Save as SVG]&', store_graph_as_svg)
a = winio@('%pv%^`gr[color=#E6E6D6, user_resize, rgb_colours]', xres, yres, mydc, plot_graph)
end
!===================================================================================================
integer function store_graph_as_svg()
!===================================================================================================
use dwdata, only : xres, yres
implicit none
C_EXTERNAL OPEN_SVG@ '__open_svg' (INSTRING,VAL,VAL):INTEGER*4
C_EXTERNAL CLOSE_SVG@ '__close_svg' (VAL):INTEGER*4
integer*4 :: ihandle
store_graph_as_svg = 2
ihandle = OPEN_SVG@('D:\test_02.svg', xres, yres)
call graph
ihandle = CLOSE_SVG@(0)
if (ihandle == 0) then
endif
end
!===================================================================================================
integer function plot_graph()
!===================================================================================================
use dwdata, only : xres, yres
implicit none
integer*4 :: clearwin_info@
character(len = 20) :: clearwin_string@
plot_graph = 2
if (clearwin_string@('call_back_reason') == 'RESIZE') then
xres = clearwin_info@ ('graphics_width')
yres = clearwin_info@ ('graphics_depth')
call graph
elseif (clearwin_string@('call_back_reason') == 'MOUSE_LEFT_CLICK') then
call show_mouse_coordinates
endif
end
!===================================================================================================
subroutine graph
!===================================================================================================
use dwdata
implicit none
C_EXTERNAL DRAW_POLYLINED@ '__win_polyline_d'(REF,REF,VAL,VAL)
C_EXTERNAL SET_LINE_WIDTH@ '__set_line_width' (VAL)
C_EXTERNAL SET_LINE_STYLE@ '__set_line_style' (VAL)
C_EXTERNAL SET_SMOOTHING_MODE@ '__set_smoothing_mode'(VAL):integer
C_EXTERNAL SELECT_GRAPHICS_OBJECT@ '__select_graphics_object' (VAL) :INTEGER*4
integer*4 :: ii, RGB@, navy, smooth
call calculate_pixel_coordinates
navy = RGB@(0,0,200)
ii = select_graphics_object@ (mydc)
if (ii == 0) then
endif
smooth = set_smoothing_mode@(5)
if (smooth == 0) then
endif
call set_line_style@(0)
call set_line_width@(2)
call draw_polylined@ (pixel_x, pixel_y, npoints, navy)
end subroutine graph
!===================================================================================================
subroutine show_mouse_coordinates
!===================================================================================================
use dwdata, only : mydc
implicit none
C_EXTERNAL SELECT_GRAPHICS_OBJECT@ '__select_graphics_object' (VAL) :INTEGER*4
C_EXTERNAL DRAW_FILLED_ELLIPSE@ '__win_fill_ellipse_l' (VAL,VAL,VAL,VAL,VAL)
integer*4 :: ii, mxw, myw, rgb@, clearwin_info@
ii = select_graphics_object@ (mydc)
if (ii == 0) then
endif
mxw = clearwin_info@ ('graphics_mouse_x')
myw = clearwin_info@ ('graphics_mouse_y')
call draw_filled_ellipse@(mxw, myw, 6, 6, rgb@(100, 149, 237))
return
end
!===================================================================================================
subroutine calculate_pixel_coordinates
!===================================================================================================
use dwdata
implicit none
integer*4 :: i
real*8 :: xmin, xmax, ymin, ymax, xscale, yscale, xrange, yrange, xorg, yorg
real_x(1) = 0.d0
real_x(npoints) = 7.d0
do i = 2, npoints-1
real_x(i) = real_x(i-1) + (real_x(npoints) - real_x(1)) / (npoints - 1)
enddo
do i = 1, npoints
real_y(i) = exp(-real_x(i)) * sin(real_x(i)*10.d0)
enddo
xrange = 0.8d0 * xres
yrange = 0.8d0 * yres
xorg = 0.5d0 * (xres - xrange)
yorg = 0.5d0 * (yres - yrange)
xmin = 0.d0
xmax = real_x(npoints)
xscale = xrange / (xmax - xmin)
ymin = minval(real_y)
ymax = maxval(real_y)
if (ymin < 0.d0) then
ymax = max(dabs(ymax), dabs(ymin))
ymin =-ymax
else
ymin = 0.d0
endif
yscale = yrange / (ymax - ymin)
do i = 1, npoints
pixel_x(i) = 0.5d0 + xorg + (real_x(i) - xmin) * xscale
pixel_y(i) = yrange - 1 + yorg - (0.5d0 + (real_y(i) - ymin)*yscale)
enddo
return
end