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


本文整理自网络,侵删。

 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;

相关阅读 >>

Delphi twebbrowser 屏蔽右键菜单

Delphi 从url地址中获得文件名

Delphi 字符串插入与删除

Delphi 10 seattle plus 新特性――system.json.builders

Delphi 根据字符串分隔符位置取值

Delphi 多函数形式的多线程同步-线程执行顺序

Delphi 获取url特殊路径

paramstr返回运行当行程序的某个参数

Delphi远程开机再配合远程控制

Delphi中的sha256算法

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...