Feature request: TRzDBGrid with header button

[David Marcus]

I wish that the TRzDBGrid would let me put a button in some, but not all, column headers. Each button would either be blank or display an arrow to indicate that the grid is sorted on that column. I also wish the header would underline a character that follows an ampersand. Any chance that my wish will come true?

[Streatley]

Yes that would be a neat solution. In the meantime you could do what we do in our own applications - that is, when the user clicks on a column heading to sort it, we change the column title and add a '(+)' in front to indicate that it's sorted acending. If they click again, to sort decending, we change the prefix to '(-)'.

Regards
Anton
Streatley Software.

[David Marcus]

What, if anything, do you do to indicate which columns can be sorted?

I've been using TopGrid, which has the features I requested, but it stopped being supported long ago. So, I need to stop using it.

[Streatley]

We allow sorting of all columns and also support multi-select so the user can sort by, for example, column 'A' within column 'B'. This flexibility is important because the grids columns are user definable (heading and width) from all fields in the table being shown. As well as the 'click' on the column we also have a popup menu (right click) that lists key sort fields and also enables the user to clear the sorting.

If you want to restrict sorting to certain columns why don't you show the possible fields in 'bold' or 'italic'?

Regards
Anton

[David Marcus]

If you want to restrict sorting to certain columns why don't you show the possible fields in 'bold' or 'italic'?

Because I'd rather not make up user interface conventions that users won't understand without reading the manual. I expect my users to read the manual to understand how to use my apps, but I think I owe it to them to make the user interface logical and clear. Buttons and arrows have reasonably clear meanings. Bold and italic headers do not.

I sometimes ask people what the use of bold means in a math book. I've yet to meet a non-mathematician who knows the right answer. On the other hand, I don't recall any math book ever explicitly explaining what bold means. Sometimes your users will understand your conventions and sometimes they won't.

[David Marcus]

I took a crack at this:

Code: Select all

//------------------------------------------------------------------------------

unit TitleButtonGrid;

// The BetterDBGrid has optional buttons in the column titles. To get a button
// in a column, put an ampersand in the column Title.Caption property. This also
// underlines the letter after the ampersand in the title. Clicking the button
// or pressing the accelerator key will sort the data set on the column, if you
// add appropriate code to the Sort_Data_Set method. Only one column can be
// sorted on at a time.

// If the grid is disabled, the row indicator is hidden. You can save the sort
// column, column widths, and column order to a TRzRegIniFile using the SaveGrid
// procedure and Restore method. If the dgRowSelect option is selected, then the
// cursor keys are adjusted to be more natural. Ctrl+Del no longer is passed to
// the grid; you can use the OnKeyDown event to handle it yourself.

interface//---------------------------------------------------------------------

uses
   // Delphi units.
   Windows, Classes, Controls, DBGrids, Graphics, Grids,

   // Raize units.
   RzCommon, RzDBGrid, RzForms;

//------------------------------------------------------------------------------

// Types for list indexes.

type
   ListIndex    =  0..MaxInt;
   ExtListIndex = -1..MaxInt;

//------------------------------------------------------------------------------

// A better version of the Raize data-aware grid.

type
   TBetterDBGrid = class( TRzDBGrid )
      strict private
         SortField:                 string;
         Clicked_Column_Field_Name: string;
         Clicked_Button_Rect:       TRect;
         Clicked_Button_Down:       boolean;

         procedure Hide_Indicator_If_Not_Enabled( {input}  ACol:   longint;
                                                  {update} ARect:  TRect;
                                                  {input}  AState: TGridDrawState );

         procedure Draw_Outer_Recessed_Border( const Rect:        TRect;
                                               const ButtonColor: TColor );

         procedure Draw_Solid_Border( const Rect:        TRect;
                                      const ButtonColor: TColor );

         procedure DrawButton( const ButtonRect:      TRect;
                               const ButtonColor:     TColor;
                               const Show_Down_Arrow: boolean );

         procedure Draw_Title_Caption( const   BrushColor: TColor;
                                       const   TitleRect:  TRect;
                                       {input} Column:     TColumn );

         procedure Sort_Data_Set( const FieldName: string );
         procedure Invalidate_Clicked_Button_Rectangle;

         procedure ScrollGrid( const Msg:   UINT;
                               const Param: WPARAM;
                               out   Key:   word );

         function AcquireFocus: boolean;

         procedure Depress_Button_If_Point_In_Title_Button( const   ThePoint: TPoint;
                                                            {input} Column:   TColumn );

         function Accelerator_Column_Index( const Key: word ): ExtListIndex;

      strict protected
         procedure DrawCell( {input}  ACol:   longint;
                             {input}  ARow:   longint;
                             {update} ARect:  TRect;
                             {input}  AState: TGridDrawState ); override;

         procedure KeyDown( var     Key:   word;
                            {input} Shift: TShiftState ); override;

         function CanGridAcceptKey( {input} Key:   word;
                                    {input} Shift: TShiftState ): boolean; override;

         procedure MouseDown( {input} Button: TMouseButton;
                              {input} Shift:  TShiftState;
                              {input} X:      integer;
                              {input} Y:      integer); override;

         procedure MouseMove( {input} Shift: TShiftState;
                              {input} X:     integer;
                              {input} Y:     integer ); override;

         procedure MouseUp( {input} Button: TMouseButton;
                            {input} Shift:  TShiftState;
                            {input} X:      integer;
                            {input} Y:      integer ); override;

         procedure CMDialogChar( var Message: TCMDialogChar ); message CM_DIALOGCHAR;

      public
         procedure Save( const    Section: string;
                         {update} IniFile: TRzRegIniFile );

         procedure Restore( const    Section:            string;
                            const    Default_Sort_Field: string;
                            {update} IniFile:            TRzRegIniFile );
   end;

//------------------------------------------------------------------------------

// Interfaced procedure.

procedure SaveGrid( const    Section:   string;
                    {input}  Grid:      TBetterDBGrid;
                    {update} FormState: TRzFormState );

implementation//----------------------------------------------------------------

uses
   // Delphi units.
   Forms, Math, Messages, Menus, SysUtils,

   // Raize units.
   RzGrafx;

//------------------------------------------------------------------------------

// Item names in the ini file that the grid state is saved in and restored from.

const
   Sort_Field_Item       = 'SortField';
   Column_ID_Item_Prefix = 'ColumnID';
   Width_Item_Prefix     = 'Width';

//------------------------------------------------------------------------------

// The row number of the title row.

const
   TitleRow = 0;

//------------------------------------------------------------------------------

// A number of pixels.

type
   PixelNumber = 0..MaxInt;

//------------------------------------------------------------------------------

// Key code.

const
   VK_None = 0;

//------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.DrawCell.
//------------------------------------------------------------------------------

procedure TBetterDBGrid.Hide_Indicator_If_Not_Enabled( {input}  ACol:   longint;
                                                       {update} ARect:  TRect;
                                                       {input}  AState: TGridDrawState );

// If the indicator column was just drawn, but the grid is not enabled, then
// fill the column to hide the indicator.

begin

   if not Enabled and not ( csLoading in ComponentState ) and ( gdFixed in AState )
   and ( ACol < IndicatorOffset ) and assigned( DataLink ) and DataLink.Active then begin

      if [ dgRowLines, dgColLines ] * Options = [ dgRowLines, dgColLines ] then
         InflateRect( ARect, -1, -1 );

      Canvas.Brush.Color := FixedColor;
      Canvas.FillRect( ARect );
   end;

end; // TBetterDBGrid.Hide_Indicator_If_Not_Enabled.

//------------------------------------------------------------------------------
// Start of procedures used by Calculate_Button_Rectangle.
//------------------------------------------------------------------------------

function RectHeight( const R: TRect ): integer;

// Return the height of the rectangle.

begin

   result := R.Bottom - R.Top;

end; // RectHeight.

//------------------------------------------------------------------------------

procedure Calculate_Button_Rectangle( const TitleRect:  TRect;
                                      out   ButtonRect: TRect );

// Calculate the rectangle for the button in the specified title rectangle.

const
   Default_Button_Size = 14;
   MinButtonSize       = 11;

var
   ButtonSize: PixelNumber;

begin

   ButtonSize := min( Default_Button_Size, max( 0, RectHeight( TitleRect ) ) );

   if ButtonSize < MinButtonSize then
      ButtonSize := 0;

   ButtonRect := Bounds( TitleRect.Right - ButtonSize,
                         TitleRect.Top + ( RectHeight( TitleRect ) - ButtonSize + 1 ) div 2,
                         ButtonSize, ButtonSize );

end; // Calculate_Button_Rectangle.

//------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.DrawButton.
//------------------------------------------------------------------------------

procedure TBetterDBGrid.Draw_Outer_Recessed_Border( const Rect:        TRect;
                                                    const ButtonColor: TColor );

// Draw the button's outer recessed border in the specified rectangle where the
// button has the specified color.

var
   DarkColor:  TColor;
   LightColor: TColor;

begin

   if Enabled then begin
      DarkColor  := DarkerColor(  ButtonColor, 20 );
      LightColor := LighterColor( ButtonColor, 20 );

   end else begin
      DarkColor  := ButtonColor;
      LightColor := ButtonColor;
   end;

   Canvas.Pen.Color := DarkColor;
   Canvas.MoveTo( Rect.Left,      Rect.Top    + 2 );
   Canvas.LineTo( Rect.Left,      Rect.Bottom - 2 );
   Canvas.MoveTo( Rect.Left  + 2, Rect.Top );
   Canvas.LineTo( Rect.Right - 2, Rect.Top );
   Canvas.Pen.Color := LightColor;
   Canvas.MoveTo( Rect.Right - 1, Rect.Top    + 2 );
   Canvas.LineTo( Rect.Right - 1, Rect.Bottom - 2 );
   Canvas.MoveTo( Rect.Left  + 2, Rect.Bottom - 1 );
   Canvas.LineTo( Rect.Right - 2, Rect.Bottom - 1 );
   Canvas.Pixels[ Rect.Left  + 1, Rect.Top    + 1 ] := DarkColor;
   Canvas.Pixels[ Rect.Right - 2, Rect.Top    + 1 ] := DarkColor;
   Canvas.Pixels[ Rect.Right - 2, Rect.Bottom - 2 ] := LightColor;
   Canvas.Pixels[ Rect.Left  + 1, Rect.Bottom - 2 ] := DarkColor;

end; // TBetterDBGrid.Draw_Outer_Recessed_Border.

//------------------------------------------------------------------------------

procedure TBetterDBGrid.Draw_Solid_Border( const Rect:        TRect;
                                           const ButtonColor: TColor );

// Draw the button's solid border in the sepcified rectangle where the button
// has the specified color.

var
   BorderColor: TColor;

begin

   if Enabled then
      BorderColor := FrameColor

   else if ButtonColor = clBtnFace then
      BorderColor := LighterColor( clBtnShadow, 30 )

   else
      BorderColor := DarkerColor( ButtonColor, 80 );

  Canvas.Pen.Color := BorderColor;
  Canvas.MoveTo( Rect.Left,      Rect.Top    + 1 );
  Canvas.LineTo( Rect.Left,      Rect.Bottom - 1 );
  Canvas.MoveTo( Rect.Left  + 1, Rect.Top );
  Canvas.LineTo( Rect.Right - 1, Rect.Top );
  Canvas.MoveTo( Rect.Right - 1, Rect.Top + 1 );
  Canvas.LineTo( Rect.Right - 1, Rect.Bottom - 1 );
  Canvas.MoveTo( Rect.Left  + 1, Rect.Bottom - 1 );
  Canvas.LineTo( Rect.Right - 1, Rect.Bottom - 1 );

end; // TBetterDBGrid.Draw_Solid_Border.

//------------------------------------------------------------------------------

procedure Draw_Button_Face( const    FaceRect:    TRect;
                            const    ButtonColor: TColor;
                            {update} Canvas:      TCanvas );

// Draw the face of the button on the specified canvas in the specified
// rectangle where the button has the specified color.

var
   Rect: TRect;

begin

   Rect := FaceRect;
   Canvas.Pen.Color := DarkerColor( ButtonColor, 20 );
   Canvas.MoveTo( Rect.Left,  Rect.Bottom - 2 );
   Canvas.LineTo( Rect.Right, Rect.Bottom - 2 );
   Canvas.Pen.Color := DarkerColor( ButtonColor, 30 );
   Canvas.MoveTo( Rect.Left,  Rect.Bottom - 1 );
   Canvas.LineTo( Rect.Right, Rect.Bottom - 1 );
   dec( Rect.Bottom, 2 );

   if FullColorSupported then
      PaintGradient( Canvas, Rect, gdHorizontalEnd, LighterColor( ButtonColor, 30 ),
                     DarkerColor( ButtonColor, 10 ) )
   else begin
      Canvas.Brush.Color := ButtonColor;
      Canvas.FillRect( Rect );
   end;

end; // Draw_Button_Face.

//------------------------------------------------------------------------------

