aktuellen Cursor mit Delphi auslesen

[SentinelPH]

Hi zusammen,
bin nicht sicher ob ich in der Richtigen Rubrik bin - wenn nicht tuts mir leid.

Ich möchte ein Programm schreiben welches im Hintergrund mitläuft und in bestimmten Abständen prüft welcher Cursor gerade geladen ist. Kann man den Dateinamen der derzeit verwendeten Cursor-Datei (.ani/.cur/...) auslesen (egal ob gerade mit Windows, einem Spiel oder Photoshop gearbeitet wird)?
Würde mich über Hilfe sehr freuen!
MfG Philipp

PS: nutze Delphi5Enterprise

[SirThornberry]

willst du den Dateinamen oder die Cursoranzeige?

[SentinelPH]

Ich weiß nicht recht was du mit Cursoranzeige meinst.

Ich möchte den Dateinamen des aktuell geladenen Cursors.
Der Standard von Windows ist z.B. arrow_m.cur wenn ich nicht irre.
Wenn ich also gerade in Windows auf dem Desktop bin möchte ich "arrow_m.cur" oder eben "C:\WINDOWS\Cursors\arrow_m.cur" auslesen.

Hoffe das war jetzt verständlich :gruebel:

Besten Dank
Philipp

[chaosben]

Hi!

