freepascal吧 关注:250贴子:915


1楼2016-05-07 20:29回复
    不定期发程序,编好就发


    2楼2016-05-07 20:30
    回复
      广告
      立即查看
      输入行数和组成沙漏的符号,打印沙漏


      3楼2016-05-07 20:36
      回复
        var
        n,i,j:longint;
        c:string;
        begin
        readln(n);{读入行数}
        n:=n div 2;
        for i:=-n to n do
        begin
        for j:=-abs(i) to 1 do write(' ');
        for j:=1 to abs(i)*2+1 do write(c);
        writeln;
        end;
        readln;
        end.


        5楼2016-05-07 20:41
        回复
          可能有错,我的PAS文件搞丢了


          6楼2016-05-07 20:42
          回复
            这是什么?


            7楼2016-05-08 11:54
            回复
              程序应该是想打印类似的图形。不过程序有误,我改了一下,仅供参考:
              var
              n,i,j:longint;
              c:char;
              begin
              c:='#';
              readln(n);{读入半个沙漏的行数}
              for i:=-n to n do
              begin
              for j:=1 to n-abs(i) do write(' ');
              for j:=1 to abs(i)*2+1 do write(c);
              writeln;
              end;
              readln;
              end.


              IP属地:浙江8楼2016-06-22 21:44
              回复
                大家都不喜欢goto啊。


                IP属地:陕西9楼2016-06-27 22:06
                回复
                  广告
                  立即查看
                  哎呀哎呀,好久没来了,因为找不到帖子了
                  感谢 @尚格羊顿 @happyzyfsjtu ,你们的程序我试过了


                  11楼2016-08-07 08:14
                  收起回复
                    var
                    x,y:longint;
                    begin
                    writeln('Find the greatest common divisor of tow numbers');
                    write('What two numbers are?');
                    readln(x,y);
                    while not(x=y)do
                    if x>y then x:=x-y
                    else y:=y-x;
                    write('Thier greatest common multple is ',x);
                    readln;
                    end.


                    12楼2016-08-07 08:14
                    回复
                      我难得发一个SB程序:
                      uses crt;
                      var
                      x:string;
                      y:shortint;
                      begin
                      read(x);
                      while 0=0 do begin
                      randomize;
                      y:=random(15);
                      textcolor(y);
                      write(x);
                      end;
                      end.


                      13楼2016-08-07 08:16
                      回复
                        输入12345以后是这样的


                        14楼2016-08-07 08:20
                        回复
                          欧,还有这个:
                          uses,crt;
                          var
                          i,k:longint;
                          j:longint;
                          x:boolean;
                          c:string;
                          begin
                          writeln('你想要彩色吗?T:要;F:不要。');
                          readln(c);
                          i:=1;
                          while i<2147483646 do begin
                          i:=i+1;
                          x:=true;
                          for j:=2 to i-1 do if i mod j=0 then begin x:=false;end;
                          if x then begin if c='T' then begin randomize; c:=random(0..15); textcolor(c);end; k:=k+1;write('第',k,'个质数是:',i);readln;end;
                          end;
                          readln;
                          writeln('这些就是1到2147483646的所有质数。');
                          readln;
                          writeln;
                          end.


                          15楼2016-08-07 08:30
                          收起回复
                            终于啊!约瑟夫问题编好了:
                            var
                            m:array[1..50]of shortint;
                            x,i,n,j,k:longint;
                            begin
                            readln(n,x);
                            for i:=1 to n do m[i]:=1;
                            i:=0;
                            while not(j=1) do begin
                            j:=0;
                            inc(k);
                            if k>n then k:=1;
                            inc(i);
                            if m[k]=0 then dec(i);
                            if i mod x=0 then begin m[k]:=0;for i:=1 to n do j:=j+m[i];i:=0; end;
                            end;
                            for i:=1 to n do if m[i]=1 then write (i);
                            readln;
                            writeln;
                            end.


                            16楼2016-08-07 09:02
                            回复
                              广告
                              立即查看
                              @happyzyfsjtu
                              @尚阁羊顿
                              一毛(十分)感谢


                              17楼2016-08-09 09:58
                              回复