在Delphi中生成带透明的光标

最新推荐文章于 2024-09-01 09:47:21 发布

原创最新推荐文章于 2024-09-01 09:47:21 发布 · 1.5k 阅读

2 ·

CC 4.0 BY-SA版权

文章标签：

#delphi #integer #function #图形 #测试

随笔专栏收录该内容

6 篇文章

订阅专栏

本文介绍了一种通过Delphi中的TBitmap和TGraphic对象来创建自定义Windows光标的方法。详细展示了如何利用颜色键（color key）生成掩膜，并通过具体的函数实现将位图转换为光标资源。此外还提供了一个示例程序，演示了如何加载位图文件并将其设置为当前窗体的光标。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

//默认颜色贱值是粉红色
//color_key,用于生成mask的，因为只有bitmap才能生成mask,color_key表示透明部分以什么颜色代替
function CreateCursorByGraphic(bm:TGraphic ; const hotx,hoty : Integer;
                               const color_key : TColor = TColor($FF00FF)):HCursor;
var
IconSizeX : integer;
IconSizeY : integer;
AndMask : TBitmap;
OrMask : TBitmap;
IconInfo : TIconInfo;
myrc     : TRect;
begin
AndMask := TBitmap.Create;
OrMask := TBitmap.Create;
try
    IconSizeX := bm.Width;
    IconSizeY := bm.Height;
    AndMask.Width := IconSizeX;
    AndMask.Height := IconSizeY;
    OrMask.Width := IconSizeX;
    OrMask.Height := IconSizeY;
    myrc := RECT (0,0,IconSizeX,IconSizeY);

    //make mask,为什么要这么麻烦，而不直接使用mask呢?这是为了保证本身有透明的图形也能支持
    AndMask.Canvas.Brush.Color := color_key;
    AndMask.Canvas.FillRect (myrc);
    AndMask.Canvas.Draw( 0,0,bm );
    AndMask.Mask( color_key ); //制做出来的Mask，只有黑白两色

    //make 'or operation' draw
    OrMask.Canvas.Brush.Color := clBlack;
    OrMask.Canvas.FillRect (myrc);
    OrMask.Canvas.Draw(0,0,bm);

    //生成光标ICON
    IconInfo.fIcon := False;
    IconInfo.xHotspot := -hotx;
    IconInfo.yHotspot := hoty;
    IconInfo.hbmMask := AndMask.Handle;//bmp.Handle;//AndMask.Handle;
    IconInfo.hbmColor := OrMask.Handle;

    Result:= CreateIconIndirect(IconInfo);
finally
    AndMask.Free;
    OrMask.Free;
end;
end;

//从普通的BMP中生成光标
function CreateCursorByBitmap (bm : TBitmap;const hotx,hoty : Integer; const color_key : TColor = TColor($FF00FF)):HCursor;
var
old_color : TColor;
old_trans : Boolean;
begin
old_color := bm.TransparentColor;
old_trans := bm.Transparent;
bm.TransparentColor := color_key;
bm.Transparent := true;
try
    Result := CreateCursorByGraphic (bm,hotx,hoty,color_key);
finally
    bm.TransparentColor := old_color;
    bm.Transparent := old_trans;
end;
end;

//测试代码

var
b1 : TBitmap;
begin
b1 := TBitmap.Create;
try
    b1.LoadFromFile( 'Popo.bmp' );
    cursor := CreateCursorByBitmap (b1,0,0);
    screen.Cursors[10] := cursor;
    Form1.Cursor := 10;

finally
b1.Free;
end;