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}
procedure SetSubCass(WC: TWinControl; newProc: TWndMethod; var oldProc: TWndMethod);
begin
oldProc:= WC.WindowProc;
WC.WindowProc:= newProc;
end;
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);
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));
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
if CheckBox1.Checked then
SetSubCass(Edit1, SubClassWndProc, oldWndProc)
else
Edit1.WindowProc:= oldWndProc;
Edit1.Repaint;
end;
procedure TForm1.CheckBox2Click(Sender: TObject);
begin
Edit1.Enabled:= CheckBox2.Checked;
end;
end.
Saludos.