procedure TBetterDBGrid.DrawButton( const ButtonRect:      TRect;
                                    const ButtonColor:     TColor;
                                    const Show_Down_Arrow: boolean );

// Draw a button in the specified rectangle using the specified color and
// optionally showing a down arrow.

var
   Rect: TRect;

begin

   Rect := ButtonRect;
   self.Draw_Outer_Recessed_Border( Rect, ButtonColor );
   InflateRect(                     Rect, -1, -1 );
   self.Draw_Solid_Border(          Rect, ButtonColor );
   InflateRect(                     Rect, -1, -1 );

   if Enabled then begin
      if ( Clicked_Column_Field_Name <> '' ) and ( Clicked_Button_Rect.Left = ButtonRect.Left )
      and Clicked_Button_Down then begin

         Canvas.Brush.Color := DarkerColor( ButtonColor, 20 );
         Canvas.FillRect( Rect );

      end else
         Draw_Button_Face( Rect, ButtonColor, Canvas );

   end else begin
      Canvas.Brush.Color := ButtonColor;
      Canvas.FillRect( Rect );
   end;

   if Show_Down_Arrow then
      DrawSpinArrow( Canvas, Rect, uiWindows95, dirDown, false, Enabled );

end; // TBetterDBGrid.DrawButton.

//------------------------------------------------------------------------------

function RectWidth( const R: TRect ): integer;

// Return the width of the rectangle.

begin

   result := R.Right - R.Left;

end; // RectWidth.

//------------------------------------------------------------------------------

procedure TBetterDBGrid.Draw_Title_Caption( const   BrushColor: TColor;
                                            const   TitleRect:  TRect;
                                            {input} Column:     TColumn );

// Draw the title caption for the specified column in the specified rectangle.

const
   Padding_For_Right_Justified                    = 2;
   AlignmentFlag: array [ TAlignment ] of integer = ( DT_Left, DT_Right, DT_Center );

var
   Rect: TRect;

begin

   Rect := TitleRect;

   if [ dgRowLines, dgColLines ] * Options = [ dgRowLines, dgColLines ] then
      InflateRect( Rect, -2, -1 )
   else
      InflateRect( Rect, -1, 0 );

   if Column.Title.Alignment = taRightJustify then
      dec( Rect.Right, Padding_For_Right_Justified );

   Canvas.Brush.Color := BrushColor;

   DrawString( Canvas, Column.Title.Caption, Rect,
               DT_SingleLine or DT_VCenter or AlignmentFlag[ Column.Title.Alignment ] );

end; // TBetterDBGrid.Draw_Title_Caption.

//------------------------------------------------------------------------------

procedure TBetterDBGrid.DrawCell( {input}  ACol:   longint;
                                  {input}  ARow:   longint;
                                  {update} ARect:  TRect;
                                  {input}  AState: TGridDrawState );

// Draw the specified cell. If the cell is a title cell and the column isn't
// expandable, then do a better job. If the grid is not enabled, then don't draw
// the row indicator. Otherwise, just call the inherited method.

var
   TitleRect:    TRect;
   MasterColumn: TColumn;
   BrushColor:   TColor;
   ButtonRect:   TRect;

begin

   if ( csLoading in ComponentState ) or ( ( gdFixed in AState ) and ( ACol < IndicatorOffset ) )
   or not Columns[ self.RawToDataColumn( ACol ) ].Showing or not ( dgTitles in Options )
   or ( ARow > TitleRow ) or self.IsRightToLeft then begin

      inherited;
      self.Hide_Indicator_If_Not_Enabled( ACol, ARect, AState );

   end else begin
      TitleRect := self.CalcTitleRect( Columns[ self.RawToDataColumn( ACol ) ], TitleRow,
                                       MasterColumn );

      if not assigned( MasterColumn ) or MasterColumn.Expandable then
         inherited

      else begin
         Canvas.Font := MasterColumn.Title.Font;

         if Enabled then
            BrushColor := MasterColumn.Title.Color

         else begin
            BrushColor        := DisabledColor;
            Canvas.Font.Color := clGrayText;
         end;

         Canvas.Brush.Color := BrushColor;
         Canvas.FillRect( TitleRect );

         if GetHotKey( MasterColumn.Title.Caption ) <> '' then begin
            Calculate_Button_Rectangle( TitleRect, ButtonRect );

            if not IsRectEmpty( ButtonRect ) then begin
               self.DrawButton( ButtonRect, BrushColor, SortField = MasterColumn.FieldName );
               dec( TitleRect.Right, RectWidth( ButtonRect ) );
            end;
         end;

         self.Draw_Title_Caption( BrushColor, TitleRect, MasterColumn );
      end;
   end;

end; // TBetterDBGrid.DrawCell.

//------------------------------------------------------------------------------
// Start of procedures used by SaveGrid.
//------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.Save.
//------------------------------------------------------------------------------

procedure Write_Ini_File_String( const    Section: string;
                                 const    Key:     string;
                                 const    Value:   string;
                                 {update} IniFile: TRzRegIniFile );

// Write the key and value to the specified section of the ini file, but if the
// value is blank, delete the key.

begin

   if TrimRight( Value ) = '' then
      IniFile.DeleteKey( Section, Key )
   else
      IniFile.WriteString( Section, Key, Value );

end; // Write_Ini_File_String.

//------------------------------------------------------------------------------

function Column_ID_Item_Name( const ColumnIndex: ListIndex ): string;

// Return the name of the column ID item for the specified column index.

begin

   result := Column_ID_Item_Prefix + IntToStr( ColumnIndex );

end; // Column_ID_Item_Name.

//------------------------------------------------------------------------------

function Column_Width_Item_Name( const ColumnIndex: ListIndex ): string;

// Return the name of the width item for the specified column index.

begin

   result := Width_Item_Prefix + IntToStr( ColumnIndex );

end; // Column_Width_Item_Name.

//------------------------------------------------------------------------------

procedure TBetterDBGrid.Save( const    Section: string;
                              {update} IniFile: TRzRegIniFile );

// Save the state of the grid to the ini file. Call SaveGrid in the form's
// OnDestroy event rather than this method in case the event is called before
// the form is fully constructed.

var
   J: ExtListIndex;

begin

   Write_Ini_File_String( Section, Sort_Field_Item, SortField, IniFile );

   for J := 0 to Columns.Count - 1 do begin
      IniFile.WriteInteger( Section, Column_ID_Item_Name(    J ), Columns[ J ].ID );
      IniFile.WriteInteger( Section, Column_Width_Item_Name( J ), Columns[ J ].Width );
   end;

end; // TBetterDBGrid.Save.

//------------------------------------------------------------------------------

procedure SaveGrid( const    Section:   string;
                    {input}  Grid:      TBetterDBGrid;
                    {update} FormState: TRzFormState );

// Check that the objects actually exist and save the grid. Call this in the
// form's OnDestroy event.

begin

   if assigned( Grid ) and assigned( FormState ) then
      Grid.Save( Section, FormState.RegIniFile );

end; // SaveGrid.

//------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.Restore.
//------------------------------------------------------------------------------

procedure TBetterDBGrid.Sort_Data_Set( const FieldName: string );

// Sort the data set on the specified field.

begin

   if assigned( DataSource ) and ( SortField <> FieldName ) then begin
      SortField := FieldName;
      self.InvalidateTitles;
      // Need to put code here to sort the data set by selecting the appropriate
      // index.
   end;

end; // TBetterDBGrid.Sort_Data_Set.

//------------------------------------------------------------------------------

procedure TBetterDBGrid.Restore( const    Section:            string;
                                 const    Default_Sort_Field: string;
                                 {update} IniFile:            TRzRegIniFile );

// Restore the state of the grid from the ini file. Call this in the form's
// OnCreate event.

var
   J:      ExtListIndex;
   Column: TColumn;

begin

   self.BeginLayout;

   try
      self.Sort_Data_Set( IniFile.ReadString( Section, Sort_Field_Item, Default_Sort_Field ) );

      for J := 0 to Columns.Count - 1 do begin
         Column := Columns.FindItemID( IniFile.ReadInteger( Section, Column_ID_Item_Name( J ),
                                                            Columns[ J ].ID ) ) as TColumn;
         Column.Index := J;
         Column.Width := IniFile.ReadInteger( Section, Column_Width_Item_Name( J ), Column.Width );
      end;

   finally
      self.EndLayout;
   end;

end; // TBetterDBGrid.Restore.

//------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.KeyDown.
//------------------------------------------------------------------------------

procedure TBetterDBGrid.Invalidate_Clicked_Button_Rectangle;

// Invalidate the clicked-button rectangle so it will be redrawn.

begin

   InvalidateRect( Handle, @Clicked_Button_Rect, false );

end; // TBetterDBGrid.Invalidate_Clicked_Button_Rectangle.

//------------------------------------------------------------------------------

procedure TBetterDBGrid.ScrollGrid( const Msg:   UINT;
                                    const Param: WPARAM;
                                    out   Key:   word );

// Scroll by sending the Windows scroll-bar message Msg with parameter Param to
// the grid. Clear the key.

begin

   self.Perform( Msg, Param, 0 );
   Key := VK_None;

end; // TBetterDBGrid.ScrollGrid.

//------------------------------------------------------------------------------

function ControlLetter( const Shift: TShiftState ): boolean;

// Return true if the user pressed the control key, but no other special keys
// except perhaps the shift key.

begin

   result := ( ssCtrl in Shift ) and ( Shift <= [ ssShift, ssCtrl ] );

end; // ControlLetter.

//------------------------------------------------------------------------------

procedure TBetterDBGrid.KeyDown( var     Key:   word;
                                 {input} Shift: TShiftState );

// Adjust the key handling of the grid so it is more natural. If we handle the
// key, clear the key so the grid won't do the normal processing. The Windows
// messages are scroll-bar messages.

begin

   if ( Key <> VK_None ) and ( Clicked_Column_Field_Name <> '' ) then begin
      Clicked_Column_Field_Name := '';
      self.Invalidate_Clicked_Button_Rectangle;
   end;

   if dgRowSelect in Options then begin
      if Shift <= [ ssShift ] then
         case Key of
            VK_Left:  self.ScrollGrid( WM_HScroll, SB_LineLeft,  Key );
            VK_Right: self.ScrollGrid( WM_HScroll, SB_LineRight, Key );
            VK_Home:  self.ScrollGrid( WM_HScroll, SB_Top,       Key );
            VK_End:   self.ScrollGrid( WM_HScroll, SB_Bottom,    Key );
         end

      else if ControlLetter( Shift ) then
         case Key of
            VK_Left:  self.ScrollGrid( WM_HScroll, SB_PageLeft,  Key );
            VK_Right: self.ScrollGrid( WM_HScroll, SB_PageRight, Key );
            VK_Prior: self.ScrollGrid( WM_VScroll, SB_Top,       Key );
            VK_Next:  self.ScrollGrid( WM_VScroll, SB_Bottom,    Key );
         end;
   end;

   if Key <> VK_None then
      inherited;

end; // TBetterDBGrid.KeyDown.

//------------------------------------------------------------------------------

function TBetterDBGrid.CanGridAcceptKey( {input} Key:   word;
                                         {input} Shift: TShiftState ): boolean;

// Prevent the grid from deleting the record when the user types Ctrl+Delete.
// The OnKeyDown event will still see Ctrl+Delete and you can delete the record
// there, if you wish.

begin

   result := inherited CanGridAcceptKey( Key, Shift )
             and not ( ( Key = VK_Delete ) and ( ssCtrl in Shift ) );

end; // TBetterDBGrid.CanGridAcceptKey.

//------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.MouseDown.
//------------------------------------------------------------------------------

function TBetterDBGrid.AcquireFocus: boolean;

// Acquire the focus, if possible. Return whether the focus was acquired. This
// is identical to the private TDBGrid.AcquireFocus method.

begin

   result := true;

   if FAcquireFocus and self.CanFocus and not ( csDesigning in ComponentState ) then begin
      self.SetFocus;
      result := self.Focused or ( InplaceEditor <> nil ) and InplaceEditor.Focused;
   end;

end; // TBetterDBGrid.AcquireFocus.

//------------------------------------------------------------------------------

procedure TBetterDBGrid.Depress_Button_If_Point_In_Title_Button( const   ThePoint: TPoint;
                                                                 {input} Column:   TColumn );

// If the specified point is in the button in the title of the specified column,
// save the field name of the column in the dbgrid object's field. Save the
// button rectangle in the dbgrid object's field. Make the button be redrawn in
// the down state.

var
   TitleRect:    TRect;
   MasterColumn: TColumn;

begin

   TitleRect := self.CalcTitleRect( Column, TitleRow, MasterColumn );

   if assigned( MasterColumn ) and ( MasterColumn.ID = Column.ID ) and not Column.Expandable
   and ( GetHotKey( Column.Title.Caption ) <> '' ) then begin

      Calculate_Button_Rectangle( TitleRect, Clicked_Button_Rect );

      if PtInRect( Clicked_Button_Rect, ThePoint ) and ( Column.FieldName <> SortField ) then begin
         Clicked_Column_Field_Name := Column.FieldName;
         Clicked_Button_Down       := true;
         self.Invalidate_Clicked_Button_Rectangle;
      end;
   end;

