Membuat jam melayang

Membuat jam melayang

Belakangan ini iparengan.com mengupdate hampir seluruh aplikasi premiumnya dengan tampilan yang segar dan kekinian namun tetap meningkatkan kualitas serta kepuasan pengguna sehingga kami tetap menjadi salah satu Developer pelopor dalam visual basic editor. Ada saatnya pembangunan aplikasi profesional tidak melulu mengejar fungsi fungsi utama dan mengabaikan tampilan sehingga terbentuklah satu aplikasi ang fungsionalis akan tetapi membosankan, terkadang anda juga akan menjumpai interface yang dibuat ala kadarnya ala jadinya ala selesainya shingga jadilah satu aplikasi yang kurang sedap dipandang. Andai semua pengembang tidak memperhatikan interface maka sudah pasti tampilan windows XP tidak akan membuat kita bosan dan microsoft tidak perlu capek capek menciptakan windows 10 yang menurut saya hanya menang tampilan dibandingkan dengan windows 7. Berawal dari itu semua mari kita mencoba membuat sesuatu yang baik dalam fungsi serta baik dari interface aplikasi.

Membuat jam melayang

Saya akan hentikan ocehan, untuk memperindah tampilan lembar kerja microsoft excel ada baiknya anda menambahkan jam dinding dalam lembar kerja microsoft excel anda, dengan begitu anda tidak perlu lagi rebutan menengok jam dinding yang dipajang pada tembok ruangan anda. Bagaimana caranya simak baik baik
+ Pastikan waktu yang ada dikomputer anda sesuai dengan jam yang ada ditempat kerja anda
+ Buka microsoft excel save as enabled macro
+ Buka jendela VBE dengan cara tekan tombol Alt + F11 pada keyboard anda
+ Insert Userform , seret kontrol Image , gunakan background jam dibawah ini



+ Ketikan baris kode macro dibawah ini kedalam userform
Private nempeldinding As Jamdinding
'sssss

Private Sub UserForm_Initialize()

Dim lngMinute As Long
Dim lngHour As Long

lngHour = Hour(Now())
lngMinute = Minute(Now())

Set nempeldinding = New Jamdinding
With nempeldinding
Set .Parent = Me
.OffsetX = Image1.Left
.OffsetY = Image1.Top
.OriginX = Image1.Width / 2
.OriginY = Image1.Height / 2
.Radius(enumClockHourHand) = Image1.Width / 4
.Radius(emnuClockMinuteHand) = Image1.Width / 3
.Color(enumClockHourHand) = RGB(50, 50, 255)
.Color(emnuClockMinuteHand) = RGB(50, 50, 255)
.SetTime = Now
End With

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set nempeldinding = Nothing
Me.Hide
End Sub
+ Buat Class Module dengan nama Jamdinding , lalu ketikan satu persatu kode macro ini
Option Explicit
Public Enum enumClock
enumClockHourHand = 1
emnuClockMinuteHand = 2
End Enum
Private Const PI = 3.14159265358979
Private Const mHOUR_PREFIX = "HrHand"
Private Const mMINUTE_PREFIX = "MnHand"
Public Parent As Object
Private m_GudangOrg As Single
Private m_KasirOrg As Single
Private m_iparengan As Single
Private m_ExcelVba As Single
Private m_Wrna1 As Collection
Private m_Wrna2 As Collection
Private m_Lengkok1() As Single
Private m_Lengkok2() As Single
Private m_datTime As Date
Public Property Let Color(Hand As enumClock, RHS As Long)
Dim lngItem As Long

If Hand = enumClockHourHand Then
For lngItem = 1 To m_Wrna1.Count
m_Wrna1.Item(lngItem).ForeColor = RHS
Next
Else
For lngItem = 1 To m_Wrna2.Count
m_Wrna2.Item(lngItem).ForeColor = RHS
Next
End If

End Property

Public Function GetTime() As Date
GetTime = m_datTime
End Function

Private Function m_AdjustTime(StartTime As Date, NewHour As Long, NewMinute As Long) As Date

m_AdjustTime = DateSerial(Year(StartTime), Month(StartTime), Day(StartTime)) + _
TimeSerial(NewHour, NewMinute, 0)

End Function

Public Property Let SetHour(ByVal RHS As Long)
m_datTime = m_AdjustTime(m_datTime, RHS, Minute(m_datTime))

m_DrawHand m_datTime

End Property

Public Property Get IsPM() As Boolean
IsPM = Hour(m_datTime) >= 12
End Property

Public Property Let SetMinute(ByVal RHS As Long)

If RHS >= 60 Or RHS < 0 Then RHS = 0 m_datTime = m_AdjustTime(m_datTime, Hour(m_datTime), RHS) m_DrawHand m_datTime End Property Public Property Get GetHour() As Long GetHour = Hour(m_datTime) End Property Private Function m_CalcAngle(OriginX As Single, OriginY As Single, Radius As Single, X As Single, Y As Single) As Single If Y = OriginY Then If X < OriginX Then m_CalcAngle = 180 Else m_CalcAngle = 0 End If ElseIf Y < OriginY Then m_CalcAngle = 4.71238898 - Atn((X - OriginX) / (Y - OriginY)) Else m_CalcAngle = 1.570796327 - Atn((X - OriginX) / (Y - OriginY)) End If End Function Private Sub m_DrawHand(DisplayTime As Date) Dim lngItem As Long Dim sngDegAngle As Single Dim sngRadAngle As Single Dim lngHour As Long Dim lngMinute As Long lngHour = Hour(DisplayTime) lngMinute = Minute(DisplayTime) sngDegAngle = (360 / 12) * lngHour sngDegAngle = sngDegAngle + ((360 / 12 / 60) * lngMinute) sngRadAngle = (sngDegAngle - 90) * (PI / 180) For lngItem = 1 To m_Wrna1.Count With m_Wrna1.Item(lngItem) .Left = m_iparengan + (m_GudangOrg + (Cos(sngRadAngle) * m_Lengkok1(lngItem))) - (m_Wrna1.Item(lngItem).Width / 2) .Top = m_ExcelVba + (m_KasirOrg + (Sin(sngRadAngle) * m_Lengkok1(lngItem))) - (m_Wrna1.Item(lngItem).Height / 2) End With Next sngDegAngle = (360 / 60) * lngMinute sngRadAngle = (sngDegAngle - 90) * (PI / 180) For lngItem = 1 To m_Wrna2.Count With m_Wrna2.Item(lngItem) .Left = m_iparengan + (m_GudangOrg + (Cos(sngRadAngle) * m_Lengkok2(lngItem))) - (m_Wrna2.Item(lngItem).Width / 2) .Top = m_ExcelVba + (m_KasirOrg + (Sin(sngRadAngle) * m_Lengkok2(lngItem))) - (m_Wrna2.Item(lngItem).Height / 2) End With Next DoEvents End Sub Public Property Get GetMinute() As Long GetMinute = Minute(m_datTime) End Property Public Property Let OriginX(RHS As Single) m_GudangOrg = RHS End Property Public Property Let OffsetX(RHS As Single) m_iparengan = RHS End Property Public Property Let OffsetY(RHS As Single) m_ExcelVba = RHS End Property Public Property Let OriginY(RHS As Single) m_KasirOrg = RHS End Property Public Property Let Radius(Hand As enumClock, RHS As Single) Dim labTemp As MSForms.Label Dim sngRadius As Single Dim lngItem As Long Dim colTemp As Collection Dim strPrefix As String Dim sngTempRadius() As Single If Hand = enumClockHourHand Then Set colTemp = m_Wrna1 strPrefix = mHOUR_PREFIX Else Set colTemp = m_Wrna2 strPrefix = mMINUTE_PREFIX End If sngRadius = RHS Do While sngRadius > 0
Set labTemp = Parent.Controls.Add("Forms.Label.1", strPrefix & colTemp.Count + 1)
With labTemp
.Caption = "."
.Font.Size = 30
.BackStyle = fmBackStyleTransparent
.TextAlign = fmTextAlignCenter
.AutoSize = True
.ForeColor = vbGreen
End With
lngItem = lngItem + 1
ReDim Preserve sngTempRadius(lngItem) As Single
sngTempRadius(lngItem) = sngRadius
colTemp.Add labTemp, CStr(colTemp.Count + 1)
sngRadius = sngRadius - 2
Loop

