Fatal编程技术网
  • windows/
  • Windows 为什么自定义光标图像显示不正确？

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

windows delphi

Windows 为什么自定义光标图像显示不正确？,windows,delphi,bitmap,cursor,gdi,Windows,Delphi,Bitmap,Cursor,Gdi,背景 我已经编写了一个函数，它根据与给定设备上下文关联的位图创建自定义光标。我使用它来创建拖放光标，这些光标显示为“撕裂”，有点像“Trello”中使用的光标 我已经使用该函数一段时间了，没有出现任何问题，但是当我将它与一个新的树组件一起使用时，我正在处理它，开始创建部分空白的游标。 我已经验证了该问题出现在Delphi 2010和Delphi Berlin中，并且我还验证了它在Windows 7和Windows 10中都已损坏 下面是一张显示光标应该是什么样子的照片（抱歉，找不到快速屏幕抓取光

背景

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

我已经使用该函数一段时间了，没有出现任何问题，但是当我将它与一个新的树组件一起使用时，我正在处理它，开始创建部分空白的游标。

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

下面是一张显示光标应该是什么样子的照片（抱歉，找不到快速屏幕抓取光标的方法）：

这是当它部分空白时的样子（好吧，它不仅仅是部分空白-它实际上是看不见的）：

故障排除

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

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

具有两个TPaintBox组件的窗体：MyPaintBoxWorks和MyPaintBoxBreak

  • 当您单击MyPaintBoxWorks时，您将获得预期的光标
  • 当你点击MyPaintboxBreaked时，你只会得到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;
我已经详细研究了函数和Microsofts文档，没有发现函数有任何错误

我还学习了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;

程序TPngImage.DrawPartialTrans（DC:HDC；Rect:TRect）；
{调整矩形结构}
程序调整Rect（var Rect:TRect）；
变量
t：整数；
开始
如果右对齐<左对齐，则
开始
t:=右直；
右矩形：=左矩形；
矩形左：=t；
结束；
如果矩形底部<矩形顶部，则
开始
t:=垂直底部；
矩形底部：=矩形顶部；
矩形顶部：=t；
结束
结束；
类型
{访问像素}
TPixelLine=TRGBQuad的数组[字]；
pPixelLine=^TPixelLine；
常数
{用于创建位图的结构}
BitMapInfo头文件：TBITMapInfo头文件=
（biSize:sizeof（TBitmapInfoHeader）；
宽度：100；
身高：100；
双翼飞机：1；
比特数：32；
双压缩：双RGB；
biSizeImage:0；
biXPelsPerMeter:0；
双渗透计：0；
biClrUsed:0；
biclr值：0）；
变量
{缓冲区位图创建}
BitmapInfo:TBitmapInfo；
BufferDC:HDC；
缓冲位：指针；
旧位图，
缓冲位图：HBitmap；
标题：TChunkIHDR；
{透明度/调色板块}
透明区块：TChunktRNS；
PaletteChunk:TChunkPLTE；
TransValue，PaletteIndex:字节；
combit：整数；
资料：PByte；
{缓冲区位图修改}
是的，
BytesPerRowSrc，
BytesPerRowAlpha：整数；
ImageSource，ImageSourceOrg，
AlphaSource:pByteArray；
影像资料：pPixelLine；
i、 j，i2，j2：整数；
{用于位图拉伸}
W、 H：红衣主教；
拉伸：布尔；
FactorX，FactorY:Double；
开始
{准备矩形结构进行拉伸绘制}
如果是（Rect.Right=Rect.Left）或（Rect.Bottom=Rect.Top），则退出；
调整Rect（Rect）；
{获取宽度和高度}
W:=右直-左直；
H:=矩形底部-矩形顶部；
Header:=Self.Header；{快速访问标头}
拉伸：=（W标题宽度）或（H标题高度）；
如果拉伸，则系数x:=W/页眉。宽度，否则系数x:=1；
如果拉伸，则工厂：=H/割台。其他工厂的高度：=1；
{准备创建位图}
Fillchar（BitmapInfo，sizeof（BitmapInfo），#0）；
BitMapInfo标头.biWidth:=W；
BitMapInfo Header.biHeight:=-整数（H）；
BitmapInfo.bmiHeader:=BitmapInfo标头；
{创建接收背景的位图，应用}
{alpha混合，然后将在背景上绘制}
BufferDC:=CreateCompatibleDC（0）；
{如果无法创建BufferDC}
如果（BufferDC=0），则RaiseError（EPNGOutMemory，EPNGOutMemoryText）；
BufferBitmap:=CreateDIBSection（BufferDC、BitmapInfo、DIB_RGB_颜色、BufferBits、0、0）；
{如果无法创建缓冲区位图}
如果（BufferBitmap=0）或（BufferBits=Nil），则
开始
如果缓冲位图为0，则删除对象（缓冲位图）；
DeleteDC（BufferDC）；
RaiseError（EPNGOutMemory，EPNGOutMemoryText）；
结束；
{选择新位图并释放旧位图}
OldBitmap:=选择对象（BufferDC，BufferBitmap）；
{D

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;