您的位置:首页 > 编程语言

RM报表 文本框 自动换行 相关代码

2015-11-12 21:33 525 查看
procedure TRMCustomMemoView.WrapMemo1(aAddChar: Boolean);
var
lCurHeight, lOneLineHeight, lMaxWidth: Integer;
lWCanvas: TCanvas;

procedure _OutLine(const lStr: WideString);
begin
FSMemo.Add(lStr);
Inc(lCurHeight, lOneLineHeight);
end;

procedure _WrapOutMemo;
var
h, oldh: HFont;
i: Integer;
begin
h := RMCreateAPIFont(lWCanvas.Font, 0, FFontScaleWidth);
oldh := SelectObject(lWCanvas.Handle, h);

try
lCurHeight := 0;
lOneLineHeight := -lWCanvas.Font.Height + LineSpacing; //每一行高度;
lMaxWidth := spWidth - spGapLeft * 2 - _CalcHFrameWidth(LeftFrame.spWidth, RightFrame.spWidth);
if (DocMode = rmdmDesigning) and (FParentReport.FDesigner.Factor <> 100) then
lMaxWidth := Round(lMaxWidth * 100 / FParentReport.FDesigner.Factor);

if (DocMode = rmdmDesigning) and (FMemo1.Count = 1) and
(RMWideCanvasTextWidth(lWCanvas, FMemo1[0]) > lMaxWidth) and
(FMemo1[0] <> '') and (FMemo1[0][1] = '[') then
_OutLine(FMemo1[0])
else
begin
if not FNeedWrapped then //不需要换行
begin
for i := 0 to FMemo1.Count - 1 do
_OutLine(FMemo1[i]);
end
else if WordWrap or AllowHtmlTag then //自动换行
begin
lCurHeight := lCurHeight + RMWrapStrings(FMemo1, FSMemo, lWCanvas, lMaxWidth, LineSpacing {lOneLineHeight},
WordBreak, CharWrap, AllowHtmlTag, True, aAddChar);

FSMemo.Add(#1);
end
else //不自动换行
begin
for i := 0 to FMemo1.Count - 1 do
begin
_OutLine(FMemo1[i]);
end;

FSMemo.Add(#1);
end;
end;
finally
FVHeight := lCurHeight - LineSpacing;
LineHeight := lOneLineHeight;
SelectObject(lWCanvas.Handle, oldh);
DeleteObject(h);
end;
end;

procedure _WrapOutMemo90;
var
h, oldh: HFont;
i: Integer;
begin
h := RMCreateAPIFont(lWCanvas.Font, 90, FFontScaleWidth);
oldh := SelectObject(lWCanvas.Handle, h);
try
lCurHeight := 0;
lOneLineHeight := -lWCanvas.Font.Height + LineSpacing;
lMaxWidth := spHeight - spGapTop * 2 - _CalcVFrameWidth(TopFrame.spWidth, BottomFrame.spWidth);
if not FNeedWrapped then
begin
for i := 0 to FMemo1.Count - 1 do
_Outline(FMemo1[i]);
end
else if WordWrap then
lCurHeight := lCurHeight + RMWrapStrings(FMemo1, FSMemo, lWCanvas, lMaxWidth, LineSpacing {lOneLineHeight},
WordBreak, CharWrap, AllowHtmlTag, True, aAddChar)
else
begin
for i := 0 to FMemo1.Count - 1 do
_Outline(FMemo1[i]);
end;
finally
FVHeight := lCurHeight - LineSpacing;
LineHeight := lOneLineHeight;
SelectObject(lWCanvas.Handle, oldh);
DeleteObject(h);
end;
end;

procedure _WrapOutMemo180;
var
i: Integer;
begin
lCurHeight := 0;
lOneLineHeight := -lWCanvas.Font.Height + LineSpacing; //每一行高度;
lMaxWidth := spHeight - spGapTop * 2 - _CalcVFrameWidth(TopFrame.spWidth, BottomFrame.spWidth);

if (DocMode = rmdmDesigning) and (FMemo1.Count = 1) and
(RMWideCanvasTextWidth(lWCanvas, FMemo1[0]) > lMaxWidth) and
(FMemo1[0] <> '') and (FMemo1[0][1] = '[') then
_OutLine(FMemo1[0])
else
begin
if not FNeedWrapped then //已经换行
begin
for i := 0 to FMemo1.Count - 1 do
_OutLine(FMemo1[i]);
end
else if WordWrap then //自动换行
begin
lCurHeight := lCurHeight + RMWrapStrings(FMemo1, FSMemo, lWCanvas, lMaxWidth, LineSpacing {lOneLineHeight},
WordBreak, CharWrap, AllowHtmlTag, False, aAddChar);
end
else //不自动换行
begin
for i := 0 to FMemo1.Count - 1 do
begin
_OutLine(FMemo1[i]);
end;
end;
end;
FVHeight := lCurHeight - LineSpacing;
LineHeight := lOneLineHeight;
end;

procedure _ChangeFontSize;
var
i: Integer;
lStr: string;
lMaxWidth: Integer;
begin
lMaxWidth := spWidth - spGapLeft * 2 - _CalcHFrameWidth(LeftFrame.spWidth, RightFrame.spWidth);
if lMaxWidth < 10 then Exit;

for i := 0 to FMemo1.Count - 1 do
begin
lStr := FMemo1[i];
while (RMWideCanvasTextWidth(lWCanvas, lStr) > lMaxWidth) and (lWCanvas.Font.Size > 0) do
lWCanvas.Font.Size := lWCanvas.Font.Size - 1;
end;

Font.Size := lWCanvas.Font.Size;
end;

begin
if not AutoAddBlank then
aAddChar := False;
if RotationType <> rmrtNone then
AllowHtmlTag := False;

FParentReport.DrawCanvas.LockCanvas;
try
lWCanvas := FParentReport.DrawCanvas.Canvas;
lWCanvas.Font.Assign(Font);
lWCanvas.Font.Height := -Round(Font.Size * 96 / 72);
SetTextCharacterExtra(lWCanvas.Handle, CharacterSpacing);
case FScaleFontType of
rmstByWidth:
begin
if DocMode <> rmdmDesigning then
_ChangeFontSize;
end;
rmstByHeight:
begin
end;
end;

FSMemo.Clear;
case RotationType of
rmrt90, rmrt270: _WrapOutMemo90;
rmrt180: _WrapOutMemo180;
else
_WrapOutMemo;
end;

SetTextCharacterExtra(lWCanvas.Handle, 0);
finally
FNeedWrapped := False;
FParentReport.DrawCanvas.UnLockCanvas;
end;
end;
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: