Analog Saat Üzerinde Mouse İle Tıklayarak Saat Seçmek

1 2 3

arada şu hata çıkıyor sebebini bulamadım

eklediğim son halinde boyutu biraz küçülttüm
kırmızı nokta Am/Pm her halükarda çizgi üzerinde olacak şekilde değiştirdim
selectivite ekledim ama saat olarak çalışsa bile
noktanın da saat ile birlikte yerinin değişmesini ayarlayamadım
yani selectivite "thirty" iken mouse 14:44 geldiğinde
saat 14:30 göstermesine rağmen nokta 14:44 de duruyor

selectivite = Me.selectivite



Select Case selectivite

    Case "hour"

        If (DkTxt >= 0 And DkTxt < 30) Then

            DkTxt = Format(0 Mod 60, "00")

        Else

            SaatTxt = Format((SonDgr \ 60) + 1, "00")

            DkTxt = Format(0 Mod 60, "00")

        End If

    Case "thirty"

        If (DkTxt >= 0 And DkTxt < 30) Then

            DkTxt = IIf(DkTxt < 15, Format(0 Mod 60, "00"), Format(30 Mod 60, "00"))

        ElseIf (DkTxt >= 30 And DkTxt < 60) Then

            SaatTxt = IIf(DkTxt < 45, Format(SonDgr \ 60, "00"), Format((SonDgr \ 60) + 1, "00"))

            DkTxt = IIf(DkTxt < 45, Format(30 Mod 60, "00"), Format(0 Mod 60, "00"))

        End If

    Case "twenty"

        If (DkTxt >= 0 And DkTxt < 20) Then

            DkTxt = IIf(DkTxt < 10, Format(0 Mod 60, "00"), Format(20 Mod 60, "00"))

        ElseIf (DkTxt >= 20 And DkTxt < 40) Then

            DkTxt = IIf(DkTxt < 30, Format(20 Mod 60, "00"), Format(40 Mod 60, "00"))

        ElseIf (DkTxt >= 40 And DkTxt < 60) Then

            SaatTxt = IIf(DkTxt < 50, Format(SonDgr \ 60, "00"), Format((SonDgr \ 60) + 1, "00"))

            DkTxt = IIf(DkTxt < 50, Format(40 Mod 60, "00"), Format(0 Mod 60, "00"))

        End If

    Case "fifteen"

        If (DkTxt >= 0 And DkTxt < 15) Then

            DkTxt = IIf(DkTxt < 7, Format(0 Mod 60, "00"), Format(15 Mod 60, "00"))

        ElseIf (DkTxt >= 15 And DkTxt < 30) Then

            DkTxt = IIf(DkTxt < 22, Format(15 Mod 60, "00"), Format(30 Mod 60, "00"))

        ElseIf (DkTxt >= 30 And DkTxt < 45) Then

            DkTxt = IIf(DkTxt < 37, Format(30 Mod 60, "00"), Format(45 Mod 60, "00"))

        ElseIf (DkTxt >= 45 And DkTxt < 60) Then

            SaatTxt = IIf(DkTxt < 52, Format(SonDgr \ 60, "00"), Format((SonDgr \ 60) + 1, "00"))

            DkTxt = IIf(DkTxt < 52, Format(45 Mod 60, "00"), Format(0 Mod 60, "00"))

        End If

    Case "ten"

        If (DkTxt >= 0 And DkTxt < 10) Then

            DkTxt = IIf(DkTxt < 5, Format(0 Mod 60, "00"), Format(10 Mod 60, "00"))

        ElseIf (DkTxt >= 10 And DkTxt < 20) Then

            DkTxt = IIf(DkTxt < 15, Format(10 Mod 60, "00"), Format(20 Mod 60, "00"))

        ElseIf (DkTxt >= 20 And DkTxt < 30) Then

            DkTxt = IIf(DkTxt < 25, Format(20 Mod 60, "00"), Format(30 Mod 60, "00"))

        ElseIf (DkTxt >= 30 And DkTxt < 40) Then

            DkTxt = IIf(DkTxt < 35, Format(30 Mod 60, "00"), Format(40 Mod 60, "00"))

        ElseIf (DkTxt >= 40 And DkTxt < 50) Then

            DkTxt = IIf(DkTxt < 45, Format(40 Mod 60, "00"), Format(50 Mod 60, "00"))

        ElseIf (DkTxt >= 50 And DkTxt < 60) Then

            SaatTxt = IIf(DkTxt < 55, Format(SonDgr \ 60, "00"), Format((SonDgr \ 60) + 1, "00"))

            DkTxt = IIf(DkTxt < 55, Format(50 Mod 60, "00"), Format(0 Mod 60, "00"))

        End If

    Case "five"

        If (DkTxt >= 0 And DkTxt < 5) Then

            DkTxt = IIf(DkTxt < 3, Format(0 Mod 60, "00"), Format(5 Mod 60, "00"))

        ElseIf (DkTxt >= 5 And DkTxt < 10) Then

            DkTxt = IIf(DkTxt < 8, Format(5 Mod 60, "00"), Format(10 Mod 60, "00"))

        ElseIf (DkTxt >= 10 And DkTxt < 15) Then

            DkTxt = IIf(DkTxt < 13, Format(10 Mod 60, "00"), Format(15 Mod 60, "00"))

        ElseIf (DkTxt >= 15 And DkTxt < 20) Then

            DkTxt = IIf(DkTxt < 18, Format(15 Mod 60, "00"), Format(20 Mod 60, "00"))

        ElseIf (DkTxt >= 20 And DkTxt < 25) Then

            DkTxt = IIf(DkTxt < 23, Format(20 Mod 60, "00"), Format(25 Mod 60, "00"))

        ElseIf (DkTxt >= 25 And DkTxt < 30) Then

            DkTxt = IIf(DkTxt < 28, Format(25 Mod 60, "00"), Format(30 Mod 60, "00"))

        ElseIf (DkTxt >= 30 And DkTxt < 35) Then

            DkTxt = IIf(DkTxt < 33, Format(30 Mod 60, "00"), Format(35 Mod 60, "00"))

        ElseIf (DkTxt >= 35 And DkTxt < 40) Then

            DkTxt = IIf(DkTxt < 38, Format(35 Mod 60, "00"), Format(40 Mod 60, "00"))

        ElseIf (DkTxt >= 40 And DkTxt < 45) Then

            DkTxt = IIf(DkTxt < 43, Format(40 Mod 60, "00"), Format(45 Mod 60, "00"))

        ElseIf (DkTxt >= 45 And DkTxt < 50) Then

            DkTxt = IIf(DkTxt < 48, Format(45 Mod 60, "00"), Format(50 Mod 60, "00"))

        ElseIf (DkTxt >= 50 And DkTxt < 55) Then

            DkTxt = IIf(DkTxt < 53, Format(50 Mod 60, "00"), Format(55 Mod 60, "00"))

        ElseIf (DkTxt >= 55 And DkTxt < 60) Then

            SaatTxt = IIf(DkTxt < 58, Format(SonDgr \ 60, "00"), Format((SonDgr \ 60) + 1, "00"))

            DkTxt = IIf(DkTxt < 58, Format(55 Mod 60, "00"), Format(0 Mod 60, "00"))

        End If

    Case "minute"

        DkTxt = Format(SonDgr Mod 60, "00")

