VB画椭圆的程序怎么编写

用极坐标方程啊。

根据椭圆的极坐标方程：x＝P*cosA,y＝P*sinA,如唤坦果在中心点旋转角度为B的话，那极迹链拦坐标方程就是

x＝P*cos(A＋B)，y＝P*sin(A＋B)，将COS（A＋B)和SIN（A＋B）展开，解关于A的方程，得到

sinA＝。。。cosA＝....

因此可以在VB里面用object.pset(sinA,cosA)画椭圆了

x1,y1为椭圆中心点移姿胡动的坐标

控件自己添加进去就OK了。

代码如下：

Private Sub Command1_Click()

Picture1.Cls

Picture1.Scale (-100, 100)-(100, -100)

Picture1.AutoRedraw = True

Dim x, y As Double

Dim Alfa, Ceta As Double

Dim x1, y1 As Double

Dim r, g, bb As Double

r = r + 10

g = g

bb = bb + r

x1 = Val(Text4.Text)

y1 = Val(Text5.Text)

a = Val(Text2.Text)

b = Val(Text3.Text)

Text1.Text = Val(Text1.Text) + 10

Ceta = Val(Text1.Text) / 180 * 3.1415926

For Alfa = -3.1415926 To 3.1415926 Step 0.003

x = a * Cos(Alfa)

y = b * Sin(Alfa)

m = ((x) * Cos(Ceta) + (y) * Sin(Ceta)) + x1

n = (-x) * Sin(Ceta) + (y) * Cos(Ceta) + y1

Picture1.PSet (m, n), RGB(r, 0, bb)

Next Alfa

Picture1.Line (0, 100)-(0, -100), vbRed

Picture1.Line (100, 0)-(-100, 0), vbRed

End Sub

使用API函数Arc

'下面代码复制到模块

Declare Function FindWindow _

Lib "user32" Alias "FindWindowA" _

(ByVal lpClassName As String, _

ByVal lpWindowName As String) _

As Long

Declare Function GetDC Lib "user32" _

(ByVal hwnd As Long) As Long

Declare Function Arc Lib "gdi32" _

(ByVal hdc As Long, ByVal X1 As Long, _

ByVal Y1 As Long, ByVal X2 As Long, _

ByVal Y2 As Long, ByVal X3 As Long, _

ByVal Y3 As Long, ByVal X4 As Long, _

ByVal Y4 As Long) As Long

Declare Function CancelDC Lib "gdi32" _

(ByVal hdc As Long) As Long

'Arc参数 类型及说明

' hdc Long，一历纤个显示场景的句柄

' X1,Y1 Long，指定围绕椭圆的一个矩形的左上角位置

' X2,Y2 Long，指定围绕椭圆的一个矩形的右下角位置

' X3,Y3 Long，指定圆弧起点

' X4,Y4 Long，指定圆弧终点

'下面代码复制到窗体

Private Sub Command1_Click()

Dim hwnd As Long

Dim hdc As Long

hwnd&= FindWindow(vbNullString, "Form1") '肢梁仿获得窗口句柄渣巧

If hwnd = 0 Then

Else

hdc = GetDC(hwnd)

Arc hdc, 50, 50, 150, 150, 50, 50, 50, 50

CancelDC hdc

End If

End Sub

Excel的Shape.ScaleWidth和 Shape.ScaleHeight方法虽然有个msoScaleFromMiddle参数，但是实际上并没法从圆心开始放大，因此你干脆就在原来圆的基础上重心画圆。

下列代码只是在你代码的基础上修改的，主要只是如何确定其它圆左上角的位置。但一次只能画一个圆。如果你需要很多这样的同心圆，则需要你修改一下代码，将新的放大比率赋值给数组变量，然后用一个简单的循环去读取数组。

Sub txy()

Const r1 = 25

Const startpos = 10

Dim r2 As Single

Dim ratio As Single

Set myShe = Application.ActiveSheet'设置对象变量

'Set myJh = New Collection'设置新集合棚李变量

myleft = Application.ActiveCell.Left + startpos '获得激活单元格的左边铅孝距

mytop = Application.ActiveCell.Top + startpos '获得激活单元格的上边距

With myShe.Shapes.AddShape(msoShapeOval, myleft, mytop, r1 * 2, r1 * 2) '添加园 msoShapeOval椭圆形

.Fill.Transparency = 1 '设置形状为透明

.Line.Weight = myXt + 0.75 '设置线条宽度

.Line.ForeColor.RGB = myRGB '设置前景色

End With

ratio = 0.8 '设置放大比例

r2 = r1 * ratio

myleft = Application.ActiveCell.Left - (r2 - (startpos + r1)) '获得激活单元格的左边距

mytop = Application.ActiveCell.Top - (r2 - (startpos + r1)) '获得激活单元格的上边距

With myShe.Shapes.AddShape(msoShapeOval, myleft, mytop, r2 * 2, r2 * 2) '添加园 msoShapeOval椭圆形

.Fill.Transparency = 1 '设置形状为透明

.Line.Weight = myXt + 0.75 '设置线条宽度

.Line.ForeColor.RGB = RGB(255, 0, 0) '设置前景色，如槐和稿果完全复制可以设回原来的myRGB

End With

End Sub

myleft, mytop是圆的左上点，确切地说，是圆的外切正方形的左上角点的坐标位置，以磅为单位；50，50是圆的直径，实际上excel里面没有单独的画圆命令，这个命令是用来画椭圆的，两个参数分别为宽度和高度，相等的话就是画圆，不等就是椭圆。使用AddShape方法添加的图形，都具有五个参数，画什么形状主要取决于第一个type参数。

---