Membuat Animasi Teks dengan Visual Basic

Persiapan :

- 1 Form

- 1 buah textbox

- 1 buah label

- 2 buah command button

Option Explicit

Dim Play As Boolean

Sub Sleep(Delay%)

Dim Mulai%

While Mulai < play =" True

Mulai = Mulai + 1

DoEvents

Wend

End Sub

Sub Animasi()

Dim h$, f$, c$, i%, t%, d%

Dim strTemp$, length%

Dim buffLeft$, buffRight$

If Play = False Then Exit Sub

h = Text1

'// Gaya Huruf Besar dan kecil

Label1 = LCase(h)

c = Label1

For i = 1 To Len(h)

Sleep 10000

Mid(c, i, 1) = UCase(Mid(c, i, 1))

Label1 = c

Next i

For i = 1 To Len(h)

Sleep 10000

Mid(c, (Len(h) + 1) - i, 1) = _

LCase(Mid(c, (Len(h) + 1) - i, 1))

Label1 = c

Next i

'// Gaya mengetik

Label1 = "|"

For i = 1 To 5

Sleep 10000

If Label1 = "|" Then

Label1 = " "

Else

Label1 = "|"

End If

Next i

For i = 1 To Len(h)

Sleep 10000

Label1 = Left(h, i) & "|"

Next i

Label1 = Left(Label1, Len(Label1) - 1)

'// Berjalan dari sebelah kiri

Label1 = h

Do

Sleep 22000

Label1 = Mid(Label1, 2, Len(Label1) - 1) & Left(Label1, 1)

DoEvents

Loop Until Label1 = h

'// Berjalan dari sebelah kanan

Label1 = h

Do

Sleep 22000

Label1 = Right(Label1, 1) & Left(Label1, Len(Label1) - 1)

Loop Until Label1 = h

'// Gaya Terbang

t = Label1.Top

Label1.Top = t + 500

While Label1.Top >= t

Sleep 5000

Label1.Top = Label1.Top - 10

Wend

Sleep 12000

'// Gaya Menghilang

Label1.Visible = False

Sleep 15000

Label1.Visible = True

Sleep 17000

'// Gaya ZOOM

'Label1.Alignment = vbCenter

For i = 1 To Label1.FontSize

Sleep 10000

Label1.FontSize = i

Next i

'// Gaya Strip

Label1 = String(Len(h), " ")

f = Label1

For i = 1 To Len(h)

Sleep 8000

c = Mid(h, Len(h) - (i - 1), 1)

Mid(f, Len(f) - (i - 1), 1) = c

Label1 = f

Next i

'// Gaya Blink

For i = 1 To 10

Sleep 12000

If Label1.Visible = True Then

Label1.Visible = False

Else

Label1.Visible = True

End If

Next i

'// Gaya Melompat dan Box

strTemp = Label1

For i = 1 To 2

length = 0

While length <>

Sleep 10000

length = length + 1

If i = 1 Then

Label1 = String(Len(strTemp), " ")

buffLeft = Label1

Mid(buffLeft, length, 1) = Mid(strTemp, length, 1)

Label1 = buffLeft

buffRight = Label1

Mid(buffRight, Len(strTemp) - (length - 1), 1) = _

Mid(strTemp, Len(strTemp) - (length - 1), 1)

Label1 = buffRight

Else

buffLeft = Label1

Mid(buffLeft, length, length) = _

Mid(strTemp, length, length)

Label1 = buffLeft

buffRight = Label1

Mid(buffRight, Len(strTemp) - (length - 1), length) = _

Mid(strTemp, Len(strTemp) - (length - 1), length)

Label1 = buffRight

End If

DoEvents

Wend

Next i

Animasi

End Sub

Private Sub Command1_Click()

If Command1.Caption = "Mulai" Then

Command1.Caption = "Stop"

Text1 = Text1 & " "

Label1 = Text1

Play = True

Else

Command1.Caption = "Mulai"

Play = False

End If

Animasi

End Sub

Private Sub Command2_Click()

End

End Sub

Private Sub Form_Load()

Form1.Caption = "Mainkan Label dengan Berbagai Animasi"

Text1.Text = "Mainkan Label dengan Berbagai Animasi "

Command1.Caption = "Mulai"

Command2.Caption = "Close"

End Sub

Mencari Data dengan VB.NET 2005

Imports System.IO
Imports System.Data.SqlClient
Imports System.Data

Private Sub cmdSearch_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles cmdSearch.Click

Dim s As String
s = "SELECT * FROM TBLBARANG WHERE KodeBarang = B01 "
oTbl = getRecBySQL(s, "TBLBARANG").Tables(0)
grd.DataSource = oTbl

End Sub

Function getRecBySQL(ByVal sSQL As String, ByVal sTblName As String) As DataSet

Dim oconn As New SqlConnection()
oconn.ConnectionString = "Data Source=.\SQLEXPRESS;Initial Catalog=DATAKU;Integrated Security=True"
Dim ocmd As SqlCommand = New SqlCommand(sSQL, oconn)
ocmd.CommandType = CommandType.Text
Dim da As SqlDataAdapter = New SqlDataAdapter(ocmd)
Dim ds As New DataSet()
da.Fill(ds, sTblName)
getRecBySQL = ds

End Function

Membuat koneksi Tanpa Objek

Sebenarnya membuat koneksi database ada beberapa cara, tapi kali ini saya hanya akan membuat koneksi Database access dalam program tanpa menggunakan objek Adodc, caranya dengan menuliskan koding sebagai berikut :

Dim Conn As New ADOB.Connection

Dim RsBarang As ADODB.Recordset

Private Sub Form_Load()

Set Conn = New ADODB.Connection

Set RsBarang = New ADODB.Recordset

Conn.Open “Provider=Microsoft.Jet.OLEDB.4.0; Data Source=” & App.Path & “\DBDasar.Mdb”

End Sub

Ingat : RsBarang adalah nama tabel

: DBDasar.mdb adalah nama database

Koneksi Visual Basic 6 Ke MySQL

Artikel ini hanya akan membahas tentang bagaimana Visual Basic 6 dapat berkomunikasi aplikasi database MySQL.

Buatlah prosedur baru di form MDI anda atau di Module (dan pastikan kalau di Module, prosedur anda adalah Public sehingga dapat dipanggil dari form utama anda). Berikan nama prosedur itu yang mewakili dengan koneksi anda. Misalnya, buat koneksi.
Prosedur yang saya buat adalah sebagai berikut:

Private Sub buat_koneksi()

Dim ConnString As String

Dim db_name As String

Dim db_server As String

Dim db_port As String

Dim db_user As String

Dim db_pass As String

'//error traping

On Error GoTo buat_koneksi_Error

'/isi variable

db_name = "databaseku"

db_server = "localhost" 'ganti jika server anda ada di komputer lain

db_port = "3306" 'default port is 3306

db_user = "root" 'sebaiknya pakai username lain.

db_pass = "password_anda"

'/buat connection string

ConnString = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=" & db_server & ";DATABASE=" & db_name & ";UID=" & db_user & ";PWD=" & db_pass & ";PORT=" & db_port & ";OPTION=3"

'/buka koneksi

With Conn

.ConnectionString = ConnString

.Open

End With

'___________________________________________________________

On Error GoTo 0

Exit Sub

buat_koneksi_Error:

MsgBox "Ada kesalahan dengan server, periksa apakah server sudah berjalan !", vbInformation, "Cek Server"

End Sub

Untuk memanggil prosedur itu, cukup panggil di form utama anda (atau form dimana anda mau memulai koneksi anda) dengan mengetik

call buka_koneksi

atau

buka_koneksi

saja.

Dan jangan lupa untuk membuat object Conn dulu dan biasanya variable Conn ini dibuat secara Public sehingga bisa dipanggil dimana saja. Biasaya saya buat disuatu Module yang isinya adalah koleksi variable Public. Nyatakan variable tersebut dengan menuliskan:

Public Conn As New ADODB.Connection

Dan seperti biasa, ketika anda menutup aplikasi, anda harus menutup dulu koneksi anda ke MySQL. Biasanya prosedur tutup koneksi ini saya taruh di blok MDIForm_Unload.

If Conn.State = adStateOpen Or Conn.State = adStateConnecting Then

Conn.Close

Set Conn = Nothing

End If

Nah, itu bagian pertama dalam membuat aplikasi Visual Basic 6 dan MySQL, untuk selanjutnya kita akan berdiskusi tentang cara membuka tabel-tabel yang ada di MySQL.

Dipublish Oleh : Edisusanto.com

Form Kontak

Your Name :
Your Email :
Subject :
Message :
Image (case-sensitive):

Efek-Efek penutupn Form

==> Form Efek Lari

Private Sub EfekLari()

Dim intTop As Integer

Dim intScreenH As Integer

‘Mendapatkan Tinggi Layar

intScreenH = Screen.Height

for intTop = Me.Top to intScheenH

‘increase Top sehingga bergerak ke bawah

Me.Top = Me.Top + 1

‘ Selesaikan Proses yang mengantri

DoEvents

Next intTop

‘Unload Form

Unlod me

End Sub

==> Form Efek Lipat ke Dalam

Private Sub EfekLipatKedalam()

Dim intHeight As Integer

Dim i As Integer

‘Mencari titik tengah vertikal

intHeight = Me.Height \ 2

for i = to intHeight

DoEvents

Me.Height = Me.Height – 100

‘Set nilai Top (hasil pengurangan)

Me.Top = (Screen.Height – Me.Height) \ 2

‘Height=500 berarti tinggal title bar

If Me.Height <= 500 Then Exit For

Next i

End Sub

==> Form Efek Hancur/Acak

Private Sub Efekhancur()

Dim i As Integer, intDown As Integer

Dim intAcross As Integer

‘Memaksimalkan Form, agar lebih kelihatan

Me.WindowState = 2

‘Perbesar Ukuran Titik

DrawWidht = 3

For I = 1 To 20000

IntDown = IntDown + 1

IntAcross = intAcross + 1

‘Menggambar titik (berwarna) acak

Pset (Rnd*IntAcross, Rnd*IntDown,QBColor(Rnd*15)

Next i

End Sub

Konfersi Angka Ke Huruf (Terbilang) dengan VB

=> Konfersi Angka ke Bilangan

Function Num2Word(ByVal n As Currency) As String

Dim Satuan As Variant

Satuan = Array("", "Satu", "Dua", "Tiga", "Empat", "Lima", "Enam", "Tujuh", "Delapan", "Sembilan", "Sepuluh", "Sebelas")

Select Case n

Case 0 To 11

Num2Word = " " + Satuan(Fix(n))

Case 12 To 19

Num2Word = Num2Word(n Mod 10) + " Belas"

Case 20 To 99

Num2Word = Num2Word(Fix(n / 10)) + " Puluh" + Num2Word(n Mod 10)

Case 100 To 199

Num2Word = " Seratus" + Num2Word(n - 100)

Case 200 To 999

Num2Word = Num2Word(Fix(n / 100)) + " Ratus" + Num2Word(n Mod 100)

Case 1000 To 1999

Num2Word = " Seribu" + Num2Word(n - 1000)

Case 2000 To 999999

Num2Word = Num2Word(Fix(n / 1000)) + " Ribu" + Num2Word(n Mod 1000)

Case 1000000 To 999999999

Num2Word = Num2Word(Fix(n / 1000000)) + " Juta" + Num2Word(n Mod 1000000)

Case Else

Num2Word = Num2Word(Fix(n / 1000000000)) + " Milyar" + Num2Word(n Mod 1000000000)

End Select

End Function

Private Sub Command1_Click()

Text1.Text = Val(Text2.Text) * Val(Text3.Text)

End Sub

Private Sub Text1_Change()

On Error Resume Next

If Text1.Text <> "" Then Label1.Caption = Num2Word(Text1.Text) + " Rupiah" Else Label1.Caption = ""

End Sub

Memindahkan File Dari Satu Folder ke Folder Lain Dangan VB

== > Memindahkan File Dari Satu Folder ke Folder Lain Dangan VB

Ketik coding berikut ini pada Module.

Declare Function MoveFile Lib "kernel32" Alias _ "MoveFileA" (ByVal lpExistingFileName As String, _

ByVal lpNewFileName As String) As Long

Ketik coding berikut ini pada Form.

Private Sub Command1_Click()

'Contoh ini memindahkan file 'c:\MyFile.Zip' ke ‘direktori 'c:\MyDir'.

A = MoveFile("c:\MyFile.Zip", "c:\MyDir\MyFile.Zip")

If A Then

MsgBox "File berhasil dipindahkan!",vbInformation, "Sukses Pindah File"
Else

MsgBox "Error. File belum dipindahkan!" & Chr(13) & "Kemungkinan file asal tidak ada" & _ Chr(13) & "atau file sudah ada di dalam " & _ Chr(13) & "direktori tujuan!", vbCritical, "Gagal _ Pindah File"

End If

End Sub

Animasi Teks dengan VB

==> Animasi Teks

Private intCount As Integer

Private Const TEKS As String =_

“By @Illank Dunia Script”

Private Sub Form_Load()

‘Inisialisasi Counter

IntCount = 0

Me.tmr.Enabled = True

End Sub

Private Sub tmr_Timer()

‘Reset counter jika lebih dari panjang teks

If IntCount > Len(TEKS) then IntCount = -1

‘Increment Counter

IntCount = IntCount + 1

‘Tampilkan Teks Satu Persatu (Karakter)

‘dimulai dari karakter paling depan

Me.Caption = Mid$(TEKS, 1, IntCount)

End Sub

Menghitung Lembur Berdasarkn Detik

==>Menghitung Lembur Berdasarkan Detik

Dim totaldetik As Long

Dim hh, mm, ss As Integer
Dim tampungdetik As Long

Private Sub cmdMulai_Click()
Timer1.Enabled = True

txtAwalLembur.Text = Time

txtDurasiPertama.Text = Format(CDate("23:59:59") _ - CDate(txtAwalLembur) + CDate("00:00:01"), _
"hh:mm:ss")

'Ditambah satu detik karena belum bulat ke 24:00:00 'dan angka 24:00:00 tsb tidak valid utk Time

txtTglMulai.Text = Format(Date, "dd/mm/yyyy")

txtTglEsok.Text = Format(Date + 1, "dd/mm/yyyy")txtDurasiKedua.Text = 0

txtTampungDetik.Text = 0
cmdMulai.Enabled = False
cmdStop.Enabled = True

End Sub

Private Sub cmdStop_Click()
Timer1.Enabled = False
Timer2.Enabled = False
cmdStop.Enabled = False
cmdMulai.Enabled = True
End Sub

Private Sub Timer1_Timer()

txtTglSistem.Text = Format(Date, "dd/mm/yyyy") txtJamSistem.Text = Time

If txtJamSistem.Text = "00:00:00" Then

txtDurasiLembur.Text = Format(CDate("23:59:59") _ - CDate(txtAwalLembur) + CDate("00:00:01"), _
"hh:mm:ss")

Else

txtDurasiLembur.Text = Format((CDate(txtJamSistem.Text) - CDate(txtAwalLembur.Text)), "hh:mm:ss")

End If

If CDate(txtAwalLembur) = CDate(txtJamSistem) Then
txtTampungDetik.Text = 0

End If

If CDate(txtTglSistem) = CDate(txtTglEsok) Then
txtTglEsok.Text = Date + 1

txtTotalDetik.Text = Format(totaldetik + 1,"0,0")

txtTampungDetik.Text = totaldetik + 1, Timer1.Enabled = False

Timer2.Enabled = True
End If

hh = Hour(txtDurasiLembur)

mm = Minute(txtDurasiLembur)

ss = Second(txtDurasiLembur)

totaldetik = hh * 3600 + mm * 60 + ss

txtTotalDetik.Text = Format(totaldetik, "0,0")

txtBesarUang.Text = Format(txtTotalDetik *100,"0,0")

txtDurasiKedua.Text = Format(Val(txtTotalDetik)- Val(txtTampungDetik), "0,0")

End Sub

Private Sub Timer2_Timer()

txtTglSistem.Text = Format(Date, "dd/mm/yyyy") txtJamSistem.Text = Time

If txtJamSistem.Text = "00:00:00" Then

txtDurasiLembur.Text = Format(CDate("23:59:59") _ - CDate(txtAwalLembur) + CDate("00:00:01"), _
"hh:mm:ss")

Else

txtDurasiLembur.Text = Format(CDate(txtJamSistem.Text) _
+ CDate(txtDurasiPertama.Text) - _
CDate("00:00:00"), "hh:mm:ss")
End If

If CDate(txtAwalLembur) = CDate(txtJamSistem) Then
txtTampungDetik.Text = 0

End If

If CDate(txtTglSistem) = CDate(txtTglEsok) Then
txtTglEsok.Text = Date + 1

txtTotalDetik.Text = Format(totaldetik, "0,0") txtTampungDetik.Text = totaldetik + 1
Timer2.Enabled = False

Timer1.Enabled = True

End If

hh = Hour(txtDurasiLembur)

mm = Minute(txtDurasiLembur)

ss = Second(txtDurasiLembur)

totaldetik = hh * 3600 + mm * 60 + ss

txtTotalDetik.Text = Format(totaldetik, "0,0")

txtBesrUang.Text = Format(txtTotalDetik * 100, - "0,0")

txtDurasiKedua.Text = Format(Val(txtTotalDetik) -Val(txtTampungDetik), "0,0")

End Sub