IDC资讯中心
文件一，form1.frm
加入一个listview，两个imagelist，一个文本框
代码如下：
option explicit
copyright ?1997-1999 brad martinez, http://www.mvps.org
demonstrates how to in place do subitem editing in the vb listview.
private m_hwndlv as long listview1.hwnd
private m_hwndtb as long textbox1.hwnd
private m_iitem as long listitem.index whose subitem is being edited
private m_isubitem as long zero based index of listview1.listitems(m_iitem).subitem being edited
private sub form_load()
dim i as long
dim item as listitem
text1.appearance = ccflat comctllib enum value
text1.visible = false
m_hwndtb = text1.hwnd
initialize the imagelists
with imagelist1
.imageheight = 32
.imagewidth = 32
.listimages.add picture:=icon
end with
with imagelist2
.imageheight = 16
.imagewidth = 16
.listimages.add picture:=icon
end with
initialize the listview
with listview1
.labeledit = lvwmanual
.hideselection = false
.icons = imagelist1
.smallicons = imagelist2
m_hwndlv = .hwnd
for i = 1 to 4
.columnheaders.add text:="column" & i
next
for i = 0 to &h3f
set item = .listitems.add(, , "item" & i, 1, 1)
item.subitems(1) = i * 10
item.subitems(2) = i * 100
item.subitems(3) = i * 1000
next
end with
end sub
private sub form_resize()
listview1.move 0, 0, scalewidth, scaleheight
end sub
private sub listview1_dblclick()
dim lvhti as lvhittestinfo
dim rc as rect
dim li as listitem
if a left button double-click… (change to suit)
if (getkeystate(vbkeylbutton) and &h8000) then
if a listview subitem is double clicked…
call getcursorpos(lvhti.pt)
call screentoclient(m_hwndlv, lvhti.pt)
if (listview_subitemhittest(m_hwndlv, lvhti) <> lvi_noitem) then
if lvhti.isubitem then
get the subitems label (and icon) rect.
if listview_getsubitemrect(m_hwndlv, lvhti.iitem, lvhti.isubitem, lvir_label, rc) then
either set the listview as the textbox parent window in order to
have the textbox move method use listview client coords, or just
map the listview client coords to the textboxs paent form
call setparent(m_hwndtb, m_hwndlv)
call mapwindowpoints(m_hwndlv, hwnd, rc, 2)
text1.move (rc.left + 4) * screen.twipsperpixelx, _
rc.top * screen.twipsperpixely, _
(rc.right – rc.left) * screen.twipsperpixelx, _
(rc.bottom – rc.top) * screen.twipsperpixely
save the one-based index of the listitem and the zero-based index
of the subitem(if the listview is sorted via the api, then listitem.index
will be different than lvhti.iitem +1…)
m_iitem = lvhti.iitem + 1
m_isubitem = lvhti.isubitem
put the subitems text in the textbox, save the subitems text,
and clear the subitems text.
text1 = listview1.listitems(m_iitem).subitems(m_isubitem)
text1.tag = text1
listview1.listitems(m_iitem).subitems(m_isubitem) = ""
make the textbox the topmost form control, make the it visible, select
its text, give it the focus, and subclass it.
text1.zorder 0
text1.visible = true
text1.selstart = 0
text1.sellength = len(text1)
text1.setfocus
call subclass(m_hwndtb, addressof wndproc)
end if listview_getsubitemrect
end if lvhti.isubitem
end if listview_subitemhittest
end if getkeystate(vbkeylbutton)
end sub
selects the listitem whose subitem is being edited…
private sub text1_gotfocus()
listview1.listitems(m_iitem).selected = true
end sub
if the textbox is shown, size its width so that its always a little
longer than the length of its text.
private sub text1_change()
if m_iitem then text1.width = textwidth(text1) + 180
end sub
update the subitem text on the enter key, cancel on the escape key.
private sub text1_keypress(keyascii as integer)
if (keyascii = vbkeyreturn) then
call hidetextbox(true)
keyascii = 0
elseif (keyascii = vbkeyescape) then
call hidetextbox(false)
keyascii = 0
end if
end sub
friend sub hidetextbox(fapplychanges as boolean)
if fapplychanges then
listview1.listitems(m_iitem).subitems(m_isubitem) = text1
else
listview1.listitems(m_iitem).subitems(m_isubitem) = text1.tag
end if
call unsubclass(m_hwndtb)
text1.visible = false
text1 = ""
call setparent(m_hwndtb, hwnd)
listview1.setfocus
m_iitem = 0
end sub
文件二：module1.bas
option explicit
copyright ?1997-1999 brad martinez, http://www.mvps.org
public type pointapi pt
x as long
y as long
end type
public type rect rct
left as long
top as long
right as long
bottom as long
end type
declare function getcursorpos lib "user32" (lppoint as pointapi) as long
declare function screentoclient lib "user32" (byval hwnd as long, lppoint as pointapi) as long
declare function getkeystate lib "user32" (byval nvirtkey as keycodeconstants) as integer
declare function setparent lib "user32" (byval hwndchild as long, byval hwndnewparent as long) as long
declare function mapwindowpoints lib "user32" (byval hwndfrom as long, byval hwndto as long, lppt as any, byval cpoints as long) as long
declare function sendmessage lib "user32" alias "sendmessagea" _
(byval hwnd as long, _
byval wmsg as long, _
byval wparam as long, _
lparam as any) as long <—
========================================================================
listview defs
#const win32_ie = &h300
user-defined
public const lvi_noitem = -1
messages
public const lvm_first = &h1000
#if (win32_ie >= &h300) then
public const lvm_getsubitemrect = (lvm_first + 56)
public const lvm_subitemhittest = (lvm_first + 57)
#end if
lvm_getsubitemrect rct.left
public const lvir_icon = 1
public const lvir_label = 2
public type lvhittestinfo was lv_hittestinfo
pt as pointapi
flags as long
iitem as long
#if (win32_ie >= &h300) then
isubitem as long this is was not in win95. valid only for lvm_subitemhittest
#end if
end type
lvhittestinfo flags
public const lvht_onitemlabel = &h4
#if (win32_ie >= &h300) then
public function listview_getsubitemrect(hwnd as long, iitem as long, isubitem as long, _
code as long, prc as rect) as boolean
prc.top = isubitem
prc.left = code
listview_getsubitemrect = sendmessage(hwnd, lvm_getsubitemrect, byval iitem, prc)
end function
public function listview_subitemhittest(hwnd as long, plvhti as lvhittestinfo) as long
listview_subitemhittest = sendmessage(hwnd, lvm_subitemhittest, 0, plvhti)
end function
#end if win32_ie >= &h300
文件三：msubclass.bas
option explicit
copyright ?1997-1999 brad martinez, http://www.mvps.org
private const wm_destroy = &h2
private const wm_killfocus = &h8
private declare function getprop lib "user32" alias "getpropa" (byval hwnd as long, byval lpstring as string) as long
private declare function setprop lib "user32" alias "setpropa" (byval hwnd as long, byval lpstring as string, byval hdata as long) as long
private declare function removeprop lib "user32" alias "removepropa" (byval hwnd as long, byval lpstring as string) as long
declare function setwindowlong lib "user32" alias "setwindowlonga" (byval hwnd as long, byval nindex as long, byval dwnewlong as long) as long
private const gwl_wndproc = (-4)
private declare function callwindowproc lib "user32" alias "callwindowproca" (byval lpprevwndfunc as long, byval hwnd as long, byval umsg as long, byval wparam as long, byval lparam as long) as long
private const oldwndproc = "oldwndproc"
public function subclass(hwnd as long, lpfnnew as long) as boolean
dim lpfnold as long
dim fsuccess as boolean
if (getprop(hwnd, oldwndproc) = 0) then
lpfnold = setwindowlong(hwnd, gwl_wndproc, lpfnnew)
if lpfnold then
fsuccess = setprop(hwnd, oldwndproc, lpfnold)
end if
end if
if fsuccess then
subclass = true
else
if lpfnold then call unsubclass(hwnd)
msgbox "unable to successfully subclass &h" & hex(hwnd), vbcritical
end if
end function
public function unsubclass(hwnd as long) as boolean
dim lpfnold as long
lpfnold = getprop(hwnd, oldwndproc)
if lpfnold then
if removeprop(hwnd, oldwndproc) then
unsubclass = setwindowlong(hwnd, gwl_wndproc, lpfnold)
end if
end if
end function
public function wndproc(byval hwnd as long, byval umsg as long, byval wparam as long, byval lparam as long) as long
select case umsg
======================================================
hide the textbox when it loses focus (its lostfocus event it not fired
when losing focus to a window outside the app).
case wm_killfocus
oldwndproc will be gone after unsubclass is called, hidetextbox
calls unsubclass.
call callwindowproc(getprop(hwnd, oldwndproc), hwnd, umsg, wparam, lparam)
call form1.hidetextbox(true)
exit function
======================================================
unsubclass the window when its destroyed in case someone forgot…
case wm_destroy
oldwndproc will be gone after unsubclass is called!
call callwindowproc(getprop(hwnd, oldwndproc), hwnd, umsg, wparam, lparam)
call unsubclass(hwnd)
exit function
end select
wndproc = callwindowproc(getprop(hwnd, oldwndproc), hwnd, umsg, wparam, lparam)
end function
