Форум программистов, компьютерный форум, киберфорум
C++ Builder
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.75/4: Рейтинг темы: голосов - 4, средняя оценка - 4.75
0 / 0 / 0
Регистрация: 20.05.2013
Сообщений: 14
1

Как переделать из Delphi в С++:

20.05.2013, 15:05. Просмотров 655. Ответов 4
Метки нет (Все метки)


Delphi
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
uses draw, game, save, load, exit, help, about;
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
  getdir(0,path);
  status:=0;
  for i:=1 to 4 do bones[i]:=0;
  for i:=1 to 4 do bones2[i]:=0;
  varbones(sender);
  for i:=1 to 26 do mas[i,1]:=0;
  for i:=1 to 26 do mas[i,2]:=0;
  for i:=1 to 26 do mas2[i,1]:=0;
  for i:=1 to 26 do mas2[i,2]:=0;
  mas[1,1]:=1;
  mas[1,2]:=15;
  mas[13,1]:=2;
  mas[13,2]:=15;
  mas[25,1]:=1;
  mas[26,1]:=2;
  mas2[1,1]:=1;
  mas2[1,2]:=15;
  mas2[13,1]:=2;
  mas2[13,2]:=15;
  mas2[25,1]:=1;
  mas2[26,1]:=2;
  draw.visible(sender);
  draw.redraw(sender);
end;
 
procedure TForm1.niClick(Sender: TObject); // i – от 1 до 24 
begin
  game.variants(sender,1);
end;
 
procedure TForm1.miClick(Sender: TObject); // i  - от 1 до 24
begin
  game.move(sender,1);
end;
 
procedure TForm1.bldomclickClick(Sender: TObject);
begin
  game.movehouse(Sender,26,zar);
end;
 
procedure TForm1.bones_clickClick(Sender: TObject);
begin
  game.bonesclick(sender);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var z1,z2:integer;
begin
  If messagedlg('Вы действительно хотите начать новую игру?',mtinformation,[mbOk,mbCancel],0)=1 then begin
  formcreate(sender);
  z1:=random(6)+1;
  z2:=random(6)+1;
  if z1=z2 then form1.Button1Click(sender)
  else begin
  if z1>z2 then player:=2;
  if z2>z1 then player:=1;
  if z1<>z2 then status:=2;
  wf:=0;
  blf:=0;
  messagedlg('Начинающий игрок определен случайным образом, бросьте зары',mtinformation,[mbok],0);
  bones_click.Enabled:=true;
  end;
  end;
end;
 
 
procedure TForm1.Button2Click(Sender: TObject);
var i,j:integer;
begin
  for i:= 1 to 26 do
    for j:= 1 to 2 do mas[i,j]:=mas2[i,j];
  for i:=1 to 4 do bones[i]:=bones2[i];
  golova:=0;
  draw.visible(sender);
  draw.redraw(sender);
  varbones(sender);
end;
 
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  form2.ShowModal;
end;
 
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
form3.ShowModal;
end;
 
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
form4.ShowModal;
end;
 
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
form5.showmodal;
end;
 
procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
form4.ShowModal;
end;
 
procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
application.Minimize;
end;
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(Form1.Handle, WM_SysCommand,$F012, 0);
end;
 
procedure TForm1.SpeedButton7Click(Sender: TObject);
begin
form6.showmodal;
end;
 
procedure TForm1.wdomclickClick(Sender: TObject);
begin
  game.movehouse(Sender,25,zar);
end;
 
end.
Модуль GAME содержит процедуры реализации игрового процесса
Delphi
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
uses main, draw;
 
procedure variants(Sender: TObject; num:integer);
var x,sum,i,j:integer;
begin
  if status=2 then begin
  messagedlg('Бросьте зары',mtinformation,[mbok],0);
  exit;
  end;
  if (status=1) and (mas[num,1]=player) then begin
    if player=1 then begin
      sum:=0;
      for i:=19 to 25 do
      if mas[i,1]=1 then sum:=sum+mas[i,2];
      if sum=15 then begin
        draw.visible(Sender);
        nomer:=num;
        for i:=1 to 4 do if bones[i]<>0 then begin
          x:=num+bones[i];
          sum:=0;
          for j:=18 to num-1 do if mas[j,1]=player then sum:=sum+mas[j,2];
          if (sum=0) and (x>25) then x:=25;
          if x=25 then zar:=i;
          if x<26 then if (mas[x,1]=player) or (mas[x,1]=0) then arrow(sender,x);
          end;
          exit;
        end;
      end;
    if player=2 then begin
      sum:=0;
      for i:=7 to 12 do
      if mas[i,1]=2 then sum:=sum+mas[i,2];
      sum:=sum+mas[26,2];
      if sum=15 then begin
        visible(Sender);
       nomer:=num;
        for i:=1 to 4 do if bones[i]<>0 then begin
          x:=num+bones[i];
         sum:=0;
         for j:=6 to num-1 do if mas[j,1]=player then sum:=sum+mas[j,2];
         if (sum=0) and (x>13) then x:=13;
         if x=13 then x:=26;
         if x=26 then zar:=i;
         if x<27 then if (mas[x,1]=player) or (mas[x,1]=0) then if (x<13) or (x=26) then arrow(sender,x);
        end;
        exit;
      end;
    end;
  end;
  if (status=1) and (mas[num,1]=player) then
  if ((mas[num,1]=1) and (num=1) and (golova=2)) or ((mas[num,1]=2) and (num=13) and (golova=2)) then else begin
  visible(Sender);
  nomer:=num;
  if bones[1]<>0 then begin
    x:=num+bones[1];
    if (mas[num,1]=2) and (x>24) then x:=x-24;
    if (x>24) or ((mas[num,1]=2) and (num<=12) and (x>12)) then else
    if (mas[x,1]=player) or (mas[x,1]=0) then arrow(sender, x);
  end;
  if bones[2]<>0 then begin
    x:=num+bones[2];
    if (mas[num,1]=2) and (x>24) then x:=x-24;
    if (x>24) or ((mas[num,1]=2) and (num<=12) and (x>12)) then else
    if (mas[x,1]=player) or (mas[x,1]=0) then arrow(sender, x);
  end;
  if main.bones[3]<>0 then begin
    x:=num+bones[3];
    if (mas[num,1]=2) and (x>24) then x:=x-24;
    if (x>24) or ((mas[num,1]=2) and (num<=12) and (x>12)) then else
    if (mas[x,1]=player) or (mas[x,1]=0) then arrow(sender, x);
  end;
  if bones[4]<>0 then begin
    x:=num+bones[4];
    if (mas[num,1]=2) and (x>24) then x:=x-24;
    if (x>24) or ((mas[num,1]=2) and (num<=12) and (x>12)) then else
    if (mas[x,1]=player) or (mas[x,1]=0) then arrow(sender, x);
  end;
end;
end;
 
function proverka(m:integer; zz:integer):integer;
var  i,j,nn,x:integer;
begin
nn:=0;
case player of
  1: begin
    if mas[m,1]=player then  for j:=1 to 4 do
       if m+zz*j<=24 then
        if (mas[m+zz*j,1]=player)or (mas[m+zz*j,1]=0) then  begin nn:=nn+mas[m,2];
         end
          else begin
          result:=nn;
          exit;
          end;
 
 
    end;
  2: if (m>=13) and (m<=24) then
    if mas[m,1]=player then  for j:=1 to 4 do begin
       x:=m+zz*j;
       if x>24 then x:=x-24;
        if (mas[x,1]=player)or (mas[x,1]=0) then   nn:=nn+mas[m,2]
          else begin
          result:=nn;
          exit;
          end; end else begin
    if mas[m,1]=player then  for j:=1 to 4 do
       if m+zz*j<=12 then
        if (mas[m+zz*j,1]=player)or (mas[m+zz*j,1]=0) then  nn:=nn+1*mas[m,2]
          else
          begin
          result:=nn;
          exit;
          end;
         end;
  end;
  result:=nn;
end;
 
procedure doublebones(sender:tobject);
var i,j,n,z,x:integer;
begin
  z:=bones[1];
  n:=0;
  case player of
  1: begin
  for i:=1 to 24-bones[1] do begin
  x:=proverka(i,z);
  n:=n+x;
 end;
  if mas[1,2]>=1 then begin
  if mas[1,2]=15 then n:=n-13 else n:=n+1-mas[1,2];
  end;
    end;
  2: begin
    for i:=13 to 24 do n:=n+proverka(i,z);
    for i:=1 to 12-bones[1] do n:=n+proverka(i,z);
    if mas[13,2]>=1 then begin
    if mas[13,2]=15 then n:=n-13 else n:=n+1-mas[13,2];
    end; //else
     end;
     end;
   if n>=4 then exit else case n of
   0: for i:=1 to 4 do bones[i]:=0;
   1: for i:=4 downto 2 do bones[i]:=0;
   2: for i:=4 downto 3 do bones[i]:=0;
   3: bones[4]:=0;
   end;
end;
 
procedure ablemove(sender:tobject);
var z:array[1..2] of boolean;
    p:boolean;
    i,j,x,z1,z2,s1,s2,sum:integer;
begin
  if player=1 then begin
      for i:=19 to 25 do
      if mas[i,1]=1 then sum:=sum+mas[i,2];
      if sum=15 then exit;
      end;
  if player=2 then begin
      for i:=7 to 12 do
      if mas[i,1]=2 then sum:=sum+mas[i,2];
      sum:=sum+mas[26,2];
      if sum=15 then exit;
      end;
  z1:=bones[1];
  z2:=bones[2];
  s1:=mas[24,2]+mas[23,2]+mas[22,2]+mas[21,2]+mas[20,2]+mas[19,2];
  s2:=mas[7,2]+mas[8,2]+mas[9,2]+mas[10,2]+mas[11,2]+mas[12,2];
  z[1]:=false;
  z[2]:=false;
  p:=false;
  case player of
  1: begin if bones[1]<>main.bones[2] then begin
    for j:=1 to 2 do begin
      for i:=1 to 24-bones[j] do
          if (mas[i,1]=player) and (p=false) then
            if (mas[i+bones[j],1]=player) or (mas[i+bones[j],1]=0) then begin
              p:=true;
              z[j]:=true;
              end;
      p:=false;
    end;
  case z[1] of
  true: begin
    if z[1]=z[2] then exit else
        for i:= 1 to 24-bones[1]-bones[2] do
          if (mas[i,1]=player) and  (z[2]=false) then
            if (mas[i+bones[1]+bones[2],1]=player) or (
              mas[i+bones[1]+bones[2],1]=0) then z[2]:=true;
        if z[2]=false then bones[2]:=0;
    end;
  false: begin
    if z[1]=z[2] then begin
      bones[1]:=0;
      bones[2]:=0;
      end else
        for i:= 1 to 24-bones[1]-bones[2] do
          if (mas[i,1]=player) and  (z[1]=false) then
            if (mas[i+bones[1]+bones[2],1]=player) or (
              mas[i+bones[1]+bones[2],1]=0) then z[1]:=true;
        if z[1]=false then bones[1]:=0;
    end;
 
  end;
  if s1=15 then begin
    if mas[z1+18,2]>=1 then bones[1]:=z1;
    if mas[z2+18,2]>=1 then bones[2]:=z2;
    end; end else doublebones(sender);
  end;
  2: begin if bones[1]<>bones[2] then begin
  for j:=1 to 2 do begin
      for i:=13 to 24 do
          if (mas[i,1]=player) and (p=false) then begin
 
            x:=i+main.bones[j];
            if x>24 then x:=x-24;
            if (mas[x,1]=player) or (mas[x,1]=0) then begin
              p:=true;
              z[j]:=true;
              end;
            end;
      for i:=1 to 12-bones[j] do
          if (mas[i,1]=player) and (p=false) then  begin
            x:=i+main.bones[j];
            if (mas[x,1]=player) or (mas[x,1]=0) then begin
              p:=true;
              z[j]:=true;
              end;
              end;
      p:=false;
    end;
  case z[1] of
  true: begin
    if z[1]=z[2] then exit else
        for i:= 13 to 24 do
          if (mas[i,1]=player) and  (z[2]=false) then begin
            x:=i+bones[1]+bones[2];
            if x>24 then x:=x-24;
            if (mas[x,1]=player) or (mas[x,1]=0) then z[2]:=true;
            end;
        for i:=1 to 12-bones[1]-bones[2] do
          if (mas[i,1]=player) and  (z[2]=false) then
            if (mas[i+bones[1]+bones[2],1]=player) or (
              mas[i+bones[1]+bones[2],1]=0) then z[2]:=true;
        if z[2]=false then bones[2]:=0;
    end;
  false: begin
    if z[1]=z[2] then begin
      bones[1]:=0;
      bones[2]:=0;
      end else
        for i:= 13 to 24 do
          if (mas[i,1]=player) and  (z[1]=false) then begin
            x:=i+bones[1]+bones[2];
            if x>24 then x:=x-24;
            if (mas[x,1]=player) or (mas[x,1]=0) then z[1]:=true;
            end;
        for i:=1 to 12-bones[1]-bones[2] do
          if (mas[i,1]=player) and  (z[1]=false) then
            if (mas[i+bones[1]+bones[2],1]=player) or (
              mas[i+bones[1]+bones[2],1]=0) then z[1]:=true;
        if z[1]=false then bones[1]:=0;
    end;
  end;
 
  if s2=15 then begin
    if mas[z1+6,2]>=1 then bones[1]:=z1;
    if mas[z2+6,2]>=1 then bones[2]:=z2;
     end; end else doublebones(sender);
  end; end;
end;
 
procedure bonesclick(Sender: TObject);
var i,j:integer;
begin
  if (player=1) and (mas[25,2]=15) then begin
    messagedlg('Игра закончена! Белые победили!',mtinformation,[mbok],0);
    exit;
    end ;
   if (player=2) and (mas[26,2]=15) then begin
        messagedlg('Игра закончена! Черные победили!',mtinformation,[mbok],0);
        exit;
        end;
  if (main.bones[1]=0) and (main.bones[2]=0) and (main.bones[3]=0) and
    (main.bones[4]=0) then begin
      status:=2;
      if player=1 then begin
        player:=2;
        messagedlg('Ходят черные',mtinformation,[mbok],0);
        end else begin
          player:=1;
          messagedlg('Ходят белые',mtinformation,[mbok],0);
          end;
 
 
  with form1 do begin
  randomize;
  z1:=random(6)+1;
  case z1 of
  1: leftbone.Picture:=b1.Picture;
  …
  6: leftbone.Picture:=b6.Picture;
  end;
  z2:=random(6)+1;
  case z2 of
  1: rightbone.Picture:=b1.Picture;
  …
  6: rightbone.Picture:=b6.Picture;
  end;
 
  golova:=0;
  status:=1;
  if z1<>z2 then begin
  bones[1]:=z1;
  bones[2]:=z2;
  bones[3]:=0;
  bones[4]:=0;
  end else begin
  bones[1]:=z1;
  bones[2]:=z1;
  bones[3]:=z2;
  bones[4]:=z2;
  end;
  if (player=1) and (bones[3]<>0) and (mas[1,2]=15) then wf:=1;
  if (player=2) and (bones[3]<>0) and (mas[13,2]=15) then blf:=1;
  ablemove(sender);
  varbones(sender);
  if (bones[1]=0) and (main.bones[2]=0) and (bones[3]=0) and (bones[4]=0) then  begin
    messagedlg('Вы не можете походиться!',mtinformation,[mbok],0);
    end;
 
  end;
  for i:=1 to 26 do
    for j:=1 to 2 do mas2[i,j]:=mas[i,j];
  for i:=1 to 4 do bones2[i]:=bones[i];
  end else messagedlg('Ход не завершен!',mtinformation,[mbok],0)
 
end;
 
 
 
procedure move(Sender: TObject; number1:integer);
var i,k:integer;
begin
  if (nomer=1) and (mas[nomer,1]=1) then golova:=2;
  if (nomer=1) and (mas[nomer,1]=1) and (wf=1) then begin
    golova:=1;
    wf:=0;
  end;
  if (nomer=13) and (mas[nomer,1]=2) then golova:=2;
   if (nomer=13) and (mas[nomer,1]=2) and (blf=1) then begin
    golova:=1;
    blf:=0;
  end;
  mas[nomer,2]:=mas[nomer,2]-1;
  mas[number1,1]:=player;
  mas[number1,2]:=mas[number1,2]+1;
  if mas[nomer,2]=0 then mas[nomer,1]:=0;
  draw.visible(sender);
  draw.redraw(sender);
  k:=number1-nomer;
  if k<1 then k:=k+24;
  i:=0;
  repeat
    i:=i+1;
    if main.bones[i]=k then begin
      main.bones[i]:=0;
      k:=0;
    end;
  until k=0;
  varbones(sender);
end;
 
 
procedure movehouse(Sender: TObject; number2,zar:integer);
begin
  main.bones[zar]:=0;
  mas[number2,2]:=mas[number2,2]+1;
  mas[nomer,2]:=mas[nomer,2]-1;
  if mas[nomer,2]=0 then mas[nomer,1]:=0;
  draw.visible(sender);
  draw.redraw(sender);
  varbones(sender);
  if (player=1) and (mas[25,2]=15) then begin
    messagedlg('Игра закончена! Белые победили!',mtinformation,[mbok],0);
    exit;
    end ;
   if (player=2) and (mas[26,2]=15) then begin
        messagedlg('Игра закончена! Черные победили!',mtinformation,[mbok],0);
        exit;
        end;
end;
 
end.
Модуль DRAW содержит процедуры отображения игрового процесса
Delphi
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
uses main;
 
procedure visible(Sender: TObject);
begin
    with form1 do  begin
    m1.Visible:=false;
    …
    m24.Visible:=false;
    wdomclick.Visible:=false;
    bldomclick.Visible:=false;
    end;
end;
 
procedure arrow(Sender: TObject; number:integer);
begin
    with form1 do
    case number of
    1: begin
        m1.Visible:=true;
        if mas[1,2]=0 then begin
            m1.Left:=n1.Left;
            m1.Top:=n1.Top;
            end else begin
            m1.Left:=n1.Left;
            m1.Top:=n1.Top-20;
            end;
        end;
    …
    26: begin
        bldomclick.Visible:=true;
        if mas[26,2]=0 then begin
            bldomclick.Left:=bldom.Left;
            bldomclick.Top:=bldom.Top;
            end else begin
            bldomclick.Left:=bldom.Left;
            bldomclick.Top:=bldom.Top-20;
            end;
        end;
    end;
end;
 
