Resaltar TEXTO parcialmente en DBGrid

[Jose Roman]

Hola a todos,

En este truco 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".

[Jose Roman]

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

[Jose Roman]

Empezado por Casimiro Notevi

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

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


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

Código Delphi [-]
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:

Código Delphi [-]
  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.

Código Delphi [-]
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.

Saludos.