Contoh Penerapan “Properti Teks” dengan Visual Basic 6.0
Contoh sederhana implementasi Properti Teks pada Visual Basic 6.0.
Seperti menerapkan Nama Font, Ukuran Font, Jenis Teks seperti Garis Tebal, Garis Miring, Garis Bawah, Garis Coret, Letak Kalimat seperti Rata Kiri, Rata Tengah, Rata Kanan dan Warna Teks. Dengan menggunakan kontrol Text Box, Label, Button, Option Button, Check Box dan Combo Box untuk mengimplementasikan perintah kejadian pada program.
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "MSCOMCTL.OCX"
Begin VB.Form frmTextProperties
BorderStyle = 1 'Fixed Single
Caption = "Property Teks"
ClientHeight = 5370
ClientLeft = 45
ClientTop = 435
ClientWidth = 11175
BeginProperty Font
Name = "Segoe UI"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form8"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5370
ScaleWidth = 11175
StartUpPosition = 2 'CenterScreen
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 37
Top = 4995
Visible = 0 'False
Width = 11175
_ExtentX = 19711
_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.Frame Frame1
Caption = "Warna Latar Belakang:"
Height = 4815
Index = 5
Left = 4680
TabIndex = 21
Top = 120
Width = 2055
Begin VB.VScrollBar VScroll1
Height = 4215
Index = 2
LargeChange = 30
Left = 1440
Max = 255
TabIndex = 24
Top = 360
Width = 375
End
Begin VB.VScrollBar VScroll1
Height = 4215
Index = 1
LargeChange = 30
Left = 840
Max = 255
TabIndex = 23
Top = 360
Width = 375
End
Begin VB.VScrollBar VScroll1
Height = 4215
Index = 0
LargeChange = 30
Left = 240
Max = 255
TabIndex = 22
Top = 360
Width = 375
End
End
Begin VB.Frame Frame1
Caption = "Rubah Semua Karakter:"
Height = 855
Index = 4
Left = 240
TabIndex = 20
Top = 1920
Width = 4215
Begin VB.PictureBox Picture1
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 0
Left = 360
ScaleHeight = 495
ScaleWidth = 3495
TabIndex = 25
Top = 240
Width = 3495
Begin VB.OptionButton Option3
Caption = "Huruf Kecil"
Enabled = 0 'False
Height = 495
Index = 1
Left = 1920
TabIndex = 27
Top = 0
Width = 1335
End
Begin VB.OptionButton Option3
Caption = "Huruf Besar"
Enabled = 0 'False
Height = 495
Index = 0
Left = 0
TabIndex = 26
Top = 0
Width = 1335
End
End
End
Begin VB.CommandButton Command1
Caption = "Baru"
Enabled = 0 'False
Height = 495
Index = 1
Left = 240
TabIndex = 13
Top = 3480
Width = 4215
End
Begin VB.TextBox Text1
Height = 375
Left = 2160
TabIndex = 0
Top = 300
Width = 2295
End
Begin VB.CommandButton Command1
Caption = "Salin"
Enabled = 0 'False
Height = 495
Index = 0
Left = 240
TabIndex = 2
Top = 2880
Width = 4215
End
Begin VB.CommandButton Command1
Caption = "Keluar"
Height = 495
Index = 3
Left = 240
TabIndex = 3
Top = 4200
Width = 4215
End
Begin VB.Frame Frame1
Caption = "Pilihan:"
Height = 4815
Index = 0
Left = 6840
TabIndex = 4
Top = 120
Width = 4095
Begin VB.Frame Frame1
Caption = "Rata Teks:"
Height = 1575
Index = 3
Left = 2040
TabIndex = 19
Top = 2400
Width = 1815
Begin VB.PictureBox Picture1
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 2
Left = 240
ScaleHeight = 1095
ScaleWidth = 1095
TabIndex = 33
Top = 240
Width = 1095
Begin VB.OptionButton Option2
Caption = "Kanan"
Enabled = 0 'False
Height = 495
Index = 2
Left = 0
TabIndex = 36
Top = 720
Width = 1215
End
Begin VB.OptionButton Option2
Caption = "Tengah"
Enabled = 0 'False
Height = 495
Index = 1
Left = 0
TabIndex = 35
Top = 360
Width = 1215
End
Begin VB.OptionButton Option2
Caption = "Kiri"
Enabled = 0 'False
Height = 495
Index = 0
Left = 0
TabIndex = 34
Top = 0
Width = 1215
End
End
End
Begin VB.ComboBox Combo1
BackColor = &H8000000F&
Enabled = 0 'False
Height = 345
Index = 1
Left = 240
Style = 2 'Dropdown List
TabIndex = 18
Top = 3510
Width = 1695
End
Begin VB.ComboBox Combo1
BackColor = &H8000000F&
Enabled = 0 'False
Height = 345
Index = 0
Left = 240
Style = 2 'Dropdown List
TabIndex = 15
Top = 2720
Width = 1695
End
Begin VB.Frame Frame1
Caption = "Jenis Teks:"
Height = 1935
Index = 2
Left = 2040
TabIndex = 8
Top = 360
Width = 1815
Begin VB.CheckBox Check1
Caption = "Coret"
Enabled = 0 'False
Height = 495
Index = 3
Left = 120
TabIndex = 12
Top = 1320
Width = 1215
End
Begin VB.CheckBox Check1
Caption = "Garis Bawah"
Enabled = 0 'False
Height = 495
Index = 2
Left = 120
TabIndex = 11
Top = 960
Width = 1455
End
Begin VB.CheckBox Check1
Caption = "Miring"
Enabled = 0 'False
Height = 495
Index = 1
Left = 120
TabIndex = 10
Top = 600
Width = 1215
End
Begin VB.CheckBox Check1
Caption = "Tebal"
Enabled = 0 'False
Height = 495
Index = 0
Left = 120
TabIndex = 9
Top = 240
Width = 1215
End
End
Begin VB.Frame Frame1
Caption = "Warna Teks:"
Height = 1935
Index = 1
Left = 240
TabIndex = 7
Top = 360
Width = 1695
Begin VB.PictureBox Picture1
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1575
Index = 1
Left = 240
ScaleHeight = 1575
ScaleWidth = 1095
TabIndex = 28
Top = 240
Width = 1095
Begin VB.OptionButton Option1
Caption = "Kuning"
Enabled = 0 'False
Height = 495
Index = 3
Left = 0
TabIndex = 32
Top = 1080
Width = 1215
End
Begin VB.OptionButton Option1
Caption = "Hijau"
Enabled = 0 'False
Height = 495
Index = 2
Left = 0
TabIndex = 31
Top = 720
Width = 1215
End
Begin VB.OptionButton Option1
Caption = "Merah"
Enabled = 0 'False
Height = 495
Index = 1
Left = 0
TabIndex = 30
Top = 360
Width = 1215
End
Begin VB.OptionButton Option1
Caption = "Biru"
Enabled = 0 'False
Height = 495
Index = 0
Left = 0
TabIndex = 29
Top = 0
Width = 1215
End
End
End
Begin VB.CommandButton Command1
Caption = "Setting Ulang"
Enabled = 0 'False
Height = 495
Index = 2
Left = 240
TabIndex = 6
Top = 4080
Width = 3615
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Ukuran Font:"
Height = 225
Index = 3
Left = 240
TabIndex = 17
Top = 3240
Width = 1020
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Jenis Font:"
Height = 225
Index = 2
Left = 240
TabIndex = 16
Top = 2445
Width = 825
End
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "0 Karakter"
Height = 225
Index = 1
Left = 2160
TabIndex = 14
Top = 720
Width = 780
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Tuliskan nama Anda :"
Height = 225
Index = 0
Left = 240
TabIndex = 5
Top = 360
Width = 1710
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "Segoe UI"
Size = 20.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 240
TabIndex = 1
Top = 1080
Width = 4215
End
End
Attribute VB_Name = "frmTextProperties"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i%
Private Sub Check1_Click(Index As Integer)
With Label2
Select Case Index
Case 0:
.FontBold = Check1(Index).Value
Case 1:
.FontItalic = Check1(Index).Value
Case 2:
.FontUnderline = Check1(Index).Value
Case 3:
.FontStrikethru = Check1(Index).Value
End Select
End With
Command1(2).Enabled = True
End Sub
Private Sub Combo1_Click(Index As Integer)
With Label2
Select Case Index
Case 0:
.FontName = Combo1(Index).Text
Case 1:
.FontSize = Combo1(Index).Text
End Select
End With
Command1(2).Enabled = True
End Sub
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0:
Label2.Caption = Text1.Text
For i = 0 To 1
Option3(i).Enabled = True
Next
Command1(0).Enabled = False
Command1(1).Enabled = True
For i = 0 To 3
Option1(i).Enabled = True
Check1(i).Enabled = True
Next
For i = 0 To 1
Combo1(i).Enabled = True
Combo1(i).BackColor = SystemColorConstants. _
vbWindowBackground
Next
For i = 0 To 2
Option2(i).Enabled = True
Next
Case 1:
Command1(0).Enabled = True
For i = 0 To 1
Option3(i).Enabled = False
Option3(i).Value = False
Next
For i = 1 To 2
Command1(i).Enabled = False
Next
For i = 0 To 3
Option1(i).Value = False
Check1(i).Value = 0
Option1(i).Enabled = False
Check1(i).Enabled = False
Next
For i = 0 To 1
Combo1(i).Enabled = False
Combo1(i).Clear
Combo1(i).BackColor = SystemColorConstants. _
vbButtonFace
Next
Form_Load
For i = 0 To 2
Option2(i).Enabled = False
Option2(i).Value = False
Next
Command1(2).Enabled = False
With Label2
.Caption = Empty
.ForeColor = vbDefault
.FontName = "Tahoma"
.FontSize = 24
.Alignment = 2
End With
With Text1
.Text = Empty
.SetFocus
End With
Case 2:
With Label2
.ForeColor = vbDefault
.FontBold = False
.FontItalic = False
.FontUnderline = False
.FontStrikethru = False
End With
For i = 0 To 3
Option1(i).Value = False
Check1(i).Value = 0
Next
For i = 0 To 1
Combo1(i).Clear
Next
Form_Load
For i = 0 To 2
Option2(i).Value = False
Next
With Label2
.FontName = "Tahoma"
.FontSize = 24
.Alignment = 2
End With
Command1(2).Enabled = False
Case 3:
Dim Respon
Respon = MsgBox("Keluar program ?", _
vbQuestion + vbYesNo, _
"Perhatian")
If Respon = vbYes Then
End
Else
Text1.SetFocus
End If
End Select
End Sub
Private Sub Form_Load()
With Combo1(0)
.AddItem "Arial"
.AddItem "Courier New"
.AddItem "Times New Roman"
End With
With Combo1(1)
.AddItem 18
.AddItem 20
.AddItem 22
.AddItem 24
End With
End Sub
Private Sub Option1_Click(Index As Integer)
With Label2
Select Case Index
Case 0:
.ForeColor = vbBlue
Case 1:
.ForeColor = vbRed
Case 2:
.ForeColor = vbGreen
Case 3:
.ForeColor = vbYellow
End Select
End With
Command1(2).Enabled = True
End Sub
Private Sub Option2_Click(Index As Integer)
With Label2
Select Case Index
Case 0:
.Alignment = 0
Case 1:
.Alignment = 2
Case 2:
.Alignment = 1
Case 3:
.Caption = UCase$(Label2)
Case 4:
.Caption = LCase$(Label2)
End Select
End With
Command1(2).Enabled = True
End Sub
Private Sub Option3_Click(Index As Integer)
With Label2
Select Case Index
Case 0:
.Caption = UCase$(Label2)
Case 1:
.Caption = LCase$(Label2)
End Select
End With
End Sub
Public Sub Rubah_Warna_Latar()
Me.BackColor = RGB(VScroll1(0).Value, _
VScroll1(1).Value, _
VScroll1(2).Value)
For i = 0 To 3
Label1(i).BackColor = RGB(VScroll1(0).Value, _
VScroll1(1).Value, _
VScroll1(2).Value)
Next
For i = 0 To 5
Frame1(i).BackColor = RGB(VScroll1(0).Value, _
VScroll1(1).Value, _
VScroll1(2).Value)
Next
For i = 0 To 3
Option1(i).BackColor = RGB(VScroll1(0).Value, _
VScroll1(1).Value, _
VScroll1(2).Value)
Check1(i).BackColor = RGB(VScroll1(0).Value, _
VScroll1(1).Value, _
VScroll1(2).Value)
Next
For i = 0 To 2
Option2(i).BackColor = RGB(VScroll1(0).Value, _
VScroll1(1).Value, _
VScroll1(2).Value)
Next
For i = 0 To 1
Option3(i).BackColor = RGB(VScroll1(0).Value, _
VScroll1(1).Value, _
VScroll1(2).Value)
Next
Picture1(0).BackColor = RGB(VScroll1(0).Value, _
VScroll1(1).Value, _
VScroll1(2).Value)
End Sub
Private Sub Text1_Change()
If Text1.Text = Empty Then
Command1(0).Enabled = False
Else
Command1(0).Enabled = True
End If
Dim PosisiKarakter As Long
Dim InputKarakter As String
Dim InputSpasi As Integer
PosisiKarakter = 1
InputSpasi = 0
InputKarakter = Text1.Text
If InputKarakter = Empty Then
Label1(1).Caption = "0 Karakter"
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(1).Caption = Len(Text1.Text) - InputSpasi & " karakter"
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Then
Beep
KeyAscii = 0
End If
If (KeyAscii = 13) Then
Command1_Click (0)
End If
End Sub
Private Sub VScroll1_Change(Index As Integer)
Select Case Index
Case 0:
Rubah_Warna_Latar
Case 1:
Rubah_Warna_Latar
Case 2:
Rubah_Warna_Latar
End Select
End Sub
Unduh Kode Sumber
Label: VB6
diposting oleh Guntur Nitiputra @ 01.01.00
0 Komentar
0 Komentar:
Posting Komentar
Berlangganan Posting Komentar [Atom]
<< Beranda