HILBERT.PAS 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130
  1. {==================}
  2. {ˆ­ä®p¬ â¨ª  1999/8}
  3. {==================}
  4. { Šp¨¢ë¥ ƒ¨«ì¡¥pâ  }
  5. {==================}
  6. uses CRT, Graph;
  7. const
  8. del = 1; {§ ¤¥p¦ª }
  9. path = ''; {ä ©«ë *.bgi ¢ p ¡®ç¥¬ ª â «®£¥}
  10. var
  11. d, r : integer;
  12. n, orient : byte;
  13. x0, y0, s, h, hscr, wscr : word;
  14. prs : real;
  15. procedure LineDown;
  16. begin LineRel (0, h) end;
  17. procedure LineUp;
  18. begin LineRel (0, -h) end;
  19. procedure LineLeft;
  20. begin LineRel (-h, 0) end;
  21. procedure LineRight;
  22. begin LineRel (h, 0) end;
  23. procedure GD (i : byte); forward;
  24. procedure GU (i : byte); forward;
  25. procedure GL (i : byte);
  26. begin
  27. if i > 0 then
  28. begin
  29. GD (i-1); LineLeft;
  30. GL (i-1); LineDown;
  31. GL (i-1); LineRight;
  32. GU (i-1); Delay (del);
  33. end
  34. end;
  35. procedure GR (i : byte);
  36. begin
  37. if i > 0 then
  38. begin
  39. GU (i-1); LineRight;
  40. GR (i-1); LineUp;
  41. GR (i-1); LineLeft;
  42. GD (i-1); Delay (del);
  43. end
  44. end;
  45. procedure GU;
  46. begin
  47. if i > 0 then
  48. begin
  49. GR (i-1); LineUp;
  50. GU (i-1); LineRight;
  51. GU (i-1); LineDown;
  52. GL (i-1); Delay (del);
  53. end
  54. end;
  55. procedure GD;
  56. begin
  57. if i > 0 then
  58. begin
  59. GL (i-1); LineDown;
  60. GD (i-1); LineLeft;
  61. GD (i-1); LineUp;
  62. GR (i-1); Delay (del);
  63. end
  64. end;
  65. function Power2 (n : byte) : word; {¢®§¢¥¤¥­¨¥ 2 ¢ á⥯¥­ì n}
  66. var p, i : word;
  67. begin
  68. p := 2;
  69. for i := 1 to n-1 do p := p * 2;
  70. Power2 := p
  71. end;
  72. BEGIN
  73. ClrScr;
  74. {¢¢®¤ ¨á室­ëå ¤ ­­ëå ¤«ï ¯®áâp®¥­¨ï ªp¨¢®© ƒ¨«ì¡¥pâ }
  75. repeat
  76. Write ('‚¢¥¤¨â¥ ¤«¨­ã áâ®p®­ë ®¯®p­®£® ª¢ ¤p â ');
  77. Write (' ¢ % ®â ¢ëá®âë íªp ­  ');
  78. ReadLn (prs)
  79. until prs < 100;
  80. Write ('‚¢¥¤¨â¥ ¯®p冷ª ªp¨¢®© ');
  81. ReadLn (n);
  82. repeat
  83. Write ('‚¢¥¤¨â¥ ®p¨¥­â æ¨î ªp¨¢®©:');
  84. Write ('¢¢¥på - 1, ¢­¨§ - 2, ¢¯p ¢® - 3, ¢«¥¢® - 4 ');
  85. ReadLn (orient)
  86. until (orient >= 1) and (orient <= 4);
  87. d := detect;
  88. InitGraph (d, r, path);
  89. SetColor (LightRed);
  90. hscr := GetMaxY + 1; {¢ëá®â  íªp ­ }
  91. wscr := GetMaxX + 1; {è¨p¨­  íªp ­ }
  92. s := Round (prs / 100 * hscr); {áâ®p®­  ª¢ ¤p â }
  93. h := Round (s / Power2 (n) - 1); {¤«¨­  á¢ï§®ª}
  94. {H å®¤¨¬ ª®®p¤¨­ âë ­ ç «ì­®© â®çª¨ ªp¨¢®©. „«ï ®p¨¥­â æ¨¨:
  95. ¢¢¥på ¨ ¢¯p ¢® ­ ç «ì­ ï â®çª  - «¥¢ ï ­¨¦­ïï â®çª  ª¢ ¤p â ;
  96. ¢­¨§ ¨ ¢«¥¢® - ¯p ¢ ï ¢¥på­ïï â®çª  ª¢ ¤p â }
  97. case orient of
  98. 1, 3 : {¢¢¥på ¨«¨ ¢¯p ¢®}
  99. begin
  100. x0 := wscr div 2 - s div 2;
  101. y0 := hscr div 2 + s div 2
  102. end;
  103. 2, 4 : {¢­¨§ ¨«¨ ¢«¥¢®}
  104. begin
  105. x0 := wscr div 2 + s div 2;
  106. y0 := hscr div 2 - s div 2
  107. end;
  108. end; {case}
  109. MoveTo (x0, y0);
  110. case orient of
  111. 1 : GU (n);
  112. 2 : GD (n);
  113. 3 : GR (n);
  114. 4 : GL (n)
  115. end;
  116. ReadLn;
  117. CloseGraph
  118. END.