Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click '自转图形1 If Chpxpy.Checked = True Then '自动变化倾角 For jj = 1 To 6 Call zzhstx1() Next jj Else Call zzhstx1() End If End Sub Sub zzhstx1() '自转图形1 ' Scale(-320, 240)-(320,-240) Dim n, p, lastp, m, i, ft, j， k1, k2 As Integer Dim cy, cx As Integer Dim th1, th2, zzw, ppw As Single Dim XS1, XS2, XS3, XS4, YS1, YS2, YS3, YS4 As Integer Dim thz1, thz2, thz3 As Single g = PictureBox1.CreateGraphics '在相框显示图象 Dim dxr1, dx1, dyr1, dy1, jd0, flag, thzz5 As Single Dim XQ, YQ As Single Dim id, ya, xa As Integer Dim px, py, pz, jtx, dxz, dyz, gx0, gy0, blx, bly, blz As Single Dim txs0, tys0 As Single Dim xs(50, 17), zs(50, 17), ys(50, 17), zc(50, 17) Dim zz(850), pp(850) As Integer Dim max(640), min(640) Dim ppp(3) As System.Drawing.Point Dim brushl As System.Drawing.Brush Dim blx1, bly1 As Single '----------------------------------------------------- ' xs(n, m) = 0 : ys(n, m) = 0 : zs(n, m) = 0 ' zz(850) = 0 : pp(850) = 0 g = PictureBox1.CreateGraphics '在相框显示图象 gx0 = TBx0.Text gy0 = TBy0.Text blx = Tblxs.Text bly = Tblys.Text blz = Tblzs.Text QJ1 = TQJ1.Text blx1 = TBlx1.Text bly1 = TBlx1.Text x1 = 0 : y1 = 0 k1 = 27 k2 = 16 id = 0 For j0 = 0 To 360 Step 360 / k1 id = id + 1 x0 = j0 thz = x0 * pi / 180 If Me.Cbhszz.Text = "正旋函数" Then x1 = x0 y1 = 100 * Math.Sin(x0) x1 = x1 y1 = y1 End If If Me.Cbhszz.Text = "水平线" Then If x1 < 1 And x1 <= 200 Then y1 = 100 x1 = 1.5 * x0 End If x1 = x1 y1 = y1 End If If Me.Cbhszz.Text = "垂直线" Then If y1 < 1 And y1 <= 200 Then y1 = x0 x1 = 100 End If x1 = x1 y1 = y1 End If If Me.Cbhszz.Text = "余旋函数" Then y1 = 100 * Math.Cos(x0) x1 = x0 x1 = x1 y1 = y1 End If If Me.Cbhszz.Text = "斜率函数" Then y1 = 2 * x0 x1 = x0 x1 = x1 y1 = y1 End If If Me.Cbhszz.Text = "斜率正旋" Then y1 = 2 * x0 + 100 * Math.Sin(x0) x1 = x0 End If If Me.Cbhszz.Text = "抛物函数" Then If y1 <= 100 Then y1 = 10 y1 = x0 * x0 x1 = x0 x1 = x1 y1 = y1 End If If Me.Cbhszz.Text = "3次方程" Then ' If y1 <= 100 Then y1 = 10 y1 = 10 * x0 * x0 * x0 x1 = x0 x1 = x1 y1 = y1 End If If Me.Cbhszz.Text = "正余相加" Then y1 = 100 * Math.Sin(x0) + 100 * Math.Cos(x0) x1 = x0 x1 = x1 y1 = y1 End If If Me.Cbhszz.Text = "指数函数" Then y1 = 0.5 ^ x0 x1 = x0 End If If Me.Cbhszz.Text = "正切函数" Then y1 = 1 * Math.Atan(x0) x1 = x0 End If If x1 >= 1 And x1 <= 1250 Or y1 >= 1 And y1 <= 600 Then x1 = x1 * blx y1 = y1 * bly TYHSTX(id) = New PointF(x1, y1) End If Next j0 For th1 = 0 To 2 * pi + 0.1 Step 2 * pi / k1 n = n + 1 : m = 0 ' id = id + 1 x1 = TYHSTX(n).X y1 = TYHSTX(n).Y TBH.Text = n Tx1.Text = TYHSTX(1).X Ty1.Text = TYHSTX(1).Y Tx2.Text = TYHSTX(2).X TY2.Text = TYHSTX(2).Y Tx3.Text = TYHSTX(3).X TY3.Text = TYHSTX(3).Y Tx4.Text = TYHSTX(4).X TY4.Text = TYHSTX(4).Y Tx5.Text = TYHSTX(5).X TY5.Text = TYHSTX(5).Y Tx6.Text = TYHSTX(6).X TY6.Text = TYHSTX(6).Y Tx7.Text = TYHSTX(7).X TY7.Text = TYHSTX(7).Y Tx8.Text = TYHSTX(8).X TY8.Text = TYHSTX(8).Y Tx9.Text = TYHSTX(9).X TY9.Text = TYHSTX(9).Y Tx10.Text = TYHSTX(10).X TY10.Text = TYHSTX(10).Y Tx11.Text = TYHSTX(11).X TY11.Text = TYHSTX(11).Y Tx12.Text = TYHSTX(12).X TY12.Text = TYHSTX(12).Y Tx13.Text = TYHSTX(13).X TY13.Text = TYHSTX(13).Y Tx14.Text = TYHSTX(14).X TY14.Text = TYHSTX(14).Y Tx15.Text = TYHSTX(15).X TY15.Text = TYHSTX(15).Y Tx16.Text = TYHSTX(16).X TY16.Text = TYHSTX(16).Y Tx17.Text = TYHSTX(17).X Ty17.Text = TYHSTX(17).Y Tx18.Text = TYHSTX(18).X TY18.Text = TYHSTX(18).Y Tx19.Text = TYHSTX(19).X TY19.Text = TYHSTX(19).Y Tx20.Text = TYHSTX(20).X TY20.Text = TYHSTX(20).Y Tx21.Text = TYHSTX(21).X TY21.Text = TYHSTX(21).Y Tx22.Text = TYHSTX(22).X TY22.Text = TYHSTX(22).Y Tx23.Text = TYHSTX(23).X TY23.Text = TYHSTX(23).Y Tx24.Text = TYHSTX(24).X TY24.Text = TYHSTX(24).Y Tx25.Text = TYHSTX(25).X TY25.Text = TYHSTX(25).Y Tx26.Text = TYHSTX(26).X TY26.Text = TYHSTX(26).Y Tx27.Text = TYHSTX(27).X Ty27.Text = TYHSTX(27).Y Tx28.Text = TYHSTX(28).X Ty28.Text = TYHSTX(28).Y Tx29.Text = TYHSTX(29).X Ty29.Text = TYHSTX(29).Y Tx30.Text = TYHSTX(30).X Ty30.Text = TYHSTX(30).Y dxr1 = Math.Abs(x1) dx1 = x1 * blx1 dyr1 = Math.Abs(y1) dy1 = y1 * bly1 ' dxz = x1 : dyz = y1 dxz = dx1 : dyz = dy1 For th2 = 0 To 2 * pi + 0.1 Step 2 * pi / k2 m = m + 1 If RbX1.Checked = True Then x = dyr1 * Math.Cos(th2) + dx1 y = -dyr1 * Math.Sin(th2) x = x y = y thy = th1 ' x = x + gx0 : y = y + gy0 : z = z ' thx = th1 ' y = 350 : z = dy1 : x = 0 ' Call rot_x() ' dxz = y - yw : dyz = z - zw End If If Rby1.Checked = True Then x = dxr1 * Math.Cos(th2) y = dxr1 * Math.Sin(th2) - dy1 x = x y = y thx = th1 ' thy = th1 ' x = dx1 : z = dy1 : y = 0 ' Call rot_y() ' dxz = x - xw : dyz = z - zw End If If Rbz1.Checked = True Then x = dxr1 * Math.Cos(th2) + dx1 * 2 y = dxr1 * Math.Sin(th2) - dy1 * 0.1 ' x = 50 * Math.Cos(th2) + dx1 * 1.5 ' y = 100 * Math.Sin(th2) - dy1 * 0.1 x = x y = y thz = th1 ' thz = jd0 * pi / 180 ' x = x : y = y : z = z ' Call rot_z() ' dxz = x - xw : dyz = y - yw ' x = x ' y = y End If If Raz2.Checked = True Then thz = th2 ' x = x : y = y : z = z x = dyr1 * Math.Cos(th2) + dxz * 2 y = dyr1 * Math.Sin(th2) - dyz * 0.1 ' End If If Rbz3.Checked = True Then '函轴一起转'函轴一起转（试验） x = dxr1 * Math.Cos(th2) + dx1 * 2 y = dxr1 * Math.Sin(th2) - dy1 * 0.1 x = x y = y thz = thz ' thz = jd0 * pi / 180 x = x : y = y : z = z Call rot_z() ' dxz = x - xw : dyz = y - yw ' x = x ' y = y End If '-------------------- ' thzj = jd0 * pi / 180 If Rx.Checked = True Then thx = thz3 x = x : y = y : z = z Call rot_x() ' Dim yw, zw As Single ' yw = y : zw = z ' y = yw * Math.Cos(thx) - zw * Math.Sin(thx) ' z = yw * Math.Sin(thx) + zw * Math.Cos(thx) x = x - dxz : y = y - dyz : z = z x = x : y = y * 0.8 : z = z x = x + gx0 : y = y + gy0 : z = z End If If Ry.Checked = True Then thy = thz3 x = x : y = y : z = z Call rot_y() ' Dim xw, zw As Single ' zw = z : xw = x ' x = zw * Math.Cos(thy) - xw * Math.Sin(thy) ' z = zw * Math.Sin(thy) + xw * Math.Cos(thy) x = x - dxz : y = y - dyz : z = z x = x + gx0 : y = y + gy0 : z = z End If If Rz.Checked = True Then thz = thz3 x = x : y = y : z = z Call rot_z() x = x - dxz : y = y - dyz : z = z x = x + gx0 : y = y + gy0 : z = z End If '------------------------------ If RGDQJ.Checked = True Then thz3 = QJ1 * pi / 180 '变化倾角 thz = thz3 '手动变化倾角 End If If Chpxpy.Checked = True Then '自动变化倾角 thz3 = jj * QJ1 * pi / 180 '变化倾角 ' thz3 += thz3 thz = thz3 '手动变化倾角 ' TQJ1.Text = thz3 End If '-------------------------------------------------------------- If RQJZ.Checked = True Then '加倾角（试验） thz = thz x = x : y = y : z = z Call rot_z() x = x : y = y : z = z x = x + gx0 : y = y + gy0 : z = z '旋转后平移到原始位置 End If If Rkong.Checked = True Then '不加倾角--加原点--空 ' x = x + gx0 : y = y + gy0 : z = z '最后结果--不加倾角--加原点 End If x = x : y = y : z = z '最后结果 ' 存入 xs(n, m) = x : ys(n, m) = y : zs(n, m) = z Next th2 Next th1 ' For jd0 = 0 To 360 Step 36 ' id = id + 1 p = 0 For n = 1 To k1 For m = 1 To k2 zc(n, m) = Int((zs(n, m) + zs(n + 1, m + 1)) / 2) zz(p) = zc(n, m) pp(p) = p p = p + 1 Next m Next n lastp = p - 1 '================================================================ For i = 2 To lastp For j = i - 1 To 0 Step -1 If zz(j) > zz(j + 1) Then zzw = zz(j) zz(j) = zz(j + 1) zz(j + 1) = zzw ppw = pp(j) pp(j) = pp(j + 1) pp(j + 1) = ppw End If Next j Next i '======================================================================== XS1 = 0 : XS2 = 0 ： XS3 = 0 ： XS4 = 0 : YS1 = 0 : YS2 = 0 ： YS3 = 0 ： YS4 = 0 For p = 0 To lastp Step 1 n = Int(pp(p) / k2) + 1 m = pp(p) Mod k2 + 1 If n <> k1 + 1 Then ' ' xa = 500 : ya = 150 ' XS1 = xs(n, m) + gx0 + xa : YS1 = ys(n, m) + gy0 + ya ' XS2 = xs(n + 1, m) + gx0 + xa : YS2 = ys(n + 1, m) + gy0 + ya ' XS3 = xs(n + 1, m + 1) + gx0 + xa : YS3 = ys(n + 1, m + 1) + gy0 + ya ' XS4 = xs(n, m + 1) + gx0 + xa : YS4 = ys(n, m + 1) + gy0 + ya XS1 = xs(n, m) + xa : YS1 = ys(n, m) + ya XS2 = xs(n + 1, m) + xa : YS2 = ys(n + 1, m) + ya XS3 = xs(n + 1, m + 1) + xa : YS3 = ys(n + 1, m + 1) + ya XS4 = xs(n, m + 1) + xa : YS4 = ys(n, m + 1) + ya If n <= 8 And m <= 16 Then ppp(0).X = XS1 : ppp(0).Y = YS1 ppp(1).X = XS2 : ppp(1).Y = YS2 ppp(2).X = XS3 : ppp(2).Y = YS3 ppp(3).X = XS4 : ppp(3).Y = YS4 If Math.Abs(YS1 * (XS2 - XS3) + YS2 * (XS3 - XS1) + YS3 * (XS1 - XS2)) > 40 Then g.DrawLine(pen1, XS1, YS1, XS2, YS2) g.DrawLine(pen1, XS2, YS2, XS3, YS3) g.DrawLine(pen1, XS3, YS3, XS4, YS4) g.DrawLine(pen1, XS4, YS4, XS1, YS1) ft = 0 ' brushl = New SolidBrush(Color.Blue) Dim TB1 As New TextureBrush(mylmage1, Drawing.Drawing2D.WrapMode.Tile) ' g.FillClosedCurve(brushl, ppp) g.FillClosedCurve(TB3, ppp) End If ' End If ' g.DrawLine(pen2, XS1, YS1, XS2, YS2) g.DrawLine(pen2, XS2, YS2, XS3, YS3) g.DrawLine(pen2, XS3, YS3, XS4, YS4) g.DrawLine(pen2, XS4, YS4, XS1, YS1) Text = "调试2" End If End If Next p ' Next n Text = "函数自转图形调试接束" ' Nex End Sub Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click '自转图形3 Call zzhstx3() '自转图形3 End Sub Sub zzhstx3() '自转图形3 ' Scale(-320, 240)-(320,-240) Dim n, p, lastp, m, i, ft, j， k1, k2 As Integer Dim cy, cx As Integer Dim th1, th2, zzw, ppw As Single Dim XS1, XS2, XS3, XS4, YS1, YS2, YS3, YS4 As Integer g = PictureBox1.CreateGraphics '在相框显示图象 Dim dxr1, dx1, dyr1, dy1, jd0, flag As Single Dim XQ, YQ As Single Dim thzj As Single Dim id, ya, xa As Integer Dim px, py, pz, jtx, dxz, dyz, gx0, gy0 As Single Dim txs0, tys0 As Single Dim xs(50, 17), zs(50, 17), ys(50, 17), zc(50, 17) Dim zz(850), pp(850) As Integer Dim max(640), min(640) Dim ppp(3) As System.Drawing.Point Dim brushl As System.Drawing.Brush '----------------------------------------------------- xs(n, m) = 0 : ys(n, m) = 0 : zs(n, m) = 0 zz(850) = 0 : pp(850) = 0 g = PictureBox1.CreateGraphics '在相框显示图象 gx0 = TBx0.Text gy0 = TBy0.Text x1 = 0 : y1 = 0 k1 = 27 k2 = 16 id = 0 ' For j0 = 0 To 360 Step 360 / k1 For j0 = -180 To 180 Step 180 / k1 id = id + 1 x0 = j0 If Me.Cbhszz.Text = "正旋函数" Then x1 = x0 y1 = 150 * Math.Sin(x0) x1 = x1 '+ gx0 y1 = y1 '+ gy0 End If If Me.Cbhszz.Text = "水平线" Then If x1 < 1 And x1 <= 200 Then y1 = 100 x1 = 1.5 * x0 End If x1 = x1 y1 = y1 End If If Me.Cbhszz.Text = "垂直线" Then If y1 < 1 And y1 <= 200 Then y1 = x0 x1 = 100 End If x1 = x1 y1 = y1 End If If Me.Cbhszz.Text = "余旋函数" Then y1 = 100 * Math.Cos(x0) x1 = x0 x1 = x1 ' + gx0 y1 = y1 ' + gy0 End If If Me.Cbhszz.Text = "斜率函数" Then y1 = 2 * x0 x1 = x0 x1 = x1 ' + gx0 y1 = y1 ' + gy0 End If If Me.Cbhszz.Text = "斜率正旋" Then y1 = 2 * x0 + 100 * Math.Sin(x0) x1 = x0 End If If Me.Cbhszz.Text = "抛物函数" Then If y1 <= 100 Then y1 = 10 y1 = x0 * x0 x1 = x0 x1 = x1 ' + gx0 y1 = y1 '+ gy0 End If If Me.Cbhszz.Text = "3次方程" Then ' If y1 <= 100 Then y1 = 10 y1 = 10 * x0 * x0 * x0 x1 = x0 x1 = x1 '+ gx0 y1 = y1 '+ gy0 End If If Me.Cbhszz.Text = "正余相加" Then y1 = 100 * Math.Sin(x0) + Math.Cos(x0) x1 = x0 x1 = x1 '+ gx0 y1 = y1 '+ gy0 End If If Me.Cbhszz.Text = "指数函数" Then y1 = 0.5 ^ x0 x1 = x0 End If If Me.Cbhszz.Text = "正切函数" Then y1 = 1 * Math.Atan(x0) x1 = x0 End If If x1 >= 1 And x1 <= 1250 Or y1 >= 1 And y1 <= 600 Then TYHSTX3(id) = New PointF(x1, y1) End If Next j0 For th1 = 0 To 2 * pi + 0.1 Step 2 * pi / k1 n = n + 1 : m = 0 ' id = id + 1 x1 = TYHSTX3(n).X y1 = TYHSTX3(n).Y dxr1 = Math.Abs(x1) dx1 = x1 dyr1 = Math.Abs(y1) dy1 = y1 dxz = x1 : dyz = y1 ' For th2 = 0 To 2 * pi + 0.1 Step 2 * pi / k2 For th2 = -pi To pi + 0.1 Step 2 * pi / k2 m = m + 1 If RbX1.Checked = True Then x = dyr1 * Math.Cos(th2) ' + dx1 y = -dyr1 * Math.Sin(th2) x = x + XQ y = y + YQ thy = th1 ' thx = th1 ' y = 350 : z = dy1 : x = 0 ' Call rot_x() ' dxz = y - yw : dyz = z - zw End If If Rby1.Checked = True Then x = dxr1 * Math.Cos(th2) y = dxr1 * Math.Sin(th2) ' - dy1 x = x + XQ y = y + YQ thx = th1 ' thy = th1 ' x = dx1 : z = dy1 : y = 0 ' Call rot_y() ' dxz = x - xw : dyz = z - zw End If If Rbz1.Checked = True Then ' x = dx1 : y = dy1 : thz = th1 thz = jd0 * pi / 180 x = x : y = y : z = z Call rot_z() dxz = x - xw : dyz = y - yw End If If Rbz3.Checked = True Then '函轴一起转 ' x = dx1 : y = dy1 : thz = th1 thz = jd0 * pi / 180 x = x + gx0 : y = y + gy0 : z = z Call rot_z() dxz = x - xw : dyz = y - yw End If If Raz2.Checked = True Then thz = th2 ' x = x : y = y : z = z x = dxr1 * Math.Cos(th2) + dxz y = -dxr1 * Math.Sin(th2) - dyz ' End If If Rx.Checked = True Then x = x : y = y : z = z Call rot_x() x = x - dxz : y = y - dyz : z = z End If If Ry.Checked = True Then x = x : y = y : z = z Call rot_y() x = x - dxz : y = y - dyz : z = z End If If Rz.Checked = True Then x = x : y = y : z = z Call rot_z() x = x - dxz : y = y - dyz : z = z End If ' 存入 xs(n, m) = x : ys(n, m) = y : zs(n, m) = z Next th2 Next th1 ' For jd0 = 0 To 360 Step 36 ' id = id + 1 p = 0 For n = 1 To k1 For m = 1 To k2 zc(n, m) = Int((zs(n, m) + zs(n + 1, m + 1)) / 2) zz(p) = zc(n, m) pp(p) = p p = p + 1 Next m Next n lastp = p - 1 '================================================================ For i = 2 To lastp For j = i - 1 To 0 Step -1 If zz(j) > zz(j + 1) Then zzw = zz(j) zz(j) = zz(j + 1) zz(j + 1) = zzw ppw = pp(j) pp(j) = pp(j + 1) pp(j + 1) = ppw End If Next j Next i '======================================================================== For p = 0 To lastp Step 1 n = Int(pp(p) / k2) + 1 m = pp(p) Mod k2 + 1 If n <> k1 + 1 Then ' xa = 500 : ya = 150 XS1 = xs(n, m) + 200 + xa : YS1 = ys(n, m) + 150 + ya XS2 = xs(n + 1, m) + 200 + xa : YS2 = ys(n + 1, m) + 150 + ya XS3 = xs(n + 1, m + 1) + 200 + xa : YS3 = ys(n + 1, m + 1) + 150 + ya XS4 = xs(n, m + 1) + 200 + xa : YS4 = ys(n, m + 1) + 150 + ya If n <= 8 Then ppp(0).X = XS1 : ppp(0).Y = YS1 ppp(1).X = XS2 : ppp(1).Y = YS2 ppp(2).X = XS3 : ppp(2).Y = YS3 ppp(3).X = XS4 : ppp(3).Y = YS4 If Math.Abs(YS1 * (XS2 - XS3) + YS2 * (XS3 - XS1) + YS3 * (XS1 - XS2)) > 40 Then g.DrawLine(pen1, XS1, YS1, XS2, YS2) g.DrawLine(pen1, XS2, YS2, XS3, YS3) g.DrawLine(pen1, XS3, YS3, XS4, YS4) g.DrawLine(pen1, XS4, YS4, XS1, YS1) ft = 0 ' brushl = New SolidBrush(Color.Blue) Dim TB1 As New TextureBrush(mylmage1, Drawing.Drawing2D.WrapMode.Tile) ' g.FillClosedCurve(brushl, ppp) g.FillClosedCurve(TB3, ppp) End If ' End If ' g.DrawLine(pen2, XS1, YS1, XS2, YS2) g.DrawLine(pen2, XS2, YS2, XS3, YS3) g.DrawLine(pen2, XS3, YS3, XS4, YS4) g.DrawLine(pen2, XS4, YS4, XS1, YS1) Text = "调试2" End If End If Next p ' Next n Text = "函数自转图形调试接束" ' Nex