Форум программистов, компьютерный форум, киберфорум
Наши страницы
Basic
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.53/15: Рейтинг темы: голосов - 15, средняя оценка - 4.53
GlaDosEvolution
9 / 9 / 0
Регистрация: 13.06.2015
Сообщений: 61
1

Публикация интересных исходников по QB64

08.12.2016, 12:45. Просмотров 2780. Ответов 28

Платформа QuickBasic 32 и 64 бита.
Используемая платформа разработки qb64.

Здесь я буду время от времени размещать исходники на этом языке, как 3d так и 2d игр или приложений работающих на qb64.

Первый исходник:

QBasic/QuickBASIC
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
' Vertex rotation test
 
SCREEN 7
 
' The end coordinates for the line segment representing a "wall"
vx1 = 70 : vy1 = 20
vx2 = 70 : vy2 = 70
 
' The coordiantes of the player
px = 50
py = 50
angle = 0
 
DO
    ' Draw the absolute map
    VIEW(4, 40) - (103, 149), 0, 1
 
    LINE(vx1, vy1) - (vx2, vy2), 14
    LINE(px, py) - (COS(angle) * 5 + px, SIN(angle) * 5 + py), 8
    PSET(px, py), 15
 
    ' Wait for screen refresh and swap page
    SCREEN ,, page%, 1 - page% : page% = 1 - page%
    WAIT &h4da, &h8, &h8
 
    SELECT CASE INKEY$
        CASE CHR$(0) + "H" : px = px + COS(angle): py = py + SIN(angle)
        CASE CHR$(0) + "P" : px = px - COS(angle): py = py - SIN(angle)
        CASE CHR$(0) + "K": angle = angle - 0.1
        CASE CHR$(0) + "M": angle = angle + 0.1
        CASE "a", "A" : px = px + SIN(angle): py = py - COS(angle)
        CASE "d", "D" : px = px - SIN(angle): py = py + COS(angle)
        CASE "q", "Q", CHR$(27): EXIT DO
    END SELECT
LOOP
 
SCREEN 0, 1, 0, 0: WIDTH 80, 25
Последующие будут поступать по мере возможности или каждую неделю а может и чаще.

Добавлено через 49 минут
В первом исходнике допустил небольшой баг так что выкладываю немного дополненную версию.

QBasic/QuickBASIC
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
' Vertex rotation test
 
SCREEN 7
 
' The end coordinates for the line segment representing a "wall"
vx1 = 70 : vy1 = 20
vx2 = 70 : vy2 = 70
 
' The coordiantes of the player
px = 50
py = 50
angle = 0
 
DO
    ' Draw the absolute map
    VIEW(4, 40) - (103, 149), 0, 1
 
    LINE(vx1, vy1) - (vx2, vy2), 14
    LINE(px, py) - (COS(angle) * 5 + px, SIN(angle) * 5 + py), 8
    PSET(px, py), 15
 
    ' Wait for screen refresh and swap page
    SCREEN ,, page%, 1 - page% : page% = 1 - page%
    WAIT &h4da, &h8, &h8: WAIT &h3da, &h8
 
    SELECT CASE INKEY$
        CASE CHR$(0) + "H" : px = px + COS(angle): py = py + SIN(angle)
        CASE CHR$(0) + "P" : px = px - COS(angle): py = py - SIN(angle)
        CASE CHR$(0) + "K": angle = angle - 0.1
        CASE CHR$(0) + "M": angle = angle + 0.1
        CASE "a", "A" : px = px + SIN(angle): py = py - COS(angle)
        CASE "d", "D" : px = px - SIN(angle): py = py + COS(angle)
        CASE "q", "Q", CHR$(27): EXIT DO
    END SELECT
LOOP
 
SCREEN 0, 1, 0, 0: WIDTH 80, 25
П.С. Я так и не сказал что можно делать после запуска. Короче когда запустил код, управление стрелками на клавиатуре. Удачи.
1
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
08.12.2016, 12:45
Ответы с готовыми решениями:

Как руссифицировать QB64
Как руссифицировать QB64

Как русифицировать QB64
Как русифицировать QBasic под Windows 7 64 бит? Вместо русских букв пишет...

Ищу примеры интересных и наглядных макросов
Ищу интересные наглядные макросы (или задания) для школьников, приблизительно...

Сервер интересных заданий
На данном сайте http://golf.shinh.org/ выложены задачи, которые можно решать на...

Пара интересных вопросов
И так таварищи есть два интересных вопроса, на которых я просто жаждю найти...

28
GlaDosEvolution
9 / 9 / 0
Регистрация: 13.06.2015
Сообщений: 61
13.12.2016, 23:25  [ТС] 2
Новый исходник второй: но уже калькулятор на qb.
QBasic/QuickBASIC
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
DIM num1 AS SINGLE
DIM num2 AS SINGLE
DIM sel AS STRING
 
DO
    CLS
 
    INPUT "Enter Fisrt Number: ", num1
    INPUT "Enter Second Number: ", num2
 
    PRINT
 
    DO
        PRINT "A) Add"
        PRINT "D) Divide"
        PRINT "M) Multiply"
        PRINT "S) Subtract"
        INPUT "Enter Selection: ", sel
 
        sel = UCASE$(sel)
    LOOP UNTIL sel = "A" OR sel = "D" OR sel = "M" OR sel = "S"
 
    PRINT
 
    SELECT CASE sel
        CASE "A"
            PRINT "Answer:"; num1 + num2
        CASE "D"
            PRINT "Answer:"; num1 / num2
        CASE "M"
            PRINT "Answer:"; num1 * num2
        CASE "S"
            PRINT "Answer:"; num1 - num2
    END SELECT
 
    PRINT
 
    DO
        INPUT "Make Another Calculation (Y/N):", sel
        sel = UCASE$(sel)
    LOOP UNTIL sel = "Y" OR sel = "N"
LOOP UNTIL sel = "N"
Добавлено через 25 минут
Цитата Сообщение от locm Посмотреть сообщение
то в винде работать не будут
Это да. Но ведь можно написать на qb64 свои ускоряющие фишки или утилиты.

Добавлено через 34 минуты
Еще я забыл упомянуть плюсы новой qb64. Это то что код QB транслируется в нативный код для машины, что делает выполнение кода максимально быстрым и отпадает необходимость в аппаратном ускорении.

Добавлено через 1 минуту
Еще тут недавно нашел игру написанную на qb64 - вот она. Сделана она весьма хорошо и работает быстро.
0
Pro_grammer
Модератор
6176 / 2259 / 443
Регистрация: 24.04.2011
Сообщений: 3,998
Записей в блоге: 10
14.12.2016, 12:16 3
Напоминаю, что тема форума Публикация интересных исходников по QB64
Священные войны и пр. около программные споры давайте в соответствующих местах!
Тут только исходники на QB64

Добавлено через 3 минуты
Цитата Сообщение от GlaDosEvolution Посмотреть сообщение
но уже калькулятор на qb
Вы уже сами определитесь, если интересные коды на QB64, то в эту тему.
А если примитивный калькулятор на QBasic, то для этого есть целый свой раздел
0
GlaDosEvolution
9 / 9 / 0
Регистрация: 13.06.2015
Сообщений: 61
14.12.2016, 12:40  [ТС] 4
Третий исходник: это некая пока недоделка текстово-графическая игра
QBasic/QuickBASIC
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
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
SCREEN 7  '320 x 200
RANDOMIZE TIMER
 
CLS
LOCATE 10, 1
PRINT "Welcome to"
PRINT
PRINT "          The Tank game."
PRINT
PRINT "Do you need instructions? y/n"
 
instruct.y.n:
y.n$ = INKEY$
SELECT CASE y.n$
CASE "y"
GOTO instruct
CASE "n"
GOTO start
END SELECT
GOTO instruct.y.n
 
instruct:
CLS
LOCATE 1, 1
PRINT "The object of the game is to shoot your"
PRINT "opponent.  There are two sets of"
PRINT "controls for each player, one to steer"
PRINT "the tank, and the other to aim the gun."
PRINT "For the blue tank, the buttons i, j, k, "
PRINT "and l steer the tank.  Buttons e, s, d,"
PRINT "and f aim the gun.  Their directions are"
PRINT "in the same layout as the arrow keys."
PRINT "The space bar is his fire button.  For"
PRINT "the white tank, the numeric keypad (make"
PRINT "sure Num Lock is on) steers the tank, "
PRINT "while the arrow keys aim the gun.  For "
PRINT "steering, the tank will go in the"
PRINT "direction of the arrow on the key.  The"
PRINT "0 is his fire button.  If you  are"
PRINT "playing a one player game, you are white"
PRINT "and the computer is blue."
PRINT
PRINT "Note: You can only fire one shell at a"
PRINT "time.  If you try to fire another, your"
PRINT "first shell will disappear."
start:
num.players = 3
PRINT
PRINT "How many players? (1/2) "
WHILE num.players <> 1 AND num.players <> 2
num$ = INKEY$
SELECT CASE num$
CASE "1"
num.players = 1
PRINT "1"
CASE "2"
num.players = 2
PRINT "2"
END SELECT
WEND
 
IF num.players = 1 THEN
PRINT
PRINT "Easy ,Difficult, Super Hard,"
PRINT "or Impossible? e/d/s/i"
difficulty$ = "0"
WHILE difficulty$ <> "e" AND difficulty$ <> "d" AND difficulty$ <> "s" AND difficulty$ <> "i"
diff$ = INKEY$
SELECT CASE diff$
CASE "e"
difficulty$ = "e"
s.difficulty$ = "e"
PRINT "Easy"
CASE "d"
difficulty$ = "d"
s.difficulty$ = "e"
PRINT "Difficult"
CASE "s"
difficulty$ = "d"
s.difficulty$ = "s"
PRINT "It can be done."
CASE "i"
difficulty$ = "d"
s.difficulty$ = "i"
PRINT "You're in for it, now."
END SELECT
WEND
END IF
 
PRINT
IF num.players = 2 THEN
PRINT "What is the person's name who will be"
INPUT "driving the blue tank? ", tanka.NAME$
ELSE
tanka.NAME$ = "Computer"
computer.duration = 0
computer.time = 0
END IF
PRINT
 
PRINT "What is the person's name who will be"
INPUT "driving the white tank? ", tankb.NAME$
PRINT
INPUT "How many rounds do you want to play? ", rounds.limit
rounds = 0
tanka.score = 0
tankb.score = 0
n.y = 1
newround:
 
IF rounds >= rounds.limit THEN
GOTO finish
END IF
 
rounds = rounds + 1
 
tanka.direction$ = "E"
tankb.direction$ = "W"
tanka.aim$ = "E"
tankb.aim$ = "W"
tanka.x = 20
tanka.y = 100
tankb.x = 300
tankb.y = 100
tanka.missile.x = -5000
tanka.missile.y = -5000
tankb.missile.x = -5000
tankb.missile.y = -5000
tanka.missile.direction$ = "0"
tankb.missile.direction$ = "0"
 
a:
 
CLS
 
LINE (tanka.x - 10, tanka.y - 10)-(tanka.x + 10, tanka.y + 10), 9, BF
LINE (tankb.x - 10, tankb.y - 10)-(tankb.x + 10, tankb.y + 10), 15, BF
LINE (tanka.missile.x - 1, tanka.missile.y - 1)-(tanka.missile.x + 1, tanka.missile.y + 1), 15, B
LINE (tankb.missile.x - 1, tankb.missile.y - 1)-(tankb.missile.x + 1, tankb.missile.y + 1), 9, B
 
COLOR 15
SELECT CASE tanka.aim$
CASE "N"
LINE (tanka.x, tanka.y)-(tanka.x, tanka.y - 10)
CASE "E"
LINE (tanka.x, tanka.y)-(tanka.x + 10, tanka.y)
CASE "S"
LINE (tanka.x, tanka.y)-(tanka.x, tanka.y + 10)
CASE "W"
LINE (tanka.x, tanka.y)-(tanka.x - 10, tanka.y)
END SELECT
 
COLOR 1
SELECT CASE tankb.aim$
CASE "N"
LINE (tankb.x, tankb.y)-(tankb.x, tankb.y - 10)
CASE "E"
LINE (tankb.x, tankb.y)-(tankb.x + 10, tankb.y)
CASE "S"
LINE (tankb.x, tankb.y)-(tankb.x, tankb.y + 10)
CASE "W"
LINE (tankb.x, tankb.y)-(tankb.x - 10, tankb.y)
END SELECT
 
FOR count = 1 TO Flicker.Control
NEXT count
 
SELECT CASE tanka.direction$
CASE "N"
tanka.y = tanka.y - 3
CASE "E"
tanka.x = tanka.x + 3
CASE "S"
tanka.y = tanka.y + 3
CASE "W"
tanka.x = tanka.x - 3
END SELECT
 
SELECT CASE tankb.direction$
CASE "N"
tankb.y = tankb.y - 3
CASE "E"
tankb.x = tankb.x + 3
CASE "S"
tankb.y = tankb.y + 3
CASE "W"
tankb.x = tankb.x - 3
END SELECT
 
SELECT CASE tanka.missile.direction$
CASE "N"
tanka.missile.y = tanka.missile.y - 6
CASE "E"
tanka.missile.x = tanka.missile.x + 6
CASE "S"
tanka.missile.y = tanka.missile.y + 6
CASE "W"
tanka.missile.x = tanka.missile.x - 6
END SELECT
 
SELECT CASE tankb.missile.direction$
CASE "N"
tankb.missile.y = tankb.missile.y - 6
CASE "E"
tankb.missile.x = tankb.missile.x + 6
CASE "S"
tankb.missile.y = tankb.missile.y + 6
CASE "W"
tankb.missile.x = tankb.missile.x - 6
END SELECT
 
change$ = INKEY$
SELECT CASE change$
CASE "q"
GOTO quit
CASE "p"
WHILE INKEY$ <> " "
WEND
 
CASE CHR$(0) + "H"
tankb.aim$ = "N"
CASE CHR$(0) + "M"
tankb.aim$ = "E"
CASE CHR$(0) + "P"
tankb.aim$ = "S"
CASE CHR$(0) + "K"
tankb.aim$ = "W"
CASE "8"
tankb.direction$ = "N"
CASE "6"
tankb.direction$ = "E"
CASE "2"
tankb.direction$ = "S"
CASE "4"
tankb.direction$ = "W"
CASE "0"
tankb.missile.direction$ = tankb.aim$
tankb.missile.x = tankb.x
tankb.missile.y = tankb.y
END SELECT
 
IF num.players = 2 THEN
SELECT CASE change$
CASE "e"
tanka.aim$ = "N"
CASE "f"
tanka.aim$ = "E"
CASE "d"
tanka.aim$ = "S"
CASE "s"
tanka.aim$ = "W"
CASE "i"
tanka.direction$ = "N"
CASE "l"
tanka.direction$ = "E"
CASE "k"
tanka.direction$ = "S"
CASE "j"
tanka.direction$ = "W"
CASE " "
tanka.missile.direction$ = tanka.aim$
tanka.missile.x = tanka.x
tanka.missile.y = tanka.y
END SELECT
 
ELSE
IF computer.time >= computer.duration THEN
computer.time = 0
computer.duration = INT(19 * RND) + 1
computer.direction = INT(4 * RND) + 1
SELECT CASE computer.direction
CASE 1
tanka.direction$ = "N"
CASE 2
tanka.direction$ = "E"
CASE 3
tanka.direction$ = "S"
CASE 4
tanka.direction$ = "W"
END SELECT
END IF
computer.time = computer.time + 1
 
SELECT CASE tanka.missile.direction$
CASE "N"
IF (tanka.missile.x < tankb.x + 10) AND (tanka.missile.x > tankb.x - 10) AND (tankb.y - 10 <= tanka.missile.y) THEN
GOTO endselect
ELSE
GOTO newtarget
END IF
CASE "E"
IF (tanka.missile.y < tankb.y + 10) AND (tanka.missile.y > tankb.y - 10) AND (tankb.x + 10 >= tanka.missile.x) THEN
GOTO endselect
ELSE
GOTO newtarget
END IF
CASE "S"
IF (tanka.missile.x < tankb.x + 10) AND (tanka.missile.x > tankb.x - 10) AND (tankb.y + 10 >= tanka.missile.y) THEN
GOTO endselect
ELSE
GOTO newtarget
END IF
CASE "W"
IF (tanka.missile.y < tankb.y + 10) AND (tanka.missile.y > tankb.y - 10) AND (tankb.x - 10 <= tanka.missile.x) THEN
GOTO endselect
ELSE
GOTO newtarget
END IF
END SELECT
 
newtarget:
 
IF (tanka.x < tankb.x + 10) AND (tanka.x > tankb.x - 10) AND (tankb.y - 10 <= tanka.y) THEN
tanka.missile.direction$ = "N"
tanka.missile.x = tanka.x
tanka.missile.y = tanka.y
END IF
 
IF (tanka.y < tankb.y + 10) AND (tanka.y > tankb.y - 10) AND (tankb.x + 10 >= tanka.x) THEN
tanka.missile.direction$ = "E"
tanka.missile.x = tanka.x
tanka.missile.y = tanka.y
END IF
 
IF (tanka.x < tankb.x + 10) AND (tanka.x > tankb.x - 10) AND (tankb.y + 10 >= tanka.y) THEN
tanka.missile.direction$ = "S"
tanka.missile.x = tanka.x
tanka.missile.y = tanka.y
END IF
 
IF (tanka.y < tankb.y + 10) AND (tanka.y > tankb.y - 10) AND (tankb.x - 10 <= tanka.x) THEN
tanka.missile.direction$ = "W"
tanka.missile.x = tanka.x
tanka.missile.y = tanka.y
END IF
 
tanka.aim$ = tanka.missile.direction$
 
endselect:
 
IF s.difficulty$ = "s" THEN
direction.num = INT(2 * RND)
SELECT CASE direction.num
CASE 0
direction.e.w$ = "E"
direction.n.s$ = "N"
CASE 1
direction.e.w$ = "W"
direction.n.s$ = "S"
END SELECT
 
SELECT CASE tanka.direction$
CASE "N"
IF tankb.missile.y < tanka.y AND tankb.missile.direction$ <> "N" AND tankb.missile.direction$ <> "S" THEN
tanka.direction$ = direction.e.w$
END IF
CASE "E"
IF tankb.missile.x > tanka.x AND tankb.missile.direction$ <> "E" AND tankb.missile.direction$ <> "W" THEN
tanka.direction$ = direction.n.s$
END IF
CASE "S"
IF tankb.missile.y > tanka.y AND tankb.missile.direction$ <> "N" AND tankb.missile.direction$ <> "S" THEN
tanka.direction$ = direction.e.w$
END IF
CASE "W"
IF tankb.missile.x < tanka.x AND tankb.missile.direction$ <> "E" AND tankb.missile.direction$ <> "W" THEN
tanka.direction$ = direction.n.s$
END IF
END SELECT
END IF
 
IF s.difficulty$ = "i" THEN
direction.num = INT(2 * RND)
SELECT CASE direction.num
CASE 0
direction.e.w$ = "E"
direction.n.s$ = "N"
CASE 1
direction.e.w$ = "W"
direction.n.s$ = "S"
END SELECT
 
SELECT CASE tanka.direction$
CASE "N"
IF tankb.missile.y > tanka.y - 13 AND tankb.missile.y < tanka.y AND tankb.missile.y > 1 AND tankb.missile.y < 200 AND tankb.missile.direction$ <> "N" AND tankb.missile.direction$ <> "S" THEN
tanka.direction$ = direction.e.w$
END IF
CASE "E"
IF tankb.missile.x < tanka.x + 13 AND tankb.missile.x > tanka.x AND tankb.missile.x > 1 AND tankb.missile.x < 320 AND tankb.missile.direction$ <> "E" AND tankb.missile.direction$ <> "W" THEN
tanka.direction$ = direction.n.s$
END IF
CASE "S"
IF tankb.missile.y < tanka.y + 13 AND tankb.missile.y > tanka.y AND tankb.missile.y > 1 AND tankb.missile.y < 200 AND tankb.missile.direction$ <> "N" AND tankb.missile.direction$ <> "S" THEN
tanka.direction$ = direction.e.w$
END IF
CASE "W"
IF tankb.missile.x > tanka.x - 13 AND tankb.missile.x < tanka.x AND tankb.missile.x > 1 AND tankb.missile.x < 320 AND tankb.missile.direction$ <> "E" AND tankb.missile.direction$ <> "W" THEN
tanka.direction$ = direction.n.s$
END IF
END SELECT
END IF
 
 
'difficult game - tank changes direction if headed right for a missile headed for him
IF difficulty$ = "d" THEN
direction.num = INT(2 * RND)
SELECT CASE direction.num
CASE 0
direction.e.w$ = "E"
direction.n.s$ = "N"
CASE 1
direction.e.w$ = "W"
direction.n.s$ = "S"
END SELECT
 
SELECT CASE tankb.missile.direction$
 
CASE "N"
IF (tankb.missile.x < tanka.x + 10) AND (tankb.missile.x > tanka.x - 10) AND (tanka.y - 10 <= tankb.missile.y) AND (tanka.direction$ <> "E") AND (tanka.direction$ <> "W") THEN
tanka.direction$ = direction.e.w$
END IF
 
CASE "E"
IF (tankb.missile.y < tanka.y + 10) AND (tankb.missile.y > tanka.y - 10) AND (tanka.x + 10 >= tankb.missile.x) AND (tanka.direction$ <> "N") AND (tanka.direction$ <> "S") THEN
tanka.direction$ = direction.n.s$
END IF
 
CASE "S"
IF (tankb.missile.x < tanka.x + 10) AND (tankb.missile.x > tanka.x - 10) AND (tanka.y + 10 >= tankb.missile.y) AND (tanka.direction$ <> "E") AND (tanka.direction$ <> "W") THEN
tanka.direction$ = direction.e.w$
END IF
 
CASE "W"
IF (tankb.missile.y < tanka.y + 10) AND (tankb.missile.y > tanka.y - 10) AND (tanka.x - 10 <= tankb.missile.x) AND (tanka.direction$ <> "N") AND (tanka.direction$ <> "S") THEN
tanka.direction$ = direction.n.s$
END IF
 
END SELECT
 
END IF
 
END IF
 
IF tanka.x < 1 THEN
tanka.direction$ = "E"
END IF
 
IF tanka.x > 319 THEN
tanka.direction$ = "W"
END IF
 
