Quitar borde de selección a TStringGrid

[Catublipas]

Buenas tardes,
tengo un pequeño problemilla estoy seguro que podéis resolverlo. Me gustaría quitarle el borde que se genera alrededor de una celda que tienes seleccionada, en mi caso es un borde punteado.

Esta es la captura:
http://es.zimagez.com/zimage/captura440.php

No se si se puede eliminar o cambiar el color, lo pondría del mismo color que el relleno y sobraría.
Muchas gracias por vuestra ayuda.
Un saludo!

[ecfisa]

Hola Catublipas.
...
Me gustaría quitarle el borde que se genera alrededor de una celda que tienes seleccionada, en mi caso es un borde punteado.
...


Fijate si te sirve de este modo:

...
type
TStringGrid = class(Grids.TStringGrid)
protected
procedure Paint; override;
end;

TForm1 = class(TForm)
StringGrid1: TStringGrid;
...
end;

var
Form1: TForm1;

implementation

{ TStringgrid }
procedure TStringGrid.Paint;
var
R: TRect;
begin
inherited;
R := CellRect(Col, Row);
DrawFocusRect(Canvas.Handle, R);
end;
...


Saludos :)

[Catublipas]

Buenas ecfisa,
gracias por tu respuesta pero no consigo implementarla, no me reconoce Grids.TStringGrid ni el método paint tampoco.
¿Cómo implemento el método?

Muchas gracias de nuevo!

[AgustinOrtu]

Firemonkey o VCL?

[Catublipas]

Estoy programandolo en VCL Form :P.

[ecfisa]

Hola Catublipas.
Buenas ecfisa,
gracias por tu respuesta pero no consigo implementarla, no me reconoce Grids.TStringGrid ni el método paint tampoco.
¿Cómo implemento el método?

Muchas gracias de nuevo!
Uso una versión antigua de Delphi como para probarlo, pero por las dudas intentá de este modo:

type
TStringGrid = class(Vcl.Grids.TStringGrid)
...


Saludos :)

[Catublipas]

Buenas ecfisa efectivamente con esto me deja pero me da los siguientes errores en el procedimiento procedure TStringGrid.Paint;


[dcc32 Error] Empresas.pas(171): E2003 Undeclared identifier: 'Paint'
[dcc32 Error] Empresas.pas(173): E2075 This form of method call only allowed in methods of derived types
[dcc32 Error] Empresas.pas(174): E2003 Undeclared identifier: 'CellRect'
[dcc32 Error] Empresas.pas(174): E2003 Undeclared identifier: 'Row'
[dcc32 Error] Empresas.pas(175): E2003 Undeclared identifier: 'Canvas'
[dcc32 Error] Empresas.pas(175): E2029 'END' expected but ',' found
[dcc32 Error] Empresas.pas(151): E2065 Unsatisfied forward or external declaration: 'TEmpresasForm.Paint'
[dcc32 Fatal Error] F2063 Could not compile used unit 'Empresas.pas'

muchas gracias de nuevo!

[Casimiro Notevi]

Pon tu código.

[Catublipas]

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Imaging.pngimage,
Vcl.StdCtrls, Vcl.PlatformDefaultStyleActnCtrls, Vcl.Menus, Vcl.ActnPopup,
Vcl.StdStyleActnCtrls, Vcl.ToolWin, Vcl.ActnMan, Vcl.ActnCtrls, Vcl.ActnMenus,
System.Actions, Vcl.ActnList, Vcl.Grids, Vcl.DBGrids, Vcl.DBCGrids, Data.DB,
IBX.IBCustomDataSet, IBX.IBQuery;

type
TStringGrid = class(Vcl.Grids.TStringGrid);
TEmpresasForm = class(TForm)
...
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure StringGridContactosDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure Paint; override;

private
{ Private declarations }
public
{ Public declarations }
end;

var
EmpresasForm: TEmpresasForm;
iterador:Integer;
R: TRect;

implementation

{$R *.dfm}

uses Login, FondoOscurecer, AnadirEmpresa, Contactos;
{ TStringgrid }
procedure TStringGrid.Paint;
begin
inherited;
R := CellRect(Col, Row);
DrawFocusRect(Canvas.Handle, R);
end;
...

[ecfisa]

Hola Catublipas.

Lo que sucede que has copiado mal...

Esta es tu declaración de TStringGrid:

...
type
TStringGrid = class(Vcl.Grids.TStringGrid);
TEmpresasForm = class(TForm)
...


Sin embargo, la propuesta que te hice era:


...
type
TStringGrid = class(Grids.TStringGrid)
protected
procedure Paint; override;
end;
TForm1 = class(TForm)
...

Por último te sugerí la reforma del mensaje #6 (http://www.clubdelphi.com/foros/showpost.php?p=502378&postcount=6)

Creo que el código final debería ser algo como esto:

...
type
TStringGrid = class(Vcl.Grids.TStringGrid)
protected
procedure Paint; override;
end;
TEmpresasForm = class(TForm)
...

implementation

procedure TStringGrid.Paint;
var
R: TRect;
begin
inherited;
R := CellRect(Col, Row);
DrawFocusRect(Canvas.Handle, R);
end;
...


Saludos :)

[AgustinOrtu]

Otra alternativa es, si tu Delphi soporta los class helpers, es esto:


type
TStringGridHelper = class helper for TStringGrid
public
procedure Paint; override;
end;


Luego, podes implementar el metodo Paint;

Los class helper se agregaron justamente para no seguir utilizando el "truco" de la interposer class y resolver este tipo de problemas (acceder a funcionalidad protegida de una clase) de una manera mas elegante

[Catublipas]

Buenas, os comento

he probado las dos maneras la respuesta de ecfisa me da error en la declaracion del procedimiento Paint. Y he probado la respuesta de AgustinOrtu que no me da error en la declaracion de la clase TStringGrid pero me da el siguiente error:

[dcc32 Error] Empresas.pas(16): E2137 Method 'Paint' not found in base class

Uso Delphi xe7 ¿tiene algo que ver?

[ecfisa]

Hola Catublipas...
Uso Delphi xe7 ¿tiene algo que ver?
Por los motivos que te expuse no puedo asegurarlo, pero es una posibilidad.

Para salir de dudas, proba este ejemplo que funciona correctamente en Delphi 7:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, Menus, XPMan;

type
TStringGrid = class(Grids.TStringGrid) // class(Vcl.Grids.TStringGrid) para tu caso
private
FBorde: Boolean;
protected
procedure Paint; override;
public
property Borde: Boolean read FBorde write FBorde default False;
end;

TForm1 = class(TForm)
StringGrid1: TStringGrid;
PopupMenu1: TPopupMenu;
MenuItemBorde: TMenuItem;
XPManifest1: TXPManifest;
procedure FormCreate(Sender: TObject);
procedure MenuItemBordeClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation {$R *.dfm}

{ TStringGrid }
procedure TStringGrid.Paint;
var
R: TRect;
begin
inherited;
if not FBorde then
begin
R := CellRect(Col, Row);
DrawFocusRect(Canvas.Handle, R);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
c, r: Integer;
sg : TStringGrid;
begin
sg := StringGrid1;
// títulos de columnas y filas
sg.Rows[0].CommaText := ',Col1,Col2,Col3,Col4,Col5';
for r := 1 to sg.RowCount - 1 do
sg.Cells[0, r] := Format('Fil%d',[r]);

// algunos valores al StringGrid
for c := sg.FixedCols to sg.ColCount - 1 do
for r := sg.FixedRows to sg.RowCount - 1 do
sg.Cells[c,r] := IntToStr(c+r);

sg.PopupMenu := PopupMenu1;
sg.Borde := True; // StringGrid inicia con borde
end;

