Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 18-10-2016
Mendizabal Mendizabal is offline
Miembro
NULL
 
Registrado: sep 2014
Posts: 31
Poder: 0
Mendizabal Va por buen camino
Utilizar DBRichText en un DBctrlGrid.

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.
Responder Con Cita
  #2  
Antiguo 20-10-2016
Mendizabal Mendizabal is offline
Miembro
NULL
 
Registrado: sep 2014
Posts: 31
Poder: 0
Mendizabal Va por buen camino
Finalmente logré solucionarlo

Código Delphi [-]
procedure TDBRichMemo2.WMPaint(var Message: TWMPaint);
var
  lBmp: TBitmap;
  lCanvas: TCanvas;
  lRichEdit: TCustomRichEdit;
  s: string;
  ch: integer;
  Stream: TStringStream;
begin
  if not (csPaintCopy in ControlState) then
  begin
    inherited;
  end
  else
  begin
    lRichEdit := TCustomRichEdit.Create(nil);
    lRichEdit.ParentWindow := Application.Handle;

    TRichEdit(lRichEdit).Color := Color;
    TRichEdit(lRichEdit).BorderStyle := BorderStyle;
    TRichEdit(lRichEdit).BorderWidth := BorderWidth;
    TRichEdit(lRichEdit).Ctl3D := Ctl3D;
    TRichEdit(lRichEdit).Font.Assign(Font);
    TRichEdit(lRichEdit).MaxLength := MaxLength;
    TRichEdit(lRichEdit).PlainText := PlainText;
    TRichEdit(lRichEdit).ScrollBars := ScrollBars;


    Stream := TStringStream.Create(s);
    try
      lRichEdit.Lines.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;

    lBmp := TBitmap.Create;
    lCanvas := TCanvas.Create;
    lBmp.Width := ClientRect.Right - ClientRect.Left;
    lBmp.Height := ClientRect.Bottom - ClientRect.Top;

    lCanvas.Handle := Message.Dc;
    ch := 0;

    lBmp.Canvas.Brush.Color := Color;
    lBmp.Canvas.Brush.Style := bsSolid;
    lBmp.Canvas.FillRect(ClientRect);

    RichEditToCanvas(lRichEdit,lBmp.Canvas,Screen.PixelsPerInch);
    lCanvas.Draw(0,0, lBmp);

    lRichEdit.Free;
    lBmp.free;
    lCanvas.free;
  end;
end;

Saludos.

Perdón, me había dejado la función RicheditToCanvas:

Código Delphi [-]
procedure RicheditToCanvas(aRichEdit: TCustomRichEdit; BMP: TBitmap; var LastChar: Integer);
var
  Range: TFormatRange;
  LogX, LogY: Integer;
  TextLenEx: TGetTextLengthEx;
  MaxLen: LongInt;
begin
  //SendMessage(aRichEdit.Handle, EM_FORMATRANGE, 0, 0);
  LogX := GetDeviceCaps(BMP.Canvas.Handle, LOGPIXELSX);
  LogY := GetDeviceCaps(BMP.Canvas.Handle, LOGPIXELSY);

  FillChar(Range, SizeOf(Range), 0);

  Range.rcPage.Top    := 0;
  Range.rcPage.Left   := 0;
  Range.rcPage.Right  := PixelsToTwips(BMP.Width, LogX);
  Range.rcPage.Bottom := PixelsToTwips(BMP.Height, LogY);

  Range.rc := Range.rcPage;
  Range.chrg.cpMin := LastChar;
  Range.chrg.cpMax := -1;
  Range.hdc := BMP.Canvas.Handle;
  Range.hdcTarget := Range.hdc;

  try
    LastChar := aRichEdit.Perform(EM_FORMATRANGE, 1, Integer(@Range));
    aRichEdit.Perform(EM_DISPLAYBAND, 0, Integer(@Range.rc));

    //MaxLen:= aRichEdit.GetTextLen;
    with TextLenEx do
    begin
      flags:= GTL_DEFAULT;
      codepage:= CP_ACP;
    end;
    MaxLen := aRichEdit.Perform(EM_GETTEXTLENGTHEX, WParam(@TextLenEx), 0);

    if LastChar >= MaxLen then
      LastChar:= -1;
  finally
    Range.hdc := BMP.Canvas.Handle;
    Range.hdcTarget := Range.hdc;
    aRichEdit.Perform(EM_FORMATRANGE, 0, 0);
  end;
end;

Última edición por Mendizabal fecha: 20-10-2016 a las 16:00:52.
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
DBctrlGrid, DBimage y JPG jcamalmx Gráficos 4 18-02-2018 20:20:54
JPG, DBImage y DBCtrlGrid jcamalmx Gráficos 2 20-07-2011 00:46:46
Dbctrlgrid e insert marcosmendozaa Varios 1 29-12-2008 02:02:52
Acerca del DBCtrlGrid lgarcia OOP 2 05-03-2005 01:04:59
DBLookupComboBox y DBCtrlGrid javiermorales OOP 1 07-05-2003 03:48:44


La franja horaria es GMT +2. Ahora son las 12:40:17.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi