Advertisement
Guest User

Untitled

a guest
Feb 22nd, 2018
69
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.24 KB | None | 0 0
  1. const
  2. con: string[16] = '0123456789ABCDEF';
  3. var
  4. w,s:char;
  5. a, X_cel: string; //check-строка с целой/дробной частью
  6. i, res_cel,pos_toch, res: integer;
  7. res_drb:real; //почему не интегер? //CH-число из строки
  8. osn, D_cel, f: integer; //основание,целая цасть
  9. D_drb: real; //дробная часть
  10. X_drb: string; //результаты целой и дробной
  11. CEL_CHA: integer; //целое число в вычислении дробной части
  12. con1: integer;
  13.  
  14. procedure q;
  15. var
  16. i:byte;
  17. begin
  18. res:=0;
  19. for i:=1 to 16 do
  20. if w = con[i] then
  21. begin
  22. res:=i-1;
  23. break;
  24. end;
  25. end;
  26.  
  27. procedure X_D_cel;
  28. var
  29. i, E:integer;
  30. begin
  31. E:=1;
  32. for i:= length(X_cel) downto 1 do
  33. begin
  34. w:=X_cel[i];
  35. q;
  36. res_cel:=res_cel+res*E;
  37. E:=E*osn;
  38. end;
  39. end;
  40.  
  41. procedure X_D_drb;
  42. var
  43. i:integer;
  44. E:real;
  45. begin
  46. E:=1/osn;
  47. for i := 1 to length(X_drb) do
  48. begin
  49. w:=X_drb[i];
  50. q;
  51. res_drb:=res_drb +res*E;
  52. E := E / osn;
  53. end;
  54. end;
  55.  
  56.  
  57. begin
  58. writeln('Введите основание');
  59. readln(osn);
  60. writeln('Ведите число в ',osn,'-чной форме');
  61. readln(a);
  62. if a[1]='-' then
  63. begin
  64. s:=a[1];
  65. a:=copy(a,2,length(a)-1);
  66. end;
  67. for i:=1 to length(a)do
  68. if a[i]>con[osn] then
  69. begin
  70. writeln ('число не принадлежит системе');
  71. exit
  72. end;
  73. pos_toch:=pos('.',a);
  74. if pos_toch<>0 then
  75. begin
  76. X_cel:=copy(a,1,pos_toch-1);
  77. X_drb:=copy(a,pos_toch+1,length(a)-pos_toch);
  78. end
  79. else X_cel:=a;
  80. pos_toch:=pos('.',X_drb);
  81. if pos_toch<>0 then
  82. begin
  83. writeln('обнаружена лишняя точка');
  84. exit;
  85. end;
  86. X_D_cel;
  87. X_D_drb;
  88. writeln('Ответ:');
  89. write(s); write(res_cel+res_drb);
  90. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement