首页 > 其他分享 >Delphi 指定句柄闪烁边框(待完善)

Delphi 指定句柄闪烁边框(待完善)

时间:2023-10-06 18:33:53浏览次数:30  
标签:Right old ahdc 句柄 Delphi 边框 ARect new Left

procedure TForm1.btn1Click(Sender: TObject);
var
 ahdc,ahdc_old, ahdc_new: HDC;
 ARect:TRect;
 ahpen:HPEN;
 ahandle:THandle;
 h,w:Integer;
 pen:integer;
 i:integer;
 bmp_old,bmp_new:HBITMAP;
begin
 ahandle := edt1.Handle;
 ahdc := GetWindowDC(aHandle);
 if ahdc > 0 then
 begin
  GetWindowRect(aHandle, ARect);

  ahdc_old := CreateCompatibleDC(ahdc);
  ahdc_new := CreateCompatibleDC(ahdc);
  bmp_old := CreateCompatibleBitmap(ahdc, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top);
  bmp_new := CreateCompatibleBitmap(ahdc, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top);
  SelectObject(ahdc_old, bmp_old);
  SelectObject(ahdc_new, bmp_new);
  BitBlt(ahdc_old, 0, 0, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, ahdc, 0, 0, SRCCOPY);


  SetBkMode(ahdc, TRANSPARENT);
  pen := 3;
  ahpen := CreatePen(PS_SOLID, pen, RGB(255, 0, 0));
  SelectObject(ahdc, ahpen);

  MoveToEx(ahdc, 1, 1, nil);
  LineTo(ahdc, ARect.Right-ARect.Left, 1);
  MoveToEx(ahdc, ARect.Right-ARect.Left-pen+1, 1, nil);
  LineTo(ahdc, ARect.Right-ARect.Left-pen+1, ARect.Bottom-ARect.Top-pen+1);
  LineTo(ahdc, 1, ARect.Bottom-ARect.Top-pen+1);
  LineTo(ahdc, 1, 1);

  BitBlt(ahdc_new, 0, 0, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, ahdc, 0, 0, SRCCOPY);

  for i := 1 to 4 do
  begin
   Sleep(50);
   if i mod 2>0 then
    BitBlt(ahdc,0,0,ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, ahdc_old, 0, 0, SRCCOPY)
   else
    BitBlt(ahdc,0,0,ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, ahdc_new, 0, 0, SRCCOPY)
  end;
  Sleep(50);
  BitBlt(ahdc,0,0,ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, ahdc_old, 0, 0, SRCCOPY);
  DeleteObject(ahpen);
  ReleaseDC(aHandle,ahdc);
  DeleteDC(ahdc_old);
  DeleteObject(bmp_old);
  DeleteDC(ahdc_new);
  DeleteObject(bmp_new);
 end;
// EndPaint(Handle,pain);

end;

 

标签:Right,old,ahdc,句柄,Delphi,边框,ARect,new,Left
From: https://www.cnblogs.com/BTag/p/17744805.html

相关文章

  • delphi中unit单元文件说明
    单元(unit)是组成Pascal程序的单独的源代码模块,单元有函数和过程组成,这些函数和过程能被主程序调用。一个单元至少要有unit语句,interface,和implementation三部分,也能可选的包含initialization和finalization两部分:一、必含部分1、unit语句每一个单元都必须在开头有这样一条语句......
  • delphi中FormDestroy和FormClose的区别和联系
    在Delphi中,FormDestroy和FormClose是用于处理窗体关闭事件的两个不同的事件处理程序。它们有一些区别和联系,下面我将详细解释它们之间的差异和关联:FormDestroy事件:FormDestroy事件是一个在窗体销毁时触发的事件。这个事件通常用于释放在窗体生命周期内创建的资源,如对象、......
  • Delphi dll 传递字符串
    //dllcodeuses//ShareMem,SysUtils,Windows,Math;{$R*.res}functionTestString1(Buffer:PChar):PChar;stdcall;varTmpstr:string;begintryTmpstr:=Buffer;ifTmpstr<>''thenbeginResult:=StrAlloc(Length......
  • delphi泛型模板编程
    delphi泛型模板编程泛型模板编程的关键:泛型作用体现在模板,体现在虚实之间相互转换,以虚概实,以实就虚。unitTxInfo;interfaceusesSystem.Types,System.Classes,System.SysUtils,Generics.Collections;typeTPeople=recordName:string;Age:str......
  • 恢复Delphi工具栏
    打开注册表,找到下面项,把Toolbars删除!计算机\HKEY_CURRENT_USER\SOFTWARE\Embarcadero\BDS\22.0\Toolbars 重新进入Delphi,恢复默认状态!如下图的状态,删除后,恢复了! ......
  • Delphi:cxGrid的使用方法
    Delphi:cxGrid的使用方法1.去掉cxgrid中抬头的box,在tableview1的ptionsview的groupbybox=false;2.在GRIDfooter中加入sum(列),tableview1的optionsview的footer=ture然后在cxGRid1的customize中的summary的footer.add需要合计的列kind=skSum3.去掉cxgrid中的过滤下拉......
  • delphi Base64转换(加密、解密)
    Base64转换(加密、解密)代码字符串加密、解密usesSystem.NetEncoding;procedureTForm1.Button1Click(Sender:TObject);varstr1,str2:string;begin//加密str1:=TNetEncoding.Base64.Encode('测试数据');Memo1.Lines.Add('加密数据'+str1);//解密s......
  • 进程与句柄
    目录关联关系内核对象表主要功能进程句柄表主要功能资源的创建过程总结扩展Handle小工具相关参考进程是操作系统进行资源分配和调度的基本单位。句柄是对操作系统资源的引用,用于访问和操作这些资源(如文件、窗口、线程等)。关联关系在Windows中,句柄和进程之间的关联是通过内核......
  • Delphi XE 时间和时间戳互转换
    usesSystem.DateUtils;functionTForm1.Gettamptime(vlen:Integer):string;varss:string;beginifvlen=13thenbeginss:=DateTimeToTimeStamp(now).time.ToString;Result:=IntToStr(DateTimeToUnix(Now,false))+Copy(ss,Length(ss)-......
  • c# winfrom窗体设置无边框后修改窗体大小 FormBorderStyle设置none后修改窗体大小
    //窗体缩放constintGuying_HTLEFT=10;constintGuying_HTRIGHT=11;constintGuying_HTTOP=12;constintGuying_HTTOPLEFT=13;constintGuying_HTTOPRIGHT=14;constintGuying_HTBOTTOM=15;co......