显示鼠标指示地方的全部文本
最近 在用Delphi编写程序时发现 当ListBox(列表框)中的文本超过显示范围时就看不到文本的完整内容 这很不方便 于是决定动手解决这个问题 让鼠标指到哪里就显示哪里的全部文本内容
一 分析问题
我们知道ListBox的Items对象中有一个Strings函数 通过指定索引可获取该索引所对应的文本 那么我们只要在OnMouseMove事件中获取当前鼠标所指的索引即可获取该索引的文本并使用Hint显示出来 因此 重点就在获取鼠标所指的索引 通过查看帮助文件 发现ListBox控件中有一个ItemAtPos函数可返回鼠标所指向的索引 找到了这个函数解决问题就容易多了
二 解决问题
在窗体中 加入一个ListBox控件 将ShowHint属性设置为True 再添加一个CommandButton控件 Caption属性设置为 填充ListBox
双击Button 控件 写入下面的代码
procedure TForm Button Click(Sender TObject)
//用显示System目录中的文件来填充ListBox
var
SearchRec TSearchRec
nResult Integer
const
szFilePath = d \\windows\\system \\* *
begin
//填充ListBox
ListBox Clear
nResult =FindFirst(szFilePath faAnyFile SearchRec) //查找第一个文件
while nResult = do //如果返回值为 表示找到文件
begin
//将找到的文件添加到ListBox中 ExtractFilepath函数用于提取文件路径
ListBox Items Add(ExtractFilePath(szFilePath) + SearchRec Name)
nResult =FindNext(SearchRec) //继续查找下一个文件 至到返回值不为 时
end
end
下面编写关键的部分代码 在ListBox的OnMouseMove事件中 加入下面的代码
procedure TForm ListBox MouseMove(Sender TObject Shift TShiftState X Y Integer)
var
nPos TPoint //将nPos声明为TPoint类型
nIndex Integer
begin
//填充nPos结构
//由于ItemAtPos是利用鼠标在ListBox中的坐标计算出所指位置的 因此我们需要获取鼠标在ListBox中的坐标 在OnMouseMove事件中已经为我们提供了鼠标在ListBox中的坐标 X Y 只需将X Y赋给nPos的x y即可
nPos x =X
nPos y =Y
//使用ItemAtPos函数返回鼠标所在ListBox中的位置
nIndex =ListBox ItemAtPos(nPos True)
if nIndex > then
ListBox Hint =ListBox Items Strings[nIndex] //显示当前位置的文本
end
将上面的代码完成后 就可以实现将鼠标指向ListBox中任何一个Item时就显示出内容来 但是程序还有一个Bug 每次鼠标移动到ListBox中时只能显示一次 这个问题与显示Hint有关 程序默认重复显示Hint的时间为 毫秒 因此只能显示一次Hint 只要我们修改重复显示Hint的时间即可解决这个问题 在窗体中加入一个ApplicationEvents控件 在OnShowHint事件中加入下面的代码
procedure TForm ApplicationEvents ShowHint(var HintStr String
var CanShow Boolean var HintInfo THintInfo)
begin
HintInfo ReshowTimeout = //设置重显时间 这里设为 毫秒比较合适
end
修改Hint的重显时间后这个功能就非常的完美了 可以看出 真正实现这个功能的代码是很少很简单的 用一个ItemAtPos函数就可以轻松搞定 这就是Delphi可爱的地方 不过作为程序员 不应该就此满足的 如果你有兴趣了解ItemAtPos是怎样获取鼠标所指范围在ListBox中索引的 那么请继续向下看
三 深入了解
要查看ItemAtPos函数在Delphi中是怎样编写的很简单 只要按下Ctrl键不放 再用鼠标点击ItemAtPos函数 就会自动定位到这个函数的所在位置(用这样的方法 我们可以查看Delphi中大多数函数及过程的源代码 分析一下这些源代码对我们编写程序是很有帮助的 而且也可以很好地了解这些函数是如何工作的)
源码如下
function TCustomListBox ItemAtPos(Pos TPoint Existing Boolean) Integer
var
Count Integer //记录ListBox中Item的个数
ItemRect TRect //记录Item的范围
begin
if PtInRect(ClientRect Pos) then //PtInRect是一个API函数 用于检测Pos所指的范围是否在ListBox当中 ClientRect这里是begin ListBox的范围
Result = TopIndex //将返回值设为ListBox第一个Item的索引值 TopIndex为
Count = Items Count //计算总数
while Result < Count do //如果当前索引值小于总数则开始循环
begin
Perform(LB_GETITEMRECT Result Longint(@ItemRect)) //向ListBox控件发送LB_GETITEMRECT消息 获取当前Item的范围
if PtInRect(ItemRect Pos) then Exit //如果刚好Pos所指的范围在当前Item的范围内则退出整个函数
Inc(Result) //将Result加 相当于Result =Result +
end
if not Existing then Exit
end
Result = //如果Pos所指的范围不在ListBox范围内 则返回
end
lishixinzhi/Article/program/Delphi/201311/24668