end; // TBetterDBGrid.Depress_Button_If_Point_In_Title_Button.

//------------------------------------------------------------------------------

procedure TBetterDBGrid.MouseDown( {input} Button: TMouseButton;
                                   {input} Shift:  TShiftState;
                                   {input} X:      integer;
                                   {input} Y:      integer);

// If a title button was clicked, record the column field name and the
// clicked-button rectangle. Otherwise, call the inheried method.

var
   Cell: TGridCoord;

begin

   Cell                      := MouseCoord( X, Y );
   Clicked_Column_Field_Name := '';

   if self.AcquireFocus and not ( csDesigning in ComponentState ) and ( Button = mbLeft )
   and not ( ssDouble in Shift ) and ( Cell.X >= IndicatorOffset ) and ( dgTitles in Options )
   and ( Cell.Y = TitleRow ) then

      self.Depress_Button_If_Point_In_Title_Button( Point( X, Y ),
                                                    Columns[ self.RawToDataColumn( Cell.X ) ] );
   if Clicked_Column_Field_Name = '' then
      inherited;

end; // TBetterDBGrid.MouseDown.

//------------------------------------------------------------------------------

procedure TBetterDBGrid.MouseMove( {input} Shift: TShiftState;
                                   {input} X:     integer;
                                   {input} Y:     integer );

// If the mouse was moved into or out of the clicked button, redraw the button.

begin

   if ( Clicked_Column_Field_Name <> '' )
   and ( Clicked_Button_Down <> PtInRect( Clicked_Button_Rect, Point( X, Y ) ) ) then begin

      Clicked_Button_Down := PtInRect( Clicked_Button_Rect, Point( X, Y ) );
      self.Invalidate_Clicked_Button_Rectangle;
   end;

   inherited;

end; // TBetterDBGrid.MouseMove.

//------------------------------------------------------------------------------

procedure TBetterDBGrid.MouseUp( {input} Button: TMouseButton;
                                 {input} Shift:  TShiftState;
                                 {input} X:      integer;
                                 {input} Y:      integer );

// Call the inherited method. If a title button was clicked, sort the data set
// on the clicked column.

var
   FieldName: string;

begin

   inherited;

   if Clicked_Column_Field_Name <> '' then begin
      FieldName                 := Clicked_Column_Field_Name;
      Clicked_Column_Field_Name := '';

      if PtInRect( Clicked_Button_Rect, Point( X, Y ) ) then
         self.Sort_Data_Set( FieldName )

      else if Clicked_Button_Down then
         self.Invalidate_Clicked_Button_Rectangle;
   end;

end; // TBetterDBGrid.MouseUp.

//------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.CMDialogChar.
//------------------------------------------------------------------------------

function TBetterDBGrid.Accelerator_Column_Index( const Key: word ): ExtListIndex;

// Return the column index that has the specified key as its accelerator key.

var
   J: ExtListIndex;

begin

   result := -1;

   for J := 0 to Columns.Count - 1 do
      if ( result = -1 ) and IsAccel( Key, Columns[ J ].Title.Caption ) then
         result := J;

end; // TBetterDBGrid.Accelerator_Column_Index.

//------------------------------------------------------------------------------

procedure TBetterDBGrid.CMDialogChar( var Message: TCMDialogChar );

// This method will be called if the user types an accelerator key. Accelerator
// keys are Alt plus a character or, if the control with focus doesn't want
// characters, just the character without Alt. Check whether the key is the
// accelerator for any of the column titles. If so, sort on the column.

var
   ColumnIndex: ExtListIndex;

begin

   ColumnIndex := self.Accelerator_Column_Index( Message.CharCode );

   if self.CanFocus and ( ColumnIndex <> -1 ) then begin
      self.Sort_Data_Set( Columns[ ColumnIndex ].FieldName );
      Message.Result := 1;

   end else
      inherited;

end; // TBetterDBGrid.CMDialogChar.

//------------------------------------------------------------------------------
end. // TitleButtonGrid.
//------------------------------------------------------------------------------


[Raize Support]

Hi David,

Thank you for sharing your work on this. I'll try to download the code and check it out, but from a review of the code it looks good.

Ray

[David Marcus]

Here is an updated version (post edited on December 9, 2011):

Code: Select all

//---------------------------------------------------------------------------------------------------------------------------------

unit DavidMarcusGridComponents;

// Customized dbgrid and dbnavigator components.

// The TBetterDBGrid has optional buttons in the column titles. To get a button in a column title, put an ampersand in the column
// Title.Caption property. This also underlines the letter after the ampersand in the title. Clicking the button or pressing the
// accelerator key will sort the data set on the column, assuming you change to the appropriate index in the OnSort event. Only one
// column can be sorted on at a time.

// I don't know what happens if the grid is editing when you try to change indexes, so I've set it so the sorting only happens if
// the grid is not editing.

// If the grid is disabled, the row indicator is hidden. You can save the sort column, column widths, and column order to a
// TRzRegIniFile using the SaveGrid procedure and Restore method. If the dgRowSelect option is selected, then the cursor keys are
// adjusted to be more natural. Ctrl+Delete is no longer passed to the grid; you can use the OnKeyDown event to handle it yourself.

// The TBetterNavigator has a BeforeClick event that lets you abort the navigate action.

// Only tested with Delphi 2006 and Raize Components 5.5.1.

// December 9, 2011.

interface//------------------------------------------------------------------------------------------------------------------------

uses
   // Delphi units. The Windows unit should come first.
   Windows, Classes, Controls, DBGrids, Graphics, Grids,

   // Raize units.
   RzCommon, RzDBGrid, RzDBNav, RzForms;

//---------------------------------------------------------------------------------------------------------------------------------

// The type for the dbgrid's OnSort event.

type
   Sort_Data_Set_Event = procedure(       Sender:    TObject;
                                    const FieldName: string ) of object;

//---------------------------------------------------------------------------------------------------------------------------------

// Constants and types for handling zero-based lists or arrays. Delphi lists (e.g., TList) and dynamic arrays start at zero.

const
   No_List_Index    = -1;
   First_List_Index =  0;
type
   ListIndex    = First_List_Index..MaxInt;
   ExtListIndex = No_List_Index..MaxInt;

//---------------------------------------------------------------------------------------------------------------------------------

// A better version of the Raize data-aware grid.

type
   TBetterDBGrid = class( TRzDBGrid )
      strict private
         Private_Sort_Field:        string;
         Clicked_Column_Field_Name: string;
         Clicked_Button_Rect:       TRect;
         Clicked_Button_Down:       boolean;
         On_Sort_Method:            Sort_Data_Set_Event;

         procedure Hide_Indicator_If_Not_Enabled( const ACol:   longint;
                                                  const ARect:  TRect;
                                                  const AState: TGridDrawState );

         procedure Draw_Outer_Recessed_Border( const Rect:        TRect;
                                               const ButtonColor: TColor );

         procedure Draw_Solid_Border( const Rect:        TRect;
                                      const ButtonColor: TColor );

         procedure DrawButton( const ButtonRect:      TRect;
                               const ButtonColor:     TColor;
                               const Show_Down_Arrow: boolean );

         procedure Draw_Title_Caption( const   BrushColor: TColor;
                                       const   TitleRect:  TRect;
                                       {input} Column:     TColumn );

         procedure Invalidate_Clicked_Button_Rectangle;

         procedure ScrollGrid( const Msg:   UINT;
                               const Param: WPARAM;
                               out   Key:   word );

         function AcquireFocus: boolean;

         procedure Depress_Button_If_Point_In_Title_Button( const   ThePoint: TPoint;
                                                            {input} Column:   TColumn );

         function Accelerator_Column_Index( const Key: word ): ExtListIndex;

      strict protected
         procedure DrawCell( {input} ACol:   longint;
                             {input} ARow:   longint;
                             {input} ARect:  TRect;
                             {input} AState: TGridDrawState ); override;

         procedure DoSort( const FieldName: string ); dynamic;

         procedure KeyDown( var     Key:   word;
                            {input} Shift: TShiftState ); override;

         function CanGridAcceptKey( {input} Key:   word;
                                    {input} Shift: TShiftState ): boolean; override;

         procedure MouseDown( {input} Button: TMouseButton;
                              {input} Shift:  TShiftState;
                              {input} X:      integer;
                              {input} Y:      integer); override;

         procedure MouseMove( {input} Shift: TShiftState;
                              {input} X:     integer;
                              {input} Y:     integer ); override;

         procedure MouseUp( {input} Button: TMouseButton;
                            {input} Shift:  TShiftState;
                            {input} X:      integer;
                            {input} Y:      integer ); override;

         procedure CMDialogChar( var Message: TCMDialogChar ); message CM_DIALOGCHAR;

      public
         procedure Save( const    Section: string;
                         {update} IniFile: TRzRegIniFile );

         procedure Sort_Data_Set( const FieldName: string );

         procedure Restore( const    Section:            string;
                            const    Default_Sort_Field: string;
                            {update} IniFile:            TRzRegIniFile );

         procedure HandleAccelerator( var Key: AnsiChar );
         function  SortField: string;

      published
         property OnSort: Sort_Data_Set_Event read On_Sort_Method write On_Sort_Method;
   end;

//---------------------------------------------------------------------------------------------------------------------------------

// The type for the navigator's BeforeClick event. Set OK to false to abort a navigate action.

type
   Before_Click_Event = procedure(     Sender: TObject;
                                   var OK:     boolean ) of object;

//---------------------------------------------------------------------------------------------------------------------------------

// A database navigator with a BeforeClick event.

type
   TBetterNavigator = class( TRzDBNavigator )
      public
         Before_Click_Method: Before_Click_Event;

         procedure BtnClick( {input} Index: TRzNavigatorButton ); override;

      published
         property BeforeClick: Before_Click_Event read Before_Click_Method write Before_Click_Method;
   end;

//---------------------------------------------------------------------------------------------------------------------------------

// Interfaced procedure.

procedure SaveGrid( const    Section:   string;
                    {input}  Grid:      TBetterDBGrid;
                    {update} FormState: TRzFormState );

implementation//-------------------------------------------------------------------------------------------------------------------

uses
   // Delphi units.
   Forms, Math, Messages, Menus, SysUtils,

   // Raize units.
   RzGrafx;

//---------------------------------------------------------------------------------------------------------------------------------

// Item names in the ini file that the grid state is saved in and restored from.

const
   Sort_Field_Item       = 'SortField';
   Column_ID_Item_Prefix = 'ColumnID';
   Width_Item_Prefix     = 'Width';

//---------------------------------------------------------------------------------------------------------------------------------

// The row number of the title row.

const
   TitleRow = 0;

//---------------------------------------------------------------------------------------------------------------------------------

// Integer types.

type
   NonnegativeInteger = 0..MaxInt;
   PositiveInteger    = 1..MaxInt;

//---------------------------------------------------------------------------------------------------------------------------------

// A type to hold a number of pixels on the screen.

type
   PixelNumber = type NonnegativeInteger;

//---------------------------------------------------------------------------------------------------------------------------------

// Key code and character for no key.

const
   VK_None = 0;
   NoKey   = chr( VK_None );

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.DrawCell.
//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Hide_Indicator_If_Not_Enabled( const ACol:   longint;
                                                       const ARect:  TRect;
                                                       const AState: TGridDrawState );

// If the indicator column was just drawn, but the grid is not enabled, then fill the column to hide the indicator.

var
   Rect: TRect;

begin

   if not Enabled and not ( csLoading in ComponentState ) and ( gdFixed in AState ) and ( ACol < IndicatorOffset )
   and assigned( DataLink ) and DataLink.Active then begin

      Rect := ARect;

      if [ dgRowLines, dgColLines ] * Options = [ dgRowLines, dgColLines ] then
         InflateRect( Rect, -1, -1 );

      Canvas.Brush.Color := FixedColor;
      Canvas.FillRect( Rect );
   end;

end; // TBetterDBGrid.Hide_Indicator_If_Not_Enabled.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by Calculate_Button_Rectangle.
//---------------------------------------------------------------------------------------------------------------------------------

function RectHeight( const R: TRect ): integer;

// Return the height of the specified rectangle.

begin

   result := R.Bottom - R.Top;

end; // RectHeight.

//---------------------------------------------------------------------------------------------------------------------------------

procedure Calculate_Button_Rectangle( const TitleRect:  TRect;
                                      out   ButtonRect: TRect );

// Calculate the rectangle for the button in the specified title rectangle.

const
   Default_Button_Size = 14;
   MinButtonSize       = 11;

var
   ButtonSize: PixelNumber;

begin

   ButtonSize := min( Default_Button_Size, max( 0, RectHeight( TitleRect ) ) );

   if ButtonSize < MinButtonSize then
      ButtonSize := 0;

   ButtonRect := Bounds( TitleRect.Right - ButtonSize, TitleRect.Top + ( RectHeight( TitleRect ) - ButtonSize + 1 ) div 2,
                         ButtonSize, ButtonSize );

end; // Calculate_Button_Rectangle.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.DrawButton.
//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Draw_Outer_Recessed_Border( const Rect:        TRect;
                                                    const ButtonColor: TColor );

// Draw the button's outer recessed border in the specified rectangle where the button has the specified color.

var
   DarkColor:  TColor;
   LightColor: TColor;

begin

   if Enabled then begin
      DarkColor  := DarkerColor(  ButtonColor, 20 );
      LightColor := LighterColor( ButtonColor, 20 );

   end else begin
      DarkColor  := ButtonColor;
      LightColor := ButtonColor;
   end;

   Canvas.Pen.Color := DarkColor;
   Canvas.MoveTo( Rect.Left,      Rect.Top    + 2 );
   Canvas.LineTo( Rect.Left,      Rect.Bottom - 2 );
   Canvas.MoveTo( Rect.Left  + 2, Rect.Top );
   Canvas.LineTo( Rect.Right - 2, Rect.Top );
   Canvas.Pen.Color := LightColor;
   Canvas.MoveTo( Rect.Right - 1, Rect.Top    + 2 );
   Canvas.LineTo( Rect.Right - 1, Rect.Bottom - 2 );
   Canvas.MoveTo( Rect.Left  + 2, Rect.Bottom - 1 );
   Canvas.LineTo( Rect.Right - 2, Rect.Bottom - 1 );
   Canvas.Pixels[ Rect.Left  + 1, Rect.Top    + 1 ] := DarkColor;
   Canvas.Pixels[ Rect.Right - 2, Rect.Top    + 1 ] := DarkColor;
   Canvas.Pixels[ Rect.Right - 2, Rect.Bottom - 2 ] := LightColor;
   Canvas.Pixels[ Rect.Left  + 1, Rect.Bottom - 2 ] := DarkColor;

end; // TBetterDBGrid.Draw_Outer_Recessed_Border.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Draw_Solid_Border( const Rect:        TRect;
                                           const ButtonColor: TColor );

// Draw the button's solid border in the sepcified rectangle where the button has the specified color.

var
   BorderColor: TColor;

begin

   if Enabled then
      BorderColor := FrameColor

   else if ButtonColor = clBtnFace then
      BorderColor := LighterColor( clBtnShadow, 30 )

   else
      BorderColor := DarkerColor( ButtonColor, 80 );

  Canvas.Pen.Color := BorderColor;
  Canvas.MoveTo( Rect.Left,      Rect.Top    + 1 );
  Canvas.LineTo( Rect.Left,      Rect.Bottom - 1 );
  Canvas.MoveTo( Rect.Left  + 1, Rect.Top );
  Canvas.LineTo( Rect.Right - 1, Rect.Top );
  Canvas.MoveTo( Rect.Right - 1, Rect.Top + 1 );
  Canvas.LineTo( Rect.Right - 1, Rect.Bottom - 1 );
  Canvas.MoveTo( Rect.Left  + 1, Rect.Bottom - 1 );
  Canvas.LineTo( Rect.Right - 1, Rect.Bottom - 1 );

end; // TBetterDBGrid.Draw_Solid_Border.

//---------------------------------------------------------------------------------------------------------------------------------

procedure Draw_Button_Face( const    FaceRect:    TRect;
                            const    ButtonColor: TColor;
                            {update} Canvas:      TCanvas );

// Draw the face of the button on the specified canvas in the specified rectangle where the button has the specified color.

var
   Rect: TRect;

begin

   Rect := FaceRect;
   Canvas.Pen.Color := DarkerColor( ButtonColor, 20 );
   Canvas.MoveTo( Rect.Left,  Rect.Bottom - 2 );
   Canvas.LineTo( Rect.Right, Rect.Bottom - 2 );
   Canvas.Pen.Color := DarkerColor( ButtonColor, 30 );
   Canvas.MoveTo( Rect.Left,  Rect.Bottom - 1 );
   Canvas.LineTo( Rect.Right, Rect.Bottom - 1 );
   dec( Rect.Bottom, 2 );

   if FullColorSupported then
      PaintGradient( Canvas, Rect, gdHorizontalEnd, LighterColor( ButtonColor, 30 ), DarkerColor( ButtonColor, 10 ) )

   else begin
      Canvas.Brush.Color := ButtonColor;
      Canvas.FillRect( Rect );
   end;

end; // Draw_Button_Face.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.DrawButton( const ButtonRect:      TRect;
                                    const ButtonColor:     TColor;
                                    const Show_Down_Arrow: boolean );

// Draw a button in the specified rectangle using the specified color and optionally showing a down arrow.

var
   Rect: TRect;

begin

   Rect := ButtonRect;
   self.Draw_Outer_Recessed_Border( Rect, ButtonColor );
   InflateRect(                     Rect, -1, -1 );
   self.Draw_Solid_Border(          Rect, ButtonColor );
   InflateRect(                     Rect, -1, -1 );

   if Enabled then begin
      if ( Clicked_Column_Field_Name <> '' ) and ( Clicked_Button_Rect.Left = ButtonRect.Left ) and Clicked_Button_Down then begin
         Canvas.Brush.Color := DarkerColor( ButtonColor, 20 );
         Canvas.FillRect( Rect );

      end else
         Draw_Button_Face( Rect, ButtonColor, Canvas );

   end else begin
      Canvas.Brush.Color := ButtonColor;
      Canvas.FillRect( Rect );
   end;

   if Show_Down_Arrow then
      DrawSpinArrow( Canvas, Rect, uiWindows95, dirDown, false, Enabled );

end; // TBetterDBGrid.DrawButton.

//---------------------------------------------------------------------------------------------------------------------------------

function RectWidth( const R: TRect ): integer;

// Return the width of the specified rectangle.

begin

   result := R.Right - R.Left;

end; // RectWidth.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.Draw_Title_Caption.
//---------------------------------------------------------------------------------------------------------------------------------

procedure Draw_Aligned_String( const    S:         string;
                               const    Rect:      TRect;
                               const    Alignment: TAlignment;
                               const    Padding:   PixelNumber;
                               {update} Canvas:    TCanvas );

// Draw the specified string on the specified canvas in the specified rectangle with the specified alignment and using the
// specified padding. But, if there isn't room to draw the string, then draw it left justified with no padding.

const
   AlignmentFlag: array [ TAlignment ] of UINT = ( DT_Left, DT_Right, DT_Center );

var
   PaddedRect: TRect;
   NeededRect: TRect;
   Format:     UINT;

begin

   PaddedRect := Rect;

   if Alignment = taLeftJustify then
      inc( PaddedRect.Left, Padding )

   else if Alignment = taRightJustify then
      dec( PaddedRect.Right, Padding );

   NeededRect := PaddedRect;
   Format     := DT_SingleLine or DT_VCenter;
   DrawString( Canvas, S, NeededRect, Format or AlignmentFlag[ Alignment ] or DT_CalcRect );

   if NeededRect.Right <= PaddedRect.Right then
      Format := Format or AlignmentFlag[ Alignment ]

   else begin
      Format     := Format or AlignmentFlag[ taLeftJustify ];
      PaddedRect := Rect;
   end;

   DrawString( Canvas, S, PaddedRect, Format );

end; // Draw_Aligned_String.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Draw_Title_Caption( const   BrushColor: TColor;
                                            const   TitleRect:  TRect;
                                            {input} Column:     TColumn );

// Draw the title caption for the specified column in the specified rectangle. It the text won't fit in the rectangle, then
// left-align it.

const
   Padding_For_Right_Justified = 2;

var
   Rect: TRect;

begin

   Rect := TitleRect;

   if [ dgRowLines, dgColLines ] * Options = [ dgRowLines, dgColLines ] then
      InflateRect( Rect, -2, -1 )
   else
      InflateRect( Rect, -1, 0 );

   Canvas.Brush.Color := BrushColor;

   Draw_Aligned_String( Column.Title.Caption, Rect, Column.Title.Alignment,
                        IfThen( Column.Title.Alignment = taRightJustify, Padding_For_Right_Justified ), Canvas );

end; // TBetterDBGrid.Draw_Title_Caption.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.DrawCell( {input} ACol:   longint;
                                  {input} ARow:   longint;
                                  {input} ARect:  TRect;
                                  {input} AState: TGridDrawState );

// Draw the specified cell. If the cell is a title cell and the column isn't expandable, then draw the title cell, and if the title
// has an accelerator character, underline the accelerator character and include a button in the title. If the grid is not enabled,
// then don't draw the row indicator. Otherwise, just call the inherited method.

var
   TitleRect:    TRect;
   MasterColumn: TColumn;
   BrushColor:   TColor;
   ButtonRect:   TRect;

begin

   if ( csLoading in ComponentState ) or ( ( gdFixed in AState ) and ( ACol < IndicatorOffset ) )
   or not Columns[ self.RawToDataColumn( ACol ) ].Showing or not ( dgTitles in Options ) or ( ARow > TitleRow )
   or self.IsRightToLeft then begin

      inherited;
      self.Hide_Indicator_If_Not_Enabled( ACol, ARect, AState );

   end else begin
      TitleRect := self.CalcTitleRect( Columns[ self.RawToDataColumn( ACol ) ], TitleRow, MasterColumn );

      if not assigned( MasterColumn ) or MasterColumn.Expandable then
         inherited

      else begin
         Canvas.Font := MasterColumn.Title.Font;

         if Enabled then
            BrushColor := MasterColumn.Title.Color

         else begin
            BrushColor        := DisabledColor;
            Canvas.Font.Color := clGrayText;
         end;

         Canvas.Brush.Color := BrushColor;
         Canvas.FillRect( TitleRect );

         if GetHotKey( MasterColumn.Title.Caption ) <> '' then begin
            Calculate_Button_Rectangle( TitleRect, ButtonRect );

            if not IsRectEmpty( ButtonRect ) then begin
               self.DrawButton( ButtonRect, BrushColor, Private_Sort_Field = MasterColumn.FieldName );
               dec( TitleRect.Right, RectWidth( ButtonRect ) );
            end;
         end;

         self.Draw_Title_Caption( BrushColor, TitleRect, MasterColumn );
      end;
   end;

end; // TBetterDBGrid.DrawCell.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by SaveGrid.
//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.Save.
//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by Write_Ini_File_String.
//---------------------------------------------------------------------------------------------------------------------------------

function IsBlank( const S: string ): boolean;

// Return true if the specified string is blank.

begin

   result := ( TrimRight( S ) = '' );

end; // IsBlank.

//---------------------------------------------------------------------------------------------------------------------------------

procedure Write_Ini_File_String( const    Section: string;
                                 const    Key:     string;
                                 const    Value:   string;
                                 {update} IniFile: TRzRegIniFile );

// Write the key and value to the specified section of the ini file, but if the value is blank, delete the key.

begin

   if IsBlank( Value ) then
      IniFile.DeleteKey( Section, Key )
   else
      IniFile.WriteString( Section, Key, Value );

end; // Write_Ini_File_String.

//---------------------------------------------------------------------------------------------------------------------------------

function Last_List_Index( const Size: integer ): integer;

// Return the last index in a zero-based list of the specified size.

begin

   result := First_List_Index + Size - 1;

end; // Last_List_Index.

//---------------------------------------------------------------------------------------------------------------------------------

function Column_ID_Item_Name( const ColumnIndex: ListIndex ): string;

// Return the name of the column ID item for the specified column index.

begin

   result := Column_ID_Item_Prefix + IntToStr( ColumnIndex );

end; // Column_ID_Item_Name.

//---------------------------------------------------------------------------------------------------------------------------------

function Column_Width_Item_Name( const ColumnIndex: ListIndex ): string;

// Return the name of the width item for the specified column index.

begin

   result := Width_Item_Prefix + IntToStr( ColumnIndex );

end; // Column_Width_Item_Name.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Save( const    Section: string;
                              {update} IniFile: TRzRegIniFile );

// Save the state of the grid to the ini file. Call SaveGrid in the form's OnDestroy event rather than this method in case the
// event is called before the form is fully constructed.

var
   J: ExtListIndex;

begin

   Write_Ini_File_String( Section, Sort_Field_Item, Private_Sort_Field, IniFile );

   for J := First_List_Index to Last_List_Index( Columns.Count ) do begin
      IniFile.WriteInteger( Section, Column_ID_Item_Name(    J ), Columns[ J ].ID );
      IniFile.WriteInteger( Section, Column_Width_Item_Name( J ), Columns[ J ].Width );
   end;

end; // TBetterDBGrid.Save.

//---------------------------------------------------------------------------------------------------------------------------------

procedure SaveGrid( const    Section:   string;
                    {input}  Grid:      TBetterDBGrid;
                    {update} FormState: TRzFormState );

// Check that the objects actually exist and save the grid. Call this in the form's OnDestroy event.