IF tanka.y < 1 THEN
tanka.direction$ = "S"
END IF
 
IF tanka.y > 199 THEN
tanka.direction$ = "N"
END IF
 
IF tankb.x < 1 THEN
tankb.direction$ = "E"
END IF
 
IF tankb.x > 319 THEN
tankb.direction$ = "W"
END IF
 
IF tankb.y < 1 THEN
tankb.direction$ = "S"
END IF
 
IF tankb.y > 199 THEN
tankb.direction$ = "N"
END IF
 
'change direction if tanks hit
 
IF (tanka.x + 10 >= tankb.x - 10) AND (tanka.y - 10 <= tankb.y + 10) AND (tanka.y + 10 >= tankb.y - 10) AND (tanka.x + 6 < tankb.x - 6) THEN
tanka.direction$ = "W"
tankb.direction$ = "E"
END IF
 
IF (tankb.x + 10 >= tanka.x - 10) AND (tankb.y - 10 <= tanka.y + 10) AND (tankb.y + 10 >= tanka.y - 10) AND (tankb.x + 6 < tanka.x - 6) THEN
tankb.direction$ = "W"
tanka.direction$ = "E"
END IF
 
IF (tanka.y + 10 >= tankb.y - 10) AND (tanka.x - 10 <= tankb.x + 10) AND (tanka.x + 10 >= tankb.x - 10) AND (tanka.y + 6 < tankb.y - 6) THEN
tanka.direction$ = "N"
tankb.direction$ = "S"
END IF
 
IF (tankb.y + 10 >= tanka.y - 10) AND (tankb.x - 10 <= tanka.x + 10) AND (tankb.x + 10 >= tanka.x - 10) AND (tankb.y + 6 < tanka.y - 6) THEN
tankb.direction$ = "N"
tanka.direction$ = "S"
END IF
 
'target recognition
 
LOCATE 12, 13
 
IF (tanka.missile.x > tankb.x - 10) AND (tanka.missile.x < tankb.x + 10) AND (tanka.missile.y > tankb.y - 10) AND (tanka.missile.y < tankb.y + 10) THEN
COLOR 9
PRINT tankb.NAME$; " got hit."
tanka.score = tanka.score + 1
GOTO new
END IF
 
IF (tankb.missile.x > tanka.x - 10) AND (tankb.missile.x < tanka.x + 10) AND (tankb.missile.y > tanka.y - 10) AND (tankb.missile.y < tanka.y + 10) THEN
COLOR 15
PRINT tanka.NAME$; " got hit."
tankb.score = tankb.score + 1
GOTO new
END IF
 
GOTO a
 
quit:
finish:
LOCATE 1, 12
IF tanka.score > tankb.score THEN
COLOR 9
PRINT tanka.NAME$; " wins!"
ELSE
  IF tankb.score > tanka.score THEN
  COLOR 15
  PRINT tankb.NAME$; " wins!"
  ELSE
  COLOR 12
  PRINT "Tie"
  END IF
END IF
IF n.y = 0 THEN
GOTO gameover
END IF
 
new:
LOCATE 15, 1
PRINT "Score:"
LOCATE 16, 5
PRINT tanka.NAME$; "-"; tanka.score; "  "; tankb.NAME$; "-"; tankb.score
IF change$ = "q" OR rounds >= rounds.limit THEN
n.y = 0
GOTO finish
END IF
LOCATE 17, 12
PRINT "space to continue"
WHILE INKEY$ <> " "
WEND
GOTO newround
 
gameover:
LOCATE 18, 12
COLOR 12
PRINT "Game Over"
LOCATE 19, 5
PRINT "Do you want to play again? y/n"
again:
y.n$ = INKEY$
SELECT CASE y.n$
CASE "y"
COLOR 15
CLS
GOTO start
CASE "n"
END
END SELECT
GOTO again

Не по теме:

Те кто тоже имеют интересные исходники, тоже выкладывайте.

0
GlaDosEvolution
9 / 9 / 0
Регистрация: 13.06.2015
Сообщений: 61
14.12.2016, 13:06  [ТС] 5
Четвертый исходник: это генератор музыки, настаивается тип нот и тон звучания в начале.
sound_gen.zip
Так так исходник больше 15.000 символов, уже нельзя в виде текста выложить. А уже в виде архива.
0
GlaDosEvolution
9 / 9 / 0
Регистрация: 13.06.2015
Сообщений: 61
14.12.2016, 13:19  [ТС] 6
Цитата Сообщение от Pro_grammer Посмотреть сообщение
А если примитивный калькулятор на QBasic
Ну я бы не сказал что он уж сильно примитивный. Вы хоть исходник смотрели. Или только увидели слово калькулятор и у вас сразу ассоциация с примитивным кодом?
0
Pro_grammer
Модератор
6176 / 2259 / 443
Регистрация: 24.04.2011
Сообщений: 3,998
Записей в блоге: 10
14.12.2016, 15:21 7
Цитата Сообщение от GlaDosEvolution Посмотреть сообщение
Вы хоть исходник смотрели.
Ну, а что может быть проще?
Если бы хотя бы вот такой калькулятор был, написан на Basic уровня 1992 г.:
Публикация интересных исходников по QB64

