Mlody87 Mlody87 - 1 month ago 28
Pascal Question

Transparent color in StringGrid

I fill cells in StringGrid green color

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin

StringGrid.Canvas.Brush.Color := clGreen;
StringGrid.Canvas.FillRect(Rect);

StringGrid.Canvas.TextOut(Rect.Left + 2, Rect.Top + 2, AGrid.Cells[ACol, ARow]);

end;


My StringGrid has black color. I would like to fill cell transparent color (for example 50%).

How can I do this?

I should draw rectangle? Or I should create bitmap and put in to cell?

Can you help me?:)

Imean effect like this:
enter image description here

Answer

With inspiration from this post I first created a TStringGrid with an image in the background. Then I added a tranparent color using WinApi.Windows.AlphaBlend() for the selected cells and similarily for the fixed cells. The end result is this:

enter image description here

The transparent "selected" color is done as a 1 pixel bitmap:

type
  TStringGrid = class(Vcl.Grids.TStringGrid)
  private
    FBackG: TBitmap;
    FForeG: TBitmap;
  ...

procedure TForm5.Button1Click(Sender: TObject);
begin
  sg.FForeG.Free;
  sg.FForeG := TBitmap.Create;
  sg.FForeG.SetSize(1, 1);
  sg.FForeG.PixelFormat := pf32bit;
  sg.FForeG.Canvas.Pixels[0, 0] := $00FF00;  // BGR
end;

And the bitmap is applied for "selected" cells (gdSelected in State) in the OnDrawCell event

procedure TForm5.sgDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
  State: TGridDrawState);
var
  sg: TStringGrid;
  r: TRect;
  success:boolean;
begin
  if not (Sender is TStringGrid) then Exit;
  sg := Sender as TStringGrid;

  r := Rect;
  r.Left := r.Left-4; // Might not be needed, depending on Delphi version?

  // Clear the cell
  sg.Canvas.Brush.Color := clBlack;
  sg.Canvas.FillRect(r);

  // Copy background to cell
  BitBlt(sg.Canvas.Handle,
    r.Left, r.Top, r.Right - r.Left, r.Bottom - r.Top,
    sg.FBackG.Canvas.Handle, r.Left, r.Top, SRCCOPY);

    // Draw fixed column or row cell(s)
  if gdFixed in State then
  begin
    success := Winapi.Windows.AlphaBlend(sg.Canvas.Handle,
      r.Left, r.Top, r.Right - r.Left, r.Bottom - r.Top,
      sg.FHeadG.Canvas.Handle, 0, 0, 1, 23, BlendFunc);
  end;

  // Draw selected cell(s)
  if gdSelected in State then
  begin
    success := Winapi.Windows.AlphaBlend(sg.Canvas.Handle,
      r.Left, r.Top, r.Right - r.Left, r.Bottom - r.Top,
      sg.FForeG.Canvas.Handle, 0, 0, 1, 1, BlendFunc);
  end;

  // Draw the text
  r := Rect;
  sg.Canvas.Brush.Style := bsClear;
  DrawText(sg.Canvas.Handle, sg.Cells[ACol, ARow],
    length(sg.Cells[ACol, ARow]), r,
    DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS);
end;

The BlendFunc: _BLENDFUNCTION; structure can be declared in the TStringGrid subclass or elsewhere where it is accessible, I declared it in the form and initialized it in the forms OnCreate event:

  BlendFunc.BlendOp := AC_SRC_OVER;
  BlendFunc.BlendFlags := 0;
  BlendFunc.SourceConstantAlpha := 128;  // This determines opacity
  BlendFunc.AlphaFormat := AC_SRC_ALPHA;

Now, you may ask, how come a 1-pixel bitmap works, and the answer is in the documentation for AlphaBlend():

If the source rectangle and destination rectangle are not the same size, the source bitmap is stretched to match the destination rectangle.

This is useful since the cell rectangles usually varies in size.

The header row and column are similarily drawn in the OnDrawCell on condition if gdFixed in State and here another bitmap is used. It is a 1 pixel wide and 23 pixels high bitmap I made separately in a graphics drawing program.

enter image description here

Yes! The tiny thing above is the image.