|
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
|