Banko-plade generator 2

I'm lookin at it ...

jeg vil gerne have at vide om fx 60 og 63 må være i samme række ?

Jens B

borrisholt >>>
nej - det må ikke forekomme i samme række, men gerne i en af de 2 andre (ud af 3 rækker) -  d.v.s. 1 række må kun inde max. et tal for 1'nere,10'ere,20'ere ... 80'ere(inkl. gamle Ole 90) -
sorry, det glemte at definere - faktisk overså jeg detaljen, indtil du pegede på problemet..

borrisholt>>

Du kan se en bankoplade her !

http://www.bankocenter.dk/forskellige_spil/1_90.htm

Stoney

OK det kræver jeg tænker lidt ...

jeg ved ikke om problemet er blevet for kompliceret og derfor kræver flere point ?

Jeg har tænkt og mener godt jeg kan lave det du beder om. Men jeg er først ved en Delphi-computer i nat, så det kræver at du har tålmodighed :)

CMS>> Hvis du vil have det lidt nemt så tag udgangs punkt i det jeg allerede har lavet .. Det skulle være til at finde ud af ..

Og der er den halve løsning .....

Jens B

jeg glæder mig til at se resultatet...

Her er en løsning som kan. (90 tal fordelt på 6 plader, ingen dubletter inden for samme 10'er, placeret rigtigt, med 5 tal i hver række)
Laver en enkelt side, men kan nemt ændres til 1000 (typen er oprettet).
Udskriver pladen i en listbox ved tryk på en button.
Jeg kan maile det til dig hvis du vil.

unit BankoM;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

Const
  Antal = 90;
  AntalPlader = 10;
  RkPrPl = 9;
  AntRaek = 18;
  forsoeg = 200;
type
  PlArr = Array[1..RkPrPl,1..AntRaek] of byte;
  AllePlader = Array[1..AntalPlader] of PlArr;
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure GetRandom(var plade: PlArr; var ok: boolean);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Numre: String;

implementation

{$R *.DFM}

procedure TForm1.GetRandom(var plade: PlArr; var ok: boolean);
var
  Raekke,Plac,i,j: byte;
  taeller: integer;
  talraek: string;
begin
  for i := 1 to RkPrPl do
    for j := 1 to AntRaek do
      plade[i,j] := 0;
  taeller := 0;
  talraek := Numre;
  j := Antal;
  while ((j > 0) and (taeller < forsoeg)) do
  begin
    repeat
      ok := true;
      i := random(j)+1;
      plac := (ord(talraek[i]) div 10) +1;
      if plac = 10 then plac := 9;  {nr 90}
      raekke := 18-((j-1) div 5);
      if plade[plac,raekke] = 0 then
      begin
        plade[plac,raekke] := ord(talraek[i]);
        delete(talraek,i,1);
        dec(j);
      end
      else
      begin
        ok := false;
        inc(taeller);
      end;
    until (ok or (taeller >= forsoeg));
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
Var
  i: byte;
begin        {genererer numre + randomize}
  Numre := '';
  for i := 1 to antal do
    Numre := Numre + chr(i);
  Randomize;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  x: PlArr;
  test: boolean;
  s: string;
  i,j,k: byte;
begin
  k := 0;      {laver en enkelt plade og udskriver den}
  repeat
    GetRandom(x,test);
    inc(k);
  until test;
  listbox1.Clear;
  for i := 1 to 18 do
  begin
    s := '';
    for j := 1 to 9 do
      s := s + IntToStr(x[j,i]) + ' ';
    listbox1.items.add(s);
  end;
  listbox1.items.add('Antal kasserede plader: '+IntToStr(k-1));
end;       

end.

hreiff >> Det er et sejt stykke arbejde du har lavet. Det virker dog ikke
100 % endnu. Jeg kæmper stadig med selv at få det til at lykkedes.
Nedenstående er et resultat af din kode. Den starter med 3 nuller i 10'erne. Som jeg har forstået det, skal der være mindst et tal i 10'erne
pr. 3. rækker osv. Anyway det er cool det du har lavet. Keep up the good
work.


0 15 27 39 0 58 65 0 0
0 10 21 0 43 56 63 0 0
0 0 0 30 0 55 69 70 87
3 0 0 33 0 54 68 71 0
5 0 0 0 45 0 67 73 85
4 0 23 37 49 53 0 0 0
0 14 0 0 44 0 64 75 88
7 0 24 38 0 0 60 76 0
0 12 26 0 0 51 0 77 84
0 16 28 0 0 59 62 72 0
2 0 0 31 42 0 61 0 80
1 19 20 32 0 0 0 79 0
0 11 25 0 41 52 0 0 81
0 18 0 34 40 57 0 0 86
0 0 22 35 48 0 0 78 82
6 17 29 0 0 50 0 0 89
8 0 0 36 46 0 66 0 83
9 13 0 0 47 0 0 74 90
Antal kasserede plader: 0

Stoney

--> Stoney:
Du har muligvis ret, jeg havde ikke overvejet det.
--> Jekk:
Er der et krav om at der skal forekomme mindst et tal i alle 10'ere, eller duer ovenstående plade?

Alternativt, må man løbe hele siden igennem for at tjekke det, men det vil nok kassere en del ekstra.

Jer er jo også det check at der ikke må være mere end 3 ens rækker i samtlige 1000 sider. Der vil sikker også blive kasseret et par stykker.

//hreiff

FLOT indsats !!!
ja der skal være mindst 1 tal i hver af de 9 kolonner på de 3 rækker...

jeg glæder mig til resultatet...

det med, at der ikke må være mere en 3 ens rækker på tværs af de 1000 sider er et "mindre" problem, som ikke nødvendigvis behøver at være med ...

Ok, her er den: (der bliver godt nok kasseret mange - men den duer)

unit Banko3M;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

Const
  Antal = 90;
  AntalPlader = 100;
  RkPrPl = 9;
  AntRaek = 18;
  forsoeg = 200;
type
  PlArr = Array[1..RkPrPl,1..AntRaek] of byte;
  AllePlader = Array[1..AntalPlader] of PlArr;
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure GetRandom(var plade: PlArr; var ok: boolean);
    procedure Tjek(const plade: PlArr; var ok: boolean);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Numre: String;

implementation

{$R *.DFM}

procedure TForm1.GetRandom(var plade: PlArr; var ok: boolean);
var
  Raekke,Plac,i,j: byte;
  taeller: integer;
  talraek: string;
begin
  for i := 1 to RkPrPl do
    for j := 1 to AntRaek do
      plade[i,j] := 0;
  taeller := 0;
  talraek := Numre;
  j := Antal;
  while ((j > 0) and (taeller < forsoeg)) do
  begin
    repeat
      ok := true;
      i := random(j)+1;
      plac := (ord(talraek[i]) div 10) +1;
      if plac = 10 then plac := 9;  {nr 90}
      raekke := 18-((j-1) div 5);
      if plade[plac,raekke] = 0 then
      begin
        plade[plac,raekke] := ord(talraek[i]);
        delete(talraek,i,1);
        dec(j);
      end
      else
      begin
        ok := false;
        inc(taeller);
      end;
    until (ok or (taeller >= forsoeg));
  end;
end;

procedure TForm1.Tjek(const plade: PlArr; var ok: boolean);
var
  i,j: integer;
begin
  ok := true;
  for i := 0 to 5 do
    for j := 1 to RkPrPl do
      if ((plade[j,(i*3+1)]=0) and (plade[j,(i*3+2)]=0) and
              (plade[j,(i*3+3)]=0)) then
        ok := false;
end;

procedure TForm1.FormCreate(Sender: TObject);
Var
  i: byte;
begin
  Numre := '';
  for i := 1 to antal do
    Numre := Numre + chr(i);
  Randomize;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  x: PlArr;
  test: boolean;
  s: string;
  i,j,k: byte;
begin
  k := 0;
  repeat
    GetRandom(x,test);
    if test then
      tjek(x,test);
    inc(k);
  until test;
  listbox1.Clear;
  listbox1.items.add('--------------------------');
  for i := 1 to 18 do
  begin
    s := '';
    for j := 1 to 9 do
      if x[j,i] = 0 then
        s := s + '  '
      else
        if x[j,i] >= 10 then
          s := s + IntToStr(x[j,i]) + ' '
        else
          s := s + ' '+IntToStr(x[j,i]) + ' ';
    listbox1.items.add(s);
    if (i mod 3) = 0 then
      listbox1.items.add('--------------------------');
  end;
  listbox1.items.add('Antal forsøg: '+IntToStr(k));
end;

end.

Ps: Brug font'en FixedSys i listbox'en - så står det rigtigt.

hreif >>

spændt til bristepunktet -
har jeg kopieret din kode ind i et nyt projekt (D5) indsat en button og listbox og erstattet den automatisk genererede unit-kode med din fra og med interface
gemt og oversat uden problemer.

ved run trykkede på button...

INGENTING sker - hvad har jeg gjort forkert ?

kunne du evt. sende mig din samlede projektkode ? jekk@seher.dk

har nu også afprøvet din første kode - med samme resultat ???

ifølge Stoney, så har han fået det til at trille ...
ergo, må det være noget jeg gør forkert - men hvad ?

det ser ud til, at programmet på 2 forskellige maskiner, aldrig når til:
  k := 0;      {laver en enkelt plade og udskriver den}
  repeat
    GetRandom(x,test);
    inc(k);
  until test;
>>>>>>  listbox1.Clear;  <<<<<<<<<<<

???
jeg har indsat en tekst i listbox1, som så
skulle slettes af listbox1.Clear; ....

flytter jeg listbox1.Clear; op før k := 0;
så får jeg en runtimefejl:
Access violation at adress 00442429 .... Read of adress FFFFFFFF
exception class EAccessviolation ...

det si'r ikke mig en dyt - sorry...

Program sendt pr. mail.

PERFEKT / RESPEKT  !!!

Tusind tak !!!!!!!!!

God week-end ...

Hvad med os andre der MÅSKE skulle få lyst til at spille banko? Skal  vi ikke have mulighed for at lave bankoplader?

Koden står ovenfor.

Hvad var det så han ikke kunne få til at virke?