SRL Archive - Other Scripts

this is a simple back jack game, and there might be a few bugs in it, :(

any ways, enjoy :D

also, i might add online stats/ online play eventually. :)

program Black_Jack;

const
  start_money = 2000;

var
  // Initform variables.
  frmDesign : TForm;
  Money, Label1, Label2, Label3,
  Label4 : TLabel;
  RadioButton1, RadioButton2, RadioButton3 : TRadioButton;
  Button1, Button2 : TButton;
  card : TStringArray;
  CurrentScore, D_CurrentScore, Curr_Money : Integer;
  cards, D_cards : String;
  P_Win, D_Win, Tie : boolean;
  
function get_pos(var wat: TStringArray; subwat: variant): integer;
var i : integer;
begin
  for i := 0 to high(wat) do
    if wat[i] = subwat then result := i;
end;
  
function drawcard: string;
begin
  result:= card[random(13)];
  if (result = '') or (result = ' ') then
    writeln(':(');
end;

function getscore(s : string): integer;
begin
  if s = 'A' then
  begin
    if currentscore <= 10 then result := 11 else result := 1;
  end else result := get_pos(card, s) + 1;
end;

function Dgetscore(s : string): integer;
begin
  if s = 'A' then
  begin
    if D_currentscore <= 10 then result := 11 else result := 1;
  end else result := get_pos(card, s) + 1;
end;

procedure Dealer_Hit;
var Dss : string;
begin
  Dss := drawcard;
  D_CurrentScore := D_CurrentScore + Dgetscore(Dss);
  D_cards := D_cards  + ' + ' + Dss;
  with Label4 do
    Caption := 'Dealers Cards: ' + inttostr(D_CurrentScore) + ' - ' + D_cards;
end;

procedure Player_Hit;
var ss : string;
begin
  ss := drawcard;
  CurrentScore := CurrentScore + getscore(ss);
  cards := cards  + ' + ' + ss;
  with Label3 do
    Caption := 'Your Cards: ' + inttostr(CurrentScore) + ' - ' + cards;
end;

procedure Win;
begin
  if CurrentScore = 21 then P_Win := true;
  if D_CurrentScore = 21 then D_Win := true;
  if (CurrentScore > 21) and (D_CurrentScore <= 21) then D_Win := true;
  if (CurrentScore < 21) and (D_CurrentScore > 21) then P_Win := true;
  if CurrentScore > 21 then P_Win := false;
  if D_CurrentScore > 21 then D_Win := false;
  if P_Win and D_Win then Tie := true;
end;

procedure resetstats;
begin
  P_Win := false;
  D_Win := false;
  CurrentScore := 0;
  D_CurrentScore := 0;
  D_cards := '';
  cards := '';
  Tie := false;
end;

function loadmoney: integer;
begin
  if RadioButton1.checked then result := 100;
  if RadioButton2.checked then result := 500;
  if RadioButton3.checked then result := 1000;
end;

procedure Handle_bet;
begin
  if tie then exit;
  if P_Win then
    Curr_Money := Curr_Money + loadmoney else
   Curr_Money := Curr_Money - loadmoney;
  Label1.Caption := '$' + inttostr(Curr_Money);
  if Curr_Money < 100 then
  begin
    MessageDlg ('You Lose!', mtCustom,[mbOK], 0);
    Curr_Money := Start_Money;
  end;
end;

procedure dowin;
begin
  if tie then
  begin
    MessageDlg ('Tie!', mtCustom,[mbOK], 0);
    Handle_bet;
    resetstats;
  end;
  if P_Win then
  begin
    MessageDlg ('Winner!', mtCustom, [mbOK], 0);
    Handle_bet;
    resetstats;
  end;
  if D_Win then
  begin
     MessageDlg ('Loser!', mtCustom,[mbOK], 0);
     Handle_bet;
    resetstats;
  end;
end;

procedure HitClick(asender: TObject);
begin
  Player_Hit;
  if D_CurrentScore <= 13 + random(4) then
    Dealer_Hit;
  Win;
  dowin;
end;

procedure StandClick(bsender: TObject);
begin
  if D_CurrentScore <= 13 + random(4) then
    Dealer_Hit;
  Win;
  if (CurrentScore > D_CurrentScore) then P_Win := true;
  if (CurrentScore < D_CurrentScore) then D_Win := true;
  dowin;
end;

// This form was parsed using DFM Form Parser v.26c Beta by Ron.
// Generated from Black Jack.dfm.
procedure Initform;
var
  TimeInitform : Integer;
begin
  TimeInitform := GetSystemTime;
  frmDesign := CreateForm;
  with frmDesign do
  begin
    Position := poScreenCenter;
    BorderStyle := bsSingle;
    ClientWidth := 250;
    ClientHeight := 150;
    Caption := 'Black Jack!';
    Color := clGreen;
    Font.Color := clWindowText;
    Font.Height := -11;
    Font.Name := 'MS Sans Serif';
    Font.Style := [];
    PixelsPerInch := 96;
  end;
  Money := TLabel.Create(frmDesign);
  with Money do
  begin
    Parent := frmDesign;
    Left := 8;
    Top := 8;
    Width := 3;
    Height := 13;
  end;
  Label1 := TLabel.Create(frmDesign);
  with Label1 do
  begin
    Parent := frmDesign;
    Left := 48;
    Top := 8;
    Width := 30;
    Height := 13;
    Caption := '$' + inttostr(Curr_Money);
  end;
  Label2 := TLabel.Create(frmDesign);
  with Label2 do
  begin
    Parent := frmDesign;
    Left := 8;
    Top := 8;
    Width := 35;
    Height := 13;
    Caption := 'Money:';
  end;
  Label3 := TLabel.Create(frmDesign);
  with Label3 do
  begin
    Parent := frmDesign;
    Left := 8;
    Top := 32;
    Width := 58;
    Height := 13;
    Caption := 'Your Cards: ';
  end;
  Label4 := TLabel.Create(frmDesign);
  with Label4 do
  begin
    Parent := frmDesign;
    Left := 8;
    Top := 56;
    Width := 72;
    Height := 13;
    Caption := 'Dealers Cards: ';
  end;
  RadioButton1 := TRadioButton.Create(frmDesign);
  with RadioButton1 do
  begin
    Parent := frmDesign;
    Left := 8;
    Top := 80;
    Width := 113;
    Height := 17;
    Caption := 'Bet 100';
    TabOrder := 0;
    checked := true;
  end;
  RadioButton2 := TRadioButton.Create(frmDesign);
  with RadioButton2 do
  begin
    Parent := frmDesign;
    Left := 8;
    Top := 104;
    Width := 113;
    Height := 17;
    Caption := 'Bet 500';
    TabOrder := 1;
  end;
  RadioButton3 := TRadioButton.Create(frmDesign);
  with RadioButton3 do
  begin
    Parent := frmDesign;
    Left := 8;
    Top := 128;
    Width := 113;
    Height := 17;
    Caption := 'Bet 1000';
    TabOrder := 2;
  end;
  Button1 := TButton.Create(frmDesign);
  with Button1 do
  begin
    Parent := frmDesign;
    Left := 168;
    Top := 80;
    Width := 73;
    Height := 25;
    Caption := 'Hit';
    TabOrder := 3;
    Button1.OnClick := @HitClick;
  end;
  Button2 := TButton.Create(frmDesign);
  with Button2 do
  begin
    Parent := frmDesign;
    Left := 169;
    Top := 121;
    Width := 71;
    Height := 24;
    Caption := 'Stand';
    TabOrder := 4;
    Button2.OnClick := @StandClick;
  end;
  WriteLn('Initform compiled in ' + IntToStr(GetSystemTime - TimeInitform) + ' milliseconds!');
end;

procedure SafeInitform;
var
  v : TVariantArray;
begin
  SetArrayLength(v, 0);
  ThreadSafeCall('Initform', v);
end;

procedure ShowInitformModal;
begin
  frmDesign.ShowModal;
end;

procedure SafeShowInitformModal;
var
  v : TVariantArray;
begin
  SetArrayLength(v, 0);
  ThreadSafeCall('ShowInitformModal', v);
end;

procedure MainInitform;
begin
  try
    SafeInitform;
    SafeShowInitformModal;
  finally
    FreeForm(frmDesign);
  except
    WriteLn('An error seems to have occurred in: Initform');
  end;
end;

begin
  ClearDebug;
  card := ['A', '2', '3', '4', '5', '6', '7', '8', '9', '10', 'J', 'Q', 'K'];
  Curr_Money := start_money;
  GetSelf.WindowState := wsMinimized;
  MainInitform;
  GetSelf.WindowState := wsNormal;
end.

Cool, maybe add bitmaps?

From: IceFire908
Cool, maybe add bitmaps?

mkay, :D

i'll work on it later

Nice game :) I just dont know what score I should try to get?

21.

Why does it give you cards like "12"?

Worked quite well. As IceFire suggested, bitmaps would be nice. A bar between total and cards along with an addition sign between card values, for example 14 ― 8 + 6. That would help with distinguishing what you have.

I also recommend, if not too difficult, disabling player from using Stand when they shouldn't (i.e. just started and have no cards drawn, and when you just clicked OK on Winner!/Loser! box.)

Solid script though.

From: Nava2
Why does it give you cards like "12"?

it gives the score twelve, there isnt any card 12. :p

and thanks scub :D

From: Awkwardsaw
it gives the score twelve, there isnt any card 12. :p

and thanks scub :D

I think you need to work on the GUI :)

Winner winner, chicken dinner ;)

From: Nava2
I think you need to work on the GUI :)

i will be. ;)

also updated, should fix bugs, let me know if there are any left lol

I thought all face cards were worth 10?

They are, right? He just makes them '11/12/13' for King/Queen/Jack (not in that order perhaps, i'm a card n00b)

I thought, in a traditional game of Black Jack, face cards were worth 10 and the ace was worth 11 or 1.

where i play it, face cards are in the order they are in the deck.. so j=11, q=12, k=13.

and ace does equal 1 or 11, :)

From: scubajesus
I also recommend, if not too difficult, disabling player from using Stand when they shouldn't (i.e. just started and have no cards drawn, and when you just clicked OK on Winner!/Loser! box.)

In real black jack you can stand on your first 2 given cards if you need to.

This naissance is sweet for scar and I worked on it a bit this year but couldn't find the time to perfect it. Yours is close to the rules of black jack.

Except, the dealer starts hitting after the player(s) stand. A player can only stand if he has less than 22 (so he hasn't busted yet). Then the dealer who is only showing 1 card face up and the other face down, lifts his face down card, and he will continue hitting until he has 17 or higher. If he has higher than 17 but lower than 22, he will stand and then the number scores can be compared for a payout.

Also, the player always gets an option to double his bet after the first 2 cards are shown but he may only receive 1 card if he doubles and has to immediately stand (unless he busts).

If you're interested in finishing this program, please try to incorporate all the rules of blackjack. This link will also talk about splitting pairs, insurance, surrendering, etc:
http://www.blackjackinfo.com/blackjack-rules.php

If you can make the bets more reasonable, that would be cool too such as $5, $25, $50, $100. Seems like we're hitting on a no maximum table like in that James Bond movie where the eccentric yuppie woman bets $1m and loses lol.

All the best!

~Ron