Anonymní profil Luboš – Programujte.com

Ahoj.

Tento program ve VB6 jsem vytvořil před 20 lety. Už se k němu nechci moc vracet.

Místo příkazu Pset (kreslí bod) by byl vhodnější příkaz Line (maluje linku) .

Option Explicit

Private Sub Command1_Click()
Cls
Dim sx As Integer, sy As Integer
Dim x As Integer, y As Integer
Dim r As Single
Dim a As Long, s As Integer
Dim polomer1 As Integer
Dim polomer2 As Integer
Dim i As Integer
Dim radians As Single
Dim uhel1 As Single, uhel2 As Single
sx = 200
sy = 150
polomer1 = 150 'rozmery ellipsy
polomer2 = 40
Const Pi = 3.14
Rem uhel1 = 45 ' úhel pootočení ve stupních (ve směru hod.ruč.)
uhel1 = Pi - (Val(Text1.Text) * (Pi / 180) - Pi / 2)
For s = 1 To 360
  uhel1 = Pi - (s * (Pi / 180) - Pi / 2)
  Cls 'vymaže kreslící plochu
    For i = 1 To 360
      radians = i * (Pi / 180)
      x = (polomer1 * Cos(radians)) * -1
      y = (polomer2 * Sin(radians)) * -1
      PSet (x + sx, y + sy) 'maluje body původní elipsy
        r = Sqr(x ^ 2 + y ^ 2)
        If y = 0 Then
          If x > 0 Then uhel2 = Pi / 2 Else uhel2 = Pi / 2 + Pi
        Else
          uhel2 = Atn(x / y)
        End If
        If y < 0 Then uhel2 = uhel2 + Pi
        uhel2 = uhel1 + uhel2
        x = r * Cos(uhel2)
        y = r * Sin(uhel2) * -1
      PSet (x + sx, y + sy) 'maluje body pootočené elipsy
    Next i
  For a = 1 To 5000000
  Next a
DoEvents
Next s
End Sub