注册 登录
Office中国论坛/Access中国论坛 返回首页

的个人空间 http://www.office-cn.net/?0 [收藏] [复制] [分享] [RSS]

日志

[转]SendMessage函数的应用(四)

已有 677 次阅读2008-3-9 19:55 |个人分类:API

1,获得光标位置和字符个数.
Cpos=SendMessage(text1.hwnd,187,-1,0)   '光标所在行的首字符在文本中的位置
Lpos=SendMessage(text1.hwnd,201,Cpos,0) '光标所在的行号
Line=SendMessage(text1.hwnd,193,Cpos,0) '这行的字符数.

2.获取第N行的文本
Dim ST As String
ST = Space(110)'必须要事先赋空格
Line=SendMessage(text1.hwnd,196, N-1, ByVal ST 'ST返回获取到的文本,Line返回文本的长度字节数

'下面的未成功
Dim str(256) As Byte, K As Integer
str(1)=1 '最大允许存放256个字符
K = SendMessage (Text1.hwnd,196,2,str(0)) '获取第3行的数据放在str中
text1.text = StrConv(str,vbUnicode) '转换为字符串后显示
   
  说明:在调用SendMessage获取第N行字符串时,lParam需要说明为字节数组,在调用完成后,再将
字节数组转换为字符串;另外,调用前必须在lParam的前两个字节指明允许存放的最大长度,其中第一
个字节为低位,第二个字节为高位,本例将高位(即str(1))置1.说明最大允许存放256个字符。
 
3.开关显示器.

SendMessage Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0 '关闭显示器.
SendMessage Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1 '打开显示器

4.程序控制拉下或收起组合框的下拉列表
   一般情况下,为了拉下或收起组合框的下拉列表,需要用键盘或鼠标进行操作,而有时我们希望程
序运行的某个时刻自动拉出下拉列表(比如在一些演示程序中),为了实现这个目的,我们也只有借助
于SendMessage函数,方法是发一个CB_SHOWDROPDOWN(&H14F)消息给组合框。
   在发CB_SHOWDROPDOWN消息时,wParam参数决定了是拉下列表(=True)还是收起表(=False),
lParam无用(设为0)。
   为说明具体的使用方法,下面提供简单的程序片段:

Const CB_SHOWDROPDOWN=&H14F

   当程序中某处需要拉下组合框Combol的列表时,调用如下语句:

SendMessage Combol.hwnd,CB_SHOWDROPDOWN,True,0

   当需要收起组合框Combol的列表时,调用如下语句:

SendMessage Combol.hwnd,CB_SHOWDROPDOWNN,False,0


5. 返回控件中显示的第一行的行号。

LineNo = SendMessageBynum(CTextBox.hwnd, EM_GETFIRSTVISIBLELINE, 0, 0)
  
6.下面的函数能够滚动控件,不过在滚动之前最好判断控件的文本行数和能够显示的行数,以免滚动时
发生混乱。函数SendMessageBynum是SendMessage函数的安全声明函数,其定义与SendMessage函数完全
相同,只是函数名不同。

Function ScrollTextBox(CTextBox As TextBox, nVal As Long, Optional nVertical As _
  Boolean = True) As Long
If nVertical Then
 ScrollTextBox = SendMessageBynum(CTextBox.hwnd, EM_LINESCROLL, 0, nVal)
Else
 ScrollTextBox = SendMessageBynum(CTextBox.hwnd, EM_LINESCROLL, nVal, 0)
End If
End Function

7.下面的函数将返回控件能显示的行数:(经试,总是引起程序崩溃)

'获取当前字体的矩形区域(即字体的高度与平均宽度等信息)
Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
Private Type TEXTMETRIC
  tmHeight As Long           '字符高度
  tmAscent As Long           '字符上部高度(基线以上)
  tmDescent As Long          '字符下部高度(基线以下)
  tmInternalLeading As Long  '由tmHeight定义的字符高度的顶部空间数目
  tmExternalLeading As Long  '加在两行之间的空间数目
  tmAveCharWidth As Long     '平均字符宽度
  tmMaxCharWidth As Long     '最宽字符的宽度
  tmWeight As Long           '字体的粗细轻重程度
  tmOverhang As Long         '加入某些拼接字体上的附加高度
  tmDigitizedAspectX As Long '字体设计所针对的设备水平方向
  tmDigitizedAspectY As Long '字体设计所针对的设备垂直方向
  tmFirstChar As String      '为字体定义的第一个字符
  tmLastChar As String       '为字体定义的最后一个字符
  tmDefaultChar As String    '字体中所没有字符的替代字符
  tmBreakChar As String      '用于拆字的字符
  tmItalic As Byte           '字体为斜体时非零
  tmUnderlined As Byte       '字体为下划线时非零
  tmStruckOut As Byte        '字体被删去时非零
  tmPitchAndFamily As Byte   '字体间距(低4位)和族(高4位)
  tmCharSet As Byte          '字体的字符集
End Type
Type RECT
  Left As Long
  Top As Long
  Right As Long
  bottom As Long
End Type
Public ST As String

Function GetVisibleLines(CTextBox As TextBox) As Long
Dim rc As RECT  '以象素为单位
Dim tm As TEXTMETRIC
Dim hDC&, lfont&, oldfont&
Dim di&, lc&
lc = SendMessage(CTextBox.hwnd, EM_GETRECT, 0, rc)
lfont = SendMessage(CTextBox.hwnd, WM_GETFONT, 0, 0)
hDC = GetDC(CTextBox.hwnd)
If lfont <> 0 Then oldfont = SelectObject(hDC, lfont)
di = GetTextMetrics(hDC, tm)
If lfont <> 0 Then lfont = SelectObject(hDC, oldfont)
GetVisibleLines = (rc.bottom - rc.top) / tm.tmHeight
di = ReleaseDC(CTextBox.hwnd, hDC)
End Function

8.设置控件的左边距。

Public Const EM_SETMARGINS& = &HD3
Public Const EC_LEFTMARGIN& = &H1

Function SetMargins(CTextBox As TextBox, nVal As Long) As Long
SetMargins = SendMessageBynum(CTextBox.hwnd, EM_SETMARGINS, EC_LEFTMARGIN, nVal)
End Function

9.利用SendMessage函数还可以实现一些有趣的效果:
  例如在按钮的Click事件中加入如下语句:

SendMessage(Command1.hWnd,BM_SETSTYLE,BS_RADIOBUTTON,1)'BM_SETSTYLE = &HF4,BS_RADIOBUTTON = &H4

  运行后点击按钮,就可以把按钮变成一个收音机按钮(经试,变成一个圆孔,有点象单选按纽)。
  如要得到圆形或椭圆形按纽可使用另外2个API函数:

hdc=CreateEllipticRgn(3, 3, 25, 25) '试验成功,这两个函数也用于创建圆形窗体
SetWindowRgn Command1.hWnd, hdc, True
DeleteObject hdc

10.窗体操作
  
Public Const WM_SYSCOMMAND = &H112
Public Const SC_CLOSE = &HF060 '关闭窗体
Public Const SC_MINIMIZE = &HF020 '最小化窗体
Public Const SC_MAXIMIZE = &HF030 '最大化窗体
Public Const SC_RESTORE = &HF120 '恢复窗体大小
Public Const WM_SETTEXT = &HC '设置窗体的Caption
Public Const WM_GETTEXT = &HD '取得窗体的caption

Private Sub Command_Click(Index As Integer)
Dim S As String
S = String(80, Chr(0))
Select Case Index
 Case 0: SendMessage Me.hwnd, WM_GETTEXT, Len(S), ByVal S: Text1 = Left(S, InStr(S, Chr(0)) - 1) '读出窗体的Caption
 Case 1: SendMessage Me.hwnd, WM_SETTEXT, 0, ByVal CStr(Text1.Text)'设置窗体的Caption,由于Text1.text属于Variant类型,所以一定先要用CStr把它转换成字符串
 Case 2: SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MAXIMIZE, ByVal 0&'窗体最大化
 Case 3: SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MINIMIZE, ByVal 0&'窗体最小化
 Case 4: SendMessage Me.hwnd, WM_SYSCOMMAND, SC_RESTORE, ByVal 0&'窗体恢复原来的大小
 Case 5: SendMessage Me.hwnd, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&'关闭窗体
End Select
End Sub

11.文本垂直居中:
  实现这个效果首先TextBox的MultiLine属性必须为True(多行文本,其实这个属性关系创建TextBox内部

使用哪个类,因此一旦创建就不能修改这个属性,所以不能在代码中修改这个属性)

Public Sub VerMiddleText(mText As TextBox)
Dim rc As RECT '以象素为单位
Dim tmpTop As Long
Dim tmpBot As Long
If mText.MultiLine = False Then Exit Sub
Call SendMessage(mText.hwnd, EM_GETRECT, 0, rc)'获得窗口区域的边界
   '进行位置数据计算
With Me.Font
  .Name = mText.Font.Name
  .Size = mText.Font.Size
  .Bold = mText.Font.Bold
End With
tmpTop = ((rc.Bottom - rc.Top) - (mText.Parent.TextHeight("H") \ Screen.TwipsPerPixelY)) \ 2
tmpBot = ((rc.Bottom - rc.Top) + (mText.Parent.TextHeight("H") \ Screen.TwipsPerPixelY)) \ 2
rc.Top = tmpTop
rc.Bottom = tmpBot
mText.Alignment = vbCenter
   '数据计算完毕,再发送EM_SETRECTNP消息(为一个编辑控件设置格式化矩形,与EM_SETRECT类似,只是控件此时不会重画)
Call SendMessage(mText.hwnd, EM_SETRECTNP, 0&, rc)
mText.Refresh
End Sub

12.调整边距:
  如果你查看TextBox中常用的消息,你会发现有这样一对消息:EM_GETMARGINS 和 EM_SETMARGINS,MSDN的解
释是:获取和设置编辑控件的左、右边距(不得用于NT3.51)。具体是左还是右由该消息的参数决定。
  这样做有什么意义呢?有的时候如果你想在texebox中放入其他对象,而又不希望文本被覆盖掉,你就需要用
到这个方法。

Private Sub SetMargin(nLeft As Integer, nRight As Integer, lhWnd As Long)
Dim lLongValue As Long
lLongValue = nRight * &H10000 + nLeft '高四位表示右边距,低四位为左边距
SendMessage lhWnd, EM_SETMARGINS, EC_LEFTMARGIN Or EC_RIGHTMARGIN, lLongValue
End Sub

评论 (0 个评论)

facelist doodle 涂鸦板

您需要登录后才可以评论 登录 | 注册

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-25 15:02 , Processed in 0.093843 second(s), 14 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回顶部