A transparent circle fails with paint because it overlaps a pixel at the top and bottom thus producing two leaking points.
An alternative Bresenham circle avoids this.
Code: Select all
Type Pt
As Long x,y
End Type
Sub GetCircle(xm As Integer, ym As Integer, r As Integer,p() As pt)
#define CIRC(r) ( ( Int( (r)*(1 + Sqr(2)) ) - (r) ) Shl 2 )
Dim As Long x = -r, y = 0, e = 2 - r Shl 1,count
Redim p(0 To CIRC(r)+4-1 )
Do
count+=1:p(count)=Type<pt>(xm-x, ym+y)
count+=1:p(count)=Type<pt>(xm-y, ym-x)
count+=1:p(count)=Type<pt>(xm+x, ym-y)
count+=1:p(count)=Type<pt>(xm+y, ym+x)
r = e
If r<=y Then
y+=1
e+=y Shl 1+1
End If
If r>x Or e>y Then
x+=1
e+=x Shl 1+1
End If
Loop While x<0
p(0)=Type(xm,ym)'set the centre in (0)
Redim Preserve p(count)
End Sub
Sub Magnify()
#define resetwheel(w,fl) fl=w
#define wheel(w,f) w-f
Dim As Long mx,my,mw,button:Getmouse mx,my,mw,button
Static As Long flag,pmw
mw=Abs(mw/2)
Line(mx-40,my-40)-(mx+40,my+40),Rgb(0,0,0),B
If button=1 Then resetwheel(mw,flag)
Dim As Ulong array(1 To 6561),count
pmw=wheel(mw,flag)
If pmw<=1 Then Exit Sub
For z As Long=1 To 2
For x As Long=mx-40 To mx+40
For y As Long=my-40 To my+40
count+=1
If z=1 Then
Var c=Point(x,y) 'needed to magnify an alpha screen
Var r =Cast(Ubyte Ptr,@c)[2]
Var g =Cast(Ubyte Ptr,@c)[1]
Var b =Cast(Ubyte Ptr,@c)[0]
Var al=Cast(Ubyte Ptr,@c)[3]
array(count)=Rgba(r,g,b,255)
End If
If z=2 Then
Var NewX=pmw*(x-mx)+mx:Var NewY=pmw*(y-my)+my
Line(newx-pmw/2,newy-pmw/2)-(newx+pmw/2,newy+pmw/2),array(count),bf
End If
Next y
Next x
count=0
Next z
Line(mx-pmw*40,my-pmw*40)-(mx+pmw*40,my+pmw*40),5,B
End Sub
Sub _circle(p() As pt,c As Ulong)
For n As Long=Lbound(p)+1 To Ubound(p)
Pset (p(n).x,p(n).y),c
Next
End Sub
Dim As Long rad=150
Dim As pt c()
getCircle(220,300,rad,c())
Screen 19,32,,64
Color ,Rgb(255,255,255)
Cls
Draw String(350,300),"Press a key",Rgb(0,200,0)
dim as ulong colour= Rgba(200,0,0,100)
Do
Screenlock
Cls
Draw String(200,20),"Left circle - bresenham, Right circle - gfx",Rgb(0,0,0)
_circle(c(),colour)
Circle(580,300),rad,colour
pset(400,300),rgb(0,200,0) ' screen centre
magnify
Screenunlock
Sleep 1,1
Loop Until Len(Inkey)
Cls
_circle(c(),colour)
Paint(c(0).x,c(0).y),colour,Point(c(1).x,c(1).y)
Sleep