急啊!!!!!fastrport 问题 (高手请进啊,很有难度啊) ( 积分: 100 )

  • 主题发起人 主题发起人 liubin44966
  • 开始时间 开始时间
L

liubin44966

Unregistered / Unconfirmed
GUEST, unregistred user!
如何处理fastreport 检索数据时,标点符号不在行头?(或在写数据库时处理);总之实现就可以:(不用word)
 
如何处理fastreport 检索数据时,标点符号不在行头?(或在写数据库时处理);总之实现就可以:(不用word)
 
不是很懂在说什么。
 
fastreport 显示数据时不能出现
1.中国人...................................................................胜利
。(不行)
1.中国人...................................................................胜
利 。(行)
类似word的功能
 
急啊。大家帮忙看看啊。分少可以再加啊
 
没看清楚你要做什么,就差一个字而已?
 
呵呵,这是影响美观的问题。
这个问题有点难。要改fastreport的源代码
 
to chenybin:
也就是标点符号不能自成一行
 
这个有点意思,它怎么知道是标点符号呢,那你在标点前面加一个空格呢?
你说不行是什么意思,显示不了?
 
改fastreport的源代码是行的,无非是判断字符,再根据情况折行。
 
to chenybin:
不行是不符和我的要求,我做的是一套考试组卷的程序。
 
to jianguobu:
你好,能把你的代码写一下吗
 
晕,这要化不少时间的,我只是给你提供思路呀。
你自己去改它的原码呀
 
不是太细,也没怎么测试,凑活看看吧
版本fr2.5,修改fr_class.pas文件:
procedure TfrMemoView.WrapMemo;
var
size, size1, maxwidth, textWidth: Integer;
b: TWordBreaks;
WCanvas: TCanvas;
lineText: string;
procedure OutLine(const str: string);
begin
SMemo.Add(str);
Inc(size, size1);
end;
procedure WrapLine(const s: string);
var
i, cur, beg, last, LoopPos: Integer;
WasBreak, CRLF: Boolean;
interpunctions: TStringList;
begin
interpunctions := TStringList.Create;//未做释放,为了方便看就放这里创建了
//不易放在句首的标点
interpunctions.text := '。'#10','#10'!'#10'?'#10'.'#10','#10'!'#10'?';
CRLF := False;
LoopPos := 0;
for i := 1 to Length(s)do
if s in [#10, #13] then
begin
CRLF := True;
break;
end;
last := 1;
beg := 1;
if not CRLF and ((Length(s) <= 1) or (WCanvas.TextWidth(s) <= maxwidth))
then
OutLine(s + #1)
else
begin
cur := 1;
while cur <= Length(s)do
begin
//1 换行符
if s[cur] in [#10, #13] then
begin
OutLine(Copy(s, beg, cur - beg) + #1);
while (cur < Length(s)) and (s[cur] in [#10, #13])do
Inc(cur);
beg := cur;
last := beg;
if s[cur] in [#13, #10] then
Exit
else
continue;
end;
//2 非换行符
if s[cur] <> ' ' then
begin
lineText := Copy(s, beg, cur - beg + 1);
textWidth := WCanvas.TextWidth(lineText);
if textWidth > maxwidth then
begin
WasBreak := False;
if (Flags and flWordBreak) <> 0 then
begin
i := cur;
while (i <= Length(s)) and not (s in spaces)do

Inc(i);
b := BreakWord(Copy(s, last + 1, i - last - 1));
if Length(b) > 0 then
begin
i := 1;
cur := last;
while (i <= Length(b)) and
(WCanvas.TextWidth(Copy(s, beg, last - beg + 1 + Ord(b)) +
'-') <= maxwidth)do
begin
WasBreak := True;
cur := last + Ord(b);
Inc(i);
end;
last := cur;
end;
end
else
if last = beg then
last := cur;
if WasBreak then
OutLine(Copy(s, beg, last - beg + 1) + '-')
else
if s[last] = ' ' then
OutLine(Copy(s, beg, last - beg))
else
begin
if last = beg then
begin
last := cur;
end;
//************ 未考虑连续标点情况:”。
if (ByteType(s, cur) = mbLeadByte) or (ByteType(s, cur) = mbSingleByte) then
begin
if (interpunctions.indexof(s[cur] + s[cur + 1]) <> -1) or (interpunctions.indexof(s[cur]) <> -1) then
begin
if ByteType(s, cur - 1) = mbTrailByte then
begin
lineText := Copy(s, beg, last - beg - 2);
//multi-byte
last := last - 2;
cur := cur - 2;
end
else
begin
lineText := Copy(s, beg, last - beg - 1);
// single byte
last := last - 1;
cur := cur - 1;
end;
end
else
lineText := Copy(s, beg, last - beg);
end
else
//*************************
begin
lineText := Copy(s, beg, last - beg);
end;
OutLine(lineText);
Dec(last);
end;
if ((Flags and flWordBreak) <> 0) and not WasBreak and (last = cur - 1) then
begin
if LoopPos = cur then
begin
beg := cur + 1;
cur := Length(s);
break;
end
else
LoopPos := cur;
end;
beg := last + 1;
last := beg;
end;
end;
if s[cur] = ' ' then

last := cur;
{$IFNDEF Delphi2} // is not delphi2
if ByteType(s, cur) = mbLeadByte then
Inc(cur, 2)
else
{$ENDIF}
Inc(cur);
end;
if beg <> cur then
//the ending
begin
lineText := Copy(s, beg, cur - beg + 1) + #1;
end;
OutLine(lineText);
end;
end;
procedure OutMemo;
var
i: Integer;
begin
size := y + gapy;
size1 := -WCanvas.Font.Height + LineSpacing;
maxwidth := dx - gapx - gapx;
if (DocMode = dmDesigning) and (Memo1.Count = 1) and
(WCanvas.TextWidth(Memo1[0]) > maxwidth) and
(Memo1[0] <> '') and (Memo1[0][1] = '[') then
OutLine(Memo1[0])
else
for i := 0 to Memo1.Count - 1do
if FWrapped then
OutLine(Memo1)
else
if (Flags and flWordWrap) <> 0 then
WrapLine(Memo1)
else
OutLine(Memo1 + #1);
VHeight := size - y + gapy;
TextHeight := size1;
end;
procedure OutMemo90;
var
i: Integer;
h, oldh: HFont;
begin
h := Create90Font(WCanvas.Font);
oldh := SelectObject(WCanvas.Handle, h);
size := x + gapx;
size1 := -WCanvas.Font.Height + LineSpacing;
maxwidth := dy - gapy - gapy;
for i := 0 to Memo1.Count - 1do
if FWrapped then
begin
OutLine(Memo1);
end
else
if (Flags and flWordWrap) <> 0 then
WrapLine(Memo1)
else
OutLine(Memo1);
SelectObject(WCanvas.Handle, oldh);
DeleteObject(h);
VHeight := size - x + gapx;
TextHeight := size1;
end;
begin
WCanvas := TempBmp.Canvas;
WCanvas.Font.Assign(Font);
WCanvas.Font.Height := -Round(Font.Size * 96 / 72);
SetTextCharacterExtra(WCanvas.Handle, CharacterSpacing);
SMemo.Clear;
if (Alignment and $4) <> 0 then
OutMemo90
else
OutMemo;
end;
 
多人接受答案了。
 
呵呵,还真有人改呀
 

Similar threads

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