Option Explicit
 
Private Sub Command1_Click()
  Const TubeWidth = 50
  Dim XTube As Long, Offset As Long, XPicture As Long, Erg As Double
 
  Picture2.Cls
  Erg = 3.14159265358979 * 2 / (TubeWidth * 2)
 
  For Offset = 0 To Picture1.ScaleWidth - 1
      If Offset - TubeWidth >= 0 Then Picture2.PaintPicture _
         Picture1.Picture, Offset - TubeWidth, 0, 1, _
         Picture1.ScaleHeight, Offset - TubeWidth, _
         0, 1, Picture1.ScaleHeight
 
	 For XTube = 1 To TubeWidth
             XPicture = ACos(XTube / (TubeWidth / 2)) / Erg
             If Offset + XPicture < Picture1.ScaleWidth Then
                Picture2.PaintPicture Picture1.Picture, Offset + _
                XTube - TubeWidth, 0, 1, Picture1.ScaleHeight, _
                Offset + XPicture, 0, 1, Picture1.ScaleHeight
             Else
                Picture2.PaintPicture Picture1.Picture, Offset + _
                XTube - TubeWidth, 0, 1, Picture1.ScaleHeight, _
                Offset + XTube - TubeWidth, 0, 1, _
		Picture1.ScaleHeight
             End If
         Next XTube
 
   Next Offset
End Sub
 
Private Function ACos(X As Double)
  X = X - 1
  If X < 1 And X > -1 Then
     ACos = Atn(-X / Sqr(-X * X + 1)) + 2 * Atn(1)
  Else
     ACos = 0
  End If
End Function
 
Private Sub Form_Load()
  Picture2.Width = Picture1.Width
  Picture2.Height = Picture1.Height
End Sub