unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Registry;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    function GetSysCursorFileName(Name: String): String;
    function GetSysPath: String;
    procedure SetSystemState(State: String);
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
  SetSystemState('Wait');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  SetSystemState('Arrow');
end;
function TForm1.GetSysCursorFileName(Name: String): String;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('Control Panel\Cursors', false);
    Result := Reg.ReadString(Name);
  finally
    Reg.Free;
  end;
end;
function TForm1.GetSysPath: String;
var
  tmpPath: array [0..255] of Char;
begin
  GetWindowsDirectory(tmpPath, 255);
  Result := tmpPath;
end;
procedure TForm1.SetSystemState(State: String);
var
  tmpCur: HCURSOR;
  tmpBusyCursorFileName: String;
begin
  tmpBusyCursorFileName := GetSysCursorFileName(State);
  //如果为系统默认的鼠标方案,在注册表内无文件名称,从资源文件中提取光标
  if tmpBusyCursorFileName <> '' then
  begin
    tmpBusyCursorFileName := StringReplace(tmpBusyCursorFileName, '%Windir%', GetSysPath, [rfReplaceAll, rfIgnoreCase]);
    tmpBusyCursorFileName := StringReplace(tmpBusyCursorFileName, '%SYSTEMROOT%', GetSysPath, [rfReplaceAll, rfIgnoreCase]);
    if FileExists(tmpBusyCursorFileName) then
      tmpCur := LoadCursorFromFile(PChar(tmpBusyCursorFileName))
    else
      tmpCur := LoadCursor(hInstance, PChar(State));
  end else
    tmpCur := LoadCursor(hInstance, PChar(State));
  try
    if tmpCur <> 0 then
      SetSystemCursor(tmpCur, OCR_NORMAL);
  finally
    DestroyCursor(tmpCur);
  end;
end;
end.
由于WINDOWS默认的鼠标方案在注册表中并不记录光标文件位置,所以我们得使用自己的资源文件。在工程中添加MyCursor.rc文件,内容如下:
Arrow Cursor Arrow.cur
AppStarting Cursor AppStarting.cur
Wait Cursor Wait.cur
这样只需要BUILD工程自己的资源文件就可以加进去了。
但有人要说了,我去哪找系统默认的光标资源呢?原来这些东东都藏在“WINDOWS\system32\user32.dll”这个文件里,虽便找个资源提取工具(我使的是ResScope1.94)导出来就可以了 。
。
下载地址:https://files.cnblogs.com/reonlyrun/SetSystemCursor.rar
在DELPHI6+Window200、WindowXP、Windows2003 Server下编译并测试通过
 
                
            
         
         浙公网安备 33010602011771号
浙公网安备 33010602011771号