Inicio > Delphi, Trucos > Dibujar una flecha (ordenación) en el título de un DBGrid

Dibujar una flecha (ordenación) en el título de un DBGrid

Share Button

A veces nos puede interesar dibujar en el título de un DBGrid una flecha para indicar la ordenación ASCENDENTE o DESCENDENTE sobre esa columna; De forma muy similar a como se muesta aquí, se pueden dibujar otros símbolos e incluso colocar imágenes.

Para conseguir ésto se debe derivar el componente de DBGrid estandard y añadir los dos métodos de dibujo a la parte privada:

{ Private declarations }
procedure __PaintArrowUp(Canvas: TCanvas; var Rect: TRect);
procedure __PaintArrowDown(Canvas: TCanvas; var Rect: TRect);
 
....y la implementación....
 
// Dibuja la línea hacia abajo
procedure TNeftaliDBGrid.__PaintArrowDown(Canvas: TCanvas; var Rect: TRect);
var
  APolyLine: Array[0..2] of TPoint;
  SaveCol, BrushCol : TColor;
begin
  // Utilizamos el canvas pasado como parámetro
  with Canvas do begin
    // Guardar los valores actuales
    SaveCol := Pen.Color;
    BrushCol := Brush.Color;
    // Activar los nuevos valores depintado
    Brush.Style := bsSolid;
    Pen.Color := Self.FixedColor;
    Brush.Color := Self.FixedColor;
    // Dibujar un rectágulo debajo para tapar el título
    Rectangle(Rect.Right-13, Rect.Top+3, Rect.Right-1, Rect.Top+15);
    // Dibujamos la flecha
    Pen.Color := clGray{clBlack};
    APolyLine[0]:=Point(Rect.Right-4, Rect.Top+5);
    APolyLine[1]:=Point(Rect.Right-11, Rect.Top+5);
    APolyLine[2]:=Point(Rect.Right-8, Rect.Top+11);
    PolyLine(APolyLine);
    Pen.Color := clWhite;
    MoveTo(Rect.Right-7, Rect.Top+11);
    LineTo(Rect.Right-4, Rect.Top+5);
    // Restaurar valores guardados
    Brush.Color := BrushCol;
    Pen.Color := SaveCol;
  end;
end;
 
// Dibuja la línea hacia arriba
procedure TNeftaliDBGrid.__PaintArrowUp(Canvas: TCanvas; var Rect: TRect);
var
  SaveCol, BrushCol : TColor;
begin
  // Utilizamos el canvas pasado por parámetro.
  with Canvas do begin
    // Guardar los valores de los colores
    SaveCol := Pen.Color;
    BrushCol := Brush.Color;
    // Nuevo estilo de pintado.
    Brush.Style := bsSolid;
    Pen.Color := Self.FixedColor;
    Brush.Color := Self.FixedColor;
    // Rectangulo por debajo para tapar el título
    Rectangle(Rect.Right-13, Rect.Top+3, Rect.Right-1, Rect.Top+15);
    // Dibujar la flacha
    Pen.Color := clGray{clBlack};
    MoveTo(Rect.Right-11, Rect.Top+11);
    LineTo(Rect.Right-8, Rect.Top+5);
    LineTo(Rect.Right-7, Rect.Top+5);
    Pen.Color:=clWhite;
    MoveTo(Rect.Right-7, Rect.Top+5);
    LineTo(Rect.Right-4, Rect.Top+11);
    LineTo(Rect.Right-11, Rect.Top+11);
    //Restaurar los colores
    Brush.Color := BrushCol;
    Pen.Color := SaveCol;
  end;
end;

Para poder pintar la flecha cuando te interese se debe redefinir el método para dibujar una celda existente en el TCustomDBGrid llamado DrawCell del componente de DBGrid estandard y añadir los dos métodos de dibujo a la parte privada:

procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
	            AState: TGridDrawState); override;
 
....y su implementación...
 
// Método para pintar una celda del DBGrid
procedure TNeftaliDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
	    AState: TGridDrawState);
begin
  inherited; // Importante la llamada al inherited
 
  // No es fila de títulos?
  if (ARow <> 0) then begin
    Exit;
  end;
 
  // Columna 3 (por ejemplo)
  if (ACol = 3) then begin
    __PaintArrowUp(Canvas, ARect);
  end;
 
  // Columna 4 (por ejemplo)
  if (ACol = 4) then begin
    __PaintArrowDown(Canvas, ARect);
  end;
