need to tilt an ellipse

[anonymous]

[Originally posted by sha]

Hi
I need to draw a tilted ellipse. it's quite simple to draw one parallel to x,y axis but I don't know how to tilt it by a given angle.
thanks

[anonymous]

[Originally posted by Brent Coppock]

It is not possible to tilt the standard vb shape control within the interface of the shape control.ÿ You would most likely need to use the shape control to program a new shape control with tilt capability.ÿ Or find an existing shape control that has this functionality already in it.ÿ You might be able to use the Windows API to tilt the VB shape control but I am not sure how that would be done.

Cheers,
Brent

[anonymous]

[Originally posted by allen]

Here's an example.ÿ The MatrixBuild and RotatePoint functions were taken from code posted in the Code Section of FreeVBCode.com by Alan Buzbee (Thanks Alan)

Save the text below to a .frm file, then open it in VB.

VERSION 5.00
Begin VB.Form Form1
ÿ Captionÿ ÿ ÿ ÿ =ÿ "Form1"
ÿ ClientHeightÿ ÿ =ÿ 3195
ÿ ClientLeftÿ ÿ ÿ =ÿ 60
ÿ ClientTopÿ ÿ ÿ =ÿ 345
ÿ ClientWidthÿ ÿ =ÿ 4680
ÿ LinkTopicÿ ÿ ÿ =ÿ "Form1"
ÿ ScaleHeightÿ ÿ =ÿ 3195
ÿ ScaleWidthÿ ÿ ÿ =ÿ 4680
ÿ StartUpPosition =ÿ 3ÿ 'Windows Default
ÿ Begin VB.TextBox txtYR
ÿ ÿ ÿ Heightÿ ÿ ÿ ÿ ÿ =ÿ 285
ÿ ÿ ÿ Leftÿ ÿ ÿ ÿ ÿ ÿ =ÿ 3120
ÿ ÿ ÿ TabIndexÿ ÿ ÿ ÿ =ÿ 5
ÿ ÿ ÿ Textÿ ÿ ÿ ÿ ÿ ÿ =ÿ "500"
ÿ ÿ ÿ Topÿ ÿ ÿ ÿ ÿ ÿ =ÿ 1440
ÿ ÿ ÿ Widthÿ ÿ ÿ ÿ ÿ =ÿ 1215
ÿ End
ÿ Begin VB.TextBox txtXR
ÿ ÿ ÿ Heightÿ ÿ ÿ ÿ ÿ =ÿ 285
ÿ ÿ ÿ Leftÿ ÿ ÿ ÿ ÿ ÿ =ÿ 3120
ÿ ÿ ÿ TabIndexÿ ÿ ÿ ÿ =ÿ 3
ÿ ÿ ÿ Textÿ ÿ ÿ ÿ ÿ ÿ =ÿ "1500"
ÿ ÿ ÿ Topÿ ÿ ÿ ÿ ÿ ÿ =ÿ 1080
ÿ ÿ ÿ Widthÿ ÿ ÿ ÿ ÿ =ÿ 1215
ÿ End
ÿ Begin VB.TextBox txtAngle
ÿ ÿ ÿ Heightÿ ÿ ÿ ÿ ÿ =ÿ 285
ÿ ÿ ÿ Leftÿ ÿ ÿ ÿ ÿ ÿ =ÿ 3120
ÿ ÿ ÿ TabIndexÿ ÿ ÿ ÿ =ÿ 1
ÿ ÿ ÿ Textÿ ÿ ÿ ÿ ÿ ÿ =ÿ "0"
ÿ ÿ ÿ Topÿ ÿ ÿ ÿ ÿ ÿ =ÿ 1800
ÿ ÿ ÿ Widthÿ ÿ ÿ ÿ ÿ =ÿ 1215
ÿ End
ÿ Begin VB.CommandButton Command1
ÿ ÿ ÿ Captionÿ ÿ ÿ ÿ =ÿ "Draw"
ÿ ÿ ÿ Heightÿ ÿ ÿ ÿ ÿ =ÿ 375
ÿ ÿ ÿ Leftÿ ÿ ÿ ÿ ÿ ÿ =ÿ 2520
ÿ ÿ ÿ TabIndexÿ ÿ ÿ ÿ =ÿ 0
ÿ ÿ ÿ Topÿ ÿ ÿ ÿ ÿ ÿ =ÿ 600
ÿ ÿ ÿ Widthÿ ÿ ÿ ÿ ÿ =ÿ 1815
ÿ End
ÿ Begin VB.Label Label3
ÿ ÿ ÿ AutoSizeÿ ÿ ÿ ÿ =ÿ -1ÿ 'True
ÿ ÿ ÿ Captionÿ ÿ ÿ ÿ =ÿ "Y Radius"
ÿ ÿ ÿ Heightÿ ÿ ÿ ÿ ÿ =ÿ 195
ÿ ÿ ÿ Leftÿ ÿ ÿ ÿ ÿ ÿ =ÿ 2400
ÿ ÿ ÿ TabIndexÿ ÿ ÿ ÿ =ÿ 6
ÿ ÿ ÿ Topÿ ÿ ÿ ÿ ÿ ÿ =ÿ 1485
ÿ ÿ ÿ Widthÿ ÿ ÿ ÿ ÿ =ÿ 645
ÿ End
ÿ Begin VB.Label Label2
ÿ ÿ ÿ AutoSizeÿ ÿ ÿ ÿ =ÿ -1ÿ 'True
ÿ ÿ ÿ Captionÿ ÿ ÿ ÿ =ÿ "X Radius"
ÿ ÿ ÿ Heightÿ ÿ ÿ ÿ ÿ =ÿ 195
ÿ ÿ ÿ Leftÿ ÿ ÿ ÿ ÿ ÿ =ÿ 2400
ÿ ÿ ÿ TabIndexÿ ÿ ÿ ÿ =ÿ 4
ÿ ÿ ÿ Topÿ ÿ ÿ ÿ ÿ ÿ =ÿ 1125
ÿ ÿ ÿ Widthÿ ÿ ÿ ÿ ÿ =ÿ 645
ÿ End
ÿ Begin VB.Label Label1
ÿ ÿ ÿ Captionÿ ÿ ÿ ÿ =ÿ "Angle:"
ÿ ÿ ÿ Heightÿ ÿ ÿ ÿ ÿ =ÿ 255
ÿ ÿ ÿ Leftÿ ÿ ÿ ÿ ÿ ÿ =ÿ 2520
ÿ ÿ ÿ TabIndexÿ ÿ ÿ ÿ =ÿ 2
ÿ ÿ ÿ Topÿ ÿ ÿ ÿ ÿ ÿ =ÿ 1845
ÿ ÿ ÿ Widthÿ ÿ ÿ ÿ ÿ =ÿ 615
ÿ End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Type TDPoint
x As Double
y As Double
z As Double
End Type

Dim RM(0 To 3, 0 To 3) As Double

Private Sub MatrixBuild(ByVal x As Double, ByVal y As Double, ByVal z As Double)
' this sub builds the rotation matrix with x, y and z as axis angles
Dim SinX, CosX, SinY, CosY, SinZ, CosZ, C1, C2

SinX = Sin(x)
CosX = Cos(x)
SinY = Sin(y)
CosY = Cos(y)
SinZ = Sin(z)
CosZ = Cos(z)

'For C1 = 0 To 3 'identity matrix
'For C2 = 0 To 3
'If C1 = C2 Then
'ÿ ÿ RM(C1, C2) = 0
'Else
'ÿ ÿ RM(C1, C2) = 1
'End If
'Next C2
'Next C1

RM(0, 0) = (CosZ * CosY)
RM(0, 1) = (CosZ * -SinY * -SinX + SinZ * CosX)
RM(0, 2) = (CosZ * -SinY * CosX + SinZ * SinX)
RM(1, 0) = (-SinZ * CosY)
RM(1, 1) = (-SinZ * -SinY * -SinX + CosZ * CosX)
RM(1, 2) = (-SinZ * -SinY * CosX + CosZ * SinX)
RM(2, 0) = SinY
RM(2, 1) = CosY * -SinX
RM(2, 2) = CosY * CosX
End Sub

Private Function RotatePoint(ByVal x As Integer, ByVal y As Integer, ByVal z As Integer) As TDPoint
' finds new point using Rotate Matrix with x, y and z as current point positions
Dim TempPoint As TDPoint
TempPoint.x = (x * RM(0, 0)) + (y * RM(0, 1)) + (z * RM(0, 2)) + RM(0, 3)
TempPoint.y = (x * RM(1, 0)) + (y * RM(1, 1)) + (z * RM(1, 2)) + RM(1, 3)
TempPoint.z = (x * RM(2, 0)) + (y * RM(2, 1)) + (z * RM(2, 2)) + RM(2, 3)

RotatePoint = TempPoint
End Function

Private Sub Command1_Click()
Dim pt As TDPoint
Dim xi As Long, yi As Long, a As Double, r As Double, xr As Long, yr As Long
Dim cx As Long, cy As Long, i As Integer
Dim rot As Double

cx = Me.Width / 2
cy = Me.Height / 2
xr = Val(txtXR.Text)
yr = Val(txtYR.Text)
rot = Val(txtAngle.Text)

MatrixBuild 0, 0, 3.1415926 * 2 / 360 * (rot)


For i = 0 To 360
ÿ a = 3.1415926 * 2 / 360 * (i)
ÿ pt = RotatePoint(xr * Cos(a), yr * Sin(a), 0)
ÿ xi = cx + pt.x
ÿ yi = cy + pt.y
ÿ ÿ ÿ If i = 0 Then
ÿ ÿ Me.CurrentX = xi
ÿ ÿ Me.CurrentY = yi
ÿ ÿ Else
ÿ ÿ Me.Line -(xi, yi)
ÿ End If
Next



End Sub