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

[Resim: do.php?img=10211]
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
Sayfalar: 1 2 3