end;

Y en la implementacion se hacen las comprobaciones de fila y columna, para que sólo pinte las flechas en la fila de títulos y en la columna que se desee. En éste ejemplo las columnas están como constantes, pero posiblemente se deberán obtener a partir de alguna variable/propiedad (por ejemplo la que el usuario pulse con el ratón. Puedes descargar el código de ejemplo del componente.

Download Descargar

Vota este post
Categories: Delphi, Trucos Tags: , , ,
  1. Luis Roberto Lezama
    miércoles, 26 de agosto de 2009 a las 18:21 | #1

    esta genial tu componente y me tomé la libertad de modificarle un par de cosas, como por ejemplo que se marque la flecha en base a la columna donde demos click en el título y agregue la propiedad de ColumnSortColor, para que se marque la columna seleccionada del color que queramos.

    te anexo todo el código por si sirve de algo.

    P.D. Le cambie el nombre al componente por TSortDBGrid (sorry, es como más generico el nombre)

    unit SortDBGrid;

    interface

    uses
    SysUtils, Classes, Controls, Grids, DBGrids, Graphics, Types;

    type
    TSortDBGrid = class(TDBGrid)
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    private
    { Private declarations }
    FColumnSort : Integer;
    FColumnSortDown : Boolean;
    FColumnSortColor : TColor;
    procedure __PaintArrowUp(Canvas: TCanvas; var Rect: TRect);
    procedure __PaintArrowDown(Canvas: TCanvas; var Rect: TRect);
    protected
    { Protected declarations }
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    procedure TitleClick(Column: TColumn); override;
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); override;
    public
    { Public declarations }
    property SortDescending : Boolean read FColumnSortDown;
    published
    { Published declarations }
    property ColumnSortColor : TColor read FColumnSortColor write FColumnSortColor;
    end;

    procedure Register;

    implementation

    procedure Register;
    begin
    RegisterComponents(‘kensei’, [TSortDBGrid]);
    end;

    { TSortDBGrid }

    {——————————————————————————}
    constructor TSortDBGrid.Create(AOwner: TComponent);
    begin
    inherited;
    FColumnSort := -1;
    FColumnSortDown := True;
    FColumnSortColor := Self.Color;
    end;
    {——————————————————————————}

    {——————————————————————————}
    destructor TSortDBGrid.Destroy;
    begin
    inherited Destroy;
    end;
    {——————————————————————————}

    {——————————————————————————}
    procedure TSortDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
    begin
    inherited;
    // No es fila de títulos?
    if (ARow 0) then begin
    Exit;
    end;

    if (FColumnSort >= 0) then begin
    if (ACol = FColumnSort + 1) then
    if FColumnSortDown then
    __PaintArrowDown(Canvas, ARect)
    else __PaintArrowUp(Canvas, ARect);
    end;
    end;
    {——————————————————————————}

    {——————————————————————————}
    procedure TSortDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
    begin
    inherited;
    if (FColumnSort >= 0) then begin
    if DataCol = FColumnSort then
    Column.Color := FColumnSortColor
    else Column.Color := clWindow;
    end;
    DefaultDrawColumnCell(rect,DataCol,Column,State)
    end;
    {——————————————————————————}

    {——————————————————————————}
    procedure TSortDBGrid.TitleClick(Column: TColumn);
    begin
    inherited;
    FColumnSort := Column.Index;
    FColumnSortDown := not FColumnSortDown;
    Repaint;
    end;
    {——————————————————————————}

    {——————————————————————————}
    procedure TSortDBGrid.__PaintArrowDown(Canvas: TCanvas; var Rect: TRect);
    var
    APolyLine: Array[0..2] of TPoint;
    SaveCol, BrushCol : TColor;
    begin

    // Utilizamos el canvas pasado como parámetro
    with Canvas do begin

    // Guardar los valores actuales
    SaveCol := Pen.Color;
    BrushCol := Brush.Color;

    // Activar los nuevos valores depintado
    Brush.Style := bsSolid;
    Pen.Color := Self.FixedColor;
    Brush.Color := Self.FixedColor;

    // Dibujar un rectágulo debajo para tapar el título
    Rectangle(Rect.Right-13, Rect.Top+3, Rect.Right-1, Rect.Top+15);

    // Dibujamos la flecha
    Pen.Color := clGray{clBlack};
    APolyLine[0]:=Point(Rect.Right-4, Rect.Top+5);
    APolyLine[1]:=Point(Rect.Right-11, Rect.Top+5);
    APolyLine[2]:=Point(Rect.Right-8, Rect.Top+11);
    PolyLine(APolyLine);
    Pen.Color := clWhite;
    MoveTo(Rect.Right-7, Rect.Top+11);
    LineTo(Rect.Right-4, Rect.Top+5);

    // Restaurar valores guardados
    Brush.Color := BrushCol;
    Pen.Color := SaveCol;

    end;
    end;
    {——————————————————————————}

    {——————————————————————————}
    procedure TSortDBGrid.__PaintArrowUp(Canvas: TCanvas; var Rect: TRect);
    var
    SaveCol, BrushCol : TColor;
    begin

    // Utilizamos el canvas pasado por parámetro.
    with Canvas do begin

    // Guardar los valores de los colores
    SaveCol := Pen.Color;
    BrushCol := Brush.Color;

    // Nuevo estilo de pintado.
    Brush.Style := bsSolid;
    Pen.Color := Self.FixedColor;
    Brush.Color := Self.FixedColor;

    // Rectangulo por debajo para tapar el título
    Rectangle(Rect.Right-13, Rect.Top+3, Rect.Right-1, Rect.Top+15);

    // Dibujar la flacha
    Pen.Color := clGray{clBlack};
    MoveTo(Rect.Right-11, Rect.Top+11);
    LineTo(Rect.Right-8, Rect.Top+5);
    LineTo(Rect.Right-7, Rect.Top+5);
    Pen.Color:=clWhite;
    MoveTo(Rect.Right-7, Rect.Top+5);
    LineTo(Rect.Right-4, Rect.Top+11);
    LineTo(Rect.Right-11, Rect.Top+11);

    //Restaurar los colores
    Brush.Color := BrushCol;
    Pen.Color := SaveCol;

    end;
    end;
    {——————————————————————————}

    end.

  2. Neftalí
    domingo, 30 de agosto de 2009 a las 19:36 | #2

    @Luis Roberto Lezama

    Gracias Luis Roberto.
    Por ahora estoy de vacaciones, cuando vuelva lo reviso.

    Un saludo.

  3. Mongiel
    martes, 1 de septiembre de 2009 a las 00:02 | #3

    @Neftalí

    @Luis Roberto Lezama
    Hola buenas tardes, me gustaria saber como instalo ese componente ya que soy nuevo en delphi. Te agradesco tu ayuda. Gracias

    Saludos!

  4. Neftalí
    lunes, 7 de septiembre de 2009 a las 11:28 | #4

    @Mongiel

    Lo normal es crear un package nuevo, añadir la unit del componente, compilarlo, linkarlo e instalarlo.

    File/New/Other => Desde aquí crear es package.
    Add para añadirle la unit.

    un saludo.

  5. Chris
    lunes, 10 de enero de 2011 a las 18:33 | #5

    Hola Neftali, te sigo desde hace muchos años, pero nunca participe activamente, pues voy tomando experiencia. Perdon por escribir esta pregunta en este articulo, pero es el mejor que encontre. Procedo a la pregunta:

    Necesito imprimir un DBGrid a modo de reporte desde QuickReport pero de manera automatica, es decir, necesito una rutina que tome un DBGrid y pueda armar la vista previa en QR. He realizado varias pruebas, pero tengo problemas con la visibilidad de las columnas, pues toma si esta o no visible dependiendo de la pantalla y no de la existencia de la columna… no se si soy claro?

    Aguando tu resp.
    Abrazo desde Argentina

    PS: maravillosos los articulos de GoogleMap.!

  6. Neftalí
    lunes, 10 de enero de 2011 a las 21:39 | #6

    Hola.
    ¿A la propiedad Visible no le hace caso? ¿Esa generacion se hace automática o de forma manual?
    ¿Puedes modificar el ancho de las columnas? Una opción sería definir columnas de ancho 0.

    Si tienes más dudas te recomiendo que visites los foros del ClubDelphi. Hay mucha gente que te pouede ayudar, además de mi.

    Un saludo.

  7. Victor
    martes, 8 de octubre de 2013 a las 02:26 | #7

    MuchÃ?��Ã?�Ã?­simas gracias!!Para usarlo hice lo siguiente:DeclarÃ?��Ã?�Ã?© dos variables el la parte Public del componente: public { Public declarations } Dir: Boolean; //Para darle la direcciÃ?��Ã?�Ã?³n a la flecha Col: Byte; //Para decirle en cual columna dibujarla published { Published declarations } end;Luego adaptÃ?��Ã?�Ã?© DrawCell a mis necesidades:procedure TNeftaliDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);begin inherited; // No es fila de tÃ?��Ã?�Ã?­tulos? if (ARow 0) then Exit; if (ACol 0) and (ACol = Col) then if dir then __PaintArrowDown(Canvas, ARect) else __PaintArrowUp(Canvas, ARect) { // Columna 3 (por ejemplo) if (ACol = 1) then __PaintArrowUp(Canvas, ARect); // Columna 4 (por ejemplo) if (ACol = 2) then __PaintArrowDown(Canvas, ARect); }end;Por Ã?��Ã?�Ã?ºltimo, al hacer click en cada columna del componente en mi aplicaciÃ?��Ã?�Ã?³n:var DirOrd: Array[0..2] of boolean = (False, True, True); //Estado inicial //de las tres columnas de mi tabla, por defecto se ordena por el campo //ID (primer campo). // el componente lo renombrÃ?��Ã?�Ã?© como DBGrid1, para coincidencia con otras // funciones ya existentesprocedure TForm2.DBGrid1TitleClick(Column: TColumn);begin ClientModule1.SqlServerMethod1.ServerMethodName := \\\\’TServerMethods1.Ordenar\\\\’; ClientModule1.SqlServerMethod1.ParamByName(\\\\’Campo\\\\’).AsString := Column.FieldName; DBGrid1.Col := Column.ID + 1; if Column.FieldName = \\\\’ID\\\\’ then begin DirOrd[0] := not DirOrd[0]; ClientModule1.SqlServerMethod1.ParamByName(\\\\’bDir\\\\’).AsBoolean := DirOrd[0]; DBGrid1.Dir := DirOrd[0] end else if Column.FieldName = \\\\’CUIL\\\\’ then begin DirOrd[1] := not DirOrd[1]; ClientModule1.SqlServerMethod1.ParamByName(\\\\’bDir\\\\’).AsBoolean := DirOrd[1]; DBGrid1.Dir := DirOrd[1] end else if Column.FieldName = \\\\’NOMBRE\\\\’ then begin DirOrd[2] := not DirOrd[2]; ClientModule1.SqlServerMethod1.ParamByName(\\\\’bDir\\\\’).AsBoolean := DirOrd[2]; DBGrid1.Dir := DirOrd[2] end; ClientModule1.SqlServerMethod1.ExecuteMethod; //La sentencia SQL de //ordenaciÃ?��Ã?�Ã?³n se encuenta en el servidor Actualizarend;Solo una pregunta, como soy un poquitÃ?��Ã?�Ã?­n corto de vista… cÃ?��Ã?�Ã?³mo dibujo las flechitas un poquito mÃ?��Ã?�Ã?¡s anchas??Gracias de nuevo por esto y todo lo que encuentro tuyo en la red

  8. Gonzalo
    domingo, 7 de septiembre de 2014 a las 14:46 | #8

    Hola! Como puedo instalar y usar esto? Me lo podrías explicar detalladamente? Muchisimas gracias por esto y por todo lo que publicas aqui y en clubdelphi.

  9. Neftalí
    lunes, 8 de septiembre de 2014 a las 08:43 | #9

    @Gonzalo
    Hola Gonzalo.
    Tal y como se explica en el artículo, debes crear un nuevo componente derivado de un TDBGrid y en él implementar el código del artículo.

    Para el tema de derivar componentes y crear nuevos puedes encontrar muchos artículos en internet que te explican cómo hacerlo. Crearlos e instalarlos.

    Un saludo.

  1. Sin trackbacks aún.