HJÆLP!!!!!
Hej Allesammen HJÆLP!!Jeg er ved at lave en skabelon/Skellet til et kortspil.
men jeg kan ikke helt finde ud af det . Jeg har lavet det færdigt men det kører ikke som det skal!!
Jeg har en form med en TMainMenu på med 2 knapper en til at starte et nyt spil med(navn: afslut1 og en til at afslutte spille spillet med(navn: afslut2). Når man trykke på afslut1 kører en procedure = NewGame. Denne NewGame-procedure har jeg sat til= p1.create(20,20,0,0); CTable.addPile(p1);
MEN JEG FÅR DENNE FEJL VED PRØVEKØRSEL:-( .
Debugger Exception Notification
-----------------------------------------
Project project1.exe raised exception class EAccessViolation with message 'Access
violation at address 00452345 in module 'PROJECT1.EXE'. Read of address FFFFFFFF'.
Procces stopped. Use Step or Run to continue.
og linien ved >>>>>>>>’erne bliver markeret i cardclasses.
mine unit’er ser sådan ud:
unit gui;
interface
uses
Windows, Messages, Classes, Graphics, Controls, Forms,
StdCtrls, cardclasses, cardFkt, Menus;
procedure NewGame;
procedure ProgInit;
type
TFrmBord = class(TForm)
MainMenu1: TMainMenu;
Nytspil1: TMenuItem;
Afslut1: TMenuItem;
Afslut2: TMenuItem;
procedure FormPaint(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer; Pile: TPile; Card: TCard);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer; Pile: TPile; Card: TCard);
procedure FormCreate(Sender: TObject);
procedure Afslut2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Afslut1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure EraseRect(HFillrect,VFillRect: TRect);
procedure DrawEmptyPile(aType: integer;x1,y1: integer);
procedure CardDrawInverted(x,y,CardNr: integer);
procedure CardDraw(x,y,CardNr: integer);
procedure BackDraw(x,y,BackNr: integer);
end;
var
FrmBord: TFrmBord;
implementation
{$R *.DFM}
uses dialogs,sysutils;
{ her kan du placere globale erklæringer af f.eks. pile }
var p1: TPile;
procedure TFrmBord.EraseRect(HFillrect,VFillRect: TRect);
begin
Canvas.brush.Color:=Color;
Canvas.FillRect(HFillRect);
Canvas.FillRect(VFillRect);
end;
procedure TFrmBord.DrawEmptyPile(aType: integer;x1,y1: integer);
const d=5;
var i: integer;
begin
case aType of
1: _BackDraw(Canvas,x1,y1,14);
2: _BackDraw(Canvas,x1,y1,13);
else
Canvas.Pen.Color:=clLime;
for i:=0 to 1 do
Canvas.RoundRect(x1+i,y1+i,x1+CardWidth-i,y1+CardHeight-i,d,d);
end
end;
procedure TFrmBord.CardDrawInverted(x,y,CardNr: integer);
begin
_CardDrawInverted(FrmBord.Canvas,x,y,CardNr);
end;
procedure TFrmBord.CardDraw(x,y,CardNr: integer);
begin
_CardDraw(FrmBord.Canvas,x,y,CardNr);
end;
procedure TFrmBord.BackDraw(x,y,BackNr: integer);
begin
_BackDraw(FrmBord.Canvas,x,y,BackNr);
end;
procedure TFrmBord.FormPaint(Sender: TObject);
begin
CTable.Refresh;
end;
procedure TFrmBord.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer; Pile: TPile; Card: TCard);
var p: TPile; c: TCard;
begin
CTable.GetPileCardAt(x,y,p,c);
if p<>nil then
{ kaldes ved MouseDown i bunken Pile på kortet Card;
skriv kode der skal udføres ved MouseDown }
begin
end;
end;
procedure TFrmBord.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer; Pile: TPile; Card: TCard);
var p: TPile; c: TCard;
begin
CTable.GetPileCardAt(x,y,p,c);
if p<>nil then
{ kaldes ved MouseUp i bunken Pile på kortet Card;
skriv kode der skal udføres ved MouseUp }
begin
end;
end;
procedure TFrmBord.Afslut2Click(Sender: TObject);
begin
close
end;
procedure TFrmBord.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CTable.Clear;
end;
procedure NewGame;
{ Kaldes ved start af nyt spil;
skriv evt. initialiseringer ved start af nyt spil;
HUSK først at kalde free for alle skabte objekter fra
evt. tidligere spil }
begin
p1.create(20,20,0,0);
CTable.addPile(p1);
end;
procedure ProgInit;
{ Kaldes ved programstart;
skriv evt. initialiseringer ved programstart i denne procedure }
begin
ShowMessage('hejhej')
end;
procedure TFrmBord.FormCreate(Sender: TObject);
begin
ProgInit;
end;
procedure TFrmBord.Afslut1Click(Sender: TObject);
begin
NewGame;
end;
end.
--------------
OG DENNE
--------------
unit cardclasses;
interface
uses classes,windows,forms,sysutils,graphics;
type
TCColor=(BLACK,RED);
TCSuit=(SPADE,HEART,DIAMOND,CLUB);
TPile=class;
TCard=class
private
suit: TCSuit;
value: integer;
faceUp: boolean;
selected: boolean;
myPile: TPile;
procedure setMyPile(p: TPile);
function getCardHeight: integer;
function getCardWidth: integer;
public
constructor create(aSuit: TCSuit; aValue: integer;
aFaceUp: boolean);
function getColor: TCColor;
function getSuit: TCSuit;
function getValue: integer;
function getCardNr: integer;
procedure TurnFaceUp;
procedure TurnFaceDown;
procedure flip;
procedure select;
procedure deSelect;
function isSelected: boolean;
function hasFaceUp: boolean;
end;
TPile=class
private
x: integer; // position
y: integer;
minAntal: integer; // minimum antal kort, default 0 , bruges ikke indtil videre
maxAntal: integer; // maximum antal kort, default 52, bruges ikke indtil videre
dx: integer; // retning
dy: integer; // forskydning i pxel fra kort til kort ved tegning
cards: TList;
PrevCount: integer;
LockRefresh: boolean;
EmptyPileType: integer; // angiver hvordan en tom
// bunke vises
IsVisible: boolean;
procedure refresh;
procedure DrawEmptyPile;
function xyInCard(x,y: integer): TCard;
function HFillRect: TRect;
function VFillRect: TRect;
public
constructor create(ax,ay,adx,ady: integer);
destructor free;
procedure SetEmptyPileShow(aType: integer);
procedure MoveTo(ax,ay: integer);
function getX: integer;
function getY: integer;
function getCardX(c: TCard): integer;
function getCardY(c: TCard): integer;
procedure setMinAntal(min: integer);
procedure setMaxAntal(max: integer);
function isEmpty: boolean;
function getSize: integer;
function getIndex(c: TCard): integer;
function Find(suit: TCSuit; value: integer): TCard;
procedure insertAtTop(c: TCard);
procedure insertAtBottom(c: TCard);
procedure insertAbove(c0,c: TCard);
procedure insertBelow(c0,c: TCard);
procedure insertAt(Index: integer; c: TCard);
function removeCard(c: TCard): TCard;
function removeCardAt(n: integer): TCard;
function removeTopCard: TCard;
function removeBottomCard: TCard;
function flipTop: TCard;
function flipBottom: TCard;
function flipCard(c: TCard): TCard;
function flipFromTop(c: TCard): TCard;
function flipFromBottom(c: TCard): TCard;
procedure flipAll;
procedure turnAllFaceUp;
procedure turnAllFaceDown;
function getTopCard: TCard;
function getBottomCard: TCard;
function getCardAt(n: integer): TCard;
procedure clear;
procedure make52; overload;
procedure make52(faceUp: boolean); overload;
procedure Extract(p: TPile; l,h: integer);
procedure Shuffle;
procedure SortValue;
procedure SortSuit;
end;
TCTable=class
private
Piles: TList;
onMove: TPile;
procedure startMoving(p: TPile);
procedure stopMoving;
public
constructor create;
destructor free;
procedure addPile(p: TPile);
procedure removePile(p: TPile);
procedure clear;
procedure Refresh;
procedure GetPileCardAt(x,y: integer;
var Pile: TPile; var Card: TCard);
end;
var CTable: TCTable;
implementation
uses gui, Cardfkt;
constructor TCard.create(aSuit: TCSuit; aValue: integer;
aFaceUp: boolean);
begin
suit:=aSuit;
value:=aValue;
faceUp:=aFaceUp;
myPile:=nil;
end;
procedure TCard.setMyPile(p: TPile);
begin
myPile:=p;
end;
function TCard.getColor: TCColor;
begin
if (suit=SPADE) or (suit=CLUB) then Result:=BLACK
else Result:=RED;
end;
function TCard.getSuit: TCSuit;
begin
Result:= suit;
end;
function TCard.getValue: integer;
begin
Result:= value;
end;
function TCard.getCardNr: integer;
begin
if faceUp then Result:= (3-ord(suit))+(value-1)*4
else Result:= -1;
end;
procedure TCard.TurnFaceUp;
begin
faceUp:=true;
if myPile<>nil then myPile.refresh;
end;
procedure TCard.TurnFaceDown;
begin
faceUp:=false;
if myPile<>nil then myPile.refresh;
end;
procedure TCard.flip;
begin
faceUp:=not faceUp;
if myPile<>nil then myPile.refresh;
end;
procedure TCard.select;
begin
selected:=true;
if myPile<>nil then myPile.refresh;
end;
procedure TCard.deSelect;
begin
selected:=false;
if myPile<>nil then myPile.refresh;
end;
function TCard.isSelected: boolean;
begin
Result:= selected;
end;
function TCard.hasFaceUp: boolean;
begin
Result:= faceUp;
end;
function TCard.getCardHeight: integer;
begin
Result:= cardHeight;
end;
function TCard.getCardWidth: integer;
begin
Result:= cardWidth;
end;
constructor TPile.create(ax,ay,adx,ady: integer);
begin
>>>>>>>> x:=ax;
y:=ay;
minAntal:=0;
maxAntal:=52;
dx:=adx;
dy:=ady;
LockRefresh:=false;
PrevCount:=0;
EmptyPileType:=0;
IsVisible:=false;
Cards:=TList.Create;
end;
destructor TPile.free;
begin
Clear;
end;
procedure TPile.clear;
begin
while cards.count>0 do
begin
TCard(cards[0]).free; // frigiv kortet
cards.delete(0); // slet fra listen
end;
refresh;
end;
procedure TPile.SetEmptyPileShow(aType: integer);
begin
EmptyPileType:=aType;
end;
procedure TPile.MoveTo(ax,ay: integer);
begin
x:=ax;
y:=ay;
refresh;
end;
function TPile.getX: integer;
begin
Result:= x;
end;
function TPile.getY: integer;
begin
Result:= y;
end;
function TPile.getCardX(c: TCard): integer;
begin
if c=nil then Result:= x
else Result:= x+cards.indexOf(c)*dx;
end;
function TPile.getCardY(c: TCard): integer;
begin
if c=nil then Result:= y
else Result:= y+cards.indexOf(c)*dy;
end;
function TPile.HFillRect: TRect;
var w: integer;
begin
w:=cardWidth; if dx<0 then w:=0;
Result.Left:=x+(Cards.Count-1)*dx+w;
Result.Right:=x+(PrevCount-1)*dx+w;
Result.Top:=y+(PrevCount-1)*dy;
Result.Bottom:=Result.Top+CardHeight;
end;
function TPile.VFillRect: TRect;
var h: integer;
begin
h:=cardHeight; if dy<0 then h:=0;
Result.Left:=x+(PrevCount-1)*dx;
Result.Right:=Result.Left+CardWidth;
Result.Top:=y+(PrevCount-1)*dy+h;
Result.Bottom:=y+(Cards.Count-1)*dy+h;
end;
procedure TPile.setMinAntal(min: integer);
begin
minAntal:=min;
end;
procedure TPile.setMaxAntal(max: integer);
begin
maxAntal:=max;
end;
function TPile.isEmpty: boolean;
begin
Result:= cards.Count=0;
end;
function TPile.getSize: integer;
begin
Result:= cards.Count;
end;
function TPile.getIndex(c: TCard): integer;
begin
Result:= cards.indexOf(c);
end;
function TPile.Find(suit: TCSuit; value: integer): TCard;
var c: TCard; i: integer;
begin
Result:= nil;
for i:=0 to cards.count-1 do
begin
c:=TCard(cards.items[i]);
if (c.getSuit=suit) and (c.getValue=value) then
begin Result:= c; break end;
end;
end;
procedure TPile.insertAtTop(c: TCard);
begin
if c<>nil then
begin cards.add(c);
c.setMyPile(self);
refresh;
end;
end;
procedure TPile.insertAtBottom(c: TCard);
begin
if c<>nil then
begin cards.insert(0,c);
c.setMyPile(self);
refresh;
end;
end;
procedure TPile.insertAbove(c0,c: TCard);
var i: integer;
begin
i:=cards.IndexOf(c0);
if (c<>nil) and (i>=0) then
begin cards.insert(i+1,c);
c.setMyPile(self);
refresh;
end;
end;
procedure TPile.insertBelow(c0,c: TCard);
var i: integer;
begin
i:=cards.indexOf(c0);
if (c<>nil) and (i>=0) then
begin cards.insert(i,c);
c.setMyPile(self);
refresh;
end;
end;
procedure TPile.insertAt(Index: integer; c: TCard);
begin
if (index<cards.Count) and (index>=0) then
begin
cards.insert(index,c);
c.setMyPile(self);
refresh;
end;
end;
function TPile.removeCard(c: TCard): TCard;
begin
cards.remove(c);
c.setMyPile(nil);
refresh;
Result:= c;
end;
function TPile.removeCardAt(n: integer): TCard;
var c: TCard;
begin
if (n>=0) and (n<cards.Count) then
begin
c:=Cards.items[n];
Cards.delete(n);
c.setMyPile(nil);
refresh;
Result:= c;
end
else Result:= nil;
end;
function TPile.removeTopCard: TCard;
var c: TCard;
begin
c:=cards.Items[Cards.Count-1];
cards.remove(c);
c.setMyPile(nil);
refresh;
Result:= c;
end;
function TPile.removeBottomCard: TCard;
var c: TCard;
begin
c:=cards.Items[0];
cards.remove(c);
c.setMyPile(nil);
refresh;
Result:= c;
end;
function TPile.flipTop: TCard;
var c: TCard;
begin
c:=cards.Items[Cards.Count-1];
c.flip;
refresh;
Result:= c;
end;
function TPile.flipBottom: TCard;
var c: TCard;
begin
c:=cards.Items[0];
c.flip;
refresh;
Result:= c;
end;
function TPile.flipCard(c: TCard): TCard;
begin
c.flip;
refresh;
Result:= c;
end;
function TPile.flipFromTop(c: TCard): TCard;
var i: integer;
begin
LockRefresh:=true;
for i:=cards.indexOf(c) to cards.Count-1 do
TCard(cards.Items[i]).flip;
LockRefresh:=false;
refresh;
Result:= c;
end;
function TPile.flipFromBottom(c: TCard): TCard;
var i: integer;
begin
LockRefresh:=true;
for i:=cards.indexOf(c) downto 0 do
TCard(cards.Items[i]).flip;
LockRefresh:=false;
refresh;
Result:= c;
end;
procedure TPile.flipAll;
var i: integer;
begin
LockRefresh:=true;
for i:=cards.count-1 downto 0 do
TCard(cards.Items[i]).flip;
LockRefresh:=false;
refresh;
end;
procedure TPile.turnAllFaceUp;
var i: integer;
begin
LockRefresh:=true;
for i:=cards.count-1 downto 0 do
TCard(cards.Items[i]).turnFaceUp;
LockRefresh:=false;
refresh;
end;
procedure TPile.turnAllFaceDown;
var i: integer;
begin
LockRefresh:=true;
for i:=cards.count-1 downto 0 do
TCard(cards.Items[i]).turnFaceDown;
LockRefresh:=false;
refresh;
end;
function TPile.getTopCard: TCard;
begin
if (cards.Count=0) then Result:= nil
else Result:= cards.Items[Cards.Count-1];
end;
function TPile.getBottomCard: TCard;
begin
if cards.count=0 then Result:= nil
else Result:=cards.Items[0];
end;
function TPile.getCardAt(n: integer): TCard;
begin
if (0<=n) and (n<cards.count) then Result:= Cards.Items[n]
else Result:= nil;
end;
procedure TPile.make52;
begin
make52(true);
end;
procedure TPile.make52(faceUp: boolean);
var suit: TCSuit; value: integer; c: TCard;
begin
LockRefresh:=true;
cards.Clear;
for suit:=SPADE to CLUB do
for value:=1 to 13 do
begin
c:=TCard.Create(suit,value,faceUp);
insertAtTop(c);
end;
LockRefresh:=false;
refresh;
end;
procedure TPile.Extract(p: TPile; l,h: integer);
var n: integer;
begin
if (l<0) or (h>=p.Cards.count) or (l>h) then exit;
LockRefresh:=true;
if p=self then
begin
for n:=0 to l-1 do removeBottomCard;
while Cards.Count>h-l+1 do removeTopCard;
end
else
begin
cards.clear;
for n:=l to h do
insertAtTop(p.removeCardAt(l));
end;
LockRefresh:=false;
refresh;
end;
procedure TPile.Shuffle;
var i,n1,n2: integer;
begin
for i:=0 to 5*cards.Count do
begin
n1:=i mod cards.Count;
n2:=random(Cards.Count);
cards.Exchange(n1,n2);
end;
refresh;
end;
procedure TPile.SortValue;
var i,j,min: integer;
function Compare(n1,n2: integer): integer;
begin
if GetCardAt(n1).value<GetCardAt(n2).value then Result:=-1
else
if GetCardAt(n1).value>GetCardAt(n2).value then Result:=1
else
begin
if GetCardAt(n1).suit<GetCardAt(n2).suit then Result:=-1
else
if GetCardAt(n1).suit>GetCardAt(n2).suit then Result:=1
else Result:=0
end
end;
begin
for i:=0 to Cards.Count-1 do
begin
min:=i;
for j:=i+1 to Cards.count-1 do
if Compare(j,min)=-1 then min:=j;
Cards.Exchange(i,min);
end;
Refresh;
end;
procedure TPile.SortSuit;
var i,j,min: integer;
function Compare(n1,n2: integer): integer;
begin
if GetCardAt(n1).suit<GetCardAt(n2).suit then Result:=-1
else
if GetCardAt(n1).suit>GetCardAt(n2).suit then Result:=1
else
begin
if GetCardAt(n1).value<GetCardAt(n2).value then Result:=-1
else
if GetCardAt(n1).value>GetCardAt(n2).value then Result:=1
else Result:=0
end
end;
begin
for i:=0 to Cards.Count-1 do
begin
min:=i;
for j:=i+1 to Cards.count-1 do
if Compare(j,min)=-1 then min:=j;
Cards.Exchange(i,min);
end;
Refresh;
end;
procedure TPile.refresh;
var i: integer; c: TCard;
begin
if LockRefresh or not IsVisible then exit;
if Cards.Count<PrevCount then
begin
FrmBord.EraseRect(HFillRect,VFillRect);
end;
if Cards.Count=0 then
DrawEmptyPile
else
for i:=0 to Cards.Count-1 do
begin
c:=Cards[i];
if c.faceUp then
begin
if c.isSelected then
FrmBord.CardDrawInverted(x+dx*i,y+dy*i,c.getCardNr)
else
begin
FrmBord.CardDraw(x+dx*i,y+dy*i,c.getCardNr);
end
end
else
FrmBord.BackDraw(x+dx*i,y+dy*i,0);
end;
PrevCount:=Cards.Count;
end;
procedure TPile.DrawEmptyPile;
begin
FrmBord.DrawEmptyPile(EmptyPileType,x,y);
end;
function TPile.xyInCard(x,y: integer): TCard;
var c: TCard; i,cx,cy: integer;
begin
Result:= nil;
for i:=cards.Count-1 downto 0 do
begin
c:=cards.Items[i];
cx:=getCardX(c);
cy:=getCardY(c);
if (cx<=x) and (x<=cx+CardWidth) and
(cy<=y) and (y<=cy+CardHeight) then
begin
Result:= c;
break
end
end;
end;
constructor TCTable.create;
begin
Piles:=TList.Create;
onMove:=nil;
end;
destructor TCTable.free;
begin
clear;
end;
procedure TCTable.addPile(p: TPile);
begin
if p=nil then exit;
Piles.add(p);
p.IsVisible:=true;
p.refresh;
end;
procedure TCTable.removePile(p: TPile);
begin
Piles.remove(p);
p.IsVisible:=false;
FrmBord.Invalidate;
end;
procedure TCTable.clear;
begin
while Piles.Count>0 do
begin
TPile(Piles[0]).free; // frigiv bunken
Piles.delete(0);
end;
FrmBord.invalidate;
end;
procedure TCTable.startMoving(p: TPile);
begin
onMove:=p;
end;
procedure TCTable.stopMoving;
begin
onMove:=nil;
end;
procedure TCTable.Refresh;
var i: integer;
begin
for i:=0 to Piles.Count-1 do
TPile(Piles[i]).Refresh;
end;
procedure TCTable.GetPileCardAt(x,y: integer;
var Pile: TPile; var Card: TCard);
var n,m: integer;
ok1,ok2,ok3,ok4: boolean;
function HiddenCard(n,x,y: integer): boolean;
var i,j,xc,yc: integer; p: TPile;
begin
Result:=false;
for i:=n+1 to Piles.Count-1 do
begin
p:=Piles[i];
for j:=0 to p.cards.count-1 do
begin
xc:=p.x+j*p.dx; yc:=p.y+j*p.dy;
if ((xc<x) and (x<xc+CardWidth) and
(yc<y) and (y<yc+CardHeight)) or
((xc<x+CardWidth) and (x+CardWidth<xc+CardWidth) and
(yc<y) and (y<yc+CardHeight)) or
((xc<x) and (x<xc+CardWidth) and
(yc<y+CardHeight) and (y+CardHeight<yc+CardHeight)) or
((xc<x+CardWidth) and (x+CardWidth<xc+CardWidth) and
(yc<y+CardHeight) and (y+CardHeight<yc+CardHeight)) then
begin
Result:=true;
exit;
end
end
end
end;
begin
Card:=nil;
for n:=Piles.Count-1 downto 0 do
begin
Pile:=TPile(Piles[n]);
for m:=Pile.Cards.Count-1 downto 0 do
begin
Card:=Pile.xyInCard(x,y);
if Card<>nil then
begin
if not HiddenCard(n,Pile.getCardX(Card),Pile.getCardY(Card)) then
exit;
break;
end
end;
if (Pile.x<=x) and (x<=Pile.x+CardWidth) and
(Pile.y<=y) and (y<=Pile.y+CardHeight) then
begin
if not HiddenCard(n,Pile.x,Pile.y) then
exit;
end
end;
Card:=nil; Pile:=nil;
end;
initialization
CTable:=TCTable.create;
end.
---------------
OG DENNE
---------------
unit cardfkt;
interface
uses graphics, windows;
procedure _CardInit(var w,h: integer);
procedure _CardDone;
procedure _CardDraw(ACanvas: TCanvas; x,y: SmallInt; CardNo: SmallInt);
procedure _CardDrawInverted(ACanvas: TCanvas; x,y: SmallInt; CardNo: SmallInt);
procedure _BackDraw(ACanvas: TCanvas; x,y: SmallInt; BackNo: SmallInt);
procedure _CardDrawExt(ACanvas: TCanvas; x,y: SmallInt; w,h: SmallInt; CardNo: SmallInt);
var CardWidth, CardHeight: integer;
implementation
const dllFName='cards32.dll';
type pinteger=^integer;
procedure ehCardInit(pw,ph: pInteger); stdcall;
external dllFName name 'cdtInit';
procedure ehCardDone; stdcall;
external dllFName name 'cdtTerm';
procedure ehCardDraw(Hnd: THandle; destX,destY,cardno,mode: integer;
rgbBgnd: longint); stdcall;
external dllFName name 'cdtDraw';
procedure ehCardDrawExt(Hnd: THandle; destX,destY,w,h: integer; cardno,mode: integer;
rgbBgnd: longint); stdcall;
external dllFName name 'cdtDrawExt';
procedure _CardInit(var w,h: integer);
var pw,ph: pinteger;
begin
pw:=new(pinteger);
ph:=new(pinteger);
ehCardInit(pw,ph);
w:=pw^; h:=ph^;
end;
procedure _CardDone;
begin
ehCardDone
end;
procedure _CardDraw(ACanvas: TCanvas; x,y: SmallInt; CardNo: SmallInt);
begin
ehCardDraw(ACanvas.Handle,x,y,CardNo,0,0{ColorToRGB(ACanvas.Brush.Color)});
end;
procedure _CardDrawInverted(ACanvas: TCanvas; x,y: SmallInt; CardNo: SmallInt);
begin
ehCardDraw(ACanvas.Handle,x,y,CardNo,2,clWhite);
end;
procedure _BackDraw(ACanvas: TCanvas; x,y: SmallInt; BackNo: SmallInt);
begin
ehCardDraw(ACanvas.Handle,x,y,BackNo+54,1,0{ColorToRGB(ACanvas.Brush.Color)});
end;
procedure _CardDrawExt(ACanvas: TCanvas; x,y: SmallInt; w,h: SmallInt; CardNo: SmallInt);
begin
ehCardDrawExt(ACanvas.Handle,x,y,w,h,CardNo,0,0);
end;
initialization
randomize;
_CardInit(CardWidth,CardHeight);
finalization
_CardDone;
end.