Skip to main content

AccessTr.neT


Analog Timepicker

Analog Timepicker

#1
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
[Resim: do.php?img=10221]
.rar AnalogSaat_acc3.rar (Dosya Boyutu: 255,03 KB | İndirme Sayısı: 6)
@benbendedeilem
Son Düzenleme: 18/05/2020, 11:36, Düzenleyen: accessman.
Cevapla
#2
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
.rar AnalogSaat_hy4.rar (Dosya Boyutu: 228,78 KB | İndirme Sayısı: 8)
Cevapla
#3
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
.rar AnalogSaat_acc3.rar (Dosya Boyutu: 246,88 KB | İndirme Sayısı: 5)
@benbendedeilem
Son Düzenleme: 18/05/2020, 16:25, Düzenleyen: accessman.
Cevapla
#4
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
Cevapla
#5
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


[Resim: do.php?img=10222]
@benbendedeilem
Cevapla
#6
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
[Resim: do.php?img=10224]

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?
.rar AnalogSaat_hy5.rar (Dosya Boyutu: 236,55 KB | İndirme Sayısı: 12)
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task