Форум программистов, компьютерный форум, киберфорум
Pascal (Паскаль)
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 5.00/5: Рейтинг темы: голосов - 5, средняя оценка - 5.00
0 / 0 / 0
Регистрация: 07.01.2021
Сообщений: 1
1

Исправить/оптимизировать код Pascal

07.01.2021, 08:56. Показов 871. Ответов 1

Author24 — интернет-сервис помощи студентам
Добрый день! Помогите исправить/оптимизировать код (решение нашел на просторах интернета)

Задача которая была дана:

Разработать программу создания и корректировки файла, содержащего
сведения о геометрических фигурах на плоскости (смотрите дополнительную
литературу). Каждый элемент этого файла должен содержать следующие данные: координаты базовой точки, форму (треугольник, круг или прямоугольник), для треугольника – координаты еще двух точек, для круга – радиус, для
прямоугольника – координаты противоположной точки. Программа должна
также позволять формировать текстовый файл, содержащий список фигур
заданной формы с указанием их площади и периметра.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
Program Pro;
uses Crt;
Type MyRec=Record
 base_x   :  Integer;
 base_y   :  Integer;
 form     :  Byte;   
 prm1     :  Integer;
 prm2     :  Integer;
 prm3     :  Integer;
 prm4     :  Integer;
end;
 
var
F            : file;
Rep          : Text;
ShapeRec     : MyRec;
RecCount     : Integer;
NumRec       : Integer;
FileNam      : string;
RepNam       : string;
num          : Integer;
i            : Integer;
a,b,c,s      : Real;
perim        : Real;
half_p       : Real;
act          : Integer;
 
procedure WriteData(var ShapeRec: MyRec);
begin
   write('Choose Shape (1 - triangle, 2 - circle, 3 - rectangle) :');
   readln(ShapeRec.form);
   write('Enter Base coord X :');
   readln(ShapeRec.base_x);
   write('Enter Base coord Y :');
   readln(ShapeRec.base_y);
   case ShapeRec.form of
     1: begin
           write('Enter first triangle virtex X:');
           readln(ShapeRec.prm1);
           write('Enter first triangle vertex Y:');
           readln(ShapeRec.prm2);
           write('Enter second triangle vertex X:');
           readln(ShapeRec.prm3);
           write('Enter second triangle vertex Y:');
           readln(ShapeRec.prm4);
      end;
   2: begin
        write('Enter circle radius  R:');
        readln(ShapeRec.prm1);
      end;
   3: begin
        write('Enter opposite point  X:');
        readln(ShapeRec.prm1);
        write('Enter opposite point  Y:');
        readln(ShapeRec.prm2);
      end;
   end;
end;
 
begin
write('Choose action (1 - create file,2- open file, 2 file, 3- exit):');
readln(act);
if (act>1) or (act>3)then act:=3;
case act of
 1: begin
        write('Input FileName to create:');
        readln(FileNam);
        Assign(F,FileNam);
        Rewrite(F, 1);
     end;
  2:begin
       write('Input FileName to open:');
       readln(FileNam);
       Assign(F,FileNam);
       Reset(F, 1);
    end;
  3:begin
        exit;
    end;
 end;
 
 repeat
 write('Choose action: ( 1 - Add Shape,2 - Edit Shape,3 - Create report, 4 - Exit ):');
 readln(act);
 case act of
   1: begin
          writeln('---------------Add Record --------------------'); 
          WriteData(ShapeRec);
          writeln('---------------------------------------------');
          Seek(F,FileSize(F));
          BlockWrite(F,ShapeRec,SizeOf(ShapeRec),num);
       end;
   2:Begin
         if FileSize(F)>=SizeOf(ShapeRec) then begin
           RecCount:=FileSize(f) div SizeOf(ShapeRec);
           write('Choose Record to edit: 1 ..',RecCount,':');
           readln(NumRec);
           Seek(F,(NumRec-1)*SizeOf(ShapeRec));
           BlockRead(F,ShapeRec,SizeOf(ShapeRec),num);
           writeln('------------------ Editing Record -----------------');
           case ShapeRec.form of
             1: Begin
                 writeln('Record No:',NumRec,': triangle',', Base',',ShapeRec.base_x,');
                 writeln('First vertex ',ShapeRec.prm1,'x',ShapeRec.prm2);
                 writeln('Second vertex',ShapeRec.prm3,' x ',ShapeRec.prm4);
                end;
 
             2:begin
                 writeln('Record No:',NumRec,':rectangle',',Base',ShapeRec.base_x,'x',ShapeRec.base_y,'y');
                 writeln('Radius',ShapeRec.prm1);
               end;
             3:begin
                 writeln('Record No:',NumRec,':rectangle',',Base',',ShapeRec.base_x,');
                 writeln('Opposite point',ShapeRec.prm1,'x',ShapeRec.prm2);
               end;
           end;
           WriteData(ShapeRec);
           writeln('--------------------------------------------');
           Seek(F,(NumRec-1)*SizeOf(ShapeRec));
           BlockWrite(F,ShapeRec,SizeOf(ShapeRec),num);
        end else writeln('File is empty!');
    end;
 3: begin
       if FileSize(F)>=SizeOf(ShapeRec)then begin
         Reset(F,1);
         write('Input FileName for Report:');
         readln(RepNam);
         RecCount:=FileSize(F) div SizeOf(ShapeRec);
         for i:=1 to RecCount do begin
            BlockRead(F,ShapeRec,SizeOf(ShapeRec),num);
            case ShapeRec.form of
              1: begin
                  writeln(Rep,i,'.Треугольик');
                  writeln(Rep,'Коордиты бзы x=',ShapeRec.base_x,',y=',ShapeRec.base_y,'');
                  writeln(Rep,'Коордиты вершиы 1 x=',ShapeRec.prm1,',y=',ShapeRec .prm2,'');
                  writeln(Rep,'Коордиты вершы 2 x=',ShapeRec.prm3,',y',ShapeRec.prm4,'');
 
                  a:=sqrt(sqr(ShapeRec.base_x-ShapeRec.prm1)+sqr(ShapeRec.base_y-ShapeRec.prm2));
                  b:=sqrt(sqr(ShapeRec.prm1-ShapeRec.prm3)+sqr(ShapeRec.prm2-ShapeRec.prm4));
                  c:=sqrt(sqr(ShapeRec.prm3-ShapeRec.base_x)+sqr(ShapeRec.prm4-ShapeRec.base_y));
                  perim:=a+b+c;
                  half_p:=perim/2;
                  s:=sqrt(half_p*(half_p - a)*(half_p - b)*(half_p - c)); {Формул Геро}
                  writeln(Rep,'Периметр',  Trunc(perim));
                  writeln(Rep,'Площдь ',  Trunc(s));
                  writeln(Rep);
                 end;
              2: begin
                  writeln(Rep,i,'.Круг');
                  writeln(Rep,'Коордиты бзы   x=',ShapeRec.base_x,',y=',ShapeRec.base_y,'');
                  writeln(Rep,'Рдиус', ShapeRec.prm1);
                  perim:=2*PI*ShapeRec.prm1;
                  s:=PI*ShapeRec.prm1*ShapeRec.prm1;
                  writeln(Rep,'Дли окружости',Trunc(perim));
                  writeln(Rep,'Площдь',Trunc(s));
                  writeln(Rep);
                 end;
              3: begin
                  writeln(Rep,i,'.Прямоугольик');
                  writeln(Rep,'Коордиты бзы  x=',ShapeRec.base_x,',y=',ShapeRec. base_y,'');
                  writeln(Rep,'Противопол. точк x=',ShapeRec.prm1,',y=',ShapeRec.prm2,'');
                  a:=abs(ShapeRec.base_x - ShapeRec.prm1);
                  b:=abs(ShapeRec.base_y - ShapeRec.prm2);
                  perim:=(a+b)*2;
                  s:=a*b;
                  writeln(Rep,'Периметр',Trunc(perim));
                  writeln(Rep,'Площдь',Trunc(s));
                  writeln(Rep);
                 end;
            end;
         end;
         Close(Rep);
       end else writeln('File is empty!');
     end;
 end;
 until act=4;
 Close(f);
 end. end.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
07.01.2021, 08:56
Ответы с готовыми решениями:

Исправить код для Free pascal WinGraph
Здравствуйте,уважаемые форумчане,как исправить это код для Free pascal WinGraph? uses crt,graph;...

Нужно перевести код из Turbo Pascal в Pascal ABC.NET
Доброго времени суток. На форуме находил похожие темы, но к сожалению так и не смог разобраться....

Нужно перевести код с Pascal ABC на Turbo Pascal - рисование работающей мельницы
Вот код, он должен рисовать работающею мельницу. uses graphABC,crt; type point=record ...

Можно как-то переделать код из Turbo Pascal чтобы он работал в pascal abc.net?
Сделайте пожалуйста, я просто не вникаю uses Graph, Crt; var grDriver: integer; grMode:...

1
Модератор
Эксперт Pascal/DelphiЭксперт NIX
7769 / 4598 / 2823
Регистрация: 22.11.2013
Сообщений: 13,077
Записей в блоге: 1
07.01.2021, 22:52 2
Пойдём резать "хвост" частями...
1)
63: имелось в виду (act<1) or (act>3).
Но поскольку case сам себе if, логичнее и проще
Pascal
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
case act of
 1: begin
        Write('Input FileName to create:');
        ReadLn(FileNam);
        Assign(F,FileNam);
        Rewrite(F, 1);
     end;
  2:begin
       Write('Input FileName to open:');
       ReadLn(FileNam);
       Assign(F,FileNam);
       Reset(F, 1);
    end;
  else
        Exit;
 end;
2)
Использовать F: file и BlockRead/Block Write вместо F: file of MyRec — затея так себе.
3)
Глобальные переменные без нужды — зло.

Добавлено через 5 минут
4)
Возможно, имело смысл использовать записи с вариантом.
5)
Возможно, имело смысл использовать ООП с базовым классом и наследованием, а, возможно, и не имело. Каких-то особых плюсов не дало бы.
0
07.01.2021, 22:52
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
07.01.2021, 22:52
Помогаю со студенческими работами здесь

Перевести в код Pascal ABC из кода Pascal Delphi
procedure TForm1.Button1Click(Sender: TObject); const n=8; var x:array of real; y,z:array of...

Перевести в код Pascal ABC из кода Pascal Delphi
Помогите перевести в код ABC а то с Delphi вообще не знаком. Задание было такое: Записать в файл...

Нужно перевести код из Turbo Pascal в Pascal ABC
Program n5; { Задача. Описать функцию less(f) от непустого файла f ...

Оптимизировать код
Помогите оптимизировать код Function cm(Message: String): String; Begin Result:=...

Переписать код из Turbo Pascal в Pascal ABC
Переписать код из Turbo Pascal в Pascal ABCprogram zadacha; uses crt, graph; const m=150; var...

Переписать код из Turbo Pascal в pascal ABC
очень плохо знаю Turbo Pascal, а времени на изучение нет, а его надо переписать в Pascal ABC, буду...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
2
Ответ Создать тему
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru