aktuellen Cursor mit Delphi auslesen

[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.