QuickReport - Justificar o QrMemo

Top Previous Next

{

Autor: Lázaro Raimundo de Oliveira

E-mail: leyzury@geocities.com

Esta unit é um freeware, pode ser usada em qualquer aplicativo pessoal ou comercial,

sem nenhum onus para o autor, entretanto qualquer alteração que seja feita nela

deve constar o nome do autor original.

Sua funcao é justificar qrMemo, deve ser colocado no evento beforeprint

como paramentro o nome do objeto qrMemo que se deseja justificar.

Atenção - Qualquer problema com o uso desta unit é de sua total responsabilidade.

Sintaxe:

Justificar(var QuickRpMemo:TQRMemo);

}

unit Justif;

interface

uses SysUtils, Windows, Qrctrls, graphics, forms;

type Alinhamento = (Esquerda, Direita, Centralizado);

procedure Justificar(var QuickRpMemo:TQRMemo);

function AnalisaLinha(QuickRpMemo:TQRMemo;Linha:Integer):String;

function JustLinha(Frase:String;EspacosInt:Integer):String;

implementation

procedure justificar(var QuickRpMemo:TQRMemo);

var

x:Integer;

LinhaAnalisada:String;

begin

//Varrer todas as linhas

for x:= 0 to (QuickRpMemo.Lines.Count-1) do

begin

LinhaAnalisada:=QuickRpMemo.Lines[x];

//Tratar linha

//ignorar linhas nulas voltando a mesma coisa.

if Trim(LinhaAnalisada)<>'' then

begin

//Analisar linha

LinhaAnalisada:=AnalisaLinha(QuickRpMemo,x);

end

else

begin

LinhaAnalisada:='';

end;

//devolver linha tratada

QuickRpMemo.Lines[x]:=LinhaAnalisada;

end;

function AnalisaLinha(QuickRpMemo:TQRMemo;Linha:Integer):String;

var TamanhoFrase:Integer;

CanvaTexto:TCanvas; //fonte - alteracao da padrao

LinhaAnalisada:String;

TamanhoEspaco:Integer;

DC:HDC;

x,y:Integer;

Inicio:Integer;

ListaPalavras:variant;

ContLista:Integer;

Frase:String;

FraseAnt:String;

ItemAtualLista:Integer;

SairLoop:Boolean;

FraseRetorno:String;

Espacos:Real;

EspacosInt:Integer;

// bNovaPalavra:Boolean;

begin

//Define valor da linha analisada

LinhaAnalisada:=QuickRpMemo.Lines[Linha];

CanvaTexto:=TCanvas.Create;

//Define o tamanho da fonte em questao

CanvaTexto.Font:=QuickRpMemo.Font;

//Define tamanho do espaco #32

DC := GetDC(0);

CanvaTexto.Handle := DC;

//Define o tamanho da fonte em questao

CanvaTexto.Font:=QuickRpMemo.Font;

//Define o tamanho do texto

CanvaTexto.Refresh;

TamanhoEspaco:=CanvaTexto.TextWidth(#32);

CanvaTexto.Handle := 0;

ReleaseDC(0, DC);

//Define valor inicial de verificao da array

//provalvelmente retirarei esta parte

Inicio:=1;

//Loop de todos os letras da expressao para separar todas as palavras

//Inicializa a variante lista de palavras com 1 campo

ListaPalavras:=VarArrayCreate([1,1],varOleStr);

ContLista:=1;

//Analisa caractere por caractere

for x:= Inicio to Length(LinhaAnalisada) do

begin

//Trata o valor de y

//Iguala o valor de y a x

y:=x;

//Caso esteja no limite da array diminuia 1 a y

if y=Length(LinhaAnalisada) then y:=y-1;

//Se o caractere for o espaco adicione um item a lista

//caso nao adicione o caractere ao item atual da lista

if (LinhaAnalisada[x] = #32) and (LinhaAnalisada[y+1] <> #32) then

Begin

ListaPalavras[ContLista]:=ListaPalavras[ContLista]+Copy(LinhaAnalisada,x,1);

ContLista:=ContLista+1;

VarArrayRedim(ListaPalavras,ContLista);

end

else {if (LinhaAnalisada[x] <> #32) then}

ListaPalavras[ContLista]:=ListaPalavras[ContLista]+Copy(LinhaAnalisada,x,1);

end;

{

//*********

//Analisa quantidade de espacos que devem estar na primeira palavra caso esta seja

//o caractere #160

if Pos(#160,ListaPalavras[1]) =1 then

begin

//Contar quantos espacos devem ser adicionados

AdiEspacos:=0;

x:=2;

Sair:=False;

while not Sair do

begin

if LinhaAnalisada[x] = #32 then

AdiEspacos:=AdiEspacos+1

else

Sair:=True;

x:=x+1;

end;

ListaPalavras[1]:=ListaPalavras[1]+StringOfChar(#32,AdiEspacos);

//*********

}

//Loop separar frase verificando pelo tamanho

FraseAnt:='';

Frase:='';

ItemAtualLista:=1;

SairLoop:=True;

while SairLoop do

begin

//Salva valor da frase anterior

FraseAnt:=Frase;

//Adiciona Frase

Frase:=Frase+ListaPalavras[ItemAtualLista];

//Verifica o tamanho da frase

DC := GetDC(0);

CanvaTexto.Handle := DC;

//Define o tamanho da fonte em questao

CanvaTexto.Font:=QuickRpMemo.Font;

//Define o tamanho do texto

TamanhoFrase:=CanvaTexto.TextWidth(Frase);

CanvaTexto.Handle := 0;

ReleaseDC(0, DC);

//Define valor de zoom do objeto para nao gerar defeitos de edicao

QuickRpMemo.Zoom:=100;

//Verifica se já alcancou o tamanho da linha

//ou é final de paragrafo

if (TamanhoFrase > QuickRpMemo.Width) or //Frases maiores que o tamanho do memo

((VarArrayHighBound(ListaPalavras,1)-(ItemAtualLista)) <= 0) //fim de linhas exatas

then

begin

//Tratar maior que aqui (Frase maior que a linha)

if TamanhoFrase > QuickRpMemo.Width then

begin

Frase:=FraseAnt;

//Retorna uma palavra na analise

ItemAtualLista:=ItemAtualLista-1;

//Verifica o tamanho da frase novamente

DC := GetDC(0);

CanvaTexto.Handle := DC;

//Define o tamanho da fonte em questao

CanvaTexto.Font:=QuickRpMemo.Font;

//Define o tamanho do texto

TamanhoFrase:=CanvaTexto.TextWidth(Frase);

CanvaTexto.Handle := 0;

ReleaseDC(0, DC);

end;

//Verificar se nao é última frase - (tamanho array - ItemAtualLista=0)

//se sim retorna o mesmo

//caso contrario mantenha a variavel

//So justificar se a diferenca for menor que zero

if ((VarArrayHighBound(ListaPalavras,1)-ItemAtualLista) > 0) then

begin

//Tratar aqui linha se estiver dentro da faixa

//justificar frase

//Espacos a acrescentar a cada entre palavras=

//O resto é dividido e adicionado aos primeiros espacos

//Espacos:=Int((QuickRpMemo.Width - TamanhoFrase)/TamanhoEspaco);

Espacos:=((QuickRpMemo.Width - TamanhoFrase)/TamanhoEspaco);

//caso o mod seja maior que a metade do tamanho do espaco acrescente mais 1

//if ((QuickRpMemo.Width - TamanhoFrase) mod TamanhoEspaco) >=

// (TamanhoEspaco/2) then Espacos:=Espacos+1;

//Converte valor de espacos para integer

EspacosInt:=Round(Espacos);

///////////////////////////***************************************

//Coloque aqui a frase justificada

Frase:=JustLinha(Frase,EspacosInt);

end;

///////////////////////////***************************************

//Adiciona a frase que retornara

FraseRetorno:=FraseRetorno+Frase;

//Zera variaveis para reinicio do processo

Frase:='';

FraseAnt:='';

end;

//Incrementa contador

ItemAtualLista:=ItemAtualLista+1;

//Condicao para saida do loop - array menor que item analisado

if ItemAtualLista > VarArrayHighBound(ListaPalavras,1) then

SairLoop:=Not SairLoop;

end;

//Libera o objeto canvas

CanvaTexto.Free;

//Retorna linha justificada

AnalisaLinha:=FraseRetorno;

end;

function JustLinha(Frase:String;EspacosInt:Integer):String;

var

FraseJustificada:String;

ListaPalavras:Variant;

x,y:Integer;

ContLista:Integer;

ItemAtual,CompFrase:Integer;

// AdiEspacos:Integer;

// Sair:Boolean;

begin

//Contar palavras

//Loop de todos os letras da expressao para separar todas as palavras

//Inicializa a variante lista de palavras com 1 campo

ListaPalavras:=VarArrayCreate([1,1],varOleStr);

ContLista:=1;

CompFrase:=Length(Frase);

for x:= 1 to CompFrase do

begin

//Trata o valor de y

//Iguala o valor de y a x

y:=x;

//Caso esteja no limite da array diminuia 1 a y

if y=Length(Frase) then y:=y-1;

//Se o caractere for o espaco adicione um item a lista

//caso nao adicione o caractere ao item atual da lista

if (Frase[x] = #32) and (Frase[y+1] <> #32) then

Begin

//Adiciona um espaco ao final da frase

ListaPalavras[ContLista]:=ListaPalavras[ContLista]+#32;

ContLista:=ContLista+1;

VarArrayRedim(ListaPalavras,ContLista);

end

else {if (Frase[x] <> #32) then}

//Adiciona o espaco ao final da palavra para evitar de coloca-lo na palavra seguinte

ListaPalavras[ContLista]:=ListaPalavras[ContLista]+Copy(Frase,x,1);

end;

{

//*********

//Analisa quantidade de espacos que devem estar na primeira palavra caso esta seja

//o caractere #160

if Pos(#160,ListaPalavras[1]) =1 then

begin

//Contar quantos espacos devem ser adicionados

AdiEspacos:=0;

x:=2;

Sair:=False;

while not Sair do

begin

if Frase[x] = #32 then

AdiEspacos:=AdiEspacos+1

else

Sair:=True;

x:=x+1;

end;

ListaPalavras[1]:=ListaPalavras[1]+StringOfChar(#32,AdiEspacos);

//*********

}

//Adiciona um espaco ao ultimo item da array.

//ListaPalavras[ContLista]:=ListaPalavras[ContLista]+#32; {desativado}

//Se palavras for igual a 1 adicione espacos a direita do frase

//Pois é a ultima linha do paragrafo

if (VarArrayHighBound(ListaPalavras,1)=1) then

FraseJustificada:=Frase+StringOfChar(#32,EspacosInt)

//Caso contrario

else

begin

//Distribui cada um dos espacos para as variaveis ate nao sobrar nenhum

ItemAtual:=1;

for x := 1 to EspacosInt do

begin

//Colocar o espaco para a primeira palavra novamente

if ItemAtual > (VarArrayHighBound(ListaPalavras,1)) then

ItemAtual:=1;

//Insere o espaco para cada o item correspondente

ListaPalavras[ItemAtual]:=ListaPalavras[ItemAtual]+#32;

//Incrementa a palavra atual

ItemAtual:=ItemAtual+1;

end;

FraseJustificada:='';

//Junta a frase novamente

for x := 1 to (VarArrayHighBound(ListaPalavras,1)) do

FraseJustificada:=FraseJustificada+ListaPalavras[x];

//FimSe

end;

//Retorne valor da funcao

JustLinha:=FraseJustificada;

end;

end.