Screen.Cursor Firemonkey

Question

डेल्फी 6 में, मैं माउस कर्सर Screen.Cursor का उपयोग कर सभी रूपों के लिए बदल सकता है:

procedure TForm1.Button1Click(Sender: TObject); 
begin 
    Screen.Cursor := crHourglass; 
end; 

मैं Firemonkey में बराबर तलाश कर रहा हूँ।

के बाद समारोह काम नहीं करता:

procedure SetCursor(ACursor: TCursor); 
var 
    CS: IFMXCursorService; 
begin 
    if TPlatformServices.Current.SupportsPlatformService(IFMXCursorService) then 
    begin 
    CS := TPlatformServices.Current.GetPlatformService(IFMXCursorService) as IFMXCursorService; 
    end; 
    if Assigned(CS) then 
    begin 
    CS.SetCursor(ACursor); 
    end; 
end; 

जब मैं प्रक्रिया के अंत में एक Sleep(2000); डालें, मैं 2 सेकंड के लिए कर्सर देख सकते हैं। लेकिन इंटरफ़ेस शायद मुक्त हो जाता है और इसलिए, कर्सर स्वचालित रूप से प्रक्रिया के अंत में रीसेट हो जाता है। मैंने इंटरफेस को मुक्त करने के लिए CS को वैश्विक चर के रूप में परिभाषित करने की कोशिश की और प्रक्रिया के अंत में CS._AddRef जोड़ें। लेकिन यह या तो मदद नहीं की। रोलबैक करने के लिए तो

procedure TForm1.Button1Click(Sender: TObject); 
begin 
    Application.MainForm.Cursor := crHourGlass; 
end; 

जब से मैं सभी रूपों के लिए कर्सर को बदलना चाहते हैं, मैं सभी रूपों के माध्यम से पुनरावृति करने की आवश्यकता होगी, लेकिन:

कोड काम करता है के बाद, लेकिन केवल मुख्य रूप के लिए काम करेंगे पिछले कर्सर मुश्किल है, क्योंकि मुझे हर रूप के लिए पिछले कर्सर को जानने की जरूरत है।

मेरे इरादे:

procedure TForm1.Button1Click(Sender: TObject); 
var 
    prevCursor: TCursor; 
begin 
    prevCursor := GetCursor; 
    SetCursor(crHourglass); // for all forms 
    try 
    Work; 
    finally 
    SetCursor(prevCursor); 
    end; 
end; 

Answer 1

IFMXCursorService कैसे FMX ढांचे कर्सर प्रबंध करती है। यह आपके उपयोग के लिए नहीं है। जिस तंत्र का आप उपयोग करना चाहते हैं वह फॉर्म Cursor संपत्ति है।

इसका मतलब है कि इसे पुनर्स्थापित करने के लिए आपको प्रत्येक फ़ॉर्म के लिए कर्सर को याद रखना होगा। मेरा सुझाव है कि आप ऐसा करने के लिए एक शब्दकोश का उपयोग करें। कार्यक्षमता को एक छोटी कक्षा में लपेटें और फिर कम से कम दर्द उस वर्ग के कार्यान्वयन के लिए स्थानीयकृत हो। आप कॉल साइट पर कोड को उचित बना सकते हैं।

Answer 2

आपको अपनी कर्सर सेवा लागू करना होगा जो एक निश्चित कर्सर को लागू करना संभव बनाता है।

unit Unit2; 

interface 

uses 
    FMX.Platform, FMX.Types, System.UITypes; 

type 
    TWinCursorService = class(TInterfacedObject, IFMXCursorService) 
    private 
    class var FPreviousPlatformService: IFMXCursorService; 
    class var FWinCursorService: TWinCursorService; 
    class var FCursorOverride: TCursor; 
    class procedure SetCursorOverride(const Value: TCursor); static; 
    public 
    class property CursorOverride: TCursor read FCursorOverride write SetCursorOverride; 

    class constructor Create; 
    procedure SetCursor(const ACursor: TCursor); 
    function GetCursor: TCursor; 
    end; 

implementation 

{ TWinCursorService } 

class constructor TWinCursorService.Create; 
begin 
    FWinCursorService := TWinCursorService.Create; 

    FPreviousPlatformService := TPlatformServices.Current.GetPlatformservice(IFMXCursorService) as IFMXCursorService; // TODO: if not assigned 

    TPlatformServices.Current.RemovePlatformService(IFMXCursorService); 
    TPlatformServices.Current.AddPlatformService(IFMXCursorService, FWinCursorService); 
end; 

function TWinCursorService.GetCursor: TCursor; 
begin 
    result := FPreviousPlatformService.GetCursor; 
end; 

procedure TWinCursorService.SetCursor(const ACursor: TCursor); 
begin 
    if FCursorOverride = crDefault then 
    begin 
    FPreviousPlatformService.SetCursor(ACursor); 
    end 
    else 
    begin 
    FPreviousPlatformService.SetCursor(FCursorOverride); 
    end; 
end; 


class procedure TWinCursorService.SetCursorOverride(const Value: TCursor); 
begin 
    FCursorOverride := Value; 
    TWinCursorService.FPreviousPlatformService.SetCursor(FCursorOverride); 
end; 

end. 

MainUnit:

procedure TForm1.Button1Click(Sender: TObject); 
var 
    i: integer; 
begin 
    TWinCursorService.CursorOverride := crHourGlass; 
    try 
    Sleep(2000); 
    finally 
    TWinCursorService.CursorOverride := crDefault; 
    end; 
end;