⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frminsert_p.pas

📁 斗地主源代码.Delphi编写.....
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit frmInsert_P;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, StrUtils,
  ShellAPI;

type
  TPokeState = (PokeFace, PokeInverse, PokeNone);
  TGameState = (GameStop, GameBegin, GameRunning);
  TPokeMarks = (King, Spades, Hearts, Clubs, Diamonds);

  TfrmInsertType = class(TForm)
    imgBG: TImage;
    shp1: TShape;
    shp2: TShape;
    imgLogo: TImage;
    tmrWatchCard: TTimer;
    img1: TImage;
    img2: TImage;
    img3: TImage;
    imgBtnQuit: TImage;
    tmrWatchState: TTimer;
    imgBackGround: TImage;
    lblMyName: TLabel;
    lblMessage: TLabel;
    lbl1: TLabel;
    lbl2: TLabel;
    lbl3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure tmrWatchCardTimer(Sender: TObject);
    procedure imgBtnQuitClick(Sender: TObject);
    procedure tmrWatchStateTimer(Sender: TObject);
    procedure lblMyNameClick(Sender: TObject);
  private
    { Private declarations }
    procedure DrawOnePoke(PokeIndex: Integer; PokeState: TPokeState; PosX: Integer; PosY: Integer);
    procedure CheckSelfAllCard;
    function CheckSideCardOut(SideDSAddres, OutCount: Cardinal): TStringList;
    procedure SideHistory(var HistoryCardList: TStringList; CurCardList: TStringList);
    procedure DrawLeaveCardAndBomb;
    procedure DrawSideCardHistory;
    function CheckPokeType(PokeData: string): TPokeMarks;
    function CheckPokeSymbol(PokeData: string): Byte;
  public
    { Public declarations }
  end;

var
  frmInsertType: TfrmInsertType;

  GameState: TGameState;

  AllOtherCardHistory, LeftCardHistory, RightCardHistory: TStringList;
  PrevAllOtherHistory, PrevLeftSideHistory, PrevRightSideHistory: string;
  LeftSideCardCount, RightSideCardCount: Integer;
  PokeLeave, PokeOutLeft, PokeOutRight, PokeOutSelf: Cardinal;

implementation

uses
  Main, DataTrack;

{$R *.dfm}



procedure TfrmInsertType.FormCreate(Sender: TObject);
var
  rt: TRect;
begin
  imgBackGround.Canvas.Brush.Bitmap := TBitmap.Create;
  imgBackGround.Canvas.Brush.Bitmap.Width := imgBG.Width;
  imgBackGround.Canvas.Brush.Bitmap.Height := imgBG.Height;
  rt := Rect(0, 0, imgBG.Width, imgBG.Height);
  imgBackGround.Canvas.Brush.Bitmap.Canvas.CopyRect(rt, imgBG.Canvas, rt);

  GameState := GameStop;

  PokeLeave := 0;
  PokeOutLeft := 0;
  PokeOutRight := 0;
  PokeOutSelf := 0;

  AllOtherCardHistory := TStringList.Create;
  LeftCardHistory := TStringList.Create;
  RightCardHistory := TStringList.Create;
end;


{-------------------------------------------------------------------------------
  过程名:    TfrmInsertType.DrawOnePoke
  说明:      绘制一张扑克
  作者:      who&who
  日期:      2005.03.11
  参数:      PokeIndex: Integer; PokeState: TPokeState; PosX: Integer; PosY: Integer
  返回值:    无
-------------------------------------------------------------------------------}
procedure TfrmInsertType.DrawOnePoke(PokeIndex: Integer; PokeState: TPokeState; PosX: Integer; PosY: Integer);
var
  rtDest, rtSource: TRect;
begin
  if PokeState = PokeInverse then
    PokeIndex := 54
  else if PokeState = PokeNone then
    PokeIndex := 55;

  rtDest := Rect(PosX, PosY, PosX + MyPokeWidth, PosY + MyPokeHeight);
  rtSource := Rect(PokeIndex * MyPokeWidth, 0, PokeIndex * MyPokeWidth + MyPokeWidth, MyPokeHeight);
  case Screen.Width of
    1024..1399:
      imgBackGround.Canvas.CopyRect(rtDest, frmMain.imgPokeBmp1024.Canvas, rtSource);
    1400..2048:
      imgBackGround.Canvas.CopyRect(rtDest, frmMain.imgPokeBmp1400.Canvas, rtSource);
  end;
end;


{-------------------------------------------------------------------------------
  过程名:    TfrmInsertType.CheckSelfAllCard
  说明:      检查自己手中的牌面,从而得知其他人手中所有的牌面。
  作者:      who&who
  日期:      2005.03.11
  参数:      无
  返回值:    无
-------------------------------------------------------------------------------}
procedure TfrmInsertType.CheckSelfAllCard;
var
  TmpStringList: TStringList;
  I, TempIndex: Integer;
  TmpCount: Cardinal;
begin
  if not GetDataFromRam(AdrSelfCount, TmpCount) then
    Close;

  TmpStringList := GetPokeListFromRam(AdrSelfPoke, TmpCount);
  for I := 0 to TmpStringList.Count - 1 do
  begin
    TempIndex := AllOtherCardHistory.IndexOf(TmpStringList[I]);
    if TempIndex >= 0 then
      AllOtherCardHistory.Delete(TempIndex);
  end;
  DrawLeaveCardAndBomb;
end;


{-------------------------------------------------------------------------------
  过程名:    TfrmInsertType.CheckSideCardOut
  说明:      检查某一方出牌牌面。
  作者:      who&who
  日期:      2005.03.11
  参数:      SideDSAddres, OutCount: Cardinal
  返回值:    TStringList
-------------------------------------------------------------------------------}
function TfrmInsertType.CheckSideCardOut(SideDSAddres, OutCount: Cardinal): TStringList;
var
  I, TempIndex: Integer;
begin
  Result := GetPokeListFromRam(SideDSAddres, OutCount);
  //将打出的牌从剩余牌队列中去除
  for I := 0 to Result.Count - 1 do
  begin
    TempIndex := AllOtherCardHistory.IndexOf(Result[I]);
    if TempIndex >= 0 then
      AllOtherCardHistory.Delete(TempIndex);
  end;
end;


{-------------------------------------------------------------------------------
  过程名:    TfrmInsertType.SideHistory
  说明:      将某一方出牌情况添加到该方历史纪录。
  作者:      who&who
  日期:      2005.03.11
  参数:      var HistoryCardList: TStringList; CurCardList: TStringList
  返回值:    无
-------------------------------------------------------------------------------}
procedure TfrmInsertType.SideHistory(var HistoryCardList: TStringList; CurCardList: TStringList);
var
  I: Integer;
begin
  for I := 0 to CurCardList.Count - 1 do
    if HistoryCardList.IndexOf(CurCardList[I]) < 0 then
      HistoryCardList.Add(CurCardList[I]);

  HistoryCardList.Sort;
end;


{-------------------------------------------------------------------------------
  过程名:    TfrmInsertType.DrawLeaveCardAndBomb
  说明:      绘制自己手中以外剩余的牌面以及可能的炸弹情况。
  作者:      who&who
  日期:      2005.03.11
  参数:      无
  返回值:    无
-------------------------------------------------------------------------------}
procedure TfrmInsertType.DrawLeaveCardAndBomb;
var
  I: Integer;
  TempPokeSymbol: Byte;
  TempStr: string;
begin
  TempStr := AllOtherCardHistory.CommaText;
  if TempStr <> PrevAllOtherHistory then
  begin
    PrevAllOtherHistory := TempStr;
    for I := 0 to AllOtherCardHistory.Count - 1 do
    begin
      DrawOnePoke(StrToInt(AllOtherCardHistory[I]), PokeFace, ImgLeftExcursion + I * MyPokeWidth, ImgAllOtherPokeTop);
      //如果是方块,则进行炸弹判定
      if (CheckPokeType(AllOtherCardHistory[I]) = Diamonds) and (I >= 3) then
      begin
        //比对前三张牌面,如果相同,则为炸弹。
        TempPokeSymbol := CheckPokeSymbol(AllOtherCardHistory[I]);
        if CheckPokeSymbol(AllOtherCardHistory[I - 1]) = TempPokeSymbol then
          if CheckPokeSymbol(AllOtherCardHistory[I - 2]) = TempPokeSymbol then
            if CheckPokeSymbol(AllOtherCardHistory[I - 3]) = TempPokeSymbol then
            begin
              imgBackGround.Canvas.Pen.Color := clYellow;
              imgBackGround.Canvas.PenPos := Point(ImgLeftExcursion + (I - 3) * MyPokeWidth, ImgBombLineTop +
                MyPokeHeight);
              imgBackGround.Canvas.LineTo(ImgLeftExcursion - 4 + (I + 1) * MyPokeWidth + ImgBombLineExcursion,
                ImgBombLineTop +
                MyPokeHeight);
              imgBackGround.Canvas.Pen.Color := clBlack;
              imgBackGround.Canvas.PenPos := Point(ImgLeftExcursion + 1 + (I - 3) * MyPokeWidth, ImgBombLineTop + 1 +
                MyPokeHeight);
              imgBackGround.Canvas.LineTo(ImgLeftExcursion - 3 + (I + 1) * MyPokeWidth + ImgBombLineExcursion,
                ImgBombLineTop + 1 +
                MyPokeHeight);
            end;
      end
      else
      begin
        //双猫判定
        if (CheckPokeType(AllOtherCardHistory[I]) = King) and (I > 0) then
          if (CheckPokeType(AllOtherCardHistory[I - 1]) = King) then
          begin
            imgBackGround.Canvas.Pen.Color := clYellow;
            imgBackGround.Canvas.PenPos := Point(ImgLeftExcursion + (I - 1) * MyPokeWidth, ImgBombLineTop +
              MyPokeHeight);
            imgBackGround.Canvas.LineTo(ImgLeftExcursion - 4 + (I + 1) * MyPokeWidth + ImgBombLineExcursion,
              ImgBombLineTop +
              MyPokeHeight);
            imgBackGround.Canvas.Pen.Color := clBlack;
            imgBackGround.Canvas.PenPos := Point(ImgLeftExcursion + 1 + (I - 1) * MyPokeWidth, ImgBombLineTop + 1 +
              MyPokeHeight);
            imgBackGround.Canvas.LineTo(ImgLeftExcursion - 3 + (I + 1) * MyPokeWidth + ImgBombLineExcursion,
              ImgBombLineTop + 1 +
              MyPokeHeight);
          end;
      end;
    end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -