|
Option Explicit
Private Sub Form_Load()
Picture2.Width = Picture1.Width
Picture2.Height = Picture1.Height
End Sub
Private Sub Command1_Click()
Const TubeWidth = 50
Dim XTube As Long, Offset As Long, XPicture As Long
Dim 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
End If
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
|
|