• Home
 · 
• Graphics
 · 
• Picture load in effect - Mercury Rising

Picture load in effect - Mercury Rising

Picture load in effect - "Mercury Rising"

Rate Picture load in effect - Mercury Rising

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'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