Listbox da mouse tekerleği ile ilgili
Tarih
14/01/2011 21:54
Konu Sahibi
drummers
Yorumlar
4
Okunma
2011
Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 5
  • 4
  • 3
  • 2
  • 1

Derecelendirme: 0/5 - 0 oy



drummers
Omur Can
Kullanici Avatari
Destek
O.... C....
398
11/05/2009
125
İzmir
Ofis 2003
29/11/2016,13:56
Çözüldü 
Ekli dosyamda Listbox1 de mouse tekerleği kullanmak istemekteyim. Konu başlıklarında arama yaptım fakat çeşitli uyarılar ile karşılaştım.

İlgileneceklere şimdiden teşekürler.

Kullanıcı adı: Admin
Şifre : 1


Ek Dosyalar
.rar   drmkayıt v1.rar (Dosya Boyutu: 219,3 KB / İndirme Sayısı: 26)
drummers, 11-05-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla


life_exciting
Aktif Üye
Kullanici Avatari
Aktif Üye
837
28/12/2009
361
Ankara
Ofis 2003
18/11/2010,00:42
Çözüldü 
Linkteki Örneği İnceleyebilirsiniz.İşinize Yarayacağını Düşünüyorum.

http://www.accesstr.net/konu-mouse-fare-...ight=mouse
Cevapla


drummers
Omur Can
Kullanici Avatari
Destek
O.... C....
398
11/05/2009
125
İzmir
Ofis 2003
29/11/2016,13:56
Çözüldü 
(14/01/2011, 22:25)lifeexciting Adlı Kullanıcıdan Alıntı: Linkteki Örneği İnceleyebilirsiniz.İşinize Yarayacağını Düşünüyorum.

http://www.accesstr.net/konu-mouse-fare-...ight=mouse

Kendi çalışmama uyarlıyamadım.Img-cray
drummers, 11-05-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla


drummers
Omur Can
Kullanici Avatari
Destek
O.... C....
398
11/05/2009
125
İzmir
Ofis 2003
29/11/2016,13:56
Çözüldü 
Konu hakkında mümkünse fikir verebilirmisiniz ? Beceremedim de.Img-grin
drummers, 11-05-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla


ogulcan92
Aktif Üye
Kullanici Avatari
Aktif Üye
1.160
06/05/2009
477
İzmir
Ofis 2003
07/08/2015,11:50
Çözüldü 
Kodlarınızı aşağıdaki şekilde düzenleyiniz.
Module Yazılacak Kod

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
Private Declare Function CallWindowProc Lib "user32.dll" Alias _
"CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long


Private Declare Function SetWindowLong Lib "user32.dll" Alias _
"SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function FindWindowA Lib "user32" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long

Private Declare Function GetWindowRect Lib "user32" ( _
ByVal hWnd As Long, lpRect As typeRect) As Long
Private Type typeRect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private dXFactor As Double
Private dYFactor As Double
Private lCaptionHeight As Long

Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Private Const SM_MOUSEWHEELPRESENT = 75

Private lLines As Long
Private hForm As Long
Public lPrevWndProc As Long
Private lX As Long
Private lY As Long
Private bUp As Boolean
Private frmContainer As msForms.UserForm


