unit1.pas

一个查看运行中的程序的所有窗体的类名称的程序

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    FowTim: TTimer;
    procedure FowTimTimer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  FmFol:TForm;
implementation

{$R *.dfm}

procedure TForm1.FowTimTimer(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
  if FmFol=nil then
  begin
    FmFol:=TForm.Create(self);
  end;
  GetCursorPos(Poss);
  with FmFol do
  begin
    if (poss.x <> tag-10) or (poss.y<>FowTim.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 FowTim.Tag +height>screen.Height then FowTim.Tag:=screen.Height-height;
      Bmp:=Tbitmap.Create;
      bmp.Width := Width;
      bmp.Height :=Height;
      bitblt(bmp.Canvas.handle,0,0,Width,Height,ic,tag,FowTim.Tag,SRCCOPY);
      Left :=tag;
      Top :=FowTim.tag;
      bitblt(canvas.handle,0,0,Width,Height,bmp.Canvas.handle,0,0,SRCAND);
      canvas.Font.Color:=ClYellow;
      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;
    FowTim.Tag:=poss.y+10;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FowTim.Enabled:=not FowTim.Enabled;
  if FowTim.Enabled=true then
  begin
    if fmfol=nil then
    begin
      fmfol:=Tform.Create(nil);
      with fmfol do
      begin
        Left:= -200;
        Top:= 133;
        BorderStyle:= bsNone;
        Color:= clGray;
        ClientWidth:=0;
      end;
    end;
    fmfol.show;
    Button1.Caption:='停止文字跟踪';
  end
  else begin
    fmfol.Hide;
    Button1.Caption:='激活文字跟踪';
  end;
end;

end.