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;
mregeln: TMemo;
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;
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 gridstichDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
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);
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..47]
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;
schweine1, supers1,hochzeit1,armut, neun, trumpfz,gekarten,ansa,
other,poskr,zstd,wr1,wr2,wr3,wr4,dransein,trumpf,chr99: integer;
const LF = #43#10;
// LF steht für LineFeed
implementation
{$R *.dfm}
///const Dateiname = 'C:\boot.ini'; // gibt's ab WinNT
{ 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.sortiere(w,s,h,e:integer);
var x:integer;
begin
if label2.Caption='
w1'
then
for x:=0
to 11
do begin
if spieler1[x]= w
then begin
spieler1[x]:=spieler1[x+1];
spieler1[x+1]:=w;
end;
end;
{var w,kr1,pk1,pk2,hz1,hz2,ka1: integer;
begin
for w:=0 to 8 do begin // Kreuz-Bube nach rechts
if spieler1[w]= 4 then begin
kr1:=1;
spieler1[w]:=spieler1[w+1];
spieler1[w+1]:=4;
end else kr1:=0;
end; //Ende
if spieler1[9]=4 then pk1:=8 else pk1:=9; // Pik-Bube nach rechts
for w:=0 to pk1-1 do begin
if spieler1[w]= 12 then begin
pk2:=1;
spieler1[w]:=spieler1[w+1];
spieler1[w+1]:=12;
end else pk2:=0;
end; //Ende
hz1:=9; // Herz-Bube nach rechts
if kr1=1 then hz1:=hz1-1;
if pk2=1 then hz1:=hz1-1;
for w:=0 to hz1-1 do begin
if spieler1[w]= 20 then begin
hz2:=1;
spieler1[w]:=spieler1[w+1];
spieler1[w+1]:=20;
end else hz2:=0;
end; // Ende
ka1:=9; //Karo-Bube nach rechts
if kr1=1 then ka1:=ka1-1;
if pk2=1 then ka1:=ka1-1;
if hz2=1 then ka1:=ka1-1;
for w:=0 to ka1-1 do begin
if spieler1[w]= 28 then begin
spieler1[w]:=spieler1[w+1];
spieler1[w+1]:=28;
end; // Ende
end;
gridspieler1.Refresh;
end;}
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.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.geben;
var
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: '+(timetostr(now)));
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]:=8;
//43
spieler1[8]:=9;
//44
spieler1[9]:=10;
// 45
spieler1[10]:=11;
// 46
spieler1[11]:=12;
//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
gekarten:=0;
ansa:=0;
geben;
btvorbehalte.Enabled:=true;
gridspieler1.Enabled:=true;
end;
procedure Tformdoppelkopf.btvorbehalteClick(Sender: TObject);
var w:integer;
begin
trumpf:=0; poskr:=0; neun:=0; hochzeit1:=0; schweine1:=0; supers1:=0; trumpfz:=0; armut:=0;
disabbl(0);
//Vorbehalte unsichtbar machen
for w:=0
to 11
do begin
if spieler1[w]>21
then trumpf:=trumpf+1;
//Trümpfe zählen
if trumpfz<4
then armut:=1;
//Armut
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+1]=45))
then poskr:=w;
//Kreuzdame
if (spieler1[w]= 28)
and(spieler1[w+1]= 29)
then schweine1:=1;
//Schweine //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
end;
if (gekarten=4)
then begin
if poskr>0
then btsieg.Caption:=('
Re!')
else
btsieg.Caption:=('
Kontra!');
btsieg.Enabled:=true;
btkeine9.Enabled:=true;
end;
end;
end;
procedure Tformdoppelkopf.FormCreate(Sender: TObject);
var w:integer;
begin
gekarten:=0;
zstd:=0;
other:=0;
for w:=0
to 47
do
nummern[w]:=w;
wimageload;
cleangrd(gridspieler1);
cleangrd(gridspieler2);
cleangrd(gridspieler3);
cleangrd(gridspieler4);
cleangrd(gridstich);
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
mregeln.Clear;
if zstd=0
then begin
mregeln.Visible:=true;
btregeln.Caption:=('
Genug!');
if OpenDlg.Execute
then begin
mregeln.Lines.LoadFromFile(OpenDlg.FileName);
end;
zstd:=1;
end else begin
btregeln.Caption:=('
Regeln!');
mregeln.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;
chr99:=gridspieler1.Col;
gridstich.Refresh;
//gridspieler1.Enabled:=false;
end;
procedure Tformdoppelkopf.gridstichDrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
if other=1
then begin
arstich[0]:=spieler1[chr99];
arstich[1]:=0;
arstich[2]:=0;
arstich[3]:=0;
gridstich.Canvas.Draw(rect.Left, rect.Top, karten[arstich[0]]);
end;
end;
procedure Tformdoppelkopf.btschweineClick(Sender: TObject);
var
MemoText :
String;
begin
btschweine.Visible:=false;
MemoText:=chatfenster.Text;
Insert('
A: Spieler 1 hat Schweine!' +Slinebreak, MemoText, +37);
chatfenster.Text := MemoText;
end;
procedure Tformdoppelkopf.btsiegClick(Sender: TObject);
begin
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;
bthochzeit.Enabled:=false;
btheimlichen.Enabled:=false;
end;
procedure Tformdoppelkopf.textein(txt:
string);
var
MemoText :
String;
begin
MemoText:=chatfenster.Text;
Insert(txt +Slinebreak, MemoText, +37);
chatfenster.Text:=MemoText;
end;
procedure Tformdoppelkopf.btsauenClick(Sender: TObject);
begin
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 3 - 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
panel1.Visible:=false;
disabbl(1);
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 textein('
A: Spieler 1 bekommt alle Augen.');
ansa:=ansa+1;
end;
end.