Private Function WindowProc( _
ByVal lWnd As Long, _
ByVal lMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long


If lMsg = WM_MOUSEWHEEL Then
lX = lParam And 65535
lY = lParam \ 65535
bUp = (wParam > 0)
WheelHandler bUp
End If

If lMsg <> WM_MOUSEWHEEL Then
WindowProc = CallWindowProc(lPrevWndProc, lWnd, lMsg, wParam, lParam)
End If
End Function

Public Sub HookWheel(ByVal frmName As msForms.UserForm, dWidth As Double, _
dHeight As Double, ByVal lLinesToScroll As Long)
If WheelPresent Then
Set frmContainer = frmName
hForm = GetFormHandle(frmName)
GetScreenFactors hForm, dWidth, dHeight
lLines = lLinesToScroll
lPrevWndProc = SetWindowLong(hForm, GWL_WNDPROC, AddressOf WindowProc)

End If

End Sub

Public Sub UnHookWheel()
Call SetWindowLong(hForm, GWL_WNDPROC, lPrevWndProc)
End Sub

Private Function GetFormHandle(ByVal frmName As msForms.UserForm, _
Optional bByClass As Boolean = True) As Long
Dim strClassName As String
Dim strCaption As String

strClassName = IIf(Val(Application.Version) > 8, "ThunderDFrame", _
"ThunderXFrame") & vbNullChar
strCaption = vbNullString
GetFormHandle = FindWindowA(strClassName, strCaption)

End Function

Public Sub GetScreenFactors(lHwnd As Long, _
dWidth As Double, _
dHeight As Double)
Dim uRect As typeRect
GetWindowRect lHwnd, uRect
dXFactor = dWidth / (uRect.Right - uRect.Left)
dYFactor = dHeight / (uRect.Bottom - uRect.Top)
lCaptionHeight = dHeight - frmContainer.InsideHeight
End Sub

Private Function WheelPresent() As Boolean
If GetSystemMetrics(SM_MOUSEWHEELPRESENT) Then
WheelPresent = True
ElseIf FindWindowA("MouseZ", "Magellan MSWHEEL") <> 0 Then
WheelPresent = True
End If
End Function

Public Sub WheelHandler(bUp As Boolean)

Dim ctlFocus As msForms.Control
Dim ctlName As msForms.Control
Dim lTopIndex As Long
Dim bMultiPage As Boolean
Dim lPage As Long
Dim lMove As Long

If Not IsOverForm Then Exit Sub
Set ctlFocus = frmContainer.ActiveControl

If TypeOf ctlFocus Is msForms.MultiPage Then
bMultiPage = True

lPage = ctlFocus.Value

Set ctlFocus = ctlFocus.SelectedItem.ActiveControl

End If

lX = lX * dXFactor
lY = lY * dYFactor
lY = lY - lCaptionHeight

If Not (TypeOf ctlFocus Is msForms.CommandButton Or _
TypeOf ctlFocus Is msForms.TextBox) Then

End If

For Each ctlName In frmContainer.Controls
With ctlName

If TypeOf ctlName Is msForms.ListBox Then

If bMultiPage = True Then

If lPage <> .Parent.Index Then GoTo SkipControl
End If
If lX > .Left Then
If lX < .Left + .Width Then
If lY > .Top Then
If lY < .Top + .Height Then

If .ListCount = 0 Then Exit Sub

lMove = IIf(bUp, -lLines, lLines)
lTopIndex = .TopIndex + lMove

If lTopIndex < 0 Then
lTopIndex = 0
ElseIf lTopIndex > .ListCount - (.Height / 10) + 2 Then
lTopIndex = .TopIndex
End If

.TopIndex = lTopIndex

Exit Sub

End If
End If
End If
End If
End If
End With

SkipControl:
Next ctlName

End Sub

Public Function IsOverForm() As Boolean
Dim uRect As typeRect
GetWindowRect hForm, uRect
With uRect
If lX >= .Left Then
If lX <= .Right Then
If lY >= .Top Then
If lY <= .Bottom Then
IsOverForm = True
lX = lX - .Left
lY = lY - .Top
End If
End If
End If
End If
End With
End Function

Userformun İnitalizesine Yazılacak Kod

Visual Basic Code
HookWheel Me, Me.Width, Me.Height, 1

Userformun Terminatesine Yazılacak Kod

Visual Basic Code
UnHookWheel

Cevapla







Konuyu Okuyanlar: 1 Ziyaretçi


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Tarih Son Yorum
  Userformdaki Listbox denetimini düzenleme devely 3 639 06/09/2016, 13:59 atoz112
  Listbox a gelen veriyi kopyalama veya ilgili satıra gitme hsendogan 4 906 15/06/2016, 16:57 atoz112
Çözüldü ListBox Sorunu kenan827 16 1.862 07/05/2015, 15:53 kenan827
Çözüldü Listbox filtre uygulaması Mecnun24 5 1.987 09/03/2011, 11:15 Mecnun24
Çözüldü Eğer ve hücre veri birleştirme ile ilgili bir soru drummers 2 1.834 01/03/2011, 15:42 drummers


Türkçe Çeviri: MCTR, Forum Yazılımı: MyBB, © 2002-2016 MyBB Group.
DMCA.com Protection Status
© Desing by XSTYLED| Develops by ozanakkaya