unit skat1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ScktComp, StdCtrls, Grids, ExtCtrls, ImgList,
ActnList, ComCtrls, jpeg, Buttons;
type
TForm1 =
class(TForm)
Panel1: TPanel;
lsort2: TLabel;
lsort3: TLabel;
lsort1: TLabel;
lsort4: TLabel;
Image1: TImage;
lmodi: TLabel;
Label2: TLabel;
StringGrid1: TStringGrid;
btnormals: TButton;
btnachkrbub: TButton;
btgeben: TButton;
btende: TButton;
btsort2: TButton;
btsort3: TButton;
btmischen: TButton;
btmemory: TButton;
btrestore: TButton;
btsort4: TButton;
ledi1: TLabeledEdit;
btneumax: TBitBtn;
trbr: TTrackBar;
Panel2: TPanel;
lbox: TListBox;
ximage1: TImage;
xbtmischen: TButton;
xbtgeben: TButton;
xbtmemory: TButton;
xbtrestore: TButton;
xbtnormals: TButton;
xbtsort2: TButton;
xbtsort3: TButton;
xbtsort4: TButton;
xlsort1: TLabel;
xlsort3: TLabel;
xlsort4: TLabel;
xlsort2: TLabel;
xbtende: TButton;
xtrbr: TTrackBar;
xlmodi: TLabel;
xlabel2: TLabel;
xbtneumax: TBitBtn;
xledi1: TLabeledEdit;
procedure FormCreate(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure btnormalsClick(Sender: TObject);
procedure btnachkrbubClick(Sender: TObject);
procedure btendeClick(Sender: TObject);
procedure btgebenClick(Sender: TObject);
procedure btsort2Click(Sender: TObject);
procedure btsort3Click(Sender: TObject);
procedure btmischenClick(Sender: TObject);
procedure btmemoryClick(Sender: TObject);
procedure btrestoreClick(Sender: TObject);
procedure btsort4Click(Sender: TObject);
procedure btneumaxClick(Sender: TObject);
procedure trbrChange(Sender: TObject);
private
procedure zeitmessung(w,s:integer);
procedure wimageload;
procedure wsortiere1vert(s,w:integer);
procedure wsortiere2einf;
procedure wsortiere3ausw;
procedure wsortiere4adrian;
procedure wmischen;
procedure wgeben;
procedure change;
procedure wxgeben;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
karten:
array[1..33]
of TBitmap;
kartenfeld,memory1:
array[1..32]
of Integer;
nummern:
array[1..33]
of Integer;
nix,von,bis,max,ws:integer;
c,n1,n2,q:int64;
implementation
{$R *.dfm}
procedure TForm1.zeitmessung(w,s:integer);
begin
if w=0
then begin //Start
QueryPerformanceFrequency(c);
QueryPerformanceCounter(n1);
end;
if w=1
then begin //Stop
QueryPerformanceCounter(n2);
if s=1
then lsort1.Caption:=format('
Zeit: %g s',[(n2-n1)/c]);
if s=2
then lsort2.Caption:=format('
Zeit: %g s',[(n2-n1)/c]);
if s=3
then lsort3.Caption:=format('
Zeit: %g s',[(n2-n1)/c]);
if s=4
then lsort4.Caption:=format('
Zeit: %g s',[(n2-n1)/c]);
end;
if w=2
then begin //Reset
end;
end;
procedure TForm1.wmischen;
var i,x,j:integer;
begin
Randomize;
for i:=1
to max
do begin
j:=Random(max-1)+1;
X:=kartenfeld[i];
kartenfeld[i]:=kartenfeld[j];
kartenfeld[j]:=x;
end;
stringgrid1.Refresh;
end;
procedure TForm1.wgeben;
var i:integer;
begin
for i:=1
to max
do
kartenfeld[i]:=nummern[i];
nix:=nummern[33];
end;
procedure TForm1.wsortiere1vert(s,w:integer);
var i,x,j:integer;
begin
zeitmessung(0,1);
if s=0
then begin
i:=1;
repeat
for j:=i+1
to max
do begin
if kartenfeld[j] < kartenfeld[i]
then begin
x:=kartenfeld[i];
kartenfeld[i]:=kartenfeld[j];
kartenfeld[j]:=x;
end;
end;
i:=i+1;
until i=max;
end;
if s=1
then begin
x:=1;
repeat
if kartenfeld[x]=w
then begin
kartenfeld[x]:=kartenfeld[x+1];
kartenfeld[x+1]:=w;
end;
x:=x+1;
until x=max;
end;
stringgrid1.Refresh;
zeitmessung(1,1);
end;
procedure TForm1.wsortiere2einf;
{man vergleicht die 1. karte mit allen folgenden, dann die 2. mit allen anderen usw. wäre adrian}
{ [url]http://www.gymmelk.ac.at/nus/Delphi/Delphi11.htm#auswahl[/url] }
var
i,j,x:integer;
begin
zeitmessung(0,2);
for i:=2
to max
do begin
x:=kartenfeld[i];
j:=i-1;
while (x<kartenfeld[j])
and (j>0)
do begin
kartenfeld[j+1]:=kartenfeld[j];
dec(j);
end;
kartenfeld[j+1]:=x;
end;
stringgrid1.Refresh;
zeitmessung(1,2);
end;
procedure TForm1.wsortiere3ausw;
var d,e,f,g:integer;
begin
zeitmessung(0,3);
for f:=1
to max-1
do begin
e:=0;
g:=f;
for d:=f+1
to max
do begin
if kartenfeld[d]<g
then begin
g:=kartenfeld[d];
e:=d;
end;
end;
kartenfeld[e]:=kartenfeld[f];
kartenfeld[f]:=g;
end;
stringgrid1.Refresh;
zeitmessung(1,3);
end;
procedure TForm1.wsortiere4adrian;
var i,j,z:integer;
begin
zeitmessung(0,4);
for i:=1
to max-1
do
begin
for j:=i+1
to max
do
begin
if kartenfeld[j]<kartenfeld[i]
then
begin
z:=kartenfeld[i];
kartenfeld[i]:=kartenfeld[j];
kartenfeld[j]:=z;
end;
end;
end;
stringgrid1.Refresh;
zeitmessung(1,4);
end;
procedure TForm1.wimageload;
var i: integer;
begin
for i:=1
to 33
do
begin
karten[i]:=TBitmap.Create;
karten[i].LoadFromFile(IntToStr(i)+'
.bmp');
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var ws:integer;
begin
wimageload;
for ws:=1
to 33
do nummern[ws]:=ws;
for ws:=1
to 32
do kartenfeld[ws]:=nummern[33];
stringgrid1.Refresh;
max:=32;
form1.Width:=1019;
form1.Height:=347;
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var c:integer;
begin
for c:=1
to 32
do begin
if kartenfeld[Acol+1]=c
then
stringgrid1.Canvas.Draw(rect.left, rect.top, Karten[c]);
end;
end;
procedure TForm1.btnormalsClick(Sender: TObject);
begin
wsortiere1vert(0,0);
end;
procedure TForm1.btnachkrbubClick(Sender: TObject);
begin
wsortiere1vert(1,29);
wsortiere1vert(1,21);
wsortiere1vert(1,13);
wsortiere1vert(1,5);
end;
procedure TForm1.btendeClick(Sender: TObject);
begin
close;
end;
procedure TForm1.btgebenClick(Sender: TObject);
begin
wgeben;
stringgrid1.Refresh;
btnachkrbub.Enabled:=true;
btnormals.Enabled:=true;
btsort2.Enabled:=true;
btsort3.Enabled:=true;
btsort4.Enabled:=true;
btmischen.Enabled:=true;
btmemory.Enabled:=true;
btrestore.Enabled:=true;
end;
procedure TForm1.btsort2Click(Sender: TObject);
begin
wsortiere2einf;
end;
procedure TForm1.btsort3Click(Sender: TObject);
begin
wsortiere3ausw;
wsortiere3ausw;
end;
procedure TForm1.btmischenClick(Sender: TObject);
begin
wmischen;
end;
procedure TForm1.btmemoryClick(Sender: TObject);
var w:integer;
begin
for w:=1
to 32
do begin
memory1[w]:=kartenfeld[w];
end;
stringgrid1.Refresh;
end;
procedure TForm1.btrestoreClick(Sender: TObject);
var w:integer;
begin
for w:=1
to 32
do begin
kartenfeld[w]:=memory1[w];
end;
stringgrid1.Refresh;
end;
procedure TForm1.btsort4Click(Sender: TObject);
begin
wsortiere4adrian;
end;
procedure TForm1.btneumaxClick(Sender: TObject);
begin
if panel1.Visible=true
then begin
if StrToInt(ledi1.Text)>32
then begin
showmessage('
Für den Skatmodus bitte nur max. 32');
ledi1.Text:='
32';
end else begin
max:=StrToInt(ledi1.Text);
wxgeben;
end;
end else begin
max:=StrToInt(ledi1.Text);
wxgeben;
end;
end;
procedure TForm1.trbrChange(Sender: TObject);
begin
if not panel1.Visible=true
then begin
//Skatmodus
change;
ws:=0;
end else
begin
//X-Modus
change;
ws:=1;
end;
end;
procedure TForm1.change;
begin
if ws=0
then begin
//skatmodus
form1.Width:=1020;
form1.Height:=348;
panel1.Visible:=true;
panel2.Visible:=false;
trbr.Position:=0;
end else begin
//x-modus
form1.Width:=378+9;
form1.Height:=600+36;
panel1.Visible:=false;
panel2.Visible:=true;
panel2.Left:=0;
panel2.Top:=0;
trbr.Position:=1;
end;
end;
procedure TForm1.wxgeben;
var i: Integer;
begin
lbox.clear;
for i:=1
to max
do lbox.Items.Add(IntToStr (i));
end;
end.