楼主看这样是否可以 Private Sub msh1_KeyPress(KeyAscii As Integer) Select Case KeyAscii Case vbKeyReturn, vbKeyTab 'move to next cell. With MSh1 If .Col + 1 <= .Cols - 1 Then .Col = .Col + 1 Else If .Row + 1 <= .Rows - 1 Then .Row = .Row + 1 .Col = 0 Else .Row = 1 .Col = 0 End If End If End With Case vbKeyBack With MSh1 'remove the last character, if any. If Len(.Text) Then .Text = Left(.Text, Len(.Text) - 1) End If End With Case Is < 32 Case Else With MSh1 .Text = .Text & Chr(KeyAscii) End With End Select End Sub
呵呵,这个问题我有一段老W的代码已解决。文件一,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
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 SubPrivate Sub Form_Resize() ' ListView1.Move 0, 0, ScaleWidth, ScaleHeight End SubPrivate 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 SubItem's 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 TextBox's 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 SubItem's text in the TextBox, save the SubItem's text, ' and clear the SubItem's 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 it's 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 IfEnd SubFriend 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
文件二:Module1.basOption Explicit ' ' Copyright ?1997-1999 Brad Martinez, http://www.mvps.org ' Public Type POINTAPI ' pt X As Long Y As Long End TypePublic Type RECT ' rct Left As Long Top As Long Right As Long Bottom As Long End TypeDeclare 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 IntegerDeclare 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 LongDeclare 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 = 2Public 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) ThenPublic 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 FunctionPublic 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.basOption Explicit ' ' Copyright ?1997-1999 Brad Martinez, http://www.mvps.org ' Private Const WM_DESTROY = &H2 Private Const WM_KILLFOCUS = &H8Private 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 LongDeclare 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 LongPrivate 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 FunctionPublic 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 IfEnd FunctionPublic 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 it's 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
最好不要直接编辑,本人一向不喜欢直接编辑lvw的东西
Private Sub msh1_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case vbKeyReturn, vbKeyTab
'move to next cell.
With MSh1
If .Col + 1 <= .Cols - 1 Then
.Col = .Col + 1
Else If .Row + 1 <= .Rows - 1 Then
.Row = .Row + 1
.Col = 0
Else
.Row = 1
.Col = 0
End If
End If
End With
Case vbKeyBack With MSh1
'remove the last character, if any.
If Len(.Text) Then
.Text = Left(.Text, Len(.Text) - 1)
End If
End With
Case Is < 32
Case Else With MSh1
.Text = .Text & Chr(KeyAscii)
End With
End Select
End Sub
最好是SPREAD控件,很好用的.
本人菜鸟一个从2002-6-9 23:43:00注册到现在才混了5个角角
不过本人努力中:)
我是用到Listview了,又找不到资料,只好向各位求教了。大家多多指教
另外mshflexgrid得界面没有Listview得好看(个人意见)。
我主要的目的是从数据库查询数据(字段和数据)然后显示出来,还有就是编辑的问题了,我怎么也不能编辑第一列以后得内容(直接编辑)。
谢谢各位,我试试你们得方法试试:)
艘艘他,很容易获得
http://community.csdn.net/Expert/topic/2959/2959960.xml?temp=.4491083
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 SubPrivate Sub Form_Resize()
' ListView1.Move 0, 0, ScaleWidth, ScaleHeight
End SubPrivate 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 SubItem's 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 TextBox's 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 SubItem's text in the TextBox, save the SubItem's text,
' and clear the SubItem's 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 it's 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 IfEnd SubFriend 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
'
' Copyright ?1997-1999 Brad Martinez, http://www.mvps.org
'
Public Type POINTAPI ' pt
X As Long
Y As Long
End TypePublic Type RECT ' rct
Left As Long
Top As Long
Right As Long
Bottom As Long
End TypeDeclare 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 IntegerDeclare 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 LongDeclare 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 = 2Public 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) ThenPublic 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 FunctionPublic 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
'
' Copyright ?1997-1999 Brad Martinez, http://www.mvps.org
'
Private Const WM_DESTROY = &H2
Private Const WM_KILLFOCUS = &H8Private 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 LongDeclare 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 LongPrivate 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 FunctionPublic 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 IfEnd FunctionPublic 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 it's 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试试看