Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Programmieren allgemein (https://www.delphipraxis.net/40-programmieren-allgemein/)
-   -   Delphi Eigener Cursor in Firemonkey (https://www.delphipraxis.net/216692-eigener-cursor-firemonkey.html)

DelphiUser123 13. Feb 2025 13:49

Eigener Cursor in Firemonkey
 
Hallo liebes Forum.
Ich habe einen eigens erstellten Cursor namens bigRed.cur mit festem Dateipfad.
Den will ich in meiner FMX App anzeigen lassen. Ich stieß auf den Forenbeitrag https://stackoverflow.com/questions/...iremonkey?rq=1

In der Zeile "Windows.SetCursor(Cursors[ACursor]); // you need to manage the Cursors list that contains the handles for all cursors" wird bei mir "Cursors" rot markiert.
Ich komme hier irgendwie nicht weiter. Wie füge ich meinen Cursor der Cursorliste hinzu? Laut Embarcadero gilt ja: "Zusätzlich zu den integrierten, in Screen angegebenen Cursors können FireMonkey-Anwendungen benutzerdefinierte Cursors zur Liste hinzufügen."
Vielen Dank für Antworten.

jaenicke 13. Feb 2025 14:21

AW: Eigener Cursor in Firemonkey
 
Zitat:

Zitat von DelphiUser123 (Beitrag 1546156)
In der Zeile "Windows.SetCursor(Cursors[ACursor]); // you need to manage the Cursors list that contains the handles for all cursors" wird bei mir "Cursors" rot markiert.

// EDIT:
Ich habe mal reingeschaut. Schau dir doch einfach mal den Originalquelltext von Delphi an, dann sollte es klar werden, wie es funktioniert. Cursors ist deine eigene Liste von Cursorn. Ich rate dir, den Originalquelltext zu kopieren und nur zu ergänzen.

DelphiUser123 13. Feb 2025 19:31

AW: Eigener Cursor in Firemonkey
 
Hier der Quellcode. Wo ist der Fehler?
Code:
unit Unit38;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Platform, windows;

type
  TForm38 = class(TForm)
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

type
  TWinCursorService = class(TInterfacedObject, IFMXCursorService)
  private
    class var FWinCursorService: TWinCursorService;
  public
    class constructor Create;
    procedure SetCursor(const ACursor: TCursor);
    function GetCursor: TCursor;
  end;

var
  Form38: TForm38;

implementation

{$R *.fmx}

class constructor TWinCursorService.Create;
begin
  FWinCursorService := TWinCursorService.Create;
  TPlatformServices.Current.RemovePlatformService(IFMXCursorService);
  TPlatformServices.Current.AddPlatformService(IFMXCursorService, FWinCursorService);
end;

function TWinCursorService.GetCursor: TCursor;
begin
  // to be implemented
end;

procedure TWinCursorService.SetCursor(const ACursor: TCursor);
begin

Windows.SetCursor(Cursors[ACursor]);
 
end;

end.

jaenicke 13. Feb 2025 23:52

AW: Eigener Cursor in Firemonkey
 
Der Fehler ist, dass du die Liste der Cursor nicht implementiert hast.

Hast du dir denn nun den Originalquelltext von Delphi aus TPlatformWin.SetCursor angeschaut?

DelphiUser123 14. Feb 2025 13:36

AW: Eigener Cursor in Firemonkey
 
Hallo jaenicke.
Zitat:

Hast du dir denn nun den Originalquelltext von Delphi aus TPlatformWin.SetCursor angeschaut?
Ich kann leider den diesbezüglichen Link in Google nicht finden. Kannst Du mir den Link geben? Gruss.

Aliquis 14. Feb 2025 14:47

AW: Eigener Cursor in Firemonkey
 
Du findest den Quelltext hier: C:\Program Files (x86)\Embarcadero\Studio\23.0\source\fmx\FMX.Platf orm.Win.pas

DelphiUser123 19. Feb 2025 13:05

AW: Eigener Cursor in Firemonkey
 
Hallo.
Ich habe mir den Quellcode unter TPlatformWin.SetCursor angeschaut. Wenn ich alles richtig verstanden habe, so muss der neue Cursor in den Listen CustomCursorMap oder CursorMap vorhanden sein.
Es scheint als wäre im CustomCursorMap viel Platz (Nil Werte).

Wie gelingt mir jetzt das Überreichen einer Ressource (mit dem Namen Cursor_1) in einen Char Pointer, aus dem das CustomCursorMap Array besteht?
Nochmals danke für Antworten.

Code:
procedure TPlatformWin.SetCursor(const ACursor: TCursor);
const
  CustomCursorMap: array [crSizeAll .. crNone] of PChar = (
    nil, nil, nil, nil, nil, IDC_SQLWAIT, IDC_MULTIDRAG, nil, nil, IDC_NODROP, IDC_DRAG, nil, nil, nil, nil, nil,
    nil, nil, nil, nil, nil, nil);

  CursorMap: array [crSizeAll .. crNone] of PChar = (
    IDC_SIZEALL, IDC_HAND, IDC_HELP, IDC_APPSTARTING, IDC_NO, nil, nil, IDC_SIZENS, IDC_SIZEWE, nil, nil, IDC_WAIT,
    IDC_UPARROW, IDC_SIZEWE, IDC_SIZENWSE, IDC_SIZENS, IDC_SIZENESW, IDC_SIZEALL, IDC_IBEAM, IDC_CROSS, IDC_ARROW, nil);

  function IsDefaultOrInvalidCursor(const ACursor: TCursor): Boolean;
  begin
    Result := (ACursor = crDefault) or not InRange(ACursor, crSizeAll, crNone);
  end;

var
  NewCursor: HCURSOR;
begin
  if not FDragAndDropActive then
  begin
    // We don't set cursor by default, when we create window. So we should use crArrow cursor by default.
    if IsDefaultOrInvalidCursor(ACursor) and not (csDesigning in Application.ComponentState) then
      FCursor := crArrow
    else
      FCursor := ACursor;

    if InRange(FCursor, crSizeAll, crNone) then
    begin
      if CustomCursorMap[FCursor] <> nil then
        NewCursor := LoadCursorW(HInstance, CustomCursorMap[FCursor])
      else
        NewCursor := LoadCursorW(0, CursorMap[FCursor]);
      Winapi.Windows.SetCursor(NewCursor);
    end;
  end;
end;

function TPlatformWin.GetCursor: TCursor;
begin
  Result := FCursor;
end;


Alle Zeitangaben in WEZ +1. Es ist jetzt 16:58 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz