home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d56 / MSYSINFO.ZIP / Demos / GUI / WI.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  2001-05-21  |  6.2 KB  |  244 lines
  1. unit WI;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   {$IFDEF VER120} ImgList,{$ENDIF}
  8.   ComCtrls, StdCtrls, ExtCtrls, CheckLst;
  9.  
  10. type
  11.   TfrmWI = class(TForm)
  12.     Panel1: TPanel;
  13.     Panel2: TPanel;
  14.     bRefresh: TButton;
  15.     Panel3: TPanel;
  16.     pc: TPageControl;
  17.     bOK: TButton;
  18.     img: TImageList;
  19.     tsWindows: TTabSheet;
  20.     tsProps: TTabSheet;
  21.     Panel4: TPanel;
  22.     tv: TTreeView;
  23.     sb: TStatusBar;
  24.     Panel5: TPanel;
  25.     pcWin: TPageControl;
  26.     tsWin: TTabSheet;
  27.     lClass: TLabel;
  28.     Label24: TLabel;
  29.     lHandle: TLabel;
  30.     Label26: TLabel;
  31.     lProcess: TLabel;
  32.     Bevel6: TBevel;
  33.     Label33: TLabel;
  34.     winIcon: TImage;
  35.     Bevel7: TBevel;
  36.     Label22: TLabel;
  37.     lInst: TLabel;
  38.     Label25: TLabel;
  39.     lID: TLabel;
  40.     Label28: TLabel;
  41.     lProc: TLabel;
  42.     Label23: TLabel;
  43.     lParent: TLabel;
  44.     Label27: TLabel;
  45.     lData: TLabel;
  46.     Label32: TLabel;
  47.     lClient: TLabel;
  48.     Label35: TLabel;
  49.     lRect: TLabel;
  50.     Label49: TLabel;
  51.     lthread: TLabel;
  52.     tsStyle: TTabSheet;
  53.     BevelPanel7: TPanel;
  54.     lws: TLabel;
  55.     lbws: TListBox;
  56.     Panel8: TPanel;
  57.     lwes: TLabel;
  58.     lbwes: TListBox;
  59.     tsClass: TTabSheet;
  60.     Label29: TLabel;
  61.     latom: TLabel;
  62.     Label31: TLabel;
  63.     lcbytes: TLabel;
  64.     Bevel8: TBevel;
  65.     Label36: TLabel;
  66.     Label38: TLabel;
  67.     lcinst: TLabel;
  68.     Label42: TLabel;
  69.     lcwndproc: TLabel;
  70.     Label44: TLabel;
  71.     lwbytes: TLabel;
  72.     Label30: TLabel;
  73.     lhbkg: TLabel;
  74.     Label37: TLabel;
  75.     lhcur: TLabel;
  76.     Label46: TLabel;
  77.     lhicon: TLabel;
  78.     Bevel10: TBevel;
  79.     Bevel9: TBevel;
  80.     BevelPanel8: TPanel;
  81.     lcs: TLabel;
  82.     lbcs: TListBox;
  83.     eText: TEdit;
  84.     eCName: TEdit;
  85.     procedure FormCreate(Sender: TObject);
  86.     procedure cmRefresh(Sender: TObject);
  87.     procedure cmClose(Sender: TObject);
  88.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  89.     procedure pcChanging(Sender: TObject; var AllowChange: Boolean);
  90.   public
  91.     procedure GetWinList;
  92.     procedure GetWinInfo(AHandle :THandle);
  93.   end;
  94.  
  95. var
  96.   frmWI: TfrmWI;
  97.  
  98. implementation
  99.  
  100. {$R *.DFM}
  101.  
  102. uses MiTeC_Routines;
  103.  
  104. procedure TfrmWI.FormCreate(Sender: TObject);
  105. begin
  106.   pc.activepage:=tsWindows;
  107.   pcwin.activepage:=tsWin;
  108.   cmRefresh(nil);
  109. end;
  110.  
  111. procedure TfrmWI.cmRefresh(Sender: TObject);
  112. begin
  113.   screen.cursor:=crhourglass;
  114.   try
  115.     GetWinList;
  116.   finally
  117.     screen.cursor:=crdefault;
  118.   end;
  119. end;
  120.  
  121. procedure TfrmWI.cmClose(Sender: TObject);
  122. begin
  123.   close;
  124. end;
  125.  
  126. procedure TfrmWI.GetWinList;
  127. var
  128.   n :integer;
  129.   cn,wt :string;
  130.   wh :hwnd;
  131.   root :ttreenode;
  132.   p :pchar;
  133.  
  134.   procedure EnumChildWins(Awh :hwnd; ARoot :ttreenode);
  135.   var
  136.     node :ttreenode;
  137.   begin
  138.     while awh<>0 do begin
  139.       getclassname(awh,p,n);
  140.       cn:=strpas(p);
  141.       getwindowtext(awh,p,n);
  142.       wt:=strpas(p);
  143.       node:=tv.items.addchild(aroot,'Window '+inttohex(awh,8)+' "'+wt+'" :'+cn);
  144.       if iswindowvisible(awh) then
  145.         node.imageindex:=2
  146.       else
  147.         node.imageindex:=1;
  148.       node.selectedindex:=node.imageindex;
  149.       enumchildwins(getwindow(awh,GW_CHILD),node);
  150.       awh:=getwindow(awh,GW_HWNDNEXT);
  151.     end;
  152.   end;
  153.  
  154. begin
  155.   n:=255;
  156.   p:=stralloc(n);
  157.   wh:=getdesktopwindow;
  158.   getclassname(wh,p,n);
  159.   cn:=strpas(p);
  160.   getwindowtext(wh,p,n);
  161.   wt:=strpas(p);
  162.   tv.FullCollapse;
  163.   tv.hide;
  164.   tv.items.clear;
  165.   root:=tv.items.add(nil,'Window '+inttohex(wh,8)+' "'+wt+'" :'+cn);
  166.   enumchildwins(getwindow(wh,GW_CHILD),root);
  167.   tv.items[0].makevisible;
  168.   tv.selected:=tv.items[0];
  169.   tv.selected.expand(false);
  170.   tv.show;
  171.   sb.panels[0].text:=inttostr(tv.items.count)+' windows';
  172. end;
  173.  
  174. procedure TfrmWI.FormClose(Sender: TObject; var Action: TCloseAction);
  175. begin
  176.   action:=cafree;
  177. end;
  178.  
  179. procedure TfrmWI.GetWinInfo(AHandle: THandle);
  180. var
  181.   pw :PWindow;
  182. begin
  183.   winIcon.Picture.Icon.Handle:=pw^.Icon;
  184.  
  185.   pw:=GetWindowInfo(AHandle);
  186.   lclass.caption:=pw^.ClassName;
  187.   etext.text:=pw^.Text;
  188.   lhandle.caption:=inttohex(pw^.Handle,8);
  189.   lthread.caption:=inttohex(pw^.Thread,8);
  190.   lprocess.caption:=inttohex(pw^.Process,8);
  191.   if pw^.Icon<>0 then
  192.     winicon.picture.icon.handle:=pw^.Icon;
  193.   lproc.caption:=inttohex(pw^.WndProc,8);
  194.   linst.caption:=inttohex(pw^.Instance,8);
  195.   lid.caption:=inttohex(pw^.ID,8);
  196.   lparent.caption:=inttohex(pw^.ParentWin,8);
  197.   ldata.caption:=inttohex(pw^.UserData,8);
  198.   lrect.caption:=format('(%d,%d)-(%d,%d), %dx%d',[
  199.                         pw^.rect.left,
  200.                         pw^.rect.top,
  201.                         pw^.rect.right,
  202.                         pw^.rect.bottom,
  203.                         pw^.rect.right-pw^.rect.left,
  204.                         pw^.rect.bottom-pw^.rect.top
  205.                         ]);
  206.    lclient.caption:=format('(%d,%d)-(%d,%d), %dx%d',[
  207.                            pw^.clientrect.left,
  208.                            pw^.clientrect.top,
  209.                            pw^.clientrect.right,
  210.                            pw^.clientrect.bottom,
  211.                            pw^.clientrect.right-pw^.clientrect.left,
  212.                            pw^.clientrect.bottom-pw^.clientrect.top
  213.                          ]);
  214.   lws.caption:=' Styles: '+inttohex(pw^.Style,8);
  215.   lbws.items.assign(pw^.Styles);
  216.   lwes.caption:=' Extended Styles: '+inttohex(pw^.ExStyle,8);
  217.   lbwes.items.assign(pw^.ExStyles);
  218.   ecname.text:=pw^.ClassName;
  219.   latom.caption:=inttohex(pw^.Atom,8);
  220.   lcbytes.caption:=inttostr(pw^.ClassBytes)+' B';
  221.   lwbytes.caption:=inttostr(pw^.WinBytes)+' B';
  222.   lcwndproc.caption:=inttohex(pw^.ClassWndProc,8);
  223.   lcinst.caption:=inttohex(pw^.ClassInstance,8);
  224.   lhbkg.caption:=inttohex(pw^.Background,8);
  225.   lhcur.caption:=inttohex(pw^.Cursor,8);
  226.   lhicon.caption:=inttohex(pw^.Icon,8);
  227.   lcs.caption:=' Styles: '+inttohex(pw^.ClassStyle,8);
  228.   lbcs.items.assign(pw^.ClassStyles);
  229. end;
  230.  
  231. procedure TfrmWI.pcChanging(Sender: TObject; var AllowChange: Boolean);
  232. begin
  233.   allowchange:=assigned(tv.selected);
  234.   if allowchange then
  235.     try
  236.       screen.cursor:=crhourglass;
  237.       getwininfo(strtoint('$'+copy(tv.selected.text,8,8)));
  238.     finally
  239.       screen.cursor:=crdefault;
  240.     end;
  241. end;
  242.  
  243. end.
  244.