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

类别:Delphi 点击:0 评论:0 推荐:
扑克组件的编写及使用上一次写了一个利用位图制作的扑克组件,这次换一下,试着利用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.

组件的使用

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;

本文地址:http://com.8s8s.com/it/it4491.htm