Einzelnen Beitrag anzeigen

Benutzerbild von Helmi
Helmi

Registriert seit: 29. Dez 2003
Ort: Erding, Republik Bayern
3.312 Beiträge
 
Delphi XE2 Professional
 
#1

Problem mit TrayIcon-Such-Funktion

  Alt 26. Dez 2007, 18:38
Hallo Jungs,

ich hab eine selbst gebastelte TrayIcon-Komponente, die einen eigen-gebauten
BalloonTip anzeigen kann (nichts anderes als eine Form).

Damit ich diesen BalloonTip (mit einem Pfeil dran) direkt an dem TrayIcon
anzeigen kann, brauch ich die Koordinaten des TrayIcons.

Dazu hab ich im I-Net folgende function gefunden (bzw. mir damals zuschicken
lassen):

Delphi-Quellcode:
function TTrayIcon.FindTrayIcon(IcoDat: TNotifyIconData): TPoint;
const
  SearchColor = clBlack;

var
  ToolWnd : HWND;
  r : TRect;
  myhDC : HDC;
  Cv : TCanvas;
  BlackIcon : TIcon;
  TmpIcon : TIcon;
  Bmp : TBitmap;
  ImageList : TImageList;
  col1, col2, col3, col4, col5, col6, col7, col8, col9: TColor;
  i, j, a, b, x, y: Integer;
  found : Boolean;
  p : TPoint;

begin
  //leeren
  r.Top := 0;
  r.Right := 0;
  r.Bottom := 0;
  r.Left := 0;

  Shell_NotifyIcon(NIM_MODIFY, @IcoDat);

  ToolWnd := FindWindowEx(FindWindow('Shell_TrayWnd', nil), HWND(0), 'TrayNotifyWnd', nil);
  GetWindowRect(ToolWnd, r);

  try
    try
      TmpIcon := TIcon.Create;
      TmpIcon.Handle := IcoDat.hIcon;

      BlackIcon := TIcon.Create;
      Bmp := TBitmap.Create;

      with Bmp do
        begin
          Height := TmpIcon.Height;
          Width := TmpIcon.Height;
          Canvas.brush.color := SearchColor;
          Canvas.FillRect(Rect(0, 0, TmpIcon.Height, TmpIcon.Height));
        end;

      ImageList := TImageList.CreateSize(TmpIcon.Height, TmpIcon.Height);

        with ImageList do
          begin
            AddMasked(Bmp, clWhite);
            GetIcon(0, BlackIcon);
          end;

      IcoDat.hIcon := BlackIcon.Handle;

      Shell_NotifyIcon(NIM_MODIFY, @IcoDat);
    finally
      FreeAndNil(Bmp);
      FreeAndNil(BlackIcon);
    end;

    try
      Bmp := TBitmap.Create;

      with Bmp do
        begin
          Height := r.Bottom-r.Top;
          Width := r.Right-r.Left;
        end;

      myhDC := GetWindowDC(ToolWnd);
      Cv := TCanvas.Create;
      Cv.Handle := myhDC;

      try
        Bmp.Canvas.CopyMode := cmSrcCopy;
        Bmp.Canvas.CopyRect(Rect(0, 0, r.Right-r.Left, r.Bottom-r.Top), Cv, Rect(0, 0, r.Right-r.Left, r.Bottom-r.Top));
      finally
        FreeAndNil(Cv);
        ReleaseDC(ToolWnd, myhDC);
      end;

      IcoDat.hIcon := TmpIcon.Handle;

      Shell_NotifyIcon(NIM_MODIFY, @IcoDat);

      a := Bmp.Height - 16;
      b := Bmp.Width - 16;
      x := 0;
      y := 0;
      found := false;

      for j := 0 to a do
        for i := 0 to b do
          begin
            col1 := Bmp.Canvas.Pixels[i, j];
            col2 := SearchColor; //Bmp.Canvas.Pixels[i + 15, j];
            col3 := Bmp.Canvas.Pixels[i + 13, j + 2];
            col4 := Bmp.Canvas.Pixels[i + 6, j + 4];
            col5 := Bmp.Canvas.Pixels[i + 8, j + 7];
            col6 := Bmp.Canvas.Pixels[i + 12, j + 9];
            col7 := Bmp.Canvas.Pixels[i + 15, j + 12];
            col8 := Bmp.Canvas.Pixels[i, j + 15];
            col9 := Bmp.Canvas.Pixels[i + 15, j + 15];
            if ((col1 = SearchColor) and (col2 = SearchColor) and (col3 = SearchColor) and
                (col4 = SearchColor) and (col5 = SearchColor) and (col6 = SearchColor) and
                (col7 = SearchColor) and (col8 = SearchColor) and (col9 = SearchColor)) then
              begin
                x := i + r.Left;
                y := j + r.Top;
                found := true;

                if (found) then
                  break;
              end;

            if (found) then
              break;
          end;

      if x <= 0 then
        x := r.Left;

      if y <= 0 then
        y := r.Top;

      p.x := x;
      p.y := y;

      Result := p;
    finally
      FreeAndNil(Bmp);
    end;
  finally
    //
  end;
end;
Wenn ich die richtig versteh, so erstellt sie ein Rechteck-Icon mit der Farbe schwarz (clBlack)
und dannach werden ein paar Punkte gesucht und wenn die übereinstimmen, dann muss sich an
diesen Koordinaten das Icon befinden.

Unter XP hatte ich keine Probleme mit dieser Function.
Aber Unter Vista Ultimate funktioniert diese nicht mehr.

die Variablen x und y bleiben 0. Das heisst die Prüfung
Delphi-Quellcode:
if ((col1 = SearchColor) and (col2 = SearchColor) and (col3 = SearchColor) and
                (col4 = SearchColor) and (col5 = SearchColor) and (col6 = SearchColor) and
                (col7 = SearchColor) and (col8 = SearchColor) and (col9 = SearchColor)) then
bleibt false.

Ich blick nicht wirklich durch, wieso diese Prüfung jetzt nicht mehr funktioniert.

Ich hab den Verdacht, dass die Farbprüfung von anderen Icons "abgelenkt" wird.

Weiss jemand wie ich die Funktion unter Vista zum Laufen bringen kann oder
(was noch besser wär) vielleicht ne einfachere Form, die Position des Icons
zu finden.
mfg
Helmi

>> Theorie ist Wissen, dass nicht funktioniert - Praxis ist, wenn alles funktioniert und keiner weiss warum! <<
  Mit Zitat antworten Zitat