为啥自定义光标图像显示不正确？
Posted
技术标签:
【中文标题】为啥自定义光标图像显示不正确？【英文标题】：Why does custom cursor image show up incorrect?为什么自定义光标图像显示不正确？ 【发布时间】：2018-05-06 20:49:58 【问题描述】：背景
我编写了一个函数，它根据与给定设备上下文关联的位图创建自定义光标。我用它来创建显示为“tear-offs”的拖放光标——有点像在“Trello”中使用的光标。
我已经使用该函数一段时间没有问题，但是当我将它与一个新的树组件一起使用时，我正在处理它开始创建部分空白光标。
我已验证该问题在 Delphi 2010 和 Delphi Berlin 中都存在，并且我还验证它在 Windows 7 中均已损坏> 和 Windows 10。
这是一张显示光标应该是什么样子的照片（抱歉 - 找不到快速的屏幕抓取光标的方法）：
这是它部分空白时的样子（嗯，它不仅仅是部分空白 - 它实际上是不可见的）：
疑难解答
故障排除后我发现，如果在调用 GetDragCursor 之前将 PNG 图像写入与 DC 关联的位图，则光标会混乱。
这是我能想到的最简单的代码，可以证明问题：
具有两个 TPaintBox 组件的表单：MyPaintBoxWorks 和 MyPaintBoxBroken。
当您单击 MyPaintBoxWorks 时，您会看到预期的光标。 当您单击 MyPaintBoxBroken 时，您将获得 png 图像。为了便于阅读（我希望如此），我排除了所有错误和资源处理。这对问题没有影响。 为了使其工作，您需要访问 Png 图像。任何 png 图像都可以。然后更新代码以加载您的图像。
uses
Types,
pngimage;
//////////////////////////////////////////////////////////////////////
procedure TMyForm.FormPaint(Sender: TObject);
begin
MyPaintBoxWorks.Canvas.Brush.Color := clGreen;
MyPaintBoxWorks.Canvas.Rectangle( 0, 0,
MyPaintBoxWorks.Width, MyPaintBoxWorks.Height );
MyPaintBoxBroken.Canvas.Brush.Color := clRed;
MyPaintBoxBroken.Canvas.Rectangle( 0, 0,
MyPaintBoxBroken.Width, MyPaintBoxBroken.Height );
end;
function GetDragCursor( Handle: HDC;
Width, Height: integer;
CursorX, CursorY: integer ): TCursor; forward;
//////////////////////////////////////////////////////////////////////
procedure TMyForm.MyPaintBoxWorksMouseDown( Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
begin
Screen.Cursor := GetDragCursor( MyPaintBoxWorks.Canvas.Handle,
MyPaintBoxWorks.Width, MyPaintBoxWorks.Height,
X, Y );
end;
//////////////////////////////////////////////////////////////////////
procedure TMyForm.MyPaintBoxBrokenMouseDown( Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer );
var
Img: TPngImage;
begin
Img := TPngImage.Create;
Img.LoadFromFile( 'D:\TestImage.png' );
Img.Draw( MyPaintBoxBroken.Canvas, Rect( 20, 20, 40, 40 ) );
Screen.Cursor := GetDragCursor( MyPaintBoxBroken.Canvas.Handle,
MyPaintBoxBroken.Width, MyPaintBoxBroken.Height,
X, Y );
end;
//////////////////////////////////////////////////////////////////////
function GetDragCursor( Handle: HDC;
Width, Height: integer;
CursorX, CursorY: integer ): TCursor;
var
MaskDC : HDC;
OrgMaskBmp : HBITMAP;
MaskBmp : HBITMAP;
ColourDC : HDC;
OrgColourBmp : HBITMAP;
ColourBmp : HBITMAP;
IconInfo : TIconInfo;
Brush : HBRUSH;
begin
// Create Colour bitmap
// ====================
ColourDC := CreateCompatibleDC( Handle );
ColourBmp := CreateCompatibleBitmap( Handle, Width, Height );
OrgColourBmp := SelectObject( ColourDC, ColourBmp );
BitBlt( ColourDC, 0, 0, Width, Height, Handle, 0, 0, SRCCOPY );
SelectObject( ColourDC, OrgColourBmp );
// Create Mask bitmap
// ==================
MaskDC := CreateCompatibleDC( Handle );
MaskBmp := CreateCompatibleBitmap( Handle, Width, Height );
OrgMaskBmp := SelectObject( MaskDC, MaskBmp );
// Fill with white
Brush := CreateSolidBrush( $FFFFFF );
FillRect( MaskDC, Rect( 0, 0, Width, Height ), Brush );
DeleteObject( Brush );
// Fill masked area with black
Brush := CreateSolidBrush( $000000 );
FillRect( MaskDC, Rect( 0, 0, Width, Height ), Brush );
DeleteObject( Brush );
SelectObject( MaskDC, OrgMaskBmp );
// Create and set cursor
// =====================
with iconInfo do
begin
fIcon := FALSE;
xHotspot := CursorX;
yHotspot := CursorY;
hbmMask := MaskBmp;
hbmColor := ColourBmp;
end;
Screen.Cursors[1] := CreateIconIndirect( iconInfo );
Result := 1;
end;
我详细研究了函数和微软的文档，我没有发现函数有什么问题。
我也研究过 TPngImage.Draw 并且看不出它有什么明显的错误（我不希望如此）。功能：
依次调用 TPngImage.DrawPartialTrans 通过 CreateDIBSection 创建位图 扫描像素并计算 alpha 混合 RGB 值 使用指针算法在像素缓冲区中移动 调用 BitBlt 将最终图像复制到 DC（我在问题末尾包含了函数的代码以供参考）
如果以下情况，游标总是正确生成的：
注释掉写入像素缓冲区的代码，或者 仅扫描图像中的前几行，或 注释掉对 BitBlt 的最终调用这看起来像是缓冲区溢出，但代码中似乎没有任何内容支持这一点。此外，更有可能是我的代码有问题。
问题
我的函数 GetDragCursor 或 DrawPartialTrans 中是否有任何错误或看起来可疑的内容？
procedure TPngImage.DrawPartialTrans(DC: HDC; Rect: TRect);
Adjust the rectangle structure
procedure AdjustRect(var Rect: TRect);
var
t: Integer;
begin
if Rect.Right < Rect.Left then
begin
t := Rect.Right;
Rect.Right := Rect.Left;
Rect.Left := t;
end;
if Rect.Bottom < Rect.Top then
begin
t := Rect.Bottom;
Rect.Bottom := Rect.Top;
Rect.Top := t;
end
end;
type
Access to pixels
TPixelLine = Array[Word] of TRGBQuad;
pPixelLine = ^TPixelLine;
const
Structure used to create the bitmap
BitmapInfoHeader: TBitmapInfoHeader =
(biSize: sizeof(TBitmapInfoHeader);
biWidth: 100;
biHeight: 100;
biPlanes: 1;
biBitCount: 32;
biCompression: BI_RGB;
biSizeImage: 0;
biXPelsPerMeter: 0;
biYPelsPerMeter: 0;
biClrUsed: 0;
biClrImportant: 0);
var
Buffer bitmap creation
BitmapInfo : TBitmapInfo;
BufferDC : HDC;
BufferBits : Pointer;
OldBitmap,
BufferBitmap: HBitmap;
Header: TChunkIHDR;
Transparency/palette chunks
TransparencyChunk: TChunktRNS;
PaletteChunk: TChunkPLTE;
TransValue, PaletteIndex: Byte;
CurBit: Integer;
Data: PByte;
Buffer bitmap modification
BytesPerRowDest,
BytesPerRowSrc,
BytesPerRowAlpha: Integer;
ImageSource, ImageSourceOrg,
AlphaSource : pByteArray;
ImageData : pPixelLine;
i, j, i2, j2 : Integer;
For bitmap stretching
W, H : Cardinal;
Stretch : Boolean;
FactorX, FactorY: Double;
begin
Prepares the rectangle structure to stretch draw
if (Rect.Right = Rect.Left) or (Rect.Bottom = Rect.Top) then exit;
AdjustRect(Rect);
Gets the width and height
W := Rect.Right - Rect.Left;
H := Rect.Bottom - Rect.Top;
Header := Self.Header; Fast access to header
Stretch := (W <> Header.Width) or (H <> Header.Height);
if Stretch then FactorX := W / Header.Width else FactorX := 1;
if Stretch then FactorY := H / Header.Height else FactorY := 1;
Prepare to create the bitmap
Fillchar(BitmapInfo, sizeof(BitmapInfo), #0);
BitmapInfoHeader.biWidth := W;
BitmapInfoHeader.biHeight := -Integer(H);
BitmapInfo.bmiHeader := BitmapInfoHeader;
Create the bitmap which will receive the background, the applied
alpha blending and then will be painted on the background
BufferDC := CreateCompatibleDC(0);
In case BufferDC could not be created
if (BufferDC = 0) then RaiseError(EPNGOutMemory, EPNGOutMemoryText);
BufferBitmap := CreateDIBSection(BufferDC, BitmapInfo, DIB_RGB_COLORS, BufferBits, 0, 0);
In case buffer bitmap could not be created
if (BufferBitmap = 0) or (BufferBits = Nil) then
begin
if BufferBitmap <> 0 then DeleteObject(BufferBitmap);
DeleteDC(BufferDC);
RaiseError(EPNGOutMemory, EPNGOutMemoryText);
end;
Selects new bitmap and release old bitmap
OldBitmap := SelectObject(BufferDC, BufferBitmap);
Draws the background on the buffer image
BitBlt(BufferDC, 0, 0, W, H, DC, Rect.Left, Rect.Top, SRCCOPY);
Obtain number of bytes for each row
BytesPerRowAlpha := Header.Width;
BytesPerRowDest := (((BitmapInfo.bmiHeader.biBitCount * W) + 31)
and not 31) div 8; Number of bytes for each image row in destination
BytesPerRowSrc := (((Header.BitmapInfo.bmiHeader.biBitCount * Header.Width) +
31) and not 31) div 8; Number of bytes for each image row in source
Obtains image pointers
ImageData := BufferBits;
AlphaSource := Header.ImageAlpha;
Longint(ImageSource) := Longint(Header.ImageData) +
Header.BytesPerRow * Longint(Header.Height - 1);
ImageSourceOrg := ImageSource;
case Header.BitmapInfo.bmiHeader.biBitCount of
R, G, B images
24:
FOR j := 1 TO H DO
begin
Process all the pixels in this line
FOR i := 0 TO W - 1 DO
begin
if Stretch then i2 := trunc(i / FactorX) else i2 := i;
Optmize when we don´t have transparency
if (AlphaSource[i2] <> 0) then
if (AlphaSource[i2] = 255) then
begin
pRGBTriple(@ImageData[i])^ := pRGBTriple(@ImageSource[i2 * 3])^;
ImageData[i].rgbReserved := 255;
end
else
with ImageData[i] do
begin
rgbRed := ($7F + ImageSource[2+i2*3] * AlphaSource[i2] + rgbRed *
(not AlphaSource[i2])) div $FF;
rgbGreen := ($7F + ImageSource[1+i2*3] * AlphaSource[i2] +
rgbGreen * (not AlphaSource[i2])) div $FF;
rgbBlue := ($7F + ImageSource[i2*3] * AlphaSource[i2] + rgbBlue *
(not AlphaSource[i2])) div $FF;
rgbReserved := not (($7F + (not rgbReserved) * (not AlphaSource[i2])) div $FF);
end;
end;
Move pointers
inc(Longint(ImageData), BytesPerRowDest);
if Stretch then j2 := trunc(j / FactorY) else j2 := j;
Longint(ImageSource) := Longint(ImageSourceOrg) - BytesPerRowSrc * j2;
Longint(AlphaSource) := Longint(Header.ImageAlpha) +
BytesPerRowAlpha * j2;
end;
Palette images with 1 byte for each pixel
1,4,8: if Header.ColorType = COLOR_GRAYSCALEALPHA then
FOR j := 1 TO H DO
begin
Process all the pixels in this line
FOR i := 0 TO W - 1 DO
with ImageData[i], Header.BitmapInfo do begin
if Stretch then i2 := trunc(i / FactorX) else i2 := i;
rgbRed := ($7F + ImageSource[i2] * AlphaSource[i2] +
rgbRed * (not AlphaSource[i2])) div $FF;
rgbGreen := ($7F + ImageSource[i2] * AlphaSource[i2] +
rgbGreen * (not AlphaSource[i2])) div $FF;
rgbBlue := ($7F + ImageSource[i2] * AlphaSource[i2] +
rgbBlue * (not AlphaSource[i2])) div $FF;
rgbReserved := not (($7F + (not rgbReserved) * (not AlphaSource[i2])) div $FF);
end;
Move pointers
Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
if Stretch then j2 := trunc(j / FactorY) else j2 := j;
Longint(ImageSource) := Longint(ImageSourceOrg) - BytesPerRowSrc * j2;
Longint(AlphaSource) := Longint(Header.ImageAlpha) +
BytesPerRowAlpha * j2;
end
else Palette images
begin
Obtain pointer to the transparency chunk
TransparencyChunk := TChunktRNS(Chunks.ItemFromClass(TChunktRNS));
PaletteChunk := TChunkPLTE(Chunks.ItemFromClass(TChunkPLTE));
FOR j := 1 TO H DO
begin
Process all the pixels in this line
i := 0;
repeat
CurBit := 0;
if Stretch then i2 := trunc(i / FactorX) else i2 := i;
Data := @ImageSource[i2];
repeat
Obtains the palette index
case Header.BitDepth of
1: PaletteIndex := (Data^ shr (7-(I Mod 8))) and 1;
2,4: PaletteIndex := (Data^ shr ((1-(I Mod 2))*4)) and $0F;
else PaletteIndex := Data^;
end;
Updates the image with the new pixel
with ImageData[i] do
begin
TransValue := TransparencyChunk.PaletteValues[PaletteIndex];
rgbRed := (255 + PaletteChunk.Item[PaletteIndex].rgbRed *
TransValue + rgbRed * (255 - TransValue)) shr 8;
rgbGreen := (255 + PaletteChunk.Item[PaletteIndex].rgbGreen *
TransValue + rgbGreen * (255 - TransValue)) shr 8;
rgbBlue := (255 + PaletteChunk.Item[PaletteIndex].rgbBlue *
TransValue + rgbBlue * (255 - TransValue)) shr 8;
end;
Move to next data
inc(i); inc(CurBit, Header.BitmapInfo.bmiHeader.biBitCount);
until CurBit >= 8;
Move to next source data
//inc(Data);
until i >= Integer(W);
Move pointers
Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
if Stretch then j2 := trunc(j / FactorY) else j2 := j;
Longint(ImageSource) := Longint(ImageSourceOrg) - BytesPerRowSrc * j2;
end
end Palette images
end case Header.BitmapInfo.bmiHeader.biBitCount;
Draws the new bitmap on the foreground
BitBlt(DC, Rect.Left, Rect.Top, W, H, BufferDC, 0, 0, SRCCOPY);
Free bitmap
SelectObject(BufferDC, OldBitmap);
DeleteObject(BufferBitmap);
DeleteDC(BufferDC);
end;
【问题讨论】：
注意：我也在 Delphi Berlin 测试过。在这里也行不通。也许并不奇怪，因为 pngimage-unit 基本上没有变化 期望有人在没有 MCVE 的情况下看这个不太现实。 是的——够公平的。我会尽量减少问题的最小部分。 我已经更新了这个问题，我认为它现在应该是一个 MCVE。 似乎问题出在 png 绘制上。你的GetDragCursor 对我来说很好用。你愿意尝试 GDI+ 吗？
【参考方案1】：
我能够使其与 GDI+ 一起使用。 似乎 Delphi png 绘制在透明的 32 位位图上画得不好。 (* 见编辑)
您的GetDragCursor 对我来说效果很好。
我使用了高度为 16 的 TPaintBox。并加载了大小为 32x32 的 PNG。并使用 32 位屏幕外位图创建光标。
uses GDIPOBJ, GDIPAPI;
procedure TForm1.FormCreate(Sender: TObject);
begin
PaintBox1.Height := 16;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
PaintBox1.Canvas.Brush.Color := clRed;
PaintBox1.Canvas.Rectangle(0, 0, PaintBox1.Width, PaintBox1.Height );
end;
procedure GPDrawImageOver(Image: TGPImage; dc: HDC; X, Y: Integer);
var
Graphics: TGPGraphics;
begin
Graphics := TGPGraphics.Create(dc);
try
Graphics.SetCompositingMode(CompositingModeSourceOver);
Graphics.DrawImage(Image, X, Y, Image.GetWidth, Image.GetHeight);
finally
Graphics.Free;
end;
end;
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Bmp: TBitmap;
Png: TGPImage;
x1, y1: Integer;
px: PRGBQuad;
begin
Bmp := TBitmap.Create;
try
Png := TGPImage.Create('C:\Users\Kobik\Downloads\Internet Explorer.png');
try
Bmp.Width := PaintBox1.Width;
Bmp.Height := Png.GetHeight;
Bmp.PixelFormat := pf32bit;
Bmp.HandleType := bmDIB;
Bmp.IgnorePalette := True;
// paint PaintBox1 canvas on the bitmap
BitBlt(Bmp.Canvas.Handle, 0, 0, PaintBox1.Width, PaintBox1.Height,
PaintBox1.Canvas.Handle, 0, 0, SRCCOPY);
// make the bottom bitmap part transparent
for y1 := 0 to Bmp.Height - 1 do
begin
px := Bmp.ScanLine[y1];
for x1 := 0 to Bmp.Width - 1 do
begin
if y1 < PaintBox1.Height then
px.rgbReserved := 255 // opaque
else
px.rgbReserved := 0; // fully transparent
Inc(px);
end;
end;
// draw png over the bitmap
GPDrawImageOver(Png, Bmp.Canvas.Handle, 0, 0);
finally
Png.Free;
end;
Screen.Cursor := GetDragCursor(Bmp.Canvas.Handle,
Bmp.Width, Bmp.Height, X, Y);
finally
Bmp.Free;
end;
end;
结果位图如下所示（底部完全透明）：
编辑：实际上不需要 GDI+（我最初的答案是基于 Delphi 7，其中 DrawPartialTrans 不准确）。
在较新的 Delphi 版本中，TPngImage.DrawPartialTrans 在我所做的小测试中运行良好。
但是，像我一样准备和使用屏幕外位图是正确的方法。
您可以使用上面相同的代码，但不要使用TGPImage，而只需使用TPngImage。
【讨论】：
谢谢你。虽然它没有解释为什么 pngimage 函数不起作用，但我对解决方案感到满意。我清楚地看到我应该将 GDI+ 用于我的所有绘图功能。 @MadsBoyd-Madsen，在绘制时，pngimage 不处理带有 alpha 的 32 位目标位图。它不考虑目标阿尔法。 （它总是使用 BitBlt 来绘制，而它可能需要使用 AlphaBlend 来绘制 32 位目标位图）。而 GDI+ 绘图在 32bit+alpha 位图上正确绘制。 酷。它仍然不能真正解释为什么进一步的 blitter-operations 根本无法正常工作。 我相信这段代码中重要的是不使用设备位图和干预 alpha 通道，而不是使用 GDIplus。对问题中的复制案例中的代码进行相同的更改，它也可以工作。 @kobik - 我假设您已经在屏幕上绘制了一个图形，例如标题上的排序箭头。然后您要拖动该标题，因此希望将标题作为一个整体捕获，并在其上带有图形以用作拖动光标。我假设的可能正确也可能不正确，但我认为这不会有所作为。另一部分，我只是评论说 GDI+ 不相关/不需要。可能是你使用的D7 png组件有问题。以上是关于为啥自定义光标图像显示不正确？的主要内容，如果未能解决你的问题，请参考以下文章