procedure redraw(sender: TObject);
var i:integer;
pic:tpicture;
begin
    with form1 do
    for i:=1 to 26 do begin
    if mas[i,1]=0 then
    case i of
    1: n1.Visible:=false;  
     …
    26: bldom.Visible:=false;
    end else begin
    case i of
    1: n1.Visible:=true;
    …
    26: bldom.Visible:=true;
    end;
    if mas[i,1]=1 then
    case mas[i,2] of
    0: pic:=picpusto.Picture;
    …
    15: pic:=w15.Picture;
    end;
    if mas[i,1]=2 then
    case mas[i,2] of
    0: pic:=picpusto.Picture;
     …
    15: pic:=bl15.Picture;
    end;
    case i of
    1: n1.Picture:=pic;
     …
    26: bldom.Picture:=pic;
    end;
    end;
    end;
end;
 
procedure varbones(sender: Tobject);
var pic:tpicture;
i:integer;
begin
    with form1 do
    for i:=1 to 4 do begin
    case bones[i] of
    0: pic:=picpusto.Picture;
    …
    6: pic:=image8.picture;
    end;
    case i of
    1: v1.picture:=pic;
    …
    4: v4.picture:=pic;
    end;
    end;
end;
end.
Модуль LOAD содержит форму загрузки сохраненной игры

Delphi
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
uses main, draw;
 
{$R *.dfm}
 
procedure TForm3.SpeedButton2Click(Sender: TObject);
begin
  form3.Close;
end;
 
procedure TForm3.SpeedButton1Click(Sender: TObject);
var i,j:integer;
begin
  if listbox1.Items.Count=0 then begin
  form3.Close;
  exit;
  end;
  form1.memo_save.Clear;
  form1.memo_save.Lines.LoadFromFile(path+'\saves\'+listbox1.Items[listbox1.itemindex]+'.sav');
  with form1 do begin
  i:=0;
  status:=strtoint(memo_save.Lines[i]);
  i:=1;
  player:=strtoint(memo_save.Lines[i]);
  i:=2;
  for j:=1 to 4 do begin
    main.bones[j]:=strtoint(memo_save.Lines[i]);
    i:=i+1;
  end;
  for j:=1 to 26 do begin
    mas[j,1]:=strtoint(memo_save.Lines[i]);
    i:=i+1;
  end;
  for j:=1 to 26 do begin
    mas[j,2]:=strtoint(memo_save.Lines[i]);
    i:=i+1;
  end;
  golova:=strtoint(memo_save.Lines[i]);
  i:=i+1;
  z1:=strtoint(memo_save.Lines[i]);
  i:=i+1;
  z2:=strtoint(memo_save.Lines[i]);
  case z1 of
  1: leftbone.Picture:=b1.Picture;
  …
  6: leftbone.Picture:=b6.Picture;
  end;
  case z2 of
  1: rightbone.Picture:=b1.Picture;
  …
  6: rightbone.Picture:=b6.Picture;
  end;
  draw.visible(sender);
  draw.redraw(sender);
  varbones(sender);
  end;
  form3.Close;
end;
 
procedure TForm3.FormActivate(Sender: TObject);
var
  s:string;
  SearchRec: TSearchRec;// структура SearchRec содержит информацию
                        // о файле, удовлетворяющем условию поиска
begin
  ListBox1.Clear;
  // сформировать список sav файлов
  if FindFirst(Path+'\saves\' + '*.sav', faAnyFile, SearchRec) =0 then
     begin
          // в каталоге есть файл с расширением sav
          // добавим имя этого файла в список
          s:=searchrec.Name;
          Delete(s, length(S)-3,4);
          ListBox1.Items.Add(s);
          // есть еще sav-файлы ?
          while (FindNext(SearchRec) = 0) do begin
              s:=searchrec.Name;
          Delete(s, length(S)-3,4);
          ListBox1.Items.Add(s);
          end;
              end;
   ListBox1.ItemIndex := 0;
   if listbox1.Items.Count=0 then begin
   messagedlg('Нет сохраненной игры',mtinformation,[mbok],0);
   form3.Close;
   end;
   form1.bones_click.Enabled:=true;
end;
 
end.
Модуль SAVE содержит форму сохранения игры

Delphi
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
uses main;
 
{$R *.dfm}
 
procedure TForm2.SpeedButton1Click(Sender: TObject);
begin
  form1.memo_save.Lines.SaveToFile(path+'\saves\'+saveedit.Text+'.sav');
  form2.Close;
end;
 
procedure TForm2.SpeedButton2Click(Sender: TObject);
begin
form2.Close;
end;
 
procedure TForm2.FormShow(Sender: TObject);
var i:integer;
begin
with form1 do begin
memo_save.Clear;
  memo_save.Lines.Add(inttostr(status));
  memo_save.Lines.Add(inttostr(player));
  for i:=1 to 4 do memo_save.Lines.Add(inttostr(bones[i]));
  for i:=1 to 26 do memo_save.Lines.Add(inttostr(mas[i,1]));
  for i:=1 to 26 do memo_save.Lines.Add(inttostr(mas[i,2]));
  memo_save.Lines.Add(inttostr(golova));
  memo_save.Lines.Add(inttostr(z1));
  memo_save.Lines.Add(inttostr(z2));
  end;
end;
 
end.
 
Модуль EXIT содежит форму подтверждения выхода из программы
 
uses main, start;
 
{$R *.dfm}
 
procedure TForm4.SpeedButton1Click(Sender: TObject);
begin
form7.Close;
end;
 
procedure TForm4.SpeedButton2Click(Sender: TObject);
begin
form4.Close;
end;
 
end.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
20.05.2013, 15:05
Ответы с готовыми решениями:

Как переделать исходники из Delphi 7 в C++ Builder 6 ?
Доброго времени суток. Как переделать исходники из Delphi в C++ Builder 6 ?, Срочно понадобилось...

Как переделать исходник временного синхронизатор из Delphi в C++?
Доброго времени суток. Как переделать исходники из Delphi в C++ Builder 6 ?, Срочно понадобилось...

Переделать код из Delphi в С++ Builder 6
Помогите пожалуйста переделать код из Delphi в С++ Builder 6, я не прошу кого то просто взять и всё...

Код Delphi переделать в C++ Builder
unit AdditionalInfoForm; interface uses Windows, Messages, SysUtils, Variants, Classes,...

4
Супер-модератор
Эксперт Pascal/DelphiАвтор FAQ
30860 / 20183 / 7874
Регистрация: 22.10.2011
Сообщений: 35,046
Записей в блоге: 6
20.05.2013, 19:35 2
Для начала - это и в Дельфи не будет компилироваться (пропуски в исходниках, ни один класс формы не присутствует). Вот когда будет - тогда попробуй начать переводить. А то не пойми какая задача решается, ничего не сказал - "вот вам код, переводите"...
1
LK
Заблокирован
20.05.2013, 19:41 3
Решается задача Игровая программа Нарды
0
Супер-модератор
Эксперт Pascal/DelphiАвтор FAQ
30860 / 20183 / 7874
Регистрация: 22.10.2011
Сообщений: 35,046
Записей в блоге: 6
20.05.2013, 19:43 4
OMG... Там то же самое, и пропуски такие же. Ясно, ещё тот исходник...
0
LK
Заблокирован
20.05.2013, 20:03 5
... полной халявы, как правило, нет.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
20.05.2013, 20:03

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

Нужно переделать код с Delphi и С++
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics,...

Переделать функцию из Delphi в C++ Builder
function TForm1.NK(i,j:integer; Sender:TObject):integer; var kol:integer; begin kol:=0; ...

Переделать исходники из Delphi 7 в C++ Builder 6
Выкладываю сам проект и если есть у кого предложения, советы, дайте пожалуйста. Программа не...

Обработка матриц. Переделать код из Delphi в C++
procedure TForm1.Button1Click(Sender: TObject); const n = 5; //размер массива + 1 var i, j:...


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

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

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