📄 vbtips.htm
字号:
<html>
<head>
<meta http-equiv="Content-Type"
content="text/html; charset=gb_2312-80">
<meta name="GENERATOR" content="Microsoft FrontPage Express 2.0">
<title>VB技巧</title>
</head>
<body>
<h1 align="center"><a name="Return"></a>VB技巧<font size="5"><strong>(1)</strong></font></h1>
<blockquote>
<p align="left"><strong>1 </strong><a href="#Tips0001"><strong>利用键盘精确移动控件和设置控件尺寸</strong></a><strong><br>
2 </strong><a href="#Tips0002"><strong>按字母或数字顺序排列列表框中的列表项.</strong></a><strong><br>
3 </strong><a href="#Tips0003"><strong>Tag属性的妙用.</strong></a><strong><br>
4 </strong><a href="#Tips0004"><strong>利用VB产生屏幕变暗的效果.</strong></a><strong><br>
5 </strong><a href="#Tips0005"><strong>使两个列表框(ListBox)的选项同步</strong></a><strong><br>
6 </strong><a href="#Tips0006"><strong>获得Win9X下文件的短文件名(8.3文件名)</strong></a><strong><br>
7 </strong><a href="#Tips0007"><strong>使指定窗口总处于其他窗口之上</strong></a><strong><br>
8 </strong><a href="#Tips0008"><strong>获得位图文件的信息</strong></a><strong><br>
9 </strong><a href="#Tips0009"><strong>获得驱动器的卷标</strong></a><strong><br>
10 </strong><a href="#Tips0010"><strong>将包含有Null结尾的字符串转换为VB字符串</strong></a><strong><br>
11 </strong><a href="#tips0011"><strong>启动控制面板命令</strong></a></p>
</blockquote>
<div align="center"><center>
<table border="0" width="88%">
<tr>
<td width="80%"><p align="left">[1] <a
href="vbtips1.htm#top">[2]</a> <a href="vbtips2.htm">[3]</a>
<a href="vbtips3.htm">[4]</a> <a href="vbtips4.htm">[5]</a>
<a href="vbtips5.htm">[6]</a> <a href="vbtips7.htm">[7]</a>
<a href="vbtips08.htm#home">[8]</a> <a href="vbtips9.htm">[9]</a>
<a href="vbtips10.htm">[10]</a></p>
</td>
<td><p align="right"><font size="2">第一页(共十页)</font></p>
</td>
</tr>
</table>
</center></div>
<hr>
<div align="center"><center>
<table border="0" width="88%">
<tr>
<td><a name="Tips0001"></a><font size="4"><strong>利用键盘精确移动控件和设置控件尺寸<br>
</strong></font>选中控件,按Ctl+上下左右键就可以以一个Grid为单位移动控件.按Shift+上下左右键就可以以一个Grid为单位扩大缩小控件.<br>
<a href="#Return">返回</a><p><a name="Tips0002"></a><font
size="4"><strong>按字母或数字顺序排列列表框中的列表项.<br>
</strong></font>将以下代码加入到你的程序中.<br>
Sub ReSort(L As Control)<br>
Dim P%, PP%, C%, Pre$, S$, V&, NewPos%, CheckIt%<br>
Dim TempL$, TempItemData&, S1$<br>
<br>
For P = 0 To L.ListCount - 1<br>
S = L.List(P)<br>
For C = 1 To Len(S)<br>
V = Val(Mid$(S, C))<br>
If V > 0 Then Exit For<br>
Next<br>
If V > 0 Then<br>
If C > 1 Then Pre = Left$(S, C - 1)<br>
NewPos = -1<br>
For PP = P + 1 To L.ListCount - 1<br>
CheckIt = False<br>
S1 = L.List(PP)<br>
If Pre <> "" Then<br>
If InStr(S1, Pre) = 1 Then CheckIt = True<br>
Else<br>
If Val(S1) > 0 Then CheckIt = True<br>
End If<br>
If CheckIt Then<br>
If Val(Mid$(S1, C)) < V Then NewPos = PP<br>
Else<br>
Exit For<br>
End If<br>
Next<br>
If NewPos > -1 Then<br>
TempL = L.List(P)<br>
TempItemData = L.ItemData(P)<br>
L.RemoveItem (P)<br>
L.AddItem TempL, NewPos<br>
L.ItemData(L.NewIndex) = TempItemData<br>
P = P - 1<br>
End If<br>
End If<br>
Next<br>
Exit Sub<br>
<a href="#Return">返回</a></p>
<p><a name="Tips0003"></a><font size="4"><strong>Tag属性的妙用.<br>
</strong></font>在VB编程中,我们经常要动态的控制很多不同控件的属性,例如我们要将一个CommandButton阵列共20各控件中的第1、4、6、7、8、11、18、20号删除。该怎么半呢？这时只要将要删除的控件的Tag属性设置为1，然后加入以下代码就可以了。<br>
For i=1 To 20<br>
If Command1(i).Tag=1 Then<br>
Unload Command1(i)<br>
End If<br>
Next i<br>
<a href="#Return">返回</a></p>
<p><a name="Tips0004"></a><font size="4"><strong>利用VB产生屏幕变暗的效果.</strong></font><br>
想利用VB编程实现屏幕变暗的效果（向关闭Win95时的效果），只要按下面的步骤来做<br>
1、在Form1中加入两个CommandButton和一个PictureBox.<br>
2、在Form1的代码窗口中添加以下代码：<br>
Private Type RECT<br>
Left As Long<br>
Top As Long<br>
Right As Long<br>
Bottom As Long<br>
End Type<br>
<br>
Private Declare Function GetDC Lib "user32"
(ByVal hwnd As Long) As Long<br>
Private Declare Function ReleaseDC Lib "user32"
(ByVal hwnd As Long, ByVal hdc As Long) As <br>
Long<br>
Private Declare Function CreatePatternBrush Lib
"gdi32" (ByVal hBitmap As Long) As Long<br>
Private Declare Function PatBlt Lib "gdi32"
(ByVal hdc As Long, ByVal x As Long, ByVal y As <br>
Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal
dwRop As Long) As Long<br>
Private Declare Function DeleteObject Lib
"gdi32" (ByVal hObject As Long) As Long<br>
Private Declare Function CreateBitmap Lib
"gdi32" (ByVal nWidth As Long, ByVal nHeight As
<br>
Long, ByVal nPlanes As Long, ByVal nBitCount As Long,
lpBits As Any) As Long<br>
Private Declare Function SelectObject Lib
"gdi32" (ByVal hdc As Long, ByVal hObject As
Long) <br>
As Long<br>
Private Declare Function InvalidateRect Lib
"user32" (ByVal hwnd As Long, ByVal lpRect As <br>
Long, ByVal bErase As Long) As Long<br>
<br>
Private bybits(1 To 16) As Byte<br>
Private hBitmap As Long, hBrush As Long<br>
Private hDesktopWnd As Long<br>
<br>
Private Sub Command1_Click()<br>
Dim rop As Long, res As Long<br>
Dim hdc5 As Long, width5 As Long, height5 As Long<br>
<br>
hdc5 = GetDC(0)<br>
width5 = Screen.Width \ Screen.TwipsPerPixelX<br>
height5 = Screen.Height \ Screen.TwipsPerPixelY<br>
<br>
rop = &HA000C9<br>
Call SelectObject(hdc5, hBrush)<br>
res = PatBlt(hdc5, 0, 0, width5, height5, rop)<br>
Call DeleteObject(hBrush)<br>
<br>
res = ReleaseDC(0, hdc5)<br>
End Sub<br>
<br>
Private Sub Command2_Click()<br>
Dim aa As Long<br>
<br>
<br>
aa = InvalidateRect(0, 0, 1)<br>
End Sub<br>
<br>
Private Sub Form_Load()<br>
Dim ary<br>
Dim i As Long<br>
ary = Array(&H55, &H0, &HAA, &H0, _<br>
&H55, &H0, &HAA, &H0, _<br>
&H55, &H0, &HAA, &H0, _<br>
&H55, &H0, &HAA, &H0)<br>
For i = 1 To 16<br>
bybits(i) = ary(i - 1)<br>
Next i<br>
hBitmap = CreateBitmap(8, 8, 1, 1, bybits(1))<br>
hBrush = CreatePatternBrush(hBitmap)<br>
Picture1.ForeColor = RGB(0, 0, 0)<br>
Picture1.BackColor = RGB(255, 255, 255)<br>
Picture1.ScaleMode = 3<br>
End Sub<br>
运行程序，按Command1就可以使屏幕暗下来，按Command2恢复。<br>
<a href="#Return">返回</a></p>
<p><a name="Tips0005"></a><font size="4"><strong>使两个列表框(ListBox)的选项同步<br>
</strong></font>步骤1<br>
在Form中添加两个ListBox和一个CommandButton一个Timer,不要改动他们的属性.<br>
步骤2<br>
在Form中添加如下代码:<br>
Private Sub Form_Load()<br>
Dim X As Integer<br>
<br>
For X = 1 To 26<br>
List1.AddItem Chr$(X + 64)<br>
Next X<br>
For X = 1 To 26<br>
List2.AddItem Chr$(X + 64)<br>
Next X<br>
Timer1.Interval = 1<br>
Timer1.Enabled = True<br>
End Sub<br>
<br>
Private Sub Command1_Click()<br>
End<br>
End Sub<br>
<br>
Private Sub timer1_Timer()<br>
Static PrevList1<br>
Dim TopIndex_List1 As Integer<br>
<br>
TopIndex_List1 = List1.TopIndex<br>
<br>
If TopIndex_List1 <> PrevList1 Then<br>
List2.TopIndex = TopIndex_List1<br>
PrevList1 = TopIndex_List1<br>
End If<br>
<br>
If List1.ListIndex <> List2.ListIndex Then<br>
List2.ListIndex = List1.ListIndex<br>
End If<br>
End Sub<br>
运行程序,当选中其中一个列表框中的某一项后,另外一个列表框中的相应项就会被选中.<br>
<a href="#Return">返回</a></p>
<p><a name="Tips0006"></a><font size="4"><strong>获得Win9X下文件的短文件名(8.3文件名)<br>
</strong></font>步骤一<br>
在Form中加入一个FileListBox,一个DirListBox,一个Label.<br>
步骤二<br>
在Form中加入以下代码:<br>
Private Declare Function GetShortPathName Lib
"kernel32" Alias "GetShortPathNameA"
(ByVal <br>
lpszLongPath As String, ByVal lpszShortPath As String,
ByVal cchBuffer As Long) As Long<br>
<br>
Private Sub Dir1_Change()<br>
File1 = Dir1.Path<br>
End Sub<br>
<br>
Private Sub Drive1_Change()<br>
Dir1 = Drive1 <br>
End Sub<br>
<br>
Private Sub File1_Click()<br>
Label1.Caption = GetShortFileName(Dir1 &
"\" & File1) <br>
End Sub<br>
<br>
Public Function GetShortFileName(ByVal FileName As
String) As String<br>
'converts a long file and path name to old DOS format<br>
'PARAMETERS<br>
' FileName = the path or filename to convert<br>
'RETURNS<br>
' String = the DOS compatible name for that particular
FileName<br>
<br>
Dim rc As Long<br>
Dim ShortPath As String<br>
Const PATH_LEN& = 164<br>
<br>
'get the short filename<br>
ShortPath = String$(PATH_LEN + 1, 0)<br>
rc = GetShortPathName(FileName, ShortPath, PATH_LEN)<br>
GetShortFileName = Left$(ShortPath, rc)<br>
End Function<br>
<a href="#Return">返回</a></p>
<p><a name="Tips0007"></a><font size="4"><strong>使指定窗口总处于其他窗口之上</strong></font><br>
将以下代码加入到Form中,这个Form就成为一个在其他所有窗口之上的窗口了.<br>
<br>
Private Declare Function SetWindowPos Lib
"user32" (ByVal hwnd As Long, ByVal
hWndInsertAfter<br>
As Long, ByVal x As Long, ByVal y As Long, ByVal cx As
Long, ByVal cy As Long, ByVal wFlags<br>
As Long) As Long<br>
<br>
Const HWND_TOPMOST = -1<br>
<br>
Private Sub Form_Load()<br>
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left /
Screen.TwipsPerPixelX _<br>
, Me.Top \ Screen.TwipsPerPixelY, Me.Width \
Screen.TwipsPerPixelX, _<br>
Me.Height \ Screen.TwipsPerPixelY, 0<br>
End Sub<br>
<a href="#Return">返回</a></p>
<p><a name="Tips0008"></a><font size="4"><strong>获得位图文件的信息</strong></font><br>
在Form中添加一个Picture控件和一个CommandButton控件,在Picture控件中加入一个位图文件,将下面代码加入其中:<br>
Private Declare Function GetObject Lib "gdi32"
Alias "GetObjectA" _<br>
(ByVal hObject As Long, ByVal nCount As Long, lpObject As
Any) _<br>
As Long<br>
Private Declare Function GetBitmapBits Lib
"gdi32" (ByVal hBitmap As Long, _<br>
ByVal dwCount As Long, lpBits As Any) As Long<br>
<br>
Private Type BITMAP<br>
bmType As Long<br>
bmWidth As Long<br>
bmHeight As Long<br>
bmWidthBytes As Long<br>
bmPlanes As Integer<br>
bmBitsPixel As Integer<br>
bmBits As Long<br>
End Type<br>
<br>
Private Sub Command1_Click()<br>
Dim hBitmap As Long<br>
Dim res As Long<br>
Dim bmp As BITMAP<br>
Dim byteAry() As Byte<br>
Dim totbyte As Long, i As Long<br>
hBitmap = Picture1.Picture.Handle<br>
<br>
res = GetObject(hBitmap, Len(bmp), bmp) '取得BITMAP的结构<br>
<br>
totbyte = bmp.bmWidthBytes * bmp.bmHeight '总共要多少BYTE来存图<br>
ReDim byteAry(totbyte - 1)<br>
'将Picture1中的图信息存到ByteAry<br>
res = GetBitmapBits(hBitmap, totbyte, byteAry(0))<br>
<br>
Debug.Print "Total Bytes Copied :"; res<br>
Debug.Print "bmp.bmBits "; bmp.bmBits<br>
Debug.Print "bmp.bmBitsPixel "; bmp.bmBitsPixel
'每相素位数<br>
Debug.Print "bmp.bmHeight "; bmp.bmHeight '以相素计算图象高度<br>
Debug.Print "bmp.bmPlanes "; bmp.bmPlanes<br>
Debug.Print "bmp.bmType "; bmp.bmType<br>
Debug.Print "bmp.bmWidth "; bmp.bmWidth '以相素计算图形宽度<br>
Debug.Print "bmp.bmWidthBytes ";
bmp.bmWidthBytes '以字节计算的每扫描线长度⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -