扑克牌组件之二——利用 cards.dll 编写扑克牌组件

cards.dll 功能很全,我们这里只用它来画扑克牌的正面和反面,其他的一律不使用。如果您对这些用法感兴趣，可以到微软的MSDN上去查阅，这里就不再罗嗦了。下面请看：

unit Card;
// 项目：扑克牌组件 之二
// 作者：黄涛
// 邮件： Hunto@163.com
// 日期： 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.

组件的使用

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

Copyright ＠ 2007-2012 敏韬网(敏而好学，文韬武略--MinTao.Net)（学习笔记） Inc All Rights Reserved.
闵涛 E_mail:admin@mintao.net(欢迎提供学习资源)

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18