Menghitung Biaya Dengan Timer

Berikut saya share contoh program untuk menghitung biaya berdasarkan perubahan durasi waktu 30 detik. Dan sangat cocok dikembangkan di dalam pembuatan aplikasi warnet.

Dim Awal, Akhir, Lama As Single
Dim dtkAwal, dtkAkhir As Single
Private Sub Command1_Click()
   If Command1.Caption = "Start" Then
      Text4.Text = 0
      dtkAwal = Time
      Awal = Now
      Text1.Text = Format(Awal, "hh:mm:ss")
      Command1.Caption = "Stop"
   ElseIf Command1.Caption = "Stop" Then
      Timer1.Enabled = False
      Akhir = Now
      Lama = Akhir - Awal
      Text3.Text = Format(Lama, "hh:mm:ss")
      Command1.Caption = "Selesai"
   ElseIf Command1.Caption = "Selesai" Then
      End
  End If
End Sub
Private Sub Timer1_Timer()
If Command1.Caption = "Stop" Then
   dtkAkhir = Time  'dtkAkhir adalah waktu terkini
   If Second(dtkAkhir - dtkAwal) = 30 Then
      dtkAwal = dtkAkhir  'Assignment dtkAkhir ke dtkAwal
      Text4.Text = Format(Text4.Text + 1100, "#,#")  'Update biaya
   End If
   Text2.Text = Format(Now, "hh:mm:ss")
   Text3.Text = Format(Now - Awal, "hh:mm:ss")
End If
End Sub

Read more »

Memanipulasi Text Menggunakan Timer

Berikut sample Memanipulasi Text Menggunakan Timer atau membuat tulisan berjalan dengan visual basic.

Dim awal As Date
Dim Gerak As Boolean
Dim Aksi As Boolean,Angka As Integer
Private Sub MDIForm_Load()
  HrfJalan = "Huruf  Jalan"
  StatusBar1.Panels(4).Text = Time
  Timer2.Enabled = True
  iJam = Format(StatusBar1.Panels(4).Text,"hh:mm:ss")
  ShowWinnerMessage
  Gerak = False
  Aksi = False
  Timer3.Interval = 500
  Timer3.Enabled = True
  awal = Time
End Sub

Private Sub ShowWinnerMessage()
    LblJalan.Visible = True
    Timer1.Enabled = True
    Timer4.Enabled = True
End Sub
--------------------------------------------------
Menampilkan huruf berjalan dari kiri ke kanan
-------------------------------------------------
Private Sub Timer1_Timer()
  LblJalan = HrfJalan
  LblJalan.Left = LblJalan.Left + 2
 'Jika huruf jalan lebih besar dari scala picture 2 maka labejln.left akan meset ke 0
  If LblJalan.Left > Picture2.ScaleWidth Then LblJalan.Left = 0
End Sub
-------------------------------------------------
Menampilkan jam dengan detik berjalan di status bar panel 4
-------------------------------------------------
Private Sub Timer2_Timer()
  With StatusBar1
     .Panels(4).Text = Time
  End With
End Sub
------------------------------------------------
Penhitung waktu, Jika dalam program tidak
terjadi aksi apapun maka program otomatis
akan keluar dengan waktu interval tertentu
-----------------------------------------------
Private Sub Timer3_Timer()
Dim durasi As Date
  Aksi = False
  'Periksa...
  If Aksi = False Then
     Gerak = False
     Timer3.Enabled = True
  Else 'Jika ada perubahan di Mouse_Move
     Gerak = True
     Timer3.Enabled = False
  End If
  'Text1.Text = awal
  'Text2.Text = Time
  'Jika tidak ada pergerakan, aktifkan perhitungan durasi
  If Gerak = False Then
    durasi = Time - awal
    'Dalam contoh ini, jika 5 detik aplikasi tidak
    'mengalami kegiatan, maka langsung keluar...
    If Format(durasi, "hh:mm:ss") = "00:01:05" Then
       'Sebelum keluar, bebaskan semua variabel di form ini
       FormSplash.Show
       Set fMainForm = Nothing
       Unload Me
    End If
  End If
End Sub
--------------------------------------------------------------
Menampilkan text berjalan pada status bar panel 1
--------------------------------------------------------------
Private Sub Timer4_Timer()
  Dim Tulis As String
  Dim pnlX1 As Panel
  Set pnlX1 = StatusBar1.Panels(1)
      Tulis = "User : " + Operator
      Angka = Angka + 1
      pnlX1.Text = TulisJalan(Angka, Tulis, 100)
End Sub
----------------------------------------------------
Fungsi penghitung kalimat untuk teks berjalan dari kanan
---------------------------------------------------
Function TulisJalan(ByRef Hitung As Integer, kalimat As String, panjang As Integer)
    If Hitung = Len(kalimat) + panjang Then
        Hitung = 0
    ElseIf Hitung > Len(kalimat) Then
        TulisJalan = kalimat & Space(Hitung - Len(kalimat))
    Else
        TulisJalan = Mid(kalimat, 1, Hitung)
    End If
End Function

Read more »