main.pas

《Delphi开发人员指南》配书原码

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, AxCard_TLB, Cards, PlayCard, StdCtrls, ExtCtrls, Menus;

type
  TMainForm = class(TForm)
    Panel1: TPanel;
    MainMenu1: TMainMenu;
    Play1: TMenuItem;
    Deal1: TMenuItem;
    Hit1: TMenuItem;
    Hold1: TMenuItem;
    DoubleDown1: TMenuItem;
    N1: TMenuItem;
    Close1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    Panel2: TPanel;
    Label3: TLabel;
    CashLabel: TLabel;
    BetLabel: TLabel;
    HitBtn: TButton;
    DealBtn: TButton;
    HoldBtn: TButton;
    ExitBtn: TButton;
    BetEdit: TEdit;
    DblBtn: TButton;
    CheatPanel: TPanel;
    DealLbl: TLabel;
    PlayLbl: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    Cheat1: TMenuItem;
    N2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Cheat1Click(Sender: TObject);
    procedure ExitBtnClick(Sender: TObject);
    procedure DblBtnClick(Sender: TObject);
    procedure DealBtnClick(Sender: TObject);
    procedure HitBtnClick(Sender: TObject);
    procedure HoldBtnClick(Sender: TObject);
  private
    CardDeck: TCardDeck;
    CurCard: TPlayingCard;
    NextPlayerPos: integer;
    NextDealerPos: integer;
    PlayerTotal: integer;
    DealerTotal: integer;
    PAceFlag: Boolean;
    DAceFlag: Boolean;
    PBJFlag: Boolean;
    DBJFlag: Boolean;
    DDFlag: Boolean;
    Procedure Deal;
    procedure DealerHit(CardVisible: Boolean);
    procedure DoubleDown;
    procedure EnableMoves(Enable: Boolean);
    procedure FreeCards;
    procedure Hit;
    procedure Hold;
    procedure ShowFirstCard;
    procedure ShowWinner;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

uses AboutU;

const
  PYPos = 175;        // starting y pos for player cards
  DYPos = 10;         // ditto for dealer's cards

procedure TMainForm.FormCreate(Sender: TObject);
begin
  CardDeck := TCardDeck.Create;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  CardDeck.Free;
end;

procedure TMainForm.About1Click(Sender: TObject);
{ Creates and invokes about box }
begin
  with TAboutBox.Create(Self) do
    try
      ShowModal;
    finally
      Free;
    end;
end;

procedure TMainForm.Cheat1Click(Sender: TObject);
begin
  Cheat1.Checked := not Cheat1.Checked;
  CheatPanel.Visible := Cheat1.Checked;
end;

procedure TMainForm.ExitBtnClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.DblBtnClick(Sender: TObject);
begin
  DoubleDown;
end;

procedure TMainForm.DealBtnClick(Sender: TObject);
begin
  Deal;
end;

procedure TMainForm.HitBtnClick(Sender: TObject);
begin
  Hit;
end;

procedure TMainForm.HoldBtnClick(Sender: TObject);
begin
  Hold;
end;

procedure TMainForm.Deal;
{ Deals a new hand for dealer and player }
begin
  FreeCards;                        // remove any cards from screen
  BetEdit.Enabled := False;         // disable bet edit ctrl
  BetLabel.Enabled := False;        // disable bet label
  if CardDeck.Count < 11 then       // reshuffle deck if < 11 cards
  begin
    Panel1.Caption := 'Reshuffling and dealing...';
    CardDeck.Shuffle;
  end
  else
    Panel1.Caption := 'Dealing...';
  Panel1.Show;                      // show "dealing" panel
  Panel1.Update;                    // make sure it's visible
  NextPlayerPos := 10;              // set horiz position of cards
  NextDealerPos := 10;
  PlayerTotal := 0;                 // reset card totals
  DealerTotal := 0;
  PAceFlag := False;                // reset flags
  DAceFlag := False;
  PBJFlag := False;
  DBJFlag := False;
  DDFlag := False;
  Hit;                              // hit player
  DealerHit(False);                 // hit dealer
  Hit;                              // hit player
  DealerHit(True);                  // hit dealer
  Panel1.Hide;                      // hide panel
  if (PlayerTotal = 11) and PAceFlag then
    PBJFlag := True;                // check player blackjack
  if (DealerTotal = 11) and DAceFlag then
    DBJFlag := True;                // check dealer blackjack
  if PBJFlag or DBJFlag then        // if a blackjack occurred
  begin
    ShowFirstCard;                  // flip dealer's card
    ShowMessage('Blackjack!');
    ShowWinner;                     // determine winner
  end
  else
    EnableMoves(True);              // enable hit, hold double down
end;

procedure TMainForm.DealerHit(CardVisible: Boolean);
{ Dealer takes a hit }
begin
  CurCard := CardDeck.Draw;           // dealer draws a card
  with TCardX.Create(Self) do         // create the ActiveX control
  begin
    Left := NextDealerPos;            // place card on form
    Top := DYPos;
    Suit := Ord(CurCard.Suit);        // assign suit
    FaceUp := CardVisible;
    Value := Ord(CurCard.Face);       // assign face
    Parent := Self;                   // assign parent for AX Ctl
    Inc(NextDealerPos, Width div 2);  // track where to place next card
    Update;                           // show card
  end;
  if CurCard.Face = cvAce then DAceFlag := True;   // set Ace flag
  Inc(DealerTotal, GetCardValue(CurCard));         // keep count
  DealLbl.Caption := IntToStr(DealerTotal);        // cheat
  if DealerTotal > 21 then                         // track dealer bust
    ShowMessage('Dealer Busted!');
end;

procedure TMainForm.DoubleDown;
{ Called to double down on dealt hand }
begin
  DDFlag := True;                // set double down flag to adjust bet
  Hit;                           // take one card
  Hold;                          // let dealer take his cards
end;

procedure TMainForm.EnableMoves(Enable: Boolean);
{ Enables/disables moves buttons/menu items }
begin
  HitBtn.Enabled := Enable;              // Hit button
  HoldBtn.Enabled := Enable;             // Hold button
  DblBtn.Enabled := Enable;              // Double down button
  Hit1.Enabled := Enable;                // Hit menu item
  Hold1.Enabled := Enable;               // Hold menu item
  DoubleDown1.Enabled := Enable;         // Double down menu item
end;

procedure TMainForm.FreeCards;
{ frees all AX Ctl cards on the screen }
var
  i: integer;
begin
  for i := ControlCount - 1 downto 0 do  // go backward!
    if Controls[i] is TCardX then
      Controls[i].Free;
end;

procedure TMainForm.Hit;
{ Player hit }
begin
  CurCard := CardDeck.Draw;          // draw card
  with TCardX.Create(Self) do        // create card AX Ctl
  begin
    Left := NextPlayerPos;           // set position
    Top := PYPos;
    Suit := Ord(CurCard.Suit);       // set suit
    Value := Ord(CurCard.Face);      // set value
    Parent := Self;                  // assign parent
    Inc(NextPlayerPos, Width div 2); // track position
    Update;                          // Display card
  end;
  DblBtn.Enabled := False;               // hit disables double down
  if CurCard.Face = cvAce then PAceFlag := True;  // set ace flag
  Inc(PlayerTotal, GetCardValue(CurCard));        // keep running total
  PlayLbl.Caption := IntToStr(PlayerTotal);       // cheat
  if PlayerTotal > 21 then                        // track bust
  begin
    ShowMessage('Busted!');
    ShowFirstCard;
    ShowWinner;
  end;
end;

procedure TMainForm.Hold;
{ Player holds. This procedure allows dealer to draw cards. }
begin
  EnableMoves(False);
  ShowFirstCard;                  // show dealer card
  if PlayerTotal <= 21 then       // if player hasn't busted...
  begin
    if DAceFlag then              // if dealer has an Ace...
    begin
      { Dealer must hit soft 17 }
      while (DealerTotal <= 7) or ((DealerTotal >= 11) and (DealerTotal < 17)) do
        DealerHit(True);
    end
    else
      // if no Ace, keep hitting until 17 is reached
      while DealerTotal < 17 do DealerHit(True);
  end;
  ShowWinner;                     // Determine winner
end;

procedure TMainForm.ShowFirstCard;
var
  i: integer;
begin
  // make sure all cards are face-up
  for i := 0 to ControlCount - 1 do
    if Controls[i] is TCardX then
    begin
      TCardX(Controls[i]).FaceUp := True;
      TCardX(Controls[i]).Update;
    end;
end;

procedure TMainForm.ShowWinner;
{ Determines winning hand }
var
  S: string;
begin
  if DAceFlag then                      // if dealer has an Ace...
  begin
    if DealerTotal + 10 <= 21 then      // figure best hand
      inc(DealerTotal, 10);
  end;
  if PACeFlag then                     // if player has an Ace...
  begin
    if PlayerTotal + 10 <= 21 then     // figure best hand
      inc(PlayerTotal, 10);
  end;
  if DealerTotal > 21 then             // set score to 0 if busted
    DealerTotal := 0;
  if PlayerTotal > 21 then
    PlayerTotal := 0;
  if PlayerTotal > DealerTotal then    // if player wins...
  begin
    S := 'You win!';
    if DDFlag then                     // pay 2:1 on double down
      CashLabel.Caption := IntToStr(StrToInt(CashLabel.Caption) +
        StrToInt(BetEdit.Text) * 2)
    else                               // pay 1:1 normally
      CashLabel.Caption := IntToStr(StrToInt(CashLabel.Caption) +
        StrToInt(BetEdit.Text));
    if PBJFlag then                    // pay 1.5:1 on blackjack
      CashLabel.Caption := IntToStr(StrToInt(CashLabel.Caption) +
        StrToInt(BetEdit.Text) div 2)
  end
  else if DealerTotal > PlayerTotal then    // if dealer wins...
  begin
    S := 'Dealer wins!';
    if DDFlag then                     // lose 2x on double down
      CashLabel.Caption := IntToStr(StrToInt(CashLabel.Caption) -
        StrToInt(BetEdit.Text) * 2)
    else                               // normal loss
      CashLabel.Caption := IntToStr(StrToInt(CashLabel.Caption) -
        StrToInt(BetEdit.Text));
  end
  else
    S := 'Push!';                      // push, no one wins
  if MessageDlg(S + #13#10'Do you want to play again with the same bet?',
    mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    Deal;
  BetEdit.Enabled := True;             // allow bet to change
  BetLabel.Enabled := True;
end;

end.