Resaltar TEXTO parcialmente en DBGrid

[Jose Roman]

Hola a todos,

En este truco (https://www.clubdelphi.com/foros/showthread.php?t=90619) hay un codigo fuente donde se resalta un texto de un DBGrid que se hace un una busqueda, me gustaria saber si alguien me puede colaborar con un ejemplo de ello, como no soy muy experto no he podido hacer que me funcione.

Gracias de antemano.

[Casimiro Notevi]

Jose Roman, ¿qué problema has tenido? ¿qué error te sale?
¿Qué código estás usando?

[Jose Roman]

Hola Casimiro, el código lo copio al igual que deduzco que poner el USES, lo que no se es como llamar el procedimiento para que funcione con en evento OnKeyPress de un TEdit, también dicen que debo activar en Options ciertas cosas, pero al hacerlo ya no veo los datos, cabe resaltar que utilizo UNIDAT y MySql con delphi Rio, me disculpan pero esto lo escribí desde mi móvil y no se que hice que se duplicó y no se cómo borrar lo anterior.

[Casimiro Notevi]

Pues haces click en el tedit, y en la pestaña "Eventos" haces doble click sobre "onKeypress".

https://i.imgur.com/tUXCXbu.png

[Jose Roman]

Gracias, pero en la descripción habla de SearchString, la cual no veo como asignar el valor del TEdit.

[Jose Roman]

Pues haces click en el tedit, y en la pestaña "Eventos" haces doble click sobre "onKeypress".

https://i.imgur.com/tUXCXbu.png
Gracias Casimiro, quizas no explique bien, el evento OnKeyPress lo se implementar, mas lo que no se es como hacer para que el truco funcione dentro de este evento, a que variable le envio lo que haya en el TEdit.

[escafandra]

El truco al que te refieres utiliza el evento OnDrawColumnCell de un StringGrid. Tu te estas refiriendo a un TEdit que no tiene ese evento. En ese caso debes hacer un subclasing y capturar el mensaje WM_PAINT o escribir un componente derivado que pinte el texto a tu gusto. Ten en cuenta que lo que hay que hacer es pintar y eso hay que hacerlo cuando toca, es decir, cuando Windows va a pintar.


En cierta ocasión contesté una pregunta sobre cómo cambiar el texto cuando un EDIT está deshabilitado y puse un ejemplo de un nuevo componente derivado de TEdit aquí: cambiar fuente de TEdit en modo ReadOnly (https://cppbuilder.es/foros/viewtopic.php?t=15141&start=0&postdays=0&postorder=asc&highlight=)


Transcribo el código por si te sirve para tomar ideas de lo que tú luego realmente pretendas hacer:



unit NewEdit;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls;

type
TNewEdit = class(TEdit)
private
DColor: COLORREF;
protected
procedure WndProc(var Message: TMessage); override;
public
procedure SetDisableColor(Color: COLORREF);
published
{ Published declarations }
end;

procedure Register;

implementation

procedure TNewEdit.WndProc(var Message: TMessage);
var
ps: PAINTSTRUCT;
DC: HDC;
begin
if (Message.Msg = WM_PAINT) and (not IsWindowEnabled(Handle)) then
begin
DC:= BeginPaint(Handle, ps);
SetTextColor(DC, DColor);
SelectObject(DC, SendMessage(Handle, WM_GETFONT, 0, 0));
TextOutA(DC, 1,1, PChar(Text), Length(Text)+1);
EndPaint(Handle, ps);
end;
inherited WndProc(Message);
end;

procedure TNewEdit.SetDisableColor(Color: COLORREF);
begin
DColor:= Color;
Invalidate;
end;

procedure Register;
begin
RegisterComponents('Samples', [TNewEdit]);
end;

end.



La parte donde pinta el texto es esta:

if (Message.Msg = WM_PAINT) and (not IsWindowEnabled(Handle)) then
begin
DC:= BeginPaint(Handle, ps);
SetTextColor(DC, DColor);
SelectObject(DC, SendMessage(Handle, WM_GETFONT, 0, 0));
TextOutA(DC, 1,1, PChar(Text), Length(Text)+1);
EndPaint(Handle, ps);
end;


Como verás, este código no usa la VCL sino que está escrito con API de Windows. La condición para activar el pintado es indiferente, pones la que te haga falta y puedes complicar esa parte hasta donde llegue tu imaginación.

La técnica del Subclasing es buena idea si se va a hacer para casos aislados. En caso contrario es mejor escribir un componente.



Saludos.

[Jose Roman]

escafandra gracias bueno punto

[escafandra]

Para completar el tema he preparado un ejemplo usando subclassing en un Edit. El subclassing lo realizo estilo VCL con el procedimiento que adjunto SetSubCass


Se cambiará a color rojo la primera palabra del texto del Edit sólo si esta deshabilitado y el subclassing activo

Subo el código completo y el formulario queda como el de la imagen Gif que se muestra con su funcionalidad.



unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);

private
oldWndProc: TWndMethod;
public
procedure SubClassWndProc(var Message: TMessage);

end;

var
Form1: TForm1;

implementation

{$R *.dfm}

//---------------------------------------------------------------------------
// Realiza un subclassing estilo VCL
procedure SetSubCass(WC: TWinControl; newProc: TWndMethod; var oldProc: TWndMethod);
begin
oldProc:= WC.WindowProc;
WC.WindowProc:= newProc;
end;


//---------------------------------------------------------------------------
// CORAZÓN DEL ASUNTO

procedure TForm1.SubClassWndProc(var Message: TMessage);
var
ps: PAINTSTRUCT;
DC: HDC;
Size: TSize;
i: integer;
S: String;
begin
if (Message.Msg = WM_PAINT) and not Edit1.Enabled then
with Edit1 do
begin
DC:= BeginPaint(Handle, ps);
// Para la primera palabra del Edit.Text
SetTextColor(DC, clRed);
SelectObject(DC, SendMessage(Handle, WM_GETFONT, 0, 0));
i:= Pos(' ', Text);
if i = 0 then i:= Length(Text);
S:= Copy(Text, 1, i);
TextOutA(DC, 1,1, PChar(S), Length(S));
// Para el resto del Edit.Text
SetTextColor(DC, clBlack);
GetTextExtentPoint32(DC, PChar(S), Length(S), Size);
SelectObject(DC, SendMessage(Handle, WM_GETFONT, 0, 0));
S:= Copy(Text, i+1, Length(Text));
TextOutA(DC, Size.cx+1, 1, PChar(S), Length(S));

EndPaint(Handle, ps);
end;
oldWndProc(Message);
end;
//---------------------------------------------------------------------------


procedure TForm1.CheckBox1Click(Sender: TObject);
begin
// Hacemos el subclass
if CheckBox1.Checked then
SetSubCass(Edit1, SubClassWndProc, oldWndProc)
// Deshacemos el SubClass
else
Edit1.WindowProc:= oldWndProc;
Edit1.Repaint;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
Edit1.Enabled:= CheckBox2.Checked;
end;

end.







https://ibb.co/HNYjQWChttps://ibb.co/HNYjQWChttps://i.postimg.cc/XYxdvh6w/202212302231.gif






Saludos.