unit InternF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Buttons;

type
  TFormInternal = class(TForm)
    Panel1: TPanel;
    SpeedChoose: TSpeedButton;
    LabelTarget: TLabel;
    Splitter1: TSplitter;
    MemoClass: TMemo;
    MemoWin: TMemo;
    CheckDrag: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SpeedChooseMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  public
    procedure UpdateData (hWnd: THandle);
    function GetClassStyles (Style: Cardinal): string;
    function GetWinStyles (Style: Cardinal): string;
    function GetWinExStyles (Style: Cardinal): string;
  private
    Capture: Boolean;
  end;

var
  FormInternal: TFormInternal;

implementation

{$R *.DFM}

function TFormInternal.GetClassStyles (Style: Cardinal): string;
begin
  Result := '';
  if (cs_bytealignclient and style) = cs_bytealignclient then
    Result := Result + 'ByteAlignClient ';
  if (cs_bytealignwindow and style) = cs_bytealignwindow then
    Result := Result + 'cs_bytealignwindow';
  if (cs_classdc and style) = cs_classdc then
    Result := Result + 'ClassDC ';
  if (cs_dblclks and style) = cs_dblclks then
    Result := Result + 'DblClks ';
  if (cs_globalclass and style) = cs_globalclass then
    Result := Result + 'GlobalClass ';
  if (cs_hredraw and style) = cs_hredraw then
    Result := Result + 'HRedraw ';
  if (cs_noclose and style) = cs_noclose then
    Result := Result + 'NoClose ';
  if (cs_owndc and style) = cs_owndc then
    Result := Result + 'OwnDc ';
  if (cs_parentdc and style) = cs_parentdc then
    Result := Result + 'ParentDc ';
  if (cs_savebits and style) = cs_savebits then
    Result := Result + 'SaveBits ';
  if (cs_vredraw and style) = cs_vredraw then
    Result := Result + 'VRedraw ';
end;

function TFormInternal.GetWinStyles (Style: Cardinal): string;
begin
  // show the kind of window
  if (ws_child and style) = ws_child then
    Result := 'Child '
  else if (ws_popup and style) = ws_popup then
    Result := 'Popup '
  else
    Result := 'Overlapped ';
  // borders
  if (ws_border and style) = ws_border then
    Result := Result + 'Border ';
  if (ws_caption and style) = ws_caption then
    Result := Result + 'Caption ';
  if (ws_thickframe and style) = ws_thickframe then
    Result := Result + 'ThickFrame ';
  if (ws_dlgframe and style) = ws_dlgframe then
    Result := Result + 'DlgFrame ';
  // border buttons
  if (ws_maximizebox and style) = ws_maximizebox then
    Result := Result + 'MaximizeBox ';
  if (ws_minimizebox and style) = ws_minimizebox then
    Result := Result + 'MinimizeBox ';
  if (ws_sysmenu and style) = ws_sysmenu then
    Result := Result + 'SysMenu ';
  // scrollbars
  if (ws_hscroll and style) = ws_hscroll then
    Result := Result + 'HScroll ';
  if (ws_vscroll and style) = ws_vscroll then
    Result := Result + 'VScroll ';
  // clipping
  if (ws_clipchildren and style) = ws_clipchildren then
    Result := Result + 'ClipChildren ';
  if (ws_clipsiblings and style) = ws_clipsiblings then
    Result := Result + 'ClipSiblings ';
  // initial status information
  if (ws_disabled and style) = ws_disabled then
    Result := Result + 'Disabled ';
  if (ws_group and style) = ws_group then
    Result := Result + 'Group ';
  if (ws_maximize and style) = ws_maximize then
    Result := Result + 'Maximize ';
  if (ws_minimize and style) = ws_minimize then
    Result := Result + 'Minimize ';
  if (ws_tabstop and style) = ws_tabstop then
    Result := Result + 'TabStop ';
  if (ws_visible and style) = ws_visible then
    Result := Result + 'Visible ';
  // note: controls styles are not supported
end;

