Bayesean Blog - Desktop, Mobile and IOT Developer Blog ### Delphi A Professional VCL DBGrid Part Three

Posted on 5th May 2019 in Delphi VCL We have covered three other parts to the Four Part series.

Feel free to read part one, part two, part four.

The second last Part in the series Part Three covers the following areas.

• Add Star levels to a column
• Add circle levels to a Column

Add Star levels to a column

Drawing Star levels requires reasonably simple trigonometry to draw each star.

In the DBgridutils unit a type Tpent declares a five array of Tpoint for the Star which is typically five points.

Code

``````type

TPent = array [0 .. 4] of TPoint;``````

To draw a star, a function is created makePent which creates the five points as Tpoint of the star as a Tpent.

The Code below shows the sin,cos and tan functions to determine the five points of a star.

Code

``````function MakePent(X, Y, L: integer): TPent;

var

DX1, DY1, DX2, DY2: integer;

newpent: TPent;

const

Sin54 = 0.809;

Cos54 = 0.588;

Tan72 = 3.078;

begin

DX1 := trunc(L * Sin54);

DY1 := trunc(L * Cos54);

DX2 := L div 2;

DY2 := trunc(L * Tan72 / 2);

newpent := point(X, Y);

newpent := point(X - DX1, Y + DY1);

newpent := point(X - DX2, Y + DY2);

newpent := point(X + DX2, Y + DY2);

newpent := point(X + DX1, Y + DY1);

result := newpent;

end;``````

The function Draw Pentacle will draw the lines to complete the star shape using the array points of Tpent.

``````procedure DrawPentacle(Canvas: TCanvas; Pent: TPent);

begin

with Canvas do

begin

MoveTo(Pent.X, Pent.Y);

LineTo(Pent.X, Pent.Y);

LineTo(Pent.X, Pent.Y);

LineTo(Pent.X, Pent.Y);

LineTo(Pent.X, Pent.Y);

LineTo(Pent.X, Pent.Y);

end;

end;``````

The Stardrawcombodrawcolumncell  procedure is inserted into the dbgrid ondrawcolumncell procedure to draw the styled stars. Set the starnum for the number of stars required and the activestar is the number of stars that are active. Typically this value will come from a Database or from live data. All colors can be adjusted and an included option is provided to include a background if required.

It typically takes the Drawpenticle and multiplies the stars by the number of stars selected.

Thereafter the stars are styled.

To style the stars correctly the windows function setpath and fillpath is actioned as the function

SetPolyFillMode is processed. This will ensure that the styling is correctly applied to all the star’s in the grid.

Usage

``````StarCombodrawcolumncell(Sender, DBGrid1, 8, DataCol, 3, 5, g, clWebGold,

clgray, Rect, Column, State, false);``````

``````procedure StarCombodrawcolumncell(sender: Tobject; Grid: TDBGrid;

colpos, datacol, offset, starnum, activestar: integer;

ActiveColor, InactiveColor: tcolor; Rect: TRect; Column: TColumn;

State: TGridDrawState; isbackground: boolean = false);

var

Pent: TPent;

i: integer;

fullwidth, Width: integer;

finalColor: tcolor;

R: TRect;

X, Y, L: integer;

begin

if (not(gdFixed in State)) and (datacol = colpos) then

begin

R := Rect;

if isbackground = true then

begin

inflaterect(R, -1, -1);

Grid.Canvas.Brush.color := styleservices.GetStyleColor(scButtonDisabled);

TDBGrid(sender).DefaultDrawColumnCell(R, datacol, Column, State);

end;

inflaterect(Rect, 0, 0);

L := (Rect.bottom - Rect.top) div 2;

Y := Rect.top + 2;

X := Rect.left + 3 + (offset div 2);

Width := trunc(L + (L div 2));

X := X + (Width div 2) + offset;

for i := 1 to starnum do

begin

finalColor := ActiveColor;

if i = 1 then

X := X;

if i > 1 then

X := X + Width;

if i > activestar then

finalColor := InactiveColor;

Pent := MakePent(X, Y, L);

BeginPath(Grid.Canvas.Handle);

DrawPentacle(Grid.Canvas, Pent);

EndPath(Grid.Canvas.Handle);

SetPolyFillMode(Grid.Canvas.Handle, WINDING);

Grid.Canvas.Brush.color := finalColor;

FillPath(Grid.Canvas.Handle);

// this fills the path using the brush colour

end;

end;

end;``````

Add circle levels to a Column

To Draw circle levels, this allows a different look vs the star rating. The first step is to draw the circle in a procedure DrawEllipsefromcenter. It uses the radius required and number of circles which it receives within the CircleCombdrawcolumncell procedure.

``````procedure DrawEllipseFromCenter(Canvas: TCanvas; Rect: TRect;

Radius, n: integer);

var

R: TRect;

begin

with Canvas do

begin

R.top := Rect.top;

if n = 1 then

R.left := Rect.left

else

R.left := Rect.left + (((Radius * 2)) * (n - 1));

R.bottom := Rect.bottom;

if n = 1 then

R.right := Rect.left + (Radius * 2) - 1

else

R.right := Rect.left + (((Radius * 2)) * (n)) - 1;

Ellipse(R);

end;

end;``````

Adding the next procedure into the DBGRID ondrawcolumncell event will draw the circles in a column.

The column is selected and an offset can be added to reposition the beginning of the circle in the grid column. Set the ratingnum will set the number of circles to show. The activating number draws the number of active circles which will typically be from live data or a database. The active and inactive color is set to match the required colors required.

Usage

``````CircleCombdrawcolumncell(Sender, DBGrid1, DataCol, 10, 0, 5, h, clWebYellow,

clgray, Rect, Column, State, false);``````

Code

``````procedure CircleCombdrawcolumncell(sender: Tobject; Grid: TDBGrid;

colpos, datacol, offset, ratingnum, activerating: integer;

ActiveColor, InactiveColor: tcolor; Rect: TRect; Column: TColumn;

State: TGridDrawState; isbackground: boolean = false);

var

Radius: integer;

i: integer;

R, CircleRect: TRect;

begin

if (not(gdFixed in State)) and (datacol = colpos) then

begin

R := Rect;

if isbackground = true then

begin

inflaterect(R, -1, -1);

Grid.Canvas.Brush.color := styleservices.GetStyleColor(scButtonDisabled);

TDBGrid(sender).DefaultDrawColumnCell(R, datacol, Column, State);

end;

inflaterect(Rect, -2, -3);

CircleRect.top := Rect.top;

Radius := (Rect.bottom - Rect.top) div 2;

CircleRect.right := Radius * ratingnum;

CircleRect.left := Rect.left + offset;

CircleRect.bottom := Rect.bottom;

inflaterect(CircleRect, -2, -2);

for i := 1 to ratingnum do

begin

if i <= activerating then

begin

Grid.Canvas.Pen.color := ActiveColor;

Grid.Canvas.Brush.color := ActiveColor;

end

else

begin

Grid.Canvas.Pen.color := InactiveColor;

Grid.Canvas.Brush.color := InactiveColor;

end;

DrawEllipseFromCenter(Grid.Canvas, CircleRect, Radius, i);

end;

end;

end;``````

Code Repository

Feel Free to download the code that covers all four parts here

9+5