VB技巧1

利用键盘精确移动控件和设置控件尺寸
选中控件,按Ctl+上下左右键就可以以一个Grid为单位移动控件.按Shift+上下左右键就可以以一个Grid为单位扩大缩小控件.
返回
按字母或数字顺序排列列表框中的列表项.
将以下代码加入到你的程序中.
Sub ReSort(L As Control)
Dim P%, PP%, C%, Pre$, S$, V&, NewPos%, CheckIt%
Dim TempL$, TempItemData&, S1$

For P = 0 To L.ListCount - 1
S = L.List(P)
For C = 1 To Len(S)
V = Val(Mid$(S, C))
If V > 0 Then Exit For
Next
If V > 0 Then
If C > 1 Then Pre = Left$(S, C - 1)
NewPos = -1
For PP = P + 1 To L.ListCount - 1
CheckIt = False
S1 = L.List(PP)
If Pre <> "" Then
If InStr(S1, Pre) = 1 Then CheckIt = True
Else
If Val(S1) > 0 Then CheckIt = True
End If
If CheckIt Then
If Val(Mid$(S1, C)) < V Then NewPos = PP
Else
Exit For
End If
Next
If NewPos > -1 Then
TempL = L.List(P)
TempItemData = L.ItemData(P)
L.RemoveItem (P)
L.AddItem TempL, NewPos
L.ItemData(L.NewIndex) = TempItemData
P = P - 1
End If
End If
Next
Exit Sub
返回

Tag属性的妙用.
在VB编程中,我们经常要动态的控制很多不同控件的属性,例如我们要将一个CommandButton阵列共20各控件中的第1、4、6、7、8、11、18、20号删除。该怎么半呢？这时只要将要删除的控件的Tag属性设置为1，然后加入以下代码就可以了。
For i=1 To 20
If Command1(i).Tag=1 Then
Unload Command1(i)
End If
Next i
返回

利用VB产生屏幕变暗的效果.
想利用VB编程实现屏幕变暗的效果（向关闭Win95时的效果），只要按下面的步骤来做
1、在Form1中加入两个CommandButton和一个PictureBox.
2、在Form1的代码窗口中添加以下代码：
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As
Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As
Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As
Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long)
As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, ByVal lpRect As
Long, ByVal bErase As Long) As Long

Private bybits(1 To 16) As Byte
Private hBitmap As Long, hBrush As Long
Private hDesktopWnd As Long

Private Sub Command1_Click()
Dim rop As Long, res As Long
Dim hdc5 As Long, width5 As Long, height5 As Long

hdc5 = GetDC(0)
width5 = Screen.Width \ Screen.TwipsPerPixelX
height5 = Screen.Height \ Screen.TwipsPerPixelY

rop = &HA000C9
Call SelectObject(hdc5, hBrush)
res = PatBlt(hdc5, 0, 0, width5, height5, rop)
Call DeleteObject(hBrush)

res = ReleaseDC(0, hdc5)
End Sub

Private Sub Command2_Click()
Dim aa As Long


aa = InvalidateRect(0, 0, 1)
End Sub

Private Sub Form_Load()
Dim ary
Dim i As Long
ary = Array(&H55, &H0, &HAA, &H0, _
&H55, &H0, &HAA, &H0, _
&H55, &H0, &HAA, &H0, _
&H55, &H0, &HAA, &H0)
For i = 1 To 16
bybits(i) = ary(i - 1)
Next i
hBitmap = CreateBitmap(8, 8, 1, 1, bybits(1))
hBrush = CreatePatternBrush(hBitmap)
Picture1.ForeColor = RGB(0, 0, 0)
Picture1.BackColor = RGB(255, 255, 255)
Picture1.ScaleMode = 3
End Sub
运行程序，按Command1就可以使屏幕暗下来，按Command2恢复。
返回

使两个列表框(ListBox)的选项同步
步骤1
在Form中添加两个ListBox和一个CommandButton一个Timer,不要改动他们的属性.
步骤2
在Form中添加如下代码:
Private Sub Form_Load()
Dim X As Integer

For X = 1 To 26
List1.AddItem Chr$(X + 64)
Next X
For X = 1 To 26
List2.AddItem Chr$(X + 64)
Next X
Timer1.Interval = 1
Timer1.Enabled = True
End Sub

Private Sub Command1_Click()
End
End Sub

Private Sub timer1_Timer()
Static PrevList1
Dim TopIndex_List1 As Integer

TopIndex_List1 = List1.TopIndex

If TopIndex_List1 <> PrevList1 Then
List2.TopIndex = TopIndex_List1
PrevList1 = TopIndex_List1
End If

If List1.ListIndex <> List2.ListIndex Then
List2.ListIndex = List1.ListIndex
End If
End Sub
运行程序,当选中其中一个列表框中的某一项后,另外一个列表框中的相应项就会被选中.
返回

获得Win9X下文件的短文件名(8.3文件名)
步骤一
在Form中加入一个FileListBox,一个DirListBox,一个Label.
步骤二
在Form中加入以下代码:
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal
lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Private Sub Dir1_Change()
File1 = Dir1.Path
End Sub

Private Sub Drive1_Change()
Dir1 = Drive1
End Sub

Private Sub File1_Click()
Label1.Caption = GetShortFileName(Dir1 & "\" & File1)
End Sub

Public Function GetShortFileName(ByVal FileName As String) As String
'converts a long file and path name to old DOS format
'PARAMETERS
' FileName = the path or filename to convert
'RETURNS
' String = the DOS compatible name for that particular FileName

Dim rc As Long
Dim ShortPath As String
Const PATH_LEN& = 164

'get the short filename
ShortPath = String$(PATH_LEN + 1, 0)
rc = GetShortPathName(FileName, ShortPath, PATH_LEN)
GetShortFileName = Left$(ShortPath, rc)
End Function
返回

使指定窗口总处于其他窗口之上
将以下代码加入到Form中,这个Form就成为一个在其他所有窗口之上的窗口了.

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter
As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags
As Long) As Long

Const HWND_TOPMOST = -1

Private Sub Form_Load()
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX _
, Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
Me.Height \ Screen.TwipsPerPixelY, 0
End Sub
返回

获得位图文件的信息
在Form中添加一个Picture控件和一个CommandButton控件,在Picture控件中加入一个位图文件,将下面代码加入其中:
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" _
(ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) _
As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, _
ByVal dwCount As Long, lpBits As Any) As Long

Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Private Sub Command1_Click()
Dim hBitmap As Long
Dim res As Long
Dim bmp As BITMAP
Dim byteAry() As Byte
Dim totbyte As Long, i As Long
hBitmap = Picture1.Picture.Handle

res = GetObject(hBitmap, Len(bmp), bmp) '取得BITMAP的结构

totbyte = bmp.bmWidthBytes * bmp.bmHeight '总共要多少BYTE来存图
ReDim byteAry(totbyte - 1)
'将Picture1中的图信息存到ByteAry
res = GetBitmapBits(hBitmap, totbyte, byteAry(0))

Debug.Print "Total Bytes Copied :"; res
Debug.Print "bmp.bmBits "; bmp.bmBits
Debug.Print "bmp.bmBitsPixel "; bmp.bmBitsPixel '每相素位数
Debug.Print "bmp.bmHeight "; bmp.bmHeight '以相素计算图象高度
Debug.Print "bmp.bmPlanes "; bmp.bmPlanes
Debug.Print "bmp.bmType "; bmp.bmType
Debug.Print "bmp.bmWidth "; bmp.bmWidth '以相素计算图形宽度
Debug.Print "bmp.bmWidthBytes "; bmp.bmWidthBytes '以字节计算的每扫描线长度
End Sub
返回

获得驱动器的卷标
在Form中添加一个CommandButton控件,再加入一下一段代码:
Private Declare Function GetVolumeInformation Lib "kernel32" _
Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long

Const FILE_VOLUME_IS_COMPRESSED = &H8000

Public Sub GetVolInfo(ByVal path As String)
Dim aa As Long
Dim VolName As String
Dim fsysName As String
Dim VolSeri As Long, compress As Long
Dim Sysflag As Long, Maxlen As Long

'初试化字符串的长度
VolName = String(255, 0)
fsysName = String(255, 0)
aa = GetVolumeInformation(path, VolName, 256, VolSeri, Maxlen, _
Sysflag, fsysName, 256)
VolName = Left(VolName, InStr(1, VolName, Chr(0)) - 1)
fsysName = Left(fsysName, InStr(1, fsysName, Chr(0)) - 1)
compress = Sysflag And FILE_VOLUME_IS_COMPRESSED
If compress = 0 Then
Me.Print "未压缩驱动器"
Else
Me.Print "压缩驱动器"
End If

Me.Print "驱动器卷标 :", VolName
Me.Print "驱动器标号 : ", Hex(VolSeri)
Me.Print "驱动器文件系统 (FAT, HPFS, or NTFS)", fsysName
Me.Print "支持的文件名长度", Maxlen
End Sub

