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

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;