Форум программистов, компьютерный форум, киберфорум
Turbo Pascal
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/6: Рейтинг темы: голосов - 6, средняя оценка - 5.00
1 / 1 / 0
Регистрация: 21.03.2013
Сообщений: 148
1

Вызвать процедуру\функцию из другого объекта\класса. Из одного класса\объекта сделать два

06.12.2016, 02:29. Просмотров 1197. Ответов 4

Здравствуйте.
Подскажите что не правильно делаю, и возможно ли вообще - вызвать процедуру\функцию из другого объекта\класса, в турбо паскале?
Хочу сделать из одного класса\объекта два.. Но чё-т как-то не получается.

Исходный код не влез, прикрепил тхт файлом. И переделанное тоже прикрепил.

Вот во что пытался переделать:
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
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
Program Pirog;
uses crt,graph;
 
const numb = 12; {Кол-во кусочков, на которые делить пирог}
      cherry = 4;{В каком из кусочков лежит вишенка) }
      attempts = 2;{Кол-во кусочков, которых можно выбрать за 1 раз }
      debug = false;
type
    arra = array[1..48] of integer; {Массив для хранения индексов кусочков, которые скушаны}
    ar = array[1..48,1..48] of integer; {Массив для хранения углов кусочков}
 
    {"""""""""""""""""}
    {------ПИРОГ------}
    {_________________}
 
    TCake = object     {Объявили класс}
 
         eaten:arra;         {Массив для хранения индексов кусочков, которые скушаны }
         choicecount:integer;{Счётчик выбора}
         procedure playerselect;
         procedure compselect;
         procedure winner(nam:integer);
         procedure ChoiceMore;
         function nextselect:integer;
         function nextselectright:integer;
 
    end;
    
     TCakeDraw = object     {Объявили класс}
 
         arr:ar;             {Массив для хранения углов кусочков  }
         eatind:integer;     {Последнего скушанного кусочка}
         partoc:integer;     {Текущий кусочек пирога }
         procedure show;
         procedure divide(nofp:integer);
         procedure selectcherry;
         procedure select(nn:integer);
         procedure clearselect(nn:integer);
         procedure eat(nn:integer);
         
    end;
 
    {"""""""""""""""""""""}
    {Вывод на екран пирога}
    {_____________________}
 
    procedure TCakeDraw.show;
      begin
        pieslice(300,250,0,360,200); {Рисуем и закрашиваем пирог}
        SetTextStyle(0,0,3);
         SetColor(15);
        OutTextXY(240,10,'Пирог!');
      end;
 
    {                                                                           }
    {"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""}
    { Делим пирог на указанное кол-во частей и записываем их координаты в массив}
    {___________________________________________________________________________}
 
    procedure TCakeDraw.divide(nofp:integer);
     var a,b,i,np:integer;
      begin
       np:=round(360/nofp); {Делим на ровные кусочки}
       a:=0;
       b:=0+np;
       for i:=1 to nofp do
        begin
          arr[1,i]:=a;
          arr[2,i]:=b;
          a:=a+np;
          b:=b+np;
         end;
       selectcherry;
       TCake.choicecount:=attempts;
       eatind:=1;
       partoc:=1;
      end;
 
    {                                                }
    {""""""""""""""""""""""""""""""""""""""""""""""""}
    { Выделяем кусок пирога, в котором лежит вишенка }
    {________________________________________________}
 
    procedure TCakeDraw.selectcherry;
     begin
      SetFillStyle(XHatchFill,4);
      pieslice(300,250,arr[1,cherry],arr[2,cherry],200);
     end;
 
    {                          }
    {""""""""""""""""""""""""""}
    { Выделяем кусочек пирога  }
    {__________________________}
 
    procedure TCakeDraw.select(nn:integer);
     var i:integer;
     begin       SetFillStyle(XHatchFill,1);
         pieslice(300,250,arr[1,nn],arr[2,nn],200);
 
     end;
 
    {                   }
    {"""""""""""""""""""}
    { Снимаем выделение }
    {___________________}
 
    procedure TCakeDraw.clearselect(nn:integer);
     begin
      SetFillStyle(XHatchFill,15);
      pieslice(300,250,arr[1,nn],arr[2,nn],200);
     end;
 
    {         }
    {"""""""""}
    { Съедаем }
    {_________}
 
    procedure TCakeDraw.eat(nn:integer);
     begin
      SetFillStyle(SolidFill,0);
      pieslice(300,250,arr[1,nn],arr[2,nn],200);
     end;
    
    {                                                    }
    {""""""""""""""""""""""""""""""""""""""""""""""""""""}
    { Пропуск выделенных кусочков или кусочка с вишенкой }
    {____________________________________________________}
 
    function TCake.nextselect:integer;
     var i:integer; ok:boolean;
     begin
       for i:=1 to numb do
        begin
         if (TCakeDraw.partoc = eaten[i]) or (TCakeDraw.partoc = cherry) then
          begin
            TCakeDraw.partoc:=TCakeDraw.partoc+1;
            if TCakeDraw.partoc > numb then
              TCakeDraw.partoc:=1;
            TCake.nextselect;
          end
         else
          nextselect:=TCakeDraw.partoc;
        end;
     end;
    
    function TCake.nextselectright:integer;
     var i:integer; ok:boolean;
     begin
       for i:=1 to numb do
        begin
         if (partoc = eaten[i]) or (partoc = cherry) then
          begin
            partoc:=partoc-1;
            if partoc < 1 then
              partoc:=numb;
            TCake.nextselectright;
          end
         else
          nextselectright:=partoc;
        end;
     end;
 
    
 
    {                      }
    {""""""""""""""""""""""}
    { Выбираем ещё кусочек }
    {______________________}
    procedure TCake.playerselect;
     var k,i,j:integer;
       begin
 
        if TCakeDraw.eatind = numb then
        winner(0)
        else
        begin
        TCakeDraw.partoc:=nextselect;
        select(TCakeDraw.partoc);
 
         repeat
          k:=ord(readkey);
          if debug then
            writeln(k);
          case k of
 
          {<- <- <- <- <- <- <- <- <- <- <-}
          { Кнопка влево <- <- <- <- <- <- }
          {<- <- <- <- <- <- <- <- <- <- <-}
          75: begin
              clearselect(TCakeDraw.partoc);
              TCakeDraw.partoc:=TCakeDraw.partoc+1;
 
              if TCakeDraw.partoc>numb then
                TCakeDraw.partoc:=1;
              select(nextselect);
          end;
 
          {-> -> -> -> -> -> -> -> -> -> ->}
          { Кнопка вправо-> -> -> -> -> -> }
          {-> -> -> -> -> -> -> -> -> -> ->}
          77: begin
             clearselect(TCakeDraw.partoc);
             TCakeDraw.partoc:=TCakeDraw.partoc-1;
             if TCakeDraw.partoc<1 then
               TCakeDraw.partoc:=numb;
             Select(nextselectright);
          end;
 
          {ENTER ENTER ENTER ENTER ENTER}
          { Кнопка ENTER  }
          {ENTER ENTER ENTER ENTER ENTER }
          13: begin
           eaten[TCakeDraw.eatind]:=TCakeDraw.partoc;
           TCakeDraw.eatind:=TCakeDraw.eatind+1;
           eat(TCakeDraw.partoc);
           TCakeDraw.partoc:=partoc+1;
           if TCakeDraw.partoc>numb then
                TCakeDraw.partoc:=1;
           Select(nextselectright);
           if debug then
                writeln('choices: ',choicecount);
           if not (choicecount = 0) then
             begin
              choicecount:=choicecount-1;
              ChoiceMore;
           end
            else compselect;
          end;
          {____________________________________________________}
         end;
        until k=32;
        end;
       end;
 
    {                 }
    {"""""""""""""""""}
    { Компьютер ходит }
    {_________________}
 
    Procedure TCake.compselect;
     var kompatt, chosenpart,i,j,l,kol:integer;
     begin
       choicecount:=attempts;
       kol:=0;
 
       if TCakeDraw.eatind = numb then
        winner(1)
       else
      begin
       kompatt:=random(attempts+1);
 
       if TCakeDraw.eatind = numb-1 then
         kompatt:=1;
       if TCakeDraw.eatind = numb-2 then
         kompatt:=2;
       if TCakeDraw.eatind = numb-3 then
         kompatt:=3;
       if kompatt = 0 then
        kompatt:=1;
       if kompatt >= attempts+1 then
        kompatt:=attempts;
 
       for i:=1 to kompatt do
         begin
           repeat
            chosenpart:=random(numb);
             if chosenpart = 0 then
               chosenpart:=1;
              if not (chosenpart = eaten[i]) and not (chosenpart = cherry) then
               begin
                eat(chosenpart);
                eaten[TCakeDraw.eatind]:=chosenpart;
                TCakeDraw.eatind:=TCakeDraw.eatind+1;
                kol:=kol+1;
               end;
 
           until kol >= kompatt;
          end;
        playerselect;
      end;
     end;
 
    {                          }
    {""""""""""""""""""""""""""}
    { Ход ещё или окончить ход }
    {__________________________}
 
    procedure TCake.ChoiceMore;
     var key,ch:integer;
       begin
         SetTextStyle(0,0,2);
 
         SetColor(15);
         OutTextXY((GetMaxX-600),(GetMaxY-200),'Взять ещё кусочек');
         OutTextXY((GetMaxX-300),(GetMaxY-200),'Поделиться с компом');
 
 
         repeat
         key:=ord(readkey);
         case key of
           75: begin { Отрисовка если перемещаемся ВЛЕВО }
               SetColor(0);
               Rectangle((GetMaxX-310),(GetMaxY-210),(GetMaxX-50),(GetMaxY-110));
               SetColor(15);
               Rectangle((GetMaxX-610),(GetMaxY-210),(GetMaxX-300),(GetMaxY-110));
               OutTextXY((GetMaxX-600),(GetMaxY-200),'Взять ещё кусочек');
               OutTextXY((GetMaxX-300),(GetMaxY-200),'Поделиться с компом');
               ch:=1;
 
 
           end;
 
            77: begin { Отрисовка если перемещаемся ВПРАВО }
 
               SetColor(0);
               Rectangle((GetMaxX-610),(GetMaxY-210),(GetMaxX-300),(GetMaxY-110));
               SetColor(15);
               Rectangle((GetMaxX-310),(GetMaxY-210),(GetMaxX-50),(GetMaxY-110));
               OutTextXY((GetMaxX-600),(GetMaxY-200),'Взять ещё кусочек');
               OutTextXY((GetMaxX-300),(GetMaxY-200),'Поделиться с компом');
               ch:=0;
 
            end;
 
            13: begin { Отрисовка если выбрали кусочек}
                SetFillStyle(SolidFill,0);
                Bar((GetMaxX-610),(GetMaxY-210),GetMaxX,GetMaxY);
                if ch = 1 then
                  begin
                   playerselect;
                   if debug then
                     writeln('Взять кусок.');
                  end;
                if ch = 0 then
                  begin
                   compselect;
                   if debug then
                     writeln('Отдать компу.');
                  end;
 
            end;
            end;
         until key=27; {Пока не нажали ЕСКейп, выход}
 
       end;
 
    {                                                }
    {""""""""""""""""""""""""""""""""""""""""""""""""}
    {  Поздравляем или огорчаем }
    {-----------------------------------------------------------------------}
     procedure TCake. winner(nam:integer);
      begin
       SettextStyle(0,0,5);
       SetColor(Green);
       if nam=0 then
        OutTextXY(80,250,'Ты проиграл!');
       if nam=1 then
        OutTextXY(80,250,'Ты выиграл!!!');
       Readln;
       CloseGraph;
      end;
 
 
 
    {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
    {                        ПИРОГ ГОТОВ :)                                 }
    {///////////////////////////////////////////////////////////////////////}
 
 
var
   Gd, Gm,
   k,
   i: Integer;
   cakeDraw:TCakeDraw;
   cake:TCake;
 
Begin
clrscr;
Gd := Detect;
Gm := Vgahi;
InitGraph(Gd, Gm, 'C:\tp7\BIN');
if GraphResult <> grOk then
  Halt(1);
 
Randomize;
SetFillStyle(XHatchFill, 15);
cakeDraw.show;
cakeDraw.divide(numb);
 
k:=random(2);
if k=0 then
  cake.compselect;
if k=1 then
  cake.playerselect;
CloseGraph;
readln;
End.
Если кто поможет буду при много благодарен.
0
Вложения
Тип файла: txt PIROG .txt (10.6 Кб, 1 просмотров)
Тип файла: txt PIROGS.txt (11.1 Кб, 1 просмотров)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
06.12.2016, 02:29
Ответы с готовыми решениями:

Спрятать указатель на функцию класса в map и вызвать из другого объекта
Товарищи, пишу примитивный &quot;tcp-сервер&quot;. В его задачи входит принятие соединений и получение...

Объявление объекта одного класса в описании другого класса
Здравствуйте. Почему при объявлении Student s в классе Teacher не возникает ошибки? Ведь такой...

Вызвать функцию класса без создания объекта
Можно ли так сделать? Точнее я знаю что можно, но у меня не получается, я хочу чтобы вот например...

Два объекта одного класса
пытаюсь понять OpenGl es 2 для этого использую пример ...

4
Модератор
Эксперт Pascal/DelphiЭксперт NIX
5665 / 3385 / 2424
Регистрация: 22.11.2013
Сообщений: 9,511
Записей в блоге: 1
07.12.2016, 00:26 2
Pascal
72
73
74
75
procedure TCakeDraw.divide(nofp:integer);
...
  TCake.choicecount:=attempts;
...
См. строку 74: в данном случае вызывать можно метод экземпляра класса, но не типа.

Добавлено через 13 минут
Задание же всем желающим предлагается угадать самостоятельно. Браво.
0
1 / 1 / 0
Регистрация: 21.03.2013
Сообщений: 148
07.12.2016, 19:09  [ТС] 3
Задание разделить один класс на два. А если запустить первый файл - то можно увидеть что всё из себя представляет..
В первом Пирог.тхт - всё работает.
Во втором - моя попытка разделить один класс на два класса.
Но проблема в том, что некоторые процедуры одного класса вызываются в другом классе. И не работает в таком случае.
0
Модератор
Эксперт Pascal/DelphiЭксперт NIX
5665 / 3385 / 2424
Регистрация: 22.11.2013
Сообщений: 9,511
Записей в блоге: 1
09.12.2016, 21:53 4
Значит способ деления выбрали неверный.
0
1 / 1 / 0
Регистрация: 21.03.2013
Сообщений: 148
10.12.2016, 23:49  [ТС] 5
Ясно понятно
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
10.12.2016, 23:49

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Как из одного объекта получить объект другого класса?
Форумчане, подскажите. У меня есть два класса: class Category{ private $id = ''; private...

Передача данных объекта одного класса , объекту другого
Доброго времени суток. В общем, столкнулся с проблемой передачи данных от одного класса другому....

С помощью делегата из одного класса вызвать private метод с другого класса
доброго времени суток. такой вопрос. С применением делегатов и пониманием проблем нет когда...

Как побитово сравнить два объекта одного класса
Здравствуйте! Возник следующий вопрос: можно ли, имея два объекта одного класса, найти их битовое...


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

Или воспользуйтесь поиском по форуму:
5
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.