简体   繁体   中英

Getting PNG images drawn to canvas using image's Alpha channel

I'm making a program to show lottery draw results history and statistics from the result data. I want to show images of the balls instead of just their numbers, so I made a set of png images of 3D-looking balls with numbers on them, small ones 32x32 and larger 48x48. Such as:

彩票球的形象

These are obviously circular with anti-aliased edges even on the alpha channel. I couldn't get them loaded into a TImageList and shown on a canvas without loosing alpha transparency, the best I got was a hard mask. Instead I have created at design-time a TImage for each ball with the the ball's png image loaded. To easily reference to them by ball number I declared var Balls: array[1..59] of TImage; , which I connect to each TImage in my form's OnCreate which is simply Balls[1] := Image01; Balls[2] := Image02; Balls[1] := Image01; Balls[2] := Image02; and so on. I use the OnMouseEnter/OnMouseLeave/OnClick events of these TImages to highlight and select them. I actually have another TImage to represent the selection highlight which is slightly larger than the balls and appears behind a Ball's TImage when the mouse is over a ball. All this works fine, but now I want to use the same images in a TDrawGrid which displays all the results data mostly as text but I want the ball numbers shown as images, using the OnDrawCell event.

Here's the problem: I can't find a way to copy the image with it's alphachannel onto the DrawGrid canvas - I had the error message when using CopyRect: 'can only modify an image if it contains a bitmap' so I found the solution online to create a TBitmap and copy the Ball's TImage but it lost the alpha blend and the background is black. I just want to be able to copy an alphachannel image to any canvas where the background could be any colour (clBtnFace for instance).

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;

UPDATE - I solved it myself. I took another look at the Draw method I first tried (and abandoned because they were appearing in the wrong place) and realised I had muddled up the X+Y. Here's the cleaned up code. I'm sure it could be simplified a bit more. I'm still playing around to see how I can craft a nice 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;

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM