RE: Analog Saat Üzerinde Mouse İle Tıklayarak Saat Seçmek - accessman - 18/05/2020
arada şu hata çıkıyor sebebini bulamadım
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
ofisteki pc dede şu hatayı verdi
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
RE: Analog Saat Üzerinde Mouse İle Tıklayarak Saat Seçmek - berduş - 18/05/2020
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 '
RE: Analog Saat Üzerinde Mouse İle Tıklayarak Saat Seçmek - accessman - 18/05/2020
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
RE: Analog Saat Üzerinde Mouse İle Tıklayarak Saat Seçmek - berduş - 18/05/2020
saat bul fonksiyonunu aşağıdakiyle değiştirip deneyebilirsinizFunction 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
|