Bayesean Blog - Desktop, Mobile and IOT Developer Blog


Delphi A Professional VCL DBGrid Part Three

Posted on 5th May 2019 in Delphi VCL


part3header43.png

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[0] := point(X, Y);

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

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

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

  newpent[4] := 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[0].X, Pent[0].Y);

    LineTo(Pent[2].X, Pent[2].Y);

    LineTo(Pent[4].X, Pent[4].Y);

    LineTo(Pent[1].X, Pent[1].Y);

    LineTo(Pent[3].X, Pent[3].Y);

    LineTo(Pent[0].X, Pent[0].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

Download Code

 

 


Lauro      Commented   6 months ago Reply

Congratulations on the Code! This example can be used in DBGrid to make the Tree feature. | Customers A | -Sales $ 100.00

Add a Comment

9+5

Recent News

Delphi Delimited String to Fields
Delphi A Professional VCL DBGrid Part Four
Delphi A Professional VCL DBGrid Part Three
Delphi A Professional VCL DBGrid Part Two
Delphi A Professional VCL DBGrid Part One
Delphi VCL Buttons in DBGrid
Two Helper Apps for Delphi LibUSB
Delphi Libusb Library Introduction

Categories

Bootstrap 4
Delphi VCL
Delphi FMX
Ajax
Bootstrap 3
CSS
XE4>Delphi > XE4
Delphi < XE4
PHP

Archives

August 2019

Delphi Delimited String to Fields

June 2019

Delphi A Professional VCL DBGrid Part Four

May 2019

Delphi A Professional VCL DBGrid Part Three

April 2019

Delphi A Professional VCL DBGrid Part Two

March 2019

Delphi A Professional VCL DBGrid Part One

November 2018

Delphi VCL Buttons in DBGrid

October 2018

Two Helper Apps for Delphi LibUSB

September 2018

Delphi Libusb Library Introduction

August 2018

Delphi Object directly to a Json string in a REST Client
Delphi using Environment Variables in your App

July 2018

Delphi FMX Leaflet Plotter using OSM Maps

June 2018

C2PAS32 Convertor Application
C to Delphi Open Source Convertors Shootout
Delphi command-line programs with DOSCommand

May 2018

Delphi PDF Embedded viewer with PDF.js

March 2018

Delphi FMX - Changing TCharacter to TCharHelper
Make Your Delphi App POP using Javascript!

January 2018

Delphi FMX Dashboard using Chart.JS
Delphi FMX Form Docking

December 2017

PHP Slim REST Server & Delphi Auth Part 5

November 2017

Delphi FMX REST Client App Part 4

October 2017

Delphi VCL REST Pricing Client App Part 3

September 2017

Delphi REST VCL Client Basic Auth Part 2B

August 2017

Delphi REST Client Part 2A
PHP PDO REST Server Part 1

July 2017

PHP REST Server and Delphi Client Intro

June 2017

Delphi SQLite Encryptor-Decryptor Tool
Updating Applications Manifest using Delphi

May 2017

Create a Visual IP Address Geolocation with PHP

March 2017

PHP Downloader using Countdown timer
PHP File Downloader from a Inbox Selection

February 2017

Javascript Image-File Uploader with ThumbViewer

January 2017

Morris Charts and PHP-PDO

December 2016

CSS to create a functional Toggle Button