delphipascallazarusfreepascalstringgrid

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


Solution

  • 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.