ASP源码.NET源码PHP源码JSP源码JAVA源码DELPHI源码PB源码VC源码VB源码Android源码

FireMonkey自定义Cursor

来源:网络整理     时间:2015-11-11     关键词:索引

本篇文章主要介绍了"FireMonkey自定义Cursor",主要涉及到索引方面的内容,对于Delphijrs看球网直播吧_低调看直播体育app软件下载_低调看体育直播感兴趣的同学可以参考一下: 在VCL中很容易通过Screen.Cursors加载自定义cursor,但在FMX中,cursor是通过IFMXCursorService管理的,只支持系统默认...

在VCL中很容易通过Screen.Cursors加载自定义cursor,但在FMX中,cursor是通过IFMXCursorService管理的,只支持系统默认的cursor。如果要加载自定义的cursor,我们需要替换平台默认实现的IFMXCursorService。

Windows平台源码如下:http://www.colayun.com/file/7590862

unit uWinCursorService;

interface

uses FMX.Platform, System.UITypes, FMX.Types, Winapi.Windows, System.Generics.Collections;

type
  TWinCursorService = class(TInterfacedObject, IFMXCursorService)
  private class var
    FWinCursorService: TWinCursorService;
    FOldCursorService: IFMXCursorService;
    FCursors: TList;
  protected
    class constructor Create;
    class destructor Destroy;
    procedure SetCursor(const ACursor: TCursor);
    function GetCursor: TCursor;
  public
    class function AddCursor(const AFileName: string): Integer;
  end;

implementation

uses System.SysUtils;
{ TWinCursorService }

class constructor TWinCursorService.Create;
begin
  FOldCursorService := TPlatformServices.Current.GetPlatformService(IFMXCursorService)
    as IFMXCursorService;
  TPlatformServices.Current.RemovePlatformService(IFMXCursorService);
  FWinCursorService := TWinCursorService.Create;
  TPlatformServices.Current.AddPlatformService(IFMXCursorService, FWinCursorService);
  FCursors := TList.Create;
end;

class destructor TWinCursorService.Destroy;
begin
  FOldCursorService := nil;
  //DestoryCursor
  FCursors.Free;
end;

class function TWinCursorService.AddCursor(const AFileName: string): Integer;
var
  hCur: HCURSOR;
begin
  Result := 0;
  hCur := LoadCursorFromFile(PCHAR(AFileName));
  if hCur>0 then
    Result := FCursors.Add(hCur) + 1;
end;

function TWinCursorService.GetCursor: TCursor;
begin
  Result := FOldCursorService.GetCursor;
end;

procedure TWinCursorService.SetCursor(const ACursor: TCursor);
var
  NewCursor: HCURSOR;
begin
  if ACursor<=crDefault then
    FOldCursorService.SetCursor(ACursor)
  else begin
    if ACursor>FCursors.Count then
      FOldCursorService.SetCursor(crDefault)
    else Winapi.Windows.SetCursor(FCursors[ACursor-1]);
  end;
end;

end.

使用上只需一句即可:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Cursor := TWinCursorService.AddCursor('.\bin\Res\2.cur');
end;

TWinCursorService.AddCursor方法加载指定光标资源,返回光标索引,程序中只要保存这个索引,之后窗体或控件需要显示该光标直接设置其cursor为这个索引就可以了。

以上就介绍了FireMonkey自定义Cursor,包括了索引方面的内容,希望对Delphijrs看球网直播吧_低调看直播体育app软件下载_低调看体育直播有兴趣的朋友有所帮助。

本文网址链接:http://www.codes51.com/article/detail_217009.html

相关图片

相关文章