Imprimir RichEdit justificado en QReport

[ingel]

esta propiedad que mencionas no JUSTIFICA el texto .. solo lo centra en el mejor de los casos .. pero los 'bordes' o margenes quedan desparejos....
Estoy desarrollando una funcion que parece que funciona bastante bien ..
cuando la finalice la subire con gusto ...
SDs

[[José Luis Garcí]]

_Hola Compañeros aqui os dejo unos procedure que justifican en un Richedit, espero que te valga, lo baje de la red de donde ??

Código Delphi [-]
//------------------------------------------------------
function MenorEspacioEntrePalabras(cad : string) : integer;
var
menor,actual,i : integer;
enespacio : boolean;
begin
  actual:=0;
  menor:=50;
  result:=0;
  enespacio:=false;
  for i:=1 to length(cad) do
  begin
    if cad[i]=' ' then
    begin
      if enespacio
      then actual:=actual+1
      else
      begin
        enespacio:=true;
        actual:=1;
      end;
    end
    else
    if enespacio then
    begin
      enespacio:=false;
      if actual < menor then
      begin
        menor:=actual;
        result:=i-actual;
        actual:=0;
      end;
    end;
  end;
end;
//------------------------------------------------------------------
function LargoTexto(texto : string; f : TFont) : integer;
var
aux : TFont;
begin
  aux:=Screen.ActiveForm.Canvas.font;
  Screen.ActiveForm.Canvas.font:=f;
  result:=Screen.ActiveForm.Canvas.textwidth(texto);
  Screen.ActiveForm.Canvas.font:=aux;
end;
//----------------------------------------------------------
function Distancia(a,b : integer) : integer;
begin
  result:=abs(a-b);
end;
//----------------------------------------------------------
procedure Justifica(cadenas : tstrings; fuente : TFont; ancho : integer);
var
i : integer;
aux : string;
begin
  for i:=0 to cadenas.count-1 do
  while Distancia(LargoTexto(cadenas[i],fuente),ancho)>10 do
  begin
    aux:=cadenas[i];
    Insert(' ',aux,MenorEspacioEntrePalabras(aux));
    cadenas[i]:=aux;
  end;
end;
//--------------------------------------------------------------

// AllText : True=todo o texto; False=parágrafo atual
procedure JustifyRichEdit(RichEdit :TRichEdit; AllText :Boolean);
const
  TO_ADVANCEDTYPOGRAPHY   = $1;
  EM_SETTYPOGRAPHYOPTIONS = (WM_USER + 202);
  EM_GETTYPOGRAPHYOPTIONS = (WM_USER + 203);
var
  ParaFormat :TParaFormat;
  SelStart,
  SelLength :Integer;
begin
  ParaFormat.cbSize := SizeOf(ParaFormat);
  if SendMessage(RichEdit.handle,
              EM_SETTYPOGRAPHYOPTIONS,
              TO_ADVANCEDTYPOGRAPHY,
              TO_ADVANCEDTYPOGRAPHY) = 1 then
  begin
    SelStart := RichEdit.SelStart;
    SelLength := RichEdit.SelLength;
    if AllText then
      RichEdit.SelectAll;
    ParaFormat.dwMask := PFM_ALIGNMENT;
    ParaFormat.wAlignment := PFA_JUSTIFY;
    SendMessage(RichEdit.handle, EM_SETPARAFORMAT, 0, LongInt(@ParaFormat));
// Restaura seleção caso tenhamos mudado para All
    RichEdit.SelStart := SelStart;
    RichEdit.SelLength := SelLength;
  end;
end;

Modo de uso

Código Delphi [-]
Justifica(redtrededitcion.Lines,redtrededitcion.Font,redtrededitcion.Width);




 if Length(redtrededitcion.selText)>0 then JustifyRichEdit(redtrededitcion,FAlse)
                                        else JustifyRichEdit(redtrededitcion,True);

[rgstuamigo]

Empezado por José Luis Garcí

_Hola Compañeros aqui os dejo unos procedure que justifican en un Richedit, espero que te valga, lo baje de la red de donde ??

...

Buen aporte Jose Luis.
Saludos...

[ingabraham]

pense que era complicado. pero es tan fácil como esto.

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
begin

with RichEdit1 do
begin
//SelectAll;
   Paragraph.Alignment:=taLeftJustify;
   SelStart:=0;
   SelLength:=0;
end;
 RichEdit1.Lines.Add('mensaje izq');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin

with RichEdit1 do
begin
//SelectAll;
   Paragraph.Alignment:=taRightJustify;
   SelStart:=0;
   SelLength:=0;
end;
 RichEdit1.Lines.Add('mensaje der');
end;