Drawing Bitmap in TTMSFNCGrid Cell

FNC TMS FNC UI Pack
1

In older VCL versions, I was able to draw bitmaps to accompany the text in a grid cell using the OnDrawCell event within a Windows application. Now I'm trying to do the same thing in a Firemonkey application and not sure how to go about it. I've seen posts about a TTMSFNCBitmapCell but have no idea how to designate a cell/column as such (and not sure I can include text in the cell as well). Note that the grid is NOT attached to a database, but is being populated via code.

I've tried using HTML in the cell, but not sure how to designate the Source parameter for a non-web application. I've also tried the OnCellBeforeDraw event, but am not getting the results I'm expecting.

Is there an example somewhere that would show me how to accomplish this? I'm willing to show the code I tried in the ONCellBeforeDraw if that would help. I'm using the latest version of the grid and Delphi Alexandria (11.3).

2

Please share your code so we can see what is happening.

3

Here is the code I'm using. It was drawn from the older DrawCell event in a previous version of the program, so I expect I've coded something incorrectly, but not sure what.

procedure TfrmTimeOffList.grdRecListCellBeforeDraw(Sender: TObject; ACol,
  ARow: Integer; AGraphics: TTMSFNCGraphics; var ARect, ATextRect: TRectF;
  var ADrawText, ADrawBackGround, ADrawBorder, AllowDraw: Boolean);
var
  TempString: string;
  i,
  TextWide: integer;
begin
  inherited;
  if ARow = 0 then
    Exit;
  TempString := grdRecList.Cells[ACol,ARow];
  { check the hours column for proper formatting }
  if ACol = 2 then begin
    grdRecList.Canvas.Font.Style := [];

    { use red if negative hours are entered }
    if StrToFloat(TempString) < 0 then
      grdRecList.Canvas.Fill.Color := TAlphaColorRec.Red;

    { bold the hours if negative hours are entered }
    if (TempString > '') and (StrToFloat(TempString) < 0) then
      grdRecList.Canvas.Font.Style := [TFontStyle.fsBold];
  end
  else begin
    { add the global image if the entry is a Global Time Off entry }
    if (Pos('G',grdRecList.Cells[3,ARow]) > 0) and (ACol = 1) then begin
      AGraphics.DrawBitmap(ATextRect.Left, ATextRect.Top +1,
            ATextRect.Left + imgGlobal.Bitmap.Width,
            imgGlobal.Bitmap.Height, imgGlobal.Bitmap);
      ATextRect.Left := ATextRect.Left + imgGlobal.Bitmap.Width + 2;
    end;

    { add the note image if the entry contains a comment }
    if (Pos('*',grdRecList.Cells[3,ARow]) > 0) and (ACol = 1) then begin
      TextWide := Trunc(grdRecList.Canvas.TextWidth(TempString)) + 2;
      { if the column is too narrow, truncate the Reason string }
      if ATextRect.Right - ATextRect.Left < TextWide + imgNote.Bitmap.Width then begin
        i := Length(TempString);
        while ((TextWide + imgNote.Bitmap.Width) > (ATextRect.Right - ATextRect.Left))
              and (i > 0) do begin
          TempString := Copy(TempString,1,i);
          Dec(i);
          TextWide := Trunc(grdRecList.Canvas.TextWidth(TempString + '...'));
        end;
        TempString := TempString + '...';
        AGraphics.DrawText(ATextRect, TempString);
      end
      else begin
        AGraphics.DrawText(ATextRect, TempString);
      end;
      ATextRect.Left := ATextRect.Left + grdRecList.Canvas.TextWidth(TempString) + 2;
      AGraphics.DrawBitmap(ARect.Left, ARect.Top, ARect.Left + imgNote.Bitmap.Width,
            imgNote.Bitmap.Height, imgNote.Bitmap);
    end;
  end;
end;
4

grdRecList.Canvas.Font should be replaced with AGraphics.Font
grdRectList.Canvas.Fill should be replaced with AGraphics.Fill

5

That helped some, now I can see the images in their proper location. However, when the row is highlighted by selection, the images are lost (although the text is still displayed properly). How do I get the images to show through the highlight?

Note that the images are png files with transparent backgrounds. Would giving them a background color help?

6

You can use ADrawBackground parameter and set it to False, then you will need to first draw your own background. The same applies to ADrawText since you are drawing the text yourself.

7

Great. That helped me resolve my problems.

1 Like