API tools faq
paste
Advertisement
Guest User

Untitled

a guest
May 23rd, 2019
85
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 23.64 KB | None | 0 0
raw download clone embed print report
  1. unit UnitGame;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, StdCtrls, Vcl.Imaging.jpeg, Vcl.ExtCtrls,
  8.   System.ImageList, Vcl.ImgList, UnitListOfPlayers, Vcl.Menus, UnitGameHelp;
  9.  
  10. type
  11.    TArrayHand = array [1..10] of Integer;
  12.    TPerson = (Player, Dealer, Nobody);
  13.  
  14.   TFormGame = class(TForm)
  15.     btStand: TButton;
  16.     btHit: TButton;
  17.     btSetBet: TButton;
  18.     btRepeatBet: TButton;
  19.     btDoubleBet: TButton;
  20.     Label1: TLabel;
  21.     Label2: TLabel;
  22.     lBalance: TLabel;
  23.     lBet: TLabel;
  24.     rb5: TRadioButton;
  25.     rb10: TRadioButton;
  26.     gbForBet: TGroupBox;
  27.     rb25: TRadioButton;
  28.     rb100: TRadioButton;
  29.     rb250: TRadioButton;
  30.     rb500: TRadioButton;
  31.     rb1000: TRadioButton;
  32.     rb1: TRadioButton;
  33.     pbPlayerHand: TPaintBox;
  34.     pbDealerHand: TPaintBox;
  35.     btResetBet: TButton;
  36.     PlayerScore: TLabel;
  37.     DealerScore: TLabel;
  38.     TimerNewGame: TTimer;
  39.     gbBalanceAndBet: TGroupBox;
  40.     btFold: TButton;
  41.     mmGameForm: TMainMenu;
  42.     ItefGameHelp: TMenuItem;
  43.     ItemBackToMenu: TMenuItem;
  44.     procedure FormCreate(Sender: TObject);
  45.     procedure FormDestroy(Sender: TObject);
  46.     procedure btSetBetClick(Sender: TObject);
  47.     procedure rb5Click(Sender: TObject);
  48.     procedure rb10Click(Sender: TObject);
  49.     procedure rb25Click(Sender: TObject);
  50.     procedure rb100Click(Sender: TObject);
  51.     procedure rb250Click(Sender: TObject);
  52.     procedure rb500Click(Sender: TObject);
  53.     procedure rb1000Click(Sender: TObject);
  54.     procedure rb1Click(Sender: TObject);
  55.     procedure btResetBetClick(Sender: TObject);
  56.     function GetCard: Integer;
  57.     function GetScore(const SomebodyHand: TArrayHand): Integer;
  58.     function GetCardValue(Number: Integer): Integer;
  59.     procedure ShowGameInterface(Visibility: Boolean);
  60.     procedure btHitClick(Sender: TObject);
  61.     procedure PrintScore(const SomebodyHand: TArrayHand; var PersonScore: TLabel);
  62.     procedure btStandClick(Sender: TObject);
  63.     procedure DealerGame;
  64.     procedure CheckGameResult;
  65.     procedure ShowResult(Winner: TPerson; Blackjack: Boolean);
  66.     procedure TimerNewGameTimer(Sender: TObject);
  67.     function CheckBust(var SomeBodyHand: TArrayHand; Person: TPerson): Boolean;
  68.     procedure btSplitClick(Sender: TObject);
  69.     procedure btDoubleBetClick(Sender: TObject);
  70.     procedure btRepeatBetClick(Sender: TObject);
  71.     procedure FormShow(Sender: TObject);
  72.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  73.     procedure FormPaint(Sender: TObject);
  74.     procedure pbPlayerHandPaint(Sender: TObject);
  75.     procedure pbDealerHandPaint(Sender: TObject);
  76.     procedure btFoldClick(Sender: TObject);
  77.     procedure ItemBackToMenuClick(Sender: TObject);
  78.     procedure ItefGameHelpClick(Sender: TObject);
  79.   private
  80.     Wdth:integer;
  81.     Hght:integer;
  82.     procedure ClearHands;
  83.   public
  84.   end;
  85.  
  86. var
  87.   FormGame: TFormGame;
  88.   lGameResult: TLabel;
  89.   ArrPlayerHand : TArrayHand;
  90.   ArrDealerHand : TArrayHand;
  91.   LastBet : Integer;
  92.  
  93. function cdtDraw(DC: HDC; X, Y, Card, Typ: Integer; Color: TColor):Integer; StdCall; external 'cards.dll';
  94. function cdtDrawExt(DC: HDC; X, Y, CardWidth, CardHeight, Card, Typ:Integer; Color:TColor):integer; StdCall; external 'cards.dll';
  95. function cdtInit(var Width, Height: Integer): Integer; StdCall; external 'cards.dll';
  96. function cdtTerm: Integer; StdCall; external 'cards.dll';
  97.  
  98.  
  99. implementation
  100.  
  101. {$R *.dfm}
  102.  
  103. uses UnitMainMenu;
  104.  
  105. procedure DrawDeck;
  106. const
  107.    X = 550;
  108.    Y = 60;
  109.    Diff = 2;
  110. var
  111.    i : Integer;
  112. begin
  113.    for i := 1 to 20 do
  114.    begin
  115.       cdtDrawExt(FormGame.Canvas.Handle, X + i * Diff, Y - i * Diff, 80, 100, 59, 1, clGray);
  116.    end;
  117. end;
  118.  
  119. procedure DrawHand(var HandPaintBox: TPaintBox; SomebodyHand: TArrayHand);
  120. const
  121.    CardWidth = 80;
  122.    CardHeght = 100;
  123.    Border = 15;
  124.    StartPositionY = 0;
  125. var
  126.    ClearWidth, ClearHeight, StartPositionX, i, Count : Integer;
  127.    Fon: TBitMap;
  128. begin
  129.    ClearWidth := HandPaintBox.Width;
  130.    ClearHeight := HandPaintBox.Height;
  131.    Fon := TBitmap.Create;
  132.    Fon.LoadFromFile('../../Картинки/FonGame.bmp');
  133.    HandPaintBox.Canvas.Draw(0 - HandPaintBox.Left, 0 - HandPaintBox.Top, Fon);
  134.    Fon.Free;
  135.    Count := 0;
  136.    for i := 1 to 10 do
  137.       if SomebodyHand[i] <> 0 then
  138.          Inc(Count);
  139.    StartPositionX := (ClearWidth - Count * (CardWidth + 2 * Border - Count * 10)) div 2;
  140.    for i := 1 to Count do
  141.    begin
  142.       if (HandPaintBox = FormGame.pbDealerHand) and (Count = 2) and (i = 2)  then
  143.          cdtDrawExt(HandPaintBox.Canvas.Handle, StartPositionX + (i - 1) * (CardWidth + 2 * Border - Count * 10),
  144.             StartPositionY, CardWidth,  CardHeght, 59, 1, clWhite)
  145.       else
  146.       cdtDrawExt(HandPaintBox.Canvas.Handle, StartPositionX + (i - 1) * (CardWidth + 2 * Border - Count * 10),
  147.          StartPositionY, CardWidth,  CardHeght, SomebodyHand[i], 0, clWhite);
  148.    end;
  149. end;
  150.  
  151. procedure TFormGame.ClearHands;
  152. var
  153.    i : Integer;
  154.    Fon: TBitmap;
  155. begin
  156.    for i := 1 to 10 do
  157.    begin
  158.       ArrPlayerHand[i] := 0;
  159.       ArrDealerHand[i] := 0;
  160.    end;
  161.    Fon := TBItmap.Create;
  162.    Fon.LoadFromFile('../../Картинки/FonGame.bmp');
  163.    pbPlayerHand.Canvas.Draw(0 - pbPlayerHand.Left, 0 - pbPlayerHand.Top, Fon);
  164.    pbDealerHand.Canvas.Draw(0 - pbDealerHand.Left, 0 - pbDealerHand.Top, Fon);
  165.    Fon.Free;
  166. end;
  167.  
  168. procedure TFormGame.ShowGameInterface(Visibility: Boolean);
  169. begin
  170.    btStand.Visible := Visibility;
  171.    btHit.Visible := Visibility;
  172.    btDoubleBet.Visible := Visibility;
  173.    btFold.Visible := Visibility;
  174.    if Visibility then
  175.    begin
  176.       btSetBet.Visible := not Visibility;
  177.       btRepeatBet.Visible := not Visibility;
  178.       btResetBet.Visible := not Visibility;
  179.       gbForBet.Visible := not Visibility;
  180.    end;
  181. end;
  182.  
  183.  
  184. procedure TFormGame.ShowResult(Winner: TPerson; Blackjack: Boolean);
  185. const
  186.    TextHeight = 50;
  187.    TextWidth = 400;
  188. begin
  189.    lGameResult := TLabel.Create(FormGame);
  190.    lGameResult.Parent := FormGame;
  191.    lGameResult.AutoSize := False;
  192.    lGameResult.Left := 0;
  193.    lGameResult.Top := DealerScore.Top + DealerScore.Height;
  194.    lGameResult.Height := PlayerScore.Top - (DealerScore.Top + DealerScore.Height);
  195.    lGameResult.Width := FormGame.ClientWidth;
  196.    lGameResult.Alignment := taCenter;
  197.    lGameResult.Font.Size := 25;
  198.    lGameResult.Font.Name := 'Vineta BT';
  199.    if Winner = Player then
  200.       if Blackjack then
  201.          lGameResult.Caption := '$Blackjack$' + #13#10 + 'Победил ' + PlayerName +
  202.             #13#10 + '   +' + IntToStr(StrToInt(lBet.Caption) * 5 div 2) + '$'
  203.       else
  204.          lGameResult.Caption := 'Победил ' + PlayerName + #13#10 +
  205.             '+' + IntToStr(StrToInt(lBet.Caption) * 2) + '$'
  206.    else
  207.       if Winner = Dealer then
  208.          if Blackjack then
  209.             lGameResult.Caption :=  '$Blackjack$' + #13#10 + 'Победил дилер' +
  210.                #13#10 + '-' + lBet.Caption + '$'
  211.          else
  212.             lGameResult.Caption := 'Победил дилер' +
  213.                #13#10 + '-' + lBet.Caption + '$'
  214.       else
  215.          lGameResult.Caption := 'Ничья'            
  216. end;
  217.  
  218. procedure TFormGame.btSetBetClick(Sender: TObject);
  219. begin
  220.    if StrToInt(lBet.Caption) >= MinBet then
  221.    begin
  222.       DrawDeck;
  223.       LastBet := StrToInt(lBet.Caption);
  224.       ArrPlayerHand[1] := GetCard;
  225.       ArrDealerHand[1] := GetCard;
  226.       ArrPlayerHand[2] := GetCard;
  227.       ArrDealerHand[2] := GetCard;
  228.       DrawHand(pbPlayerHand, ArrPlayerHand);
  229.       PrintScore(ArrPlayerHand, PlayerScore);
  230.       PrintScore(ArrDealerHand, DealerScore);
  231.       DrawHand(pbDealerHand, ArrDealerHand);
  232.       ShowGameInterface(True);
  233.    end
  234.    else
  235.       MessageBox(Handle, PChar('Минимальная ставка ' + IntToStr(MinBet) + '$'), PChar(''), MB_ICONINFORMATION + MB_OK);
  236. end;
  237.  
  238. procedure TFormGame.btSplitClick(Sender: TObject);
  239. begin
  240.    MessageBox(Handle, 'На стадии разработки!', 'Не доступно', MB_ICONSTOP + MB_OK);
  241. end;
  242.  
  243. procedure TFormGame.btHitClick(Sender: TObject);
  244. var
  245.    Index : Integer;
  246. begin
  247.    btDoubleBet.Visible := False;
  248.    Index := 3;
  249.    while ArrPlayerHand[Index] <> 0 do
  250.       Inc(Index);
  251.    ArrPlayerHand[Index] := GetCard;
  252.    DrawHand(pbPlayerHand, ArrPlayerHand);
  253.    PrintScore(ArrPlayerHand, PlayerScore);
  254.    if GetScore(ArrPlayerHand) = 21 then
  255.       DealerGame;
  256.    if CheckBust(ArrPlayerHand, Player) then
  257.       CheckGameResult;
  258. end;
  259.  
  260. procedure TFormGame.btDoubleBetClick(Sender: TObject);
  261. begin
  262.    ArrPlayerHand[3] := GetCard;
  263.    DrawHand(pbPlayerHand, ArrPlayerHand);
  264.    PrintScore(ArrPlayerHand, PlayerScore);
  265.    if CheckBust(ArrPlayerHand, Player) then
  266.       CheckGameResult
  267.    else
  268.       btStandClick(Sender);
  269. end;
  270.  
  271. procedure TFormGame.btStandClick(Sender: TObject);
  272. begin
  273.    ShowGameInterface(False);
  274.    DealerGame;
  275. end;
  276.  
  277. procedure TFormGame.btFoldClick(Sender: TObject);
  278. const
  279.    MessageFold = 'Вы уверены, что хотите сдаться?' + #13#10 +
  280.       'Вам вернется лишь 50% от вашей ставки.';
  281. var
  282.    CurPlayer: PPlayer;
  283. begin
  284.    if MessageBox(Handle, MessageFold, '', MB_ICONINFORMATION + MB_YESNO) = mrYes then
  285.    begin
  286.       ShowGameInterface(False);
  287.       lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) +
  288.          StrToInt(lBet.Caption) div 2);
  289.       if FindPlayer(FirstPl, PlayerName, CurPlayer) then
  290.          CurPlayer^.DataPl.Balance := lBalance.Caption;
  291.       lBet.Caption := '0';
  292.       TimerNewGame.Enabled := True;
  293.    end;
  294. end;
  295.  
  296. procedure TFormGame.TimerNewGameTimer(Sender: TObject);
  297. const
  298.    MessageBankrot = 'На вышем счету недостаточно денег для продолжения игры.' +
  299.       #13#10 + 'Вы будете перенапрвлены в главное меню!';
  300. begin
  301.    ClearHands;
  302.    btSetBet.Visible := True;
  303.    btRepeatBet.Visible := True;
  304.    btResetBet.Visible := True;
  305.    gbForBet.Visible := True;
  306.    PlayerScore.Caption := '';
  307.    DealerScore.Caption := '';
  308.    FreeAndNil(lGameResult);
  309.    TimerNewGame.Enabled := False;
  310.    if (StrToInt(lBalance.Caption) < MinBet) then
  311.    begin
  312.       if MessageBox(Handle, MessageBankrot, 'Вы банкрот!', MB_ICONINFORMATION + MB_OK) = mrOk then
  313.          ItemBackToMenu.Click;
  314.    end;
  315. end;
  316.  
  317. procedure TFormGame.CheckGameResult;
  318. const
  319.    BlackJack: Boolean = True;
  320. var
  321.    CurPlayer: PPlayer;
  322. begin
  323.    if (GetScore(ArrDealerHand) > 21) then
  324.    begin
  325.       ShowResult(Player, not Blackjack);
  326.       ShowGameInterface(False);
  327.       lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) + StrToInt(lBet.Caption) * 2);
  328.       if FindPlayer(FirstPl, PlayerName, CurPlayer) then
  329.       begin
  330.          CurPlayer^.DataPl.Balance := lBalance.Caption;
  331.          if CurPlayer^.DataPl.Balance > CurPlayer^.DataPl.MaxBalance then
  332.          begin
  333.             CurPlayer^.DataPl.MaxBalance := CurPlayer^.DataPl.Balance;
  334.             RatingSort(FirstPl, LastPl);
  335.          end;
  336.       end;
  337.       lBet.Caption := '0';
  338.       TimerNewGame.Enabled := True;
  339.    end
  340.    else
  341.    begin
  342.       if (GetScore(ArrPlayerHand) > 21) then
  343.       begin
  344.          ShowResult(Dealer, not Blackjack);
  345.          DealerScore.Caption := IntToStr(GetScore(ArrDealerHand));
  346.          ShowGameInterface(False);
  347.          lBet.Caption := '0';
  348.          TimerNewGame.Enabled := True;
  349.       end
  350.       else
  351.       begin
  352.          if (GetScore(ArrPlayerHand) > GetScore(ArrDealerHand)) then
  353.          begin
  354.             ShowResult(Player, not Blackjack);
  355.             ShowGameInterface(False);
  356.             lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) + StrToInt(lBet.Caption) * 2);
  357.             if FindPlayer(FirstPl, PlayerName, CurPlayer) then
  358.             begin
  359.                CurPlayer^.DataPl.Balance := lBalance.Caption;
  360.                if CurPlayer^.DataPl.Balance > CurPlayer^.DataPl.MaxBalance then
  361.                begin
  362.                   CurPlayer^.DataPl.MaxBalance := CurPlayer^.DataPl.Balance;
  363.                   RatingSort(FirstPl, LastPl);
  364.                end;
  365.             end;
  366.             lBet.Caption := '0';
  367.             TimerNewGame.Enabled := True;
  368.          end;
  369.          if (GetScore(ArrDealerHand) > GetScore(ArrPlayerHand)) then
  370.          begin
  371.             ShowResult(Dealer, not Blackjack);
  372.             ShowGameInterface(False);
  373.             lBet.Caption := '0';
  374.             TimerNewGame.Enabled := True;
  375.          end;
  376.          if GetScore(ArrPlayerHand) = GetScore(ArrDealerHand) then
  377.          begin
  378.             ShowResult(Nobody, not BlackJack);
  379.             ShowGameInterface(False);
  380.             lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) + StrToInt(lBet.Caption));
  381.             lBet.Caption := '0';
  382.             TimerNewGame.Enabled := True;
  383.          end;
  384.       end;  
  385.    end;
  386. end;
  387.  
  388. procedure TFormGame.DealerGame;
  389. const
  390.    CardWidth = 80;
  391.    CardHeght = 100;
  392.    Border = 15;
  393.    StartPositionY = 0;
  394. var
  395.    Index, StartPositionX : Integer;
  396. begin
  397.    Index := 2;
  398.    DealerScore.Caption:= IntToStr(GetScore(ArrDealerHand));
  399.    while StrToInt(DealerScore.Caption) < 17 do
  400.    begin
  401.       Inc(Index);
  402.       ArrDealerHand[Index] := GetCard;
  403.       DrawHand(pbDealerHand, ArrDealerHand);
  404.       PrintScore(ArrDealerHand, DealerScore);
  405.    end;
  406.    if Index = 2 then
  407.    begin
  408.       StartPositionX := (pbDealerHand.Width - Index * (CardWidth + 2 * Border - Index * 10)) div 2;
  409.       cdtDrawExt(pbDealerHand.Canvas.Handle, StartPositionX + (CardWidth + 2 * Border - Index * 10),
  410.          StartPositionY, CardWidth,  CardHeght, ArrDealerHand[Index], 0, clWhite)
  411.    end;
  412.    CheckGameResult;
  413. end;
  414.  
  415. procedure TFormGame.btRepeatBetClick(Sender: TObject);
  416. const
  417.    MsgNoLastBet = 'Еще не было ставок в данном сеансе.' + #13#10 + 'Сделайте ставку вручную!';
  418.    MsgSmallBalance = 'Текущий баланс не позволяет поставить ставку такого размера!';
  419. begin
  420.    if LastBet <> 0 then
  421.    begin
  422.       if StrToInt(lBalance.Caption) > LastBet then
  423.          if StrToInt(lBet.Caption) = 0 then
  424.          begin
  425.             lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) - LastBet);
  426.             lBet.Caption := IntToStr(LastBet);
  427.          end
  428.          else
  429.          begin
  430.             btResetBet.Click;
  431.             lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) - LastBet);
  432.             lBet.Caption := IntToStr(LastBet);
  433.          end
  434.       else
  435.          MessageBox(Handle, MsgSmallBalance, 'Внимание!', MB_ICONINFORMATION + MB_OK);
  436.    end
  437.    else
  438.       MessageBox(Handle, MsgNoLastBet, 'Внимание', MB_ICONINFORMATION + MB_OK);
  439. end;
  440.  
  441. procedure TFormGame.btResetBetClick(Sender: TObject);
  442. begin
  443.    lBalance.Caption := IntToStr(StrToint(lBalance.Caption) + StrToInt(lBet.Caption));
  444.    lBet.Caption := '0';
  445. end;
  446.  
  447. function TFormGame.CheckBust(var SomeBodyHand: TArrayHand; Person: TPerson): Boolean;
  448. var
  449.    IsBust : Boolean;
  450. begin
  451.    if GetScore(SomeBodyHand) > 21 then
  452.       IsBust := True
  453.    else
  454.       IsBust := False;  
  455.    CheckBust := IsBust;
  456. end;
  457.  
  458. procedure TFormGame.FormClose(Sender: TObject; var Action: TCloseAction);
  459. begin
  460.    Action := TCloseAction.caNone;
  461.    ItemBackToMenu.Click;
  462. end;
  463.  
  464. procedure TFormGame.FormCreate(Sender: TObject);
  465. begin
  466.    cdtInit(Wdth,Hght); // Инициализируем DLL
  467. end;
  468.  
  469. procedure TFormGame.FormDestroy(Sender: TObject);
  470. begin
  471.    cdtTerm; // Освобождаем ресурсы
  472. end;
  473.  
  474. procedure TFormGame.FormPaint(Sender: TObject);
  475. var
  476.    Fon: TBitMap;
  477. begin
  478.    Fon := TBitmap.Create;
  479.    Fon.LoadFromFile('../../Картинки/FonGame.bmp');
  480.    FormGame.Canvas.Draw(0, 0, Fon);
  481.    Fon.Free;
  482.    DrawDeck;
  483. end;
  484.  
  485. procedure TFormGame.FormShow(Sender: TObject);
  486. begin
  487.    DrawDeck;
  488.    gbBalanceAndBet.Visible := True;
  489.    ShowGameInterface(False);
  490.  
  491.    lBalance.Caption := Balance;
  492.    lBet.Caption := '0';
  493.    LastBet := 0;
  494.    PlayerScore.Caption := '';
  495.    DealerScore.Caption := '';
  496.  
  497.    gbForBet.Visible := True;
  498.    btSetBet.Visible := True;
  499.    btResetBet.Visible := True;
  500.    btRepeatBet.Visible := True;
  501. end;
  502.  
  503. function TFormGame.GetCard: Integer;
  504. var
  505.    CardValue : Integer;
  506.    IsUsed, IsFind : Boolean;
  507.    I: Integer;
  508. begin
  509.    IsFind := False;
  510.    while not IsFind do
  511.    begin
  512.       CardValue := Random(51);
  513.       IsUsed := False;
  514.       for I := 1 to Length(ArrPlayerHand) do
  515.       begin
  516.          if (ArrPlayerHand[i] = CardValue) or (ArrDealerHand[i] = CardValue) then
  517.             IsUsed := True;
  518.       end;
  519.       IsFind := not IsUsed;
  520.    end;
  521.    GetCard := CardValue;
  522. end;
  523.  
  524. function TFormGame.GetCardValue(Number: Integer): Integer;
  525. var
  526.    Value : Integer;
  527. begin
  528.    Number := Number div 4;
  529.    case Number of
  530.       0:
  531.          Value := 11;
  532.  
  533.       1..9:
  534.          Value := Number + 1;
  535.  
  536.       10..12:
  537.          Value := 10;
  538.    end;
  539.    Result := Value;
  540. end;
  541.  
  542. function TFormGame.GetScore(const SomebodyHand: TArrayHand): Integer;
  543. var
  544.    Score, i, Count, AceAsElevenCount : Integer;
  545. begin
  546.    Count := 0;
  547.    Score := 0;
  548.    for i := 1 to 10 do
  549.       if SomebodyHand[i] <> 0 then
  550.          Inc(Count);
  551.    AceAsElevenCount := 0;
  552.    for i := 1 to Count do
  553.    begin
  554.       if GetCardValue(SomebodyHand[i]) = 11 then
  555.       begin
  556.          if (Score + 11) <= 21 then
  557.          begin
  558.             Inc(AceAsElevenCount);
  559.             Score := Score + 11;
  560.          end
  561.          else
  562.             Score := Score + 1;
  563.       end
  564.       else
  565.       begin
  566.          if (Score + GetCardValue(SomebodyHand[i])) > 21 then
  567.          begin
  568.             Score := Score + GetCardValue(SomebodyHand[i]);
  569.             while (Score > 21) and (AceAsElevenCount > 0) do
  570.             begin
  571.                Score := Score - 10;
  572.                Dec(AceAsElevenCount);
  573.             end;
  574.          end
  575.          else
  576.             Score := Score + GetCardValue(SomebodyHand[i]);
  577.       end;
  578.    end;
  579.    Result := Score;
  580. end;
  581.  
  582. procedure TFormGame.ItefGameHelpClick(Sender: TObject);
  583. begin
  584.    FormGameHelp.Show;
  585. end;
  586.  
  587. procedure TFormGame.ItemBackToMenuClick(Sender: TObject);
  588. const
  589.    UnfinishedGame = 'Партия еще не закончилась!' + #13#10
  590.          + 'Если нажмете "Да" - вернется 50% от вашей ставки.' + #13#10
  591.             + 'Нажмете "Нет" - партия будет продолжена';
  592. var
  593.    CurPlayer: PPlayer;
  594. begin
  595.    if lBet.Caption <> '0' then
  596.    begin
  597.       if btSetBet.Visible then
  598.       begin
  599.          btResetBet.Click;
  600.          Balance := lBalance.Caption;
  601.          if FindPlayer(FirstPl, PlayerName, CurPlayer) then
  602.          begin
  603.             CurPlayer^.DataPl.Balance := Balance;
  604.             if StrToInt(CurPlayer^.DataPl.MaxBalance) < StrToInt(Balance) then
  605.             begin
  606.                CurPlayer^.DataPl.MaxBalance := Balance;
  607.                RatingSort(FirstPl, LastPl);
  608.             end;
  609.          end;
  610.          ClearHands;
  611.          FormGame.Hide;
  612.          FormMainMenu.Show;
  613.       end
  614.       else
  615.       begin
  616.          if MessageBox(Handle, UnfinishedGame, 'Выйти в главное меню?', MB_ICONSTOP + MB_YESNO) = mrYes then
  617.          begin
  618.             lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) + StrToInt(lBet.Caption) div 2);
  619.             Balance := lBalance.Caption;
  620.             if FindPlayer(FirstPl, PlayerName, CurPlayer) then
  621.             begin
  622.                CurPlayer^.DataPl.Balance := Balance;
  623.                if StrToInt(CurPlayer^.DataPl.MaxBalance) < StrToInt(Balance) then
  624.                begin
  625.                   CurPlayer^.DataPl.MaxBalance := Balance;
  626.                   RatingSort(FirstPl, LastPl);
  627.                end;
  628.             end;
  629.             ClearHands;
  630.             FormGame.Hide;
  631.             FormMainMenu.Show;
  632.          end;
  633.       end;
  634.    end
  635.    else
  636.    begin
  637.       Balance := lBalance.Caption;
  638.       if FindPlayer(FirstPl, PlayerName, CurPlayer) then
  639.       begin
  640.          CurPlayer^.DataPl.Balance := Balance;
  641.          if StrToInt(CurPlayer^.DataPl.MaxBalance) < StrToInt(Balance) then
  642.          begin
  643.             CurPlayer^.DataPl.MaxBalance := Balance;
  644.             RatingSort(FirstPl, LastPl);
  645.          end;
  646.       end;
  647.       FormGame.Hide;
  648.       FormMainMenu.Show;
  649.    end;
  650. end;
  651.  
  652. procedure TFormGame.pbDealerHandPaint(Sender: TObject);
  653. begin
  654.    DrawHand(pbDealerHand, ArrDealerHand);
  655. end;
  656.  
  657. procedure TFormGame.pbPlayerHandPaint(Sender: TObject);
  658. begin
  659.    DrawHand(pbPlayerHand, ArrPlayerHand);
  660. end;
  661.  
  662. procedure TFormGame.PrintScore(const SomebodyHand: TArrayHand; var PersonScore: TLabel);
  663. var
  664.    i, Count : Integer;
  665. begin
  666.    if PersonScore = DealerScore then
  667.    begin
  668.       Count := 0;
  669.       for i := 1 to 10 do
  670.          if SomebodyHand[i] <> 0 then
  671.             Inc(Count);
  672.       if Count = 2 then
  673.          PersonScore.Caption := '?'
  674.       else
  675.          PersonScore.Caption := IntToStr(GetScore(SomebodyHand));
  676.    end
  677.    else
  678.    begin                                                      
  679.       PersonScore.Caption := IntToStr(GetScore(SomebodyHand));
  680.    end;
  681. end;
  682.  
  683. ////////////////////////////////////////////////////////////////////////////////
  684. {Раздел ставок}
  685. procedure TFormGame.rb1000Click(Sender: TObject);
  686. const
  687.    AddBet = 1000;
  688. begin
  689.    if StrToInt(lBalance.Caption) >= AddBet  then
  690.    begin
  691.       lBet.Caption := IntToStr(StrToInt(lBet.Caption) + AddBet);
  692.       lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) - AddBet);
  693.    end;
  694.    rb1000.Checked := False;
  695. end;
  696.  
  697. procedure TFormGame.rb100Click(Sender: TObject);
  698. const
  699.    AddBet = 100;
  700. begin
  701.    if StrToInt(lBalance.Caption) >= AddBet  then
  702.    begin
  703.       lBet.Caption := IntToStr(StrToInt(lBet.Caption) + AddBet);
  704.       lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) - AddBet);
  705.    end;
  706.    rb100.Checked := False;
  707. end;
  708.  
  709. procedure TFormGame.rb10Click(Sender: TObject);
  710. const
  711.    AddBet = 10;
  712. begin
  713.    if StrToInt(lBalance.Caption) >= AddBet  then
  714.    begin
  715.       lBet.Caption := IntToStr(StrToInt(lBet.Caption) + AddBet);
  716.       lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) - AddBet);
  717.    end;
  718.    rb10.Checked := False;
  719. end;
  720.  
  721. procedure TFormGame.rb1Click(Sender: TObject);
  722. const
  723.    AddBet = 1;
  724. begin
  725.    if StrToInt(lBalance.Caption) >= AddBet  then
  726.    begin
  727.       lBet.Caption := IntToStr(StrToInt(lBet.Caption) + AddBet);
  728.       lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) - AddBet);
  729.    end;
  730.    rb1.Checked := False;
  731. end;
  732.  
  733. procedure TFormGame.rb250Click(Sender: TObject);
  734. const
  735.    AddBet = 250;
  736. begin
  737.    if StrToInt(lBalance.Caption) >= AddBet  then
  738.    begin
  739.       lBet.Caption := IntToStr(StrToInt(lBet.Caption) + AddBet);
  740.       lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) - AddBet);
  741.    end;
  742.    rb250.Checked := False;
  743. end;
  744.  
  745. procedure TFormGame.rb25Click(Sender: TObject);
  746. const
  747.    AddBet = 25;
  748. begin
  749.    if StrToInt(lBalance.Caption) >= AddBet  then
  750.    begin
  751.       lBet.Caption := IntToStr(StrToInt(lBet.Caption) + AddBet);
  752.       lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) - AddBet);
  753.    end;
  754.    rb25.Checked := False;
  755. end;
  756.  
  757. procedure TFormGame.rb500Click(Sender: TObject);
  758. const
  759.    AddBet = 500;
  760. begin
  761.    if StrToInt(lBalance.Caption) >= AddBet  then
  762.    begin
  763.       lBet.Caption := IntToStr(StrToInt(lBet.Caption) + AddBet);
  764.       lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) - AddBet);
  765.    end;
  766.    rb500.Checked := False;
  767. end;
  768.  
  769. procedure TFormGame.rb5Click(Sender: TObject);
  770. const
  771.    AddBet = 5;
  772. begin
  773.    if StrToInt(lBalance.Caption) >= AddBet  then
  774.    begin
  775.       lBet.Caption := IntToStr(StrToInt(lBet.Caption) + AddBet);
  776.       lBalance.Caption := IntToStr(StrToInt(lBalance.Caption) - AddBet);
  777.    end;
  778.    rb5.Checked := False;
  779. end;
  780.  
  781. ////////////////////////////////////////////////////////////////////////////////
  782.  
  783. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!