by Looi Tuck Wai (5 Submissions)
Category: Graphics
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 14th August 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Picture load in effect - "Mercury Rising"
VBcoders
'Author : Looi Tuck Wai
'Date : 13/8/1999
'Control : 2 Picture Box (Picture1 & Picture2),1 Command Button (CmdMercury)
'Code :
Option Explicit
Private Sub CmdMercury_Click()
Const TubeWidth = 80
Dim XTube As Long, Offset As Long, XPicture As Long, Erg As Double
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 = Mercury(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 Sub Form_Load()
Picture2.Width = Picture1.Width
Picture2.Height = Picture1.Height
End Sub
Private Function Mercury(X As Double)
X = X - 1
If X < 1 And X > -1 Then
Mercury = Atn(-X / Sqr(-X * X + 1)) + 2 * Atn(1)
Else
Mercury = 0
End If
End Function