Delphi 组件编写--扑克牌组件

 

在网上看了不少关于扑克牌组件的编写，大多是调用Windows/system32下的cards.dll其实我们如果不调用这些函数也是可以作一个很好扑克牌组件。具体步骤如下：

       1、 首先做一个位图文件，符合如下格式，所有的扑克牌均为同样大小，每种花色排一行，从A到K排列，花色按黑桃、红桃、方块、梅花排列。如果不想做可以从QQ game 下的CardRes.dll中导出，本组件就用的就是QQ Game的位图。然后建立一个文本文件名为card.rc，内容为 card Bitmap “card.bmp“，然后用brcc32.exe编译成 card.res。

      2、该扑克牌组件自TGraphicControl继承。可以做为一个单个扑克牌使用。其主要的属性有CardId，是其牌的编号，FaceUp是扑克牌 正面朝上还是朝下的属性。Left,Top,Width,Height，Visual等属性均是继承于TGraphicControl，只需要说明一下即 可。其源代码如下：

unit uCard;
//  单元：    可视化组件 ——扑克牌组件
//  作者：    黄涛
//  E_Mail:   [email protected]
//  日期：    2004.12.7
//  修改日期: 2004.12.8
interface
uses windows,Messages,classes,Graphics,controls,dialogs;
type
  //朴克的花色定义，分别是黑桃、红心、方块、梅花
  TCardSuit=( csSpade,csHeart,csClub,csDiamond);
  TCard =class(TGraphicControl) //扑克的组件
  private
    FCardId:Cardinal ;  //扑克的编号，0-51为各花色的1-K，52为大王，53小王
    FFaceUp:bool;      //是否正面朝上
    procedure SetCardId(id:Cardinal);//设置扑克牌的编号
    procedure SetFaceUp(Flag:Bool); //设置是否正面朝上
    function GetValue:integer;     //得到扑克牌的点数
    function GetSuit:TCardSuit;   //得到扑克牌的花色
  protected
    procedure Paint; override;   //画扑克牌的程序
  public
    constructor Create(AOwner:TComponent);overload;override; //构造函数
    constructor Create(AOwner:TComponent;Id:Cardinal);overload;
    procedure SetCard(Suit:TCardSuit;Value:Cardinal); //设置扑克牌的编号
  published
    property CardId:Cardinal read FCardId write SetCardId; //扑克牌编号
    property FaceUp:bool read FFaceUp write SetFaceUp default False; //正面朝上
    property Value:integer read GetValue;   //扑克的点数，只读
    property Suit:TCardSuit read GetSuit;   //扑克的花色，只读
    property OnClick;            //单击
    property OnDblClick;         //双击
  end;
implementation
{$R Card.res}
{ TCard }
var CardMap:TBitmap;  //扑克牌的图形，从Card.res中获取
constructor TCard.Create(AOwner: TComponent);
begin
  inherited;   //如果父控件是WINDOWCONTROL的话，设置其Parent属性
  if Aowner is TWinControl then self.Parent := TWinControl(Aowner);
  Width:=CardMap.Width div 14; //得到扑克牌的宽度
  Height:=CardMap.Height div 4; //得到扑克牌的高度
  FaceUp:=False;   //默认扑克牌朝下
end;
constructor TCard.Create(AOwner: TComponent;Id: Cardinal);
begin
  Create(AOwner);
  CardId:=Id; //设置扑克牌的编号
end;
procedure TCard.SetCardId(id:Cardinal);
begin
  if id<54 then FCardId:=id;  //设置扑克牌的编号
  Paint;      //重新画扑克牌
end;
procedure TCard.SetCard(Suit:TCardSuit; Value: Cardinal);
begin
  dec(Value);
  CardId:=Value shl 2 + Cardinal(Suit) and 3;//设置扑克牌的编号并重画
end;
procedure TCard.Paint; //画扑克牌
var x,y,tmp:integer;
begin
  if not assigned(Parent) then exit;//如果没有定义父控件，直接退出，以免报错
  inherited;
  if FaceUp then tmp:=CardId //如果面朝上，则画正面
  else tmp:=54;              //反之画背面
  x:=(tmp shr 2)*Width;     //该扑克牌在位图中横坐标的位置
  y:=(tmp and 3)*Height;    //该扑克牌在位图中纵坐标的位置
  bitblt(Canvas.Handle,0,0,Width,Height,  //画图
    CardMap.Canvas.Handle ,x,y,SRCCOPY);
end;
procedure TCard.SetFaceUp(Flag: Bool);//设置牌面朝上还是朝下
begin
  FFaceUp:=Flag;
  Paint;         //重画
end;
function TCard.GetValue: integer;
begin
  Result:=CardId shr 2; //得到该牌的值
  inc(Result);
end;
function TCard.GetSuit:TCardSuit;
begin
  Result:=TCardSuit(CardId and 3);  //得到该牌的花色
end;
initialization  //单元初始化
  CardMap:=TBitmap.create ; //创建位图
  CardMap.LoadFromResourceName(HINSTANCE,'card');//从资源中导入
finalization
  CardMap.Free ;//清除位图
end.



＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
上一次写了一个利用位图制作的扑克组件，这次换一下，试着利用cards.dll来做一人组件。这个组件没有大小王，速度也比上一个慢了许多。不过这个组件可以设置很多背景,而且它的宽度和长度都是可以更改的。 
cards.dll 功能很全,我们这里只用它来画扑克牌的正面和反面,其他的一律不使用。如果您对这些用法感兴趣，可以到微软的MSDN上去查阅，这里就不再罗嗦了。下面请看： 

  
  
  
  

   
   
   
   
 
    
unit Card;
 
    
// 项目：扑克牌组件 之二
 
    
// 作者：黄涛
 
    
// 邮件： [email protected]
 
    
// 日期： 2004.12.16
 
    
// 本组件调用 Windows 的 cards.dll，如果系统不为2000/XP将无法使用。
 
    
interface
 
    
uses
 
    
  SysUtils, Classes, Controls,windows;
 
    
type
 
    
  TCardSuit=(csClub,csDiamond,csHeart,csSpade); //花色
 
    
  TCard = class(TGraphicControl)
 
    
  private
 
    
    FFaceUp:bool;   //是否面朝上
 
    
    FCardId:Cardinal; //扑克牌的编号
 
    
    FBackId:Cardinal; //背面图案
 
    
    procedure SetCardId(Id:Cardinal); //设置扑克牌的编号
 
    
    procedure SetFaceUp(FaceUp:bool); //设置是否面朝上
 
    
    procedure SetBackId(const Value: Cardinal); //设置扑克牌的背面图案
 
    
    function GetSuit: TCardSuit;  //得到扑克牌的花色
 
    
    function GetValue: Cardinal;  //得到扑克牌的点数
 
    
  protected
 
    
    procedure Paint;override;   //画扑克牌
 
    
  public
 
    
    constructor Create(AOwner:TComponent);override;
 
    
    procedure SetCard(Suit:TCardSuit;Value:Cardinal); //设置扑克牌的编号
 
    
  published
 
    
    property CardId:Cardinal read FCardId write SetCardId;  //扑克牌编号
 
    
    property FaceUp:bool read FFaceUp write SetFaceUp default False;  //是否正面朝上
 
    
    property BackId:Cardinal read FBackId write SetBackId default 0;  //背景图案
 
    
    property Suit:TCardSuit read GetSuit; //花色，只读
 
    
    property Value:Cardinal read GetValue; //点数，只读
 
    
    property OnClick; //单击事件
 
    
    property OnDblClick; //双击事件
 
    
  end;
 
    
procedure Register;
 
    
implementation
 
    
//单元变量，默认的扑克牌宽度和长度
 
    
var CardWidth,Cardheight:integer;
 
    
//初如化DLL
 
    
procedure cdtInit(var Width,Height:integer);stdcall;external 'cards.dll';
 
    
//结束DLL调用
 
    
procedure cdtTerm;stdcall;external 'cards.dll';
 
    
//画扑克函数
 
    
procedure cdtDrawExt(ADC:HDC;Left,Top,Width,Height:Cardinal;CardId:Cardinal;
 
    
  mode:integer;Bkgnd:integer);stdcall;external 'cards.dll';
 
    
procedure Register; //注册组件
 
    
begin
 
    
  RegisterComponents('Samples', [TCard]);
 
    
end;
 
    
{ TCard }
 
    
constructor TCard.Create(AOwner: TComponent);
 
    
begin
 
    
  inherited;
 
    
  if AOwner is TWinControl then Parent :=TWinControl(AOwner);
 
    
  FaceUp:=False;      //设置默认为扑克面朝下
 
    
  Width :=CardWidth;  //设置默认的扑克牌宽度，可修改
 
    
  Height:=CardHeight; //设置默认的扑克牌高度，可修改
 
    
end;
 
    
function TCard.GetSuit: TCardSuit;
 
    
begin
 
    
  result:=TCardSuit(CardId and 3); //得到扑克牌的花色
 
    
end;
 
    
function TCard.GetValue: Cardinal;
 
    
begin
 
    
  result:=CardId shr 2 +1;     //得到扑克牌的值
 
    
end;
 
    
procedure TCard.Paint;  //画扑克牌
 
    
var Id,cmd :Cardinal;
 
    
begin
 
    
  if not assigned(Parent) then exit;//如果父组件没定义，直接退出
 
    
  if FaceUp then //正面朝上
 
    
  begin
 
    
    Id:=CardId;
 
    
    cmd:=0;
 
    
  end
 
    
  else           //背面朝上
 
    
  begin
 
    
    Id:=BackId+54;
 
    
    cmd:=1;
 
    
  end;
 
    
  cdtDrawExt(Canvas.Handle ,0,0,Width,Height,Id,cmd,0);
 
    
end;
 
    
procedure TCard.SetBackId(const Value: Cardinal);//设置背景的图案，当时生效
 
    
begin
 
    
  if (Value <12) and (FBackId <> Value) then FBackId:= Value;
 
    
  if not FaceUp then Paint;
 
    
end;
 
    
procedure TCard.SetCard(Suit: TCardSuit; Value: Cardinal);
 
    
begin  //设置扑克牌编号，当时重画
 
    
  dec(Value);
 
    
  CardId:=(Value shl 2 ) or Cardinal(Suit);
 
    
end;
 
    
procedure TCard.SetCardId(Id: Cardinal);
 
    
begin               //设置扑克牌编号，当时重画
 
    
  if Id<52 then FCardId:=Id;
 
    
  if FaceUp then Paint; //正面朝上则重画
 
    
end;
 
    
procedure TCard.SetFaceUp(FaceUp: bool);
 
    
begin                 //设置背面或正面朝上
 
    
  FFaceUp:=FaceUp;
 
    
  paint;
 
    
end;
 
    
initialization
 
    
  cdtInit(CardWidth,CardHeight); //初始化DLL
 
    
finalization
 
    
  cdtTerm;   //调用结束
 
    
end.
 
    

 
   
  
  
  
  

组件的使用

1. procedure TForm1.Button2Click(Sender: TObject);
2. var i:integer;
3.   k:TCardSuit;
4. begin
5.   //扑克牌组件代码演示
6.   for k:=low(TCardSuit) to high(TCardSuit) do //自上向下画出各个花色的扑克牌
7.     for i:=1 to 13 do //自左向右画出各个点数的扑克牌
8.       with TCard.Create(self) do
9.       begin
10.         SetCard(k,i);  //设置扑克牌编号
11.         Left:=(i-1)*15;  //设置左力位置
12.         Top:=ord(k)*Height; //设置顶部位置
13.         FaceUp:=True;     //正面朝上
14.       end;
15.   for i:= 0 to 11 do  //依次画出12种背景图案
16.   with TCard.Create(self) do
17.   begin
18.     BackId:=i;          //设置背景图案
19.     Top:=(i and 3)*Height;    //设置顶部位置
20.     Left:=(i shr 2) *Width+180+width; //设置左边位置
21.   end;
22. end;