有人在用fastReport作报表时处理过字体自动缩小的问题吗,怎么做?(有分的) (0分)

  • 主题发起人 主题发起人 mypeoplelxt
  • 开始时间 开始时间
M

mypeoplelxt

Unregistered / Unconfirmed
GUEST, unregistred user!
[red][?]搜了半天,怎么连提这种问题的都没有,不会是太简单了吧,要是就好了,
请求帮助中..............[/red]
 
procedure TfrMemoView.Draw(Canvas: TCanvas);
var
newdx: Integer;
OldScaleX, OldScaleY:do
uble;
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;

begin
Draw(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 truedo
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;
 
http://delphibbs.com/delphibbs/dispq.asp?lid=746952
多谢多谢,
如果需要分的话请到上述地址去拿,有50分,一直没给.
不过这也还是有问题,如果要是我的memo高度够高,但宽度不够,岂不是lbz的代码无效?
代码修改中............................有没有更完善的?
 
更完善的,可以试试ReportMachine,可以按宽度或高度缩放
http://reportmachine.delphibbs.com/
 
现在报表都做完了,当时考虑是不会出现需要字体缩小的问题的,要不就用RB了,
所以,现在,请求帮助中..........
 
上一段代码加上以下代码(以下代码实现宽度字体自动缩小--自动换行=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 - 1do
begin
if j < tw(memo1) then
j := Canvas.TextWidth(Memo1);
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;
 
lbz,你好!
我是Delphi的新朋友,關於宽度字体自动缩小的代碼有沒有漏掉一點,還像沒顯示完,加在代碼中報表沒有變,請回复.謝!
 
请问:tw()是什么函数,是不是漏了?
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
后退
顶部