pukegamewin.pas

基于使用Delphi编写源码的扑克牌游戏源码

                  MyImage[Currently.Card[j]].top:=K;
                  MyImage[Currently.Card[j]].Left :=Card4_Left;
                  NotCard4[i]:=Currently.Card[j];
                  MyCard[Currently.Card[j]].Top := K;//Myimage[Currently.Card[j]].Top;
                  MyCard[Currently.Card[j]].Left:=Card4_Left;//Myimage[currently.Card[j]].Left;
                  K:=K+15;
                  j:=j+1;
                 end;
                Result:=True;
               end;//end of more
           end
           else
           begin

               if CompareCard(MyCard[NotCard4[Not4Max-1]].CardName,MyCard[Card.Tag].CardName,2) then
               begin //----
                 if Not More then
                 begin
                  Card.Top:=MyCard[NotCard4[Not4Max-1]].Top+15;
                  Card.Left := Card4_Left;
                  MyCard[Card.Tag].Top:=Card.Top;
                  MyCard[Card.Tag].Left:=Card4_Left;
                  Not4Max:=Not4Max+1;
                  SetLength(NotCard4,Not4Max);
                  NotCard4[Not4Max-1]:=Card.Tag;
                  Result:=True;
                  end
                  else
                  begin
                    OldMax:=Not4Max;
                    Not4Max:=Not4Max+High(Currently.Card)+1;
                    Setlength(NotCard4,Not4Max);
                    j:=0;
                    k:=MyCard[NotCard4[OldMax-1]].Top+15;
                    for i:=OldMax to High(NotCard4)do
                    begin
                         MyImage[Currently.Card[j]].top:=K;
                         MyImage[Currently.Card[j]].Left :=Card4_Left;
                         NotCard4[i]:=Currently.Card[j];
                         MyCard[Currently.Card[j]].Top :=K; // Myimage[Currently.Card[j]].Top;
                         MyCard[Currently.Card[j]].Left:=card4_Left; //Myimage[currently.Card[j]].Left;
                         k:=K+15;
                         j:=j+1;
                    end;
                    Result:=True;

                  end;//end of more
              end; //----
            end;
       end;
       end;//Ok;
    end;


end;

function TForm1.CompareCard(S1, S2: String;UpDown:integer): Boolean;
Var
 Temp1,Temp2:String;
begin
 Result:=False;
 temp1:=s1;
 Temp2:=s2;
 delete(Temp1,1,1);
 Delete(Temp2,1,1);

// showmessage('检查是否可以放置:'+s1+'='+Temp1+','+S2+'='+Temp2);

 Case UpDown of
    1:begin
        if strtoint(Temp1)=13 then
        Temp1:='0';
        if (copy(s1,1,1)=Copy(S2,1,1)) and (StrToint(Temp1)+1=StrToInt(Temp2)) then
        begin
         Result:=True;
        end;
      end;

    2:begin

       if strtoint(Temp1)=1 then
          Temp1:='14';


       if (Copy(s1,1,1)='B')or(Copy(s1,1,1)='H') then
       begin
          if ((Copy(s2,1,1)='R')or(Copy(s2,1,1)='P')) and (StrToint(Temp1)-1=StrToint(Temp2))then
           begin
             Result:=True;
           end;
       end;
       if (Copy(s1,1,1)='R')or(Copy(s1,1,1)='P') then
       begin
          if ((Copy(s2,1,1)='B')or(Copy(s2,1,1)='H')) and (StrToint(Temp1)-1=StrToint(Temp2))then
           begin
            Result:=True;
           end;
       end;
     end;
   end;

end;

