Geladenes Icon in Cursor umwandeln

Für alle, denen der Tipp hier zu aufwändig ist.

Die folgende Funktion ChangeIconToCursor wandelt ein geladenes Icon in einen Cursor um.

  • Der Parameter Icon ist das geladene Icon. Die Variable wird mit dem aus dem Icon erstellten Cursor überschrieben.

  • Die Parameter nHotspotX und nHotspotY geben die Position des Hotspots an, also des aktiven Punkts im Cursor. Gemessen wird in Pixeln, links oben ist (0,0).

procedure ChangeIconToCursor(var Icon: HICON; nHotspotX, nHotspotY: Integer);
var
  iInfo: TIconInfo;
  NewIcon: HICON;
begin
  if Icon = 0 then
    exit;

  if not GetIconInfo(Icon, iInfo) then
    RaiseLastOSError;

  try
    iInfo.fIcon := false;
    iInfo.xHotspot := nHotspotX;
    iInfo.yHotspot := nHotspotY;
    NewIcon := CreateIconIndirect(iInfo);
    if NewIcon = 0 then
      RaiseLastOSError;

    DestroyIcon(Icon);
    Icon := NewIcon;
  finally
    if iInfo.hbmMask <> 0 then
      DeleteObject(iInfo.hbmMask);
    if iInfo.hbmColor <> 0 then
      DeleteObject(iInfo.hbmColor);
  end;
end;

Der Weg zurück geht natürlich genau so einfach.

procedure ChangeCursorToIcon(var Icon: HICON);
var
  iInfo: TIconInfo;
  NewIcon: HICON;
begin
  if Icon = 0 then
    exit;

  if not GetIconInfo(Icon, iInfo) then
    RaiseLastOSError;

  try
    if not iInfo.fIcon then
    begin
      iInfo.fIcon := true;
      NewIcon := CreateIconIndirect(iInfo);
      if NewIcon = 0 then
        RaiseLastOSError;

      DestroyIcon(Icon);
      Icon := NewIcon;
    end;
  finally
    if iInfo.hbmMask <> 0 then
      DeleteObject(iInfo.hbmMask);
    if iInfo.hbmColor <> 0 then
      DeleteObject(iInfo.hbmColor);
  end;
end;

...und so kann man dann den farbigen Cursor in der eigenen Anwendung benutzen:

// Der Inhalt der Datei "CURSOR.RC" steht weiter unten
// Annahme: das Icon heißt 'MYCURSOR'
{$R CURSOR.RES CURSOR.RC}

const
  crColorCursor = 1;

procedure TForm1.FormCreate(Sender: TObject);
var
  Cursor: HICON;
begin
  Cursor := LoadImage(hInstance, 'MYCURSOR', IMAGE_ICON,
    GetSystemMetrics(SM_CXCURSOR), GetSystemMetrics(SM_CYCURSOR), 0);
  ChangeIconToCursor(Cursor, 0, 0);
  Screen.Cursors[crColorCursor] := Cursor;

  Self.Cursor := crColorCursor;
end;

Hier noch der Inhalt der RC-Datei, die man mit einem einfachen Texteditor wie z.B. Notepad erstellt. Beim Speichern dann einfach den Typ auf "Alle Dateien" ändern und von Hand die Erweiterung ".rc" anfügen.

Bei neueren Delphi-Versionen kann man die Datei auch einfach zum Projekt hinzufügen und kann sie dann über einen Doppelklick bearbeiten.

MYCURSOR ICON "mycursor.ico"
Flocke's Garage
Valid HTML 4.01 Transitional Valid CSS!
(C) 2005-2013 Volker Siebert.
Creative Commons-LizenzvertragDer gesamte Inhalt dieser Webseite steht unter einer Creative Commons-Lizenz (sofern nicht anders angegeben).