xwindows.pas

我自己用的Delphi函数单元 具体说明见打包文件的HELP目录下面

unit xWindows;

interface

uses Windows, Sysutils, Controls, Forms;

const
  DEFAULT_FOCUSRECT_WIDTH = 3; //缺省的窗口虚线外框宽度


//------------------------------------------------------------------//
function FindVCLControl(Handle: HWND; ProcessID: DWORD = 0): TWinControl;
function IsVCLControl(Handle: HWND; ProcessID: DWORD = 0): Boolean;
function FindTopMostWindow(ParentWnd: HWND; Pt: TPoint): HWND;

//------------------------------------------------------------------//
procedure DrawAnyFocusRect(DC: HDC; R: TRect; Width: Integer = DEFAULT_FOCUSRECT_WIDTH);
procedure DrawWindowFocusRect(Wnd: HWND; Width: Integer = DEFAULT_FOCUSRECT_WIDTH);
procedure DrawControlFocusRect(Control: TControl; Width: Integer = DEFAULT_FOCUSRECT_WIDTH);

implementation

uses xKernel;

var
  WindowAtom : TAtom;               
//ControlAtom: TAtom;               
  
  AtomText   : array[0..31] of Char;
  
  { Find a TWinControl given a window handle }
  
//------------------------------------------------------------------//
//系统中有许多窗口存在，有些属于VCL，有些来自API、MFC、OWL等。输入Handle
//及进程编号(不限于本进程)，FindVCLControl返回拥有此窗口的TWinControl组件，
//若窗口不属于VCL组件，返回nil。
function FindVCLControl(Handle: HWND; ProcessID: DWORD = 0): TWinControl;
begin
//  DebugStrFmt('Find Control Handle = %x',[Handle]);
  if Handle <> 0 then
  begin
    if ProcessID = 0 then
      GetWindowThreadProcessId(Handle, @ProcessID);
    WindowAtom := GlobalAddAtom(StrFmt(AtomText, 'Delphi%.8X',[ProcessID]));
    Result := Pointer(GetProp(Handle, MakeIntAtom(WindowAtom)));
//    DebugStrFmt('Find Control PID = %x Result = %p',[ProcessID, Pointer(Result)]);
  end else
    Result := nil;
end;

//------------------------------------------------------------------//
//本函数与FindVCLControl类似，只是返回布尔值。
function IsVCLControl(Handle: HWND; ProcessID: DWORD = 0): Boolean;
begin
  Result := FindVCLControl(Handle, ProcessID) <> nil;
end;

//------------------------------------------------------------------//
//输入窗口及坐标，返回该坐标上，最上层可视子窗口。
//ParentWnd：要搜寻的最上层子窗口的窗口句柄；
//pt：相对于该窗口客户端区域的坐标；
function FindTopMostWindow(ParentWnd: HWND; Pt: TPoint): HWND;
var
  R: TRect;
begin
  Result := GetWindow(ParentWnd, GW_CHILD); // 取得第一个子视窗

  while Result <> 0 do
  begin
    GetWindowRect(Result, R); // 取得视窗矩形区域

    if IsWindowVisible(Result) and PtInRect(R, Pt) then
    begin
      if Result = Application.MainForm.Handle then // 忽略程式的 Main Form
      begin
        Result := 0;
        Exit;
      end;
      Result := FindTopmostWindow(Result, Pt); // 找到视窗, 递回呼叫取得子视窗
      Exit;
    end;
    Result := GetWindow(Result, GW_HWNDNEXT); // 取得下一个 siblings 视窗
  end;

  Result := ParentWnd; // 找不到, 它就是我们要找的
end;

{
  使用 ChildWindowFromPoint 来寻找, 连 non-visual 视窗都会找到

function FindTopMostWindow(ParentWnd: HWND; Pt: TPoint): HWND;
begin
  repeat
    Result := ChildWindowFromPoint(ParentWnd, Pt);
    if Result = ParentWnd then break;

    if Result = Application.MainForm.Handle then // 若是 MainForm 本身, 传回 0
    begin
      Result := 0;
      Exit;
    end;

    MapWindowPoints(ParentWnd, Result, Pt, 1);
    ParentWnd := Result;
  until false;
end;
}

//------------------------------------------------------------------//
//用于为窗口或TControl组件绘制宽度为Width的虚线框，此虚线框以XOR方式和
//原有背景结合，所以再调用一次会消除虚线框，适合于焦点窗口选择界面。
procedure DrawAnyFocusRect(DC: HDC; R: TRect; Width: Integer = DEFAULT_FOCUSRECT_WIDTH);
var
  I: Integer;
begin
  InflateRect(R, - Width, - Width);
  DrawFocusRect(DC, R);
  for I := 1 to Width do
  begin
    InflateRect(R, 1, 1);
    DrawFocusRect(DC, R);
  end;
end;

procedure DrawWindowFocusRect(Wnd: HWND; Width: Integer = DEFAULT_FOCUSRECT_WIDTH);
var
  DC: HDC;  
  R : TRect;
begin
  DC := getwindowdc(Wnd);
  GetWindowRect(Wnd, R);
  MapWindowPoints(HWND_DESKTOP, Wnd, R, 2);
  OffsetRect(R, - R.left, - R.top);
  DrawAnyFocusRect(DC, R, Width);
  releasedc(Wnd, DC);
end;

procedure DrawControlFocusRect(Control: TControl; Width: Integer = DEFAULT_FOCUSRECT_WIDTH);
var
  Wnd: HWND; 
  DC : HDC;  
  R  : TRect;
begin
  Wnd := Control.Parent.Handle;
  DC := getdc(Wnd);
  R := Control.BoundsRect;
  DrawAnyFocusRect(DC, R, Width);
  releasedc(Wnd, DC);
end;


end.