【发布时间】：2018-02-11 19:50:22
【问题描述】：
我正在制作一个程序来显示抽奖结果历史和结果数据的统计数据。我想显示球的图像而不仅仅是它们的数字，所以我制作了一组带有数字的 3D 外观球的 png 图像，小的 32x32 和更大的 48x48。如：
即使在 Alpha 通道上，这些显然也是带有抗锯齿边缘的圆形。我无法将它们加载到 TImageList 并显示在画布上而不会失去 alpha 透明度，我得到的最好的方法是硬蒙版。相反，我在设计时为每个球创建了一个 TImage，并加载了球的 png 图像。为了通过球号轻松引用它们，我声明了var Balls: array[1..59] of TImage;，我将其连接到表单的 OnCreate 中的每个 TImage，即简单的 Balls[1] := Image01; Balls[2] := Image02; 等等。我使用这些 TImage 的 OnMouseEnter/OnMouseLeave/OnClick 事件来突出显示和选择它们。实际上，我有另一个 TImage 来表示比球稍大的选择高光，当鼠标悬停在球上时，它会出现在 Ball 的 TImage 后面。所有这一切都很好，但现在我想在 TDrawGrid 中使用相同的图像，它主要将所有结果数据显示为文本，但我希望使用 OnDrawCell 事件将球号显示为图像。
问题是：我找不到将带有 alphachannel 的图像复制到 DrawGrid 画布上的方法 - 我在使用 CopyRect 时收到错误消息：'can only modify an image if it contains a bitmap' 所以我发现在线解决方案创建一个 TBitmap 并复制 Ball 的 TImage 但它丢失了 alpha 混合并且背景是黑色的。我只想能够将 alphachannel 图像复制到背景可以是任何颜色的任何画布（例如 clBtnFace）。
const
CellPadding = 4;
Colnames: array [0..15] of string = ('Draw','Day','Date','Month','Year','1st','2nd','3rd','4th','5th','6th','B','Jackpot','Wins','Machine','Ball set');
procedure TLottoResults.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
dcBall: Integer;
dcRect: TRect;
dcBmp: TBitmap;
begin
DrawGrid1.Canvas.Brush.Style := bsClear;
if ARow = 0 then
begin
DrawGrid1.Canvas.Font.Name := 'Tahoma';
DrawGrid1.Canvas.Font.Size := 12;
DrawGrid1.Canvas.Font.Style := [fsBold];
DrawGrid1.Canvas.TextRect(Rect, Rect.Left+CellPadding, Rect.Top, Colnames[ACol])
end
else
begin
if gdSelected in State then DrawGrid1.Canvas.Brush.Color := clGreen
else DrawGrid1.Canvas.Brush.Color := clNavy;
DrawGrid1.Canvas.FillRect(Rect);
DrawGrid1.Canvas.Font.Color := clWhite;
if ACol in [5..11] then // columns to display images instead of text
begin
// StringGrid1 is what the raw CSV data is loaded into first and is kept invisible,
// and it's contents are copied to DrawGrid1 for actual display.
if TryStrToInt(StringGrid1.Cells[ACol, ARow-1], dcBall)then
begin
if dcBall in [1..59] then
begin
dcBmp := TBitmap.Create;
// Following disabled code is what has been tried in various combinations
// dcBmp.PixelFormat := pf32bit;
// dcBmp.TransparentMode := tmFixed;
// dcBmp.TransparentColor := clBtnFace;
// dcBmp.AlphaFormat := afDefined;
// Balls[dcBall].Picture.Graphic.Transparent := True;
dcBmp.Assign(Balls[dcBall].Picture.Graphic);
Balls[dcBall].Picture.Bitmap := dcBmp;
// FreeAndNil(dcBmp);
dcRect := TRect.Create(0,0,32,32);
if DataLoaded then
DrawGrid1.Canvas.CopyRect(TRect.Create(Rect.Left+2, Rect.Top+2, Rect.Left+32+2, Rect.Top+32+2), Balls[dcBall].Canvas, dcRect);
// DrawGrid1.Canvas.Draw(Rect.Top,Rect.Left,Balls[dcBall].Picture.Graphic); // Draw draws in the wrong place, why?
end
else
begin // Display as text if not in range 1 to 59
DrawGrid1.Canvas.Font.Name := 'Courier New';
DrawGrid1.Canvas.Font.Size := 12;
DrawGrid1.Canvas.Font.Style := [];
DrawGrid1.Canvas.TextRect(Rect, Rect.Left+CellPadding, Rect.Top+(DrawGrid1.RowHeights[ARow] div 2)-(DrawGrid1.Canvas.TextHeight('Ag') div 2), '('+StringGrid1.Cells[ACol, ARow-1]+')');
end;
end
else
begin // Display as text is TryStrToInt failed
DrawGrid1.Canvas.Font.Name := 'Courier New';
DrawGrid1.Canvas.Font.Size := 12;
DrawGrid1.Canvas.Font.Style := [];
DrawGrid1.Canvas.TextRect(Rect, Rect.Left+CellPadding, Rect.Top+(DrawGrid1.RowHeights[ARow] div 2)-(DrawGrid1.Canvas.TextHeight('Ag') div 2), StringGrid1.Cells[ACol, ARow-1]);
end;
end
else
begin // All other columns display as text
DrawGrid1.Canvas.Font.Name := 'Courier New';
DrawGrid1.Canvas.Font.Size := 12;
DrawGrid1.Canvas.Font.Style := [];
DrawGrid1.Canvas.TextRect(Rect, Rect.Left+CellPadding, Rect.Top+(DrawGrid1.RowHeights[ARow] div 2)-(DrawGrid1.Canvas.TextHeight('Ag') div 2), StringGrid1.Cells[ACol, ARow-1]);
end;
end;
end;
【问题讨论】：
-
欢迎来到stackoverflow。请，你能提供一些你的具体问题的代码。这证明了您尝试了多远，它将帮助其他成员更好地理解您的问题，当时，您将向他们提供您的问题的背景。请检查以下链接：stackoverflow.com/help/mcve 和 stackoverflow.com/help/how-to-ask
-
这是给德尔福的吗？如果是这样，我们可能应该这样标记它
-
Delphi，XE8，但适用于任何版本的解决方案也可以！
-
您走错了路，返回将它们加载到图像列表并按照评论使用“绘图”。除了 'AlphaBlend' GDI 会忽略 alpha 通道，'CopyRect' 将不起作用。