Option Explicit
 
Private SW%, SH%, ZB%, ZH%
 
Private Sub Form_Activate()
 
Dim i%, E$, Z%, BZ%, XPos%, YPos%, Wnk1!, Wnk2!
Dim Rad1%, Rad2%, Pi!, X$, Y$, Out$, Mldg$
 
Out = "193C303730277510273137303027213A2721307534392675142533303938B1"
Out = Out & "3B3B363D303B6A033C3039751239A9363E75203B3175343939302675"
Out = Out & "12202130752F203875123037202721262134327B"
Mldg = ""
For i = 1 To Len(Out) Step 2
  Mldg = Mldg & Chr(85 Xor ("&H" & Mid(Out, i, 2)))
Next i
Pi = 4 * Atn(1)
With Me
.BackColor = RGB(0, 128, 192)
.WindowState = vbMaximized
.ScaleMode = vbPixels
.AutoRedraw = True
SW = .ScaleWidth
SH = .ScaleHeight
 
X = Left(Mldg, InStr(1, Mldg, "?"))
Y = ""
For i = 1 To Len(X): Y = Y & Mid(X, i, 1) & " ": Next i
.FontBold = True
.Caption = Space((SW - .TextWidth(Y)) / .TextWidth("  ")) & Y
.FontBold = False
.FontName = "Arial Black"
.FontSize = 24
ZB = .TextWidth("W")
ZH = .TextHeight("W")
Call Diag
Rad1 = SW / 2 - 2 * ZB
Rad2 = Rad1 * 0.4
Mldg = Mid(Mldg, InStr(Mldg, "?") + 1)
BZ = Len(Mldg)
For i = 0 To BZ - 1
  Wnk1 = 2 * Pi / BZ * i
  Wnk2 = 2 * Pi * (1 + 0.5) - Wnk1
  E = Mid(Mldg, i + 1, 1)
  If E = " " Then
    Z = (Z + 1) Mod 7
  Else
    Me.Line (0, 0)-(ZB, ZH), vbBlack, BF
    .ForeColor = Choose(Z + 1, vbRed, RGB(255, 64, 0), vbYellow, vbGreen, RGB( _
      128, 128, 255), vbBlue, vbMagenta)
    .CurrentX = 0
    .CurrentY = 0
    Me.Print E
    XPos = SW \ 2 + Rad1 * Sin(Wnk2)
    YPos = SH \ 2 + Rad2 * Cos(Wnk2) - 16
    Call DreheWnk(Wnk1, XPos, YPos)
    DoEvents
  End If
Next i
Me.Line (0, 0)-(ZB, ZH), .BackColor, BF
.FillStyle = 0
.FillColor = vbRed
For i = 0 To 8
  Wnk1 = 2 * Pi / 9 * i
  Me.Circle (SW \ 2 + Rad1 / 1.5 * Sin(Wnk1), SH \ 2 + Rad2 / 1.5 * Cos(Wnk1)), _
    20, vbRed, -0.00001, -Pi, 0.9
Next i
.FillStyle = 1
End With
 
End Sub
 
Private Sub Form_Unload(Cancel%)
  End
End Sub
 
Private Sub DreheWnk(Winkel!, XPos%, YPos%)
 
Dim XM%, YM%, Farbe&, Fhdc&, SWnk!, CWnk!, NeuX!, NeuY!, RelX%, RelY%, i%, j%
 
XM = ZB \ 2
YM = ZH \ 2
SWnk = Sin(Winkel)
CWnk = Cos(Winkel)
Fhdc = Me.hDC
For j = 0 To ZH - 1
  RelY = j - YM
  For i = 0 To ZB - 1
    Farbe = Me.Point(i, j)
    If Farbe <> vbBlack Then
      RelX = i - XM
      NeuX = XPos + CWnk * RelX - SWnk * RelY
      NeuY = YPos + SWnk * RelX + CWnk * RelY
      Me.PSet (NeuX, NeuY), Farbe
      Me.PSet (NeuX + 1, NeuY), Farbe
    End If
  Next i
Next j
 
End Sub
 
Private Sub Diag()
 
Dim i!, j%, Farbe&, Rand&, Rad1%
 
With Me
.FillStyle = 0
.FillColor = vbWhite
Rad1 = SW \ 2 - 30
For i = 0 To 140
  If (i Mod 20) = 0 Then
    Farbe = IIf(j = 0, RGB(255, 162, 208), vbWhite)
    j = 1 - j
  End If
  If i = 0 Or i = 140 Then
    Rand = vbBlack
  Else
    Rand = Farbe
  End If
  Me.Circle (SW \ 2, SH \ 2 - i + 125), Rad1, Rand, , , 0.4
  DoEvents
Next i
.FillStyle = 1
End With
 
End Sub