文章排版问题。看看我的代码的问题出在哪里了？(100分)

  • 主题发起人 主题发起人 soFTangeL
  • 开始时间 开始时间
S

soFTangeL

Unregistered / Unconfirmed
GUEST, unregistred user!
原文章版式：

??这是第一段这是第一段这是第一段这是第一段这是第一段??（这之前是两个中文空格）这是第二段这是第二段这是第二段这是第二段这是第二段??这是第三段这是第三段这是第三段这是第三段这是第三段

我要把他转换成这个格式：

??这是第一段这是第一段这是第一段这是第一段这是第一段
??这是第二段这是第二段这是第二段这是第二段这是第二段
??这是第三段这是第三段这是第三段这是第三段这是第三段

即在文章的两个空格（或一个空格，或两个以上的空格）前添加一个回车换行？
我试写出了下面的代码：

intPos := Pos('??', Dst);
while (intPos <> 0) do
begin
i := intPos;
Insert(#13#10, Dst, intPos);
intPos := Pos('??', Dst);
end;

但这样会陷入死循环。即文件定位的指针始终停在第一个“??”前面，怎么解决这个问题？
 
我顶一下！

没有人肯回答么？
 

Var
ts:string;
intPos := Pos('??', Dst);
while (intPos <> 0) do
begin
i := intPos;
Insert(#13#10, Dst, intPos);
ts:=ts+copy(Dst,1,intPos+4);
Dst:=copy(Dst,intPos+4,lenght(Dst)- intPos-4);
intPos := Pos('??', Dst);
end;
 
要注意全角和半角
 
procedure TForm1.Button1Click(Sender: TObject);
var
dst:widestring;
i:integer;
begin
dst:='这是第一段这是第一段这是第一段这是第一段这是第一段??这是第二段这是第二段这是第二段这是第二段这是第二段??这是第三段这是第三段这是第三段这是第三段这是第三段';
i := Pos('??', Dst);
while (i <> 0) do
begin
dst:=copy(dst,1,i-1)+copy(dst,i+2,length(dst)-i);
Insert(#13#10, Dst, i);
i := Pos('??', Dst);
end;
showmessage(Dst);
end;
 
可多个空格，但只能是半角
procedure TForm1.Button1Click(Sender: TObject);
var
pos,c:integer;
tstr,ts:string;
send:boolean;
begin
pos:=0;
tstr:=Memo1.Lines.Strings[0];
repeat
send:=FindSpace(pos,c,tstr);
if c>=2 then
begin
ts:=ts+copy(tstr,1,pos-1)+#13#10+copy(tstr,pos,c);
end;
if send then
tstr:=copy(tstr,pos+c,length(tstr)-pos-c+1);
until (not send);
Memo1.Lines.Clear;
Memo1.Lines.Text:=ts;
end;


function TForm1.FindSpace(var spos,count:integer;str: string): Boolean;
var
i,c:integer;
IsSpace:boolean;
tchar:char;
begin
IsSpace:=False;
Result:=True;
for i :=1 to length(str) do
begin
tchar:=str;
if tchar=chr(32) then
begin
if IsSpace then
inc(c)
else
begin
spos:=i;
IsSpace:=True;
c:=1;
end;
end
else
begin
if IsSpace then
begin
if i=length(str) then
Result:=False;
count:=c
exit;
end;
end;
end;
if i=length(str)+1 then
Result:=False;
end;
 
你这样当然死循环了，你插入了过后没有删除：
procedure StringReplaceAll(var text: string
const ss, ds: string);
var
p: Integer;
begin
p := Pos(ss, text);
while p > 0 do
begin
Delete(text, p, Length(ss));
Insert(ds, text, p);
p := Pos(ss, text);
end;
end;

然后 StringReplaceAll(s, '??', #13#10)
就可以了
不过这样空格也不见了，一个改进办法：

StringReplaceAll(s, '??', #13#10#1)
//先把空格换为不会在字符串里出现的 #1
StringReplaceAll(s, #1, '??')
//再把 #1 换回空格

这样既避免了死循环，有保留了空格。经分析，满足你的要求
当然，要方便，就稍微封装一下：

function AdjustParagraph(Text: string): string;
begin
StringReplaceAll(Text, '??', #13#10#1);
StringReplaceAll(Text, #1, '??');
Result := Text;
end;

然后直接调用 AdjustParagraph 就可以了。
 
非常好，尤其是beta的方法！已解决了问题！但同时也有一个新的问题产生：

如果源文本的某一行有很多空格那岂不是要产生N个回车换行？这样的排版看起来太不顺眼了，因此我把beta的 StringReplaceAll源程序略微改动了一下，见下面：

procedure StringReplaceAll(var text: string
const ss, ds: string);
var
p,i: Integer;
begin
p := Pos(ss, text);
while p > 0 do
begin
//下面是后来添上的
i:=p;
while (i < Length(text)) do
begin
if (Copy(text, i, 2) <> '　') then
break
else
Inc(i, 2);
end;
//上面是后来添上的
Delete(text, p, i-p)
//原语句：Delete(text, p, Length(ss));
Insert(ds, text, p);
p := Pos(ss, text);
end;
end;

我的目标是把两个或两个以上的连续空格都替换成 回车换行 + 双空格（双空格用来表示一段的开始），但是以上的代码并不能很好的工作（似乎Copy(text, i, 2)怎么也产生不了有效的数值），该怎样改进呢？
 
另外，若是我想把两个以上的连续空格忽略掉，即把 N(N>2)个连续空格当作两个空格，然后在他们前面添加回车换行那又该怎么做呢？
 
怎么不能StringRelpace呢？可以这样呀？

Source:='这是第一段这是第一段这是第一段这是第一段这是第一段??这是第二段这是第二段这是第二段这是第二段这是第二段??这是第三段这是第三段这是第三段这是第三段这是第三段';
Target:=StringReplace(Source,'??',#13#10,[rfReplaceAll]);

呵呵！简单点。
 
分两步：
1.扫描含两个以上空格，多出的删除。－－规范
2.在空格前加入#13#10。
 
实现代码：
procedure TForm1.Button1Click(Sender: TObject);
var
s, temp: string;
i, n: integer;
ok: boolean;
begin
memo1.Lines.clear;
memo1.Lines.LoadFromFile('a.txt');
s := memo1.text
//Lines[0];
i := 1;
n := pos(' ', copy(s, i, length(s)));
i := n+2;
while n > 0 do begin
ok := true;
while ok do begin
if copy(s, i, 1) = ' ' then
begin
delete(s, i, 1);
// showmessage(IntToStr(i)+':'+s);
end
else
ok := false;
inc(i);
end;
n := pos(' ', copy(s, i, length(s)-i+1));
i:=i+n+1;
end;
memo1.text:=s;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
s:widestring;
begin
s:=memo1.text;
s:=StringReplace(s, ' ',#13#10+' ', [rfReplaceAll]);
Insert(' ', s, 1);
memo1.lines.add(s);
end;
 
那你试试下面的文字：

　　　　　　（此前6个中文空格）风萧萧兮易水寒　　　　　　　　　　（此前10个中文空格）壮士一去兮不复还


我想让它转换成下面的格式：

-----------------------
风萧萧兮易水寒
壮士一去兮不复还
-----------------------


而不是下面这种格式：

-----------------------


风萧萧兮易水寒




壮士一去兮不复还
-----------------------

即忽略两个以上的连续空格。如果有 N(N>2) 个连续空格，不能产生 N/2 个 “回车换行+两个空格”。
能做到么？
 
对于全角空格：
procedure TForm1.Button1Click(Sender: TObject);
var
s, temp: Widestring;
i, n: integer;
ok: boolean;
begin
memo1.Lines.clear;
memo1.Lines.LoadFromFile('a.txt');
s := memo1.text
//Lines[0];
i := 1;
n := pos('??', copy(s, i, length(s)));
i := n+2;
while n > 0 do begin
ok := true;
while ok do begin
if copy(s, i, 1) = '?' then
begin
delete(s, i, 1);
showmessage(IntToStr(i)+':'+s);
end
else
ok := false;
inc(i);
end;
n := pos('??', copy(s, i, length(s)-i+1));
i:=i+n;
end;
memo1.text:=s;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
s:widestring;
begin
s:=memo1.text;
s:=StringReplace(s, '??',#13#10+'??', [rfReplaceAll]);
// Insert(' ', s, 1);
memo1.lines.add(s);
end;
 
//我想把两个以上的连续空格忽略掉
StringReplaceAll(Text, '???', '??')
// 将三个空格转为两个
虽说效率低点，但是应该可以奏效，如果要处理的文件不是很大的话
注意，只调用一次即可（删除多余空格），考虑里面有个循环。
然后再插入。
 
OK，现在分赃。：）
 
您必须登录或注册才可回复。

Similar threads

不
关于在Delphi中链接VC的obj文件（XE2以上版本） - 不得闲
回复
0
查看
926
不得闲
不
不
B编码以及BT种子文件分析 - 不得闲
回复
0
查看
1K
不得闲
不
不
电子病历的进展 - 不得闲
回复
0
查看
813
不得闲
不
不
关于SpeedButton中使用下划线快捷键不响应的问题 - 不得闲
回复
0
查看
670
不得闲
不
不
ISO8583报文协议（转） - 不得闲
回复
0
查看
848
不得闲
不
后退
顶部