AccessTr.neT

Ellerinize sağlık

---

ellerinize sağlık sn. @berduş
tabiki daha bitmedi çünkü çıkış amacımız formlarda saat girmek gerektiğinde popup açılan bir analog saat formundan mouse ile saat seçip metin kutusuna yazdırmaktı
13-24 saat arası için yeni resim ekledim bunun üzerinden seçmemiz daha iyi olacak 
düzelmesi gereken problemler şunlar
* resimin boyutları 5x5 cm olursa daha güzel olacak (ben beceremedim) tabiki popup formda 5x5 cm olacak
* resim boyutları  değiştiğinde tıklanan yerlerde buna bağlı yer değiştirse yani resmin boyutuna bağlı olsa
* mouse resim üzerinde gezdikçe titreme oluyor. hem labelde veri değişip hem titreme olmadan olabilir mi

sn. @berduş konu taşındığı için örnek ekleyemedim 

---

ileride bittiğinde  çok güzel bir TimePicker olacak. 
peki buna neler eklenecek
* mouse çember çizgisi üzerinde olmasa bile 
   ufak kırmızı bir nokta çember üzerinde hareket edecek 
   böylece daha hassas seçim yapılabilecek,  hassasiyet seçenekleri olacak. Açılan kutudan seçilerek
   1 saat, 30 dk, 20 dk, 15 dk, 10 dk, 5 dk, 1 dk
   bunlardan hangisi seçilirse en yakın olana yuvarlayacak. mesela 
   5 dk seçtiysek mouse  14:36 üzerinde iken 14:35 e yuvarlayacak
   15 dk seçtiysek mouse  14:36 üzerinde iken 14:30 a yuvarlayacak
   20 dk seçtiysek mouse  14:36 üzerinde iken 14:40 a yuvarlayacak
   1 saat seçtiysek mouse  14:36 üzerinde iken 15:00 e yuvarlayacak

Çalışmanızı ekleyebilirsiniz.
Genellestirmeye çalışırım eklenen resmin konumuna ve boyutuna gore işlemler yapılabilir belki, yada yada çember üzerinde seçimi belirten bir daire yada çember de eklemeye çalışırım ama geriye kalan yuvarlama işini sizin halletmeniz gerek. Biraz da sizin uğraşmanız gerekiyor.

elbette uğraşıyorum ama benimkisi elek ile su taşımaya benziyor

---

form2 deki gibi resim formun zemin resmi olarak ayarlansa  titreme olayı ortadan kalkar mı

---

yuvarlama işini if ler ile yapabilirim. ama kırmızı noktayı çember çizgisi üzerinde olması gereken yere nasıl yerleştireceğim
asıl mesele bu

Titremenin kaynağı hem timerdaki olaylar hem de Mouse move olayının beraber çalışmasından kaynaklı işlem yoğunluğu olabilir, dün denerken öyle birşey dikkatimi çekmemişti.

timer a gerek yok son eklediğim örnekte onu iptal ettim ama titreme devam ediyor

en başa eklenecek değişken ve sabitler

    Dim XTan, YTan As Long

    Dim YariCap, nCentreLeft, nCentreUp, GcGn, YrCpDis, YrCpKdrn, YrCpic As Single

    Dim BtnX, BtnY As Single

    Const Pi = 3.142857

değişkenlere değer atamak için form yükle me olayına eklenen kodlar

Private Sub Form_Load()

nCentreUp = (Me.Resim0.Height / 2) 'resim merkezinin konumu

nCentreLeft = (Me.Resim0.Width / 2)

BtnX = Me.Resim0.Top - Me.BtnKnm.Height / 2

BtnY = Me.Resim0.Left - Me.BtnKnm.Height / 2

    YariCap = Me.Resim0.Height / 2 'yariçap

    ' aşağıdaki 3 oran resmin özellikleriyle ilgili _

    mevcut resimdeki kadranın içindeki ve dışındaki rakamların resme göre orantısal konumu _

    -en/boy=1 olmak kaydıyla- resmi büyütüp küçültebilirsiniz _

    ama bu resim yerine başka resim kullanmak isterseniz _

    bu oranları tekrar hesaplamanız gerekir

    

    YrCpDis = 0.929 '13 / 14

    YrCpKdrn = 0.857 '6 / 7

    YrCpic = 0.67 '67 / 100

    GcGn = YariCap * (YrCpKdrn) 'gecegündüz hesabı



End Sub

saati ve botonun konumunu hesaplayan fonksiyon

Function SaatBul() As String

Dim SonDgr, Teta As Single

Dim Aci As Integer

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ığı



SaatTxt = Format(SonDgr \ 60, "00") 'dereceden saat ve dakikaya dönüştürme

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



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

If UznTwips < GcGn Then

    SaatTxt = SaatTxt + 12

    Carpan = YrCpic 'kırmızı dairenin, çemberin içinde olmasını sağlar

End If

Teta = (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)))



SaatBul = SaatTxt & ":" & DkTxt

DoEvents

End Function

resme tkladığımızda saat alma kodu ve fare konumunun kodu

Private Sub Resim0_Click()

Me.Metin10 = SaatBul

End Sub



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

    XTan = x - nCentreLeft

    YTan = nCentreUp - Y

    Me.LblSaat.Caption = SaatBul



End Sub

kırmızı çerçeve yerine yuvarlak buton kullandım
dilerim işinize yarar

---

titremeyi engelleyemedim