Private Sub Command1_Click()
Form1.Caption = "c:驱动器信息"
Call GetVolInfo("c:\")
End Sub
返回

将包含有Null结尾的字符串转换为VB字符串
在VB编程调用Windows API函数时,经常会碰到以Null结尾的字符串,下面是一段将Null结尾字符串转换到VB字符串的函数:
Public Function LPSTRToVBString$(ByVal s$)
Dim nullpos&
nullpos& = InStr(s$, Chr$(0))
If nullpos > 0 Then
LPSTRToVBString = Left$(s$, nullpos - 1)
Else
LPSTRToVBString = ""
End If
End Function
返回

启动控制面板命令
控制面板
模块： control.exe
命令： rundll32.exe shell32.dll,Control_RunDLL
结果： 显示控制面板窗口。
例子：
Dim x
x = Shell("rundll32.exe shell32.dll,Control_RunDLL")

辅助选项
模块： access.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,5
结果： 显示辅助选项/常规。

命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,1
结果： 显示辅助选项/键盘。

命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,2
结果： 显示辅助选项/声音。

命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,3
结果： 显示辅助选项/显示。

命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,4
结果： 显示辅助选项/鼠标。

添加新硬件
模块： sysdm.cpl
命令：rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl @1

增加新的打印机
模块：shell32.dll
命令：rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL AddPrinter

添加/删除程序
模块：appwiz.cpl
命令：rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1
结果：显示安装/卸载。

命令：rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1
结果：显示安装/卸载。

命令：rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,2
结果：显示Windows 安装。

命令：rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,3
结果：显示启动盘。

复制磁盘
模块：diskcopy.dll
命令：rundll32.exe diskcopy.dll,DiskCopyRunDll

时间/日期
模块： timedate.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,0
结果： 显示设置日期/时间。

命令： rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,1
结果： 显示设置时间区域。

拨号连接(DUN)
模块： rnaui.dll
命令： rundll32.exe rnaui.dll,RnaDial 连接_名称
结果： 打开指定的拨号连接。
例子：
x= Shell("rundll32.exe rnaui.dll,RnaDial " & "连接_名称", 1)

显示器
模块： desk.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0
结果： 背景设置。

命令： rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,1
结果： 屏幕保护设置。

命令： rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,2
结果： 外观设置。

命令： rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3
结果： 设置窗口。

操纵杆
模块： joy.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL joy.cpl

邮件/传真
模块： mlcfg32.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL mlcfg32.cpl
结果： 出现 MS Exchange 属性设置。

邮局设置
模块： wgpocpl.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL wgpocpl.cpl
结果： 显示 MS Postoffice Workgroup Admin 设置。

主设置
模块： main.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @0
结果： 显示鼠标属性。

命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @1
结果： 显示键盘/速度属性。

命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @1,,1
结果： 显示键盘/语言属性。

命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @1,,2
结果： 显示键盘/常规属性。

命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @2
结果： 显示打印机属性。

命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @3
结果： 显示字体属性。

命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @4
结果： 显示电源管理属性。

增加 Modem
模块：modem.cpl
命令：rundll32.exe shell32.dll,Control_RunDLL modem.cpl,,add

多媒体
模块： mmsys.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,0
结果：声音。

命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,1
结果：视频。

命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,2
结果：声音 MIDI。

命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,3
结果：CD/音乐。

命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,4
结果：高级。

命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl @1
结果：声音。

网络
模块：netcpl.cpl
命令：rundll32.exe shell32.dll,Control_RunDLL netcpl.cpl

打开方式窗口(Open With)
模块： shell32.dll
命令：rundll32.exe shell32.dll,OpenAs_RunDLL path\filename

口令
模块： password.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL password.cpl

区域设置
模块： intl.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,0
结果： 区域设置。

命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,1
结果： 数字格式设置。

命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,2
结果： 金额格式设置。

命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,3
结果：时间格式设置。

命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,4
结果： 日期格式设置。

屏幕保护
模块： appwiz.cpl
命令： rundll32.exe desk.cpl,InstallScreenSaver c:\win\system\Flying Windows.scr
结果： 安装屏幕保护并显示预览属性页。

系统设置
模块： sysdm.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,0
结果： 显示常规设置。

命令： rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,1
结果： 显示设备管理设置。

命令： rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,2
结果： 显示硬件设置。

命令： rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,3
结果： 显示性能设置。

IE4 设置
模块： inetcpl.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl
返回