改变 ListIndex而不发生 Click 事件 

    在修改 Combo 或 Listview 的ListIndex 时， 会发生 Click 事件， 下面的函数可以阻止该事件。

    声明：

Private Declare Function SendMessage Lib _

"user32" Alias "SendMessageA" (ByVal _

hWnd As Long, ByVal wMsg As Long, ByVal _

wParam As Long, lParam As Any) As Long

Const CB_GETCURSEL = &H147

Const CB_SETCURSEL = &H14E

Const LB_SETCURSEL = &H186

Const LB_GETCURSEL = &H188

    函数：

Public Function SetListIndex(lst As Control, _

ByVal NewIndex As Long) As Long

　

If TypeOf lst Is ListBox Then

Call SendMessage(lst.hWnd, _

LB_SETCURSEL, NewIndex, 0&)

SetListIndex = SendMessage(lst.hWnd, _

LB_GETCURSEL, NewIndex, 0&)

ElseIf TypeOf lst Is ComboBox Then

Call SendMessage(lst.hWnd, _

CB_SETCURSEL, NewIndex, 0&)

SetListIndex = SendMessage(lst.hWnd, _

CB_GETCURSEL, NewIndex, 0&)

End If

End Function


 
调整 Combo 下拉部分的宽度 

    声明：

Private Declare Function SendMessage Lib _

"USER32" Alias "SendMessageA" _

(ByVal hwnd As Long, ByVal Msg As Long, _

ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const CB_GETDROPPEDWIDTH = &H15F

Private Const CB_SETDROPPEDWIDTH = &H160

Private Const CB_ERR = -1

    函数：

' 取得 Combo 下拉的宽度

' 可以利用该函数比例放大或缩小宽度

Public Function GetDropdownWidth(cboHwnd As Long) As Long

Dim lRetVal As Long

lRetVal = SendMessage(cboHwnd, CB_GETDROPPEDWIDTH, 0, 0)

If lRetVal <> CB_ERR Then

GetDropdownWidth = lRetVal

'单位为 pixels

Else

GetDropdownWidth = 0

End If

End Function

'设置 Combo 下拉的宽度

'单位为 pixels

Public Function SetDropdownWidth(cboHwnd As _

Long, NewWidthPixel As Long) As Boolean

Dim lRetVal As Long

lRetVal = SendMessage(cboHwnd, _

CB_SETDROPPEDWIDTH, NewWidthPixel, 0)

If lRetVal <> CB_ERR Then

SetDropdownWidth = True

Else

SetDropdownWidth = False

End If

End Function


 
Combo的自动查询技术 

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const CB_FINDSTRING = &H14C

Private Sub Combo1_Change()

Dim iStart As Integer

Dim sString As String

Static iLeftOff As Integer


iStart = 1

iStart = Combo1.SelStart


If iLeftOff <> 0 Then

Combo1.SelStart = iLeftOff

iStart = iLeftOff

End If


sString = CStr(Left(Combo1.Text, iStart))

Combo1.ListIndex = SendMessage(Combo1.hwnd, _

B_FINDSTRING, -1, ByVal CStr(Left( _

ombo1.Text, iStart)))
　

If Combo1.ListIndex = -1 Then

iLeftOff = Len(sString)

combo1.Text = sString

End If


Combo1.SelStart = iStart

iLeftOff = 0

End Sub

    静态变量 iLeftOff 指定了字符长度。


 
自动选择 Text 的内容 


    在使用 VFP 的应用进行录入时，每进入一个录入框，就自动选择该框中的所有内容。利用以下的代码，也可实现类似的功能。

Private Sub MyTextBox_GotFocus()

AutoSelect MyTextBox

End Sub
　

Sub AutoSelect(SelObject As Control)

SelObject.SelStart = 0

If TypeOf SelObject Is MaskEdBox Then

SelObject.SelLength = Len(SelObject.FormattedText)

Else

If TypeOf SelObject Is TextBox Then

SelObject.SelLength = Len(SelObject.Text)

End If

End If

End Sub


 
捕捉 MouseExit 事件 

    MouseDown、MouseUp、MouseMove。VB 似乎提供了很好的 Mouse 事件。但好象还缺少什么！对！还差 MouseExit（鼠标移出）事件。在 VB 中，我们要捕捉 MouseExit 事件，必须用 API 函数：

Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function ReleaseCapture Lib "user32" () As Long

    然后，我们可以在控件（以 Picture1 为例）的 MouseMove 事件上加上以下代码：

Dim MouseExit As Boolean

MouseOver = (0 <= X) And (X <= Picture1.Width) And (0 <= Y) And (Y <= Picture1.Height)

If MouseExit Then

........

SetCapture Picture1.hWnd

Else

........

ReleaseCapture

End If


 
如何让文本框输入完后,直接跳入下一行? 


    我们在编制程序的时候，特别是数据库软件，经常会遇到这样一个问题：在文本框中输入完后，用户习惯性的按下回车键。但是系统“嘀”的一声，并没有象想象那样跳入下一行或者其他的什么。那么能不能让程序在输入完后干其他的事呢？试一试下面的代码吧。

Sub Text1_keyPress(KeyAscii As Integer)
　

If KeyAscii=13 Then

SendKeys"{tab}"

End If

End Sub


 
如何强制文件对话框再次读取正确的磁盘? 


    如果构造了一个以通用对话框为模型的简单对话框(通常应使用通用对话框的OCX),会发现再次选择软盘驱动器并不实际.再次读盘,改变到C盘,并再次选择A盘.只是使它读新软盘中的目录.

    为了解决这个问题,在一个按钮的代码段中加入以下代码:

drive1.refresh

dir1.refresh

file1.refresh


 
VB的OPEN对话框控件图示功能扩充
安徽 刘成 

    Visual Basic For Windows（VB）提供了丰富的控件，但其提供的公用对话框控件在打开文件时（例如＊．Bmp和＊．Pcx等）不能显示文件内容即图像，本文给出了一个实例，可以模拟一些图形软件包在打开文件的同时显示图像，模拟和扩充OPEN控件功能。

    为模拟的扩充OPEN功能，下面给出了一个完整的VB程序，实现方法如下：


一、建立窗体

    首先建立一个窗体（窗体名为OPNFILE），窗体上包含驱动器列表、目录列表、文件列表、两个命令按钮（确认、取消）和显示影像的控件（picture或image），下面是这6个控件的建立方法和有关属性的改变。

    1、DirvelistBox驱动器列表控件

    双击驱动器列表控件，在窗体上调准控件的位置，控件名称为“Drive1”。

    2、DirlistBox目录列表控件

    双击目录列表控件，在窗体上调准控件的位置，控件名称为“Dirl”

    3、FilelistBox文件列表控件

    双击文件列表控件，在窗体上调准控件的位置和尺寸，控件名称为“Filel”，修改“Pattern”属性为“*.bmp, *.pcx”。

    4、Command Buttom命令按钮控件

    双击命令按钮控件，建立命令按钮，第一个取名为Command1，修改Caption属性为“确认”，第二个取名为Command2，修改Caption属性为“取消”。

    5、显示影像的控件

    既可以选picture控件，也可选image控件显示图像，以image控件为例。双击image控件，调准矩形框的大小和位置，取名为imagel，设置strtch属性。strech＝false时，图形以原尺寸显示。


二、事件过程的建立

    1、驱动器更改事件过程

    Sub Drive－change（）

    ①Dirl．Path＝Drivel．Drive

    ②ChDrive Drivel．Drive

    End Sub

    其中①当驱动器发生更改时，改变目录路径；②更改路径。

    2、目录更改事件过程

    Sub Dirl change（）

    Filel．Path＝Dirl．path

    End Sub

    该事件过程是对目录发生更改时，作出文件路径更改的响应。

    3、文件列表单击事件

    Sub Filel－click（）

    Imagel．picture＝loadpicture（Filel.path＋”＼”＋Filel.FileName）

    End Sub

    单击任一图形文件名时，在image控件框上显示图像。

    4、命令按钮控件

    Sub Command1－click（）

    F1＄＝Filel．path＋”＼”＋FileName

    End

    End Sub

    Sub Command2－click（）

    F1＄＝” ”

    End Sub

    F1＄为选择文件名称，供软件使用，若用户单击“取消”按钮，F1＄为空串。

    单击驱动器名可以改变驱动器，单击目录列表中某一目录可以更改目录，单击某一图形文件可以显示图形，在文件列表中按“↑”或“↓”键，可以随着文件名的变化，图像框中的图形也随之发生更改。

    F1＄可以供应用程序调用，其中包含驱动器名、目录和文件名。