Avatar billede jakob/cosmo Nybegynder
08. februar 2002 - 19:10 Der er 4 kommentarer og
1 løsning

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.
Avatar billede -simon- Nybegynder
08. februar 2002 - 19:14 #1
det var fa***** et langt spm :)
Avatar billede jakob/cosmo Nybegynder
08. februar 2002 - 19:16 #2
ups underlige tegn:
&#61516;= :-(

&#8217;= >>>>>'erne og unit'er

jaaaaa Hjæææææææælp

hvis i vil have mere kan det også laves!!!!!!!
Avatar billede jakob/cosmo Nybegynder
08. februar 2002 - 19:21 #3
det er alså denne jeg får fejl i
constructor TPile.create(ax,ay,adx,ady: integer);
  begin
    x:=ax;<<<<<<<<<<<<<<<<<<<<<<<<<denne linie er blå<<<<<<<<<<<<<<
    y:=ay;
    minAntal:=0;
    maxAntal:=52;
    dx:=adx;
    dy:=ady;
    LockRefresh:=false;
    PrevCount:=0;
    EmptyPileType:=0;
    IsVisible:=false;

    Cards:=TList.Create;
  end;
Avatar billede xs2k Nybegynder
09. februar 2002 - 13:47 #4
under NewGame skal du ikke skrive

p1.create(20,20,0,0);

men

p1 := TPile.Create(20, 20, 0, 0);
Avatar billede jakob/cosmo Nybegynder
09. februar 2002 - 15:08 #5
Mange Tak xs2k men jeg kan heller ikke få min mousedown til at virke hvis den er dette skulle den vise en message hvis man trykker på p1:

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
    if Pile=p1 then
    begin
        ShowMessage('hej');
    end;
  end;
end;
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester