## draw rotated ellipse

BasicCoder2
Posts: 3298
Joined: Jan 01, 2009 7:03

### draw rotated ellipse

Draw rotated Ellipse.

Code: Select all

`'some useful definesConst Pi = 4 * Atn(1)Dim Shared As Double TwoPi = 8 * Atn(1)Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degreesDim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radianstype ELLIPSE    as integer cx,cy   'center of ellipse    as integer r1,r2   'axis of ellipse    as ulong   c1,c2   'border color and fill color    as single  angle   'rotate by angleend typesub drawEllipse(e as ELLIPSE)        dim as single x1,y1,x2,y2,x,y,cosAngle,sinAngle    dim as single steps    dim as single angle        'compute minimum pixels for circumference    steps = (abs(e.r1)+abs(e.r2))/360    cosAngle = cos(e.angle)    sinAngle = sin(e.angle)        x = cos(angle)*e.r1    y = sin(angle)*e.r2    x1 = cosAngle * x - sinAngle * y    y1 = cosAngle * y + sinAngle * x            for angle  = 0*DtoR to 361*DtoR step steps*DtoR        x = cos(angle)*e.r1        y = sin(angle)*e.r2        x2 = cosAngle * x - sinAngle * y        y2 = cosAngle * y + sinAngle * x            line (x1+e.cx,y1+e.cy)-(x2+e.cx,y2+e.cy),e.c1  'join points        x1 = x2        y1 = y2    next angle        paint (e.cx,e.cy),e.c2,e.c1     end subdim shared as ELLIPSE e1e1.cx = 320e1.cy = 240e1.r1 = 100e1.r2 = 200e1.c1 = rgb(255,0,0)  'outline colore1.c2 = rgb(0,0,255)  'fill colorsub update()    screenlock    cls    drawEllipse(e1)    screenunlockend subscreenres 640,480,32for angle as single = 0 to 360    e1.angle = angle*DtoR    update()    sleep 20next angle`
Last edited by BasicCoder2 on Nov 25, 2017 13:42, edited 1 time in total.
xlucas
Posts: 263
Joined: May 09, 2014 21:19
Location: Argentina

### Re: rotate oval

That looks very neat, mate! :) It occurs to me that, instead of the space bar, the right mouse button could be used to switch between changing the radius and rotating the oval. Just an idea.
BasicCoder2
Posts: 3298
Joined: Jan 01, 2009 7:03

### Re: rotate oval

A few times when using MSPAINT I wished I could rotate an oval.
Probably it should be drawn in a rectangle where the mouse starts it at the top/left corner as in DPAINT and the have the option to rotate and move the rectangle.

It was in response to reading the bit in squares where I noticed the rotated oval had holes which meant it would not fill.
viewtopic.php?f=3&t=16207&start=5505
Found some more,
viewtopic.php?f=3&t=9566&hilit=rotate+ellipse+oval
viewtopic.php?f=3&t=20440&hilit=rotate+ellipse
.
MrSwiss
Posts: 2763
Joined: Jun 02, 2013 9:27
Location: Switzerland

### Re: rotate oval

I've used as a start, the one pointed to, in the second link, provided by BasicCoder2.
Then I've made it into a "standalone" Sub (without any external Const's/#Define's):

Code: Select all

`' Draws a rotated ellipse' Written by jofers, edited by Kristopher Windsor and, _' made independant of all externals by MrSwiss' Draw an ellipse centered at (cx, cy) with a certain hight, width, _' rotation angle (in degrees) and color (up to 32-bit)Sub DrawEllipse(Byval cX As Long, Byval cY As Long, _                Byval Wid As Single, Byval Hgt As Single, _                Byval angle As Single, ByVal cc As ULong)    #Define Pi 3.14159265f  ' As Single    Dim As Single SinAngle, CosAngle, D2R = Pi / 180    Dim As Single X, Y      ' a point on the ellipse    Dim As Single rX, rY    ' the point rotated    angle *= D2R    CosAngle = Cos(angle)    SinAngle = Sin(angle)    x = ( Wid * Cos(0) )    y = ( Hgt * -Sin(0) )    Rx = ( x * CosAngle ) - ( y * SinAngle )    Ry = ( y * CosAngle ) + ( x * SinAngle )    Pset ( rx + cx, ry + cy ), cc    For Theta As UInteger = 1 to 360        angle = Theta * D2R        X = Wid * Cos(angle)        Y = Hgt * -Sin(angle)        rX = ( X * CosAngle ) - ( Y * SinAngle )        rY = ( Y * CosAngle ) + ( X * SinAngle )        Line - (rX + cX, rY + cY), cc ' is rotated    Next    #Undef PiEnd SubScreen 12Dim As Single ang = 0.0Do    ScreenLock    Cls    DrawEllipse(320, 240, 110, 190, ang, 12)    Paint (320, 240), 9, 12   ' fill ellipse    ScreenUnLock    ang += .5    ' use -= for CCW rotation (+= CW)    If ang > 359.5 Then ang = 0.0    If ang < 0.0 Then ang = 359.5    Sleep( 5, 1 )Loop Until Len( InKey() )`
For speed reasons, the Theta-loop was changed, from Single to UInteger ...
It also fill's without problems, as demonstrated in the demo code.
Position cX and cY, changed from Single, to Long.
Also, added cc (ULong) for color (up to 32-bit), as a 6th. parameter.
Last edited by MrSwiss on Nov 24, 2017 15:08, edited 1 time in total.
dodicat
Posts: 5155
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: rotate oval

Also with Draw:

Code: Select all

`function Ellipse(x as long,y as long,rx as long,ry as long,angle as long,col as ulong,paintflag as long=1) as string    static as single pi2=8*atn(1)    static as long lx,ly,xpos,ypos     dim as string s="Ta" &angle &"Bm" &x &"," &y:s+="Bm+" &rx &"," &0:s+="C" &col    for z as single=0 to pi2*1.1 step pi2/60         if z>pi2 then exit for         xpos=rx*cos(z)         ypos=ry*sin(z)       if z<>0 then s+="M+" &(xpos-lx) &"," &(ypos-ly)        lx=xpos:ly=ypos    next z    if paintflag then s+="BM" &x &"," &y &"P" &col &"," &col    return send functionfunction contrast(c as ulong) as ulong       #define Intrange(f,l) int(Rnd*((l+1)-(f))+(f))       'get the rgb values       dim as ubyte r=Cptr(Ubyte Ptr,@c)[2],g=Cptr(Ubyte Ptr,@c)[1],b=Cptr(Ubyte Ptr,@c)[0],r2,g2,b2       do           r2=Intrange(0,255):g2=IntRange(0,255):b2=IntRange(0,255)           'get at least 120 byte difference           loop until abs(r-r2)>120 andalso abs(g-g2)>120 andalso abs(b-b2)>120          return rgb(r2,g2,b2)    end function      Function Regulate(Byval MyFps As long,Byref fps As long=0) As long    Static As Double timervalue,lastsleeptime,t3,frames    frames+=1    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0    Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000    If sleeptime<1 Then sleeptime=1    lastsleeptime=sleeptime    timervalue=Timer    Return sleeptimeEnd Functionscreen 20,32dim as long a,x,y,w,b,flag,k=1dim as ulong colour1=rgb(200,0,0),colour2=contrast(colour1)do    getmouse x,y,w,b    x=abs(x)    y=abs(y)    w=abs(w)    if b=1 and flag=0 then colour1=rgb(rnd*255,rnd*255,rnd*255):flag=1:colour2=contrast(colour1):k=-k    a+=1    screenlock    clsdraw ellipse(200,200,150,100,a*2,colour1,1) 'fixeddraw ellipse(x,y,150,5+w,-a*k,colour2,1)     'floaterscreenunlocksleep regulate(60),1flag=bloop until len(inkey)sleep   `
dafhi
Posts: 1197
Joined: Jun 04, 2005 9:51

### Re: rotate oval

I'll second comment by xlucas, except i'm using keypress

Code: Select all

`#ifndef piConst Pi = 4 * Atn(1)const TwoPi = 8 * Atn(1)#endif' Draws a rotated ellipse' Written by jofers, edited by Kristopher Windsor' made independant of all externals by MrSwiss' edited by dafhiSub DrawEllipse(Byval cX As single, Byval cY As single, _                Byval w As Single, Byval h As Single, _                Byval angle As Single, ByVal col As ULong)                    var cosa = Cos(angle)    var sina = Sin(angle)        Pset ( w * cosa + cx, w * sina + cy ), col    For angle = 2*pi/360 to 2*pi step 2*pi/360        var X = w * Cos(angle)        var Y = h * -Sin(angle)        Line - (X * cosa - Y * sina + cX, Y * cosa + X * sina + cY), col    NextEnd Subtype imagevars '2017 Oct 10 - by dafhi  as integer            w,h,bpp,bypp,pitch,rate,  wm, hm, pitchBy 'helpers  as any ptr            im, pixels  as ulong ptr          p32  as string             driver_name  declare sub           get_info(im as any ptr=0)  declare               destructor  as single             midx, midy, diagonal '2017 Oct 10end typeDestructor.imagevars  If ImageInfo(im) = 0 Then ImageDestroy im:  im=0End Destructorsub imagevars.get_info(im as any ptr)  if im=0 then    ScreenInfo w,h, bpp, bypp, pitch, rate, driver_name    pixels=screenptr  elseif Imageinfo(im)=0 then    ImageInfo im, w, h, bypp, pitch, pixels    this.im = im:  bpp = bypp * 8  endif: wm=w-1: hm=h-1:  pitchBy=pitch\bypp:  p32=pixels  midx=w/2: midy=h/2:  diagonal = sqr(w*w+h*h)end subtype tRunTime  as single           exit_mark = 25  as single           key_wait = .2  as string           kstr  as double           t, tp, dt  as single           next_key_time  declare function    update as double  declare property    key_allow as boolean  declare property    rdy2draw as boolean  declare property    finished as boolean  declare sub         keytime_advance  declare constructorEnd Typeconstructor.tRunTime  t = Timer:  exit_mark += t  next_key_time = t + key_waitend constructorfunction tRunTime.update as double:  kstr = inkey  tp = t:  t = timer  dt = t - tp:  return dtEnd functionproperty tRunTime.key_allow as boolean  return t >= next_key_timeEnd Propertyproperty tRunTime.finished as boolean  return t >= exit_markEnd Propertysub tRunTime.keytime_advance  next_key_time = t + key_waitEnd Subconst EDIT_W = 0const EDIT_A = 1type editModeVars  as long       mode = EDIT_W  as single     w = 110, a  declare sub   update(dx as single, dy as single)End Typesub editModeVars.update(dx as single, dy as single)  ? "Press a key to toggle edit": ?  select case as const mode  case EDIT_W    w = sqr(dx*dx+dy*dy)    ? "EDIT MODE:  width"  case EDIT_A    a = atan2(dy, dx)    ? "EDIT MODE:  angle"  End SelectEnd Subsub main    Screen 12  var   buf = imagevars:  buf.get_info  dim as tRunTime     rt  dim as editModeVars mode  dim as integer      mousex, mousey, mouseb  Do    getmouse mousex,mousey,,mouseb        ScreenLock      Cls      DrawEllipse(buf.midx, buf.midy, mode.w, 190, mode.a, 12)      Paint (buf.midx, buf.midy), 9, 12   ' fill      mode.update mousex - buf.midx, mousey - buf.midy    ScreenUnLock      rt.update    if rt.finished then exit do    if rt.key_allow then      if rt.kstr <> "" then        rt.keytime_advance        mode.mode = 1 - mode.mode      EndIf    EndIf    Sleep 5,1  Loop until rt.kstr = chr(27)  ?: ? "finished.  exiting .. ": sleep 1500end subMain`
Last edited by dafhi on Nov 29, 2017 12:16, edited 3 times in total.
h4tt3n
Posts: 669
Joined: Oct 22, 2005 21:12
Location: Denmark

### Re: rotate oval

Here is an example of how to draw rotated ellipses without calling sine and cosine for every iteration. This version is *much* faster and less CPU expensive than the other examples posted here so far.

Cheers, Mike

Code: Select all

`''   Very fast ellipse drawing function by Michael "h4tt3n" Nissen''   version 4.0 March 2010''   syntax:''   DrawEllipse(center x, center y, semimajor axis, semiminor axis, angle in radians, color)Randomize''   sample programDim Shared As Double pi = 4*Atn(1)declare sub DrawEllipse(byval x as single, byval y as single, byval a as single, _byval b as single, byval angle as single, byval col as uinteger)screenres 800, 600, 16Dim As Double T = TimerFor i As Integer = 1 To 100drawellipse(400, 300, Rnd*400, Rnd*300, Rnd*2*pi, RGB(64+Rnd*128, 64+Rnd*128, 64+Rnd*128))      ''   yellow ellipse'drawellipse(400, 300, 400, 300, rgb(255, 0, 255))      ''   purple ellipse'drawellipse(400, 300, 400, 200, rgb(0, 255, 0))         ''   green ellipse'drawellipse(400, 300, 150, 150, rgb(0, 0, 255))         ''   blue ellipseNextPrint Timer-Tsleepend''   the subsub DrawEllipse(byval x as single, byval y as single, byval a as single, _   byval b as single, byval angle as single, byval col as uinteger)      ''   fast ellipse drawing function by Michael "h4tt3n" Nissen, march 2010      ''   these constants decide the graphic quality of the ellipse   Const As Integer face_length   = 6               ''   approx. face length in pixels   Const As Integer max_faces      = 512            ''   maximum number of faces in ellipse   Const As Integer min_faces      = 32            ''   minimum number of faces in ellipse      ''   approx. ellipse circumference (Hudson's method)   Dim As Double h                        = ((a-b)*(a-b))/((a+b)*(a+b))   Dim As Double circumference    = 0.25*pi*(a+b)*(3*(1+h*0.25)+1/(1-h*0.25))      ''   number of faces in ellipse   Dim As Integer num_faces          = circumference\face_length      ''   clamp number of faces   If num_faces > max_faces Then num_faces = max_faces   If num_faces < min_faces Then num_faces = min_faces      ''   keep number of faces divisible by 4   num_faces -= num_faces Mod 4      ''   Dim As Double CosAngle = Cos(Angle)   Dim As Double SinAngle = Sin(Angle)      ''   Dim As Double c  = Cos(2*pi/num_faces)   Dim As Double s  = Sin(2*pi/num_faces)      ''   Dim As Double x1 = 1, y1 = 0, x2, y2      ''   For i As Integer = 1 To num_faces-1            x2 = x1      y2 = y1      x1 = c*x2-s*y2      y1 = s*x2+c*y2            Line(x + a*x2*CosAngle - b*y2*SinAngle,   y + a*x2*SinAngle + b*y2*CosAngle)- _            (x + a*x1*CosAngle - b*y1*SinAngle,   y + a*x1*SinAngle + b*y1*CosAngle), col      'PSet (x+a*x1*CosAngle-b*y1*SinAngle,   y+a*x1*SinAngle+b*y1*CosAngle), col      'Draw String (x+a*x2*CosAngle-b*y2*SinAngle,   y+a*x2*SinAngle+b*y2*CosAngle), str(i)         Next      Line(x + a*x1*CosAngle - b*y1*SinAngle, y + a*x1*SinAngle + b*y1*CosAngle)- _         (x + a*CosAngle, y + a*SinAngle), col   'Draw String (x+a*x1*CosAngle-b*y1*SinAngle,   y+a*x1*SinAngle+b*y1*CosAngle), str(num_faces)   End Sub`
BasicCoder2
Posts: 3298
Joined: Jan 01, 2009 7:03

### rotate Ellipse with mouse

In this example you can rotate the ellipse using the mouse while holding down the right mouse button.
Probably will use the left mouse button to grab and move the oval.
Resize maybe have some kind of tag on the oval.

Code: Select all

