Introduction
It's a long time since TDBGrid
has been released and there is no major change in the behavior of this component till now. In this article, we will add some features that make TDBGrid
more user friendly and easy to use. Some of them are new and some of them can be found on the internet.
Background
Here are some features that may enhance the traditional DBGrid
and make it more user friendly:
- Gradient background according to cell type
- Integrated search capabilities for
string
fields - Sorting columns
- Hot tracking
- Automatically adjust the width of columns
- Row and column resizing
- Supporting mouse wheel
- Word wrapping cells
- Sound effects
- Integrated and configurable popup menu for applying commands on individual records
- Supporting bidirectional mode
- Loading and saving configurations
The library which is used for giving a new look to our grid is GDI+. There are some free translations of GDI+ for Delphi but the one that has been used in this component could be downloaded from www.progdigy.com however it has been already added to the project. Remember that this component is developed in Delphi 7 and its sorting capability is only available to descendents of TCustomADODataset
. Default filter expressions that it generates are compatible with TCustomADODataset
but there is an event for manipulating filter expression, just before applying the filter. Please note that in this component, it was supposed that the first column and first row are the fixed ones and the other ones are data content, so if you need another condition please change the DrawCell
as you wish. The final product looks something like this:
Appearance
For creating a gradient bitmap background, firstly we should create it in memory. Then we will StrechDraw
it in each related cell. For drawing a vertical gradient, it is enough to produce a bitmap with 1 pixel width and some arbitrary height which may extend from 1 to, for example, 50 pixels. This height would be referred to as Step and it has the same meaning as resolution of gradients. The function drawVerticalGradient
gets a bitmap variable and allocates memory for it and then draws a gradient bar regarding "start color", "center color" and "finish color" whose center position is adjustable.
procedure TEnhDBGrid.drawVerticalGradient(var grBmp: TBitmap; gHeight: integer;
color1, color2, color3: TColor; centerPosition: integer);
var
graphics: TGPGraphics;
linGrBrush: TGPLinearGradientBrush;
r1, g1, b1, r2, g2, b2, r3, g3, b3: byte;
colors: array [0 .. 2] of TGPColor;
blendPoints: array [0 .. 2] of single;
begin
try
if Assigned(grBmp) then
grBmp.Free;
grBmp := TBitmap.create;
grBmp.Width := 1;
grBmp.Height := gHeight;
extractRGB(color1, r1, g1, b1);
extractRGB(color2, r2, g2, b2);
extractRGB(color3, r3, g3, b3);
graphics := TGPGraphics.create(grBmp.Canvas.Handle);
linGrBrush := TGPLinearGradientBrush.create(MakePoint(0, 0),
MakePoint(0, gHeight), MakeColor(255, 255, 255, 255),
MakeColor(255, 255, 255, 255));
colors[0] := MakeColor(r1, g1, b1);
blendPoints[0] := 0;
colors[1] := MakeColor(r2, g2, b2);
blendPoints[1] := centerPosition / 100;
colors[2] := MakeColor(r3, g3, b3);
blendPoints[2] := 1;
linGrBrush.SetInterpolationColors(@colors, @blendPoints, 3);
graphics.FillRectangle(linGrBrush, 0, 0, 1, gHeight);
linGrBrush.Free;
graphics.Free;
except
OutputDebugString('Error in creating gradient.');
end;
end;
We have these 5 kinds of gradients to StrechDraw
them whenever it was necessary:
grBmpTitle: TBitmap;
grBmpSelected: TBitmap;
grBmpActive: TBitmap;
grBmpAlt1: TBitmap;
grBmpAlt2: TBitmap;
grBmpTitle
is used for fixed cells backgrounds. The grBmpSelected
is used for drawing selected items backgrounds, grBmpActive
is used for the cell which is active, grBmpAlt1
and grBmpAlt1
are used for normal rows backgrounds alternatively.
The procedure that uses some of these bitmaps is the overridden DrawColumnCell
procedure:
row := DataSource.DataSet.recNo;
if (gdSelected in State) then
begin
Canvas.StretchDraw(Rect, grBmpActive);
tempFont.Color:=FActiveCellFontColor;
end
else if isMultiSelectedRow then
begin
Canvas.StretchDraw(Rect, grBmpSelected);
tempFont.Color:=FSelectedCellFontColor;
end
else if Odd(row) then
Canvas.StretchDraw(Rect, grBmpAlt1);
else
Canvas.StretchDraw(Rect, grBmpAlt2);
if Column.Field<>nil then
myDrawText(Column.Field.DisplayText, Canvas, Rect, Column.alignment, tempFont);
myDrawText
draws a string
transparently and if its width is more than drawing rectangle width, it breaks the line and writes the words as much as possible in the next lines.
For drawing title bars and fixed cells and indicators, we should override DrawCell
. The indicator shapes are in Data.res which is part of this project.
if ARow > 0 then
begin
if ACol = 0 then
begin
dec(ARow);
Canvas.StretchDraw(ARect, grBmpTitle);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDOUTER, BF_RECT);
if (gdFixed in AState) then
begin
if Assigned(DataLink) and DataLink.Active then
begin
MultiSelected := False;
if ARow >= 0 then
begin
prevousActive := DataLink.ActiveRecord;
try
Datalink.ActiveRecord := ARow;
MultiSelected := isMultiSelectedRow;
finally
Datalink.ActiveRecord := prevousActive;
end;
end;
if (ARow = DataLink.ActiveRecord) or MultiSelected then
begin
indicIndex := 0;
if DataLink.DataSet <> nil then
case DataLink.DataSet.State of
dsEdit: indicIndex := 1;
dsInsert: indicIndex := 2;
dsBrowse:
if MultiSelected then
if (ARow <> Datalink.ActiveRecord) then
indicIndex := 3
else
indicIndex := 4;
end;
myIndicators.BkColor := FixedColor;
myLeft := ARect.Right - myIndicators.Width - 1;
if Canvas.CanvasOrientation = coRightToLeft then Inc(myLeft);
myIndicators.Draw(Canvas, myLeft,
(ARect.Top + ARect.Bottom - myIndicators.Height) shr 1,
indicIndex, dsTransparent, itImage,True);
end;
end;
end;
inc(ARow);
end
else
inherited;
end
else
begin
Canvas.StretchDraw(ARect, grBmpTitle);
ar:=ARect;
DrawEdge(Canvas.Handle, AR, BDR_RAISEDOUTER, BF_RECT);
if ACol > 0 then
myDrawText(Columns[ACol - 1].Title.Caption,
Canvas, AR, Columns[ACol - 1].Title.Alignment , Columns[ACol - 1].Title.Font)
end;
myDrawText
uses DrawText
API because it has alignment and word wrapping capabilities.
procedure TEnhDBGrid.myDrawText(s:string; outputCanvas: Tcanvas; drawRect: TRect;
drawAlignment:TAlignment ; drawFont:TFont);
const
drawFlags : array [TAlignment] of Integer =
(DT_WORDBREAK or DT_LEFT or DT_NOPREFIX,
DT_WORDBREAK or DT_RIGHT or DT_NOPREFIX,
DT_WORDBREAK or DT_CENTER or DT_NOPREFIX );
var
r:trect;
bw, bh, cw, ch, difX:integer;
begin
if s='' then
exit;
if UseRightToLeftAlignment then
case drawAlignment of
taLeftJustify: drawAlignment := taRightJustify;
taRightJustify: drawAlignment := taLeftJustify;
end;
r:= drawRect;
cw:=ClientWidth;
ch:=ClientHeight;
bmpDrawText.Width:=( r.Right - r.Left);
bmpDrawText.Height:=r.Bottom- r.Top;
bw:=bmpDrawText.Width;
bh:=bmpDrawText.Height;
drawRect.Left:=0;
drawRect.Top:=0;
drawRect.Right:=bw;
drawRect.Bottom:=bh;
if ColorToRGB( drawFont.Color )=(ColorToRGB
( bmpDrawText.TransparentColor) and $ffffff) then
toggleTransparentColor;
bmpDrawText.Canvas.FillRect(drawRect);
InflateRect(drawRect, -2,-2);
bmpDrawText.Canvas.Font:= drawFont;
DrawText(bmpDrawText.Canvas.Handle,
pchar(s), length(s), drawRect,
drawFlags[drawAlignment]
);
if UseRightToLeftAlignment then
begin
if r.Right > ClientWidth then
begin
bmpClipped.Width:=cw-r.Left;
bmpClipped.Height:=bh;
bmpClipped.Canvas.CopyRect(bmpClipped.Canvas.ClipRect,
bmpDrawText.Canvas, Rect(bw, 0, bw-( cw - r.Left ), bh) );
outputCanvas.StretchDraw(rect(r.Left , r.Top, cw, r.Bottom), bmpClipped);
end
else
outputCanvas.StretchDraw(Rect(r.Right, r.Top, r.Left, r.Bottom), bmpDrawText);
end
else
outputCanvas.Draw(r.Left, r.top, bmpDrawText);
end;
When BiDiMode
is RightToLeft
, Canvas.Draw
will draw our bmpDrawText
reversed. To solve this problem, StretchDraw
should be called with a rectangle that its right and left border coordinates were substituted.
Search
If user wants to search in a string
field, it's as easy as right clicking in a string
field title bar and type part of the desired statement. It will update the Sort
attribute of the dataset
to show only the desired results. User can cancel filter by pressing the Escape key.
So we start with creating a TEditBox
and some controlling variables in the Create
procedure:
edtSearchCriteria := TEdit.create(Self);
edtSearchCriteria.Width := 0;
edtSearchCriteria.Height := 0;
edtSearchCriteria.Parent := Self;
edtSearchCriteria.Visible := false;
searchVisible := false;
lastEditboxWndProc := edtSearchCriteria.WindowProc;
edtSearchCriteria.WindowProc := edtSearchCriteriaWindowProc;
filtering := false;
The next step is detecting mouse right clicks on title bar and show the search edit box. So we override MouseDown
procedure:
if (Button = mbRight) and FAllowFilter then
begin
for i := 0 to Columns.Count - 1 do
begin
r := CellRect(i + 1, 0);
mp := CalcCursorPos;
if pointInRect(mp, r) then
begin
if (Columns[i].Field.DataType = ftString) or
(Columns[i].Field.DataType = ftWideString) then
begin
if not(filtering and (lastSearchColumn = Columns[i])) then
ClearFilter;
lastSearchColumn := Columns[i];
edtSearchCriteria.Visible := true;
searchVisible := true;
if searchFieldName <> Columns[i].FieldName then
searchFieldName := Columns[i].FieldName
else
edtSearchCriteria.Text := lastSearchStr;
edtSearchCriteria.Font := Columns[i].Title.Font;
edtSearchCriteria.Left := r.Left;
edtSearchCriteria.top := r.top;
edtSearchCriteria.Width := r.Right - r.Left;
edtSearchCriteria.Height := r.bottom - r.top;
filtering := true;
LeftCol:=myLeftCol;
windows.SetFocus(edtSearchCriteria.Handle);
break;
end;
end;
end;
end;
If you want to add non string
fields to the allowed filtering fields, you should change the above procedure to handle those fields.
For moving the edit box in case of grid scrolling, we should just set the edtSearchCriteria
coordinates in the DrawCell
procedure:
if lastSearchColumn <> nil then
if (ACol > 0) and (ARow = 0) then
begin
if searchVisible then
begin
edtSearchCriteria.Visible :=isVisibleColumn(lastSearchColumn);
if (Columns[ACol - 1].FieldName = searchFieldName) then
begin
ar := CellRect(ACol, 0);
if edtSearchCriteria.Visible then
begin
if UseRightToLeftAlignment then
edtSearchCriteria.Left := ClientWidth - ARect.Right
else
edtSearchCriteria.Left := ARect.Left;
edtSearchCriteria.Width := ARect.Right - ARect.Left;
end;
end;
end
end;
The string
which was entered into the edit box should be applied to the Dataset
as a Filter
. The place to do that is edtSearchCriteriaWindowProc
that handles messages delivered to the edtSearchCriteria
:
if lastSearchStr<>edtSearchCriteria.Text then
begin
if filtering then
begin
plc := leftCol;
lastSearchStr := edtSearchCriteria.Text;
psp:=edtSearchCriteria.SelStart;
if lastSearchStr <> '' then
begin
DataSource.DataSet.Filtered := false;
critStr := '[' + searchFieldName + '] LIKE ''%' + lastSearchStr + '%''';
if Assigned(FOnBeforeFilter) then
FOnBeforeFilter(Self, lastSearchColumn, lastSearchStr, critStr);
DataSource.DataSet.Filter := critStr;
try
DataSource.DataSet.Filtered := true;
except
ShowMessage('Couldn''t filter data.');
end;
end
else
begin
DataSource.DataSet.Filtered := false;
end;
leftCol := plc;
if not edtSearchCriteria.Focused then
begin
windows.SetFocus(edtSearchCriteria.Handle);
edtSearchCriteria.SelStart:=psp;
end;
end;
end;
It calls OnBeforeFilter
before applying the filter in case the user wants Filter string
to be manipulated. Additionally, it handles special characters such as Escape and Up and Down arrows to switch the focus into the grid.
if Message.Msg = WM_KEYDOWN then
begin
if Message.WParam = VK_ESCAPE then
begin
playSoundInMemory(FEscSoundEnabled, sndEsc, 'Escape');
if searchVisible then
begin
while (GetQueueStatus(QS_ALLINPUT)) > 0 do
PeekMessage(Msg, 0, 0, 0, PM_REMOVE);
edtSearchCriteria.Visible := false;
searchVisible := false;
edtSearchCriteria.invalidate;
end
else
ClearFilter;
end
else if (Message.WParam = VK_DOWN) then
begin
DataSource.DataSet.Next;
windows.SetFocus(Handle);
end
else if (Message.WParam = VK_UP) then
begin
DataSource.DataSet.Prior;
windows.SetFocus(Handle);
end;
end;
Sorting
Although it was mentioned in many web sites about how to sort data in a DBGrid
, we will discuss it here because TEnhDBGrid
has this capability and its functionality should be described.
Sorting is only available for DataSets
that are descendants of TCustomADOGrid
. This grid sorts every column which was clicked on the title and keeps track of the Ascending or Descending mode after that. Also, it shows an arrow to indicate the sort column and the type of sort. The procedure which was overridden for this purpose is TitleClick
:
Type
TSortType = (stNone, stAsc, stDesc);
procedure TEnhDBGrid.TitleClick(Column: TColumn);
var
p: pointer;
plc: integer;
begin
inherited;
if not(DataSource.DataSet is TCustomADODataSet) then
Exit;
plc := leftCol;
p := DataSource.DataSet.GetBookmark;
if lastSortColumn <> Column then
begin
lastSortColumn := Column;
lastSortType := stAsc;
try
TCustomADODataset(DataSource.DataSet).Sort := '[' + Column.FieldName + '] ASC';
except
ShowMessage('Didn''t sorted !');
lastSortColumn := nil;
lastSortType := stNone;
end;
end
else
begin
if lastSortType = stAsc then
begin
lastSortType := stDesc;
TCustomADODataset(DataSource.DataSet).Sort := '[' + Column.FieldName + '] DESC';
end
else
begin
lastSortType := stAsc;
TCustomADODataset(DataSource.DataSet).Sort := '[' + Column.FieldName + '] ASC';
end;
end;
if DataSource.DataSet.BookmarkValid(p) then
begin
DataSource.DataSet.GotoBookmark(p);
DataSource.DataSet.FreeBookmark(p);
end;
leftCol := plc;
end;
And for showing an arrow that shows the sorting column and sort type, the DrawCell
is a proper position for doing that:
if (lastSortColumn <> nil) then
if (lastSortColumn.Index + 1 = ACol) and (ARow = 0) then
drawTriangleInRect(ARect, lastSortType, Columns[ACol - 1].Title.Alignment);
drawTriangleInRect
as its name depicts draws a triangle according to the sorting type in the title of the sorted column. If you have a more artistic idea about showing the sort type in the title bar, change drawTriangleInRect
procedure as you want.
Hot Tracking
For having hot tracking behavior, we should determine the row number beneath the mouse and move database RecNo
to that place. In the original DBgrid
, there is no relation between the record numbers and the bounding row rectangle, so we had to make a list of drew records and their position and update them every time visible records are changed. So we have an array of rows information:
type
TRowInfo = record
recNo,
top,
bottom: integer;
end;
ri: array of TRowInfo;
lastRowCount: integer;
Every time lastRowCount
is different from RowCount
, we reallocate the array and start to update its content. Update takes place at DrawColumnCell
:
if RowCount <> lastRowCount then
begin
SetLength(ri, RowCount);
lastRowCount := RowCount;
for i := 0 to RowCount - 1 do
begin
ri[i].recNo := -1;
ri[i].top := 0;
ri[i].bottom := 0;
end;
end;
for i := 0 to RowCount - 1 do
if (ri[i].recNo = -1) OR
((ri[i].top = Rect.top) AND (ri[i].bottom = Rect.bottom)) then
begin
ri[i].recNo := row;
ri[i].top := Rect.top;
ri[i].bottom := Rect.bottom;
break;
end;
And now we have a relation between record numbers and visual position of the rows, so we could do a hot track every time mouse moves by overriding MouseMove
:
if FHotTrack then
if DataSource.DataSet.State = dsBrowse then
begin
if (lastMouseX = X) and (lastMouseY = Y) then
Exit
else
begin
lastMouseX := X;
lastMouseY := Y;
end;
for i := 0 to high(ri) do
if (Y >= ri[i].top) and (Y <= ri[i].bottom) then
begin
if ri[i].recNo < 1 then
continue;
if ri[i].recNo > DataSource.DataSet.recNo then
begin
while ri[i].recNo > DataSource.DataSet.recNo do
DataSource.DataSet.Next;
break;
end
else if ri[i].recNo < DataSource.DataSet.recNo then
begin
while ri[i].recNo < DataSource.DataSet.recNo do
DataSource.DataSet.Prior;
break;
end
end;
if not(dgRowSelect in Options) then
begin
gc := MouseCoord(X, Y);
if (gc.X > 0) and (gc.Y > 0) then
begin
gr.Left := gc.X;
gr.Right := gc.X;
gr.top := gc.Y;
gr.bottom := gc.Y;
Selection := gr;
end;
end;
InvalidateCol(0);
end;
Automatically Adjust the Width of Columns
Just like sorting, it was mentioned in many web sites and you could skip this part if you are not interested in it.
Our auto width-ing occurs every time user double clicks on a right side boundary of a column not only on title bar but of course on entire columns right border it is possible.
For implementing it, we have to override the DblClick
method:
plc := leftCol;
p := CalcCursorPos;
for i := 0 to Columns.Count - 1 do
begin
r := CellRect(i + 1, 0);
begin
if (UseRightToLeftAlignment and (abs(p.X - r.Left) < 5)) or
((not UseRightToLeftAlignment) and (abs(p.X - r.Right) < 5)) then
begin
autoFitColumn(i, true);
leftCol := plc;
dblClicked := true;
break;
end
end;
end;
Also, user can auto width all columns with double clicking on the first cell in row zero and column zero:
if pointInRect(p, CellRect(0, 0)) then
begin
autoFitAll;
Exit;
end;
As you see in the above code, the left column index was preserved and does not change after auto width-ing columns.
Row and Column Resizing
For this purpose, we should override CalcSizingState
procedure and allow parent Grid
object to resize rows and columns.
Deciding on granting column resizing:
for i := myLeftCol - 1 to Columns.Count - 1 do
if abs(getColumnRightEdgePos(Columns[i]) - X) < 5 then
begin
State := gsColSizing;
Index := i + 1;
if IsRightToLeft then
SizingPos := ClientWidth - X
else
SizingPos := X;
SizingOfs := 0;
end;
Deciding on granting row resizing:
if FAllowRowResize then
if State <> gsColSizing then
for i := 0 to high(ri) do
begin
if (abs(ri[i].bottom - Y) < 3) and (ri[i].bottom>0) then
begin
State := gsRowSizing;
Index := i + 1;
SizingPos := Y;
SizingOfs := 0;
lastResizedRow := Index;
Break;
end;
end;
For preventing resizing in out of the cells area:
if MouseCoord(x,y).X=-1 then
exit;
Supporting Mouse Wheel
When mouse wheel rolls, windows sends WM_MOUSEWHEEL
to the control and we should move the dataset
current record to next or previous position and for further user comfort, scroll horizontally if users keeps Ctrl key pressed while turning the mouse wheel. The procedure we are going to override is WndProc(var Message: TMessage)
:
if Message.Msg = WM_MOUSEWHEEL then
begin
ctrlPressed := ((Message.WParam and $FFFF) and (MK_CONTROL)) > 0;
if Message.WParam < 0 then
begin
if not checkDBPrerequisites then
Exit;
if ctrlPressed then
begin
incLeftCol;
end
else
begin
if not DataSource.DataSet.Eof then
begin
DataSource.DataSet.Next;
InvalidateCol(0);
end;
end;
end
else
begin
if not checkDBPrerequisites then
Exit;
if ctrlPressed then
decLeftCol
else
begin
if not DataSource.DataSet.Bof then
begin
DataSource.DataSet.Prior;
InvalidateCol(0);
end;
end;
end;
end;
Control should have been focused to receive WM_MOUSEWHEEL
so we have to provide some means to receive focus automatically if the user moves the pointer on this grid. The place to implement this functionality is MouseMove
:
if (not searchVisible) and FAutoFocus and (not Focused) then
windows.SetFocus(Handle);
Word Wrapping Cells
Word wrapping was implemented in myDrawText
by using the DT_WORDBREAK
when calling DrawText
. In fact, when using DrawText
function in RightToLeft
mode to draw the text directly on controls canvas, there are some problems which reside on reversed coordinates. To cope with this problem, we should draw the text on a TBitmaps
canvas and then draw it on the controls canvas. In this way, we will have a double buffered output too.
Sound Effects
User will hear a sound on "HotTracking", "Double clicking", "Sorting" and "Pressing escape key". Obviously, we should play a sound asynchronously in KeyDown
, DblClick
, TitleClick
and Scroll
procedures. The procedure that we are going to call is playSoundInMemory
:
procedure TEnhDBGrid.playSoundInMemory(cnd: boolean; m: TResourceStream;
name: string);
begin
try
if cnd then
sndPlaySound(m.Memory, SND_MEMORY or SND_ASYNC);
except
OutputDebugString(PChar('Error in playing ' + name + ' sound !'));
end;
end;
Sounds are embedded in Data.res and they are loaded in Create
procedure:
try
sndHover := TResourceStream.create(HInstance, 'hover', RT_RCDATA);
sndDblClick := TResourceStream.create(HInstance, 'dblclick', RT_RCDATA);
sndSort := TResourceStream.create(HInstance, 'click', RT_RCDATA);
sndEsc := TResourceStream.create(HInstance, 'esc', RT_RCDATA);
except
OutputDebugString('Error in loading sounds from resources');
end;
Integrated and Configurable Popup Menu for Applying Commands on Individual Records
The common work that a programmer has to do after placing a TDabaseGrid
is putting some means to do some actions on individual records of a dataset
. For making this job easier, there is a customizable popup menu and a callback mechanism to speed up implementing common operations on records.
The member variable that holds command titles and their values is FPopupMenuCommands
which is a TStrings
object and holds a list of CommandTitle, CommandID
pairs:
which would produce a popup menu like this:
when user clicks on an item of the popup menu, control triggers this event:
TOnPopupCommandEvent = procedure(Sender: TObject; commandID, rowNo: integer ) of object;
However TEnhDBGrid.DataSource.Dataset
shows the current active row, the current row number of the dataset
is passed to the event handler.
Loading and Saving Configurations
There are two procedures saveConfig(fn: String)
and loadConfig(fn: String)
in which we are saving some visual properties of this component. They could be modified to save and load other properties that you may think were missed.
Epilogue
I hope this component give your database applications a new and attractive look. Any bug report or suggestions would be welcome and appreciated. A sample project has been included to test this component.
History
- 20th May, 2011: Initial post