S
H
A
R
E

Thursday, April 28, 2011

VB.net Create Simple Text Effect Following Mouse

This Program will displaying text on screen and following mouse with simple effect. Just a simple, have some conntrol mouse manipulation, and timer for animation.


This project using NetFramework 3.5, I write it with Visual studio 2008, Would you like to try??
Ok, lets make a new VB project in Visual studio. and then... copy the code bellow:



Public Class Form
    Dim str As String = ""
    Dim StrLen As Integer = 0
    Dim pos As Integer = 0
    Const TxWidth As Integer = 17
    Dim Lb(30) As Label
    Dim WithEvents tm As New Timer()
    Dim WithEvents TmIkuti As New Timer()


    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        str = "This A Simple Mouse Effect"
        Me.ShowInTaskbar = False
        Me.TopMost = True
        StrLen = str.Length
        Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None
        Me.BackColor = Color.White
        Me.TransparencyKey = Color.White
        TataHuruf()
    End Sub

    Private Sub TataHuruf()
        For i = 0 To StrLen - 1
            Lb(i) = New Label
            Lb(i).Text = str(i)
            Lb(i).Width = TxWidth
            Lb(i).Font = New Font("Calibri", 12, FontStyle.Bold)
            Lb(i).Left = TxWidth * i
            Lb(i).Top = 5
            Lb(i).Parent = Me
            Lb(i).Show()
        Next
        Me.Height = Lb(0).Height + 5
        Me.Width = TxWidth * StrLen
        tm.Interval = 80
        tm.Start()
        TmIkuti.Interval = 10
        TmIkuti.Start()
    End Sub

    Private Sub Animasi() Handles tm.Tick
        Lb(pos).Top = 0
        Lb(pos).ForeColor = Color.Red
        Dim pr As Integer = PosMovPrev(pos)
        Lb(pr).Top = 5
        Lb(pr).ForeColor = Color.Black
        PosMoveNext()
    End Sub

    Private Sub IkutiMouse_x() Handles TmIkuti.Tick
        Try
            Me.Left = Control.MousePosition.X - (Me.Width \ 2)
            Me.Top = Control.MousePosition.Y
        Catch ex As Exception

        End Try
    End Sub

    Private Sub PosMoveNext()
        If pos >= (StrLen - 1) Then
            pos = 0
        Else
            pos += 1
        End If
        If Trim(Lb(pos).Text) = "" Then PosMoveNext()
    End Sub
    Private Function PosMovPrev(ByVal n As Integer) As Integer
        If n <= 0 Then
            n = StrLen - 1
        Else
            n -= 1
        End If
        If Trim(Lb(n).Text) = "" Then
            Return PosMovPrev(n)
        Else
            Return n
        End If
    End Function
End Class

2 comments:

lim ronny limena said...

Thanksssss
:)

Mobile App Developers said...

Great article, Thanks for your great information, the content is quiet interesting. I will be waiting for your next post.

Post a Comment