为什么自定义光标图像显示不正确？答案

【问题标题】：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+ 吗？

标签： windows delphi bitmap gdi mouse-cursor

【解决方案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组件有问题。