function TFormInternal.GetWinExStyles (style: Cardinal): string;
begin
  Result := '';
  // add the extended styles
  if (ws_ex_acceptfiles and style) = ws_ex_acceptfiles then
    Result := Result + 'AcceptFiles ';
  if (ws_ex_appwindow and style) = ws_ex_appwindow then
    Result := Result + 'AppWindow ';
  if (ws_ex_mdichild and style) = ws_ex_mdichild then
    Result := Result + 'MdiChild ';
  if (ws_ex_noparentnotify and style) = ws_ex_noparentnotify then
    Result := Result + 'NoParentNotify ';
  if (ws_ex_contexthelp and style) = ws_ex_contexthelp then
    Result := Result + 'ContextHelp ';
  if (ws_ex_controlparent and style) = ws_ex_controlparent then
    Result := Result + 'ControlParent ';
  if (ws_ex_topmost and style) = ws_ex_topmost then
    Result := Result + 'TopMost ';
  if (ws_ex_transparent and style) = ws_ex_transparent then
    Result := Result + 'Transparent ';

  // border - edge styles
  if (ws_ex_clientedge and style) = ws_ex_clientedge then
    Result := Result + 'ClientEdge ';
  if (ws_ex_staticedge and style) = ws_ex_staticedge then
    Result := Result + 'StaticEdge ';
  if (ws_ex_dlgmodalframe and style) = ws_ex_dlgmodalframe then
    Result := Result + 'DlgModalFrame ';
  if (ws_ex_windowedge and style) = ws_ex_windowedge then
    Result := Result + 'WindowEdge ';
  if (ws_ex_palettewindow and style) = ws_ex_palettewindow then
    Result := Result + 'PaletteWindow ';
  if (ws_ex_toolwindow and style) = ws_ex_toolwindow then
    Result := Result + 'ToolWindow ';

  // left/right input mode and scrollbars
  if (ws_ex_left and style) = ws_ex_left then
    Result := Result + 'Left ';
  if (ws_ex_leftscrollbar and style) = ws_ex_leftscrollbar then
    Result := Result + 'LeftScrollBar ';
  if (ws_ex_ltrreading and style) = ws_ex_ltrreading then
    Result := Result + 'LtrReading ';
  if (ws_ex_right and style) = ws_ex_right then
    Result := Result + 'Right ';
  if (ws_ex_rightscrollbar and style) = ws_ex_rightscrollbar then
    Result := Result + 'RightScrollBar ';
  if (ws_ex_rtlreading and style) = ws_ex_rtlreading then
    Result := Result + 'RtlReading ';
end;

function GetCursorName (hCur: THandle): string;
var
  I: Integer;
begin
  // default: handle value
  Result := IntToHex (hCur, 16);
  // looks for Delphi cursor
  for I := crHelp to crArrow do
    if Screen.Cursors [I] = hCur then
      Result := CursorToString (I);
end;

procedure TFormInternal.FormCreate (Sender: TObject);
begin
  UpdateData (Handle);
end;

procedure TFormInternal.UpdateData (hWnd: THandle);
var
  WndClassName, Title: string;
  WndClass: TWndClass;
  hInst, hwndParent: THandle;
