上一段代码加上以下代码(以下代码实现宽度字体自动缩小--自动换行=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;