博客
关于我
强烈建议你试试无所不能的chatGPT,快点击我
模拟系统提示框
阅读量:5012 次
发布时间:2019-06-12

本文共 1332 字,大约阅读时间需要 4 分钟。

在FormCreate设置PersonSignLB的windows消息

aHint :=THintWindow.Create(nil);

aHint.Color :=clInfoBk;
FWndMethod := PersonSignLB.WindowProc;
PersonSignLB.WindowProc := LabelWndProc;

 

显示个人提示框

procedure TMainForm.LabelWndProc(var Msg: TMessage);

  //根据一定长度,将字符串变为回车的字符

  function SplitByLen(src:string;var row:Integer;perCount:Integer):string;
  var
    i,j:Integer;
    c:Char;
    sTemp,s1:string;
    bIsDBCS:Boolean;
  begin
    row :=Ceil(Length(src)/perCount);
    sTemp :='';
    bIsDBCS :=False;
    for I := 1 to row do
    begin
      for   j:= 1 to  perCount   do
      begin
        if bIsDBCS   then
          bIsDBCS   :=   False
        else
          if Windows.IsDBCSLeadByte(byte(src[j]))   then
            bIsDBCS   := True;
      end;

      if  bIsDBCS   then   Dec(perCount);

      if i=row then
        sTemp :=sTemp +Copy(src,1,perCount)
      else
        sTemp :=sTemp +Copy(src,1,perCount)+#10#13;
      src :=Copy(src,perCount+1,Length(src)-perCount);
    end;
    if bIsDBCS then
      Inc(perCount);
    Result :=sTemp;  
  end;

var

  p,p1,p2: TPoint;
  iRow:Integer;
  s:string;
begin
  GetCursorPos(p);
  p1 :=Point(p.x,p.y+20);

  if Msg.Msg = CM_MOUSELEAVE then

  begin
    ShowWindow(aHint.Handle, SW_HIDE);
  end
  else if Msg.Msg = CM_MOUSEENTER then
  begin
    s :=SplitByLen(FSingLB,iRow,36);
    //djc 2012-8-30 mod
    if iRow=1 then
      p2 :=Point(p.x+220,p.y+36)
    else
      p2 :=Point(p.x+220,p.y+26*iRow);
    aHint.ActivateHint(Rect(p1,p2),s);
  end;
  FWndMethod(Msg);
end;

 

 

转载于:https://www.cnblogs.com/djcsch2001/archive/2012/08/31/2665173.html

你可能感兴趣的文章
JAVA项目将 Oracle 转 MySQL 数据库转换(Hibernate 持久层)
查看>>
三层架构(我的理解及详细分析)
查看>>
Django模板语言相关内容
查看>>
前端开发工程师如何在2013年里提升自己【转】--2016已更新升级很多何去何从?...
查看>>
markdown语法测试集合
查看>>
running and coding
查看>>
实现QQ第三方登录、网站接入
查看>>
HTML CSS 层叠样式表 三
查看>>
Qt pro pri 文件学习1
查看>>
软件工程概论第六周学习进度条
查看>>
[思路]导入导出功能
查看>>
【iOS】UICollectionView自己定义Layout之蜂窝布局
查看>>
golang——(strings包)常用字符串操作函数
查看>>
发布aar到jcenter
查看>>
跨浏览器问题的五种解决方案
查看>>
XPath定位时,使用文本的方法小技巧。
查看>>
安装pandas报错(AttributeError: 'module' object has no attribute 'main')
查看>>
ch02 fundamental definition 01
查看>>
JSON解析
查看>>
Position is everything?(css定位学习的一些心得)(一)
查看>>