procedure TfrCustomMemoView.ShowMemo;
var
DR : TRect;
SavX,SavY : Integer;
procedure OutMemo;
var
i: Integer;
curyf, thf, linespc: double;
FTmpFL:boolean;
function OutLine(st: String): Boolean;
var
{$IFDEF DebugLR}
aw: Integer;
{$ENDIF}
cond: boolean;
n, {nw, w, }curx, lasty: Integer;
lastyf: Double;
Ts: TTextStyle;
//K6
bAddedBold, bAddedUnderline:boolean;
//K6
begin
lastyf := curyf + thf - LineSpc - 1;
lastY := Round(lastyf);
cond := not streaming and (lasty<=DR.Bottom);
{$IFDEF DebugLR_detail}
DebugLn('OutLine curyf=%f + thf=%f - gapy=%d = %f (%d) <= dr.bottom=%d == %s',
[curyf,thf,gapy,lastyf,lasty,dr.bottom,dbgs(Cond)]);
{$ENDIF}
if not Streaming and cond then
begin
n := Length(St);
//w := Ord(St[n - 1]) * 256 + Ord(St[n]);
LastLine := true;
SetLength(St, n - 2);
if Length(St) > 0 then
begin
FTmpFL:=false;
if St[Length(St)] = #1 then
begin
FTmpFL:=true;
SetLength(St, Length(St) - 1);
end
else
LastLine := false;
end;
// handle any alignment with same code
Ts := Canvas.TextStyle;
Ts.Layout :=tlTop;
Ts.Alignment := taLeftJustify;
Ts.Wordbreak :=false;
Ts.SingleLine:=True;
Ts.Clipping :=True;
Canvas.TextStyle := Ts;
//K6
// se il testo inizia per <b> allora lo metto bold..
bAddedBold:=false;
bAddedUnderline:=false;
try
if LowerCase(St).StartsWith('<b>') then
begin
if not(fsBold in Canvas.Font.Style) then
begin
Canvas.Font.Style := Canvas.Font.Style+ [fsBold];
bAddedBold:=true;
end;
// rimuovo dal testo <b> e </b>
St:=St.Replace('<b>','');
St:=St.Replace('</b>','');
end;
if LowerCase(St).StartsWith('<u>') then
begin
if not(fsUnderline in Canvas.Font.Style) then
begin
Canvas.Font.Style := Canvas.Font.Style+ [fsUnderline];
bAddedUnderline:=true;
end;
// rimuovo dal testo <b> e </b>
St:=St.Replace('<u>','');
St:=St.Replace('</u>','');
end;
// k6
(*
// the disabled code allows for text-autofitting adjusting font size
// TODO: waiting for users mising this and make it an option or remove it
nw := Round(w * ScaleX); // needed width
{$IFDEF DebugLR_detail}
DebugLn('TextWidth=%d st=%s',[Canvas.TextWidth(St),copy(st, 1, 20)]);
{$ENDIF}
while (Canvas.TextWidth(St) > nw) and (Canvas.Font.Size>1) do
begin
Canvas.Font.Size := Canvas.Font.Size-1;
{$IFDEF DebugLR}
DebugLn('Rescal font %d',[Canvas.Font.Size]);
{$ENDIF}
end;
{$IFDEF DebugLR_detail}
Debugln('Canvas.Font.Size=%d TextWidth=%d',[Canvas.Font.Size,Canvas.TextWidth(St)]);
aw := Canvas.TextWidth(St); // actual width
DebugLn('nw=%d aw=%d',[nw,aw]);
{$ENDIF}
*)
case Alignment of
Classes.taLeftJustify : CurX :=x+InternalGapX;
Classes.taRightJustify: CurX :=x+dx-1-InternalGapX-Canvas.TextWidth(St);
Classes.taCenter : CurX :=x+InternalGapX+(dx-InternalGapX-InternalGapX-Canvas.TextWidth(St)) div 2;
end;
if not Exporting then
begin
if Justify and not LastLine then
begin
if FirstLine then
CanvasTextRectJustify(Canvas, DR, x+InternalGapX + FParagraphGap, x+dx-1-InternalGapX, round(CurYf), St, true)
else
CanvasTextRectJustify(Canvas, DR, x+InternalGapX, x+dx-1-InternalGapX, round(CurYf), St, true)
end
else
begin
if FirstLine then
Canvas.TextRect(DR, CurX + FParagraphGap, round(curYf), St)
else
Canvas.TextRect(DR, CurX, round(curYf), St);
end;
end
else
begin
if FirstLine then
CurReport.InternalOnExportText(X + FParagraphGap, round(curYf), St, Self)
else
CurReport.InternalOnExportText(X, round(curYf), St, Self);
end;
// k6
finally
if bAddedBold then Canvas.Font.Style := Canvas.Font.Style- [fsBold];
if bAddedUnderline then Canvas.Font.Style := Canvas.Font.Style- [fsUnderline];
end;
//K6
Inc(CurStrNo);
Result := False;
end
else
Result := True;
curyf := curyf + thf;
FirstLine:=FTmpFL;
end;
begin {OutMemo}
if Alignment in [Classes.taLeftJustify..Classes.taCenter] then
begin
if Layout=tlCenter then
y:=y+(dy-VHeight) div 2
else
if Layout=tlBottom then
y:=y+dy-VHeight;
end;
curyf := y + InternalGapY;
LineSpc := LineSpacing * ScaleY;
// calc our reference at 100% and then scale it
// NOTE: this should not be r((Self.Font.Size*96/72 + LineSpacing)*ScaleY)
// as our base at 100% is rounded.
if Self.Font.Size = 0 then
i := Round((-GetFontData(Self.Font.Handle).Height * 72 / Self.Font.PixelsPerInch))
else
i := Self.Font.Size;
thf := Round(i*96/72 + LineSpacing)* ScaleY;
// Corrects font height, that's the total line height minus the scaled linespacing
Canvas.Font.Height := -Round(thf - LineSpc);
{$IFDEF DebugLR}
DebugLn('curyf=%f thf=%f Font.height=%d TextHeight(H)=%d DR=%s Memo1.Count=%d',
[curyf, thf, Canvas.Font.Height, Canvas.Textheight('H'), dbgs(DR), Memo1.Count]);
{$ENDIF}
CurStrNo := 0;
FirstLine:=true;
for i := 0 to Memo1.Count - 1 do
if OutLine(Memo1[i]) then
break;
{$IFDEF DebugLR}
DebugLn('CurStrNo=%d CurYf=%f Last"i"=%d',[CurStrNo, CurYf, i]);
{$ENDIF}
end;
Recent
