“Penanganan TextBox” dengan Visaul Basic 6.0
Percontohan “Penanganan TextBox” yang terdapat pada blog “Tutorial, Tips dan Trik Seputar IT”.
Tidak ada modifikasi yang dibuat. Untuk lebih lengkapnya dapat dilihat pada kode sumber yang disertakan.
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Masukan TextBox"
ClientHeight = 7455
ClientLeft = 45
ClientTop = 405
ClientWidth = 4590
BeginProperty Font
Name = "Segoe UI"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7455
ScaleWidth = 4590
StartUpPosition = 2 'CenterScreen
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 18
Top = 7080
Visible = 0 'False
Width = 4590
_ExtentX = 8096
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 5
Left = 240
TabIndex = 11
Top = 5400
Width = 4095
End
Begin VB.CommandButton Command1
Caption = "K&eluar"
Height = 495
Index = 1
Left = 3120
TabIndex = 13
Top = 6840
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "Bersihkan Semua TextBox"
Height = 495
Index = 0
Left = 240
TabIndex = 12
Top = 6000
Width = 4095
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 4
Left = 240
TabIndex = 9
Top = 4440
Width = 4095
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 3
Left = 240
TabIndex = 7
Top = 3480
Width = 4095
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 2
Left = 240
TabIndex = 5
Top = 2520
Width = 4095
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 1
Left = 240
TabIndex = 3
Top = 1560
Width = 4095
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 0
Left = 240
TabIndex = 1
Top = 600
Width = 4095
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "(Ketik ""abc"" untuk keluar)"
BeginProperty Font
Name = "Segoe UI"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 10
Left = 2160
TabIndex = 19
Top = 5140
Width = 2085
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Validasi:"
Height = 255
Index = 9
Left = 240
TabIndex = 10
Top = 5040
Width = 720
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "0 Huruf 0 Spasi"
BeginProperty Font
Name = "Segoe UI"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 8
Left = 2520
TabIndex = 17
Top = 3920
Width = 1725
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "0 Huruf 0 Spasi"
BeginProperty Font
Name = "Segoe UI"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 7
Left = 2520
TabIndex = 16
Top = 2960
Width = 1725
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "0 Huruf 0 Spasi"
BeginProperty Font
Name = "Segoe UI"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 6
Left = 2520
TabIndex = 15
Top = 1995
Width = 1725
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "0 Angka"
BeginProperty Font
Name = "Segoe UI"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 5
Left = 2880
TabIndex = 14
Top = 1040
Width = 1365
End
Begin VB.Line Line1
Index = 0
X1 = 0
X2 = 4560
Y1 = 6720
Y2 = 6720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Hanya Karater tertentu:"
Height = 255
Index = 4
Left = 240
TabIndex = 8
Top = 4080
Width = 2025
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Hanya Huruf Kecil:"
Height = 255
Index = 3
Left = 240
TabIndex = 6
Top = 3120
Width = 1590
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Hanya Huruf Besar:"
Height = 255
Index = 2
Left = 240
TabIndex = 4
Top = 2160
Width = 1665
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Hanya Huruf:"
Height = 255
Index = 1
Left = 240
TabIndex = 2
Top = 1200
Width = 1125
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Hanya Numerik/Angka:"
Height = 255
Index = 0
Left = 240
TabIndex = 0
Top = 240
Width = 1995
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
BorderWidth = 4
Index = 1
X1 = 0
X2 = 4560
Y1 = 6720
Y2 = 6720
End
Begin VB.Menu menu_klik_kanan
Caption = "Menu"
Visible = 0 'False
Begin VB.Menu menu_klik_kanan_potong
Caption = "Potong"
End
Begin VB.Menu menu_klik_kanan_salin
Caption = "Salin"
End
Begin VB.Menu menu_klik_kanan_tempel
Caption = "Tempel"
End
Begin VB.Menu menu_klik_kanan_hapus
Caption = "Hapus"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const WM_RBUTTONDOWN = &H204
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Public Sub OpenContextMenu(FormName As Form, menuName As Menu)
Call SendMessage(FormName.hwnd, WM_RBUTTONDOWN, 0, 0&)
FormName.PopupMenu menuName
End Sub
Private Sub Command1_Click(index As Integer)
Select Case index
Case 0:
Dim Kontrol As Control
For Each Kontrol In Form1.Controls
If (TypeOf Kontrol Is TextBox) Then Kontrol.Text = Empty
Next Kontrol
Text1(0).SetFocus
Case 1:
Unload Me
End Select
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("Keluar program ?", vbQuestion + vbYesNo, "Perhatian") _
= vbNo Then
Cancel = 1
Text1(0).SetFocus
End If
End Sub
Private Sub Text1_Change(index As Integer)
Dim PosisiKarakter As Long
Dim InputKarakter As String
Dim InputSpasi As Integer
Select Case index
Case 0:
'menghitung banyaknya karakter ketika mengetik
PosisiKarakter = 1
InputSpasi = 0
InputKarakter = Text1(index).Text
If InputKarakter = Empty Then
Label1(5).Caption = "0 Angka"
ElseIf Len(InputKarakter) > 0 Then
Do While PosisiKarakter > 0
PosisiKarakter = InStr(PosisiKarakter, _
InputKarakter, " ")
If PosisiKarakter > 0 Then
While Mid(InputKarakter, PosisiKarakter, 1) = " "
PosisiKarakter = PosisiKarakter + 1
InputSpasi = InputSpasi + 1
Wend
End If
Loop
Label1(5).Caption = Len(Text1(index).Text) - _
InputSpasi & " Angka"
End If
Case 1:
'merubah huruf pertama pengetikan dan setelah _
spasi menjadi huruf besar
Dim Masukan%
Masukan = Text1(index).SelStart
Text1(index).Text = StrConv(Text1(index).Text, vbProperCase)
Text1(index).SelStart = Masukan
'menghitung banyaknya karakter ketika mengetik
PosisiKarakter = 1
InputSpasi = 0
InputKarakter = Text1(index).Text
If InputKarakter = Empty Then
Label1(6).Caption = "0 Huruf 0 Spasi"
ElseIf Len(InputKarakter) > 0 Then
Do While PosisiKarakter > 0
PosisiKarakter = InStr(PosisiKarakter, InputKarakter, " ")
If PosisiKarakter > 0 Then
While Mid(InputKarakter, PosisiKarakter, 1) = " "
PosisiKarakter = PosisiKarakter + 1
InputSpasi = InputSpasi + 1
Wend
End If
Loop
Label1(6).Caption = Len(Text1(index).Text) - _
InputSpasi & " Huruf " & _
InputSpasi & " Spasi"
End If
Case 2:
'menghitung banyaknya karakter ketika mengetik
PosisiKarakter = 1
InputSpasi = 0
InputKarakter = Text1(index).Text
If InputKarakter = Empty Then
Label1(7).Caption = "0 Huruf 0 Spasi"
ElseIf Len(InputKarakter) > 0 Then
Do While PosisiKarakter > 0
PosisiKarakter = InStr(PosisiKarakter, InputKarakter, " ")
If PosisiKarakter > 0 Then
While Mid(InputKarakter, PosisiKarakter, 1) = " "
PosisiKarakter = PosisiKarakter + 1
InputSpasi = InputSpasi + 1
Wend
End If
Loop
Label1(7).Caption = Len(Text1(index).Text) - _
InputSpasi & " Huruf " & _
InputSpasi & " Spasi"
End If
Case 3:
'menghitung banyaknya karakter ketika mengetik
PosisiKarakter = 1
InputSpasi = 0
InputKarakter = Text1(index).Text
If InputKarakter = Empty Then
Label1(8).Caption = "0 Huruf 0 Spasi"
ElseIf Len(InputKarakter) > 0 Then
Do While PosisiKarakter > 0
PosisiKarakter = InStr(PosisiKarakter, InputKarakter, " ")
If PosisiKarakter > 0 Then
While Mid(InputKarakter, PosisiKarakter, 1) = " "
PosisiKarakter = PosisiKarakter + 1
InputSpasi = InputSpasi + 1
Wend
End If
Loop
Label1(8).Caption = Len(Text1(index).Text) - _
InputSpasi & " Huruf " & _
InputSpasi & " Spasi"
End If
End Select
End Sub
Private Sub Text1_GotFocus(index As Integer)
'memilih semua karakter di textbox
Select Case index
Case 0:
With Text1(index)
.SelStart = 0
.SelLength = Len(Text1(index))
End With
Case 1:
With Text1(index)
.SelStart = 0
.SelLength = Len(Text1(index))
End With
Case 2:
With Text1(index)
.SelStart = 0
.SelLength = Len(Text1(index))
End With
Case 3:
With Text1(index)
.SelStart = 0
.SelLength = Len(Text1(index))
End With
Case 4:
With Text1(index)
.SelStart = 0
.SelLength = Len(Text1(index))
End With
End Select
End Sub
Private Sub Text1_KeyPress(index As Integer, KeyAscii As Integer)
Dim Karakter$
Karakter = "~`!@#$%^&*()-_+=[]{}:;'<>,.?/\|"
Select Case index
Case 0:
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or _
KeyAscii = 13 Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
End If
'tombol enter berfungsi seperti tombol tab
If (KeyAscii = 13) Then
SendKeys "{tab}"
KeyAscii = 0
End If
Case 1:
If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Then
Beep
KeyAscii = 0
End If
If InStr(1, Karakter, Chr(KeyAscii)) > 0 Then
KeyAscii = 0
End If
If (KeyAscii = 13) Then
SendKeys "{tab}"
KeyAscii = 0
End If
Case 2:
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Then
Beep
KeyAscii = 0
End If
If InStr(1, Karakter, Chr(KeyAscii)) > 0 Then
KeyAscii = 0
End If
If (KeyAscii = 13) Then
SendKeys "{tab}"
KeyAscii = 0
End If
Case 3:
KeyAscii = Asc(LCase(Chr(KeyAscii)))
If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Then
Beep
KeyAscii = 0
End If
If InStr(1, Karakter, Chr(KeyAscii)) > 0 Then
KeyAscii = 0
End If
If (KeyAscii = 13) Then
SendKeys "{tab}"
KeyAscii = 0
End If
Case 4:
If Not InStr(1, Karakter, Chr(KeyAscii)) > 0 Then
KeyAscii = 0
End If
End Select
End Sub
Private Sub Text1_MouseDown(index As Integer, Button As Integer, _
Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then Call OpenContextMenu(Me, _
Me.menu_klik_kanan)
End Sub
Private Sub Text1_Validate(index As Integer, Cancel As Boolean)
Select Case index
Case 5:
Cancel = Text1(5).Text <> "abc"
End Select
End Sub
Unduh Kode Sumber
Label: VB6
diposting oleh Guntur Nitiputra @ 00.30.00
0 Komentar
0 Komentar:
Posting Komentar
Berlangganan Posting Komentar [Atom]
<< Beranda