Zugriff auf ein TImage einer externen Anwendung

[sirius]

So, ich hab die Sache mit Classname wieder reingebracht, dürfte aber wie gesagt nicht viel bringen.
folgende Änderungen vom letzten Mal:
type TSearchtype=(sImageSize,sCaption,sImageSizefromClassname);

Delphi-Quellcode:

procedure Info(memory:Pmemory;wparam,lparam:cardinal); stdcall;
//Die bisherige Funktion zum ermitteln und senden der Infos bezüglich TImage und TLabel
var pi,p,pm:ppointer;
    i:integer;
    a:cardinal;
    c:pchar;
    left,top,width,height:smallint;
    same:boolean;
    SearchType:TSearchType;
    vgl:array[0..31] of char;
    vgllength:integer;
    index:word;
begin

  Searchtype:=TSearchType(lparam mod 65536);
  index:=lparam div 65536;

  //Da Strings nicht über Messages gesendet werden können, benötigen wir ein Atom
  vgllength:=memory^.GlobalGetAtomName(wparam,@vgl,32);

  wparam:=0;
  lparam:=0;
  p:=pointer(cardinal(memory^.oldwindowproc)+9);


  pm:=pointer(integer(p^)+16);


  for a:=0 to pinteger(integer(pm^)+8)^-1 do begin //von 0 bis componentcount
    p:=pointer(cardinal(pm^)+4);
    p:=pointer(cardinal(p^)+4*a);
    pi:=p; //pi^ ist Zeiger auf ein Objekt


    if searchtype=simagesizefromclassname then begin
      p:=p^;
      p:=pointer(cardinal(p^)-44);
    end else
      p:=pointer(cardinal(p^)+8);
    p:=p^;

    c:=pchar(p);
    if (pbyte(p)^=vgllength)or(SearchType<>sImagesizefromClassname) then begin
      if SearchType=sImagesizefromClassName then inc(c);
      same:=false;
      for i:=1 to vgllength do begin
        if vgl[i-1]<>c^ then break;
        same:=i=vgllength;
        inc(c);
      end;
      if same then begin
        dec(index);
        if (index=0)or(SearchType<>sImagesizefromClassname) then begin
          if SearchType=sCaption then begin
            p:=pointer(cardinal(pi^)+$64);
            wparam:=cardinal(p^);
            c:=pchar(p^);
            while c^<>#0 do begin
              inc(c);
              inc(lparam);
            end;
            inc(memory^.backmsg);
          end else begin
            left:=pinteger(integer(pi^)+$40)^;
            top:=pinteger(integer(pi^)+$44)^;
            width:=pinteger(integer(pi^)+$48)^;
            height:=pinteger(integer(pi^)+$4C)^;
            wparam:=left*65536+top;
            lparam:=width*65536+height;
          end;
          break;
        end;
      end;
    end;
  end;
  //Ergebnis Nach Hause senden
  memory^.Postmessage(memory^.backwnd,memory^.backmsg,wparam,lparam);
end;

Delphi-Quellcode:

procedure TForm1.communicate(vgl:string;Searchtype:TsearchType;index:word=0);
//Eine Anfrage an unsere neue WndProc starten
var wparam,lparam:cardinal;
begin
  wparam:=globaladdAtom(pchar(vgl)); //String in ein Atom laden; Nr. des Atoms in wparam
  if searchtype=sImageSizefromclassname
    then lparam:=cardinal(Searchtype)+index*65536
    else lparam:=cardinal(Searchtype);
  sendmessage(myhandle,mymsg,wparam,lparam); //Message für unsere newwndproc; und warten bis sie dort verarbeitet wurde
  globaldeleteatom(wparam); //Atom wieder löschen
end;

Und die Testroutine:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  //Besipielanfragen an die newwndProc
  communicate('TImage',sImageSizefromclassname,2);
  communicate('Image2',sImageSize);
  communicate('Label1',sCaption);
  //hier oder in einer anderen Funktion können noch mehr solche Anfragen gestartet werden
end;