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) <> 0) and (Memo.Count > 0) and 
   (DocMode <> dmDesigning) then 
 begin 
   newdx := CalcWidth(Memo); 
   if (Alignment and frtaVertical) <> 0 then 
   begin 
     dy := newdx; 
   end 
   else if (Alignment and frtaRight) <> 0 then 
   begin 
     x := x + dx - newdx; 
     dx := newdx; 
   end 
   else 
     dx := newdx; 
 end; 

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

 if Memo1.Count > 0 then 
 begin 
   FWrapped := Pos(#1, Memo1.Text) <> 0; 
   if Memo1[Memo1.Count - 1] = #1 then 
     Memo1.Delete(Memo1.Count - 1); 
   OldScaleX := ScaleX; OldScaleY := ScaleY; 
   ScaleX := 1; ScaleY := 1; 
   CalcGaps; 
   if ((Flags and flAutoSize) <> 0) and (DocMode <> dmDesigning) then 
     dx := dx + 100; 
//    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>4) then 
     begin 
       Font.Size := Font.Size - 1; //当字体过大时，适当缩小字体 
     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 > 0 then ShowMemo; 
 SetTextCharacterExtra(Canvas.Handle, 0); 
 RestoreCoord; 
 font.size := fs; 
end; 
 
 
 
页首
有人在用fastReport作报表时处理过字体自动缩小的问题吗,怎么做?(有分的)
帖子 由 whf » 星期二, 2002年7月30日 20:21

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

http://delphibbs.com/delphibbs/dispq.asp?lid=746952 
多谢多谢, 
如果需要分的话请到上述地址去拿,有50分,一直没给. 
不过这也还是有问题,如果要是我的memo高度够高,但宽度不够,岂不是lbz的代码无效? 
代码修改中............................有没有更完善的?
 
 
 
页首
有人在用fastReport作报表时处理过字体自动缩小的问题吗,怎么做?(有分的)
帖子 由 whf » 星期四, 2002年8月1日 15:59

更完善的，可以试试ReportMachine,可以按宽度或高度缩放 
http://reportmachine.delphibbs.com/
 
 
 
页首
有人在用fastReport作报表时处理过字体自动缩小的问题吗,怎么做?(有分的)
帖子 由 mypeoplelxt » 星期五, 2002年8月2日 11:03

现在报表都做完了,当时考虑是不会出现需要字体缩小的问题的,要不就用RB了, 
所以,现在,请求帮助中..........
 
 
 
页首
有人在用fastReport作报表时处理过字体自动缩小的问题吗,怎么做?(有分的)
帖子 由 lbz » 星期五, 2002年8月2日 12:40

上一段代码加上以下代码（以下代码实现宽度字体自动缩小--自动换行=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 := 0; 
   for i := 0 to memo1.Count - 1 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 + 1, DRect.Top, DRect.Right - 2, DRect.Bottom - 1); 
 VHeight := Round(VHeight * ScaleY); 

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

 if (Alignment and $18) <> 0 then 
 begin 
   ad := Alignment; 
   ox := x; oy := y; 
 
 
 
页首
有人在用fastReport作报表时处理过字体自动缩小的问题吗,怎么做?(有分的)
帖子 由 gdlz » 星期六, 2003年12月27日 19:41

lbz,你好! 
我是Delphi的新朋友,關於宽度字体自动缩小的代碼有沒有漏掉一點,還像沒顯示完,加在代碼中報表沒有變,請回复.謝!
 
 
 
页首
有人在用fastReport作报表时处理过字体自动缩小的问题吗,怎么做?(有分的)
帖子 由 lhbzq » 星期六, 2004年1月17日 01:59

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