An den Dateiname kommst du nicht ran. :(
Warum? Nun ja, weil man den Cursor per Code setzen kann. Quasi aus dem nichts (nil :-D) Dadurch basiert er nicht mehr auf einer Datei und man wird vergeblich versuchen eine entsprechende zu finden.

Aber wenn du uns verrätst was du mit der Datei machen willst, können wir dir vielleicht helfen.

[SentinelPH]

Ich will im Endeffekt auch nicht den Dateinamen sondern nur vergleichen können ob er sich verändert.
Gibt es eine Möglichkeit das mit zu bekommen?

[bitsetter]

Moin,

mit dem Code kannst du den aktuellen Cursor auslesen, das ging zumindest bei mir unter WinXP und unter Win98.
Du kannst dann ja mit 2 Bitmap arbeiten und beide jedesmal miteinander vergleichen. Wenn sie unterschiedlich sind, hat sich der Cursor geändert.
Das wäre zumindest eine Möglichkeit.

Delphi-Quellcode:

procedure TForm1.Timer1Timer(Sender: TObject);
var
  ico: TIcon;
  ThreadID, CurrThrId: cardinal;
begin
  ico:= TIcon.Create;
  try
    ThreadID := GetWindowThreadProcessID(WindowFromPoint(Mouse.CursorPos), nil);
    CurrThrId := GetCurrentThreadId;
    if ThreadID <> CurrThrId then
    begin
      if AttachThreadInput(ThreadID, CurrThrId, true) then
      begin
        ico.Handle := GetCursor;
        AttachThreadInput(ThreadID, CurrThrId, false);
      end;
    end
    else
      ico.Handle :=  GetCursor;

    Image1.Picture.Bitmap.Width := ico.Width;
    Image1.Picture.Bitmap.Height := ico.Height;
    Image1.Picture.Bitmap.Canvas.Pen.Color := Image1.Picture.Bitmap.Canvas.Brush.Color;
    Image1.Picture.Bitmap.Canvas.Rectangle(0, 0, ico.Width, ico.Height);
    Image1.Picture.Bitmap.Canvas.Draw(0, 0, ico);
  finally
    ico.Free;
  end;
end;

Ob das auch bei Videospielen funktioniert ist allerdings wieder eine andere Sache.

[SentinelPH]

das hilft mir weiter :-D

Danke!

[bitsetter]

Zitat:

Zitat von bitsetter

Du kannst dann ja mit 2 Bitmap arbeiten und beide jedesmal miteinander vergleichen. Wenn sie unterschiedlich sind, hat sich der Cursor geändert.

Eventuell reicht es bei dir schon das

Delphi-Quellcode:

ico.Handle

mit dem vorigem Handle zu vergleichen, das wäre noch einfacher. Das habe ich gerade mal ausprobiert, und es hat soweit funktioniert.

[SentinelPH]

Klingt gut - das ist sicher die "sauberere" Variante als jedes Pixel zu vergleichen (auch wenn auch das klapp^^).
Wie würde das dann aussehen?
Warum läuft das nur in Proceduren von Objekten - dachte mir das eher so...:

Delphi-Quellcode:

var icon_alt : TIcon;

procedure TfrmXYZ.FormCreate(Sender: TObject);
begin
  ico_alt := TIcon.Create;
end;

function verglCursor : boolean;
var icon_neu : TIcon;
var ThreadID : cardinal;
begin
  ico_neu := TIcon.Create;
  try 
    ThreadID := GetWindowThreadProcessID(WindowFromPoint(Mouse.CursorPos), nil); 
    if ThreadID <> GetCurrentThreadId then
    begin 
      if AttachThreadInput(ThreadID, GetCurrentThreadId, true) then 
      begin 
        icon_neu.Handle := GetCursor;
        AttachThreadInput(ThreadID, GetCurrentThreadId, false);
      end; 
    end 
    else
      icon_neu.Handle := GetCursor;
    if icon_alt.Handle  = icon_neu.Handle  then
      result := true
    else
      result := false;
    icon_alt := icon_neu;
  finally
    icon_neu.Free;
  end;
end;

//Inkompatible Typen: 'HICON' und 'procedure, untyped pointer or untyped parameter'
...
Habe leider keine Ahnung von Handle und co - bastel damit so rum ohne es richtig zu verstehen :oops:

Gruß Philipp

[bitsetter]

Zitat:

Zitat von SentinelPH

//Inkompatible Typen: 'HICON' und 'procedure, untyped pointer or untyped parameter'

An welcher Stelle kommt denn die Fehlermeldung, habe den Code mal getestet aber bei mir kam so eine Meldung nicht.

So ging es bei mir:

Delphi-Quellcode:

var
  icon_alt : TIcon;

procedure TForm1.FormCreate(Sender: TObject);
begin
  icon_alt := TIcon.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  icon_alt.Free;
end;

function verglCursor : boolean;
var
  icon_neu : TIcon;
  ThreadID : cardinal;
begin
  icon_neu := TIcon.Create;
  try
    ThreadID := GetWindowThreadProcessID(WindowFromPoint(Mouse.CursorPos), nil);
    if ThreadID <> GetCurrentThreadId then
    begin
      if AttachThreadInput(ThreadID, GetCurrentThreadId, true) then
      begin
        icon_neu.Handle := GetCursor;
        AttachThreadInput(ThreadID, GetCurrentThreadId, false);
      end;
    end
    else
      icon_neu.Handle := GetCursor;

    result := icon_alt.Handle = icon_neu.Handle;
    icon_alt.Handle := icon_neu.Handle;
  finally
    icon_neu.Free;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 if not verglCursor then
   beep;
end;

[SentinelPH]

ist die Zeile
result := icon_alt.Handle = icon_neu.Handle;
gleich
if icon_alt.Handle = icon_neu.Handle then
result := true;
???

[SentinelPH]

Zitat:

if AttachThreadInput(ThreadID, GetCurrentThreadId, true) then

diese Zeile ergibt nun einen RuntimeError ohne Fehlermeldung!

[fLaSh11]

@ SentinelPH:

ja,

Delphi-Quellcode:

bool := <Vergleichswert> = <Vergleichswert2>;

ist eine kurzform für

Delphi-Quellcode:

bool:=false;
if <Vergleichswert> = <Vergleichswert2> then
  bool := true;

beide Vergleichswerte müssen vom gleichen Typ sein!

[SentinelPH]

@fLaSh11 Danke
@bitsetter:
habe es jetzt nochmal umgebaut:

Delphi-Quellcode:

function getIcon : TIcon;
var ThreadID : cardinal;
begin
  result := TIcon.Create;
  try
    ThreadID := GetWindowThreadProcessID(WindowFromPoint(Mouse.CursorPos), nil);
    if ThreadID <> GetCurrentThreadId then
    begin
      if AttachThreadInput(ThreadID, GetCurrentThreadId, true) then
      begin
        result.Handle := GetCursor;
        AttachThreadInput(ThreadID, GetCurrentThreadId, false);
      end;
    end
    else
      result.Handle := GetCursor;
  finally
      result.Free;
  end;
end;

function verglCursor : boolean;
var icon_neu : TIcon;
begin
  icon_neu := TIcon.Create;
  icon_neu := getIcon;
  if icon_neu.Handle = icon_alt.Handle then
    result := true
  else
    result := false;
  icon_neu.Free;
end;

procedure XYZ.FormCreate(Sender: TObject);
begin
  icon_alt := TIcon.Create;
  icon_alt := getIcon;
end;

procedure XYZ.Timer1Timer(Sender: TObject);
begin
  if verglCursor = true then
    beep
end;

procedure XYZ.FormDestroy(Sender: TObject);
begin
  icon_alt.Free;
end;

wenn jetzt getIcon in FormCreate aufgerufen wird minimiert sich das Programm welches im Vordergrund ist (was ich nicht will) - Delphi gibt aber keine Fehlermeldung aus.

Vielen Dank bitsetter für deine Mühe und Geduld!
Gruß Philipp

[bitsetter]

Zitat:

Zitat von SentinelPH

Delphi-Quellcode:

function getIcon : TIcon;
var ThreadID : cardinal;
begin
  result := TIcon.Create;
  try
    ThreadID := GetWindowThreadProcessID(WindowFromPoint(Mouse.CursorPos), nil);
    if ThreadID <> GetCurrentThreadId then
    begin
      if AttachThreadInput(ThreadID, GetCurrentThreadId, true) then
      begin
        result.Handle := GetCursor;
        AttachThreadInput(ThreadID, GetCurrentThreadId, false);
      end;
    end
    else
      result.Handle := GetCursor;
  finally
      result.Free;<---- hier
  end;
end;

Daran wird es wohl liegen, außerdem kannst du mit so einer Funktion leicht Speicherlöcher erzeugen. Oder du machst daraus so

Delphi-Quellcode:

function getIcon : HICON;
...
result := GetCursor;

eine Funktion.



Hier wieder meine Version leicht abgeändert:

Delphi-Quellcode:

procedure getIcon(var Ico: TIcon);
var ThreadID, CurrThrId: cardinal;
begin
    ThreadID := GetWindowThreadProcessID(WindowFromPoint(Mouse.CursorPos), nil);
    CurrThrId := GetCurrentThreadId;
    if ThreadID <> CurrThrId then
    begin
      if AttachThreadInput(ThreadID, CurrThrId, true) then
      begin
        Ico.Handle := GetCursor;
        AttachThreadInput(ThreadID, CurrThrId, false);
      end;
    end
    else
      Ico.Handle := GetCursor;
end;

function verglCursor : boolean;
var icon_neu : TIcon;
begin
  icon_neu := TIcon.Create;
  getIcon(icon_neu);
  if icon_neu.Handle = icon_alt.Handle then
    result := true
  else
    result := false;
  icon_alt.Handle := icon_neu.Handle;
  icon_neu.Free;
end;

procedure XYZ.FormCreate(Sender: TObject);
begin
  icon_alt := TIcon.Create;
  getIcon(icon_alt);
end;

procedure XYZ.Timer1Timer(Sender: TObject);
begin
  if not verglCursor then
    beep
end;

procedure XYZ.FormDestroy(Sender: TObject);
begin
  icon_alt.Free;
end;

EDIT:
Noch eine andere Version:

Delphi-Quellcode:

var
  icon_alt : HICON;

function GetIcon: HICON;
var
  ThreadID, CurrThrId: cardinal;
begin
  Result := 0;
  ThreadID := GetWindowThreadProcessID(WindowFromPoint(Mouse.CursorPos), nil);
  CurrThrId := GetCurrentThreadId;
  if ThreadID <> CurrThrId then
  begin
    if AttachThreadInput(ThreadID, CurrThrId, true) then
    begin
      Result := GetCursor;
      AttachThreadInput(ThreadID, CurrThrId, false);
    end;
  end
  else
    Result := GetCursor;
end;

function verglCursor : boolean;
var
  icon_neu : HICON;
begin
  icon_neu:= GetIcon;
  result := icon_neu = icon_alt;
  icon_alt := icon_neu;
end;

procedure XYZ.FormCreate(Sender: TObject);
begin
  icon_alt:= GetIcon;
end;

procedure XYZ.Timer1Timer(Sender: TObject);
begin
  if not verglCursor then
    beep
end;

[SentinelPH]

Hi, also das Problem mit dem minimieren besteht leider noch immer - somit kann ich leider auch nicht rechts sagen ob der Rest läuft...

[bitsetter]

Hallo,

den Fehler kann ich nicht nachvollziehen, habe mal das Projekt angehängt. Bei mir ging es unter WinXP und unter Win98SE.