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; |
{ 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; |
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.
Descargar
