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.