Я бы реально восторгался.
А у вас QB64 - довольно мощный и современный ЯП, а код на уровне 80-х.
Для многих тут аборигенов код будет неинтересен ( как обещано в заголовке темы), уровень школьника, начинающего изучать QBasic.
P.S. Не в обиду ВАМ сказано - просто личное мнение, и ни чего более.
0
GlaDosEvolution
9 / 9 / 0
Регистрация: 13.06.2015
Сообщений: 61
14.12.2016, 15:26  [ТС] 8
Цитата Сообщение от Pro_grammer Посмотреть сообщение
а код на уровне 80-х
Ну уж извините если не так написал. Я писал калькулятор с учетом на текстовый интерфейс.

Добавлено через 1 минуту
И если что я не профи кодер на диалекте qb64. Я больше предпочел бы FreeBasic.
0
locm
2195 / 920 / 118
Регистрация: 28.10.2011
Сообщений: 2,981
Записей в блоге: 6
14.12.2016, 16:01 9
Цитата Сообщение от GlaDosEvolution Посмотреть сообщение
Я больше предпочел бы FreeBasic.
Что мешает его предпочитать? Толку будет больше чем от QB64.
0
GlaDosEvolution
9 / 9 / 0
Регистрация: 13.06.2015
Сообщений: 61
14.12.2016, 16:18  [ТС] 10
Цитата Сообщение от locm Посмотреть сообщение
Что мешает его предпочитать?
Просто раз я уже выбрал специфический диалект то придется его использовать. Ну а если кому будет интересно то я могу создать тему только под FreeBasic исходники (и как я для себя выяснил, с ним легче работать).
Цитата Сообщение от locm Посмотреть сообщение
Толку будет больше чем от QB64
Да согласен, толк от использования qb64 не очень большой.

П.С. И еще новость. У меня закончилась мотивация по созданию исходников на qb64. Если кто знает что еще можно не сложное сделать на нем, то пишите. Ну а если нет то я создам новую тему где буду делать исходники на FreeBasic.
0
locm
2195 / 920 / 118
Регистрация: 28.10.2011
Сообщений: 2,981
Записей в блоге: 6
14.12.2016, 17:34 11
Цитата Сообщение от GlaDosEvolution Посмотреть сообщение
У меня закончилась мотивация по созданию исходников на qb64. Если кто знает что еще можно не сложное сделать на нем, то пишите.
Если терпения хватит, можете повторить мой проект написав его с нуля на QB64.
2
GlaDosEvolution
9 / 9 / 0
Регистрация: 13.06.2015
Сообщений: 61
14.12.2016, 18:03  [ТС] 12
Цитата Сообщение от locm Посмотреть сообщение
Если терпения хватит, можете повторить мой проект написав его с нуля на QB64
Мне кажется что возможностей qb64 может не хватить для торрент клиента. И написать на qb64 не так то и просто без нормальной ide или редактора с нормальным авто-дополнением кода и хорошей подсветкой синтаксиса.
А на C11 написать раз плюнуть.

Добавлено через 1 минуту
Да и к тому же PureBasic мощнее в 6 раз qb64.

Добавлено через 7 минут
А у вас классный торрент клиент. Молодец.

Не по теме:

При желании вы могли бы даже обойти знаменитый uTorrent



Добавлено через 1 минуту
Мне кажется что уже пора переходить в новую тему, если размещение бесполезных исходников еще актуально.
0
The trick
Модератор
7714 / 2735 / 766
Регистрация: 22.02.2013
Сообщений: 3,867
Записей в блоге: 77
14.12.2016, 18:05 13
Вот простые идеи:
http://www.cyberforum.ru/blogs/354370/blog1867.html
http://www.cyberforum.ru/blogs/354370/blog2375.html
http://www.cyberforum.ru/blogs/354370/blog2051.html
http://www.cyberforum.ru/blogs/354370/blog1855.html
http://www.cyberforum.ru/blogs/354370/blog1767.html
0
GlaDosEvolution
9 / 9 / 0
Регистрация: 13.06.2015
Сообщений: 61
14.12.2016, 18:28  [ТС] 14
Цитата Сообщение от The trick Посмотреть сообщение
Вот простые идеи
Спс. Попробую переделать под qb64, но на это потребуется время, так как возможности у qb64 сильно урезаны по сравнению с VisualBasic.
0
Pro_grammer
Модератор
6176 / 2259 / 443
Регистрация: 24.04.2011
Сообщений: 3,998
Записей в блоге: 10
14.12.2016, 20:43 15
Цитата Сообщение от GlaDosEvolution Посмотреть сообщение
А на C11 написать раз плюнуть.
Вообще то это не конкретный язык программирования, а стандарт языка Си от 2011 года.
Его поддерживает например GCC.
Естественно, на Си можно и пишется всё что угодно, это де-факто основной язык для любой операционной системы, на нёс написаны все основные библиотеки и список его достоинств можно продолжать вечно.
Только вот такой нюанс - кто знает в совершенстве Си(++) тот о Бейсике даже и разговаривать не станет, так что сравнение некорректное.
0
GlaDosEvolution
9 / 9 / 0
Регистрация: 13.06.2015
Сообщений: 61
14.12.2016, 20:55  [ТС] 16
Цитата Сообщение от Pro_grammer Посмотреть сообщение
так что сравнение некорректное
Ну не знаю мне вот синтаксис FreeBasic нравится больше чем любой язык семейства Си.
Но Си мощнее FreeBasic. Вот такой вот нюанс получается.
0
Pro_grammer
Модератор
6176 / 2259 / 443
Регистрация: 24.04.2011
Сообщений: 3,998
Записей в блоге: 10
14.12.2016, 21:23 17
Цитата Сообщение от GlaDosEvolution Посмотреть сообщение
синтаксис FreeBasic нравится больше чем любой язык семейства Си.
На вкус и цвет все фломастеры разные. Скажите это на форуме, где собираются профи по Си.
А Вы на FreeBasic пробовали написать полноценное оконное приложение? Ну что бы там с кнопками, текстовыми полями, переключателями, таблицами и т.п.
Вообще, хоть что то серьёзное, написанное Вами с начала и до конца, что то на несколько тысяч строк кода?
1
GlaDosEvolution
9 / 9 / 0
Регистрация: 13.06.2015
Сообщений: 61
14.12.2016, 23:05  [ТС] 18
Цитата Сообщение от Pro_grammer Посмотреть сообщение
ообще, хоть что то серьёзное, написанное Вами с начала и до конца, что то на несколько тысяч строк кода?
Пока такого большого нету. Только небольшие игры поделки, максимум в 400 строк кода.
0
Quiet Snow
4409 / 1305 / 376
Регистрация: 25.04.2010
Сообщений: 3,350
15.12.2016, 08:41 19
Вот например банальная ошибка в 165 строчке. Делей циклом. Переменная неинициализирована.
А тут должна быть привязка к таймеру. А что внутри должно быть? Правильно делей.

QBasic/QuickBASIC
1
2
FOR count = 1 TO Flicker.Control
NEXT count
Сейчас достаточно выложить код на форум и тебе всё расскажут и покажут. А раньше без инета
корячишься неделю или две, куришь справку, перебираешь варианты и алгоритмы, короче тлен.
Есть польза - есть, понимает человек суть этой пользы, вопрос риторический.
0
GlaDosEvolution
9 / 9 / 0
Регистрация: 13.06.2015
Сообщений: 61
16.12.2016, 17:28  [ТС] 20
Выкладываю третий и новогодний тип исходника на qb64:
Выкладываю в zip так как символов больше 15.000 не вставить на форум.
Первый архив исходник:
carols_src.zip
Второй архив готовый exe для запуска без qb64:
carols_exe.zip
Примечание к программе:
Когда увидите меню пишите номер нужной композиции их меню.
И еще момент, все звуки генерируются вашей встроенной звуковой картой из специально кодированных отрывков в исходнике.

И собственно вот и новый пост подошел к концу.
И за сим прощаюсь и до скорой встречи.

Заранее поздравляю: С новым годом киберфорум.
2
16.12.2016, 17:28
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
16.12.2016, 17:28

много интересных программ)
http://imglink.ru/thumbnails/09-03-11/06568cb05550cc0b1bd7e04740d71429.jpg ...

Решения интересных задачек! ХЕЛП
Доброго времени суток, уважаемые программисты. Хотел бы попросить Вас о...

Несколько интересных фактов в Javascript
Здравствуйте! На днях читал небольшую статью с названием &quot;Несколько интересных...


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

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

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