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下编译并测试通过