// PopupMenu-ItemBorde
procedure TForm1.MenuItemBordeClick(Sender: TObject);
const
TXT: array[Boolean] of string = ('Poner borde', 'Quitar borde');
begin
StringGrid1.Borde := not StringGrid1.Borde;
MenuItemBorde.Checked := StringGrid1.Borde;
MenuItemBorde.Caption := TXT[StringGrid1.Borde];
StringGrid1.Refresh;
end;

end.


Muestra:
http://s28.postimg.org/9psqx237h/Catublipas.gif

Saludos :)

[Catublipas]

Buenas ecfisa,
me ha funcionado al parecer me faltaba incorporar la libreria Vcl.grids, ya no me da el error pero no me quita el borde.
Es posible que sea porque el StringGrid lo he creado en tiempo de diseño, o ¿no tiene nada que ver?
Muchas gracias de veras por vuestra ayuda de nuevo! :)

[ecfisa]

Buenas ecfisa,
me ha funcionado al parecer me faltaba incorporar la libreria Vcl.grids, ya no me da el error pero no me quita el borde.
Es posible que sea porque el StringGrid lo he creado en tiempo de diseño, o ¿no tiene nada que ver?
Muchas gracias de veras por vuestra ayuda de nuevo! :)
No me parece... controla que la declaración:

type
TStringGrid = class(Vcl.Grids.TStringGrid)
...

preceda (esté mas arriba) a la definición de la variable de tipo TStringGrid que uses en el formulario.

Otra opción es que hagas una nueva unidad,

unit Unit2;

interface

uses Windows, Types, Grids; // Vcl.Grids, etc, etc

type
TStringGrid = class(Grids.TStringGrid) // class(Vcl.Grids.TStringGrid)
private
FBorde: Boolean;
protected
procedure Paint; override;
public
property Borde: Boolean read FBorde write FBorde default False;
end;

implementation

{ TStringGrid }
procedure TStringGrid.Paint;
var
R: TRect;
begin
inherited;
if not FBorde then
begin
R := CellRect(Col, Row);
DrawFocusRect(Canvas.Handle, R);
end;
end;
end.

y luego en el formulario en que la vayas a usar la incluyas en la última posición en el uses de la sección interface:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, Grids, Unit2; // <- Última en ser incluída

type
// (Ya no se necesita la declaración por la inclusión de Unit2)
TEmpresasForm = class(TForm)
...


Nota: Para todos los casos toma en cuenta las diferencias que tiene Delphi XE7 con Delphi 7 cuando se hace referencia a las unidades y clases, vg.:

Delphi 7 : Grids.TStringGrid
Delphi XE7 : Vcl.Grids.TStringGrid


Saludos :)

[Catublipas]

Perdón corrijo, no termina de quitar el borde jajajaja.
Os paso las imagenes a ver si se os ocurre algo.

[Catublipas]

He probado creando la unidad nueva, hago referencia en la otra unidad y sigo en las mismas, no me da problemas, pero sigue sin quitar el borde.
Por cierto he probado a desactivar Default Drawing pero es un caos aunque si que quita el borde, pero se desconfigura todo.

[ecfisa]

La verdad, estoy imposibilitado de probar el código sobre XE7 así que ando a tientas :(.

Lo último que se me ocurre es que pruebes calificando la función DrawFocusRect:

{ TStringGrid }
procedure TStringGrid.Paint;
var
R: TRect;
begin
inherited;
if not FBorde then
begin
R := CellRect(Col, Row);
Windows.DrawFocusRect(Canvas.Handle, R); // ( también prueba con: Canvas.DrawFocusRect(R); )
end;
end;


Saludos :)

[Catublipas]

Ecfisa funciona perfecto, he hecho lo que has puesto y he desactivado el Default Drawing y va clavado!
Muchas gracias de nuevo!:)

Un saludo!