由 dawei
背景
我编写了一个函数,它根据与给定设备上下文关联的位图创建自定义光标.我使用它来创建拖拽光标,显示为“撕下” – 有点像它们在“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,MyPaintBoxWorks.Width,MyPaintBoxWorks.Height );
MyPaintBoxBroken.Canvas.Brush.Color := clRed;
MyPaintBoxBroken.Canvas.Rectangle( 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.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.Height,Y );
end;
//////////////////////////////////////////////////////////////////////
function GetDragCursor( Handle: HDC;
Width,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,Height,Handle,SRCCOPY );
SelectObject( ColourDC,OrgColourBmp );
// Create Mask bitmap
// ==================
MaskDC := CreateCompatibleDC( Handle );
MaskBmp := CreateCompatibleBitmap( Handle,Height );
OrgMaskBmp := SelectObject( MaskDC,MaskBmp );
// Fill with white
Brush := CreateSolidBrush( $FFFFFF );
FillRect( MaskDC,Rect( 0,Height ),Brush );
DeleteObject( Brush );
// Fill masked area with black
Brush := CreateSolidBrush( $000000 );
FillRect( MaskDC,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);
{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,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 dont 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,BufferDC,SRCCOPY);
{Free bitmap}
SelectObject(BufferDC,OldBitmap);
DeleteObject(BufferBitmap);
DeleteDC(BufferDC);
end;
我能够使它与GDI一起工作.
好像Delphi png draw在透明的32位Bitmap上绘制得不好. (*见编辑)
你的GetDragCursor对我很有用.