如何通過発送消息実現CombolBox的選択操作

選択操作?
///选择操作，我看错了，呵呵~~是选择操作吧。那就不要api我去写个exp

就是根据ComboBox的句柄来実現対它的操作,選択某一項

是选择某一项吗？我倒，繁体的选择不是你打的那样吧
一定要用api去选择么-_-#

不用API那要用什麼,我想用発送消息来実現.

楼主说的是否这个意思，COMBO在一个程序，另一个程序要通过发送消息来控制它的选择内容呢？

WallesCai(WallesCai) 説的很対,就是這個意思

Option Explicit
'实现自动查询组合框内容所需的API函数声明
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    lPram As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, Source As Any, ByVal Length As Long)
Private Const EM_GETLINE = &HC4
Private Const EM_LINELENGTH = &HC1
Private Const EM_LINEINDEX = &HBBPrivate Const WM_USER = &H400
Private Const LB_ERR = (-1)
Private Const LB_FINDSTRING = &H18F '该消息用来在列表框中进行字符串匹配搜索Private Const CB_FINDSTRING = &H14C '该消息用来在组合框中进行字符串匹配搜索
Private Const EM_GETLINECOUNT = &HBA '该消息用来获取文本框中的行数
Private Const BACKSPACE = 8
Private Const DELETE = 46Dim LastLine As Long '最后的行数
Dim LineHeight As Long '每行的高度Dim m_AutoSelect As Boolean '该公用变量用来存放判断是否执行组合框自动选择功能的状态'******************************************************
'功能：检测要添加的项目是否已经存在于列表框
'输入：
'   ctlTem                 Control     控件类型
'   因为该过程可以对列表框和组合框通用,所以不指定控件类型
'   strTem                 string      要添加的字符串
'输出:  无
'******************************************************
Sub CheckItem(ByVal ctlTem As Control, ByVal strTem As String)
    Dim Ret As Long
    Dim strItem As String

    strItem = strTem
    If TypeName(ctlTem) = "ListBox" Then
        '注意，此处参数strItem需要指明ByVal传递，否则不能得到正确结果
        Ret = SendMessage(ctlTem.hwnd, LB_FINDSTRING, -1, ByVal strItem)
    ElseIf TypeName(ctlTem) = "ComboBox" Then
        Ret = SendMessage(ctlTem.hwnd, CB_FINDSTRING, -1, ByVal strItem)
    End If

    If Ret = LB_ERR Then '如果没有发现重复的项，则添加项目
        ctlTem.AddItem strItem
    Else
        ctlTem.ListIndex = Ret
        MsgBox "不能加入重复的值！"
    End If
End Sub'******************************************************
'功能：获取文本框中指定行的文本
'输入：
'   hwnd                   Long        控件句柄
'   lngLine                Long        指定的行号
'   strLine                String      返回的字符串
'输出:  无
'影响:  参数strLine         用来存放从文本框中获取的字符串'TextBox是以VBcr+VBlf为分隔符，如果逐一读取TextBox的每一行，
'就要逐行找该分隔符。这样的方法是很慢的。'本过程所提供的方法，调用API函数直接读取指定行的文本，执行速
'度很快。
'******************************************************
Sub TxtGetLine(ByVal hwnd As Long, ByVal lngLine As Long, ByRef strLine As String)
    Dim Length As Long                  '某一行的长度
    Dim Barr() As Byte, Barr2() As Byte '用来存放指定行的内容
    Dim lngIndex As Long                '文本框中行的序号

    '根据给定行取得行的索引号
    lngIndex = SendMessage(hwnd, EM_LINEINDEX, lngLine, ByVal 0&)
    '根据行索引取得该行的长度
    Length = SendMessage(hwnd, EM_LINELENGTH, lngIndex, ByVal 0&)

    If Length > 0 Then
        ReDim Barr(Length + 1) As Byte
        ReDim Barr2(Length + 1) As Byte
        Call CopyMemory(Barr(0), Length, 2)
        Call SendMessage(hwnd, EM_GETLINE, lngLine, Barr(0))
        Call CopyMemory(Barr2(0), Barr(0), Length)
        '将字节型数组中的内容转换为字符串
        strLine = StrConv(Barr2, vbUnicode)
    Else
        strLine = vbNullString
    End If
End Sub'******************************************************
'功能:根据输入字符自动搜索组合框中存在项，看是否匹配，
'    并且显示在输入框中
'******************************************************
Private Sub cboExtend_Change()
    Dim iStart As Long '定义被选择字符的起始位置
    Dim sString As String '用来存放在cboExtend控件中获取的子字符串

    If m_AutoSelect = True Then '为真，则执行自动选择
        iStart = 1 '只是初始化的作用
        iStart = cboExtend.SelStart '设置iStart为组合框中文本被选择区域的开始位置

        '取得当前输入字符以及以前输入字符所形成的字符串，保存于变量sString中
        sString = CStr(Left(cboExtend.Text, iStart))
        '利用API函数去执行搜索、匹配字符串的工作
        cboExtend.ListIndex = SendMessage(cboExtend.hwnd, CB_FINDSTRING, -1, ByVal _
            CStr(Left(cboExtend.Text, iStart)))

        If cboExtend.ListIndex = -1 Then '如果没有找到匹配的字符串，则保留当前的输入
            cboExtend.Text = sString
        End If

        '将iStart的值设置为选择区域的开始位置，即选择区域往后移动一个字符
        cboExtend.SelStart = iStart
        '设置被选中的区域长度
        cboExtend.SelLength = Len(cboExtend.Text) - iStart
    End If
