Ryan San Rakagi Moderator
Jumlah posting : 260 Join date : 2011-04-19 Age : 29 Lokasi : CIREBON
| Subject: Cara Membuat Jam Analog VB 6 Tue Dec 06, 2011 12:45 pm | |
| Pada kali ini saya ingin memposting cara membuat Jam Analog alias jam seperti jam dinding menggunakan VB6. Tampilannya sebagai berikut: [You must be registered and logged in to see 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
NB: untuk Source yg kedua semua nama di default/standar tanpa ada perubahan. | |
|
Drw123 Warga Lama
Jumlah posting : 126 Join date : 2011-07-05 Age : 26 Lokasi : Bekasi
| Subject: Re: Cara Membuat Jam Analog VB 6 Tue Dec 06, 2011 1:15 pm | |
| Mantap Deh Bang, Tutornya.... Aku Izin Copas Ke Blog N Bikin Buat ProjectKu Ya... | |
|
Ryan San Rakagi Moderator
Jumlah posting : 260 Join date : 2011-04-19 Age : 29 Lokasi : CIREBON
| Subject: Re: Cara Membuat Jam Analog VB 6 Tue Dec 06, 2011 1:31 pm | |
| - Drw123 wrote:
- Mantap Deh Bang, Tutornya....
Aku Izin Copas Ke Blog N Bikin Buat ProjectKu Ya... Eitz jangan lupa credit's nya ea gan pke nama ane and satu lagi neh ane hari ini belum ketimpuk ama cendol neh gan jadi ane minta cendol nya donk gan ea klo gx ngasih jga gx apa" kq | |
|
Drw123 Warga Lama
Jumlah posting : 126 Join date : 2011-07-05 Age : 26 Lokasi : Bekasi
| Subject: Re: Cara Membuat Jam Analog VB 6 Tue Dec 06, 2011 2:28 pm | |
| Ok, Aku Kasih Cendol... Aku Bikin Sendiri Aja Deh...
Soalnya Itu Ada Yang Eror... Yang Aku Buat Udah Di Fix... | |
|
Ryan San Rakagi Moderator
Jumlah posting : 260 Join date : 2011-04-19 Age : 29 Lokasi : CIREBON
| Subject: Re: Cara Membuat Jam Analog VB 6 Wed Dec 07, 2011 3:05 pm | |
| - Drw123 wrote:
- Ok, Aku Kasih Cendol...
Aku Bikin Sendiri Aja Deh...
Soalnya Itu Ada Yang Eror... Yang Aku Buat Udah Di Fix... Ada yang slah nya dmn gan? wahh harus ada yg di benerin neh biar anggota cmonhack gx sesat trimakasih ea gan atas info nya | |
|
Drw123 Warga Lama
Jumlah posting : 126 Join date : 2011-07-05 Age : 26 Lokasi : Bekasi
| |
Ryan San Rakagi Moderator
Jumlah posting : 260 Join date : 2011-04-19 Age : 29 Lokasi : CIREBON
| Subject: Re: Cara Membuat Jam Analog VB 6 Thu Dec 08, 2011 11:48 am | |
| | |
|
Drw123 Warga Lama
Jumlah posting : 126 Join date : 2011-07-05 Age : 26 Lokasi : Bekasi
| Subject: Re: Cara Membuat Jam Analog VB 6 Sat Dec 10, 2011 6:57 am | |
| Buat Bikin Newtab Aku Sih Bisanya Cuman New Window.... Kalo Bisa Secepatnya ya Bang... Lewat Ok2... | |
|
Ryan San Rakagi Moderator
Jumlah posting : 260 Join date : 2011-04-19 Age : 29 Lokasi : CIREBON
| Subject: Re: Cara Membuat Jam Analog VB 6 Sat Dec 10, 2011 11:37 am | |
| - Drw123 wrote:
- Buat Bikin Newtab
Aku Sih Bisanya Cuman New Window....
Kalo Bisa Secepatnya ya Bang... Lewat Ok2... ane ada'y yg VB 2010 neh gan klo VB 6 ane blum buat neh soal'y msih UAS | |
|
Sponsored content
| Subject: Re: Cara Membuat Jam Analog VB 6 | |
| |
|