所見及所得的類分析跟蹤器

　　{以下代碼可以分析Windows下的鼠標處的對象類名，句柄及其遞歸父類等信息，是很久以前火鳥的工具軟件視窗超人中的一段代碼。其觸發使用了Timer控件，其實更好的實現是用Windows Mouse Hook來做觸發，就當拋磚引玉吧；此代碼還實現了不依賴於Windows2000以上要求的半透明窗口（在Win98/WinMe下也可半透明），本實現的實現其實比較類似於金山詞霸的即指即譯功能，只不過大家在做不同的應用而已。 在Delphi環境下，新建一個窗體，把代碼貼入即可，本工具主要會對做Windows環境下的開發人員工作有些幫助（如分析別人的程序的控件對象，跟蹤對象句柄等）}
　　unit Unit1;

　　interface

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

　　type
　　  TForm1 = class(TForm)
　　    procedure Timer1Timer(Sender: TObject);
　　    procedure FormCreate(Sender: TObject);
　　  private
　　    { Private declarations }
　　  public
　　    { Public declarations }
　　  end;

　　var
　　  Form1: TForm1;
　　  Timer1: TTimer;

　　implementation

　　{$R *.dfm}

　　procedure TForm1.Timer1Timer(Sender: TObject);
　　var poss:TPoint;
　　    ic:Hdc;
　　    Bmp:TbitMap;
　　  Hands: HWND;
　　  Buf: array[0..129] of Char;
　　  Stmp:TStrings;
　　  itmp,iwidth,iheight:integer;
　　  sWord,sline:string;
　　begin
　　  GetCursorPos(Poss);
　　  with self do
　　  begin
　　    if (poss.x <> tag-10) or (poss.y<>timer1.Tag-10) then left:=screen.Width
　　    else
　　    begin
　　      Hands := WindowFromPoint(Poss);
　　      if (left=tag) or (hands=handle) then exit;
　　      stmp:=TStringList.create;
　　      stmp.Add('句柄: '+IntToStr(Hands));
　　      GetClassName(Hands, Buf, 128);
　　      stmp.Add ('類名: '+Buf);
　　      itmp:=GetParent(Hands);
　　      while itmp>0  do
　　      begin
　　          GetClassName(itmp, Buf, 128);
　　          if buf<>'' then stmp.Add (inttostr(stmp.Count-1)+'級父類: '+Buf);
　　          itmp:=GetParent(itmp);
　　      end;
　　      SendMessage(Hands, WM_GETTEXT, 128, Integer(@Buf));
　　      sWord:='字符: '+buf;
　　      if length(sword)>132 then sword:=sWord+'....';
　　      repeat
　　        itmp:=pos(chr(10),sWord);
　　        if itmp>0 then
　　        begin
　　          sline:=copy(sWord,1,itmp-1);
　　          sword:=copy(sWord,itmp+1,length(sWord));
　　        end
　　        else sline:=sWord;
　　        itmp:=pos(chr(13),sline);
　　        if itmp>0 then sline:=copy(sline,1,itmp-1);
　　        stmp.Add(sline);
　　      until sline=sWord;
　　      iwidth:=0;
　　      for itmp:=0 to stmp.Count-1 do if canvas.TextWidth(stmp[itmp])+15>iWidth then iWidth:=canvas.TextWidth(stmp[itmp])+15;
　　      iheight:=stmp.Count*(canvas.TextHeight(stmp[0])+2);
　　      width:=iwidth;
　　      height:=iheight;
　　      SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE+ SWP_NOSIZE+SWP_NOACTIVATE+SWP_NOOWNERZORDER);
　　      ic:=CreateDC('DISPLAY',nil,nil,nil);
　　      if tag+width>screen.Width then tag:=screen.Width-width;
　　      if timer1.Tag +height>screen.Height then timer1.Tag:=screen.Height-height;
　　      Bmp:=Tbitmap.Create;
　　      bmp.Width := Width;
　　      bmp.Height :=Height;
　　      bitblt(bmp.Canvas.handle,0,0,Width,Height,ic,tag,timer1.Tag,SRCCOPY);
　　      Left :=tag;
　　      Top :=timer1.tag;
　　      bitblt(canvas.handle,0,0,Width,Height,bmp.Canvas.handle,0,0,SRCAND);
　　      canvas.Font.Color:=$0000FF;
　　      SetBkMode(canvas.handle,TRANSPARENT);
　　      for itmp:=0 to stmp.Count-1 do canvas.TextOut(5,5+itmp*canvas.TextHeight(stmp[itmp]),TrimRight(stmp[itmp]));
　　      deletedc(ic);
　　      bmp.free;
　　      stmp.Free;
　　    end;
　　    tag:=poss.x+10;
　　    timer1.Tag:=poss.y+10;
　　  end;
　　end;
　　procedure TForm1.FormCreate(Sender: TObject);
　　begin
　　  self.BorderStyle:=bsNone;
　　  Timer1:=TTimer.Create(self);
　　  timer1.Interval:=300;
　　  timer1.OnTimer:=Timer1Timer;
　　end;

　　end.