begin
  MemoClass.Lines.BeginUpdate;
  MemoWin.Lines.BeginUpdate;
  try
    SetLength (Title, 100);
    // retrieve the WNDCLASS name
    SetLength (WndClassName, 100);
    hInst := GetWindowLong (hWnd, GWL_HINSTANCE);
    GetClassName (hWnd, PChar (WndClassName), 100);
    GetClassInfo (hInst, PChar (WndClassName), WndClass);
    // show class information
    with WndClass, MemoClass.Lines do
    begin
      Clear;
      Add ('Class Name: ' + WndClassName);
      Add ('Window Procedure: ' + IntToHex (Cardinal (lpfnWndProc), 8));
      Add ('Class Extra Bytes: ' + IntToStr (cbClsExtra));
      Add ('Window Extra Bytes: ' + IntToStr (cbWndExtra));
      Add ('Instance Handle: ' + IntToHex (hInstance, 8));
      GetModuleFileName (hInstance, PChar (Title), 100);
      Add ('Module Name: ' + Title);
      Add ('Icon Handle: ' + IntToHex (hIcon, 8));
      Add ('Cursor: ' + GetCursorName (hCursor));
      Add ('Brush handle: ' + IntToHex (hbrBackground, 8));
      if lpszMenuName <> nil then
        if HiWord (Cardinal(lpszMenuName)) <> 0 then
          Add ('Menu name: ' + PChar (lpszMenuName))
        else
          Add ('Menu ID: ' + IntToStr (LoWord (lpszMenuName)));
      Add (#13);
      Add ('Class styles:');
      Add (GetClassStyles (Style));
    end;

    // show window data
    with MemoWin.Lines do
    begin
      Clear;
      GetWindowText (hWnd, PChar (Title), 100);
      Add ('Window Handle: ' + IntToHex (hWnd, 8));
      Add ('  Title: "' + PChar (Title) + '"');
      Add ('Window Procedure: ' + IntToHex (GetWindowLong (hWnd, GWL_WNDPROC), 8));
      Add ('Instance Handle: ' + IntToHex (GetWindowLong (hWnd, GWL_HINSTANCE), 8));
      hwndParent := GetWindowLong (hWnd, GWL_HWNDPARENT);
      Add ('Parent/Owner Window: ' + IntToHex (hwndParent, 8));
      if hwndParent <> 0 then
      begin
        GetWindowText (hwndParent, PChar (Title), 100);
        Add ('  Par/Own Title: "' + PChar (Title) + '"');
      end;
      hwndParent := GetParent (hWnd);
      Add ('Real Parent Window: ' + IntToHex (hwndParent, 8));
      if hwndParent <> 0 then
      begin
        GetWindowText (hwndParent, PChar (Title), 100);
        Add ('  Parent Title: "' + PChar (Title) + '"');
      end;
      if GetParent (hWnd) <> 0 then
        Add ('Child ID: ' + IntToHex (GetWindowLong (hWnd, GWL_ID), 8))
      else
        Add ('Menu Handle: ' + IntToHex (GetWindowLong (hWnd, GWL_ID), 8));
      Add ('User Data: ' + IntToHex (GetWindowLong (hWnd, GWL_USERDATA), 8));
      Add (#13);
      Add ('Window Styles: ' +
        GetWinStyles (GetWindowLong (hWnd, GWL_STYLE)));
      Add (#13);
      Add ('Extended Styles: ' +
        GetWinExStyles (GetWindowLong (hWnd, GWL_EXSTYLE)));
    end;
  finally
    MemoClass.Lines.EndUpdate;
    MemoWin.Lines.EndUpdate;
  end;
end;

procedure TFormInternal.FormResize(Sender: TObject);
begin
  // split the area equally
  MemoClass.Width := ClientWidth div 2;
end;

procedure TFormInternal.FormMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  hWnd: THandle;
  Title: string;
  Pt: TPoint;
begin
  if Capture then
  begin
    Pt := Point (X, Y);
    Pt := ClientToScreen (Pt);
    hWnd := WindowFromPoint (Pt);
    if hWnd = 0 then
      Exit;
    SetLength (Title, 100);
    GetWindowText (hWnd, PChar (Title), 100);
    LabelTarget.Caption :=
      'Window: ' + IntToHex (hWnd, 8) +
      ' - "' + string (PChar (Title)) + '"';
    if CheckDrag.Checked then
      UpdateData (hWnd);
  end;
end;

procedure TFormInternal.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  hWnd: THandle;
  Pt: TPoint;
begin
  if Capture then
  begin
    Pt := Point (X, Y);
    Pt := ClientToScreen (Pt);
    hWnd := WindowFromPoint (Pt);
    if hWnd <> 0 then
      UpdateData (hWnd);
    MouseCapture := False;
    Capture := False;
    // release the speed button
    SpeedChoose.Perform (
      wm_LButtonUp, mk_LButton, 0);
  end;
end;

procedure TFormInternal.SpeedChooseMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  MouseCapture := True;
  Capture := True;
end;

end.