Z_x_b,我要扑克牌控件！

Question

请关注http://www.csdn.net/Expert/topic/521/521646.shtm

Answer 1

控件原理：自己构建一个资源文件，包括所有牌面和背面图片，由控件在onpaint中调用，Tcard由Tgraphiccontral继承，有几个属性：牌类型（花色、鬼牌）、牌面值（1-13）、显示背面……，原理不难，只是改造增加了鬼牌。其他具体内容可以看源程序中的注释！

Answer 2

控件原理：自己构建一个资源文件，包括所有牌面和背面图片，由控件在onpaint中调用，Tcard由Tgraphiccontral继承，有几个属性：牌类型（花色、鬼牌）、牌面值（1-13）、显示背面……，原理不难，只是改造增加了鬼牌。其他具体内容可以看源程序中的注释！

Answer 3

Sorry,这两天我出差了，今天才回来，我的E-Mail:[email protected]

Answer 4

unit Card;
//这是一个免费的论坛软件，送我100分，送你源程序！
//由于时间急促，鬼牌不大好看，有什么好图片，你可以对.RES进行修改，
//或者发给我，我改完了再发给你！！
//此控件由z_x_b（鄙人）设计、改造，有什么BUG请通知：[email protected]!
interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;type
  TCardValue = 1..13;   //牌面数字
  TCardSuit = (Spades,Diamonds,Clubs,Hearts,Lghost,Gghost);//牌面类型
  TShortSuit = (S,D,C,H,L,G);  //简写形式
  TDecks = (Standard1, Standard2, Fishes1, Fishes2,
           Beach, Leaves1, Leaves2, Robot,
           Roses, Shell, Castle, Hand);  //牌背面类型
  TCard = class(TGraphicControl)
  private
    FValue: TCardValue;
    FSuit: TCardSuit;
    FDeckType: TDecks;
    FShowDeck: Boolean;
    procedure WMSize(var Message: TWMSize); message WM_PAINT;
    procedure SetValue(Value : TCardValue);
    procedure SetSuit(Suit: TCardSuit);
    procedure SetShowDeck(ShowDeck: Boolean);
    procedure SetDeckType(DeckType: TDecks);
  protected
    property Height default 96;
    property Width default 71;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetCard(CValue: Integer; CSuit: TShortSuit);
    procedure RandomCard;
    procedure Turn;
    function DifferentFrom(FromCard: TCard): Boolean;
  published
    property Value: TCardValue read FValue write SetValue;
    property Suit: TCardSuit read FSuit write SetSuit;
    property ShowDeck: Boolean read FShowDeck write SetShowDeck;
    property DeckType: TDecks read FDeckType write SetDeckType;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;procedure Register;implementation{$R CARDS.RES}procedure Register;
begin
  //注册控件
  RegisterComponents('COOL', [TCard]);
end;constructor TCard.Create(AOwner: TComponent);
begin
//设定初始状态
  inherited Create(AOwner);
  Height := 96;
  Width := 71;
  FValue := 1;
  FSuit := Hearts;
  FDeckType := Standard1;
  FShowDeck := False;
  Randomize;
end;destructor TCard.Destroy;
begin
  inherited Destroy;
end;                    procedure TCard.WMSize(var Message: TWMSize);
begin
// 禁止改变大小
  inherited;
  Width := 71;
  Height := 96;
end;procedure TCard.SetValue(Value : TCardValue);
begin
//数字限制在1-13之间
  if Value<1 then Value := 1;
  if Value>13 then Value :=13;
  FValue := Value;
  Paint;
end;procedure TCard.SetSuit(Suit: TCardSuit);
begin
  FSuit := Suit;
  Paint;
end;procedure TCard.SetShowDeck(ShowDeck: Boolean);
begin
  FShowDeck := ShowDeck;
  Paint;
end;procedure TCard.SetDeckType(DeckType: TDecks);
begin
  FDeckType := DeckType;
  Paint;
end;procedure TCard.SetCard(CValue: Integer; CSuit: TShortSuit);
begin
  if (CValue>0) and (CValue<14) then Value := CValue;
  if CSuit in [C,H,S,D,L,G] then
    case CSuit of
      C: Suit := Clubs;
      H: Suit := Hearts;
      S: Suit := Spades;
      D: Suit := Diamonds;
      L:Suit := LGHOST; //小鬼
      G:Suit := GGHOST; //大鬼
    end;end;procedure TCard.Turn;
begin
  ShowDeck := not ShowDeck;
end;procedure TCard.RandomCard;
var Rand: Integer;
begin
  Rand := Random(6)+1;
  CASE Rand OF
  1: FSuit := Hearts;
  2: FSuit := Clubs;
  3: FSuit := Spades;
  4: FSuit := Diamonds;
  5: FSuit := LGHOST;
  6: FSuit := GGHOST;
  END;
  Rand := Random(13)+1;
  FValue := Rand;
  Paint;
end;function TCard.DifferentFrom(FromCard: TCard): Boolean;
begin
//这里没有比较鬼牌，应该改进！（您自己来吧）
  if (FSuit <> FromCard.Suit)
  or (FValue <> FromCard.Value)
  then DifferentFrom := True
  else DifferentFrom := False;
end;procedure TCard.Paint;
var CardBitmap: TBitmap;
    ResName: String;
begin
  CardBitmap := TBitmap.Create;
  if not ShowDeck then
  begin   // 显示牌面
    case FSuit of
    Hearts: ResName := 'H'+IntToStr(FValue);
    Spades: ResName := 'S'+IntToStr(FValue);
    Clubs: ResName := 'C'+IntToStr(FValue);
    Diamonds: ResName := 'D'+IntToStr(FValue);
    Lghost: ResName := 'L0';
    Gghost: ResName := 'G0';
    end;  end
  else                         //显示背面
    case DeckType of
    Standard1: ResName := 'STD1';
    Standard2: ResName := 'STD2';
    Fishes1: ResName := 'FISHES1';
    Fishes2: ResName := 'FISHES2';
    Beach: ResName := 'BEACH';
    Leaves1: ResName := 'LEAVES1';
    Leaves2: ResName := 'LEAVES2';
    Robot: ResName := 'ROBOT';
    Roses: ResName := 'ROSES';
    Shell: ResName := 'SHELL';
    Castle: ResName := 'CASTLE';
    Hand: ResName := 'HAND';
    end;
  // 从资源中获取图片
  CardBitmap.LoadFromResourceName(HInstance,ResName);
  Canvas.Draw(0,0,CardBitmap);
  CardBitmap.Free;
end;end.
给[email protected]发信总是不成功（给别人发没有问题），所以贴出来。