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

发布时间 2023-10-06 18:25:06作者: Tag
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;