function CircleCursor(// 创建一个圆形的鼠标图案
AColor: TColor;// 指定圆形的颜色
ASize: Integer // 指定圆形的直径
): HCursor;// 返回鼠标图案句柄
var
vBitmapMask: TBitmap;
vBitmapColor: TBitmap;
vIconInfo: TIconInfo;
begin
vBitmapMask := TBitmap.Create;
vBitmapColor := TBitmap.Create;
try
vBitmapMask.PixelFormat := pf24bit;
vBitmapColor.PixelFormat := pf24bit;
vBitmapMask.Width := 32;
vBitmapMask.Height := 32;
vBitmapMask.Canvas.Brush.Color := clWhite;
vBitmapMask.Canvas.FillRect(Rect(0,0,32,32));
vBitmapMask.Canvas.Brush.Color := clBlack;
vBitmapMask.Canvas.Ellipse(0,0, ASize, ASize);
vBitmapColor.Width := 32;
vBitmapColor.Height := 32;
vBitmapColor.Canvas.Brush.Color := clBlack;
vBitmapColor.Canvas.FillRect(Rect(0,0,32,32));
vBitmapColor.Canvas.Pen.Color := AColor;
vBitmapColor.Canvas.Brush.Color := AColor;
vBitmapColor.Canvas.Ellipse(0,0, ASize, ASize);
vIconInfo.fIcon := True;
vIconInfo.xHotspot := ASize div 2;
vIconInfo.yHotspot := ASize div 2;
vIconInfo.hbmMask := vBitmapMask.Handle;
vIconInfo.hbmColor := vBitmapColor.Handle;
Result := CreateIconIndirect(vIconInfo);
finally
vBitmapMask.Free;
vBitmapColor.Free;
end;
end;{ CircleCursor }
const
crMyCursor = 5;
procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.Cursors[crMyCursor] := CircleCursor(clRed,16);
Screen.Cursor := crMyCursor;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DestroyIcon(Screen.Cursors[crMyCursor]);
Screen.Cursors[crMyCursor] := 0;
end;
