动态创建一个鼠标指针图案

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;