End Sub

按上面:
'***********************************************************
'功能：加入这样的代码，是为了在删除字符时候不至于一直执行
'       自动查找选择的功能
'***********************************************************
Private Sub cboExtend_KeyPress(KeyAscii As Integer)
    If KeyAscii = BACKSPACE Then    '如果是退格键，则不执行自动选择
        m_AutoSelect = False
    Else                            '如果是别的输入，则执行自动选择
        m_AutoSelect = True
    End If
End SubPrivate Sub cmdAdd_Click()
    Dim strTem As String
    strTem = Trim$(txtList.Text)
    Call CheckItem(lstExtend, strTem)
End SubPrivate Sub cmdShow_Click()
    Dim strTem As String
    Dim numLine As Long

    '为何要减1？因为TextBox行数从0算起，如果输入2的话，一般
    '希望取得我们看上去的第二行。即序数为1的那行文本
    '注意，由于只是测试程序，这里没有出错控制，请严格输入正整数
    numLine = CLng(Trim$(txtLine.Text)) - 1
    Call TxtGetLine(txtExtend.hwnd, numLine, strTem)
    txtShow.Text = strTem
End SubPrivate Sub Form_Load()
    '初始化组合框
    cboExtend.AddItem "Students"
    cboExtend.AddItem "Teachers"
    cboExtend.AddItem "Workers"
    cboExtend.AddItem "Clerks"

    '初始化列表框
    lstExtend.AddItem "Students"
    lstExtend.AddItem "Teachers"
    lstExtend.AddItem "Workers"
    lstExtend.AddItem "Clerks"

    '设定文本框中每行的高度
    Set Me.Font = txtExtend.Font
    LineHeight = Me.TextHeight("A")
End Sub'*************************************************************
'功能：改变文本框的高度。高度随着行数的变化而变化，与GetFocus结合
'     使用。此时，需要设置TextBox的MultiLine属性为真。本例演示的
'    是不设置ScroolBar，通过代码自由得改变文本框高度的方法。为了正
'  的运行程序，把文本框的边框BorderStyle设置为0_None，否则，每次输
'   入的第一行文本都不能显示出来。
'*************************************************************
Private Sub txtExtend_Change()
    Dim Ret As Long '定义存放文本框中行数的变量
    Ret = SendMessage(txtExtend.hwnd, EM_GETLINECOUNT, 0, 0&)

    If Ret <> LastLine Then '判断Ret与最后的行数LastLine是否相等
        '该语句判断文本框高度是否已经合窗体高度一样，同时看是否存
        '在多行文本
        If txtExtend.Height + txtExtend.Top + LineHeight > _
            Me.ScaleHeight And Ret > 1 Then

            '判断最终的行数（LastLine）是否小于或等于目前行数（Ret）减1的
            If LastLine <= Ret - 1 Then
                Exit Sub '如果已经是最大高度，则保持
            End If
            LastLine = Ret - 1 '超过最大高度，需要控制
        Else
            LastLine = Ret '取得行数赋给LastLine
        End If

        '在最大高度范围内获取了最终的行数，然后来确定高度
        txtExtend.Height = LastLine * LineHeight '修改高度
    End If
End Sub'***************************************************
'功能： 1.自动选择文本；2.获取文本框中的行数
'***************************************************
Private Sub txtExtend_GotFocus()
    '文本框控件获得焦点，就将文本框内容全部选中
    txtExtend.SelStart = 0
    txtExtend.SelLength = Len(Trim$(txtExtend.Text))

    '获取文本框中的行数
    LastLine = SendMessage(txtExtend.hwnd, EM_GETLINECOUNT, 0, 0&)
End Sub'******************************************************
'功能：实现文本框中输入字符限制
'******************************************************
Private Sub txtExtend_KeyPress(KeyAscii As Integer)
    '用Select Case比用If语句选择余地大，这个功能使得文本框只能输入
    '数字和小数点“.”同时也能响应BackSpace键
    Select Case KeyAscii
        Case 48 To 57           '如果是数字，则允许输入
        Case 46, 8              '如果是.和退格键BackSpace也能正确响应
        Case 13                 '如果是回车键，则执行相关操作
            KeyAscii = 0        '屏蔽掉默认的“滴”的声音
            SendKeys "{tab}"    '执行Tab键操作，焦点跳转到下一个控件
        Case Else               '其他的字符和键值均不响应
            KeyAscii = 0
    End Select
End Sub

调试易

如何通過発送消息実現CombolBox的選択操作

解决方案 »