begin

   if assigned( Grid ) and assigned( FormState ) then
      Grid.Save( Section, FormState.RegIniFile );

end; // SaveGrid.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.Restore.
//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.Sort_Data_Set.
//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.DoSort( const FieldName: string );

// Call the OnSort event. A descendant could override this method to do the sorting without having to use the OnSort event.

begin

   if assigned( On_Sort_Method ) then
      On_Sort_Method( self, FieldName );

end; // TBetterDBGrid.DoSort.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Sort_Data_Set( const FieldName: string );

// Sort the data set on the specified field. If the data set is not a TableInfo, then you must use the OnSort event to do the
// actual sorting. Changing the index causes the grid to scroll all the way to the left. I don't know why it does this. I scroll it
// back by saving and restoring LeftCol.

var
   SavedLeftCol: integer;

begin

   if assigned( DataSource ) and not EditorMode and ( Private_Sort_Field <> FieldName ) then begin
      Private_Sort_Field := FieldName;
      SavedLeftCol       := LeftCol;
      self.InvalidateTitles;
      self.DoSort( FieldName );
      LeftCol := SavedLeftCol;
   end;

end; // TBetterDBGrid.Sort_Data_Set.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Restore( const    Section:            string;
                                 const    Default_Sort_Field: string;
                                 {update} IniFile:            TRzRegIniFile );

// Restore the state of the grid from the ini file. Call this in the form's OnCreate event.

var
   J:      ExtListIndex;
   Column: TColumn;

begin

   self.BeginLayout;

   try
      self.Sort_Data_Set( IniFile.ReadString( Section, Sort_Field_Item, Default_Sort_Field ) );

      for J := First_List_Index to Last_List_Index( Columns.Count ) do begin
         Column := Columns.FindItemID( IniFile.ReadInteger( Section, Column_ID_Item_Name( J ), Columns[ J ].ID ) ) as TColumn;
         Column.Index := J;
         Column.Width := IniFile.ReadInteger( Section, Column_Width_Item_Name( J ), Column.Width );
      end;

   finally
      self.EndLayout;
   end;

end; // TBetterDBGrid.Restore.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.KeyDown.
//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Invalidate_Clicked_Button_Rectangle;

// Invalidate the clicked-button rectangle so it will be redrawn.

begin

   InvalidateRect( Handle, @Clicked_Button_Rect, false );

end; // TBetterDBGrid.Invalidate_Clicked_Button_Rectangle.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.ScrollGrid( const Msg:   UINT;
                                    const Param: WPARAM;
                                    out   Key:   word );

// Scroll by sending the Windows scroll-bar message Msg with parameter Param to the grid. Clear the key.

begin

   self.Perform( Msg, Param, 0 );
   Key := VK_None;

end; // TBetterDBGrid.ScrollGrid.

//---------------------------------------------------------------------------------------------------------------------------------

function ControlLetter( const Shift: TShiftState ): boolean;

// Return true if the user pressed the control key, but no other special keys except perhaps the shift key.

begin

   result := ( ssCtrl in Shift ) and ( Shift <= [ ssShift, ssCtrl ] );

end; // ControlLetter.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.KeyDown( var     Key:   word;
                                 {input} Shift: TShiftState );

// Adjust the key handling of the grid so it is more natural. If we handle the key, clear the key so the grid won't do the normal
// processing. The Windows messages are scroll-bar messages. If the mouse is being clicked, clear the mouse click and eat the key.

begin

   if ( Key <> VK_None ) and ( Clicked_Column_Field_Name <> '' ) then begin
      Clicked_Column_Field_Name := '';
      self.Invalidate_Clicked_Button_Rectangle;

   end else begin
      if dgRowSelect in Options then begin
         if Shift <= [ ssShift ] then
            case Key of
               VK_Left:  self.ScrollGrid( WM_HScroll, SB_LineLeft,  Key );
               VK_Right: self.ScrollGrid( WM_HScroll, SB_LineRight, Key );
               VK_Home:  self.ScrollGrid( WM_HScroll, SB_Top,       Key );
               VK_End:   self.ScrollGrid( WM_HScroll, SB_Bottom,    Key );
            end

         else if ControlLetter( Shift ) then
            case Key of
               VK_Left:  self.ScrollGrid( WM_HScroll, SB_PageLeft,  Key );
               VK_Right: self.ScrollGrid( WM_HScroll, SB_PageRight, Key );
               VK_Prior: self.ScrollGrid( WM_VScroll, SB_Top,       Key );
               VK_Next:  self.ScrollGrid( WM_VScroll, SB_Bottom,    Key );
            end;
      end;

      if Key <> VK_None then
         inherited;
   end;

end; // TBetterDBGrid.KeyDown.

//---------------------------------------------------------------------------------------------------------------------------------

function TBetterDBGrid.CanGridAcceptKey( {input} Key:   word;
                                         {input} Shift: TShiftState ): boolean;

// Prevent the grid from deleting the record when the user types Ctrl+Delete. The OnKeyDown event will still see Ctrl+Delete and
// you can delete the record there, if you wish.

begin

   result := inherited CanGridAcceptKey( Key, Shift ) and not ( ( Key = VK_Delete ) and ( ssCtrl in Shift ) );

end; // TBetterDBGrid.CanGridAcceptKey.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.MouseDown.
//---------------------------------------------------------------------------------------------------------------------------------

function TBetterDBGrid.AcquireFocus: boolean;

// Acquire the focus, if possible. Return whether the focus was acquired. This is identical to the private TDBGrid.AcquireFocus
// method.

begin

   result := true;

   if FAcquireFocus and self.CanFocus and not ( csDesigning in ComponentState ) then begin
      self.SetFocus;
      result := self.Focused or ( InplaceEditor <> nil ) and InplaceEditor.Focused;
   end;

end; // TBetterDBGrid.AcquireFocus.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Depress_Button_If_Point_In_Title_Button( const   ThePoint: TPoint;
                                                                 {input} Column:   TColumn );

// If the specified point is in the button in the title of the specified column, save the field name of the column in the dbgrid
// object's field. Save the button rectangle in the dbgrid object's field. Make the button be redrawn in the down state.

var
   TitleRect:    TRect;
   MasterColumn: TColumn;

begin

   TitleRect := self.CalcTitleRect( Column, TitleRow, MasterColumn );

   if assigned( MasterColumn ) and ( MasterColumn.ID = Column.ID ) and not Column.Expandable
   and ( GetHotKey( Column.Title.Caption ) <> '' ) then begin

      Calculate_Button_Rectangle( TitleRect, Clicked_Button_Rect );

      if PtInRect( Clicked_Button_Rect, ThePoint ) and ( Column.FieldName <> Private_Sort_Field ) then begin
         Clicked_Column_Field_Name := Column.FieldName;
         Clicked_Button_Down       := true;
         self.Invalidate_Clicked_Button_Rectangle;
      end;
   end;

end; // TBetterDBGrid.Depress_Button_If_Point_In_Title_Button.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.MouseDown( {input} Button: TMouseButton;
                                   {input} Shift:  TShiftState;
                                   {input} X:      integer;
                                   {input} Y:      integer);

// If a title button was clicked, record the column field name and the clicked-button rectangle. Otherwise, call the inheried
// method.

var
   Cell: TGridCoord;

begin

   Cell                      := MouseCoord( X, Y );
   Clicked_Column_Field_Name := '';

   if self.AcquireFocus and not ( csDesigning in ComponentState ) and not EditorMode and ( Button = mbLeft )
   and not ( ssDouble in Shift ) and ( Cell.X >= IndicatorOffset ) and ( dgTitles in Options ) and ( Cell.Y = TitleRow ) then

      self.Depress_Button_If_Point_In_Title_Button( Point( X, Y ), Columns[ self.RawToDataColumn( Cell.X ) ] );

   if Clicked_Column_Field_Name = '' then
      inherited;

end; // TBetterDBGrid.MouseDown.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.MouseMove( {input} Shift: TShiftState;
                                   {input} X:     integer;
                                   {input} Y:     integer );

// If the mouse was moved into or out of the clicked button, redraw the button.

begin

   if ( Clicked_Column_Field_Name <> '' ) and ( Clicked_Button_Down <> PtInRect( Clicked_Button_Rect, Point( X, Y ) ) ) then begin
      Clicked_Button_Down := PtInRect( Clicked_Button_Rect, Point( X, Y ) );
      self.Invalidate_Clicked_Button_Rectangle;
   end;

   inherited;

end; // TBetterDBGrid.MouseMove.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.MouseUp( {input} Button: TMouseButton;
                                 {input} Shift:  TShiftState;
                                 {input} X:      integer;
                                 {input} Y:      integer );

// Call the inherited method. If a title button was clicked, sort the data set on the clicked column. We clear
// Clicked_Column_Field_Name before calling the methods that may redraw the title buttons because its value is checked by the
// DrawButton method.

var
   FieldName: string;

begin

   if Clicked_Column_Field_Name <> '' then begin
      FieldName                 := Clicked_Column_Field_Name;
      Clicked_Column_Field_Name := '';

      if PtInRect( Clicked_Button_Rect, Point( X, Y ) ) then
         self.Sort_Data_Set( FieldName )

      else if Clicked_Button_Down then
         self.Invalidate_Clicked_Button_Rectangle;
   end;

   inherited;

end; // TBetterDBGrid.MouseUp.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.CMDialogChar.
//---------------------------------------------------------------------------------------------------------------------------------

function TBetterDBGrid.Accelerator_Column_Index( const Key: word ): ExtListIndex;

// Return the column index that has the specified key as its accelerator key.

var
   J: ExtListIndex;

begin

   result := No_List_Index;

   for J := First_List_Index to Last_List_Index( Columns.Count ) do
      if ( result = No_List_Index ) and IsAccel( Key, Columns[ J ].Title.Caption ) then
         result := J;

end; // TBetterDBGrid.Accelerator_Column_Index.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.CMDialogChar( var Message: TCMDialogChar );

// This method will be called if the user types an accelerator key. Accelerator keys are Alt plus a character or, if the control
// with focus doesn't want characters, just the character without Alt. Check whether the key is the accelerator for any of the
// column titles. If so, sort on the column. Do not set focus to the grid.

var
   ColumnIndex: ExtListIndex;

begin

   ColumnIndex := self.Accelerator_Column_Index( Message.CharCode );

   if self.CanFocus and not EditorMode and ( ColumnIndex <> No_List_Index ) then begin
      self.Sort_Data_Set( Columns[ ColumnIndex ].FieldName );
      Message.Result := 1;

   end else
      inherited;

end; // TBetterDBGrid.CMDialogChar.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.HandleAccelerator.
//---------------------------------------------------------------------------------------------------------------------------------

function Key_Code_For_Character( const Key: AnsiChar ): word;

// Return the virtual key code for the specified character.

begin

   result := ord( upcase( Key ) );

end; // Key_Code_For_Character.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.HandleAccelerator( var Key: AnsiChar );

// If the specified key is the accelerator key for a column title, sort on the column. This method may be called in another
// control's OnKeyPress event if you want the user to be able to use the grid's accelerator key without pressing Alt, but Windows
// thinks the other control wants the key, e.g., TRzNumericEdit.

var
   ColumnIndex: ExtListIndex;

begin

   ColumnIndex := self.Accelerator_Column_Index( Key_Code_For_Character( Key ) );

   if self.CanFocus and ( ColumnIndex <> No_List_Index ) then begin
      self.Sort_Data_Set( Columns[ ColumnIndex ].FieldName );
      Key := NoKey;
   end;

end; // TBetterDBGrid.HandleAccelerator.

//---------------------------------------------------------------------------------------------------------------------------------

function TBetterDBGrid.SortField: string;

// Return the name of the field that the grid is currently sorted on.

begin

   result := Private_Sort_Field;

end; // TBetterDBGrid.SortField.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterNavigator.BtnClick( {input} Index: TRzNavigatorButton );

// Call the BeforeClick event. If the BeforeClick event sets OK to false, then don't call the inherited method. Raize's navigator
// doesn't let you say you don't want to navigate (since the NavBtn parameter has to have some value). This lets you abort a
// navigate action, if you want to.

var
   OK: boolean;

begin

   OK := true;

   if assigned( Before_Click_Method ) then
      Before_Click_Method( self, OK );

   if OK then
      inherited;

end; // TBetterNavigator.BtnClick.

//---------------------------------------------------------------------------------------------------------------------------------
end. // DavidMarcusGridComponents.
//---------------------------------------------------------------------------------------------------------------------------------

[David Marcus]

Here is a Delphi XE2, Raize 6.0 version:

Code: Select all

//---------------------------------------------------------------------------------------------------------------------------------

unit DavidMarcusGridComponentsXE2;

// Customized DBGrid and DBNavigator components.

// The TBetterDBGrid has optional buttons in the column titles. To get a button in a column title, put an ampersand in the column
// Title.Caption property. This also underlines the letter after the ampersand in the title. Clicking the button or pressing the
// accelerator key will sort the data set on the column, assuming that you change to the appropriate index in the OnSort event.
// Only one column can be sorted on at a time.

// For the TDBGrid (and TRzDBGrid), if dgTitleClick is in TDBGrid.Options, then the title changes color and looks depressed when
// the user clicks it. And, if dgTitleHotTrack is in TDBGrid.Options, then the title cells hot track (althogh only seems to take
// effect if also have dgTitleClick). The purpose of these options is similar to that of having title buttons, but it doesn't make
// much sense to do both (and it would be complicated to support both at the same time). So, if you set either of these options,
// then you won't get the buttons in the titles or the underlined letters. In the TDBGrid, if you don't have dgTitleClick, then the
// OnTitleClick event won't be called. However, the TBetterDBGrid will call the event when a title button is clicked or the title
// accelerator key is pressed.

// I don't know what happens if the grid is editing when you try to change indexes, so I've set it so that the sorting only happens
// if the grid is not editing.

// Additional differences from TDBGrid/TRzDBGrid: If the grid is disabled, the row indicator is hidden. You can save the sort
// column, column widths, and column order to a TRzRegIniFile using the SaveGrid procedure and Restore method. If the dgRowSelect
// option is selected, then the cursor keys are adjusted to be more natural. Ctrl+Delete is no longer passed to the grid; you can
// use the OnKeyDown event to handle it yourself.

// The TBetterNavigator has a BeforeClick event that lets you abort the navigate action.

// Requires Delphi XE2 and Raize Components 6.0. David Marcus. June 16, 2012.

interface//------------------------------------------------------------------------------------------------------------------------

uses
   // Delphi units. The Winapi.Windows unit should come first.
   Winapi.Windows, System.Classes, Vcl.Controls, Vcl.DBGrids, Vcl.Graphics, Vcl.Grids,

   // Raize units.
   RzCommon, RzDBGrid, RzDBNav, RzForms;

//---------------------------------------------------------------------------------------------------------------------------------

// The type for the dbgrid's OnSort event.

type
   Sort_Data_Set_Event = procedure( {update} Sender:    TObject;
                                    const    FieldName: string ) of object;

//---------------------------------------------------------------------------------------------------------------------------------

// Constants and types for handling zero-based lists or arrays. Delphi lists (e.g., TList) and dynamic arrays start at zero.

const
   No_List_Index    = -1;
   First_List_Index =  0;
type
   ListIndex    = First_List_Index..MaxInt;
   ExtListIndex = No_List_Index..MaxInt;

//---------------------------------------------------------------------------------------------------------------------------------

// Integer type.

type
   NonnegativeInteger = 0..MaxInt;

//---------------------------------------------------------------------------------------------------------------------------------

// A better version of the Raize data-aware grid.

type
   TBetterDBGrid = class( TRzDBGrid )
      strict private
         Private_Sort_Field:  string;
         ClickedColumn:       TColumn;
         Clicked_Button_Rect: TRect;
         Clicked_Button_Down: boolean;
         On_Sort_Method:      Sort_Data_Set_Event;

         function Title_Buttons_Active: boolean;
         function TitleOffset: byte;
         function Raw_To_Data_Row( const RawRow: NonnegativeInteger ): integer;

         procedure Draw_Background_For_Raw_Cell( const ARect:  TRect;
                                                 const AColor: TColor;
                                                 const AState: TGridDrawState;
                                                 const ACol:   integer;
                                                 const ARow:   integer );

         procedure Hide_Indicator_If_Not_Enabled( const ACol:   longint;
                                                  const ARow:   longint;
                                                  const ARect:  TRect;
                                                  const AState: TGridDrawState );

         procedure Draw_Outer_Recessed_Border( const Rect:        TRect;
                                               const ButtonColor: TColor );

         procedure Draw_Solid_Border( const Rect:        TRect;
                                      const ButtonColor: TColor );

         procedure DrawButton( const ButtonRect:      TRect;
                               const ButtonColor:     TColor;
                               const Show_Down_Arrow: boolean );

         procedure Draw_Title_Caption( const   TitleRect: TRect;
                                       {input} Column:    TColumn );

         procedure Invalidate_Clicked_Button_Rectangle;

         procedure ScrollGrid( const Msg:   UINT;
                               const Param: WPARAM;
                               out   Key:   word );

         function AcquireFocus: boolean;

         procedure Depress_Button_If_Point_In_Title_Button( const   ThePoint: TPoint;
                                                            {input} Column:   TColumn );

         procedure Sort_Data_And_Call_Title_Click_Event( {update} Column: TColumn );
         function  Accelerator_Column_Index( const Key: word ): ExtListIndex;

      strict protected
         procedure DrawCell( {input} ACol:   longint;
                             {input} ARow:   longint;
                             {input} ARect:  TRect;
                             {input} AState: TGridDrawState ); override;

         procedure DoSort( const FieldName: string ); dynamic;

         procedure KeyDown( var     Key:   word;
                            {input} Shift: TShiftState ); override;

         function CanGridAcceptKey( {input} Key:   word;
                                    {input} Shift: TShiftState ): boolean; override;

         procedure MouseDown( {input} Button: TMouseButton;
                              {input} Shift:  TShiftState;
                              {input} X:      integer;
                              {input} Y:      integer); override;

         procedure MouseMove( {input} Shift: TShiftState;
                              {input} X:     integer;
                              {input} Y:     integer ); override;

         procedure Call_Title_Click_Event( {update} Column: TColumn ); dynamic;

         procedure MouseUp( {input} Button: TMouseButton;
                            {input} Shift:  TShiftState;
                            {input} X:      integer;
                            {input} Y:      integer ); override;

         procedure CMDialogChar( var Message: TCMDialogChar ); message CM_DIALOGCHAR;

      public
         procedure Save( const    Section: string;
                         {update} IniFile: TRzRegIniFile );

         procedure Sort_Data_Set( const FieldName: string );

         procedure Restore( const    Section:            string;
                            const    Default_Sort_Field: string;
                            {update} IniFile:            TRzRegIniFile );

         procedure HandleAccelerator( var Key: char );
         function  SortField: string;

      published
         property OnSort: Sort_Data_Set_Event read On_Sort_Method write On_Sort_Method;
   end;

//---------------------------------------------------------------------------------------------------------------------------------

// The type for the navigator's BeforeClick event. Set OK to false to abort a navigate action.

type
   Before_Click_Event = procedure( {update} Sender: TObject;
                                   var      OK:     boolean ) of object;

//---------------------------------------------------------------------------------------------------------------------------------

// A database navigator with a BeforeClick event.

type
   TBetterNavigator = class( TRzDBNavigator )
      public
         Before_Click_Method: Before_Click_Event;

         procedure BtnClick( {input} Index: TRzNavigatorButton ); override;

      published
         property BeforeClick: Before_Click_Event read Before_Click_Method write Before_Click_Method;
   end;

//---------------------------------------------------------------------------------------------------------------------------------

// Interfaced procedure.

procedure SaveGrid( const    Section:   string;
                    {input}  Grid:      TBetterDBGrid;
                    {update} FormState: TRzFormState );

implementation//-------------------------------------------------------------------------------------------------------------------

uses
   // Delphi units.
   System.Math, System.SysUtils, Vcl.Forms, Vcl.Menus, Winapi.Messages,

   // Raize units.
   RzGrafx;

//---------------------------------------------------------------------------------------------------------------------------------

// Item names in the ini file that the grid state is saved in and restored from.

const
   Sort_Field_Item       = 'SortField';
   Column_ID_Item_Prefix = 'ColumnID';
   Width_Item_Prefix     = 'Width';

//---------------------------------------------------------------------------------------------------------------------------------

// The row number of the title row.

const
   TitleRow = 0;

//---------------------------------------------------------------------------------------------------------------------------------

// A type to hold a number of pixels on the screen.

type
   PixelNumber = type NonnegativeInteger;

//---------------------------------------------------------------------------------------------------------------------------------

// Key code and character that can't come from pressing a key.

const
   VK_None = 0;
   NoKey   = chr( VK_None );

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.DrawCell.
//---------------------------------------------------------------------------------------------------------------------------------

function TBetterDBGrid.Title_Buttons_Active: boolean;

// Return true if the grid's options are compatible with title buttons. We don't know what should happen, or if our modifications
// will work, if IsRightToLeft is true, so don't display the title buttons in that case.

begin

   result := ( [ dgTitles, dgTitleClick, dgTitleHotTrack ] * Options = [ dgTitles ] ) and not self.IsRightToLeft;

end; // TBetterDBGrid.Title_Buttons_Active.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.Hide_Indicator_If_Not_Enabled.
//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.Draw_Background_For_Raw_Cell.
//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.Raw_To_Data_Row.
//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.TitleOffset.
//---------------------------------------------------------------------------------------------------------------------------------

function Last_List_Index( const Size: integer ): integer;

// Return the last index in a zero-based list of the specified size.

begin

   result := First_List_Index + Size - 1;

end; // Last_List_Index.

//---------------------------------------------------------------------------------------------------------------------------------

function TBetterDBGrid.TitleOffset: byte;

// Return the title offset, i.e., the number of rows of titles. This should be the same as the private FTitleOffset. I don't know
// if the check on ComponentState is necessary, but TCustomDBGrid.InternalLayout does it.

var
  J:     ExtListIndex;
  Depth: integer;

begin

   if ( [ csLoading, csDestroying ] * ComponentState = [] ) and ( dgTitles in Options ) then begin
      result := 1;

      if assigned( Datalink ) and assigned( Datalink.Dataset ) and Datalink.Dataset.ObjectView then
         for J := First_List_Index to Last_List_Index( Columns.Count ) do
            if Columns[ J ].Showing then begin
               Depth := Columns[ J ].Depth;

               if Depth >= result then
                  result := Depth + 1;
            end;
   end else
      result := 0;

end; // TBetterDBGrid.TitleOffset.

//---------------------------------------------------------------------------------------------------------------------------------

function TBetterDBGrid.Raw_To_Data_Row( const RawRow: NonnegativeInteger ): integer;

// Return the data row number corresponding to the specified raw row number. The raw row numbers number all rows (both title and
// data) starting at zero. The data row numbers have the first data row as row number zero.

begin

   result := RawRow - self.TitleOffset;

end; // TBetterDBGrid.Raw_To_Data_Row.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Draw_Background_For_Raw_Cell( const ARect:  TRect;
                                                      const AColor: TColor;
                                                      const AState: TGridDrawState;
                                                      const ACol:   integer;
                                                      const ARow:   integer );

// Draw the background for the specified cell where the column and row numbers are the raw numbers.

begin

   self.DrawCellBackground( ARect, AColor, AState, self.RawToDataColumn( ACol ), self.Raw_To_Data_Row( ARow ) );

end; // TBetterDBGrid.Draw_Background_For_Raw_Cell.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Hide_Indicator_If_Not_Enabled( const ACol:   longint;
                                                       const ARow:   longint;
                                                       const ARect:  TRect;
                                                       const AState: TGridDrawState );

// If the indicator column was just drawn, but the grid is not enabled, then fill the column to hide the indicator.

var
   Rect: TRect;

begin

   if not Enabled and not ( csLoading in ComponentState ) and ( gdFixed in AState ) and ( ACol < IndicatorOffset )
   and assigned( DataLink ) and DataLink.Active then begin

      Rect := ARect;

      if [ dgRowLines, dgColLines ] * Options = [ dgRowLines, dgColLines ] then
         InflateRect( Rect, -1, -1 );

      self.Draw_Background_For_Raw_Cell( Rect, FixedColor, AState, ACol, ARow );
   end;

end; // TBetterDBGrid.Hide_Indicator_If_Not_Enabled.

//---------------------------------------------------------------------------------------------------------------------------------

procedure Calculate_Button_Rectangle( const TitleRect:  TRect;
                                      out   ButtonRect: TRect );

// Calculate the rectangle for the button in the specified title rectangle.

const
   Default_Button_Size = 14;
   MinButtonSize       = 11;

var
   ButtonSize: PixelNumber;

begin

   ButtonSize := min( Default_Button_Size, max( 0, TitleRect.Height ) );

   if ButtonSize < MinButtonSize then
      ButtonSize := 0;

   ButtonRect := Bounds( TitleRect.Right - ButtonSize, TitleRect.Top + ( TitleRect.Height - ButtonSize + 1 ) div 2, ButtonSize,
                         ButtonSize );

end; // Calculate_Button_Rectangle.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.DrawButton.
//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Draw_Outer_Recessed_Border( const Rect:        TRect;
                                                    const ButtonColor: TColor );

// Draw the button's outer recessed border in the specified rectangle where the button has the specified color.

var
   DarkColor:  TColor;
   LightColor: TColor;

