登录  
 加关注
查看详情
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

面包会有的

... ...

 
 
 

日志

 
 

VB使用大全 - 10  

2007-09-08 14:35:48|  分类: 默认分类 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

157、如何侦测目前文字框中共有几行?
要判断文字框中目前有几行,可以使用回圈判断共有几个换行字元来取得,但是在这儿我们要使用 API 来做到这个功能!
'请在 Form 中放一个 TextBox 及一个 label,在声明区中加入以下声明:
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const EM_GETLINECOUNT = &HBA
'在 Text1 的 Change 事件中加入以下程序码:
Sub Text1_Change()
Dim lineCount As Long
On Local Error Resume Next
'立刻侦测目前文字框中共有几行
lineCount = SendMessageLong(Text1.hwnd, EM_GETLINECOUNT, 0&, 0&)
Label1 = "文字框中共有 " & Format$(lineCount, "##,###") & " 行"
End Sub
158、如何判断使用者电脑中系统字型大小?
在【问题】如何算出屏幕的分辨率?我们提到:如果希望使用者在跑我们开发的应用程序时,看到的画面的样子和我们在 Design Time 时一样的话,我们往往需要处理屏幕分辨率的问题。
除了屏幕的分辨率之外,电脑中设定的字型大小是大字型 ( Large Font ) 或小字型 ( Small Font ) 或其他大小的自订字型,也是一个影响的因素,要如何侦测电脑中的字型大小呢?
由【控制面板】的【显示器】【设定】页签中,我们可以得知以下讯息:
大字型 ( Large Font ):120 dpi
小字型 ( Small Font ):96 dpi
以下之程序可以判断系统是否使用小字型,当然大字型之判断方式也相同:
请在模组中加入以下声明及模组:
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Const LOGPIXELSX = 88
Public Function IsScreenFontSmall() As Boolean
Dim hWndDesk As Long
Dim hDCDesk As Long
Dim logPix As Long
Dim r As Long
hWndDesk = GetDesktopWindow()
hDCDesk = GetDC(hWndDesk)
logPix = GetDeviceCaps(hDCDesk, LOGPIXELSX)
r = ReleaseDC(hWndDesk, hDCDesk)
IsScreenFontSmall = (logPix = 96)
End Function
在程序中呼叫 IsScreenFontSmall 若返回值为 True 即为小字型。

159、使用 Label 模拟资源管理器左右窗口中的调整杆 ( Splitter )

要模拟这个功能,有很多种不同的作法,今天我们要使用一个 Label 控制项来分割分别放在左右的 TreeView 及 ListView,整个动作的重点在于,当我们在分隔线上按下鼠标左键时,就准备调整视窗中各控制项的大小,当我们放开鼠标左键时,就停止调整的动作!

'在 Form 中放入一个 Label,一个 TreeView 及 一个 ListView,位置不拘,并加入以下程序码:

Private mbResizing As Boolean '判断是否按下鼠标左键 (准备调整大小)

Private Sub Form_Load()
'设定 TreeView1 为屏幕 1/3,ListView1 为屏幕 2/3
TreeView1.Move 0, 0, Me.ScaleWidth / 3, Me.ScaleHeight
ListView1.Move (Me.ScaleWidth / 3) + 50, 0, (Me.ScaleWidth * 2 / 3) - 50, Me.ScaleHeight
Label1.Move Me.ScaleWidth / 3, 0, 100, Me.ScaleHeight
Label1.MousePointer = vbSizeWE
End Sub

Private Sub Form_Resize()
'设定 TreeView1 为屏幕 1/3,ListView1 为屏幕 2/3
TreeView1.Move 0, 0, Me.ScaleWidth / 3, Me.ScaleHeight
ListView1.Move (Me.ScaleWidth / 3) + 50, 0, (Me.ScaleWidth * 2 / 3) - 50, Me.ScaleHeight
Label1.Move Me.ScaleWidth / 3, 0, 100, Me.ScaleHeight
Label1.MousePointer = vbSizeWE
End Sub

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'准备调整大小
If Button = vbLeftButton Then mbResizing = True
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'按下鼠标左键并移动时, 自动调整各控制项大小
If mbResizing Then
Dim nX As Single
nX = Label1.Left + X
If nX < 500 Then Exit Sub
If nX > Me.ScaleWidth - 500 Then Exit Sub
TreeView1.Width = nX
ListView1.Left = nX + 50
ListView1.Width = Me.ScaleWidth - nX - 50
Label1.Left = nX
End If
End Sub

Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'停止调整大小
mbResizing = False
End Sub

160、【万用文件搜寻器】--- 将 Windows 的【寻找文件】功能套进 VB 中

这个 Walkdir 模组可以让您从任何一个目录往下所有目录中找寻符合您要求的所有文件!根据实际测试的结果,搜寻文件的速度和 Windows 的【寻找文件】功能不相上下,有时甚至更快呢!

共有三个参数说明如下:

1、文件类型:可接受万用字符 *,可同时设定多个类型(中间用分号隔开),例如 ( OLE*.DLL; *.TLB )
2、开始目录:可以是根目录。
3、字串阵列:用来存放符合的文件名称 (全路径文件名),是一个动态阵列。

这个模组会使用递回的方式一层一层的搜寻所有的子目录,找出所有符合条件的文件,并将文件名称 (含全路径) 放入字串阵列中,这个阵列的大小会自动根据找到的文件个数而自动调整,最后阵列的大小就是找到的文件个数!

要实际使用这个模组,您必须先在 Form 中放入一个 DirListBox 及一个 FileListBox,分别取名为 Dir1 及 File1,最好将这二个控制项的 Visible 属性设成 False,可以大大加快搜寻的速度。

'以下是使用的范例: (  要一个 CommandButton 及一个 ListBox )

Private Sub Command1_Click()
ReDim sarray(0) As String
'找寻 Windows 目录下文件类型为 OLE*.DLL 的所有文件
Call DirWalk("OLE*.DLL", "C:\windows", sarray)
'将阵列的资料放到 List1 中
Dim i As Integer
For i = LBound(sarray) To UBound(sarray) - 1
List1.AddItem sarray(i)
Next
End Sub

'模组内容如下:

Sub DirWalk(ByVal sPattern As String, ByVal CurrDir As String, sFound() As String)
Dim i As Integer
Dim sCurrPath As String
Dim sFile As String
Dim ii As Integer
Dim iFiles As Integer
Dim iLen As Integer

If Right$(CurrDir, 1) <> "\" Then
Dir1.Path = CurrDir & "\"
Else
Dir1.Path = CurrDir
End If
For i = 0 To Dir1.ListCount
If Dir1.List(i) <> "" Then
DoEvents
Call DirWalk(sPattern, Dir1.List(i), sFound())
Else
If Right$(Dir1.Path, 1) = "\" Then
sCurrPath = Left(Dir1.Path, Len(Dir1.Path) - 1)
Else
sCurrPath = Dir1.Path
End If
File1.Path = sCurrPath
File1.Pattern = sPattern
If File1.ListCount > 0 Then
'在目录中找到符合的文件
For ii = 0 To File1.ListCount - 1
ReDim Preserve sFound(UBound(sFound) + 1)
sFound(UBound(sFound) - 1) = sCurrPath & "\" & File1.List(ii)
Next ii
End If
iLen = Len(Dir1.Path)
Do While Mid(Dir1.Path, iLen, 1) <> "\"
iLen = iLen - 1
Loop
Dir1.Path = Mid(Dir1.Path, 1, iLen)
End If
Next i
End Sub

161、如何移除 MDIForm 的 Max/Min Button?
不像其他的 Form 一样,MDIForm 并没有提供 MaxButton 及 MinButton 的属性来让我们移除最大化及最小化的按钮,如果您想移除 MDIForm 的最大化及最小化的按钮,您可以在 MDIForm 中加入以下的程序,但是如果您只想移除其中的一个,则只要将对应的程序码加上注解符号即可。
'请在 MDIForm 的声明区中加入以下声明
#If Win32 Then
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
#Else
Private Declare Function SetWindowLong Lib "User" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "User" (ByVal hwnd As Integer, ByVal nIndex As Integer) As Long
#End If
Const WS_MINIMIZEBOX = &H20000 '最小化
Const WS_MAXIMIZEBOX = &H10000 '最大化
Const GWL_STYLE = (-16)
'在 MDIForm 的 MDIForm_Load 事件中加入以下程序码
Sub MDIForm_Load()
Dim lWnd As Long
lWnd = GetWindowLong(Me.hwnd, GWL_STYLE)
lWnd = lWnd And Not (WS_MINIMIZEBOX) '最小化
lWnd = lWnd And Not (WS_MAXIMIZEBOX) '最大化
lWnd = SetWindowLong(Me.hwnd, GWL_STYLE, lWnd)
End Sub
162、如何防止 Form 被移动?
有些应用程序,我们希望固定 Form 的位置,不希望使用者移动它,在 VB5 以上的版本,我们可以直接在属性表中设定 Form 的 Moveable 属性为 False 即可。
但是 VB4 以下的版本却没有这个功能,这时就得借助 API 的功能了!而我们实际要做的,就是移除系统功能表 ( ControlBox ) 中的【移动】的功能,您可以检查一下您现在使用的浏览器左上方的系统功能表,【移动】的位置是第二个,所以 Index = 1 ( index 由 0 算起 )。
'请在表单的声明区中加入以下声明
Private Declare Function GetSystemMenu Lib "User" (ByVal hWnd As Integer, ByVal bRevert As Integer) As Integer
Private Declare Function RemoveMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
Const MF_BYPOSITION = &H400
'在 Form_Load 事件中加入以下程序码
Private Sub Form_Load()
SystemMenu% = GetSystemMenu(hWnd, 0)
Res% = RemoveMenu(SystemMenu%, 1, MF_BYPOSITION) <--- 第二个参数是 Index
End Sub
163、如何设定 ComboBox 之最大长度?
在文字框 (TextBox) 中,我们可以设定 MaxLength 属性来设定文字框可输入的最大长度,但是同样具有一个文字框的 ComboBox,却没有提供这样的功能!要做到这个功能,必须自己写程序来判断。'下面就是一个范例程序:
'我们在 Key_Press 事件来处理,程序中假设最大长度为 10,并已将倒退键排除在外
Private Sub Combo1_KeyPress(KeyAscii As Integer)
Const MAXLENGTH = 10 '设定最大长度为 10
If Len(Combo1.Text) >= MAXLENGTH And KeyAscii <> vbKeyBack Then
KeyAscii = 0
End If
End Sub
164、如何撰写没 Form 的程序?
一般在撰写 VB 的程序时,由于一进入 VB 的环境时就会自动产生一个 Form1,而 VB 本身又是一种事件驱动程序,所以有些人一直认为 VB 的程序一定会有一个以上的 Form 存在。其实 VB 也可以撰写一些完全没有表单 (Form) 的程序。
撰写的方法如下:
1、启动一个新的工程 (Project)
2、移除 Form1
3、开启一个 Module (名称可自取,或使用 Default 名称 Module1)
4、在 Module 中加入一段名为 Main 的 SubRoutine (名称一定要取为 Main)
'例:下面的程序执行时会开启 c:\test.txt 并写入一个数字,然后直接结束,没有任何表单。
Public Sub Main()
Open "c:\test.txt" For Output As #3
Print #3, 6666
Close #3
End '可有可无,会自动结束
End Sub
165、别让 MsgBox 中断了一些 Background 的处理作业
在 VB 中,一旦您呼叫了 MsgBox,您正在执行的一些 Background 的处理作业,例如计数器或时钟...等,都会停下来,直到您回应了 MsgBox 之后,一切才会恢复正常!或许您并不希望如此,这也有可能造成一些不必要的错误!
要解决这个问题,您必须使用 Windows API 去呼叫 MessageBox Function,它的使用方法、外观和 MsgBox 的结果完全相同,但是它却不会中断一些 Background 的处理作业!
在以下的范例中,您要在 Form 中加入一个 Label、二个 CommandButton 及一个 Timer,不更改任何属性。
'在声明区中加入以下声明:
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
'加入以下程序码:
Private Sub Command1_Click()
MsgBox "计时器停掉了!", 64, "VB 的讯息框"
End Sub
Private Sub Command2_Click()
MessageBox Me.hwnd, "注意!计时器还在跑!", "API 的讯息框", 64
End Sub
Private Sub Form_Load()
Timer1.Interval = 1000
Label1.Caption = "目前的时间是:" & Time
End Sub
Private Sub Timer1_Timer()
Label1.Caption = "目前的时间是:" & Time
End Sub

