FR报表 自动缩小的代码

procedure TfrMemoView.Draw(Canvas: TCanvas);
var
 newdx: Integer;
 OldScaleX, OldScaleY: Double;
 fs: integer; //2002.7.25 LBZ
begin
 SetTextCharacterExtra(Canvas.Handle, Round(CharacterSpacing * ScaleX));
 Self.Canvas := Canvas;
 fs := font.size;
 if ((Flags and flAutoSize) <> ) and (Memo.Count > ) and
   (DocMode <> dmDesigning) then
 begin
   newdx := CalcWidth(Memo);
   if (Alignment and frtaVertical) <>  then
   begin
     dy := newdx;
   end
   else if (Alignment and frtaRight) <>  then
   begin
     x := x + dx - newdx;
     dx := newdx;
   end
   else
     dx := newdx;
 end; 

 BeginDraw(Canvas);
 Streaming := False;
 Memo1.Assign(Memo); 

 if Memo1.Count >  then
 begin
   FWrapped := Pos(#, Memo1.Text) <> ;
   if Memo1[Memo1.Count - ] = # then
     Memo1.Delete(Memo1.Count - );
   OldScaleX := ScaleX; OldScaleY := ScaleY;
   ScaleX := ; ScaleY := ;
   CalcGaps;
   if ((Flags and flAutoSize) <> ) and (DocMode <> dmDesigning) then
     dx := dx + ;
//    WrapMemo;
//    ScaleX := OldScaleX; ScaleY := OldScaleY;
//    RestoreCoord;
//2002.7.25 LBZ在WrapMemo与ScaleX := OldScaleX; ScaleY := OldScaleY;之间改为:
   while true do
   begin
     WrapMemo;
     if (VHeight > abs(drect.top - drect.Bottom)) and (Font.Size>) then
     begin
       Font.Size := Font.Size - ; //当字体过大时，适当缩小字体
     end
     else break;
   end;
//2002.7.25 LBZ
   ScaleX := OldScaleX; ScaleY := OldScaleY;
   RestoreCoord;
   Memo1.Assign(SMemo);
 end; 

 CalcGaps;
 if not Exporting then ShowBackground;
 if not Exporting then ShowFrame;
 if Memo1.Count >  then ShowMemo;
 SetTextCharacterExtra(Canvas.Handle, );
 RestoreCoord;
 font.size := fs;
end; 

页首
有人在用fastReport作报表时处理过字体自动缩小的问题吗,怎么做?(有分的)
帖子 由 whf » 星期二, 年7月30日 :

good

页首
有人在用fastReport作报表时处理过字体自动缩小的问题吗,怎么做?(有分的)
帖子 由 mypeoplelxt » 星期四, 年8月1日 :

http://delphibbs.com/delphibbs/dispq.asp?lid=746952
多谢多谢,
如果需要分的话请到上述地址去拿,有50分,一直没给.
不过这也还是有问题,如果要是我的memo高度够高,但宽度不够,岂不是lbz的代码无效?
代码修改中............................有没有更完善的?

页首
有人在用fastReport作报表时处理过字体自动缩小的问题吗,怎么做?(有分的)
帖子 由 whf » 星期四, 年8月1日 :

更完善的，可以试试ReportMachine,可以按宽度或高度缩放
http://reportmachine.delphibbs.com/

页首
有人在用fastReport作报表时处理过字体自动缩小的问题吗,怎么做?(有分的)
帖子 由 mypeoplelxt » 星期五, 年8月2日 :

现在报表都做完了,当时考虑是不会出现需要字体缩小的问题的,要不就用RB了,
所以,现在,请求帮助中..........

页首
有人在用fastReport作报表时处理过字体自动缩小的问题吗,怎么做?(有分的)
帖子 由 lbz » 星期五, 年8月2日 :

上一段代码加上以下代码（以下代码实现宽度字体自动缩小--自动换行=false时有效）
procedure TfrMemoView.ShowMemo;
var
 DR: TRect;
 ad, ox, oy: Integer;
.
.
.
 //2002.8.1计算memo最长的行宽。LBZ
 function wid: integer;
 var i, j: integer;
 begin
   j := ;
   for i :=  to memo1.Count -  do
   begin
     if j < tw(memo1[i]) then j := Canvas.TextWidth(Memo1[i]);
   end;
   wid := j;
 end;
 //2002.8.1计算memo最长的行宽。LBZ 

begin
 AssignFont(Canvas);
 SetTextCharacterExtra(Canvas.Handle, Round(CharacterSpacing * ScaleX));
 DR := Rect(DRect.Left + , DRect.Top, DRect.Right - , DRect.Bottom - );
 VHeight := Round(VHeight * ScaleY); 

 //2002.8.1 当字体缩放=true AND 自动换行=false时,自动单行字体缩放 LBZ
 if ((Flags and flWordWrap) = ) and (wid > abs(drect.Left - drect.Right)) then
 begin
   if memo1.Count >  then
   begin
     while (wid > abs(drect.Left - drect.Right)) and (Canvas.Font.Size > ) do
     begin
       canvas.Font.Size := canvas.Font.Size - ;
     end;
     VHeight := Round((Canvas.Font.size *  /  * memo1.count + LineSpacing * (memo1.count - ) + Gapy + Gapy) * ScaleY);
   end;
 end;
 //2002.8.1 当字体缩放=true AND 自动换行=false时,自动单行字体缩放 LBZ 

 if (Alignment and $) <>  then
 begin
   ad := Alignment;
   ox := x; oy := y; 

页首
有人在用fastReport作报表时处理过字体自动缩小的问题吗,怎么做?(有分的)
帖子 由 gdlz » 星期六, 年12月27日 :

lbz,你好!
我是Delphi的新朋友,關於宽度字体自动缩小的代碼有沒有漏掉一點,還像沒顯示完,加在代碼中報表沒有變,請回复.謝!

页首
有人在用fastReport作报表时处理过字体自动缩小的问题吗,怎么做?(有分的)
帖子 由 lhbzq » 星期六, 年1月17日 :

请问：tw()是什么函数，是不是漏了？