[Mendizabal]

Buenos días,

Estoy tratando de usar un DBRichText en un DBctrlGrid. Para ello, he hecho descender un componente propio heredando de un TCustomRichEdit. Mi problema es que cuando el DBctrlGrid me replica mi DBRichText, soy incapaz de conseguir que me muestre texto enriquecido en los DBRichtext sobre los que no tengo el "foco". Cuando digo "foco" me refiero a que el DBctrlGrid esté sobre un registro en concreto. No sé si me explico.

Texto plano sí que lo he logrado interceptado el WMPaint, pero mi problema es que necesito texto enriquecido.

Para mostrar texto plano la solución que he encontrado es usando los mensajes WM_Settext, WM_EraseBKGND y el propio WM_Paint. Estos mensajes utilizan el handle de un TPaintControl cuyo propietario es el propio componente tipo DBRichtext que estoy creando:

Código Delphi [-]
procedure TDBRichMemo.WMPaint(var Message: TWMPaint);
var
   strText: string;
begin
  inherited;
  strText := FDataLink.Field.DisplayText;

   SendMessage(FPaintControl.Handle, WM_SETTEXT, 0, Winapi.Windows.LPARAM(PChar(strText)));
   SendMessage(FPaintControl.Handle, WM_ERASEBKGND, Message.DC, 0);
   SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
end;

Hasta aquí bien, pero como ya dije lo que yo quiero es mostrar texto con formato. Al principio lo que probé es interpretar yo mismo el formato, y tratar de formatear el texto que se pinta en mi componente mediante el mensaje EM_SetCharFormat. Algo de este estilo (en este caso, sería solo para el color):

Código Delphi [-]
procedure TDBRichMemo.WMPaint(var Message: TWMPaint);
var
   strText: string;
   tFormat: TCharFormat2;
begin
  inherited;
  strText := FDataLink.Field.DisplayText;
 
  FillChar(tFormat,SizeOf(tFormat),0);
  tFormat.cbSize := SizeOf(tFormat);
  tFormat.crTextColor := ColorToRGB(255); //Aquí usaremos el color que toque
  tFormat.dwMask := CFM_COLOR;

  SendMessage(FPaintControl.Handle, EM_SETCHARFORMAT, 0, Longint(@tFormat));
  SendMessage(FPaintControl.Handle, WM_SETTEXT, 0, Winapi.Windows.LPARAM(PChar(strText)));
  SendMessage(FPaintControl.Handle, WM_ERASEBKGND, Message.DC, 0);
  SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
end;

Pero no funciona bien (únicamente serviría para colorear todo el texto), y además es muy tedioso de hacer. Esa solución es muy mala. Y además, como ya dije, no hace lo que necesito.

Luego traté mediante el mensaje EM_STREAMIN, pero tampoco lo logro. O se tira el texto contra sí mismo (replicándose infinitamente), o me lanza una excepción por tratar de acceder a un objeto que no existe. Os pongo algunos ejemplos de lo que he intentado, pero tampoco creo que sea el camino correcto:

Código Delphi [-]
procedure TDBRichMemo2.WMPaint(var Message: TWMPaint);
var
   Stream: TStringStream;
begin
  inherited;
  try
    Stream := TStringStream.Create(FDataLink.Field.AsString);
    SendMessage(FPaintControl.Handle, EM_STREAMIN,SF_RTF, LParam(@Stream));
    SendMessage(FPaintControl.Handle, WM_ERASEBKGND, Message.DC, 0);
    SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
  finally
    Stream.Free;
  end;
end;

Código Delphi [-]
procedure TDBRichMemo2.WMPaint(var Message: TWMPaint);
var
   rtfStream: TEditStream;
   sourceStream : TMemoryStream;
begin
  inherited;
  sourceStream := TMemoryStream.Create;
  try
    sourceStream := TStringStream.Create(Self.FDataLink.Field.AsString);
    sourceStream.Position := 0;
    rtfStream.dwCookie := DWORD_PTR(sourceStream) ;
    rtfStream.dwError := $0000;
    rtfStream.pfnCallback := @EditStreamReader;
    //Self.Lines.Clear;
    Self.Lines.BeginUpdate;
    Self.Perform(EM_STREAMIN, SFF_SELECTION or SF_RTF or SFF_PLAINRTF,
      LPARAM(@rtfStream));
    Self.Lines.EndUpdate;

  finally
    sourceStream.Free;
  end;
end;

function EditStreamReader( dwCookie: DWORD_PTR; pbBuff: PByte;
     cb: LongInt; var pcb: Longint): LongInt; stdcall;
begin
     result := $0000;
     try
       pcb := TStream(dwCookie).Read(pbBuff^, cb);
     except
       result := $FFFF;
     end;
end;

Código Delphi [-]
procedure TDBRichMemo2.WMPaint(var Message: TWMPaint);
var
   rtfStream: TEditStream;
   sourceStream : TMemoryStream;
begin
  inherited;
  sourceStream := TMemoryStream.Create;
  try
    sourceStream := TStringStream.Create(Self.FDataLink.Field.AsString);
    sourceStream.Position := 0;
    rtfStream.dwCookie := DWORD_PTR(sourceStream) ;
    rtfStream.dwError := $0000;
    rtfStream.pfnCallback := @EditStreamReader;

    SendMessage(FPaintControl.Handle, EM_STREAMIN,
      SFF_SELECTION or SF_RTF or SFF_PLAINRTF, LPARAM(@rtfStream));
    SendMessage(FPaintControl.Handle, WM_ERASEBKGND, Message.DC, 0);
    SendMessage(FPaintControl.Handle, WM_PAINT, message.DC, 0);
   if rtfStream.dwError <> $0000 then
      raise Exception.Create('Error appending RTF data.') ;
  finally
    sourceStream.Free;
  end;
end;

después de casi darme por vencido, me gustaría preguntar:

1º- ¿Hay algún componente, aunque sea de terceros, que haga esto por mi? Si es así, no me comeré más la cabeza. Estoy tratando con los LMD, pero tampoco parecen dar resultados. Cada vez me gustan menos esos componentes, pero eso otra historia.

2º- ¿Se os ocurre como podría lograrlo con mi propio componente? Yo creo que lo que he ido probando no me lleva a ningún lado, pero a lo mejor alguno ve la forma de arreglar ese código para que haga lo que yo quiero. O a lo mejor existe un camino mucho más sencillo para hacerlo. ¿A alguien se le ocurre algo?

Muchas gracias.