End Select

Private Sub Resim0_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    active = True

End Sub



Private Sub Resim0_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    If (active) Then

        XTan = X - nCentreLeft

        YTan = nCentreUp - Y

        Me.LblSaat.Caption = SaatBul

    End If

End Sub



Private Sub Resim0_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    active = False

End Sub

hassaslık açılır kutusu için
60;"Hour";30;"Thirty";20;"Twenty";15;"Fifteen";10;"Ten";5;"Five";1;"Minute"
sütun sayısı=2
sütun genişliği=0
yapıp
Select Case selectivite döngüsü yerine de aşağıdaki kodu yazmayı dener misiniz
sadece saati göstermek için
çember kısmını daha halledemedim

Hassas = Me.selectivite

SonDgr = Round(SonDgr / Hassas) * Hassas '

son halini şuraya ekledim
https://accesstr.net/konu-analog-timepicker.html
sadece noktayı kadranda gezdirmek kaldı istersen buradan bakıp değişiklik yapalım

saat bul fonksiyonunu aşağıdakiyle değiştirip deneyebilirsiniz

Function SaatBul() As String



Dim UznTwips As Double

Dim SaatTxt, DkTxt As Integer

Dim Carpan, Teta As Single

Dim Aci As Integer

Dim Hassas As Byte

Dim SonDgr As Single



SaatBul = ""

If YTan = 0 Then Exit Function

SonDgr = Atn(XTan / YTan) * 180 / 3.142857 'radyan olan açıyı dereceye çevirmek için



If YTan < 0 Then Aci = 180  'çeyrekliklerin durumuna göre açı düzeltme

If XTan < 0 And YTan > 0 Then Aci = 360



SonDgr = 2 * (Aci + SonDgr)

UznTwips = Sqr((XTan) ^ 2 + (YTan) ^ 2) 'fare imlecinin resmin merkezine uzaklığı



Hassas = Me.selectivite

SonDgr = Round(SonDgr / Hassas) * Hassas '



SaatTxt = SonDgr \ 60 'dereceden saat ve dakikaya dönüştürme

DkTxt = SonDgr Mod 60



Carpan = YrCpDis 'kırmızı dairenin, çemberin dışında olmasını sağlar

If UznTwips < GcGn Then SaatTxt = SaatTxt + 12

SaatBul = Format(SaatTxt, "00") & ":" & Format(DkTxt, "00")



If SaatBul = TmpSaatBul Then Exit Function

Me.LblSaat.Caption = SaatBul

    



Teta = Pi * SonDgr / 360 '(Atn(XTan / YTan) + Aci * Pi / 180) '

Me.BtnKnm.Top = IIf(BtnX + YariCap * (1 - (Carpan) * Cos(Teta)) < 1, 1, BtnX + YariCap * (1 - (Carpan) * Cos(Teta)))

Me.BtnKnm.Left = IIf(BtnY + YariCap * (1 + (Carpan) * Sin(Teta)) < 1, 1, BtnY + YariCap * (1 + (Carpan) * Sin(Teta)))



TmpSaatBul = SaatBul

End Function

1 2 3

Analog Saat Üzerinde Mouse İle Tıklayarak Saat Seçmek

accessman

berduş

accessman

berduş