[Anónimo]

olá pessoal, mais uma vez precisando da ajuda de vocês!

É o seguinte, tenho uma combobox com mais de 400 itens e crescendo diariamente.

como faço para usar o scroll do mouse nesta combobox??

obrigado…..

[jorgerod]

acho que já te deram uma resposta noutro local onde colocaste esta questão. no entanto, vê em:

http://www.xtremevbtalk.com/showthread.php?t=254921

pode ser que te ajude.

fica bem.

[Anónimo]

acho que já te deram uma resposta noutro local onde colocaste esta questão. no entanto, vê em:

http://www.xtremevbtalk.com/showthread.php?t=254921

pode ser que te ajude.

fica bem.

caro jorge, obrigado pela resposta.
quanto ao link que postou, sempre que entro meu pc trava e nao obedece mais nada, mas mesmo assim obrigado pela atenção.

abraço…

[jorgerod]

mcjota,

o que está no link, é o seguinte:

option explicit

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 findwindow lib “user32” alias “findwindowa” ( _
byval lpclassname as string, byval lpwindowname as string) as long

private const gwl_wndproc = -4
private const wm_mousewheel = &h20a

private hwnd_userform as long
private lngwndproc as long

‘this traps the mousewheel scroll message as it’s sent to your form by wiindows,
‘then it calls the procedure in the form’s code module in order to scroll the list
private function windowproc(byval lwnd as long, byval lmsg as long, byval wparam as long, byval lparam as long) as long
dim mousekeys as long
dim rotation as long

if lmsg = wm_mousewheel then
mousekeys = wparam and 65535
rotation = wparam / 65536

‘you will have to replace “userform1” in the following line, with the name of your form 😉
userform1.combobox1_mousewheel rotation
end if
windowproc = callwindowproc(lngwndproc, lwnd, lmsg, wparam, lparam)

end function

public sub wheelhook(clientform as userform)
hwnd_userform = findwindow(“thunderdframe”, clientform.caption)
lngwndproc = setwindowlong(hwnd_userform, gwl_wndproc, addressof windowproc)
end sub

public sub wheelunhook()
dim lret as long
lret = setwindowlong(hwnd_userform, gwl_wndproc, lngwndproc)
end sub

e, a seguir:

‘***************************************************
‘created by member timbo @ xtremevbtalk.com
‘adapted from the listbox solution by mathieu plante
‘***************************************************

‘#############################################################
‘don’t forget to substitute “combobox1” with your control name
‘#############################################################

option explicit

‘flag to determine if the control is currently hooked
private blnhooked as boolean

private sub combobox1_mousemove(byval button as integer, byval shift as integer, byval x as single, byval y as single)
‘create the hook when the mouse is over the control
combobox1_hook
end sub

private sub userform_mousemove(byval button as integer, byval shift as integer, byval x as single, byval y as single)
‘destroy the hook when the mouse is not over the control
combobox1_unhook
end sub

private sub userform_queryclose(cancel as integer, closemode as integer)
‘ensure the hook is destroyed before the form closes
combobox1_unhook
end sub

private sub userform_deactivate()
‘destroy the hook if another window takes the focus
combobox1_unhook
end sub

private sub combobox1_hook()
‘only hook the control if it is not already hooked
if not blnhooked then
wheelhook me
blnhooked = true
end if
end sub

private sub combobox1_unhook()
‘only destroy hook the control if it is already hooked
if blnhooked then
wheelunhook
blnhooked = false
end if
end sub

‘custom method to execute the mousewheel scroll action

public sub combobox1_mousewheel(byval rotation as long)
dim lngnewindex as long
static intcounter as integer

‘a little retarding routine to make the mousewheel less sensitive!
intcounter = intcounter + 1
if not intcounter = 3 then exit sub
intcounter = 0

with me.combobox1
if rotation lngnewindex then .listindex = lngnewindex
else
if not .listindex <= -1 then .listindex = .listindex – 1
end if
end with

end sub

[Anónimo]

caro jorge..
muito obrigado pela resposta!
vou tentar adaptar o código para ver o resultado.

abraço….

[Autor]

Artigos