Delphi 11, VCL, runtime styles properties-CodePudding

Assuming I use a style in Delphi 11 VCL and I have a DBGrid painted accordingly to the style, the user can switch between a set of styles during application usage.

Q1. How can I retrive the color value a cell will be painted (and its font color too) at runtime?

Q2. I have to draw DBGrid's cells accordingly to some field values in the DBGrid's dataset. Using OnDrawColumnCell is easy BUT some styles really don't cope with customer's meaning colorset: they are really unwacthable. Thereafter I would like to alter the current style color (grid and its font) at runtime.

Thank you mates.

Giovanni

CodePudding user response：

Q1: Inside the OnDrawColumnCell event the Canvas.Brush.Color and Canvas.Font.Color are already set to the style values.

Q2: Remove seClient and seFont from the grid's StyleElements property and the grid's Color and Font.Color properties are used.

CodePudding user response：

If you use themes, then drawing goes in non-standard way. VCL use StyleHooks to draw any control with theme supports. If we talk about TDBGrid – it’s additional use lot of theme drawing by itself for optimization reasons, but you always can take a look at sources to understand how it works. Part of code that draws cells with different styles it’s TCustomDBGrid.DrawCell. I use part of it for my own implementation of TDBGrid, so here parts of sources for you to let you better understanding:

type
  TForm2 = class(TForm)
    Button1: TButton;
    DBGrid1: TDBGrid;
  private
    { Private declarations }
    function ColorFilter(AColor: TColor): TColor;
    function FillBMPGradient(var ABMP: TBitmap; ACol1, ACol2: TColor; AWidth,
      AHeight: integer; AVertical: Boolean = true): Boolean;
  public
    { Public declarations }
    procedure GenerateBitmap;
    function GrayScaleColor(AColor: TColor): TColor;
  end;

uses
  Vcl.Themes, VCL.GraphUtil;

//in real life this is field of class, but to simplify - i move it to VAR
var
  //Lot of precached bitmaps for future drawing of cell background
  FParLine, FNParLine, FSelLine, FGroupCell,
  FSelCell, FFixedLine, FGutter,
  FFixedSortCol, FSelGutter : TBitmap;
  //lot of precached colors
  FTitleFontColor, FSelectedFontColor, FCellFontColor,
  FBorderCellColor, FBorderSelCellColor, FBorderTitleCellColor,
  FBorderGutterCellColor, FBackGrountColor : TColor;

//function for make color gray
function TForm2.GrayScaleColor(AColor: TColor): TColor;
var
  xGray : byte;
begin
  xGray :=  Round((0.299 * GetRValue(AColor))   (0.587 * GetGValue(AColor))   (0.114 * GetBValue(AColor)));
  Result:= RGB(xGray, xGray, xGray);
end;

//function make colors gray of not, depends of Enable property of Grid
function TForm2.ColorFilter(AColor : TColor) : TColor;
begin
  if not Enabled then begin
    Result := GrayScaleColor(AColor)
  end else begin
    Result := AColor;
  end;
end;


function TForm2.FillBMPGradient(var ABMP: TBitmap; ACol1,
  ACol2: TColor; AWidth, AHeight: integer; AVertical: Boolean): Boolean;
begin
  ACol1 := ColorFilter(ACol1);
  ACol2 := ColorFilter(ACol2);

  if not Assigned(ABMP) then
     ABMP := TBitmap.create();

  if (AWidth <> 0) and (AWidth <> ABMP.Width) then
    ABMP.Width := AWidth;
  if (AHeight <> 0) and (AHeight <> ABMP.Height) then
    ABMP.Height := AHeight;

  if AVertical then
    Vcl.GraphUtil.GradientFillCanvas(ABMP.Canvas, ACol1, ACol2, ABMP.Canvas.ClipRect, gdVertical)
  else
    Vcl.GraphUtil.GradientFillCanvas(ABMP.Canvas, ACol1, ACol2, ABMP.Canvas.ClipRect, gdHorizontal);
end;

