delphi - 使用图像的 Alpha channel 将 PNG 图像绘制到 Canvas 上

Question

我正在制作一个程序来显示彩票抽奖结果历史记录和结果数据的统计数据。我想显示球的图像而不仅仅是它们的数字，因此我制作了一组带有数字的 3D 球的 png 图像，小球为 32x32，大球为 48x48。如:

这些明显是圆形的，即使在 Alpha channel 上也具有抗锯齿边缘。我无法将它们加载到 TImageList 中并在 Canvas 上显示而不丢失 alpha 透明度，我得到的最好的是硬掩模。相反，我在设计时为每个球创建了一个 TImage，并加载了球的 png 图像。为了通过球号轻松引用它们，我声明了 var Balls: array[1..59] of TImage;，我将其连接到表单的 OnCreate 中的每个 TImage，即 Balls[1 ] := Image01; Balls[2] := Image02; 等等。我使用这些 TImage 的 OnMouseEnter/OnMouseLeave/OnClick 事件来突出显示并选择它们。实际上，我有另一个 TImage 来表示选择突出显示，它比球稍大，并且当鼠标位于球上方时出现在球的 TImage 后面。所有这些工作正常，但现在我想在 TDrawGrid 中使用相同的图像，该图像主要以文本形式显示所有结果数据，但我希望使用 OnDrawCell 事件将球号显示为图像。

问题是:我找不到将带有 alpha channel 的图像复制到 DrawGrid Canvas 上的方法 - 使用 CopyRect 时出现错误消息:“只能修改包含位图的图像”，所以我发现网上的解决方案创建一个TBitmap并复制球的TImage，但它丢失了alpha混合并且背景是黑色的。我只是希望能够将 alpha channel 图像复制到背景可以是任何颜色的任何 Canvas (例如 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;

Answer 1

更新 - 我自己解决了。我再次查看了我第一次尝试的 Draw 方法(由于它们出现在错误的位置而放弃了)，并意识到我混淆了 X+Y。这是清理后的代码。我确信它可以进一步简化。我仍在尝试如何制作一个漂亮的 DrawGrid。 Here's a screen grab of the result.

procedure TLottoResults.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  dcBall: Integer;
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
          if DataLoaded then
             DrawGrid1.Canvas.Draw(Rect.Left+2,Rect.Top+2,Balls[dcBall].Picture.Graphic); 
        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;