begin

   if Enabled then begin
      DarkColor  := DarkerColor(  ButtonColor, 20 );
      LightColor := LighterColor( ButtonColor, 20 );

   end else begin
      DarkColor  := ButtonColor;
      LightColor := ButtonColor;
   end;

   Canvas.Pen.Color := DarkColor;
   Canvas.MoveTo( Rect.Left,      Rect.Top    + 2 );
   Canvas.LineTo( Rect.Left,      Rect.Bottom - 2 );
   Canvas.MoveTo( Rect.Left  + 2, Rect.Top );
   Canvas.LineTo( Rect.Right - 2, Rect.Top );
   Canvas.Pen.Color := LightColor;
   Canvas.MoveTo( Rect.Right - 1, Rect.Top    + 2 );
   Canvas.LineTo( Rect.Right - 1, Rect.Bottom - 2 );
   Canvas.MoveTo( Rect.Left  + 2, Rect.Bottom - 1 );
   Canvas.LineTo( Rect.Right - 2, Rect.Bottom - 1 );
   Canvas.Pixels[ Rect.Left  + 1, Rect.Top    + 1 ] := DarkColor;
   Canvas.Pixels[ Rect.Right - 2, Rect.Top    + 1 ] := DarkColor;
   Canvas.Pixels[ Rect.Right - 2, Rect.Bottom - 2 ] := LightColor;
   Canvas.Pixels[ Rect.Left  + 1, Rect.Bottom - 2 ] := DarkColor;

end; // TBetterDBGrid.Draw_Outer_Recessed_Border.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Draw_Solid_Border( const Rect:        TRect;
                                           const ButtonColor: TColor );

// Draw the button's solid border in the sepcified rectangle where the button has the specified color.

var
   BorderColor: TColor;

begin

   if Enabled then
      BorderColor := FrameColor

   else if ButtonColor = clBtnFace then
      BorderColor := LighterColor( clBtnShadow, 30 )

   else
      BorderColor := DarkerColor( ButtonColor, 80 );

  Canvas.Pen.Color := BorderColor;
  Canvas.MoveTo( Rect.Left,      Rect.Top    + 1 );
  Canvas.LineTo( Rect.Left,      Rect.Bottom - 1 );
  Canvas.MoveTo( Rect.Left  + 1, Rect.Top );
  Canvas.LineTo( Rect.Right - 1, Rect.Top );
  Canvas.MoveTo( Rect.Right - 1, Rect.Top + 1 );
  Canvas.LineTo( Rect.Right - 1, Rect.Bottom - 1 );
  Canvas.MoveTo( Rect.Left  + 1, Rect.Bottom - 1 );
  Canvas.LineTo( Rect.Right - 1, Rect.Bottom - 1 );

end; // TBetterDBGrid.Draw_Solid_Border.

//---------------------------------------------------------------------------------------------------------------------------------

procedure Draw_Button_Face( const    FaceRect:    TRect;
                            const    ButtonColor: TColor;
                            {update} Canvas:      TCanvas );

// Draw the face of the button on the specified canvas in the specified rectangle where the button has the specified color.

var
   Rect: TRect;

begin

   Rect := FaceRect;
   Canvas.Pen.Color := DarkerColor( ButtonColor, 20 );
   Canvas.MoveTo( Rect.Left,  Rect.Bottom - 2 );
   Canvas.LineTo( Rect.Right, Rect.Bottom - 2 );
   Canvas.Pen.Color := DarkerColor( ButtonColor, 30 );
   Canvas.MoveTo( Rect.Left,  Rect.Bottom - 1 );
   Canvas.LineTo( Rect.Right, Rect.Bottom - 1 );
   dec( Rect.Bottom, 2 );

   if FullColorSupported then
      PaintGradient( Canvas, Rect, gdHorizontalEnd, LighterColor( ButtonColor, 30 ), DarkerColor( ButtonColor, 10 ) )

   else begin
      Canvas.Brush.Color := ButtonColor;
      Canvas.FillRect( Rect );
   end;

end; // Draw_Button_Face.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.DrawButton( const ButtonRect:      TRect;
                                    const ButtonColor:     TColor;
                                    const Show_Down_Arrow: boolean );

// Draw a button in the specified rectangle using the specified color and optionally showing a down arrow.

var
   Rect: TRect;

begin

   Rect := ButtonRect;
   self.Draw_Outer_Recessed_Border( Rect, ButtonColor );
   InflateRect(                     Rect, -1, -1 );
   self.Draw_Solid_Border(          Rect, ButtonColor );
   InflateRect(                     Rect, -1, -1 );

   if Enabled then begin
      if assigned( ClickedColumn ) and ( Clicked_Button_Rect.Left = ButtonRect.Left ) and Clicked_Button_Down then begin
         Canvas.Brush.Color := DarkerColor( ButtonColor, 20 );
         Canvas.FillRect( Rect );

      end else
         Draw_Button_Face( Rect, ButtonColor, Canvas );

   end else begin
      Canvas.Brush.Color := ButtonColor;
      Canvas.FillRect( Rect );
   end;

   if Show_Down_Arrow then
      DrawSpinArrow( Canvas, Rect, uiWindows95, dirDown, false, Enabled );

end; // TBetterDBGrid.DrawButton.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.Draw_Title_Caption.
//---------------------------------------------------------------------------------------------------------------------------------

procedure Draw_Aligned_String( const    S:         string;
                               const    Rect:      TRect;
                               const    Alignment: TAlignment;
                               const    Padding:   PixelNumber;
                               {update} Canvas:    TCanvas );

// Draw the specified string on the specified canvas in the specified rectangle with the specified alignment and using the
// specified padding. But, if there isn't room to draw the string, then draw it left justified with no padding. The background
// should already be drawn; we use a brush style of bsClear.

const
   AlignmentFlag: array [ TAlignment ] of UINT = ( DT_Left, DT_Right, DT_Center );

var
   PaddedRect:    TRect;
   NeededRect:    TRect;
   Format:        UINT;
   OriginalStyle: TBrushStyle;

begin

   PaddedRect := Rect;

   if Alignment = taLeftJustify then
      inc( PaddedRect.Left, Padding )

   else if Alignment = taRightJustify then
      dec( PaddedRect.Right, Padding );

   NeededRect := PaddedRect;
   Format     := DT_SingleLine or DT_VCenter;
   DrawString( Canvas, S, NeededRect, Format or AlignmentFlag[ Alignment ] or DT_CalcRect );

   if NeededRect.Right <= PaddedRect.Right then
      Format := Format or AlignmentFlag[ Alignment ]

   else begin
      Format     := Format or AlignmentFlag[ taLeftJustify ];
      PaddedRect := Rect;
   end;

   OriginalStyle      := Canvas.Brush.Style;
   Canvas.Brush.Style := bsClear;
   DrawString( Canvas, S, PaddedRect, Format );
   Canvas.Brush.Style := OriginalStyle;

end; // Draw_Aligned_String.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Draw_Title_Caption( const   TitleRect: TRect;
                                            {input} Column:    TColumn );

// Draw the title caption for the specified column in the specified rectangle. It the text won't fit in the rectangle, then
// left-align it.

const
   Padding_For_Right_Justified = 2;

var
   Rect: TRect;

begin

   Rect := TitleRect;

   if [ dgRowLines, dgColLines ] * Options = [ dgRowLines, dgColLines ] then
      InflateRect( Rect, -2, -1 )
   else
      InflateRect( Rect, -1, 0 );

   Draw_Aligned_String( Column.Title.Caption, Rect, Column.Title.Alignment,
                        IfThen( Column.Title.Alignment = taRightJustify, Padding_For_Right_Justified ), Canvas );

end; // TBetterDBGrid.Draw_Title_Caption.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.DrawCell( {input} ACol:   longint;
                                  {input} ARow:   longint;
                                  {input} ARect:  TRect;
                                  {input} AState: TGridDrawState );

// Draw the specified cell. If the cell is a title cell and the column isn't expandable, then draw the title cell, and if the title
// has an accelerator character, underline the accelerator character and include a button in the title. If the grid is not enabled,
// then don't draw the row indicator. Otherwise, just call the inherited method. When reading the Delphi code, it helps to remember
// that gdFixed will be in AState for the title row and the DrawCells procedure in TRzDBGrid.Paint paints over the raised-inner
// cell border.

var
   TitleRect:    TRect;
   MasterColumn: TColumn;
   BrushColor:   TColor;
   ButtonRect:   TRect;

begin

   if ( csLoading in ComponentState ) or ( ( gdFixed in AState ) and ( ACol < IndicatorOffset ) )
   or not Columns[ self.RawToDataColumn( ACol ) ].Showing or not self.Title_Buttons_Active or ( ARow > TitleRow ) then begin

      inherited;
      self.Hide_Indicator_If_Not_Enabled( ACol, ARow, ARect, AState );

   end else begin
      TitleRect := self.CalcTitleRect( Columns[ self.RawToDataColumn( ACol ) ], TitleRow, MasterColumn );

      if not assigned( MasterColumn ) or MasterColumn.Expandable then
         inherited

      else begin
         Canvas.Font := MasterColumn.Title.Font;

         if Enabled then
            BrushColor := MasterColumn.Title.Color

         else begin
            BrushColor        := DisabledColor;
            Canvas.Font.Color := clGrayText;
         end;

         self.Draw_Background_For_Raw_Cell( TitleRect, BrushColor, AState, ACol, ARow );

         if GetHotKey( MasterColumn.Title.Caption ) <> '' then begin
            Calculate_Button_Rectangle( TitleRect, ButtonRect );

            if not IsRectEmpty( ButtonRect ) then begin
               self.DrawButton( ButtonRect, BrushColor, Private_Sort_Field = MasterColumn.FieldName );
               dec( TitleRect.Right, ButtonRect.Width );
            end;
         end;

         self.Draw_Title_Caption( TitleRect, MasterColumn );
      end;
   end;

end; // TBetterDBGrid.DrawCell.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by SaveGrid.
//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.Save.
//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by Write_Ini_File_String.
//---------------------------------------------------------------------------------------------------------------------------------

function IsBlank( const S: string ): boolean;

// Return true if the specified string is blank.

begin

   result := ( TrimRight( S ) = '' );

end; // IsBlank.

//---------------------------------------------------------------------------------------------------------------------------------

procedure Write_Ini_File_String( const    Section: string;
                                 const    Key:     string;
                                 const    Value:   string;
                                 {update} IniFile: TRzRegIniFile );

// Write the key and value to the specified section of the ini file, but if the value is blank, delete the key.

begin

   if IsBlank( Value ) then
      IniFile.DeleteKey( Section, Key )
   else
      IniFile.WriteString( Section, Key, Value );

end; // Write_Ini_File_String.

//---------------------------------------------------------------------------------------------------------------------------------

function Column_ID_Item_Name( const ColumnIndex: ListIndex ): string;

// Return the name of the column ID item for the specified column index.

begin

   result := Column_ID_Item_Prefix + IntToStr( ColumnIndex );

end; // Column_ID_Item_Name.

//---------------------------------------------------------------------------------------------------------------------------------

function Column_Width_Item_Name( const ColumnIndex: ListIndex ): string;

// Return the name of the width item for the specified column index.

begin

   result := Width_Item_Prefix + IntToStr( ColumnIndex );

end; // Column_Width_Item_Name.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Save( const    Section: string;
                              {update} IniFile: TRzRegIniFile );

// Save the state of the grid to the ini file. Call SaveGrid in the form's OnDestroy event rather than this method in case the
// event is called before the form is fully constructed.

var
   J: ExtListIndex;

begin

   Write_Ini_File_String( Section, Sort_Field_Item, Private_Sort_Field, IniFile );

   for J := First_List_Index to Last_List_Index( Columns.Count ) do begin
      IniFile.WriteInteger( Section, Column_ID_Item_Name(    J ), Columns[ J ].ID );
      IniFile.WriteInteger( Section, Column_Width_Item_Name( J ), Columns[ J ].Width );
   end;

end; // TBetterDBGrid.Save.

//---------------------------------------------------------------------------------------------------------------------------------

procedure SaveGrid( const    Section:   string;
                    {input}  Grid:      TBetterDBGrid;
                    {update} FormState: TRzFormState );

// Check that the objects actually exist and save the grid. Call this in the form's OnDestroy event.

begin

   if assigned( Grid ) and assigned( FormState ) then
      Grid.Save( Section, FormState.RegIniFile );

end; // SaveGrid.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.Restore.
//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.Sort_Data_Set.
//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.DoSort( const FieldName: string );

// Call the OnSort event. A descendant could override this method to do the sorting without having to use the OnSort event.

begin

   if assigned( On_Sort_Method ) then
      On_Sort_Method( self, FieldName );

end; // TBetterDBGrid.DoSort.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Sort_Data_Set( const FieldName: string );

// Sort the data set on the specified field. Changing the index causes the grid to scroll all the way to the left. I don't know why
// it does this. I scroll it back by saving and restoring LeftCol.

var
   SavedLeftCol: integer;

begin

   if assigned( DataSource ) and not EditorMode and ( Private_Sort_Field <> FieldName ) then begin
      Private_Sort_Field := FieldName;
      SavedLeftCol       := LeftCol;
      self.InvalidateTitles;
      self.DoSort( FieldName );
      LeftCol := SavedLeftCol;
   end;

