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

Question

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

windowsdelphibitmapgdimouse-cursor

6

背景

我编写了一个函数，该函数基于与给定设备上下文相关联的位图创建自定义光标。我使用它来创建拖放光标，这些光标看起来像是“Trello”中使用的那种“撕开”。

我使用这个函数一段时间了，没有问题，但是当我在一个新的树组件上使用它时，它开始创建部分空白的光标。

我已经验证了该问题在Delphi 2010和Delphi Berlin中都存在，并且我还验证了它在Windows 7和Windows 10中都存在。

这里是一张照片，展示了光标应该是什么样子的（抱歉-无法找到快速截取光标的方法）：

这是部分空白的外观（好吧，它不只是部分空白-它几乎是看不见的）：

故障排除

经过故障排除，我发现如果在调用GetDragCursor之前向与DC相关联的位图写入PNG图像，则光标会出错。

以下是我能想到的演示问题的最简单代码：

一个带有两个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;

- Mads Boyd-Madsen

2

没有一个最小可复现的例子，很难指望别人能够理解这个问题。 - Sertac Akyuz

好的 - 很好。我会尝试将问题简化到最小部分。 - Mads Boyd-Madsen

我已经更新了问题，我认为现在它应该是一个MCVE。 - Mads Boyd-Madsen

似乎问题出在png绘制上。你的GetDragCursor对我来说很好用。你愿意尝试使用GDI+吗？ - kobik

Blitting没问题。图标有点奇怪... @kobik - 你得到了整个正方形，而不仅仅是png吗？ - Sertac Akyuz

显示剩余3条评论

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- kobik · Accepted Answer

我能够使用GDI+使其工作。
似乎Delphi的png绘制在透明的32位位图上画得不好。 (请参阅EDIT)
您的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。