VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - VB问题全功略(42)
发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:10540, 日期:2002-02-02
VB问题全功略(42)

206、如何算出 TextBox 的总行数?
207、如何预先算出目前在 TextBox 中的资料存档后的文件大小?
208、如何以桌面上的背景图来设定 Form 的背景?
209、改变 ListIndex而不发生 Click 事件
210、调整 Combo 下拉部分的宽度
206、如何算出 TextBox 的总行数?

在很多文字编辑器中,都可以告诉您,目前在编辑器中的文字总共有几行,我们也来实作一下!

有人问我说,要计算文字框中有多少行,只要将光标移到最后方 (Text1.SelLength=Len(Text1)),再使用前一个主题:问题180:如何算出 TextBox 中目前光标是在第几行?的模组就可以算出来了,没错!不过,二种方法都差不了多少,可以任君选择!

在 Form 中放入一个 TextBox 并将 Multiline 属性设为 True,放入一个 Label 用来显示目前 TextBox 中总共有几行,在表单声明区中加入以下声明及模组:

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

Function LineCount(txthwnd As Long) As Long
On Local Error Resume Next
LineCount = SendMessageLong(Text1.hwnd, EM_GETLINECOUNT, 0&, 0&)
LineCount = Format$(lineCount, "##,###")
End Function

注释:呼叫这个模组时要传入的是 TextBox 的 hwnd
注释:实际使用时,用法如下:

Private Sub Command1_Click()
Label1 = LineCount(Text1.hwnd)
End Sub

207、如何预先算出目前在 TextBox 中的资料存档后的文件大小?

之前在问题156: 如何取得文件大小? 我们讨论过已存档文件大小的算法,但是在一笔新资料尚未存档前,我们其实也可以先算出它存档后文件会有多大!作法如下:

在 Form 中放入一个 TextBox 并将 Multiline 属性设为 True,放入一个 Label 用来显示目前 TextBox 中总共有几行,在表单声明区中加入以下声明及模组:

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
Const EM_LINEINDEX = &HBB
Const EM_LINELENGTH = &HC1

Function TextSize(txthwnd As Long) As Long
Dim lineCount As Long
Dim ChrsUpToLast As Long
Dim DocumentSize As Long
On Local Error Resume Next

注释:首先,算出 TextBox 的总行数
lineCount& = SendMessageLong(txthwnd, EM_GETLINECOUNT, 0&, 0&)
注释:接著 ,算出 TextBox 的位元组数
ChrsUpToLast& = SendMessageLong(txthwnd, EM_LINEINDEX, lineCount& - 1, 0&)

If ChrsUpToLast& = 0 Then
DocumentSize& = 0
ElseIf ChrsUpToLast& < 65000 Then
DocumentSize& = SendMessageLong(txthwnd, _
EM_LINELENGTH, ChrsUpToLast&, 0&) + ChrsUpToLast
End If

TextSize = Format$(DocumentSize&, "##,###")
End Function

注释:呼叫这个模组时要传入的是 TextBox 的 hwnd
注释:实际使用时,用法如下:

Private Sub Command1_Click()
Label1 = TextSize(Text1.hwnd)
End Sub

208、如何以桌面上的背景图来设定 Form 的背景?

这个功能是由网友 jimmy 所提供,它的功能就是将 User 桌面的图片直接拿来当作我们表单的背景图。
PaintDesktop API 只 要传入一个数值,就是表单的 hDC 属性值。

请直接将以下之程序码复制到表单中即可:

Private Declare Function PaintDesktop Lib "user32" (ByVal hDC As Long) As Long

Private Sub Form_Paint()
PaintDesktop Me.hDC
End Sub

注:
hDC 属性是 Windows 执行环境的周边设定内容物件代码。在 Windows 执行环境,系统透过给 Printer 物件和应用程序中每个表单和 PictureBox 控制项分配一个周边设定内容,来管理系统显示。可以用 hDC 属性参考物件的周边设定内容代码。这提供了一个传递给 Windows API 呼叫的值。

209、改变 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

210、调整 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

004 把所有的字体名称放到 Combo 98-6-07
For I = 0 To Screen.FontCount - 1
cboFont.AddItem Screen.Fonts(I)
Next I