//this procedure generate bitmaps cache
procedure TForm2.GenerateBitmap;
const
  CFixedStates: array[Boolean, Boolean] of TThemedGrid = (
    (tgFixedCellNormal, tgFixedCellPressed),
    (tgFixedCellHot, tgFixedCellPressed));
  CFixedGradientStates: array[Boolean, Boolean] of TThemedGrid = (
    (tgGradientFixedCellNormal, tgGradientFixedCellPressed),
    (tgGradientFixedCellHot, tgGradientFixedCellPressed));
  CFixedClassicStates: array[Boolean, Boolean] of TThemedGrid = (
    (tgClassicFixedCellNormal, tgClassicFixedCellPressed),
    (tgClassicFixedCellHot, tgClassicFixedCellPressed));
  CNormalStates: array[Boolean] of TThemedGrid = (
    tgCellNormal, tgCellSelected);
  CNormalGradientStates: array[Boolean] of TThemedGrid = (
    tgGradientCellNormal, tgGradientCellSelected);
  CNormalClassicStates: array[Boolean] of TThemedGrid = (
    tgClassicCellNormal, tgClassicCellSelected);
var
  LStyle: TCustomStyleServices;
  LColor : TColor;
  LDetails: TThemedElementDetails;
  FUseStyle : boolean;
  xCol1, xCol2 : TColor;

 function UseTheme : boolean;
 begin
   Result := FUseStyle;
 end{function UseTheme};

 procedure MyDraw(var ABitmap : TBitmap; ADetails : TThemedElementDetails; AWidth : integer = 160; AHeight : integer = 16);
 var
   i : integer;
 begin
   if not Assigned(ABitmap) then begin
     ABitmap := TBitmap.Create;
     ABitmap.SetSize(AWidth, AHeight);
     i := SaveDC(ABitmap.Canvas.Handle);
     try
       LStyle.DrawElement(ABitmap.Canvas.Handle, LDetails, Rect(0, 0, AWidth, AHeight));
     finally
       RestoreDC(ABitmap.Canvas.Handle, i);
     end{finally};
   end{if};
 end;
