voyhelp.pas

这一系列是我平时收集的pascal深入核心编程

unit VoyHelp;

interface

uses Windows;

procedure VoyHelp_DrawWindowFrame(hWndSubject: HWND); // 框选窗体
procedure VoyHelp_UpdateWindowInfo(hWndEdit, hWndSubject: HWND); // 窗体信息

implementation

  // 自己写的定位字符串尾小函数 ^^
function SearchEnd(First: PChar): PChar;
begin
  Result := First;
  while (Result^ <> #0) do Inc(Result);
end;

  // 反转窗体边框颜色, 重复调用将'擦除'
procedure VoyHelp_DrawWindowFrame(hWndSubject: HWND);
var
  Dc: HDC;
  Rc: TRect;
  Pen: HPEN;
begin
 // 窗体位于屏幕的范围
  GetWindowRect(hWndSubject, Rc);

 // 整个窗体的设备环境
  Dc := GetWindowDC(hWndSubject);

 // 保存设备环境的状态
  SaveDC(Dc);

 // 目标象素为原色取反
  SetROP2(Dc, R2_NOT);

 // 按窗体边框宽度建立画笔, 并选入,
 // 当该画笔被一个需要外接矩形的函数使用时,
 // 考虑到画笔宽度, 图像会适当收缩
  Pen := CreatePen(PS_INSIDEFRAME, 3 * GetSystemMetrics(SM_CXBORDER), RGB(0, 0, 0));
  SelectObject(Dc, Pen);

 // 选入系统预定空画刷
  SelectObject(Dc, GetStockObject(NULL_BRUSH));

 // (使用反色)绘制矩形
  Rectangle(Dc, 0, 0, Rc.Right - Rc.Left, Rc.Bottom - Rc.Top);

 // 恢复设备环境的状态
 // 并释放
  RestoreDC(Dc, -1);
  ReleaseDC(hWndSubject, Dc);

 // 删除之前的画笔对象
  DeleteObject(Pen);
end;

type
  TStyleList = record  // 风格列表数组成员结构
    dwID: DWORD;   // 单个风格
    szName: PChar; // 风格名称
  end;

const
  g_szClassStyles: array[0..12] of TStyleList = // 窗体类风格
  ( (dwID: CS_VREDRAW; szName: 'CS_VREDRAW'),
    (dwID: CS_HREDRAW; szName: 'CS_HREDRAW'),
    (dwID: CS_KEYCVTWINDOW; szName: 'CS_KEYCVTWINDOW'),
    (dwID: CS_DBLCLKS; szName: 'CS_DBLCLKS'),
    (dwID: CS_OWNDC; szName: 'CS_OWNDC'),
    (dwID: CS_CLASSDC; szName: 'CS_CLASSDC'),
    (dwID: CS_PARENTDC; szName: 'CS_PARENTDC'),
    (dwID: CS_NOKEYCVT; szName: 'CS_NOKEYCVT'),
    (dwID: CS_NOCLOSE; szName: 'CS_NOCLOSE'),
    (dwID: CS_SAVEBITS; szName: 'CS_SAVEBITS'),
    (dwID: CS_BYTEALIGNCLIENT; szName: 'CS_BYTEALIGNCLIENT'),
    (dwID: CS_BYTEALIGNWINDOW; szName: 'CS_BYTEALIGNWINDOW'),
    (dwID: CS_GLOBALCLASS; szName: 'CS_GLOBALCLASS')  );

  g_szWindowStyles: array[0..15] of TStyleList = // 窗体风格
  ( (dwID: WS_POPUP; szName: 'WS_POPUP'),
    (dwID: WS_CHILD; szName: 'WS_CHILD'),
    (dwID: WS_MINIMIZE; szName: 'WS_MINIMIZE'),
    (dwID: WS_VISIBLE; szName: 'WS_VISIBLE'),
    (dwID: WS_DISABLED; szName: 'WS_DISABLED'),
    (dwID: WS_CLIPSIBLINGS; szName: 'WS_CLIPSIBLINGS'),
    (dwID: WS_CLIPCHILDREN; szName: 'WS_CLIPCHILDREN'),
    (dwID: WS_MAXIMIZE; szName: 'WS_MAXIMIZE'),
    (dwID: WS_BORDER; szName: 'WS_BORDER'),
    (dwID: WS_DLGFRAME; szName: 'WS_DLGFRAME'),
    (dwID: WS_VSCROLL; szName: 'WS_VSCROLL'),
    (dwID: WS_HSCROLL; szName: 'WS_HSCROLL'),
    (dwID: WS_SYSMENU; szName: 'WS_SYSMENU'),
    (dwID: WS_THICKFRAME; szName: 'WS_THICKFRAME'),
    (dwID: WS_GROUP; szName: 'WS_GROUP'),
    (dwID: WS_TABSTOP; szName: 'WS_TABSTOP')  );

  g_szExWindowStyles: array[0..4] of TStyleList = // 窗体扩展风格
  ( (dwID: WS_EX_DLGMODALFRAME; szName: ''),
    (dwID: WS_EX_NOPARENTNOTIFY; szName: ''),
    (dwID: WS_EX_TOPMOST; szName: ''),
    (dwID: WS_EX_ACCEPTFILES; szName: ''),
    (dwID: WS_EX_TRANSPARENT; szName: '')  );

  // 将dwStyleFlags所有的风格, 转成字符串形式添加到szBuf尾部
procedure VoyHelp_AppendStyleStrings(szBuf: PChar; const Styles: array of TStyleList;
 dwStyleFlags: DWORD);
var
  nStyleIndex, nNumStyles: Integer;
begin
  nNumStyles := 0; // 匹配风格为0个
  lstrcat(szBuf, ' ('); // 开始

  for nStyleIndex := Low(Styles) to High(Styles) do // 遍历指定风格列表
  begin
    if (Styles[nStyleIndex].dwID and dwStyleFlags) <> 0 then // 存在此风格
    begin
      if (nNumStyles > 0) then lstrcat(szBuf, ', '); // 不是第一个匹配风格, 则先添加分隔符
      Inc(nNumStyles);
      lstrcat(szBuf, Styles[nStyleIndex].szName); // 添加当前风格对应的名称字符串
    end;
  end;

  if (nNumStyles = 0) then lstrcat(szBuf, 'none'); // 没有匹配风格
  lstrcat(szBuf, ')'#13#10); // 结尾
end;

  // 向szBuf尾部添加字符串形式的额外内存字节数值信息
procedure VoyHelp_AppendExtraBytes(szBuf: PChar; hWndSubject: HWND;
  nExtraBytesID: Integer);
var
  nExtraByteNum, nExtraBytes: Integer;
  bByte: DWORD; // wvsprintf()需要4字节变量, 所以我用DWORD来放Byte, ^^
  pfnGetWord: function(hWnd: HWND; nIndex: Integer): Word; stdcall;
  List: array[0..1] of Integer; // wvsprintf()转换列表
begin
  if (nExtraBytesID = GCL_CBCLSEXTRA) then
  begin
    pfnGetWord := @GetClassWord;
    List[0] := Integer(PChar('Class'));
  end else
  begin
    pfnGetWord := @GetWindowWord;
    List[0] := Integer(PChar('Windows'));
  end;
    
  nExtraBytes := GetClassLong(hWndSubject, nExtraBytesID); // 额外内存字节数
  List[1] := nExtraBytes;

  wvsprintf(SearchEnd(szBuf), '%s extra bytes:'#9'%u (', @List[0]); // 开始

  nExtraByteNum := 0;
  while (nExtraByteNum < nExtraBytes) do // 遍历各字节
  begin
    if (nExtraByteNum = 0) then
      bByte := LoByte(pfnGetWord(hWndSubject, nExtraByteNum)) // 内存 $ABCD 等于 $CDAB
    else begin
      lstrcat(szBuf, ' '); // 不是第一个字节, 则先添加分隔符
      bByte := HiByte(pfnGetWord(hWndSubject, nExtraByteNum - 1)); // 第nExtraByteNum字节
    end;
    wvsprintf(SearchEnd(szBuf), '0x%02x', @bByte); // IntToStr()
    Inc(nExtraByteNum);
  end;

  if (nExtraByteNum = 0) then lstrcat(szBuf, 'none'); // 无额外空间
  lstrcat(szBuf, ')'#13#10); // 结尾
end;

  // 添加hWndSubject窗体的窗体类信息至szBuf尾部
procedure VoyHelp_SetClassInfo(szBuf: PChar; hWndSubject: HWND);
var
  szClassName: array[0..100] of Char;
  List: array[0..9] of DWORD; // wvsprintf()转换列表
begin
  szClassName[0] := #0;

 // 开头标题
  lstrcat(szBuf, '********* CLASS INFORMATION *********'#13#10);

 // 窗体类名
  GetClassName(hWndSubject, szClassName, SizeOf(szClassName));

 // 注意, 这里应该用GetClassWord/Long而不是GetClassInfoEx
 // 因为GetClassInfoEx无法取到在其他进程注册的窗体类的信息

 // 转换列表
  List[0] := DWORD(@szClassName[0]); // 类名称
  List[1] := GetClassWord(hWndSubject, GCW_ATOM); // 类原子
  List[2] := GetClassLong(hWndSubject, GCL_HMODULE); // 注册模块
  List[3] := GetClassLong(hWndSubject, GCL_WNDPROC); // 窗体过程
  List[4] := GetClassLong(hWndSubject, GCL_HICON);   // 图标句柄
  List[5] := GetClassLong(hWndSubject, GCL_HICONSM); // 小图标句柄
  List[6] := GetClassLong(hWndSubject, GCL_HCURSOR); // 光标句柄
  List[7] := GetClassLong(hWndSubject, GCL_HBRBACKGROUND); // 背景画刷
  List[8] := GetClassLong(hWndSubject, GCL_MENUNAME); // 菜单名称
  List[9] := GetClassLong(hWndSubject, GCL_STYLE); // 类风格

 // 转换到尾部
  wvsprintf(
    SearchEnd(szBuf),
    'Class name:'#9'%s'#13#10 +
    'Atom:'#9'0x%04x'#13#10 +
    'hInstance:'#9'0x%08x'#13#10 +
    'lpfnWndProc:'#9'0x%08x'#13#10 +
    'hIcon:'#9'0x%08x'#13#10 +
    'hIconSm:'#9'0x%08x'#13#10 +
    'hCursor:'#9'0x%08x'#13#10 +
    'hbrBackground:'#9'0x%08x'#13#10 +
    'lpszMenuName:'#9'0x%08x'#13#10 +
    'Class styles:'#9'0x%08x',
    @List[0]);

 // 窗体类风格字符串
  VoyHelp_AppendStyleStrings(szBuf, g_szClassStyles, GetClassLong(hWndSubject, GCL_STYLE));

 // 额外空间字节列表
  VoyHelp_AppendExtraBytes(szBuf, hWndSubject, GCL_CBCLSEXTRA);

 // 追加回车
  lstrcat(szBuf, #13#10);
end;

  // Window Properties 枚举回调函数
function VoyHelp_PropEnumProcEx(hWnd: HWND; lpszString: PChar;
  hData: THandle; dwData: DWORD): BOOL; stdcall;
var
  szBuf: PChar;
  List: array[0..1] of DWORD; // wvsprintf() 转换列表
begin
  szBuf := PChar(dwData); // 自定义数据, 此处是目标字符串地址

  List[0] := DWORD(lpszString); // 原子 or 字符串
  List[1] := hData; // 数据

  if (DWORD(lpszString) <= $0000FFFF) then // 原子 or 字符串
    wvsprintf(SearchEnd(szBuf), #9'Atom %04x = 0x%08x'#13#10, @List[0])
  else
    wvsprintf(SearchEnd(szBuf), #9'%s = 0x%08x'#13#10, @List[0]);

  Result := TRUE; // 继续枚举
end;

  // 添加hWndSubject窗体信息至szBuf尾部
procedure VoyHelp_SetWindowInfo(szBuf: PChar; hWndSubject: HWND);
var
  szWndText, szWndPrntText: array[0..100] of Char;
  hWndParent: HWND;
  dwProcessID: DWORD;
  Rc: TRect;
  List: array[0..17] of DWORD;
begin
 // 取父窗体
  hWndParent := GetWindowLong(hWndSubject, GWL_HWNDPARENT);

 // 开头标题
  lstrcat(szBuf, '********* WINDOW INSTANCE INFORMATION *********'#13#10);

 // 窗体文本
  if (GetWindowText(hWndSubject, szWndText, SizeOf(szWndText)) = 0) then
    szWndText := '(no caption)';

 // 句柄合法
  if IsWindow(hWndParent) then
  begin
    if (GetWindowText(hWndParent, szWndPrntText, SizeOf(szWndPrntText)) = 0) then
      szWndPrntText := '(no caption)';
  end else
  begin
    szWndPrntText := '(no parent)';
  end;

 // 窗体范围
  GetWindowRect(hWndSubject, Rc);

 // 所属进程
  GetWindowThreadProcessId(hWndSubject, @dwProcessID);

 // 转换列表 
  List[0] := hWndSubject; // 窗体句柄
  List[1] := DWORD(@szWndText[0]); // 窗体标题
  List[2] := GetWindowLong(hWndSubject, GWL_HINSTANCE); // 所属模块
  List[3] := hWndParent; // 父窗体句柄
  List[4] := DWORD(@szWndPrntText[0]); // 父窗体标题
  List[5] := GetWindowThreadProcessId(hWndSubject, nil); // 所属线程
  List[6] := dwProcessID; // 所属进程
  List[7] := GetWindowLong(hWndSubject, GWL_ID); // 菜单句柄 or 自身(作为子窗体的)ID
  List[8] := GetWindowLong(hWndSubject, GWL_ID);
  List[9] := GetWindowLong(hWndSubject, GWL_USERDATA); // 用户(类使用者)数据
  List[10] := GetWindowLong(hWndSubject, GWL_USERDATA);
  List[11] := Rc.Left; // 窗体范围..
  List[12] := Rc.Top;
  List[13] := Rc.Right;
  List[14] := Rc.Bottom;
  List[15] := Rc.Right - Rc.Left; // 窗体尺寸..
  List[16] := Rc.Bottom - Rc.Top;
  List[17] := GetWindowLong(hWndSubject, GWL_STYLE); // 窗体风格

 // 注意, 这里并未尝试显示窗体的GWL_WNDPROC属性,
 // 一个进程无法取另一个进程建立的窗体的回调地址,
 // 因为操作系统总是给GetWindowLong()返回nil ..

 // 转换到尾部
  wvsprintf(
    SearchEnd(szBuf),
    'Window:'#9'0x%08x - %s'#13#10 +
    'hInstance:'#9'0x%08x'#13#10 +
    'Parent window:'#9'0x%08x - %s'#13#10 +
    'Thread ID:'#9'0x%08x'#13#10 +
    'Process ID:'#9'0x%08x'#13#10 +
    'Menu/ID:'#9'0x%08x (%d)'#13#10 +
    'User data:'#9'0x%08x (%d)'#13#10 +
    'Rectangle:'#9'(%d, %d)-(%d, %d), Dim=%d x %d'#13#10 +
    'Window styles:'#9'0x%08x',
    @List[0]);   

 // 窗体风格字符串
  VoyHelp_AppendStyleStrings(szBuf, g_szWindowStyles,
    GetWindowLong(hWndSubject, GWL_STYLE));

 // 扩展风格数值
  List[0] := GetWindowLong(hWndSubject, GWL_EXSTYLE);
  wvsprintf(SearchEnd(szBuf), 'Extended styles:'#9'0x%08x ', @List[0]);

 // 扩展风格字符串
  VoyHelp_AppendStyleStrings(szBuf, g_szExWindowStyles,
    GetWindowLong(hWndSubject, GWL_EXSTYLE));

 // 额外空间字节列表
  VoyHelp_AppendExtraBytes(szBuf, hWndSubject, GCL_CBWNDEXTRA);

 // Properties 列表标题
  lstrcat(szBuf, 'Properties:');

 // 枚举 Window Properties                                           
  if (EnumPropsEx(hWndSubject, @VoyHelp_PropEnumProcEx, Integer(szBuf)) <> -1) then
  begin
    lstrcat(szBuf, #9'(none)'#13#10); // 没有 Properties **
  end;

 // 回车  
  lstrcat(szBuf, #13#10);    
end;

 // 如果作为VoyHelp_UpdateWindowInfo()局部变量, 将导致堆栈溢出
var szBuf: array[0..8192] of Char;
 // 在编辑框控件 hWndEdit 显示窗口 hWndSubject 各种信息
procedure VoyHelp_UpdateWindowInfo(hWndEdit, hWndSubject: HWND);
begin
 // 置为空串
  szBuf[0] := #0;

 // 窗体类信息
  VoyHelp_SetClassInfo(szBuf, hWndSubject);

 // 窗体信息
  VoyHelp_SetWindowInfo(szBuf, hWndSubject);

 // 传给Edit
  SetWindowText(hWndEdit, szBuf); 
end;

end.