Click here to Skip to main content
65,938 articles
CodeProject is changing. Read more.
Articles / multimedia / GDI+

Improving Delphi TDBGrid

4.92/5 (15 votes)
20 May 2011CPOL8 min read 84.7K   3.1K  
Improve Delphi's TDBGrid by adding some new features to it

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:

Image 1

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.

Delphi
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:

Delphi
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:

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

Delphi
if ARow > 0 then  //draw contents
begin

  if ACol = 0 then  // draw indicators
  begin
    dec(ARow);
    Canvas.StretchDraw(ARect, grBmpTitle);
    // shape borders like a button
    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;  // multiselected and current row
            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 // draw grid content
    inherited;
end
else // draw titles
begin
  // draw title gradient bitmap
  Canvas.StretchDraw(ARect, grBmpTitle);

  ar:=ARect;
  // shape borders like a button
  DrawEdge(Canvas.Handle, AR, BDR_RAISEDOUTER, BF_RECT);

  // write title
  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.

Delphi
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;

    //set dimensions for output
    bmpDrawText.Width:=( r.Right - r.Left);
    bmpDrawText.Height:=r.Bottom- r.Top;
    bw:=bmpDrawText.Width;
    bh:=bmpDrawText.Height;

    //set drawing area in output bmp
    drawRect.Left:=0;
    drawRect.Top:=0;
    drawRect.Right:=bw;
    drawRect.Bottom:=bh;

    // if the drawing font color is same as transparent color
    //change transparent color
    if ColorToRGB( drawFont.Color )=(ColorToRGB
	( bmpDrawText.TransparentColor) and $ffffff) then
       toggleTransparentColor;

    //to make entire surface of canvas transparent
    bmpDrawText.Canvas.FillRect(drawRect);

    //shrink the rectangle
    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:

Delphi
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:

Delphi
// detect right clicking on a column title
if (Button = mbRight) and FAllowFilter then
begin
  for i := 0 to Columns.Count - 1 do
  begin
    r := CellRect(i + 1, 0);

    mp := CalcCursorPos;

    // if mouse in column title
    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:

Delphi
// make search editbox visible if it is necessary
if lastSearchColumn <> nil then
  if (ACol > 0) and (ARow = 0) then
  begin

    if searchVisible then
    begin
      edtSearchCriteria.Visible :=isVisibleColumn(lastSearchColumn);

      // reposition edit box
      if (Columns[ACol - 1].FieldName = searchFieldName) then
      begin
        // adjust search edit box position
        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:

Delphi
// there was a change in search criteria
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 + '%''';
      //critStr := '[' + searchFieldName + '] = ''' + 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.

Delphi
if Message.Msg = WM_KEYDOWN then
begin

  if Message.WParam = VK_ESCAPE then
  begin

    playSoundInMemory(FEscSoundEnabled, sndEsc, 'Escape');

    // first escape disappears the search box
    // second escape disables searches and  sorting
    if searchVisible then
    begin
      // there are some remaining messages that cause windows to play an
      // exclamation sound because editbox is not visible after this.
      // by removing remaining messages we prevent that unwanted sounds
      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
    // if user presses down arrow it means that he/she needs to go forward
    // in records
    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:

Delphi
Type
  TSortType = (stNone, stAsc, stDesc);

procedure TEnhDBGrid.TitleClick(Column: TColumn);
var
  p: pointer;
  plc: integer; // previous left column
begin
  inherited;

  if not(DataSource.DataSet is TCustomADODataSet) then
    Exit;

  plc := leftCol;
  p := DataSource.DataSet.GetBookmark;

  if lastSortColumn <> Column then
  begin
    // new column to sort
    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
    // reverse sort order
    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:

Delphi
// draw an arrow in sorted columns
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:

Delphi
type 
  TRowInfo = record
    recNo,
    top,
    bottom: integer;
  end;

{**************************}
{     class members        }
{**************************}
  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:

Delphi
if RowCount <> lastRowCount then
begin
  SetLength(ri, RowCount);
  lastRowCount := RowCount;
  // reset all records
  for i := 0 to RowCount - 1 do
  begin
    ri[i].recNo := -1;
    ri[i].top := 0;
    ri[i].bottom := 0;
  end;
end;

// find first empty rowInfo element or same row position
// and store this row info
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:

Delphi
if FHotTrack then
if DataSource.DataSet.State = dsBrowse then   //do not bother user edit
                      //or insert operations
begin
  // prevent repetitive mouse move events
  if (lastMouseX = X) and (lastMouseY = Y) then
    Exit
  else
  begin
    lastMouseX := X;
    lastMouseY := Y;
  end;

  // move to the suitable row
  // ri was filled in CellDraw
  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;

      // movebackward or forward to reach to the pointer
      // you could set RecNo exactly to the desired no to
      // see the disastrous results

      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 row select is not enabled
  if not(dgRowSelect in Options) then
  begin
    // move to cell under mouse pointer
    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;
  // update indicator column
  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:

Delphi
plc := leftCol;
p := CalcCursorPos;

// find the column that should be auto widthed
for i := 0 to Columns.Count - 1 do
begin
  r := CellRect(i + 1, 0);
  // if you want just title DblClicks uncomment this line
  // if (p.Y>=r.Top) and (p.Y<=r.Bottom) then
  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;
      // don't allow an extra click event
      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:

Delphi
// if cell is the corner one then autofit all columns
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:

Delphi
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:

Delphi
if FAllowRowResize then
  if State <> gsColSizing then
      for i := 0 to high(ri) do
      begin //search rows bottom line positions
        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:

Delphi
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):

Delphi
// the control should have focus to receive this message
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
      // horizontal scroll
      incLeftCol;
    end
    else
    begin
      // vertical scroll
      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
      // horizontal scroll
      decLeftCol
    else
    begin
      // vertical scroll
      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:

Delphi
// if need auto focus then take focus to this control
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:

Delphi
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:

Delphi
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:

Image 2

which would produce a popup menu like this:

Image 3

when user clicks on an item of the popup menu, control triggers this event:

Delphi
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

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)