Combinação de Numeros

unit Main;

interface

uses
printers,Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, StdCtrls, ComCtrls, ExtCtrls;

type
TJogo = class
d : array [0..12] of integer;
tam : integer;
function igual(j:TJogo):boolean;
end;

TJogo50 = class
d : array [0..50] of integer;
tam : integer;
procedure arruma;
function igual(j:TJogo50):boolean;
constructor Create;
end;

TForm1 = class(TForm)
PageControl1: TPageControl;
Tab6a12: TTabSheet;
lbcomb: TListBox;
Label4: TLabel;
tabDezenas: TStringGrid;
btGerar: TButton;
btimprimir: TButton;
Label6: TLabel;
edcomb: TEdit;
Label5: TLabel;
EdQuantComb: TEdit;
Label3: TLabel;
LbTotal: TLabel;
tabEscolhidas: TStringGrid;
Label2: TLabel;
Label1: TLabel;
Tab50: TTabSheet;
Button1: TButton;
EdQuntComb50: TEdit;
Label7: TLabel;
MemoComb: TMemo;
Btimprimir50: TButton;
PrintDialog1: TPrintDialog;
TabSheet1: TTabSheet;
NCount: TUpDown;
Edit1: TEdit;
Edit2: TEdit;
RCount: TUpDown;
Label9: TLabel;
DisplayGrp: TRadioGroup;
ComputePBtn: TButton;
ComputeCBtn: TButton;
TestComboPermutesBtn: TButton;
TestComboCombosBtn: TButton;
Button4: TButton;
btnSalvar: TButton;
Button3: TButton;
Button5: TButton;
Memo1: TMemo;
CountLbl: TLabel;
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
Label10: TLabel;
Label8: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
procedure FormCreate(Sender: TObject);
procedure tabDezenasSelectCell(Sender: TObject; Col, Row: Integer;
var CanSelect: Boolean);
procedure tabDezenasDrawCell(Sender: TObject; Col, Row: Integer;
Rect: TRect; State: TGridDrawState);
procedure tabEscolhidasDrawCell(Sender: TObject; Col, Row: Integer;
Rect: TRect; State: TGridDrawState);
procedure EdQuantCombKeyPress(Sender: TObject; var Key: Char);
procedure tabEscolhidasSelectCell(Sender: TObject; Col, Row: Integer;
var CanSelect: Boolean);
procedure btGerarClick(Sender: TObject);
procedure btimprimirClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Btimprimir50Click(Sender: TObject);
procedure ComputePBtnClick(Sender: TObject);
procedure ComputeCBtnClick(Sender: TObject);
procedure TestComboPermutesBtnClick(Sender: TObject);
procedure TestComboCombosBtnClick(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure btnSalvarClick(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
n,r:integer;
count:integer;
actualCount:integer;
freq,start,stop:int64;
x:array of integer;
Procedure AddListEntry;
Procedure Setup;
procedure showresults;
end;

var
Form1: TForm1;
f : textfile;

implementation

{$R *.DFM}

Uses combo, UMakeCaption;

Procedure TForm1.Setup;
var i:integer;
Begin
memo1.clear;
if rcount.position>ncount.position then rcount.position:=ncount.position;
n:=nCount.position;
r:=rCount.position;
count:=1;
actualcount:=0;
for i:=1 to r do count:=count*(n-(i-1)); {This is N!/(N-R)!}
setlength(x,r); {set length of dynamic array}
for i:=0 to r-1 do x[i]:=i+1;
addlistentry;
screen.cursor:=crHourglass;
queryperformancefrequency(freq);
queryperformancecounter(start);
end;

Procedure TForm1.addlistentry;
var
i:integer;
s:string;
begin
if (displaygrp.itemindex=0) and (memo1.lines.count<30240) then
begin
s:=´´;
For i:= 0 to length(x)-1 do s:=s+´ ´+inttostr(x[i]);
delete(s,1,1);
memo1.lines.add(s);
end;
inc(actualCount);
end;


procedure TForm1.showresults;
begin
queryperformancecounter(stop);
countlbl.caption:=´Qauntidade: ´+inttostr(actualCount)
+#13+´Tempo: ´+inttostr(30240*(stop-start) div freq)+´ ms´;
screen.cursor:=crdefault;
end;

procedure TForm1.FormCreate(Sender: TObject);
var c,i,j:integer;
begin
c:=0;
for i:=0 to 9 do
for j:=0 to 9 do
begin
inc(c);
tabDezenas.Cells[j,i] := Format(´¬.2d´,[c]);
end;
tabDezenas.Cells[9,9] := ´00´;
end;

procedure TForm1.tabDezenasSelectCell(Sender: TObject; Col, Row: Integer;
var CanSelect: Boolean);
var i,j,k:integer;
existe:boolean;
tmp:String;
begin
existe:=false;
i :=tabEscolhidas.Tag;
for j:=0 to 9 do
for k:=0 to 4 do
if tabEscolhidas.Cells[j,k]=tabDezenas.Cells[Col,Row] then existe:= true;
if (not existe) and (i<=49) then
begin
tabEscolhidas.Cells[(i mod 10), i div 10 ]:= tabDezenas.Cells[Col,Row];
tabEscolhidas.Tag := tabEscolhidas.Tag +1;
for j:=0 to tabEscolhidas.Tag do
for k:=j to tabEscolhidas.Tag -1 do
if strtoint(tabEscolhidas.Cells[j mod 10,j div 10]) > strtoint(tabEscolhidas.Cells[k mod 10,k div 10]) then
begin
tmp:=tabEscolhidas.Cells[j mod 10,j div 10];
tabEscolhidas.Cells[j mod 10,j div 10] :=tabEscolhidas.Cells[k mod 10,k div 10];
tabEscolhidas.Cells[k mod 10,k div 10]:=tmp;
end;
LbTotal.Caption := Format(´Total de ¬.2d dezenas selecionadas´,[tabEscolhidas.Tag]);
end;
end;

procedure TForm1.tabDezenasDrawCell(Sender: TObject; Col, Row: Integer;
Rect: TRect; State: TGridDrawState);
var k,j:integer;
begin
for j:=0 to 9 do
for k:=0 to 4 do
if tabEscolhidas.Cells[j,k]=tabDezenas.Cells[Col,Row] then
begin
tabDezenas.Canvas.Brush.Color := clBtnFace;
tabDezenas.Canvas.Pen.Color := clBtnText;
tabDezenas.Canvas.Rectangle(Rect.left,Rect.top,Rect.right,Rect.bottom);
tabDezenas.Canvas.TextOut(Rect.Left+2,Rect.Top+2,tabDezenas.Cells[Col,Row]);
tabDezenas.Canvas.Pen.Color := clActiveCaption;
tabDezenas.Canvas.Pen.Width := 1;
tabDezenas.Canvas.MoveTo(Rect.Left+1,Rect.Top+1);
tabDezenas.Canvas.LineTo(Rect.Right-1,Rect.Bottom-1);
tabDezenas.Canvas.MoveTo(Rect.Right-1,Rect.Top+1);
tabDezenas.Canvas.LineTo(Rect.Left+1,Rect.Bottom-1);
end;
end;

procedure TForm1.tabEscolhidasDrawCell(Sender: TObject; Col, Row: Integer;
Rect: TRect; State: TGridDrawState);
begin
if (tabEscolhidas.Cells[col,row] <> ´´) then
begin
tabEscolhidas.Canvas.Pen.Width :=1;
tabEscolhidas.Canvas.Pen.Color := clBlack;
tabEscolhidas.Canvas.Ellipse(rect.Left,rect.Top,rect.right,rect.bottom);
tabEscolhidas.Canvas.TextOut(rect.Left+4,rect.Top+3,tabEscolhidas.Cells[col,row]);
end;
end;



procedure TForm1.EdQuantCombKeyPress(Sender: TObject; var Key: Char);
begin
if (key in [´a´..´z´,´A´..´Z´]) then
key := #0;
end;


procedure TForm1.tabEscolhidasSelectCell(Sender: TObject; Col,
Row: Integer; var CanSelect: Boolean);
var i : integer;
begin
if tabEscolhidas.Cells[col,row]<>´´ then
begin
for i:=1 to tabEscolhidas.Tag-1 do
if strtoint(tabEscolhidas.Cells[i mod 10,i div 10]) > strtoint(tabEscolhidas.Cells[col,row]) then
begin
tabEscolhidas.Cells[(i-1) mod 10, (i-1) div 10]:=tabEscolhidas.Cells[(i) mod 10, (i) div 10]
end;
tabEscolhidas.Cells[(tabEscolhidas.Tag-1)mod 10,(tabEscolhidas.Tag-1)div 10]:=´´;
tabEscolhidas.Tag := tabEscolhidas.Tag -1;
tabDezenas.Invalidate;
end;
end;


function TJogo.igual(j:TJogo):boolean;
var i:integer;
begin
igual:=true;
for i:=0 to tam-1 do
begin
if (j.d[i]<>self.d[i]) then igual:=false;
break;
end;

end;

function TJogo50.igual(j:TJogo50):boolean;
var i:integer;
begin
igual:=true;
for i:=0 to 49 do
begin
if (j.d[i]<>self.d[i]) then igual:=false;
break;
end;

end;

constructor TJogo50.Create;
var i:integer;
begin
for i:=0 to 49 do self.d[i]:=101;
end;

procedure TJogo50.arruma;
var i,j,t:integer;
begin
for i:= 0 to 49 do
for j:= i+1 to 49 do
if (self.d[i]>=self.d[j]) then
begin
t := self.d[i];
self.d[i] := self.d[j];
self.d[j] := t;
end;
end;

procedure TForm1.btGerarClick(Sender: TObject);
var comb,max,t,k,j,i,q,l,ind:integer;
jogo: array [0..12] of string;
inds: TJogo;
flag:boolean;
linha:string;
begin
lbcomb.Clear;
q := strtoint(EdQuantComb.Text);
comb :=strtoint(edcomb.Text);
if (comb>12) then
raise Exception.Create(´O maior tamanho de jogos é 12´);
Randomize;
for i:= 1 to q do
begin
inds := TJogo.create;
inds.tam := comb;
for k:= 0 to comb-1 do inds.d[k]:=-1;
for j:= 0 to comb-1 do
begin
repeat
flag:=true;
if j=0 then max := 9
else if j=1 then max := 19
else max := tabEscolhidas.Tag;
ind := random(max);
for k:= 0 to comb-1 do if inds.d[k]=ind then flag:=false;
until flag;
inds.d[j]:=ind;
end;
for j:= 0 to comb - 2 do
for k:= j+1 to comb -1 do
if (inds.d[j]>inds.d[k]) then
begin
t := inds.d[j];
inds.d[j] := inds.d[k];
inds.d[k] := t;
end;
for j:= 0 to lbcomb.Items.Count-1 do
begin
repeat
flag :=true;
if inds.igual(lbcomb.Items.Objects[j] as TJogo) then
begin
k := random(comb-1);
for l:=0 to comb-1 do
begin
if k=l then
if inds.d[l]<inds.d[l+1]-1 then
begin
inc (inds.d[l]);
break;
end;
end;
end
else if (lbcomb.Items.Objects[j] as TJogo).d[0]>inds.d[0] then break;
until flag;
end;
for j:= 0 to comb-1 do
jogo[j]:= tabEscolhidas.Cells[inds.d[j] mod 10,inds.d[j] div 10];
for l:= 0 to comb-1 do
begin
linha := linha + jogo[l];
if l < comb-1 then linha:=linha+´-´;
end;
lbcomb.Items.AddObject(linha,inds);
linha:=´´;
end;
end;




procedure TForm1.btimprimirClick(Sender: TObject);
var i:integer;
s:string;
begin
assignprn(f);
rewrite(f);
s := ´ JOGOS GERADOS´+chr(13)+chr(10);
i:=0;
while i < lbcomb.Items.Count do
begin
writeln(f,s);
s := lbcomb.Items.Strings[i];
inc(i);
if i < lbcomb.Items.Count then s:= s+chr(9)+ lbcomb.Items.Strings[i];
inc(i);
if i < lbcomb.Items.Count then s:= s+chr(9)+ lbcomb.Items.Strings[i];
inc(i);
end;
writeln(f,s);
closefile(f);
end;


procedure TForm1.Button1Click(Sender: TObject);
var d : array [0..99] of integer;
e : TStringList;
s:string;
i,j,num,k,c:integer;
jogo:TJogo50;
begin
e := TStringList.Create();
MemoComb.Lines.Clear;
MemoComb.Lines.Add(´--------------------------------------------Combinações Geradas--------------------------------------------´);
MemoComb.Lines.Add(´ ´);
Randomize;
c:=1;
while c<= StrtoInt(EdQuntComb50.text) do
begin
for i:= 0 to 99 do d[i]:=i;
j:=99;
jogo := Tjogo50.Create;
for i:=0 to 49 do
begin
num:=Random(j);
dec(j);
jogo.d[i]:=d[num];
jogo.arruma;
for k:=num to j do
d[k]:=d[k+1];
end;
for k:=0 to e.Count-1 do
if (e.Objects[k] as TJogo50).igual(jogo) then
begin
dec(c);
end;
s:=´# Jogo ´+Format(´¬.2d´,[c])+´ ´;
for i:=0 to 48 do
begin
s := s+Format(´¬.2d´,[jogo.d[i]])+´ - ´;
if (i=24) then s:= s +chr(13) + chr(10) +´ ´;
end;
s:=s+Format(´¬.2d´,[jogo.d[49]]);
MemoComb.Lines.Add(s+chr(13) + chr(10));
jogo.Destroy;
inc (c);
end;
Btimprimir50.Visible:=true;
e.Destroy;

end;

procedure TForm1.Btimprimir50Click(Sender: TObject);
var i:integer;
begin
assignprn(f);
rewrite(f);
i:=0;
while i < MemoComb.Lines.Count do
begin
writeln(f,MemoComb.Lines[i]);
inc(i);
end;
writeln(f,chr(12));
closefile(f);
Btimprimir50.Visible:=false;
end;

procedure TForm1.ComputePBtnClick(Sender: TObject);

Function CanInc(p:integer; var newval:integer):boolean;
var
i:integer;
Begin
if x[p]>=n then result:=false
else
Begin
result:=false;
newval:=x[p];
while (result=false) and (newval<n) do
Begin
inc(newval);
result:=true;
for i:= 0 to p-1 do
if x[i]=newval then Begin result:=false; break; end;
end;
end;
end;

var
i,j, newval:integer;
incpos:integer;
ok:boolean;
begin
Setup;
for i:= 2 to count do
Begin
{find the position to increment starting with rightmost}
incpos:=r-1;
ok:=false;
while (incpos>=0) and (not OK) do
if CanInc(incpos,newval) then Begin x[incpos]:=newval; ok:=true; end
else dec(incpos);
{now reset the remainder to the smallest values possible}
for j:= incpos+1 to r-1 do
Begin
x[j]:=0;
if CanInc(j,newval) then x[j]:=newval
else showmessage(´System error´);
end;
addlistentry;
end;
showresults;

end;

procedure TForm1.ComputeCBtnClick(Sender: TObject);
var
i,j:integer;
incpos:integer;
begin
Setup;
for i:=2 to r do count:=count div i;
for i:= 2 to count do
Begin

incpos:=r-1;

while x[incpos]>=n-r+incpos+1 do dec(incpos);

inc(x[incpos]);

for j:=incpos+1 to r-1 do x[j]:=x[j-1]+1;
addlistentry;
end;
showresults;

end;

procedure TForm1.TestComboPermutesBtnClick(Sender: TObject);
var i:integer;
begin
setup;
memo1.clear;
actualcount:=0;
combos.setup(r,n, permutations);
while combos.getnextpermute do
begin
for i:=0 to r-1 do x[i]:=combos.selected[i+1];
addlistentry;
end;
showresults;
If combos.getcount<>actualcount
then showmessage(´Count error: ´+inttostr(combos.getcount));
end;

procedure TForm1.TestComboCombosBtnClick(Sender: TObject);
var i:integer;
begin
setup;
memo1.clear;
actualcount:=0;
combos.setup(r,n,combinations);
while combos.getnextcombo do
begin
for i:=0 to r-1 do x[i]:=combos.selected[i+1];
addlistentry;
end;
showresults;
If combos.getcount<>actualcount
then showmessage(´Count error: ´+inttostr(combos.getcount));
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Memo1.Lines.Clear;
end;

procedure TForm1.btnSalvarClick(Sender: TObject);
begin
with SaveDialog1 do
if Execute then Memo1.Lines.SaveToFile(Filename);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
With OpenDialog1 do
if Execute then Memo1.Lines.LoadFromFile(Filename);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
Application.Terminate;
end; :)

end.

Osmano, cadê o código das units combo, UMakeCaption;
elas aparecem na implementação da unit fornecida por você mas não há nenhum sinal das referidas units.
Se pegou de algum site, por favor, informe o endereço.
Falou?! :D