<< Kembali

Efek mengetik

 
Nama Control Properti Value
TextBox Name
Locked
Teks
txtHasil
True
-
TextBox Name
Teks
txtTeks
"Ketikan"
Module Name Module1
CommandButton Name cmdKetik
 

 Copy & paste-kan listing dibawah ini ke Form pada code editor :

 Option Explicit

Public Function Out(Prompt As String, LineSpace As String)
On Error Resume Next 'Jika error lanjutkan
Dim CL As Integer
Dim I As Integer

I = 1 'Tentukan nilai awal I

'Perintah jarak paragraf
Do
DoEvents
'Jika banyak jarak paragraf kurang dari 1 maka
'keluar perulangan jalankan perintah selanjutnya

If LineSpace < 1 Then Exit Do
'Tambahkan paragraf baru
txtHasil.Text = txtHasil.Text & Chr(13) + Chr(10)
CL = CL + 1 'Tambahkan lagi CL-nya
Loop Until CL = LineSpace

'Perintah ketikan
Do
DoEvents 'Memberi kesempatan aplikasi lain untuk tetap berjalan
Delay 10 'Kecepatan ketik
Beep 'Bunyi bios yang dikeluarkan
'Ambil karakter satu persatu sesuai dgn jumlah I

txtHasil.Text = txtHasil.Text & Mid(Prompt, I, 1)
I = I + 1 'Tambahkan lagi I-nya

Loop Until I > Len(Prompt) 'Ulangi sampai I lebih besar dari banyaknya karakter
'Aktifkan kembali tombol

cmdKetik.Enabled = True
End Function

Private Sub cmdKetik_Click()
'Matikan tombol
cmdKetik.Enabled = False
'Panggil fungsi out (teks yg akan ditampilkan, jarak paragraf dgn kalimat sebelumnya)
Out txtTeks.Text, 1
End Sub

 Copy & paste-kan listing dibawah ini ke dalam module :

Option Explicit

Declare Function GetTickCount Lib "kernel32" () As Long

'Fungsi ini menggantikan Timer control
Public Function Delay(wait As Long)
Dim lasttick, currenttick As Long
lasttick = GetTickCount
Do
currenttick = GetTickCount
DoEvents
Loop Until (currenttick - lasttick) > wait
End Function


<< Kembali
Hosted by www.Geocities.ws

1