［上一页］（42）［下一页］

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

［上一页］（42）［下一页］