home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1997 May / Pcwk0597.iso / delphi / tenpack.lzh / DEMOSB.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-16  |  4KB  |  167 lines
  1. unit demosb;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Grids, StdCtrls, Buttons, Pssbclas, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Subclass1: TSubclass;
  12.     BitBtn1: TBitBtn;
  13.     StringGrid1: TStringGrid;
  14.     BitBtn2: TBitBtn;
  15.     Label1: TLabel;
  16.     BitBtn3: TBitBtn;
  17.     Panel1: TPanel;
  18.     Panel2: TPanel;
  19.     Panel3: TPanel;
  20.     Panel4: TPanel;
  21.     Label2: TLabel;
  22.     procedure FormCreate(Sender: TObject);
  23.     procedure BitBtn2Click(Sender: TObject);
  24.     procedure StringGrid1SelectCell(Sender: TObject; Col, Row: Longint;
  25.       var CanSelect: Boolean);
  26.     procedure BitBtn1Click(Sender: TObject);
  27.     procedure BitBtn3Click(Sender: TObject);
  28.     procedure Subclass1SysEvent(const msg: TMessage; var handled: Boolean);
  29.   private
  30.     { Private declarations }
  31.   public
  32.     { Public declarations }
  33.   end;
  34.  
  35. var
  36.   Form1: TForm1;
  37.   gridrow : integer;
  38.   gridcol : integer;
  39.   SubclassedhWnd : THandle;
  40.   function fillgrid(hwnd:THandle;lparam:longint):longint;export;
  41. implementation
  42.  
  43. {$R *.DFM}
  44.  
  45. procedure TForm1.FormCreate(Sender: TObject);
  46. begin
  47.      stringgrid1.options := [goFixedVertLine,goFixedHorzLine,goVertLine,goHorzLine];
  48.      gridrow := 0;
  49.      gridcol := 0;
  50.      Stringgrid1.cells[gridcol,gridrow] := 'hWnd';
  51.      inc(gridcol);
  52.      Stringgrid1.cells[gridcol,gridrow] := 'Window';
  53. end;
  54. function fillgrid(hwnd:THandle;lparam:longint):longint;
  55. var
  56.    i : integer;
  57.    P : array[0..255] of char;
  58.    S : string;
  59.    nsize : integer;
  60.    l : longint;
  61. begin
  62.  
  63.      nsize := sizeof(P);
  64.      If IsWindow(hwnd) then
  65.      begin
  66.        If form1.Stringgrid1.rowcount < gridrow then
  67.          form1.stringgrid1.rowcount := form1.stringgrid1.rowcount + 1;
  68.        i := GetWindowtext(hwnd,P,nsize);
  69.        if i > 0 then
  70.       begin
  71.        S := StrPas(P);
  72.        gridcol := 0;
  73.        form1.stringgrid1.cells[gridcol,gridrow] := inttostr(hwnd);
  74.        gridcol := 1;
  75.        form1.stringgrid1.cells[gridcol,gridrow] := S;
  76.        inc(gridrow);
  77.        application.processmessages;
  78.       end;
  79.      end;
  80.      fillgrid := 1;
  81.  
  82. end;
  83. procedure TForm1.BitBtn2Click(Sender: TObject);
  84. var
  85.    l : longint;
  86.    enumerated : boolean;
  87.    i : integer;
  88.    j : integer;
  89. begin
  90.      for i := 1 to stringgrid1.rowcount - 1 do
  91.      begin
  92.        for j := 1 to stringgrid1.colcount - 1 do
  93.          stringgrid1.cells[j,i] := '';
  94.      end;
  95.      gridrow := 1;
  96.      gridcol := 0;
  97.      enumerated := EnumWindows(TFarProc(@FillGrid),l);
  98. end;
  99.  
  100. procedure TForm1.StringGrid1SelectCell(Sender: TObject; Col, Row: Longint;
  101.   var CanSelect: Boolean);
  102. begin
  103.      if col = 1 then
  104.       canselect := false
  105.      else
  106.      begin
  107.        SubclassedhWnd := strtoint(Stringgrid1.cells[col,row]);
  108.        label1.caption := 'Subclass: '+stringgrid1.cells[1,row];
  109.      end;
  110. end;
  111.  
  112. procedure TForm1.BitBtn1Click(Sender: TObject);
  113. begin
  114.    if IsWindow(SubclassedhWnd) then
  115.    begin
  116.      subclass1.WndHandle := SubclassedhWnd;
  117.      subclass1.Hook;
  118.    end
  119.    else
  120.      ShowMessage('No window has been selected');
  121. end;
  122.  
  123. procedure TForm1.BitBtn3Click(Sender: TObject);
  124. begin
  125.    Subclass1.Unhook;
  126.    panel2.caption := '';
  127.    panel3.caption := '';
  128.    panel4.caption := '';
  129.    label1.caption := 'Subclassing stopped';
  130. end;
  131.  
  132. procedure TForm1.Subclass1SysEvent(const msg: TMessage;
  133.   var handled: Boolean);
  134. var
  135.    M : String;
  136. begin
  137.    with Msg do
  138.    begin
  139.      case Msg of
  140.        WM_COMMAND : M := 'WM_COMMAND';
  141.        WM_SYSCOMMAND : M := 'WM_SYSCOMMAND';
  142.        WM_MOUSEMOVE : M := 'WM_MOUSEMOVE';
  143.        WM_LBUTTONDOWN : M := 'WM_LBUTTONDOWN';
  144.        WM_LBUTTONUP : M := 'WM_LBUTTONUP';
  145.        WM_RBUTTONUP : M := 'WM_RBUTTONUP';
  146.        WM_RBUTTONDOWN : M := 'WM_RBUTTONDOWN';
  147.        WM_NCHITTEST : M := 'WM_NCHITTEST';
  148.        WM_NCLBUTTONDOWN : M := 'WM_NCLBUTTONDOWN';
  149.        WM_NCLBUTTONUP : M := 'WM-NCLBUTTONUP';
  150.        WM_NCRBUTTONDOWN : M := 'WM_NCRBUTTONDOWN';
  151.        WM_NCRBUTTONUP : M := 'WM_NCRBUTTONUP';
  152.        WM_SETCURSOR : M := 'WM_SETCURSOR';
  153.        WM_WINDOWPOSCHANGING : M:='WM_WINDOWPOSCHANGING';
  154.        WM_WINDOWPOSCHANGED : M:='WM_WINDOWPOSCHANGED';
  155.        WM_MOVE : M:='WM_MOVE';
  156.        WM_SIZE : M:='WM_SIZE';
  157.        else
  158.          M := 'Other';
  159.      end;
  160.      panel2.caption := M;
  161.      panel3.caption := 'wParam: '+inttostr(wParam);
  162.      panel4.caption := 'lParam: '+inttostr(lParam);
  163.    end;
  164. end;
  165.  
  166. end.
  167.