Assalamualaikum wr.wb
Saya dulu sempat bingung dan was-was kalo dagangan saya nanti gak laku…maka saya berfikir bagaimana supaya dagangan saya nanti bisa laku walo sedikit incom buat saya.
Nah disini saya akan sampaikan sedikit hiasan untuk program aplikasi yang anda buat supaya pemakai lebih nyaman dan selalu update time and date…
Bagaimana caranya…
1. Buat menu project
Buatlah satu menu project untuk program aplikasi anda sebagai contoh project1.
2. Buat form dan timer
Pada saat buat menu project pasti anda sekaligus akan diminta untuk buat satu form kosong sebagai contoh form1, setelah itu masukkan satu timer kedalam form1 dan beri nama timer1, seperti pada gambar
3. Kode string jam analog cursor
Berikut saya sertakan kode string untuk menampilkan jam analog pada program aplikasi anda :
Kalau tidak ingin report copy paste saja untuk menghidari kekeliruan penulisan.
Private Const LVM_FIRST = &H1000&
Private Const LVM_SETEXTENDEDLISTVIEWSTYLE = (LVM_FIRST + 54)
Private Const LVM_GETEXTENDEDLISTVIEWSTYLE = (LVM_FIRST + 55)
Private Const LVS_EX_GRIDLINES = &H1&
Private Const LVS_EX_SUBITEMIMAGES = &H2&
Private Const LVS_EX_CHECKBOXES = &H4&
Private Const LVS_EX_TRACKSELECT = &H8&
Private Const LVS_EX_HEADERDRAGDROP = &H10&
Private Const LVS_EX_FULLROWSELECT = &H20&
Private Const LVS_EX_ONECLICKACTIVATE = &H40&
Private Const LVS_EX_TWOCLICKACTIVATE = &H80&
Private Const LVS_EX_FLATSB = &H100
Private Const LVS_EX_REGIONAL = &H200
Private Const LVS_EX_INFOTIP = &H400&
Private Const LVS_EX_UNDERLINEHOT = &H800
Dim Ymouse, Xmouse, dy(30), dx(30), Da(30), Mo(30)
Dim Split1, Day1, Year1, Todaysdate, h, m, d, s, Face, Speed, n, scrll
Dim Dsplit, HandHeight, Handwidth, HandX, HandY, Step, currStep
Dim Test, ClockHeight, ClockWidth, ClockFromMouseY, ClockFromMouseX
Dim Fcol, Mcol, Scol, Hcol, Dcol
Dim RG As Integer
‘############
‘By:blog priyantoagoes
‘############
Private Type FL
T(30) As Long
Le(30) As Long
End Type
Dim FL As FL
Private Type HL
T(30) As Long
Le(30) As Long
End Type
Dim HL As HL
Private Type SL
T(30) As Long
Le(30) As Long
End Type
Dim SL As SL
Private Type ML
T(30) As Long
Le(30) As Long
End Type
Dim ML As ML
Private Type DL
T(30) As Long
Le(30) As Long
End Type
Dim DL As DL
Const PI = 3.1415
Private Declare Function GetActiveWindow Lib “user32″ () As Long
Private Declare Function ShellExecute Lib “shell32.dll” Alias “ShellExecuteA” (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Private Sub Timer1_Timer()
dy(0) = dy(0) + (Ymouse – dy(0)) * Speed
dy(0) = Fix(dy(0))
dx(0) = dx(0) + (Xmouse – dx(0)) * Speed
dx(0) = Fix(dx(0))
For i = 1 To Len(d) – 1
dy(i) = dy(i) + (dy(i – 1) – dy(i)) * Speed
dy(i) = Fix(dy(i))
dx(i) = dx(i) + (dx(i – 1) – dx(i)) * Speed
dx(i) = Fix(dx(i))
Next i
secs = Second(Now)
sec = -1.57 + PI * secs / 30
Mins = Minute(Now)
Min = -1.57 + PI * Mins / 30
hr = Hour(Now)
hrs = -1.575 + PI * hr / 6 + PI * Int(Minute(Now)) / 360
For i = 0 To n – 2
FL.T(i) = dy(i) + ClockHeight * Sin(-1.0471 + i * Split1 * PI / 180) + scrll
FL.Le(i) = dx(i) + ClockWidth * Cos(-1.0471 + i * Split1 * PI / 180)
Next i
For i = 0 To Len(h) – 1
HL.T(i) = dy(i) + HandY + (i * HandHeight) * Sin(hrs) + scrll
HL.Le(i) = dx(i) + HandX + (i * Handwidth) * Cos(hrs)
Next i
For i = 0 To Len(m) – 1
ML.T(i) = dy(i) + HandY + (i * HandHeight) * Sin(Min) + scrll
ML.Le(i) = dx(i) + HandX + (i * Handwidth) * Cos(Min)
Next i
For i = 0 To Len(s) – 1
SL.T(i) = dy(i) + HandY + (i * HandHeight) * Sin(sec) + scrll
SL.Le(i) = dx(i) + HandX + (i * Handwidth) * Cos(sec)
Next i
For i = 0 To Len(d) – 1
DL.T(i) = dy(i) + ClockHeight * 1.5 * Sin(currStep + i * Dsplit * PI / 180) + scrll
DL.Le(i) = dx(i) + ClockWidth * 1.5 * Cos(currStep + i * Dsplit * PI / 180)
Next i
currStep = currStep – Step
P
End Sub
Private Function SP(ByVal ST As String, ByVal Nu As Integer, Optional K As Byte = 1) As String
SP = Mid(ST, Nu + 1, K)
End Function
Private Sub P()
Cls
With form1 ‘Nama Form
.FontBold = False
.ForeColor = Dcol
For i = 0 To Len(d) – 1
.CurrentY = DL.T(i)
.CurrentX = DL.Le(i)
Print SP(d, i)
Next i
.ForeColor = Fcol
For i = 0 To n – 1
.CurrentY = FL.T(i)
.CurrentX = FL.Le(i)
If (i = 18 Or i = 20 Or i = 22) Then
Print SP(Face, i, 2)
i = i + 1
Else
Print SP(Face, i, 1)
End If
Next i
.FontBold = True
.ForeColor = Scol
For i = 0 To Len(s) – 1
.CurrentY = SL.T(i)
.CurrentX = SL.Le(i)
Print SP(s, i)
Next i
.ForeColor = Mcol
For i = 0 To Len(m) – 1
.CurrentY = ML.T(i)
.CurrentX = ML.Le(i)
Print SP(m, i)
Next i
.ForeColor = Hcol
For i = 0 To Len(h) – 1
.CurrentY = HL.T(i)
.CurrentX = HL.Le(i)
Print SP(h, i)
Next i
End With
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Ymouse = y + ClockFromMouseY ‘:event.y+ClockFromMouseY;
Xmouse = x + ClockFromMouseX ‘:event.x+ClockFromMouseX;
End Sub
Private Sub Form_Load()
Timer1.Interval = 40
Me.BackColor = &HFFFFC0 ‘&H808080
Dcol = vbGreen
Fcol = vbBlue
Scol = vbYellow
Mcol = vbRed
Hcol = vbBlack
ClockHeight = 600
ClockWidth = 600
ClockFromMouseY = 1200
ClockFromMouseX = 600
Da(1) = “SUNDAY”: Da(2) = “MONDAY”: Da(3) = “TUESDAY”: Da(4) = “WEDNESDAY”
Da(5) = “THURSDAY”: Da(6) = “FRIDAY”: Da(7) = “SATURDAY”
Mo(1) = “JANUARY”: Mo(2) = “FEBRUARY”: Mo(3) = “MARCH”
Mo(4) = “APRIL”: Mo(5) = “MAY”: Mo(6) = “JUNE”: Mo(7) = “JULY”
Mo(8) = “AUGUST”: Mo(9) = “SEPTEMBER”: Mo(10) = “OCTOBER”
Mo(11) = “NOVEMBER”: Mo(12) = “DECEMBER”
Day1 = Day(Now)
Year1 = Year(Now)
If (Year1 < 2000) Then Year1 = Year1 + 1900
Todaysdate = ” ” + Da(Weekday(Now)) + ” ” + Str(Day1) + ” ” + Mo(Month(Now)) + ” ” + Str(Year1)
d = Todaysdate
h = “…”
m = “….”
s = “…..”
Face = “1 2 3 4 5 6 7 8 9 101112 “
form1.Font = “Arial”
form1.FontSize = 9
Speed = 0.6
n = Len(Face) – 2
Ymouse = 0
Xmouse = 0
scrll = 0
Split1 = 360 / n
Dsplit = 360 / Len(d)
HandHeight = ClockHeight / 4.5
Handwidth = ClockWidth / 4.5
HandY = -7
HandX = -2.5
scrll = 0 ’2 * ClockHeight
Step = 0.06
currStep = 0
End Sub
Jangan lupa setelah code anda masukkan untuk disave dan run (F5) untuk mencoba dari data code yang sudah anda buat.
Tolong untuk dicek kembali dari hasil code yang anda masukkan terjadi bug atau nggak…Apabila terjadi bug dan anda mengalami masalah silahkan untuk comen diblog saya ini…insyaallah saya akan bantu.
Selamat mencoba…
semoga bermanfaat…
Wassalamualaikum wr.wb
Link Download Contoh project, [.dll],[.ocx]
| Tweet |
2 komentar:
cursor untuk dimana ya itu???
blog atau komputer???
@zahirah kartini...
Cursor jam analog untuk program aplikasi visualbasic 6.0
Mohon maaf sebelumnya...
Dalam judul konten artikelnya sudah jelas tentang pemrograman visual basic.
Posting Komentar
Say: Berkomentarlah dengan baik dan sopan...dan jangan gunakan SPAM untuk blog ini...Terima kasih [by.admin]