If Hand = enumClockHourHand Then
Set colTemp = m_Wrna1
strPrefix = mHOUR_PREFIX
m_Lengkok1 = sngTempRadius
Else
Set colTemp = m_Wrna2
strPrefix = mMINUTE_PREFIX
m_Lengkok2 = sngTempRadius
End If

End Property
Public Property Let SetTime(RHS As Date)

m_datTime = m_AdjustTime(RHS, Hour(RHS), Minute(RHS))

Me.SetHour = Hour(m_datTime)
Me.SetMinute = Minute(m_datTime)

End Property
Public Sub UpdateHand(Hand As enumClock, X As Single, Y As Single, PM As Boolean)

Dim lngItem As Long
Dim sngDegAngle As Single
Dim sngRadAngle As Single
Dim lngPreviousHour As Long
Dim lngPreviousMinute As Long
Dim lngHour As Long
Dim lngMinute As Long

If Y = m_KasirOrg Then
If X < m_GudangOrg Then sngRadAngle = 180 * (PI / 180) Else sngRadAngle = 0 End If ElseIf Y < m_KasirOrg Then sngRadAngle = 4.71238898 - Atn((X - m_GudangOrg) / (Y - m_KasirOrg)) Else sngRadAngle = 1.570796327 - Atn((X - m_GudangOrg) / (Y - m_KasirOrg)) End If sngDegAngle = (sngRadAngle * (180 / PI)) Select Case sngDegAngle Case Is >= 270
sngDegAngle = sngDegAngle - 270
Case Else
sngDegAngle = sngDegAngle + 90
End Select

If Hand = enumClockHourHand Then
lngHour = CLng(sngDegAngle / (360 / 12) - 0.5)
lngMinute = CLng((sngDegAngle - ((360 / 12) * lngHour)) / (360 / 12 / 60))
If PM Then
lngHour = lngHour + 12
End If
Else
lngMinute = CLng(sngDegAngle / (360 / 60))
lngHour = Me.GetHour
End If

Me.SetMinute = lngMinute
Me.SetHour = lngHour

End Sub
Private Sub Class_Initialize()

Set m_Wrna1 = New Collection
Set m_Wrna2 = New Collection

End Sub

Private Sub Class_Terminate()

Do While m_Wrna1.Count > 0
Parent.Controls.Remove mHOUR_PREFIX & m_Wrna1.Count
m_Wrna1.Remove m_Wrna1.Count
Loop
Set m_Wrna1 = Nothing

Do While m_Wrna2.Count > 0
Parent.Controls.Remove mMINUTE_PREFIX & m_Wrna2.Count
m_Wrna2.Remove m_Wrna2.Count
Loop
Set m_Wrna2 = Nothing

End Sub
+ Beralih ke VBAProject bagian Thisworkbook , buat jam dinding muncul saat userform aktif
Private Sub Workbook_Open()
On Error Resume Next
FTime.Show VbModules
End Sub
+ Simpan project jam dinding anda, sekarang silahkan dicoba

Kira kira seperti itulah cara Membuat jam melayang jika anda kurang suka dengan jam analog anda juga bisa berkreasi membuat jam digital dengan cara Jam digital berdetak ringan. Semoga manfaat

Share this: