JAM ANALOG VB 6

Kalau mau tau langkah-langkahnya dan Source Code, sebagai berikut:


1. Ubah Properti
'Name' Form1 menjadi 'frmMain',
BackColor = Yellow,
BorderStyle = 0,
DrawWidth = 3,
ForeColor = Red,
Height = 3075,
MaxButton = False,
MinButton = False,
StartUpPosition = 2,
Width = 2625.

2. Kemuadian gambar 3 buah jarum jam dengan menggunakan Line Tool (Detik, Menit, Jam) dengan catatan, ketiga line tersebut berada mempunyai titik pusat yang sma. Ganti Properti 'Name'nya menjadi (Linehour,lineMinute,lineSecond). Warnailah jarum jam dengan warna yang berbeda agar terlihat perbedaan antara Jam, Menit dan Detik.

3. Buat sebuah Label di bawah ketiga jarum jam tadi, ganti Properti 'Name'nya menjadi Lbltime dan ubah ForeColor = Red.

4. Masukkan sebuah objek 'Timer',ganti Properti 'Name'nya menjadi tmrClock dan atur Properti 'Intervalnya' = 1

5. Buatlah Label "X" untuk membuat opsi "Keluar", dan isilah ToolTipText dengan "Keluar". Ganti 'Name'nya menjadi "LabelX".

6. Setelah semua objek telah dimasukkan di Design View, lalu klik menu 'View + Code'
kemudian copy paste Source code di bawah ini.

Code:

Option Explicit Private Const pi As Double = 3.14159265358979 Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long Private Declare Function ReleaseCapture Lib "user32" () As Long 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 Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long Private Sub MakeRoundObject(objObject As Object, Value As Long) Static lngHeight, lngLong, lngReturn, lngWidth As Long lngWidth = objObject.Width / Screen.TwipsPerPixelX lngHeight = objObject.Height / Screen.TwipsPerPixelY SetWindowRgn objObject.hWnd, CreateRoundRectRgn(0, 0, lngWidth, lngHeight, Value, Value), True End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyEscape Then App.TaskVisible = False Unload Me End End If End Sub Private Sub Form_Load() Dim intX As Integer Call MakeRoundObject(frmMain, 20) Call tmrClock_Timer For intX = 0 To 360 Step 6 If intX Mod 30 = 0 Then Me.DrawWidth = 6 Me.PSet (1100 * Cos(intX * pi / 180) + lineSecond.X1, 1100 * Sin(intX * pi / 180) + lineSecond.Y1) Else Me.DrawWidth = 3 Me.PSet (1100 * Cos(intX * pi / 180) + lineSecond.X1, 1100 * Sin(intX * pi / 180) + lineSecond.Y1) End If Next intX End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) ReleaseCapture SendMessage Me.hWnd, &HA1, 2, 0& End Sub Private Sub lblTime_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Call Form_MouseDown(Button, Shift, x, y) End Sub Private Sub tmrClock_Timer() Dim dblSecond As Double, dblMinute As Double, dblHour As Double dblSecond = Second(Now) * 6 - 90 dblMinute = (Minute(Now) + Second(Now) / 60) * 6 - 90 dblHour = (Hour(Now) + Minute(Now) / 60) * 30 - 90 lineSecond.X2 = 1000 * Cos(dblSecond * pi / 180) + lineSecond.X1 lineSecond.Y2 = 1000 * Sin(dblSecond * pi / 180) + lineSecond.Y1 lineMinute.X2 = 900 * Cos(dblMinute * pi / 180) + lineMinute.X1 lineMinute.Y2 = 900 * Sin(dblMinute * pi / 180) + lineMinute.Y1 Linehour.X2 = 700 * Cos(dblHour * pi / 180) + Linehour.X1 Linehour.Y2 = 700 * Sin(dblHour * pi / 180) + Linehour.Y1 Lbltime.Caption = Format(Now, "hh:mm:ss") End Sub Private Sub LabelX_Click() End End Sub

Dan selesai lah Jam analog nya dan jika ada kesalahan dalam source silahkan

Pke source yg kedua neh gan

checkidot:

Code:

Private Sub Command1_Click() Unload Me End Sub Private Sub Form_Load() Dim atas As Long Dim hasil As Long Me.Width = 1000 * Screen.TwipsPerPixelX / 2 Me.Height = 1000 * Screen.TwipsPerPixelY / 2 atas = CreateEllipticRgn&(10, 50, 450, 470) hasil = SetWindowRgn(Me.hWnd, atas, True) Left = Screen.Width \ 2 - 4000 Top = (Screen.Height - Height) \ 2 End Sub Private Sub Form_Resize() Dim i, sudut Static flag As Boolean If flag = False Then flag = True End If For i = 0 To 14 Scale (-1, -1)-(1.2, 1) sudut = i * 2 * Atn(1) / 3 Line1.X1 = 3000 Line1.Y1 = 3000 Line1.X2 = Cos(sudut) Line1.Y2 = Sin(sudut) Line2.X1 = 3000 Line2.Y1 = 3000 Line2.X2 = Cos(sudut) Line2.Y2 = Sin(sudut) Line3.X1 = 3000 Line3.Y1 = 3000 Line3.X2 = Cos(sudut) Line3.Y2 = Sin(sudut) Next i End Sub Private Sub Timer1_Timer() Const jam = 0 Const menit = 13 Const detik = 14 Dim sudut Static detiklalu If Second(Now) = detiklalu Then Exit Sub detiklalu = Second(Now) sudut = -0.5236 * (15 - (Hour(Now) + Minute(Now) / 60)) Line1.X1 = 0 Line1.Y1 = 0 Line1.X2 = 0.4 * Cos(sudut) Line1.Y2 = 0.4 * Sin(sudut) sudut = -0.1047 * (75 - (Minute(Now) + Second(Now) / 60)) Line2.X1 = 0 Line2.Y1 = 0 Line2.X2 = 0.5 * Cos(sudut) Line2.Y2 = 0.5 * Sin(sudut) sudut = -0.1047 * (75 - Second(Now)) Line3.X1 = 0 Line3.Y1 = 0 Line3.X2 = 0.6 * Cos(sudut) Line3.Y2 = 0.6 * Sin(sudut) End Sub

NB: untuk Source yg kedua semua nama di default/standar tanpa ada perubahan.