![]() |
Re: Doppelkopf-Projekt
Liste der Anhänge anzeigen (Anzahl: 2)
Mittlerweile hab' ich mich mal wieder rangemacht und Phase zwei abgeschlossen.
Für Verbesserungen bin ich jederzeit offen... :wink:
Delphi-Quellcode:
Nun sind dran:
unit Unit1;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, StdCtrls, Buttons, jpeg, ExtCtrls, ComCtrls, Spin,ShellApi, mmsystem ; type Tformdoppelkopf = class(TForm) gridspieler1: TStringGrid; gridspieler2: TStringGrid; gridspieler3: TStringGrid; gridspieler4: TStringGrid; btaus: TBitBtn; btgebe: TBitBtn; logo_w: TImage; Chatfenster: TMemo; Edit1: TEdit; btKommentar: TButton; btchat: TButton; btregeln: TButton; OpenDlg: TOpenDialog; laspieler4: TLabel; laspieler3: TLabel; laspieler2: TLabel; Button1: TButton; Label1: TLabel; btvorbehalte: TButton; Label2: TLabel; gridstich: TStringGrid; lastich: TLabel; Panel1: TPanel; btsauen: TButton; bthochzeit: TButton; btsieg: TButton; btkeine9: TButton; bt5neun: TButton; btarmut: TButton; btschweine: TButton; btkeinenv: TButton; btheimlichen: TButton; btstrich: TButton; btkoenig: TButton; btsonssoli: TButton; trumpfanzahl: TLabel; rregeln: TRichEdit; Image1: TImage; BitBtn1: TBitBtn; laarmut: TLabel; Label3: TLabel; Label4: TLabel; btgrid1enabled: TButton; Label5: TLabel; Kartenaufnahme: TButton; procedure btausClick(Sender: TObject); procedure btgebeClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure gridspieler1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure gridspieler2DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure gridspieler3DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure gridspieler4DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure btchatClick(Sender: TObject); procedure btKommentarClick(Sender: TObject); procedure btregelnClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure Button1Click(Sender: TObject); procedure btvorbehalteClick(Sender: TObject); procedure gridspieler1Click(Sender: TObject); procedure btschweineClick(Sender: TObject); procedure btsiegClick(Sender: TObject); procedure btsauenClick(Sender: TObject); procedure btheimlichenClick(Sender: TObject); procedure btsonssoliClick(Sender: TObject); procedure btkoenigClick(Sender: TObject); procedure btkeinenvClick(Sender: TObject); procedure bthochzeitClick(Sender: TObject); procedure btarmutClick(Sender: TObject); procedure btstrichClick(Sender: TObject); procedure bt5neunClick(Sender: TObject); procedure btkeine9Click(Sender: TObject); procedure btgrid1enabledClick(Sender: TObject); procedure gridstichDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure KartenaufnahmeClick(Sender: TObject); private procedure geben; procedure wimageload; procedure sreihenfolge; function PosN(Substring, Mainstring: string; n: Integer): Integer; procedure cleangrd(grd:TStringgrid); procedure sortiere(w,s,h,e:integer); procedure textein(txt:string); procedure disabbl(i:integer); public { Public declarations } end; var formdoppelkopf: Tformdoppelkopf; karten:array[0..48] of TBitmap; nummern:array[0..48]of Integer; spieler1:array[0..11] of Integer; spieler2:array[0..11] of Integer; spieler3:array[0..11] of Integer; spieler4:array[0..11] of Integer; arstich:array[0..3] of Integer; arar: array[0..2] of Integer; schweine1, supers1,hochzeit1,armut,neun, gekarten, //wieviele Karten gespielt wurden ansa, //für keine 9, Anzahl der angesagten "Limits" other,//ob Karten gegben worden sind poskr, //ob ne kreuzdame vorhanden ist, und wenn ja wo (w/w+1) zstd, // ob Regeln angezeigt werden oder nich dransein,wr1,wr2,wr3,wr4, //für die Reihenfolge der Spieler trumpf, //Anzahl der Trümpfe anzahl, vorbehaltclick, siegja:integer; //Anzahl der gespielten Karten timeto:string; // Spielbeginn const LF = #43#10; // LF steht für LineFeed implementation {$R *.dfm} { Sounds: sndPlaySound(PChar('C:\Datei.wav'),SND_SYNC); SND_SYNC = Während die Datei abgespielt wird, steht die Anwendung SND_ASYNC = Die Datei wird unabhängig vom Programm abgespielt. SND_LOOP = Immer wieder und immer wieder sndPlaySound(nil,0);} procedure Tformdoppelkopf.FormCreate(Sender: TObject); var w:integer; begin timeto:=(timetostr(now)); textein('Spielbeginn: ' + timeto); for w:=0 to 48 do nummern[w]:=w; wimageload; cleangrd(gridspieler1); cleangrd(gridspieler2); cleangrd(gridspieler3); cleangrd(gridspieler4); cleangrd(gridstich); end; procedure Tformdoppelkopf.textein(txt:string); var MemoText : String; begin MemoText:=chatfenster.Text; Insert(Slinebreak +txt, MemoText, +38); chatfenster.Text:=MemoText; end; procedure TFormdoppelkopf.sortiere(w,s,h,e:integer); var x,y,q:integer; begin if h=1 then begin if s=1 then begin for x:=0 to 10 do if spieler1[x]=w then begin spieler1[x]:=spieler1[x+1]; spieler1[x+1]:=w; end; end; end; if h=0 then begin for x:=0 to 10 do begin for q:=x+1 to 11 do begin if ((spieler1[q])<(spieler1[x])) then begin y:=spieler1[x]; spieler1[x]:=spieler1[q]; spieler1[q]:=y; end; end; end; end; gridspieler1.Refresh; end; procedure TFormdoppelkopf.cleangrd(grd:TStringgrid); var grdRec:TGridRect; begin with grdRec do begin Top:=-1; Left:=-1; Right:=-1; Bottom:=-1; end; grd.Selection:=grdRec; end; procedure TFormdoppelkopf.sreihenfolge; begin if wr1=4 then wr1:=1 else wr1:=wr1+1; if wr2=4 then wr1:=1 else wr2:=wr2+1; if wr3=4 then wr1:=1 else wr3:=wr3+1; if wr4=4 then wr1:=1 else wr4:=wr4+1; if wr1=4 then dransein:=1 else dransein:=wr1+1; end; procedure Tformdoppelkopf.geben; var w,i,x,j:integer; begin for w:=0 to 11 do begin spieler1[w]:=48; spieler2[w]:=48; spieler3[w]:=48; spieler4[w]:=48; end; chatfenster.Clear; chatfenster.Lines.Add('Chatfenster'); chatfenster.Lines.Add('Spielbeginn: '+(timeto)); Randomize; for i:= 0 to 47 do begin j:=Random(47); X:=nummern[i] ; nummern[i]:= nummern[j]; nummern[j]:=x; end; { spieler1[0]:=1; // 22 spieler1[1]:=2; //23 spieler1[2]:=3; //28 spieler1[3]:=4; //29 spieler1[4]:=5; //40 spieler1[5]:=6; //41 spieler1[6]:=7; //42 spieler1[7]:=12; //43 spieler1[8]:=13; //44 spieler1[9]:=45; // 45 spieler1[10]:=46; // 46 spieler1[11]:=47; //47 } for i:=0 to 11 do begin spieler1[i]:=nummern[i]; spieler2[i]:=nummern[i+12]; spieler3[i]:=nummern[i+24]; spieler4[i]:=nummern[i+36]; end; for i:=0 to 10 do begin for j:=i+1 to 11 do begin if spieler1[j] < spieler1[i] then begin x:=spieler1[i]; spieler1[i]:=spieler1[j]; spieler1[j]:=x; end; if spieler2[j] < spieler2[i] then begin x:=spieler2[i]; spieler2[i]:=spieler2[j]; spieler2[j]:=x; end; if spieler3[j] < spieler3[i] then begin x:=spieler3[i]; spieler3[i]:=spieler3[j]; spieler3[j]:=x; end; if spieler4[j] < spieler4[i] then begin x:=spieler4[i]; spieler4[i]:=spieler4[j]; spieler4[j]:=x; end; end; end; other:=1; gridspieler1.Refresh; gridspieler2.Refresh; gridspieler3.Refresh; gridspieler4.Refresh; end; procedure Tformdoppelkopf.btausClick(Sender: TObject); begin //MessageDlg('Copyright © 2006 by tankm26', mtCustom, [mbOK], 0); close; end; procedure Tformdoppelkopf.btgebeClick(Sender: TObject); begin arstich[0]:=nummern[48]; arstich[1]:=nummern[48]; arstich[2]:=nummern[48]; arstich[3]:=nummern[48]; btschweine.Visible:=true; siegja:=0; anzahl:=0; label5.Caption:=IntToStr(anzahl); gekarten:=0; zstd:=0; other:=0; ansa:=0; gekarten:=0; geben; vorbehaltclick:=0; btvorbehalte.Enabled:=true; gridspieler1.Enabled:=true; gridstich.Refresh; end; procedure Tformdoppelkopf.btvorbehalteClick(Sender: TObject); var w:integer; begin trumpf:=0; neun:=0; hochzeit1:=0; schweine1:=0; supers1:=0; disabbl(0); if vorbehaltclick=0 then begin for w:=0 to 11 do begin if spieler1[w]>21 then begin //Trümpfe zählen trumpf:=trumpf+1; label2.Caption:=IntToStr(trumpf); end; //if trumpf=2 then arstich[2]:=11; if spieler1[w]=0 then neun:=1; if spieler1[w]=1 then neun:=neun+1; //herz 9 if spieler1[w]=6 then neun:=neun+1; if spieler1[w]=7 then neun:=neun+1; //pik 9 if spieler1[w]=14 then neun:=neun+1; if spieler1[w]=15 then neun:=neun+1; //kreuz 9 if spieler1[w]=22 then neun:=neun+1; if spieler1[w]=23 then neun:=neun+1; //karo 9 if (spieler1[w]=44) and (spieler1[w+1]=45)then hochzeit1:=1; //Hochzeit if ((spieler1[w]=44) or (spieler1[w]=45)) then poskr:=w; //Kreuzdame if (spieler1[w]= 28)and(spieler1[w+1]= 29) then schweine1:=1; //Schweine if schweine1=1 then if ((spieler1[w]= 22)and(spieler1[w+1]= 23))then supers1:=1; //(Super-)sauen if gekarten=0 then begin if spieler1[11]<29 then btstrich.Enabled:=true; // unterm Strich if (neun>4) then bt5neun.Enabled:=true; // Neunen if armut=1 then btarmut.Enabled:=true; //Armut if schweine1=1 then btschweine.Enabled:=true; //Schweine if ((btschweine.Enabled=true) and (supers1=1)) then btsauen.Enabled:=true; //(Super-)sauen if hochzeit1=1 then begin bthochzeit.Enabled:=true; btheimlichen.Enabled:=true; // Hochzeit end else begin bthochzeit.Enabled:=false; // Hz btheimlichen.Enabled:=false; end; // Hz if trumpf<4 then begin armut:=1; btarmut.Enabled:=true; end; if trumpf>3 then begin armut:=0; btarmut.Enabled:=false; end; label1.Caption:=IntToStr(armut); vorbehaltclick:=1; end; end; // for w:=0 to... - end end; // vorbehaltclick - end if (gekarten=4) then begin label1.Visible:=false; if poskr>0 then btsieg.Caption:=('Re!') else btsieg.Caption:=('Kontra!'); if not (laspieler2.Caption=('Spieler 2 - Gegner')) then btsieg.Enabled:=true; end; end; procedure Tformdoppelkopf.gridspieler1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var w:integer; begin for w:=0 to 47 do if other= 1 then begin if spieler1[Acol]=w then gridspieler1.Canvas.Draw(rect.left, rect.top, Karten[w]); end else cleangrd(gridspieler1); end; procedure Tformdoppelkopf.gridspieler2DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin if other= 1 then gridspieler2.Canvas.Draw(rect.left, rect.top, Karten[48]); end; procedure Tformdoppelkopf.gridspieler3DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin if other= 1 then gridspieler3.Canvas.Draw(rect.left, rect.top, Karten[48]); end; procedure Tformdoppelkopf.gridspieler4DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin if other= 1 then gridspieler4.Canvas.Draw(rect.left, rect.top, Karten[48]); end; procedure Tformdoppelkopf.btchatClick(Sender: TObject); begin if not (edit1.Text=('')) then begin chatfenster.Lines.Add('C: ' + edit1.text); chatfenster.Perform(WM_VSCROLL, SB_BOTTOM, 0); edit1.Clear; end; end; procedure Tformdoppelkopf.btKommentarClick(Sender: TObject); begin if not (edit1.Text=('')) then begin chatfenster.Lines.Add('K: ' + edit1.text); edit1.Clear; end; end; procedure Tformdoppelkopf.btregelnClick(Sender: TObject); begin rregeln.Clear; if zstd=0 then begin rregeln.Visible:=true; btregeln.Caption:=('Genug!'); if OpenDlg.Execute then rregeln.Lines.LoadFromFile(OpenDlg.FileName); //rregeln.Lines.LoadFromFile(...\'01_dokoordnung'); zstd:=1; end else begin btregeln.Caption:=('Regeln!'); rregeln.Visible:=false; zstd:=0; end; end; procedure Tformdoppelkopf.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose:= MessageDlg('Wirklich beenden?', mtConfirmation, [mbyes,mbno], 0) = mrYes; end; procedure Tformdoppelkopf.Button1Click(Sender: TObject); var MemoText : String; Text : String; begin MemoText := chatfenster.Text; Text := 'Das ist ein Test'; Insert(Text +Slinebreak, MemoText, +37); chatfenster.Text := MemoText; end; function Tformdoppelkopf.PosN(Substring, Mainstring: string; n: Integer): Integer; // Funktion zum Suchen ob ein Zeichen im String enthalten ist begin // if Pos(substring, mainstring) = 0 then begin // posn := 0; // Exit; // end else begin // if n = 1 then posn := Pos(substring, mainstring) // else begin // posn := Pos(substring, mainstring) + posn(substring, Copy(mainstring, // (Pos(substring, mainstring) + 1), Length(mainstring)), n - 1); // end; // end; // end; procedure Tformdoppelkopf.gridspieler1Click(Sender: TObject); begin gekarten:=gekarten+1; label3.CAption:=IntToStr (gekarten); if anzahl=0 then begin arstich[0]:=spieler1[gridspieler1.Col]; spieler1[gridspieler1.Col]:=nummern[48]; arstich[1]:=nummern[48]; arstich[2]:=nummern[48]; arstich[3]:=nummern[48]; end; if anzahl=1 then begin arstich[1]:=spieler1[gridspieler1.Col]; spieler1[gridspieler1.Col]:=nummern[48]; arstich[2]:=nummern[48]; arstich[3]:=nummern[48]; end; if anzahl=2 then begin arstich[2]:=spieler1[gridspieler1.Col]; spieler1[gridspieler1.Col]:=nummern[48]; arstich[3]:=nummern[48]; end; if anzahl=3 then begin arstich[3]:=spieler1[gridspieler1.Col]; spieler1[gridspieler1.Col]:=nummern[48]; end; anzahl:=anzahl+1; label5.Caption:=IntToStr(anzahl); sortiere(48,1,1,0); gridstich.Refresh; gridspieler1.Refresh; end; procedure Tformdoppelkopf.btschweineClick(Sender: TObject); begin sortiere(28,1,1,0); sortiere(29,1,1,0); btschweine.Visible:=false; textein('A: Spieler 1 hat Schweine!'); btsauen.Enabled:=true; end; procedure Tformdoppelkopf.btsiegClick(Sender: TObject); begin siegja:=1; if btsieg.Caption=('Re!') then textein('A: Spieler 1 sagt Re!'); if btsieg.Caption=('Kontra!') then textein('A: Spieler 1 sagt Kontra!'); btsieg.Enabled:=false; btkeine9.Enabled:=true; bthochzeit.Enabled:=false; btheimlichen.Enabled:=false; end; procedure Tformdoppelkopf.btsauenClick(Sender: TObject); begin sortiere(22,1,1,0); sortiere(23,1,1,0); btsauen.Enabled:=false; textein('A: Spieler 1 hat Superschweine!'); end; procedure Tformdoppelkopf.btheimlichenClick(Sender: TObject); begin textein('(A): Ich spiele einen Heimlichen'); bthochzeit.Enabled:=false; btheimlichen.Enabled:=false; btsieg.Enabled:=false; laspieler2.Caption:=('Spieler 2 - Gegner'); laspieler3.Caption:=('Spieler 3 - Gegner'); laspieler4.Caption:=('Spieler 4 - Gegner'); end; procedure Tformdoppelkopf.btsonssoliClick(Sender: TObject); begin showmessage('Geben Sie dem Programmierer nur 3.000€ für XXL-Version des Programms - und dann gehts'); end; procedure Tformdoppelkopf.btkoenigClick(Sender: TObject); begin showmessage('Das geht nich! Wir sind hier nich bei Maxens!'); end; procedure Tformdoppelkopf.btkeinenvClick(Sender: TObject); begin if not (btheimlichen.Enabled=true) then begin panel1.Visible:=false; disabbl(1); end else showmessage('Entscheiden Sie sich gefälligst zwischen einem "Heimlichen" und der "Hochzeit"'); end; procedure Tformdoppelkopf.bthochzeitClick(Sender: TObject); begin textein('A: ' + 'Spieler 1 hat ne Hochzeit!'); bthochzeit.Enabled:=false; btheimlichen.Enabled:=false; end; procedure Tformdoppelkopf.disabbl; begin if i=0 then begin btschweine.Enabled:=false; btsieg.Enabled:=false; btkeine9.Enabled:=false; btstrich.Enabled:=false; btheimlichen.Enabled:=false; bthochzeit.Enabled:=false; btarmut.Enabled:=false; bt5neun.Enabled:=false; btaus.Enabled:=false; btvorbehalte.Enabled:=false; btgebe.Enabled:=false; gridspieler1.Enabled:=false; gridspieler2.Enabled:=false; gridspieler3.Enabled:=false; gridspieler4.Enabled:=false; panel1.Visible:=true; end; if i=1 then begin btaus.Enabled:=true; btvorbehalte.Enabled:=true; btgebe.Enabled:=true; gridspieler1.Enabled:=true; gridspieler2.Enabled:=true; gridspieler3.Enabled:=true; gridspieler4.Enabled:=true; panel1.Visible:=false; end; end; procedure Tformdoppelkopf.btarmutClick(Sender: TObject); begin if poskr>1 then textein('Spieler 1 ist arm - mit') else textein('Spieler 1 ist arm - ohne'); btarmut.Enabled:=false; end; procedure Tformdoppelkopf.btstrichClick(Sender: TObject); begin textein('Es wird neugegeben, da Spieler1 "unterm Strich ist".'); btstrich.Enabled:=false; end; procedure Tformdoppelkopf.bt5neunClick(Sender: TObject); begin textein('Es wird neugegeben, da Spieler1 mind. fünf Neunen hat.'); bt5neun.Enabled:=false; end; procedure Tformdoppelkopf.btkeine9Click(Sender: TObject); begin if ansa=0 then if btkeine9.Caption=('Keine 9!') then begin btkeine9.Caption:=('Keine 6!'); textein('A: Spieler 1 erreicht mind. 151 Augen.'); end; if ansa=1 then if btkeine9.Caption=('Keine 6!') then begin btkeine9.Caption:=('Keine 3!'); textein('A: Spieler 1 erreicht mind. 181 Augen.'); end; if ansa=2 then if btkeine9.Caption=('Keine 3!') then begin btkeine9.Caption:=('Schwarz!'); textein('A: Spieler 1 erreicht mind. 201 Augen.'); end; if ansa=3 then if btkeine9.Caption=('Schwarz!') then begin textein('A: Spieler 1 bekommt alle Augen.'); btkeine9.Enabled:=false; end; ansa:=ansa+1; end; procedure Tformdoppelkopf.wimageload; var i: integer; begin for i:=0 to 48 do begin karten[i]:=TBitmap.Create; karten[i].LoadFromFile(IntToStr(i)+'.bmp'); end; end; procedure Tformdoppelkopf.btgrid1enabledClick(Sender: TObject); begin if gridspieler1.Enabled=true then begin gridspieler1.Enabled:=false; btgrid1enabled.Caption:=('Enablen'); end else begin gridspieler1.Enabled:=true; btgrid1enabled.Caption:=('Disablen'); end; end; procedure Tformdoppelkopf.gridstichDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var w:integer; begin if other= 1 then begin for w:=0 to 47 do if arstich[Acol]=w then gridstich.Canvas.Draw(rect.left, rect.top, Karten[w]); end else cleangrd(gridspieler1); end ; procedure Tformdoppelkopf.KartenaufnahmeClick(Sender: TObject); begin if anzahl=4 then begin spieler1[8]:=arstich[0]; arstich[0]:=nummern[48]; spieler1[9]:=arstich[1]; arstich[1]:=nummern[48]; spieler1[10]:=arstich[2]; arstich[2]:=nummern[48]; spieler1[11]:=arstich[3]; arstich[3]:=nummern[48]; end; sortiere(0,1,0,0); gridspieler1.Refresh; gridstich.Refresh; end; end. · Bedienen · Stich · Punkte · Sieger . Spielanleitung Bis denn, Wieland |
Re: Doppelkopf-Projekt
Liste der Anhänge anzeigen (Anzahl: 1)
so, ich hab nu einige Verbesserungen vorgenommen, so kann man nun Karten ausspielen (zwar nur eine Runde, aber das wird scho')
|
Re: Doppelkopf-Projekt
wie kann ich diese for-Schleife abbrechen? es soll überprüft werden, ob 'w' in spieler2 enthalten ist.
Delphi-Quellcode:
for s:=0 to 10 do begin
if not spieler2[s]=w then womputerzug(a) else begin if wr2=1 then begin wr3:=2; arstich[0]:=spieler2[s]; arstich[1]:=nummern[48]; arstich[2]:=nummern[48]; arstich[3]:=nummern[48]; hintgr(3); end; if wr2=2 then begin wr3:=3; arstich[1]:=spieler2[s]; hintgr(3); end; if wr2=3 then begin wr3:=4; arstich[2]:=spieler2[s]; hintgr(3); end; if wr2=4 then begin kartenaufnahme.Enabled:=true; arstich[3]:=spieler2[s]; end; spieler2[s]:=nummern[48]; cleangrd(gridspieler2); sortiere(48,1,0,1); gridstich.Refresh; gekarten:=gekarten+1; label3.CAption:=IntToStr (gekarten); end; end; |
Alle Zeitangaben in WEZ +1. Es ist jetzt 20:32 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz