TuDeck - Card stack

//   Card stack


// u_TDeck.pas

unit u_TDeck;
interface
uses
        Windows, Classes, SysUtils,
        StdCtrls,
        ch_LogMessages,

        u_TList,
        u_TexasHoldConst;

const

        CARD_LIMIT = (13 * 4);    // 撲克牌總數 十三張 * 4種類

        // 牌的位置
        POSITION_POOL = 0; // 在牌堆裡
        POSITION_HOLE = 1; // 玩家手牌
        POSITION_FIELD = 2;// 桌上公牌

        // 牌的類型
        CARD_CATEGORY_SPADE = 0;  // 黑桃
        CARD_CATEGORY_HEARD = 1;  // 紅心
        CARD_CATEGORY_CLUB = 2;  // 梅花
        CARD_CATEGORY_DIAMOND = 3;  // 方塊
        CARD_CATEGORY_LIMIT = 4;  //

type

//******************************************************************************
// 類別名稱：TCardData
// 功　　能：每張牌的結構定義
//******************************************************************************
        TCardData = class        //TCardData 結構的定義
            Category: word;       // 種類                 
            Index: word;          // 數
            ListIndex: word;      // 表格位置
            Position: word;       // 位置
            Player: integer;      // 玩家
        end;

//******************************************************************************
// 類別名稱：TuDeck
// 功　　能：維護牌堆資料 提供 亂數取牌
//******************************************************************************
        TuDeck = Class
          private
            m_aCardDataList: TuList;  // 撲克牌陣列
            m_DeckMessToFiles : TLogMessToFiles;
            function GetRandomCardIndex: integer; // 找一張沒有被派發出來的牌
          public
            constructor Create;
            destructor Destroy; override;

            procedure Init; // 初始化

            
            function GetRandomCard(Player, nPosition: integer): integer;
            function GetIndexCard(nIndex,Player, nPosition:integer):integer;

            function Items( nListIndex:integer ):TCardData;
            function Index( nListIndex:integer ): word;
            function Category( nListIndex:integer ): word;
            function Position( nListIndex:integer ): word;
            function Player( nListIndex:integer ): integer;
        end;
        function compareByPoker(Item1 : Pointer; Item2 : Pointer) : Integer;


implementation


constructor TuDeck.Create;
var
        i: integer;
        TmpCardData: TCardData;
begin
        m_DeckMessToFiles := TLogMessToFiles.Create('DeckMessage.txt');
 
        m_aCardDataList := TuList.Create();
        for i := 0 to CARD_LIMIT - 1 do begin
            TmpCardData := TCardData.Create();
            m_aCardDataList.Add(TmpCardData);
        end;
        
        Init();
end;


destructor TuDeck.Destroy;
begin
        m_aCardDataList.Free;
        m_DeckMessToFiles.Free;
end;


//******************************************************************************
// 函式名稱：Init
// 功　　能：初始化撲克牌陣列 並洗牌(重設亂數種子)
//******************************************************************************
procedure TuDeck.Init();
var

        TmpCategory: integer;
        TmpIndex: integer;
        CardIndex: integer;
        TmpCardData : TCardData;
begin

        // 每一把要重新洗牌 重設亂數種子
        Randomize;

        CardIndex := 0;
        for TmpCategory := 0 to CARD_CATEGORY_LIMIT - 1 do begin
            for TmpIndex := 1 to CARD_INDEX_LIMIT do begin
                TmpCardData := m_aCardDataList.GetItems(CardIndex);
                TmpCardData.Category := TmpCategory;
                TmpCardData.Index := TmpIndex;
                TmpCardData.ListIndex := CardIndex;
                TmpCardData.Position := POSITION_POOL;
                TmpCardData.Player := PLAYER_NIL;
                Inc(CardIndex);
            end;
        end;
end;


//******************************************************************************
// 函式名稱：GetIndexCard
// 功　　能：直接取出 nIndex 指定的牌
//******************************************************************************
function TuDeck.GetIndexCard(nIndex,Player, nPosition:integer):integer;
var
        TmpCardData : TCardData;
begin
        TmpCardData := m_aCardDataList.GetItems(nIndex);
        TmpCardData.Position := nPosition;
        TmpCardData.Player := Player;

        Result := nIndex;
end;


//******************************************************************************
// 函式名稱：GetRandomCard
// 功　　能：亂數取牌
//******************************************************************************
function TuDeck.GetRandomCard(Player, nPosition: integer): integer;
var
        nIndex: integer;
        TmpCardData : TCardData;
begin

        nIndex := GetRandomCardIndex();
        TmpCardData := m_aCardDataList.GetItems(nIndex);
        TmpCardData.Position := nPosition;
        TmpCardData.Player := Player;

        Result := nIndex;
end;


//******************************************************************************
// 函式名稱：GetRandomCardIndex
// 功　　能：隨機取得 CardList 的參數
//******************************************************************************
function TuDeck.GetRandomCardIndex: integer;
var
        TmpIndex, nIndex: integer;


        nTmpNext : Integer;
        nTmpPrev : Integer;
        nRandom2 : Integer;

        TmpCardData : TCardData;
begin


        nIndex := Random(CARD_LIMIT);

        // 如果 還沒發出去就直接發
        TmpCardData := m_aCardDataList.GetItems(nIndex);
        if TmpCardData.Position = POSITION_POOL then
        begin
            Result := nIndex;
            exit;
        end;

        if nIndex = CARD_LIMIT - 1 then begin
            nIndex := 0;
        end;

        (* 順序搜尋 *)
        nTmpNext := -1;
        for TmpIndex := nIndex to CARD_LIMIT - 1 do begin
            TmpCardData := m_aCardDataList.GetItems(TmpIndex);
            if TmpCardData.Position = POSITION_POOL then
            begin
                nTmpNext := TmpIndex;
                break;
            end;
        end;
        
        if nIndex = 0 then begin
            nIndex := CARD_LIMIT - 1;
        end;

        nTmpPrev := -1;
        for TmpIndex := nIndex downto 0 do begin
            TmpCardData := m_aCardDataList.GetItems(TmpIndex);
            if TmpCardData.Position = POSITION_POOL then begin
                nTmpPrev := TmpIndex;
                break;
            end;
        end;

        // 當所有牌都發完時 才會兩個都是負的
        // 如果發到都沒有牌 代表程式有問題
        if (nTmpNext = -1) And (nTmpPrev = -1) then begin
            m_DeckMessToFiles.m_WriteTXTOne(
            Format ('nIndex %d nTmpNext %d nTmpPrev %d ',[nIndex, nTmpNext, nTmpPrev]), 1);
        end;

        if nTmpNext = -1 then begin
            Result := nTmpPrev;
            exit;
        end;

        if nTmpPrev = -1 then begin
            Result := nTmpNext;
            exit;
        end;


        nRandom2 := Random(CARD_LIMIT) mod 2;
        if nRandom2 = 1 then begin
            Result := nTmpNext;
        end else begin
            Result := nTmpPrev;
        end;

end;

function TuDeck.Index( nListIndex:integer ): word;
begin
        Result := TCardData(m_aCardDataList.GetItems(nListIndex)).Index;
end;

function TuDeck.Category( nListIndex:integer ): word;
begin
       Result := TCardData(m_aCardDataList.GetItems(nListIndex)).Category;
end;

function TuDeck.Player( nListIndex:integer ): integer;
begin
       Result := TCardData(m_aCardDataList.GetItems(nListIndex)).Player;
end;

function TuDeck.Position( nListIndex:integer ): word;
begin
       Result := TCardData(m_aCardDataList.GetItems(nListIndex)).Position;
end;

function TuDeck.Items( nListIndex:integer ): TCardData;
begin
        Result := m_aCardDataList.GetItems(nListIndex);
end;

end.

function compareByPoker(Item1 : Pointer; Item2 : Pointer) : Integer;
var
        CardData1, CardData2: TCardData;
begin
        CardData1 := Item1;
        CardData2 := Item2;

        if CardData1.Index > CardData2.Index then
            Result := 1
        else if CardData1.Index = CardData2.Index then
            Result := 0
        else
            Result := -1;

end;

compare是給TList使用的



牌堆取牌器(52張牌)

用在發牌, 發麻將, 都還不錯.

當然啦,除非要用, 不然在小弟的強大墮性的驅使下, 不會花時間做任何的多型!