AccessTr.neT

Sn. @berduş un emekleri sonucunda mükemmel bir analog timepicker ortaya çıkmış oldu
elbette eksikleri olabilir. ama şu haliyle bile çok harika oldu peki neler eklendi
bu saat olmadığı için timer yok sadece zaman seçiliyor
selectivite ile "1 saat, 30,20,15,10,5,1 dk lık hassasiyet ile seçim yapılıyor
saat seçmek için sol tıklatıp mouse saat üzerinde gezdirip
istenilen zamana gelince mouse bırakıyorsunuz
mouse nerde olursa olsun kırmızı nokta kadran üzerinde dolaşıyor
sadece bir eksiği kaldı o da kırmızı nokta selectiviteye uymuyor
eğer sn. @berduş vakti olursa eklerse çok güzel olacak
bunu nerede kullanacağız 
tarih seçerken takvim açıldığı gibi saat girmek gereken kutulara çift tıklayınca bu açılacak 
saat seçilince metin kutusuna ekleyecek
şimdilik son halini ekliyorum

SaatBul fonksiyonunu aşağıdaki kodla değiştirip dener misiniz

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

ellerine sağlık sn @berduş son halini ve Digital font ekledim
benim 100 satırda uğraşarak yaptığımı sen iki satır kod ile halledip geçiyorsun. yine moralim bozuldu
şimdi popup form olarak açtırıp  
form1 deki metin kutusuna seçilen tarihi yazdırma kısmı kaldı 
ben zaten yapamıyorum yaptığım kısmınıda hamallık ile uzun yoldan yapmış oluyorum

Orada acilir kutuya bir sütun daha eklemiştim, kod o sayede kisaldi

Yukledigim dosyadaki kodları incelediniz mi orada mouseMove olayı ile bir yer daha dsgismist o nedenle titreme baya azalmıştı. Sizin dosyanızı indirdigimde hâlâ eski kodlar kullanıldığından titreme baya fazla geldi

ben "AnalogSaat_hy3" üzerinden devam ettim. evet titreme azalmıştı.
ama zaten mouse basılı tutulurken değerler değişeceği için sıkıntı olmayacak
ama metin kutusuna değeri aktarmamız lazım

Daha önce tarih atama için aynısı yapılmıştı ordaki kodu kullanabilirsiniz

Form1de metin kutusuna çift tıklayınca zaman seçici açılır
zamanı belirledikten sonra saatin yazılı olduğu metin kutusuna çift tıklanınca veri aktarılır


Eklenecek Modülün kodu

Public txtbox As Access.TextBox

saat24 formuna eklenecek fonksiyon

Function SeciliZaman(Optional Target_Control As Object) As String

      Set txtbox = Target_Control

      DoCmd.OpenForm me.Name '"Saat24"

End Function

saat24 formuna eklenecek Etiket çift tıklama olayı

Private Sub LblSaat_DblClick(Cancel As Integer)

            txtbox.Value = Me.LblSaat.Caption

            DoCmd.SetWarnings False

            DoCmd.Close

           DoCmd.SetWarnings True



End Sub

Bu arada neden İngilizce?