由于WINDOWS基于窗口管理的机制,各个窗口独立管理自己的光标(Cursor)形状,如果想通过一个函数设置整个应用程序中每个窗口的鼠标指针为忙状态就非常困难了。查了一些资料发现只有SetSystemCursor这个API函数可以达到要求,下面是列出代码:

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

Posted on 2007-01-11 21:36  Clark Zheng  阅读(632)  评论(0编辑  收藏  举报