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

📄 pukegamewin.pas

📁 基于使用Delphi编写源码的扑克牌游戏源码
💻 PAS
📖 第 1 页 / 共 4 页
字号:
unit pukeGamewin;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, StdCtrls, Gamewin;


const
  UpCard_Top = 16;
  UpCard_Left1 = 240;
  UpCard_Left2 = 330;
  UpCard_Left3 = 420;
  UPCard_Left4 = 510;
  DownCard_Top = 130;
  Card0_Left= 16;
  Card1_Left= 250;
  Card2_Left= 340;
  Card3_left= 430;
  Card4_Left= 520;
  CardWidth= 71;
  CardHeight=96;
type
      TPlayCard = Record
       CardName: String;
       Top: integer;
       Left: Integer;
      end;

type  TMatter = Record
       Ground:integer;
       Index:Integer;
       Card:Array of integer;
       end;
type
  TForm1 = class(TForm)
    ClickBmp: TImage;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N9: TMenuItem;
    N2: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    A1: TMenuItem;
    Button1: TButton;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Shape4: TShape;
    Shape5: TShape;
    Label1: TLabel;
    Label2: TLabel;
    Shape6: TShape;
    Timer1: TTimer;
    C1: TMenuItem;
    S1: TMenuItem;
    U1: TMenuItem;
    Label3: TLabel;

    procedure N9Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ClickBmpDblClick(Sender: TObject);
    procedure MyMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MyMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure MyMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure C1Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure N10Click(Sender: TObject);
  published
    procedure SetCard;
    procedure DelhandCard(Cardvar: integer);
    function CheckGround(Card: Timage):bool;
    function CompareCard(S1, S2: String;UpDown:integer): Boolean;
    procedure MoveCard(GroundName, ColVar,CardVar: integer);
    function MoreMove(Card: Timage): TMatter;
  private
    Bitmap:TBitmap;
      procedure WMEraseBkgnd(var m: TWMEraseBkgnd); message WM_ERASEBKGND;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Closeword:Boolean;
  my:integer;
  MyCard,UnDoCard: Array[0..51] of TPlayCard;

  OkCard1,OkCard2,OkCard3,OkCard4:Array of integer;
  NotCard1,NotCard2,NotCard3,NotCard4:Array of integer;
  Ok1Max,
  Ok2Max,
  Ok3Max,
  Ok4Max,
  Not1Max,
  Not2Max,
  Not3Max,
  Not4Max,
  Flag,
  VarX,
  VarY,
  OldTop,
  OldLeft:integer;

  MyImage :Array[0..51] of  TImage;
  HandCard,BackCard:Array of Integer;      //手牌


  Playing:Boolean;
  PlayingCardList:TList;
  //DQhigh,DQLow,DQStep:integer;
  Pointer,Step:integer;
  More:Boolean;
  Currently:TMatter;
  Counts:integer;
  implementation

uses about;
{$R *.DFM}
{$R PuKe.Res}
procedure TForm1.N9Click(Sender: TObject);
begin
close;

end;


procedure TForm1.N3Click(Sender: TObject);
var
  i,j:integer;
  Temp:TImage;
begin
  Form1.Shape1.Visible :=True;
  Form1.Shape2.Visible :=True;
  Form1.Shape3.Visible :=True;
  Form1.Shape4.Visible :=True;
  Form1.Shape5.Visible :=True;
  Form1.Shape6.Visible :=False;
  clickbmp.Visible:=True;
  Clickbmp.BringToFront;
  Button1.Visible :=True;
  Counts:=0;
  Ok1Max:=0;
  Ok2Max:=0;
  Ok3Max:=0;
  Ok4Max:=0;
  Not1MaX:=0;
  Not2Max:=0;
  Not3Max:=0;
  Not4Max:=0;
  More:=False;
  SetCard;
  ClickBmp.Picture.Bitmap.LoadFromResourceName(Hinstance,'Pic2');
  ClickBmp.Enabled :=True;
  Pointer:=0;
  Step:=3;
  if PlayingCardList<>nil then
  begin
    j:=PlayIngCardList.Count;
    if j>0 then
    begin
        for I:=0 to j-1 do
        begin
         Temp:=PlayingCardList.Items[I];
         Temp.free;
        end;
         PlayingCardList.Clear;
    end;
  end;
  for i:=0 to 51 do
  begin
  MyImage[i]:= TImage.Create(Self);
  Myimage[i].Parent:=self;
  MyImage[i].Top:=UpCard_Top;
  MyCard[i].Top :=UpCard_Top;
  MyImage[i].Left := Card0_Left;
  MYCard[i].Left := Card0_Left;
  MyImage[i].Tag :=i;
  MyImage[i].Visible := False;
  MyImage[i].Picture.Bitmap.LoadFromResourceName(Hinstance,MyCard[i].CardName);
  MYimage[i].AutoSize := True;
  MYimage[i].Transparent := True;
  MyImage[i].OnMouseDown :=MyMOuseDown;
  MyImage[i].OnMouseMove := MyMouseMove;
  MyImage[i].OnMouseUp := MyMouseUp;
  PlayingCardList.Add(MyImage[i]);
  end;
  Label2.Caption:='剩余牌数:'+inttostr(8);
  SetLength(BackCard,8);
  for i:=0 to 7 do
  begin
     BackCard[7-i]:= i;
     MyCard[i].Top := DownCard_Top;
     MyCard[i].Left := Card0_Left;
     MyImage[i].Top :=MyCard[i].Top;
     MyImage[i].Left := MyCard[i].Left;
     Myimage[i].Visible :=True;
     Myimage[i].Enabled :=False;
     Myimage[i].BringToFront;

  end;

  Myimage[8].Top :=UpCard_Top;
  Myimage[8].Left:= UPCard_Left1;
  MYimage[8].Visible := True;
  Ok1Max:=1;
  SetLength(OkCard1,Ok1Max);
  OkCard1[0]:=8;
  MyCard[8].Top := UpCard_Top;
  MYCard[8].Left := Card1_Left;

  Myimage[9].Top:=DownCard_Top;
  MYimage[9].Left:=Card1_Left;
  MYimage[9].Visible := True;
  Not1Max:=1;
  SetLength(NotCard1,Not1Max);
  NotCard1[0]:=9;

  MyCard[9].Top := DownCard_Top;
  MyCard[9].Left := Card1_Left;

  MYimage[10].Top:=DownCard_Top;
  MYimage[10].Left:=Card2_Left;
  Myimage[10].Visible := True;
  Not2Max:=1;
  SetLength(NotCard2,Not2Max);
  NotCard2[0]:=10;
  Mycard[10].Top := DownCard_Top;
  MyCard[10].Left := Card2_Left;

  MYimage[11].Top := DownCard_Top;
  Myimage[11].Left:=Card3_Left;
  Myimage[11].Visible := True;
  Not3Max:=1;
  SetLength(NotCard3,Not3Max);
  NotCard3[0]:=11 ;

  MyCard[11].Top := DownCard_Top;
  MyCard[11].Left := Card3_Left;

  MYimage[12].Top := DownCard_Top;
  MYimage[12].Left := Card4_Left;
  MYimage[12].Visible := True;
  Not4Max:=1;
  SetLength(NotCard4,Not4Max);
  NotCard4[0]:=12;

  MyCard[12].Top := DownCard_Top;
  MyCard[12].Left := Card4_Left;
  label1.Caption :='剩余牌数:'+inttostr(39);
  //未翻牌赋值
  SetLength(HandCard,39);
  for i:=0 to high(HandCard) do
  begin
    HandCard[i]:=i+13;
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i,j: integer;
  PukeColor: array[0..3] of String;
begin
  Bitmap:=TBitmap.Create;
   Bitmap.LoadFromFile('bor6.bmp');
  CloseWord:=True;
  Timer1.Enabled:=True;
  Timer1.Interval :=10;
  My:=Form1.Width+20 ;
  Form1.Repaint;
  Ok1Max:=0;
  Ok2Max:=0;
  Ok3Max:=0;
  Ok4Max:=0;
  Not1MaX:=0;
  Not2Max:=0;
  Not3Max:=0;
  Not4Max:=0;
  ClickBmp.Enabled :=False;
  PlayingCardList:=Tlist.Create;
  Playing:=False;
  PuKeColor[0] := 'B';
  PuKeColor[1] := 'R';
  PuKeColor[2] := 'H';
  PuKeColor[3] := 'P';
  for i:=0 to 12 do
  begin
     for j:=0 to 3 do
     begin
      MyCard[i*4+j].CardName :=PukeColor[j]+IntToStr(i+1);
     end;
  end;

end;

procedure TForm1.SetCard;
var i,oldval,newval:integer;
     Temp:String;
 //    s:String;
begin
    Randomize;
    for i:=1 to 500 do
    begin
    oldval:=StrToint(FloatToStr(Random(52)));
    newVal:=StrToint(FloatToStr(Random(52)));
    Temp:=MyCard[OldVal].CardName ;
    MyCard[OldVal].CardName :=MyCard[NewVal].CardName;
    MyCard[NewVal].CardName :=Temp;
    end;
  {  s:='';
    for i:=0 to 51 do
    begin
      if (i+1) mod 13 = 0  then
       S:=S+MyCard[i].CardName+#13#10  //PuKeSet[i]+#13#10
       else
       s:=s+MyCard[i].CardName+',' // PukeSet[i]+',';
    end;
    showmessage(s);

   }
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
PlayingCardList.Free;
Bitmap.Free;
end;

procedure TForm1.ClickBmpDblClick(Sender: TObject);
Var
i,j,LeftY:integer;
Temp:Array of integer;
begin
  if (Step=0) then
  begin
   form1.Shape6.Visible :=True;
   Form1.Shape6.BringToFront;
   clickbmp.Visible :=False;
   Exit;
 end;
    if (Pointer)>high(HandCard) then
    begin
    Pointer:=0;
    Step:=Step-1;
      if Step>0 then
      begin
        for i:=0 to high(HandCard) do
        begin
          Myimage[HandCard[i]].Top:=16;
          Myimage[HandCard[i]].Left:=16;
          Myimage[HandCard[i]].Visible := False;
          MyCard[HandCard[i]].Top :=16;
          MYCard[handCard[i]].Left:=16;
        end;
      end;
    end
    else
    begin

      for i:=0 to Pointer-1 do    //整理翻完未拿的牌至一处
      begin
      Myimage[HandCard[i]].Top:=16;
      MYimage[HandCard[i]].Left:=104;
      Myimage[HandCard[i]].BringToFront ;
      MYCard[HandCard[i]].Top:=16;
      MyCard[handCard[i]].Left:=104;
      end;
    end;


 //重新排列数组的次序;
    i:=0;
    SetLength(Temp,0);
    while i<=Step-1 do
    begin
      if (Pointer+i)>High(HandCard) then
      break;
      SetLength(Temp,i+1);
      Temp[i]:=HandCard[pointer+i];
      Inc(i);

    end;
    Counts:=High(Temp)+1;
   j:=0;
    for i:=High(Temp) downto 0 do
     begin
       HandCard[Pointer+j]:=Temp[i];
       J:=J+1;
     end;

    LeftY:=104;
        j:=0;
   i:=Pointer;
   while i<=High(handCard) do
   begin
      if j>Step-1 then
       break;
       MYimage[HandCard[i]].Top :=UpCard_Top+j;
       Myimage[HandCard[i]].left:=LeftY;
       Myimage[HandCard[i]].Visible :=True;
       Myimage[HandCard[i]].BringToFront;
       MyCard[HandCard[i]].Top := UpCard_Top+j;
       MYCard[handCard[i]].Left:=LeftY;
       LeftY:=LeftY+16;
       inc(i);
       inc(Pointer);
       inc(j);
    end;
end;

procedure TForm1.MyMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
MyPoint:TMatter;
begin
   Flag:=0;
   varX:=X;
   VarY:=Y;
   OldTop:=(Sender as Timage).Top;
   OldLeft:=(Sender as Timage).Left;
   MyPoint:=MoreMove((Sender as Timage));
   Currently:=MyPoint;
   More:=False;
   Case MyPoint.Ground of
       1:begin
         if  Counts=0 then
             counts:=1;
         if (MyPoint.Index+1)=Counts then
             Flag:=1;
         end;
       2:begin
         Flag:=1;
         end;
       3:begin
           //上边第一列
           if MyPoint.Index+1=Ok1Max then
            begin
            Flag:=1;
             (Sender as Timage).BringToFront;
            end;
         end;
       //---
       4:begin
            //上边第二列
            if MyPoint.Index+1=Ok2Max then
            begin
              Flag:=1;
              (Sender as Timage).BringToFront;

⌨️ 快捷键说明

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