procedure TForm1.MoveCard(GroundName, ColVar,CardVar: integer);
var
i:integer;
begin

   Case GroundName of //-
    1:begin
         if BackCard <> nil then
         begin

            for i:=0 to High(BackCard)-1 do
            begin
               BackCard[i]:=BackCard[i+1];
            end;
            SetLength(BackCard,High(BackCard));

         end;
      end;
    2:begin
         Case Colvar of

            1:begin
               dec(Ok1Max);
               SetLength(OkCard1,Ok1Max);
              end;
            2:begin
               Dec(Ok2Max);
               SetLength(OkCard2,ok2Max);

              end;
            3:begin
               dec(Ok3Max);
               SetLength(OkCard3,Ok3Max);

              end;
            4:begin
               dec(Ok4Max);
               SetLength(OkCard4,Ok4Max);
              end;
         end;
      end;
    3:begin
         case ColVar of
         1:begin
              i:=0;
              while i<= High(Notcard1) do
              begin
                  if NotCard1[i]=CardVar then
                  begin
                       Not1Max:=i;
                       SetLength(NotCard1,Not1Max);
                       break;
                  end;
                  inc(i);
              end;

           end;


         2:begin
              i:=0;
              while i<=High(NotCard2) do
              begin
                  if NotCard2[i]=CardVar then
                  begin
                     Not2Max:=i;
                     SetLength(NotCard2,Not2Max);
                     break;
                  end;
                  inc(i);
              end;

           end; //2 end;

         3:begin
              i:=0;
              While i<=high(Notcard3) do
              begin
                  if NotCard3[i]=CardVar then
                  begin
                     Not3Max:=i;
                     SetLength(NotCard3,Not3Max);
                     break;
                  end;
                  Inc(i);
              end;


           end;
         4:begin
              i:=0;
              While i<=High(NotCard4) do
              begin
                  if NotCard4[i]=CardVar then
                  begin
                     Not4Max:=i;
                     SetLength(NotCard4,Not4Max);
                     Break;
                  end;
                  Inc(i);
              end;

           end;

         end;
      end;
   end;//-
end;

function TForm1.MoreMove(Card: Timage): TMatter;
var
i,j:integer;
Matter:TMatter;
begin
   //覆盖范围检验
    Matter.Ground:=0;
    Matter.Index :=0;
    SetLength(Matter.Card,0);
    Result:=Matter;
    if ((Card.Top>=UpCard_Top) and (Card.Top<=UpCard_Top+2)) and ((Card.Left>=104) and (Card.Left<=152)) then
    begin
        //取牌处
      Matter.Ground :=1;
      Matter.Index :=Card.Top-UpCard_Top;
      Result:=Matter;
    end;
    if (Card.Top=DownCard_Top) and (Card.Left=Card0_Left)  then
    begin
       //背牌处；
       Matter.Ground := 2;
       Matter.Index :=0;
       Result:=Matter;
    end;

    if (Card.Top=UpCard_Top) and ((Card.Left=Card1_Left) or (Card.Left=UpCard_Left1)) then
    begin
     //第一列摆放好的牌位
       Matter.Ground:=3;
      for i:=0 to high(OkCard1) do
       begin
          if OkCard1[i]=Card.Tag then
          begin
            Matter.Index := i;
          end;
       end;
       Result:=Matter;
     end;

     if (Card.Top=UpCard_Top) and ((Card.Left=UpCard_Left2)or(Card.Left=Card2_Left)) then
     begin
         //第二列摆放好的牌位
         Matter.Ground:=4;
         for i:=0 to high(OkCard2) do
          begin
             if OkCard2[i]=Card.Tag then
              begin
                Matter.Index := i;
              end;
          end;
       Result:=Matter;
     end;

     if (Card.Top=UpCard_Top) and ((Card.Left=UpCard_Left3)or(Card.Left=Card3_Left)) then
     begin
         //第三列摆放好的牌位
         Matter.Ground:=5;
         for i:=0 to high(OkCard3) do
          begin
             if OkCard3[i]=Card.Tag then
              begin
                Matter.Index := i;
              end;
          end;
       Result:=Matter;
     end;

     if (Card.Top=UpCard_Top) and ((Card.Left=UpCard_Left4)or(Card.Left=Card4_Left)) then
     begin
         //第四列摆放好的牌位
         Matter.Ground:=6;
         for i:=0 to high(OkCard4) do
          begin
             if OkCard4[i]=Card.Tag then
              begin
                Matter.Index := i;
              end;
          end;
       Result:=Matter;
     end;

     //---------------------------------------------
     //下边牌
     if (Card.Top>=DownCard_Top) and (Card.Left=Card1_Left) then
     begin
       //下边第一列;
         Matter.Ground := 7;
         for i:=0 to high(NotCard1) do
         begin
            if NotCard1[i]=Card.Tag then
            begin
                Matter.Index:=i;
                SetLength(Matter.Card,High(NotCard1)+1-i);
                break;
            end;
         end;
         j:=0;
         for i:=Matter.Index to High(NotCard1) do
         begin
          Matter.Card[j]:=NotCard1[i];
          inc(j);
         end;
          Result:=Matter;
     end;

     if (Card.Top>=DownCard_Top) and (Card.Left=Card2_Left) then
     begin
         //下边第二列;
         Matter.Ground := 8;
         for i:=0 to high(NotCard2) do
         begin
            if NotCard2[i]=Card.Tag then
             begin
              Matter.Index := i;
              SetLength(Matter.Card,High(NotCard2)+1-i);
              Break;
             end;
         end;

         j:=0;
         for i:=Matter.Index to high(NotCard2) do
         begin
             Matter.Card[j]:=NotCard2[i];
             inc(j);
         end;
         Result:=matter;
     end;

     if (Card.Top>=DownCard_Top) and (Card.Left=Card3_Left) then
     begin
         //下边第三列;
         Matter.Ground :=9;
         for i:=0 to high(NotCard3) do
         begin
            if NotCard3[i]=Card.Tag then
             begin
              Matter.Index := i;
              SetLength(Matter.Card,High(NotCard3)+1-i);
              Break;
             end;
         end;

         j:=0;
         for i:=Matter.Index to high(NotCard3) do
         begin
             Matter.Card[j]:=NotCard3[i];
             inc(j);
         end;
         Result:=matter;

      end;

     if (Card.Top>=DownCard_Top) and (Card.Left=Card4_Left) then
     begin
        //下边第四列
        Matter.Ground :=10 ;
         for i:=0 to high(NotCard4) do
         begin
            if NotCard4[i]=Card.Tag then
             begin
              Matter.Index := i;
              SetLength(Matter.Card,High(NotCard4)+1-i);
              Break;
             end;
         end;

         j:=0;
         for i:=Matter.Index to high(NotCard4) do
         begin
             Matter.Card[j]:=NotCard4[i];
             inc(j);
         end;
         Result:=matter;
     end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if CloseWord then
begin
 My:=My-1;
 if my<-190 then
 my:=width-100;
 Label3.Top:=form1.height-80;
 Label3.Left:=My;
end;
end;

procedure TForm1.A1Click(Sender: TObject);
begin
  AboutBox.ShowModal;
end;

procedure TForm1.S1Click(Sender: TObject);
begin
Form1.Button1.Click;
end;

procedure TForm1.C1Click(Sender: TObject);
begin
if Closeword then
begin
CloseWord:=False;
Timer1.Enabled:=False;
Label3.Visible :=False;
C1.Caption:='打开字幕(&O)';
Form1.Repaint;
end
else
begin
Timer1.Enabled :=True;
Label3.Visible :=True;
CloseWord:=True;
C1.Caption :='关闭字幕(&C)';
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
x,y:integer;
begin
 y := 0;
  while y < Height do
  begin
    x := 0;
    while x < Width do
    begin
      Canvas.Draw(x, y, Bitmap);
      x := x + Bitmap.Width;
    end;
    y := y + Bitmap.Height;
  end;
end;

procedure TForm1.WMEraseBkgnd(var m: TWMEraseBkgnd);
begin
  m.Result := LRESULT(False);
end;

procedure TForm1.N10Click(Sender: TObject);
begin
  if (not winhelp(Handle,'PlayCard.hlp',HELP_fINDER,0)) then
  begin
    showmessage('不能访问帮助信息');
    exit;
  end;
end;

end.