AccessTr.neT

Tam Versiyon: Analog Saat Üzerinde Mouse İle Tıklayarak Saat Seçmek
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3
arada şu hata çıkıyor sebebini bulamadım
[Resim: do.php?img=10218]
sn. @berduş ofisteki pc de bir önceki mesajdaki hatayı vermiyor. ama yinede madem timepicker olacak her pc de hataszı çalışsa çok güzel olur
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
  [Resim: do.php?img=10219]
ofisteki pc dede şu hatayı verdi

[Resim: do.php?img=10220]
sadece mouse basılı iken işlem yapması için şunları ekledim daha güzel oldu
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
Sayfalar: 1 2 3