“Procedure Test” dengan Visual Basic 6.0

Percontohan “Procedure Test” yang terdapat pada blog “Yulis Riyadi”.

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         =   "Procedure Test"
   ClientHeight    =   3375
   ClientLeft      =   45
   ClientTop       =   405
   ClientWidth     =   4680
   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     =   3375
   ScaleWidth      =   4680
   StartUpPosition =   2  'CenterScreen
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   5
      Top             =   3000
      Visible         =   0   'False
      Width           =   4680
      _ExtentX        =   8255
      _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.CommandButton Command1 
      Caption         =   "Keluar"
      Height          =   495
      Index           =   3
      Left            =   3000
      TabIndex        =   4
      Top             =   2760
      Width           =   1575
   End
   Begin VB.CommandButton Command1 
      Caption         =   "ByVal"
      Height          =   495
      Index           =   2
      Left            =   1440
      TabIndex        =   3
      Top             =   1920
      Width           =   1815
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Function Test"
      Height          =   495
      Index           =   1
      Left            =   2400
      TabIndex        =   2
      Top             =   1200
      Width           =   1815
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Sub Test"
      Height          =   495
      Index           =   0
      Left            =   360
      TabIndex        =   1
      Top             =   1200
      Width           =   1815
   End
   Begin VB.Line Line1 
      Index           =   0
      X1              =   0
      X2              =   4680
      Y1              =   2640
      Y2              =   2640
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "Label1"
      BeginProperty Font 
         Name            =   "Segoe UI"
         Size            =   27.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   735
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   4215
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00FFFFFF&
      BorderWidth     =   4
      Index           =   1
      X1              =   0
      X2              =   4680
      Y1              =   2640
      Y2              =   2640
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Total As Currency

Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0:
            Tulis_Teks ("Halo")
        Case 1:
            Label1.Caption = "Jumlah : " & Jumlah_Angka()
        Case 2:
            Dim Harga As Currency
            
            Harga = 10000
            Total = 0
            Call Hitung_Diskon(Harga, 0.1)
            MsgBox "Harga " & Harga & " setelah diskon 10% menjadi " & Total
        Case 3:
            Unload Me
    End Select
End Sub

Public Sub Tulis_Teks(teks As String, Optional warna As ColorConstants = vbMagenta)
    With Label1
        .Caption = teks
        .ForeColor = warna
    End With
End Sub

Private Function Jumlah_Angka() As String
    Dim Angka1, Angka2 As String
    Dim Hasil As Single

    Angka1 = InputBox("Tulis Angka 1 :", "Hitung Angka")
    Angka2 = InputBox("Tulis Angka 2 :", "Hitung Angka")
    
    If Angka1 <> Empty And Angka2 <> Empty Then
        Hasil = CSng(Angka1) + CSng(Angka2)
        Jumlah_Angka = CSng(Hasil)
    End If
End Function

Private Sub Hitung_Diskon(ByVal Harga_Awal As Currency, Diskon As Single)
    Harga_Awal = Harga_Awal * (1 - Diskon)
    Total = CCur(Harga_Awal)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If MsgBox("Keluar program ?", vbQuestion + vbYesNo, "Perhatian") = vbNo Then
        Cancel = 1
    End If
End Sub

Private Sub Label1_DblClick()
    Call Tulis_Teks("Hi", vbBlue)
End Sub

Unduh Kode Sumber