Welcome to our forums
Does anybody have sample code to fill a polygon with a hatch pattern? I don't seem to be making any progress with createhatchbrush
Cheers
Brian
draw_filled_polygon@ only allows you to specify the fill as a solid colour.
I guess that you may be able to create your own brush hBrush using CreateHatchBrush but you will have to select it into the relevant device context before calling draw_filled_polygon@ etc.
You can get the hDC from clearwin_info@('GRAPHICS_HDC') and then select the created hBrush with a call to the Windows API SelectObject.
oldBrush = SelectObject(hDC, hBrush)
In I.O. Angell & G. Griffith 'High-resolution computer graphics using Fortran 77' published by Macmillan, ISBN 0-333-40398-3 (0-333-430399-1 for the paperback) (1987) there is a routine for doing just that on pages 93 & 94. (You are a bit too far away from SW London for me to offer you the loan of my copy. I could scan the pages and e mail them if you send me an e mail address via 'private message').
However, when I typed up the code and ran it my recollection is that it missed out one of the hatch lines through a vertex. I never got to the bottom of it, and gave up ... (it might have simply been a precision problem).
Eddie
Eddie,
You are right, lines which pass through a vertex go wrong. I seem to remember having a fight with that routine. I have attached where I got to in 1994, but it does seem to be a precision problem where one of the hatching lines is very close to the end of a boundary line.
This code just checks a series of lines against a boundary.
dimension xvert(100),yvert(100),x1(10),y1(10),x2(10),y2(10),
& rmt(100)
open(unit=10,file='border',status='unknown')
c
c determine the border into which lines are to be clipped
read(10,*)nvertex
do i=1,nvertex
read(10,*)xvert(i),yvert(i)
c print *,xvert(i),yvert(i)
enddo
c
c read the lines to be drawn
read(10,*)nlines
do i=1,nlines
read(10,*)x1(i),y1(i),x2(i),y2(i)
c print *,x1(i),y1(i),x2(i),y2(i)
enddo
c
c take a line and see whether the intersection is within the range of each
c of the border lines
do j = 1,nlines
dx = x2(j)-x1(j)
dy = y2(j)-y1(j)
c
c set number of intersections to zero plus 2 to denote the start and end
c of the line itself and insert 0 & 1 into the rmt array
ni = 2
rmt(1) = 0.0
rmt(2) = 1.0
c print *,' rmu isec'
do i=0,nvertex-1
i1 = mod(i+1,nvertex)+1
call ill2(xvert(i+1),yvert(i+1),xvert(i1),yvert(i1),
& x1(j),y1(j),dx,dy,rmu,rmt(ni+1),isec)
c print *,rmu,rmt(ni+1),isec
if(isec .eq. 1)then
c
c yes it intersects but is it within limits of border line in question
if(rmu .ge. 0.0 .and. rmu .le. 1.0)then
c
c take this one into account
c print *,'line intersects edge ',i-1,' at rmu =',rmu
c
c determine position on line to be drawn of the intersection
ni = ni + 1
endif
endif
enddo
c print *,'RMT values'
c print *,(rmt(i),i=1,ni)
call SORT(rmt,Ni,1,ni,1,1,ISTAT)
c print *,'RMT values sorted'
c print *,(rmt(i),i=1,ni)
c
c if the first value in the list is 0.0 then line starts outside
c if the last value in the list is 1.0 then line ends outside
c we must also only draw items in the range of 0.0 to 1.0 so scan list
c and start a line on an even rmt array subscript plot to next subscript
c only draw a line if start point is in range 0 to 1
print *,'rmt values to plot'
do i = 2,ni-1,2
if(rmt(i) .ge. 0.0 .and. rmt(i) .le. 1.0)then
print *,i,rmt(i),' to ',rmt(i+1)
endif
enddo
enddo
end
See continuation post
Ian
Part 2
c==================================================================
subroutine ill2(x1,y1,x2a,y2a,x3,y3,x4,y4,rmu,rmt,isec)
c
c finds point of intersection of two lines x1,y1 to x2,y2 with
c x3,y3 to x4,y4
c rmu is the non dimensional value of the intersection on the first line
c rmu = 0 for start of line ,1 for end of line therefore outside range
c 0 to 1 means they do not intersect
c x,y are the coordinates of the intersection
c isec = 1 if success else 0
x2 = x2a-x1
y2 = y2a-y1
delta = x2*y4 - y2*x4
delta2 = x4*y2 - y4*x2
c
c if delta = 0 then lines parallel
if(abs(delta) .lt. 0.00001)then
isec = 0
return
endif
c
c find rmu value for (x,y) on first line
isec = 1
rmu = ((x3-x1)*y4 - (y3-y1)*x4)/delta
rmt = ((x1-x3)*y2 - (y1-y3)*x2)/delta2
return
end
Part 3
SUBROUTINE SORT(X,N,M,L,ISORT,ITY,ISTAT)
C sorts X into order
C name type size dimensions i/o description
C x RE 4 (*,*) b an array dimensioned (nxm) containing the data to be sorted.
C n in 4 i the maximum number of entries in each column. and the first dimension of ix
C m in 4 i the number of columns in ix to be sorted and hence the second dimension of ix.
C l in 4 i the fill of the array columns 0 < l <= n
C isort in 4 i the column to sort on 1 <= isort <= m
C ity in 4 i the type of sort.
C +1 = ascending order, +2 = ascending on absolute value
C -1 = descending order, -2 = descending order on absolute
C istat in 4 o error status.
C 0 = ok, 1 = zero colums in array, 2 = sort column too low, 4 = sort column too high, 8 = invalid sort type so isort set to 1,
C 16 = fill greater than available so l set to n
C status 1, 2 & 4 are fatal, 8 & 16 are non-fatal
DIMENSION X(N,M)
C note : istat codes may be the summation of any
C of the above
C ! initialize status
ISTAT = 0
C ! zero columns found
IF( M.LT.1 )ISTAT = 1
C sort column too low
IF( ISORT.LT.1 )ISTAT = ISTAT + 2
C sort column too high
IF( ISORT.GT.M )ISTAT = ISTAT + 4
C ===============================================
C if istat not zero then don't sort, just return
IF( ISTAT.NE.0 )RETURN
IF( ITY.NE.1 .AND. ITY.NE.-1 )THEN
IF( ITY.NE.2 .AND. ITY.NE.-2 )THEN
ITY = 1
ISTAT = 8
ENDIF
ENDIF
IF( L.GT.N )THEN
L = N
ISTAT = ISTAT + 16
ENDIF
C ! float integer
TY = SIGN(1.0,FLOAT(ITY))
MODE = ABS(ITY)
C ===============================================
C set up search loops
DO 30 I = 1, L - 1
DO 20 J = I + 1, L
C ===============================================
C check magnitudes
C ===============================================
IF( MODE.EQ.1 )THEN
C
C normal sort
IF( X(I,ISORT)*IFIX(TY).LE.X(J,ISORT)*IFIX(TY) )GOTO 20
C
C absolute sort
ELSEIF( ABS(X(I,ISORT)*IFIX(TY)).LE.ABS(X(J,ISORT)*IFIX(TY))
& )THEN
GOTO 20
ENDIF
C ===============================================
C do the swap
C ===============================================
DO 10 K = 1, M
DUMMY = X(J,K)
X(J,K) = X(I,K)
X(I,K) = DUMMY
10 CONTINUE
20 CONTINUE
30 CONTINUE
RETURN
END
Thanks Ian,
That saved me a job.
Eddie
Gents Thanks for the very prompt replies
Paul I have not had a chace to try this yet;
Eddie Thanks for the offer; and
Ian thanks for the code
Cheers
Brian
Ian,
I could not resist converting your SORT to fortran 90, using a SELECT CASE (ITY) structure. I do think that fortran 90 is an improvement in style and probably with little overhead.
I also noted your code sets ITY to 1, however ITY is not supplied as a variable. This could be one of those nasty bugs that is difficult to find.
IF( ITY.NE.2 .AND. ITY.NE.-2 )THEN
ITY = 1
ISTAT = 8
ENDIF
John
Paul
Worked perfect;ly when i used the polygon API and after I twiged that I had to define my coordinates in a vector of alternating x and y values
Thanks again to all
Brian,
Could you post the code please, for all to see?
John
May I add my voice to John H's, asking to see a code fragment please?
Apart from the line through a vertex problem, I think that the ultimate reason I abandoned the quest to program hatching was the incredible price drop in colour printers, and my abandoning plotters of the type that used to pick up a pen and rush round the page with it.
To John C: As Angell and Griffiths were writing in Fortran 77, they probably eschewed Select Case deliberately. Think yourself lucky the code isn't all in arithmetic IFs, ASSIGNed GOTOs and Holleriths, with no comments and worse ....
Eddie
Apologies
Here is code:
integer hatchbrush,oldbrush,npts
integer*4 ijk(50)
c put xy coordinates into a vector array ijk c alternating x and y
ijk(1)=x(1)
ijk(2)=y(1)
.
.
.
.
.
ijk(2n-1)=x(n)
ijk(2n)=x(n)
npts=n
ij=clearwin_info@('GRAPHICS_HDC')
hatchBrush = CreateHatchBrush(HS_DIAGCROSS,RGB@(255,128,0))
oldBrush = SelectObject (ij, hatchBrush)
call polygon(ij,ijk,npts)
Cheers
Brian