Delphi调用WinAPI: 输入光标相关的函数[3]

本例测试修改光标的形色, 效果图:

代码文件:unit Unit1;
interface
uses
　Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
　Dialogs, StdCtrls, ExtCtrls;
type
　TForm1 = class(TForm)
　　RadioGroup1: TRadioGroup;
　　procedure FormCreate(Sender: TObject);
　　procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
　　　Shift: TShiftState; X, Y: Integer);
　　procedure RadioGroup1Click(Sender: TObject);
　　procedure FormDestroy(Sender: TObject);
　end;
var
　Form1: TForm1;
implementation
{$R *.dfm}
var
　bit: TBitmap;
procedure TForm1.FormCreate(Sender: TObject);
const
　c = '★';
begin
　RadioGroup1.Caption := '光标形色';
　RadioGroup1.Items.CommaText := '黑色,灰度,自定义';
　RadioGroup1.ItemIndex := 0;
　bit := TBitmap.Create;
　bit.Canvas.Font.Size := 16;
　bit.Width := bit.Canvas.TextWidth(c);
　bit.Height := bit.Canvas.TextHeight(c);
　bit.Canvas.TextOut(0, 0, c);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
　SetCaretBlinkTime(530);
　bit.Free;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
　Shift: TShiftState; X, Y: Integer);
var
　h: HBITMAP;
begin
　DestroyCaret;
　h := 0;
　case RadioGroup1.ItemIndex of
　　1: h := 1;
　　2: h := bit.Handle;
　end;
　CreateCaret(Handle, h, 4, 32);
　SetCaretPos(X,Y);
　ShowCaret(Handle);
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
var
　h: HBITMAP;
　pt: TPoint;
begin
　GetCaretPos(pt);
　DestroyCaret;
　h := 0;
　case RadioGroup1.ItemIndex of
　　1: h := 1;
　　2: h := bit.Handle;
　end;
　CreateCaret(Handle, h, 4, 32);
　SetCaretPos(pt.X, pt.Y);
　ShowCaret(Handle);
end;
end.