begin
  ////////////////////
  //Fill Bitmap

  LStyle := StyleServices;
  FUseStyle := (not LStyle.IsSystemStyle) and LStyle.Enabled and (seClient in DBGrid1.StyleElements);
  if UseTheme then begin
    if not LStyle.GetElementColor(LStyle.GetElementDetails(tgCellNormal), ecTextColor, FCellFontColor) or
       (FCellFontColor = clNone) then
      FCellFontColor := clHighlightText;
    if not LStyle.GetElementColor(LStyle.GetElementDetails(tgCellSelected), ecTextColor, FSelectedFontColor) or
       (FSelectedFontColor = clNone) then
      FSelectedFontColor := clHighlightText;
    if not LStyle.GetElementColor(LStyle.GetElementDetails(tgFixedCellNormal), ecTextColor, FTitleFontColor) or
       (FTitleFontColor = clNone) then
      FTitleFontColor := clHighlightText;
  end else begin
    FCellFontColor := clBlack;//clBlack;
    FSelectedFontColor := clWhite;
    FTitleFontColor := clBlack;//clBlack;
  end{if..else};

  //FFixedSortCol
  if UseTheme then begin
     LDetails := LStyle.GetElementDetails(CFixedStates[true{(gdHotTrack in AState)},true{ (gdPressed in AState)}]);
     MyDraw(FFixedSortCol, LDetails);
  end else begin
    xCol1 := $00E0FCFC;
    xCol2 := $009EF3F3;

    FillBMPGradient(FFixedSortCol, xCol1, xCol2, 16, 16);
  end{if..else};

  //Fixed line
  if UseTheme then begin
     LDetails := LStyle.GetElementDetails(CFixedStates[false{(gdHotTrack in AState)},false{ (gdPressed in AState)}]);
     MyDraw(FFixedLine, LDetails);
     LStyle.GetElementColor(LStyle.GetElementDetails(tgFixedCellNormal), ecBorderColor, FBorderTitleCellColor);
     FBorderGutterCellColor := FBorderTitleCellColor;
  end else begin
    xCol1 := $00C8EDFB;
    xCol2 := $00ABDFF3;
    FBorderTitleCellColor :=  rgb(200, 170, 105);
    FBorderGutterCellColor := ($00D6D6D6);
    FillBMPGradient(FFixedLine, xCol1, xCol2, 19, 19, true); //$00D7FFE7
  end{if..else};

  //FParLine
  if UseTheme then begin
    LDetails := LStyle.GetElementDetails(CNormalStates[false {(gdSelected in AState) and (goDrawFocusSelected in FOptions)}]);
    if LStyle.GetElementColor(LDetails, ecFillColor, LColor) and (LColor <> clNone) then
      xCol1 := LColor;
    xCol1 := GetShadowColor(xCol1, 10);
    xCol2 := xCol1;
    FillBMPGradient(FParLine, xCol1, xCol2, 16, 16, true);
 end else begin
    xCol1 := $00f5f5f5;
    xCol2 := $00f5f5f5;
    FillBMPGradient(FParLine, xCol1, xCol2, 16, 16, true); //$00FEFAF5
  end{if..else};

  //FNParLine
  if UseTheme then begin
    LDetails := LStyle.GetElementDetails(CNormalStates[false {(gdSelected in AState) and (goDrawFocusSelected in FOptions)}]);
    if LStyle.GetElementColor(LDetails, ecFillColor, LColor) and (LColor <> clNone) then
      xCol1 := LColor;
    xCol2 := xCol1;
    FillBMPGradient(FNParLine, xCol1, xCol2, 16, 16, true);
  end else begin
    FillBMPGradient(FNParLine, clWhite, clWhite, 16, 16, true); //$00FEFAF5
  end{if..else};

  //FSelLine
  if UseTheme then begin
    LDetails := LStyle.GetElementDetails(CNormalStates[false {(gdSelected in AState) and (goDrawFocusSelected in FOptions)}]);
    if LStyle.GetElementColor(LDetails, ecFillColor, LColor) and (LColor <> clNone) then
      xCol1 := LColor;
    xCol1 := GetShadowColor(xCol1, 40);
    xCol2 := xCol1;
    FillBMPGradient(FSelLine, xCol1, xCol2, 16, 16, true);
  end else begin
    FillBMPGradient(FSelLine, $00E6E1D5, $00E6E1D5, 16, 16, true); //$00FEFAF5
  end{if..else};

  //sel cell
  if UseTheme then begin
    LDetails := LStyle.GetElementDetails(CNormalStates[true {(gdSelected in AState) and (goDrawFocusSelected in FOptions)}]);
    MyDraw(FSelCell, LDetails, 300, 21);
  end else begin
    FillBMPGradient(FSelCell, $00796951, $00796951, 16, 16, true);
  end{if..else};

  FillBMPGradient(FGroupCell,
                  $00E1AB80,
                  $00E1AB80,
                  16,
                  16,
                  true
                 );

  //FGutter
  if UseTheme then begin
    LDetails := LStyle.GetElementDetails(CFixedStates[false, false]);
    MyDraw(FGutter, LDetails);
  end else begin
    FillBMPGradient(FGutter, $00EBEBEB, $00DBDBDB, 16, 16, true);
  end{if..else};

  if UseTheme then begin
    LDetails := LStyle.GetElementDetails(CFixedStates[true, false]);
    MyDraw(FSelGutter, LDetails, 21, 21);
  end else begin
    FillBMPGradient(FSelGutter, $00FFF3D7, $00F0966A, 16, 16, true);
  end{if..else};
  //all is done ;)
  ////////////////////
end;

I use procedure GenerateBitmap after loading component and when theme is changed. After it - i use this colors for drawings my grid and draw cached bitmaps with scaling to fill cells background. Yea, i know that it's not comlete test project, but you can get answers for both your questions from it.