end; // TBetterDBGrid.Sort_Data_Set.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Restore( const    Section:            string;
                                 const    Default_Sort_Field: string;
                                 {update} IniFile:            TRzRegIniFile );

// Restore the state of the grid from the ini file. Call this in the form's OnCreate event.

var
   J:      ExtListIndex;
   Column: TColumn;

begin

   self.BeginLayout;

   try
      self.Sort_Data_Set( IniFile.ReadString( Section, Sort_Field_Item, Default_Sort_Field ) );

      for J := First_List_Index to Last_List_Index( Columns.Count ) do begin
         Column := Columns.FindItemID( IniFile.ReadInteger( Section, Column_ID_Item_Name( J ), Columns[ J ].ID ) ) as TColumn;
         Column.Index := J;
         Column.Width := IniFile.ReadInteger( Section, Column_Width_Item_Name( J ), Column.Width );
      end;

   finally
      self.EndLayout;
   end;

end; // TBetterDBGrid.Restore.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.KeyDown.
//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Invalidate_Clicked_Button_Rectangle;

// Invalidate the clicked-button rectangle so it will be redrawn.

begin

   InvalidateRect( Handle, @Clicked_Button_Rect, false );

end; // TBetterDBGrid.Invalidate_Clicked_Button_Rectangle.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.ScrollGrid( const Msg:   UINT;
                                    const Param: WPARAM;
                                    out   Key:   word );

// Scroll by sending the Windows scroll-bar message Msg with parameter Param to the grid. Clear the key.

begin

   self.Perform( Msg, Param, 0 );
   Key := VK_None;

end; // TBetterDBGrid.ScrollGrid.

//---------------------------------------------------------------------------------------------------------------------------------

function ControlLetter( const Shift: TShiftState ): boolean;

// Return true if the user pressed the control key, but no other special keys except perhaps the shift key.

begin

   result := ( ssCtrl in Shift ) and ( Shift <= [ ssShift, ssCtrl ] );

end; // ControlLetter.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.KeyDown( var     Key:   word;
                                 {input} Shift: TShiftState );

// Adjust the key handling of the grid so it is more natural. If we handle the key, clear the key so the grid won't do the normal
// processing. The Windows messages are scroll-bar messages. If the mouse is being clicked, clear the mouse click and eat the key.

begin

   if ( Key <> VK_None ) and assigned( ClickedColumn ) then begin
      ClickedColumn := nil;
      self.Invalidate_Clicked_Button_Rectangle;

   end else begin
      if dgRowSelect in Options then begin
         if Shift <= [ ssShift ] then
            case Key of
               VK_Left:  self.ScrollGrid( WM_HScroll, SB_LineLeft,  Key );
               VK_Right: self.ScrollGrid( WM_HScroll, SB_LineRight, Key );
               VK_Home:  self.ScrollGrid( WM_HScroll, SB_Top,       Key );
               VK_End:   self.ScrollGrid( WM_HScroll, SB_Bottom,    Key );
            end

         else if ControlLetter( Shift ) then
            case Key of
               VK_Left:  self.ScrollGrid( WM_HScroll, SB_PageLeft,  Key );
               VK_Right: self.ScrollGrid( WM_HScroll, SB_PageRight, Key );
               VK_Prior: self.ScrollGrid( WM_VScroll, SB_Top,       Key );
               VK_Next:  self.ScrollGrid( WM_VScroll, SB_Bottom,    Key );
            end;
      end;

      if Key <> VK_None then
         inherited;
   end;

end; // TBetterDBGrid.KeyDown.

//---------------------------------------------------------------------------------------------------------------------------------

function TBetterDBGrid.CanGridAcceptKey( {input} Key:   word;
                                         {input} Shift: TShiftState ): boolean;

// Prevent the grid from deleting the record when the user types Ctrl+Delete. The OnKeyDown event will still see Ctrl+Delete and
// you can delete the record there, if you wish.

begin

   result := inherited CanGridAcceptKey( Key, Shift ) and not ( ( Key = VK_Delete ) and ( ssCtrl in Shift ) );

end; // TBetterDBGrid.CanGridAcceptKey.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.MouseDown.
//---------------------------------------------------------------------------------------------------------------------------------

function TBetterDBGrid.AcquireFocus: boolean;

// Acquire the focus, if possible. Return whether the focus was acquired. This is identical to the private TDBGrid.AcquireFocus
// method.

begin

   result := true;

   if FAcquireFocus and self.CanFocus and not ( csDesigning in ComponentState ) then begin
      self.SetFocus;
      result := self.Focused or ( InplaceEditor <> nil ) and InplaceEditor.Focused;
   end;

end; // TBetterDBGrid.AcquireFocus.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Depress_Button_If_Point_In_Title_Button( const   ThePoint: TPoint;
                                                                 {input} Column:   TColumn );

// If the specified point is in the button in the title of the specified column, save the field name of the column in the dbgrid
// object's field. Save the button rectangle in the dbgrid object's field. Make the button be redrawn in the down state.

var
   TitleRect:    TRect;
   MasterColumn: TColumn;

begin

   TitleRect := self.CalcTitleRect( Column, TitleRow, MasterColumn );

   if assigned( MasterColumn ) and ( MasterColumn.ID = Column.ID ) and not Column.Expandable
   and ( Column.FieldName <> Private_Sort_Field ) and ( GetHotKey( Column.Title.Caption ) <> '' ) then begin

      Calculate_Button_Rectangle( TitleRect, Clicked_Button_Rect );

      if PtInRect( Clicked_Button_Rect, ThePoint ) then begin
         ClickedColumn       := Column;
         Clicked_Button_Down := true;
         self.Invalidate_Clicked_Button_Rectangle;
      end;
   end;

end; // TBetterDBGrid.Depress_Button_If_Point_In_Title_Button.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.MouseDown( {input} Button: TMouseButton;
                                   {input} Shift:  TShiftState;
                                   {input} X:      integer;
                                   {input} Y:      integer);

// If a title button was clicked, record the column field name and the clicked-button rectangle. Otherwise, call the inheried
// method. Note that Depress_Button_If_Point_In_Title_Button may set ClickedColumn.

var
   Cell: TGridCoord;

begin

   Cell          := MouseCoord( X, Y );
   ClickedColumn := nil;

   if self.Title_Buttons_Active and self.AcquireFocus and not ( csDesigning in ComponentState ) and not EditorMode
   and ( Button = mbLeft ) and not ( ssDouble in Shift ) and ( Cell.X >= IndicatorOffset ) and ( Cell.Y = TitleRow ) then

      self.Depress_Button_If_Point_In_Title_Button( Point( X, Y ), Columns[ self.RawToDataColumn( Cell.X ) ] );

   if not assigned( ClickedColumn ) then
      inherited;

end; // TBetterDBGrid.MouseDown.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.MouseMove( {input} Shift: TShiftState;
                                   {input} X:     integer;
                                   {input} Y:     integer );

// If the mouse was moved into or out of the clicked button, redraw the button.

begin

   if assigned( ClickedColumn ) and ( Clicked_Button_Down <> PtInRect( Clicked_Button_Rect, Point( X, Y ) ) ) then begin
      Clicked_Button_Down := PtInRect( Clicked_Button_Rect, Point( X, Y ) );
      self.Invalidate_Clicked_Button_Rectangle;
   end;

   inherited;

end; // TBetterDBGrid.MouseMove.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.MouseUp.
//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.Sort_Data_And_Call_Title_Click_Event.
//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Call_Title_Click_Event( {update} Column: TColumn );

// If there is an OnTitleClick event, call it. The TDBGrid.TitleClick method only calls the event if dgTitleClick is in Options,
// but we want to call it if the user clicks one of our buttons or uses the title accelerator key.

begin

   if assigned( OnTitleClick ) then
      OnTitleClick( Column );

end; // TBetterDBGrid.Call_Title_Click_Event.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.Sort_Data_And_Call_Title_Click_Event( {update} Column: TColumn );

// Sort the data set on the field corresponding to the specified column. Call the OnTitleClick event. However, if the data set is
// already sorted on the field, do nothing.

begin

   if Column.FieldName <> Private_Sort_Field then begin
      self.Sort_Data_Set(          Column.FieldName );
      self.Call_Title_Click_Event( Column );
   end;

end; // TBetterDBGrid.Sort_Data_And_Call_Title_Click_Event.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.MouseUp( {input} Button: TMouseButton;
                                 {input} Shift:  TShiftState;
                                 {input} X:      integer;
                                 {input} Y:      integer );

// If a title button was clicked, sort the data set on the clicked column. Call the inherited method. We clear ClickedColumn before
// calling the methods that may redraw the title buttons because its value is checked by the DrawButton method.

var
   C: TColumn;

begin

   if assigned( ClickedColumn ) then begin
      C             := ClickedColumn;
      ClickedColumn := nil;

      if PtInRect( Clicked_Button_Rect, Point( X, Y ) ) then
         self.Sort_Data_And_Call_Title_Click_Event( C )

      else if Clicked_Button_Down then
         self.Invalidate_Clicked_Button_Rectangle;
   end;

   inherited;

end; // TBetterDBGrid.MouseUp.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.CMDialogChar.
//---------------------------------------------------------------------------------------------------------------------------------

function TBetterDBGrid.Accelerator_Column_Index( const Key: word ): ExtListIndex;

// Return the column index that has the specified key as its accelerator key, if any. If the title buttons aren't active, then
// return No_List_Index.

var
   J: ExtListIndex;

begin

   result := No_List_Index;

   if self.Title_Buttons_Active then
      for J := First_List_Index to Last_List_Index( Columns.Count ) do
         if ( result = No_List_Index ) and IsAccel( Key, Columns[ J ].Title.Caption ) then
            result := J;

end; // TBetterDBGrid.Accelerator_Column_Index.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.CMDialogChar( var Message: TCMDialogChar );

// This method will be called if the user types an accelerator key. Accelerator keys are Alt plus a character or, if the control
// with focus doesn't want characters, just the character without Alt. Check whether the key is the accelerator for any of the
// column titles. If so, sort on the column and call the OnTitleClick event. Do not set focus to the grid (so the user can sort the
// grid while another control retains the focus).

var
   ColumnIndex: ExtListIndex;

begin

   ColumnIndex := self.Accelerator_Column_Index( Message.CharCode );

   if ( ColumnIndex <> No_List_Index ) and self.CanFocus and not EditorMode then begin
      self.Sort_Data_And_Call_Title_Click_Event( Columns[ ColumnIndex ] );
      Message.Result := 1;

   end else
      inherited;

end; // TBetterDBGrid.CMDialogChar.

//---------------------------------------------------------------------------------------------------------------------------------
// Start of procedures used by TBetterDBGrid.HandleAccelerator.
//---------------------------------------------------------------------------------------------------------------------------------

function Key_Code_For_Character( const Key: char ): word;

// Return the virtual key code for the specified character. Since we are converting to a key code, the character should be ASCII.

begin

   result := ord( UpCase( Key ) );

end; // Key_Code_For_Character.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterDBGrid.HandleAccelerator( var Key: char );

// If the specified key is the accelerator key for a column title, sort on the column and call the OnTitleClick event. This method
// may be called in another control's OnKeyPress event if you want the user to be able to use the grid's accelerator key without
// pressing Alt, but Windows thinks the other control wants the key, e.g., TRzNumericEdit.

var
   ColumnIndex: ExtListIndex;

begin

   ColumnIndex := self.Accelerator_Column_Index( Key_Code_For_Character( Key ) );

   if ( ColumnIndex <> No_List_Index ) and self.CanFocus and not EditorMode then begin
      self.Sort_Data_And_Call_Title_Click_Event( Columns[ ColumnIndex ] );
      Key := NoKey;
   end;

end; // TBetterDBGrid.HandleAccelerator.

//---------------------------------------------------------------------------------------------------------------------------------

function TBetterDBGrid.SortField: string;

// Return the name of the field that the grid is currently sorted on.

begin

   result := Private_Sort_Field;

end; // TBetterDBGrid.SortField.

//---------------------------------------------------------------------------------------------------------------------------------

procedure TBetterNavigator.BtnClick( {input} Index: TRzNavigatorButton );

// Call the BeforeClick event. If the BeforeClick event sets OK to false, then don't call the inherited method. Raize's navigator
// doesn't let you say you don't want to navigate (since the NavBtn parameter has to have some value). This lets you abort a
// navigate action, if you want to.

var
   OK: boolean;

begin

   OK := true;

   if assigned( Before_Click_Method ) then
      Before_Click_Method( self, OK );

   if OK then
      inherited;

end; // TBetterNavigator.BtnClick.

//---------------------------------------------------------------------------------------------------------------------------------
end. // DavidMarcusGridComponentsXE2.
//---------------------------------------------------------------------------------------------------------------------------------


[Raize Support]

Hi David,

Thanks for your contribution!

Ray