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()是什么函数,是不是漏了?

 

你可能感兴趣的:(FR报表 自动缩小的代码)