166、如何找出 Windows / System / Temp 目录的正确路径?(二)
记得我们分三个单元来说明如何找出 Windows / System / Temp 目录的正确路径?
当时我们都是使用 API 来做,使用的 API 分别是:
问题 如何找出 Windows 目录的正确路径?
使用 GetWindowsDirectory Function
问题 如何找出 System 目录的正确路径?
使用 GetSystemDirectory Function
问题 如何找出 Temp 目录的正确路径?
使用 GetTempPath Function
有的人不太喜欢使用 API,一来有的 API 有点难,一来比较不容易找到完整的资料说明或完整的范例。不过以上三个题目都可以不使用 API 就得到答案的!原因如下:
在我们启动电脑的同时,我们的操作系统,会挪出一个区块,用来存放一些系统环境变量,或许您会问,到底存了哪些东西呢?其实说来不外乎几个来源:
1、Autoexec.bat:TMP / TEMP / PATH / PROMPT .....
2、Config.sys:COMSPEC .....
3、Msdos.sys:WinDir / WinBootDir .....
4、当然您的电脑中不一定有 Autoexec.bat 或 Config.sys,不过没关系,系统自己会给定一些初始值!
而这些环境变量,在 VB 中只要使用 ENVIRON Statement 就可以抓得到!语法如下:
Environ[$](environmentstring)
其中 environmentstring 是一个环境变量的字串,例如:〈TEMP〉、〈WinDir〉、〈PATH〉...等。
所以,如果您 .....
要得到 TEMP 的路径,只要使用 Environ("TEMP") 即可,结果可能为 C:\WINDOWS\TEMP。
要得到 Windows 的路径,只要使用 Environ("Windows") 即可,结果可能为 C:\WINDOWS。
而如果您想找到 System 的路径,我想有了 Windows 路径之后,应该不是难事了吧!
167、如何将长文件名转成短文件名格式 (MS-DOS 8.3)
虽然在 Windows95/98 中已经都可以使用长文件名/目录 (最长可以到255个字元),但是在您将长文件名的文件或目录存档时,系统同时给了它一个可以相容于以前 MS-DOS 时代的 8.3 格式的文件名称!
到目前为止,还是有些软件会使用 8.3 格式的文件名称,在安装这些软件时,它们写到注册表中的资料,仍然采用 8.3 格式的文件名称,所以有时候,您在维护系统时,必须知道目前这时长文件的档案,转成 8.3 格式的文件名称之后是什么文件。
以下这个范例会让您在 DirListBox 及 FileListBox 中选择目录及文件名称,然后将您选出的(长)文件名转成 8.3 格式的文件名称,如果您有注意到的话,它不但是将文件名称转掉,连长文件的目录名称也会一起转成 8.3 格式的文件名称。
由于程序码较长,我不再列出程序码,而直接将文件压缩下载:
168、清除画面中各栏位资料
当一个 Form 中只有二、三个物件的时候,您要清除其中的资料,您会一个栏位一个栏位来清除,反正就是那么几个物件,二三行指令也就解决了!
但是,若您的 Form 中有二、三十个,甚至五、六十个以上的物件时,可就要想想办法了!以下的这个模组就在这种情形下产生了,一般要清除资料,最重要的二个属性就是 .Text 及 .LisIndex。
Public Sub ClearAllControls(frmFORM As Form)
Dim ctlControl As Object
On Error Resume Next
For Each ctlControl In frmFORM.Controls
ctlControl.Text = ""
ctlControl.ListIndex = -1
DoEvents
Next
End Sub
而在程序中要呼叫这个模组只要如下使用即可:
call ClearAllControls(Me)
169、为您精心设计的画面拍张快照吧!( Taking a screenshot )
我们在设计系统时,有时候会保留让使用者做屏幕 HardCopy 的功能。
以前,我总是要求使用者自己去按键盘上的【Print Screen】按钮,将画面的影像留在【剪贴板】中,并要求使用者自己到 Windows95/98 提供的【小画家】或【小作家】中,先做【贴上】的动作后,再将画面影像存成 .BMP 档或直接由印表机中印出。
上面这些动作,对一个程序开发者,或一个熟练的操作者并不困难,但是,很可悲的,大部份的使用者都不属于以上所描述的二种人,例如:我曾经写过一个系统是给大楼清洁维护公司的人员用的,其中有很多使用者甚至是一些学历不高的『欧巴尚』,不但程序的设计都要简化操作,连系统上线都是高难度的,更别说屏幕的 HardCopy 列印、存档的动作了!
不过,以上的动作,我们都可以直接在 VB 的程序中做到,要做到这个功能有二个方法:
方法一:直接模拟按【Print Screen】按钮,再将【剪贴板】中的图像抓到 Picture 中。
方法二:完全使用 API 来处理。
下面来看看第二种做法:

请在声明区中加入以下声明:
Private Declare Function GetDesktopWindow Lib "user32" () As Long
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 BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
'在 Form 中加入二个 CommandButton,及一个 PictureBox,不必更改属性,加入以下程序码:
Private Sub Form_Load()
'将 Picture1 之长宽设定成和屏幕一样大小
Picture1.Width = Screen.Width
Picture1.Height = Screen.Height
End Sub
Private Sub Command1_Click()
'将屏幕画面抓下后放到 Picture1 中
Dim lngDesktopHwnd As Long
Dim lngDesktopDC As Long
Picture1.AutoRedraw = True
Picture1.ScaleMode = vbPixels
lngDesktopHwnd = GetDesktopWindow
lngDesktopDC = GetDC(lngDesktopHwnd)
Call BitBlt(Picture1.hdc, 0, 0, Screen.Width, Screen.Height, lngDesktopDC, 0, 0, SRCCOPY)
Picture1.Picture = Picture1.Image
Call ReleaseDC(lngDesktopHwnd, lngDesktopDC)
End Sub
Private Sub Command2_Click()
'将 Picture1 中的屏幕画面存成 .BMP 档
SavePicture Picture1, "C:\TEST.BMP"
End Sub
在以上的范例中,只要按下 Command1 就会将屏幕的画面截取下来放到 Picture1 中,按下 Command2 之后,就会将 Picture1 中的图片存成文件 ( 文件名称可自行更改 ),如果您想打印,也可以直接使用 PaintPicture 将图片丢到打印机中打出!
至于图片的打印,以后会另有单元介绍。

170、随心所欲地移除表单左上方的系统功能表的某几个项目

针对这个主题,其实以前已经讨论过二次了,只不过不是以这样直接了当的方式点出在题目中而已,不知道大家是否有印象?

这二次分别是:问题:如何移除 Form 右上方之『X』按钮?

对应到系统功能表的【关闭】选项问题:如何防止 Form 被移动?对应到系统功能表的【移动】选项而我在网路上闲逛时,看到有个外国人用了一个很笨的方法写了一个模组,不过对于不想研究 API 的人来说应该是很好用的模组,可以让您用选择的方式随便您想移除系统功能表的任一个项目!完整程序码如下,说明加在其中:

'在声明区中加入以下声明:

'抓取系统 Menu 的 hwnd
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Integer, ByVal bRevert As Integer) As Integer

'移除系统 Menu 的 API
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
'第一个参数是系统 Menu 的 hwnd
'第二个参数是要移除选项的 Index

Private Const MF_BYPOSITION = &H400&

'模组内容如下:

Private Sub RemoveMenus(frm As Form, remove_restore As Boolean, remove_move As Boolean, remove_size As Boolean, remove_minimize As Boolean, remove_maximize As Boolean, remove_seperator As Boolean, remove_close As Boolean)

Dim hMenu As Long' 抓取系统 Menu 的 hwnd

hMenu = GetSystemMenu(hWnd, False)

If remove_close Then RemoveMenu hMenu, 6, MF_BYPOSITION '是否移除【关闭】选项
If remove_seperator Then RemoveMenu hMenu, 5, MF_BYPOSITION '是否移除【分隔线】
If remove_maximize Then RemoveMenu hMenu, 4, MF_BYPOSITION '是否移除【放到最大】选项
If remove_minimize Then RemoveMenu hMenu, 3, MF_BYPOSITION '是否移除【缩到最小】选项
If remove_size Then RemoveMenu hMenu, 2, MF_BYPOSITION '是否移除【大小】选项
If remove_move Then RemoveMenu hMenu, 1, MF_BYPOSITION '是否移除【移动】选项
If remove_restore Then RemoveMenu hMenu, 0, MF_BYPOSITION '是否移除【还原】选项
End Sub

这个模组共有八个参数,第二个到第八个参数分别对应到系统功能表的七个选项! ( True / False )

今天如果我想做到和问题如何移除 Form 右上方之『X』按钮?一样的结果,表示我要将对应到系统功能表的【关闭】选项移除,则我只要将相对应的参数设成 True 即可,其他要保留的则为 False。

范例如下:

Private Sub Form_Load()
  RemoveMenus Me, False, False, False, False, False, True, True
End Sub

  评论这张
 
阅读(668)| 评论(0)

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2018