Hoşgeldiniz, bugün 03 June 2025
aktif üye 8,903
SEN DE YAZ
HazırKod ziyaretçilerinin katkıları bizim için çok önemli!
Sizde hazırkod üyesi olun, ekleyeceğiniz kodlar yapacağınız yorumlarla hazirkod.com'a katkıda bulunun.
ETİKETLER
toplu mesaj toplu mesaj gönderme toplu sms gönderme toplu sms paketleri toplu sms programı toplu mesaj atma sms paketleri başlıklı sms toplu mesaj gönderme programı toplu sms sistemi toplu sms firmaları kurumsal sms paketler

Programalama > PASCAL

PASCAL / Blackjack
Bence Guzel Bir Program Denemesi Bedava
Etiketler: blackjack

Ort. 0
Puan ver:
hazirkod 19 June 19:34 0
0 kişiden 0 puan aldı
5444
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
USES CRT;{WINDOWS ICIN WINCRT}
 
CONST
 CESIT:ARRAY[0..3] OF CHAR=( '', '', '', '');
 GORUNUM:ARRAY[1..13]OF STRING[2]=('A','2','3','4','5','6','7','8','9','10','J','Q','K');
 
VAR
  SECILEN:ARRAY[1..52] OF INTEGER;
  TOP,CES,DEGER,DEGER2,TOP2,TOP11,PUANO,PUANK,SAYAC,SEKIL,SAYAC2,TOPILK,TOPILK2,I,KART:INTEGER;
  CH:CHAR;GIZLI:STRING[2];NAME:STRING; secim,CIKAN,CIKAN2:byte;KO,KK:BOOLEAN;
 
PROCEDURE GETNAME(VAR NAME:STRING);
BEGIN
 CLRSCR;
 GOTOXY(18,10);
 WRITELN('iSMiNiZi GiRiNiZ');
 GOTOXY(19,14);READ(NAME);
END;{KULLANICIDAN ILGILI YERLERDE KULLANMAK ICIN ISIM ALIR}
 
PROCEDURE RENK;
 BEGIN
  TEXTBACKGROUND(WHITE);
  IF (CES=0)OR(CES=1)THEN TEXTCOLOR(RED)ELSE TEXTCOLOR(BLACK);
 END;{KARTLARIN ARKA PLAN VE TEXT RENGINI BELIRLER}
 
PROCEDURE RENK2;
BEGIN
  TEXTBACKGROUND(BLACK);HIGHVIDEO;TEXTCOLOR(WHITE);
 END;{ORJINAL TEXT VE ARKA PLAN RENGINI GERI YUKLER}
 
PROCEDURE SIFIRLA;
BEGIN
FOR I:=1 TO 52 DO
 SECILEN[KART]:=0;
 TOP:=0;TOP2:=0;SAYAC:=1;SAYAC2:=1;TOP11:=0;KART:=0;CIKAN:=0;CIKAN2:=0;
END;{DEGISKENLERI SIFIRLAR}
 
PROCEDURE PUAN_YAZ;
BEGIN
 GOTOXY(14,20);WRITELN('PUAN:',PUANO);
 GOTOXY(46,20);WRITELN('PUAN:',PUANK);
END;{PUANLARI ILGILI YERLERE YAZAR}
 
PROCEDURE OKU;
 BEGIN
   REPEAT
    CH:=READKEY;
    CH:=UPCASE(CH);
   UNTIL CH IN['D','P'];
 END;{KLAVYEDEN DOGRU VERI ALINMASINI SAGLAR}
 
PROCEDURE YENDINIZ;
BEGIN
 GOTOXY(14,19);WRITELN(NAME,'  KAZANDI');
 PUANO:=PUANO+1;
 SIFIRLA;
END;{OYUNCUNUN KAZANDIGI DURUMLARDA KULLANILIR}
 
PROCEDURE YENILDINIZ;
BEGIN
 GOTOXY(46,19);WRITELN('MEHMET KAZANDI');
 PUANK:=PUANK+1;
 SIFIRLA;
END;{OYUNCUNUN KAYBETTIGI DURUMLARDA KULLANILIR}
 
PROCEDURE KARMA(VAR CES,DEGER:INTEGER);
BEGIN  KART:=KART+1;
 SECILEN[KART]:=RANDOM(52)+1;
 FOR I:=1 TO KART-1 DO
  BEGIN
   IF SECILEN[KART]=SECILEN[I] THEN
     BEGIN
     REPEAT
     SECILEN[KART]:=RANDOM(52)+1;
     I:=1;
     UNTIL SECILEN[KART]<>SECILEN[I];
     END;
  END;
   IF (SECILEN[KART]<=13)AND(SECILEN[KART]>1) THEN CES:=0 ELSE
     IF SECILEN[KART]<=26 THEN CES:=1 ELSE
       IF SECILEN[KART]<=39 THEN CES:=2 ELSE CES:=3;
        DEGER:=SECILEN[KART] MOD 13+1;
         SEKIL:=SECILEN[KART] MOD 13+1;
          IF SEKIL IN[11,12,13] THEN  DEGER:=10;
END;{KARMA ISLEMINI YAPAR VE KARTIN DAHA ONCE KULLANILIP
                                           KULLANILMADIGINI KONTROL EDER}
 
 
PROCEDURE KASA(VAR TOP2,SAYAC2:INTEGER);
BEGIN
  RENK;SAYAC2:=SAYAC2+1;
  {KASA ICIN AS DURUMU}
 IF SEKIL=1 THEN BEGIN DEGER:=11;CIKAN2:=CIKAN2+1;END;
   TOP2:=TOP2+DEGER;
 IF TOP2>21 THEN BEGIN TOP2:=TOP2-CIKAN2*10;CIKAN2:=0;END;
 
IF SAYAC2<>3 THEN BEGIN
                   GOTOXY(48,SAYAC2);WRITELN(CESIT[CES],GORUNUM[SEKIL]:2);
                   RENK2;
                   GOTOXY(46,18);WRITELN('TOPLAM: ',TOP2:2);
                  END;
 
IF SAYAC2=3 THEN BEGIN
                  GIZLI:=GORUNUM[SEKIL];
                  GOTOXY(48,SAYAC2);WRITELN('# ?');
                  RENK2;
                 END;
END;{KASANIN OYUNLA ILGILI TUM ISLEMLERINI YAPAR}
 
PROCEDURE PLAYER(VAR TOP,SAYAC:INTEGER);
 BEGIN
  RENK;SAYAC:=SAYAC+1;
  GOTOXY(16,SAYAC);WRITELN(CESIT[CES],GORUNUM[SEKIL]:2);
  {OYUNCU ICIN AS DURUMU}
  IF SEKIL=1 THEN BEGIN DEGER:=11;CIKAN:=CIKAN+1;END;
  TOP:=TOP+DEGER;
  IF TOP>21 THEN BEGIN TOP:=TOP-CIKAN*10;CIKAN:=0;END;
RENK2;
END;{OYUNCUNU OYUNLA ILGILI TUM ISLEMLERINI YAPAR}
 
PROCEDURE BASLA;
BEGIN
  CLRSCR;
    GOTOXY(47,1);WRITELN('MEHMET OLGAR');
    GOTOXY(14,1);WRITELN(NAME);
    KARMA(CES,DEGER);PLAYER(TOP,SAYAC);
    KARMA(CES,DEGER); PLAYER(TOP,SAYAC);
    KARMA(CES,DEGER); KASA(TOP2,SAYAC2);
    KARMA(CES,DEGER);KASA(TOP2,SAYAC2);
    BEGIN
 KO:=FALSE;KK:=FALSE;
 IF TOP=21 THEN
          IF TOP2<>21 THEN BEGIN
                            PUANO:=PUANO+2;
                            GOTOXY(27,19);WRITELN(NAME,'  BLACKJACK YAPTI');
                            KO:=TRUE;
                           END;
 
    IF TOP2=21 THEN
          IF TOP<>21 THEN BEGIN
                           PUANK:=PUANK+2;
                           GOTOXY(27,19);WRITELN('MEHMET BLACKJACK YAPTI');
                           KK:=TRUE;
                          END;
    END;
 
  IF (KK=FALSE)AND(KO=FALSE) THEN
                              BEGIN
                               GOTOXY(46,18);WRITELN('TOPLAM: ??');
                              END;
  IF (KK=TRUE)OR(KO=TRUE)OR((TOP=21)AND(TOP2=21)) THEN
   BEGIN
    GOTOXY(48,3);WRITELN(' ? ->',GIZLI:2);
    GOTOXY(46,18);WRITELN('TOPLAM: ',TOP2:2);
   END;
    GOTOXY(14,18);WRITELN('TOPLAM: ', TOP:2);
    PUAN_YAZ;
END;{OYUN MASASINI HAZIRLAR VE BLACKJACK KONTROLU YAPAR}
 
PROCEDURE PUANLA;
BEGIN
 IF (KO=FALSE)AND(KK=FALSE) THEN
  BEGIN
    IF (TOP=TOP2)AND(TOP<22) THEN BEGIN
                                   GOTOXY(34,19);WRITELN('BERABER');
                                  END;
 
    IF (TOP=21)AND(TOP2<>21) THEN YENDINIZ;
 
    IF (TOP2=21)AND(TOP<>21) THEN YENILDINIZ;
 
    IF (TOP2<21)AND(TOP<21)THEN
                            BEGIN
                             IF TOP>TOP2 THEN YENDINIZ;
                             IF TOP<TOP2 THEN YENILDINIZ;
                            END;
 
    IF (TOP2<21)AND(TOP>21)THEN
                            BEGIN
                             YENILDINIZ;
                             GOTOXY(14,19);WRITELN(NAME,'  BATTI..');
                            END;
 
    IF (TOP2>21)AND(TOP<21) THEN BEGIN
                                  YENDINIZ;
                                  GOTOXY(46,19);WRITELN('MEHMET BATTI..');
                                 END;
    IF (TOP>21)AND(TOP2>21) THEN BEGIN
                                   GOTOXY(14,19);WRITELN(NAME,'  BATTI..');
                                   GOTOXY(46,19);WRITELN('MEHMET BATTI..');
                                 END;
  END;
END;{PUANLAMA ISLEMINI YAPAR}
 
BEGIN
 CLRSCR;
 SIFIRLA;
  GETNAME(NAME);
   REPEAT RANDOMIZE;
    BASLA;
    IF (KK=FALSE)AND(KO=FALSE) THEN
    BEGIN
     GOTOXY(24,22);WRITELN('(P)AS MI?,,(D)EVAM MI?');
     OKU;
     IF (CH='D')AND(TOP<>21)THEN
                             WHILE (TOP<21)AND(CH<>'P') DO
                              BEGIN
                               KARMA(CES,DEGER);
                               PLAYER(TOP,SAYAC);
                               GOTOXY(14,18);WRITELN('TOPLAM: ',TOP:2);
                               OKU;
                              END;{OYUNCUNUN ISLEMLERI}
 
     IF (CH='P')OR(TOP>20) THEN
                            BEGIN
                             GOTOXY(46,18);WRITELN('TOPLAM: ',TOP2:2);
                             GOTOXY(48,3);WRITELN(' ? ->',GIZLI:2);
                            END;{GIZLENMIS KAGIDI DOGRU ZAMANDA
                                                       ILGILI YERE YAZAR}
 
     IF ((CH='P')OR(TOP>21))AND(TOP2<17)THEN
                                         BEGIN
                                          REPEAT
                                           KARMA(CES,DEGER);
                                           KASA(TOP2,SAYAC2);
                                          UNTIL (TOP2>21)OR((16<TOP2)AND(TOP2<22));
                                         END;{KASANIN ISLEMLERI}
     PUANLA;
     PUAN_YAZ;
    END;{OYUNUN TUM ISLEMLERI}
     SIFIRLA;
     GOTOXY(24,22); WRITELN('DEVAM ETMEK ISTERMISINIZ?#-E-*-H-#');
    REPEAT
     CH:=READKEY; CH:=UPCASE(CH);
    UNTIL CH IN['E','H'];
 UNTIL CH='H';
END.{OYUN}


Yorumlar                 Yorum Yaz
Bu hazır kod'a ilk yorumu siz yapın!
KATEGORİLER
ADO.NET - ADO - 8
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
COMPONENT - 5
DATABASE - 8
DELPHI - 247
FLASH - 49
HTML - 536
JAVA - JSP - 43
JAVA SCRIPT - 494
PASCAL - 246
PERL - 11
PHP - 160
VISUAL BASIC - 337
VISUAL BASIC.NET - 39
WML - 9
XML - 2
Tüm Kategoriler
GİZLİLİK İLKELERİ | BİZE ULAŞIN
Copyright © 2002 - 2025 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.