为什么自定义光标图像显示不正确?

背景

我写了一个函数,根据与给定的设备上下文关联的位图创build一个自定义光标。 我使用它来创build拖放游标,这些游标显示为“撕下” – 有点像“Trello”中使用的游标。

我一直在使用该函数没有问题,但是当我用它与一个新的树组件,我正在开始创build部分空白的游标。

我已经证实,在Delphi 2010Delphi Berlin中都会出现这个问题,而且我也证实在Windows 7Windows 10中都出现了问题

这是一张照片,显示光标应该是什么样子(对不起 – 找不到一个快速的方法来屏幕抓取光标):

在这里输入图像说明

下面是部分空白的样子(好吧,它不是部分空白 – 实际上是隐形的):

在这里输入图像说明

故障排除

经过故障排除后,我发现,如果调用GetDragCursor 之前将PNG图像写入与DC相关的位图,光标就会混乱。

下面是我能想到的最简单的代码,它演示了这个问题:

包含两个TPaintBox组件的表单: MyPaintBoxWorksMyPaintBoxBroken

  • 当你点击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; 

我已经研究了函数和微软的文档,我找不到任何错误的function。

我也学习了TPngImage.Draw,看不出有什么明显的错误(我不希望如此)。 function:

  • 调用TPngImage.DrawPartialTrans,依次
  • 通过CreateDIBSection创build一个位图
  • 扫描像素并计算alpha混合的RGB值
  • 使用指针算术来移动像素缓冲区
  • 拨打BitBlt将最终图像复制到DC中

(我已经在问题末尾包含了该函数的代码以供参考)

如果我:

  • 注释写入像素缓冲区的代码,或者
  • 只扫描图像中的前几行,或者
  • 注释掉最后一次给BitBlt的电话

这看起来像是一个缓冲区溢出,但代码中没有任何东西似乎支持这一点。 另外,这更可能是我的代码有错。

我的函数GetDragCursorDrawPartialTrans中是否有任何错误或看起来可疑?

 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; 

我能够使它与GDI +一起工作。
看起来像Delphi的png绘制不能很好地绘制在透明的32位位图上。 (* 见编辑

你的GetDragCursor对我来说效果不错。

我用了一个高度为16的TPaintBox ,并加载了一个大小为32×32的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 +实际上是不需要的 (我最初的答案是基于德尔福7, DrawPartialTrans是不准确的)。

在较新的Delphi版本中, TPngImage.DrawPartialTrans在我所做的小测试中工作得很好。

但是,像我一样准备和使用屏幕外位图是正确的方法。
你可以使用上面相同的代码,而不是使用TGPImage只需使用一个TPngImage