程序我看了，改了几处地方。程序基本上是照书上搬的，所以最好是照搬到底，不要抄漏了，或者是搬错了！呵呵！(^_^)
上面程序的打印过程，书上好象不是那样的啊！你想怎么打的？呵呵！

    要提醒的地方是：建立二叉树的时候，数据域里，没有ltag,rtag这两个标记，但是建立线索二叉树时，有了这两个域，所以生成数据要给它们赋值嘛！不要照搬生成二叉树的算法。我调试了很久才发现这个问题的。老实说，我以前也没有耐心去编这个程序，你的耐心和毅力比我强多了！呵呵！
(^_^)

program xiansuohua(input,output);
  type
    thlinktp=^thrnodetp;
    thrnodetp=record
              data:integer;
              ltag,rtag:0..1;
              lchild,rchild:thlinktp
              end;
var
   x:integer;
   root,pre,thrt,bt,p,q,r,s:thlinktp;
procedure add(x :integer;var p:thlinktp);
   begin
     if p=nil
       then  begin
              new(p);
              with p^ do
                begin
                  data:=x;
                  ltag:=0;              (*****)
                  rtag:=0;              (*****)  
                  lchild:=nil;
                  rchild:=nil
                  end
             end
             else with p^ do
               if x< data
                 then add(x,lchild)
                 else add(x,rchild)
              end;
  procedure inthread(p:thlinktp);
    begin
      if p<>nil then
        begin
          inthread(p^.lchild);
          if (pre<>nil) and (pre^.rtag=1) then pre^.rchild:=p;
          if p^.lchild=nil then
                      begin
                        p^.ltag:=1;
                        p^.lchild:=pre
                      end;
        if pre^.rchild=nil then                   (*****)
            begin
              pre^.rtag:=1;
              pre^.rchild:=p;
            end;
        pre:=p;
        inthread(p^.rchild);
      end;
      end;

  procedure crt_inthlinked(var thrt:thlinktp;bt:thlinktp);
     begin
       new(thrt);
       thrt^.ltag:=0;
       thrt^.rtag:=1;
       thrt^.rchild:=thrt;
       if bt =nil then thrt^.lchild:=thrt
         else begin
                thrt^.lchild:=bt;
                pre:=thrt;
                inthread(bt);
                pre^.rchild:=thrt;
                pre^.rtag:=1;
                thrt^.rchild:=pre;
                thrt^.rtag:=1;
    end;
    end;
  procedure xiansuo(thrt:thlinktp);             (**这个过程改得比较大***)
    begin
      p:=thrt^.lchild;
      while p<> thrt do
        begin
          while p^.ltag=0 do p:=p^.lchild;
          writeln(p^.data);
          while(p^.rtag=1) and (p^.rchild<>thrt) do
           begin
              p:=p^.rchild;
              writeln(p^.data);
           end;
           p:=p^.rchild;
        end;
        end;
  begin

    root:=nil;
    read(x);
    writeln(x:6);
    while x>=0 do
      begin
        add(x,root);
        read(x);
        writeln(x:6)
      end;
    writeln;
    crt_inthlinked(thrt,root);
    xiansuo(thrt);
  end.

太感谢了！