cara membuat Jam Analog

Do you Like this story..?


Get Free Email Updates Daily!	Follow us!

Pada kali ini saya ingin memposting cara membuat Jam Analog , dan sebelum nya saya juga memposting Cara Membuat Jam Digital Dengan VisualBasic . gak Usah basa basi langsung aja Nih Caranya ..

Reduce this image

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