`'some useful definesConst Pi = 4 * Atn(1)Dim Shared As Double TwoPi = 8 * Atn(1)Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degreesDim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radianstype ELLIPSE    as integer xc,yc   'center of ellipse    as integer r1,r2   'axis of ellipse    as ulong   c1,c2   'border color and fill color    as single  angle   'rotate by angleend typesub drawEllipse(e as ELLIPSE)        dim as single x1,y1,x2,y2,x,y,cosAngle,sinAngle    dim as single steps    dim as single angle        'compute minimum pixels for circumference    steps = (abs(e.r1)+abs(e.r2))/360    cosAngle = cos(e.angle)    sinAngle = sin(e.angle)        x = cos(angle)*e.r1    y = sin(angle)*e.r2    x1 = cosAngle * x - sinAngle * y    y1 = cosAngle * y + sinAngle * x            for angle  = 0*DtoR to 361*DtoR step steps*DtoR        x = cos(angle)*e.r1        y = sin(angle)*e.r2        x2 = cosAngle * x - sinAngle * y        y2 = cosAngle * y + sinAngle * x            line (x1+e.xc,y1+e.yc)-(x2+e.xc,y2+e.yc),e.c1  'join points        x1 = x2        y1 = y2    next angle    paint (e.xc,e.yc),e.c2,e.c1         angle = 180*DtoR    x = cos(angle)*e.r1    y = sin(angle)*e.r2    x1 = cosAngle * x - sinAngle * y    y1 = cosAngle * y + sinAngle * x    line (e.xc,e.yc)-(x1+e.xc,y1+e.yc),rgb(255,255,0)    angle = 90*DtoR    x = cos(angle)*e.r1    y = sin(angle)*e.r2    x1 = cosAngle * x - sinAngle * y    y1 = cosAngle * y + sinAngle * x    line (e.xc,e.yc)-(x1+e.xc,y1+e.yc),rgb(255,255,255)    end subdim shared as ELLIPSE e1e1.xc = 320e1.yc = 240e1.r1 = 100e1.r2 = 200e1.c1 = rgb(255,0,0)  'outline colore1.c2 = rgb(0,0,255)  'fill colorsub update()    screenlock    cls    drawEllipse(e1)    locate 2,2    print int(e1.angle*RtoD)    locate 2,2    print "HOLD RIGHT MOUSE KEY DOWN AND USE MOUSE TO ROTATE ELLIPSE"    screenunlockend subscreenres 640,480,32dim as integer mx,my,mbdim as single yd,xd,angledo    getmouse mx,my,,mb    if mb=2 then        xd = e1.xc-mx        yd = e1.yc-my        angle = int(RtoD*(atan2(yd,xd)))        if angle<0 then angle = angle+360        e1.angle = angle*DtoR    end if    update()    sleep 2loop until multikey(&H01)`
MrSwiss
Posts: 2763
Joined: Jun 02, 2013 9:27
Location: Switzerland

### Re: draw rotated ellipse

This refers to: "draw rotated ellipse" only ...
I've changed the Sub, to use "Static As Single Pi" with: conditional compiling, to avoid:
"duplicate definition" Error, if Pi is already defined (externally), just the new sub:

Code: Select all

`Sub DrawEllipse(Byval cX As Long, Byval cY As Long, _                Byval Wid As Single, Byval Hgt As Single, _                Byval angle As Single, ByVal cc As ULong)#Ifndef Pi    Static As Single Pi = 3.14159265f   ' only, if NOT defined! (externally)#EndIf    Dim As Single SinAngle, CosAngle, D2R = Pi / 180    Dim As Single X, Y      ' a point on the ellipse    Dim As Single rX, rY    ' the point rotated    angle *= D2R    CosAngle = Cos(angle)    SinAngle = Sin(angle)    x = ( Wid * Cos(0) )    y = ( Hgt * -Sin(0) )    Rx = ( x * CosAngle ) - ( y * SinAngle )    Ry = ( y * CosAngle ) + ( x * SinAngle )    Pset ( rx + cx, ry + cy ), cc    For Theta As UInteger = 1 to 360        angle = Theta * D2R        X = Wid * Cos(angle)        Y = Hgt * -Sin(angle)        rX = ( X * CosAngle ) - ( Y * SinAngle )        rY = ( Y * CosAngle ) + ( X * SinAngle )        Line - (rX + cX, rY + cY), cc ' is rotated    NextEnd Sub`