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.