Pliks Napisano Czerwiec 10, 2014 Zgłoś Share Napisano Czerwiec 10, 2014 Witam, od jakiegoś czasu chcę stworzyć program do generowania liczb losowych lotto w Turbo Pascalu, w taki sposób, żeby losował mi 6 liczb z 49, szeregował je od najmniejszej do największej i zapisywał do pliku w takim formacie nazwy np. : 2014-4-30_13;20;54. Najpierw udało mi się stworzyć program, który nie sortuje w kolejności od najmniejszej do największej, ale zapisuje do pliku pod odpowiednią nazwą: program zadanie4; uses dos,crt; var a,i,j,p:byte; z:char; tab:array[1..6] of byte; spr:boolean; plik2:text; opis: String; KoniecPetli: boolean; procedure losujzapisz; {poczatek procedury losujzapisz} begin clrscr; randomize; Begin assign(plik2, 'd:\lot.txt'); rewrite(plik2); spr:=false; for p:=1 to 1 do begin for i:=1 to 6 do begin repeat spr:=false; a:=random(49)+1; for j:=1 to i do begin if a=tab[j] then spr:=true; end; until spr<>true; tab[i]:=a; write(plik2, tab[i],' '); writeln(tab[i],' '); end; end; writeln(plik2); write('Liczby zapisane do pliku txt: '); for i:=1 to 6 do write(tab[i],' '); close(plik2); readln; End; end; {koniec procedury losujzapisz} procedure dopisz; {porczatek procedury dopisz} var a,i,j: byte; Begin assign(plik2, 'd:\lot.txt'); append(plik2); randomize; spr:=false; begin for i:=1 to 6 do begin repeat spr:=false; a:=random(49)+1; for j:=1 to i do begin if a=tab[j] then spr:=true; end; until spr<>true; tab[i]:=a; write(plik2, tab[i],' '); writeln(tab[i],' '); end; end; writeln(plik2); write('Liczby zapisane do pliku txt: '); for i:=1 to 6 do write(tab[i],' '); close(plik2); end;{koniec procedury dopisz} procedure wybierz; {poczatek procedury wybierz} begin z:= Readkey; if z=#27 then exit; Writeln('Wtamy w programie Lotto.'); Write('Wcisnij enter aby wylosowac i dopisac lub escape aby zakonczyc.'); begin readln(z); repeat z:=ReadKey; if z=#27 then exit; read; dopisz; until z = #27; end; end; {koniec procedury wybierz} procedure zapisdaty; const dni:array[0..6] of string=('Niedz','Pon','Wto','Sro','Czw','Pia','Sob'); var plik: text; var godz, min, sek, sek100, rr, mm, dd, dztyg: word; var g2,m2,s2, rr2, mm2, dd2: String; begin clrscr; getdate(rr, mm, dd, dztyg); Str(rr,rr2); writeln(rr2); Str(mm,mm2); writeln(mm2); Str(dd,dd2); writeln(dd2); gettime(godz, min, sek, sek100); Str(godz,g2); writeln(g2); Str(min,m2); writeln(m2); Str(sek,s2); writeln(s2); rename(plik2, 'D:\' +rr2+'-'+mm2+'-'+dd2+'_'+g2+';' +m2+';' +s2+ '.txt' ); end; {kod glowny} begin repeat z:= Readkey; if z=#27 then exit; losujzapisz; wybierz; until z = #27; zapisdaty; clrscr; end. [/spoiler] <code=delphi> program zadanie4; uses dos,crt; var a,i,j,p:byte; z:char; tab:array[1..6] of byte; spr:boolean; plik2:text; opis: String; KoniecPetli: boolean; procedure losujzapisz; {poczatek procedury losujzapisz} begin clrscr; randomize; Begin assign(plik2, 'd:\lot.txt'); rewrite(plik2); spr:=false; for p:=1 to 1 do begin for i:=1 to 6 do begin repeat spr:=false; a:=random(49)+1; for j:=1 to i do begin if a=tab[j] then spr:=true; end; until spr<>true; tab[i]:=a; write(plik2, tab[i],' '); writeln(tab[i],' '); end; end; writeln(plik2); write('Liczby zapisane do pliku txt: '); for i:=1 to 6 do write(tab[i],' '); close(plik2); readln; End; end; {koniec procedury losujzapisz} procedure dopisz; {porczatek procedury dopisz} var a,i,j: byte; Begin assign(plik2, 'd:\lot.txt'); append(plik2); randomize; spr:=false; begin for i:=1 to 6 do begin repeat spr:=false; a:=random(49)+1; for j:=1 to i do begin if a=tab[j] then spr:=true; end; until spr<>true; tab[i]:=a; write(plik2, tab[i],' '); writeln(tab[i],' '); end; end; writeln(plik2); write('Liczby zapisane do pliku txt: '); for i:=1 to 6 do write(tab[i],' '); close(plik2); end;{koniec procedury dopisz} procedure wybierz; {poczatek procedury wybierz} begin z:= Readkey; if z=#27 then exit; Writeln('Wtamy w programie Lotto.'); Write('Wcisnij enter aby wylosowac i dopisac lub escape aby zakonczyc.'); begin readln(z); repeat z:=ReadKey; if z=#27 then exit; read; dopisz; until z = #27; end; end; {koniec procedury wybierz} procedure zapisdaty; const dni:array[0..6] of string=('Niedz','Pon','Wto','Sro','Czw','Pia','Sob'); var plik: text; var godz, min, sek, sek100, rr, mm, dd, dztyg: word; var g2,m2,s2, rr2, mm2, dd2: String; begin clrscr; getdate(rr, mm, dd, dztyg); Str(rr,rr2); writeln(rr2); Str(mm,mm2); writeln(mm2); Str(dd,dd2); writeln(dd2); gettime(godz, min, sek, sek100); Str(godz,g2); writeln(g2); Str(min,m2); writeln(m2); Str(sek,s2); writeln(s2); rename(plik2, 'D:\' +rr2+'-'+mm2+'-'+dd2+'_'+g2+';' +m2+';' +s2+ '.txt' ); end; {kod glowny} begin repeat z:= Readkey; if z=#27 then exit; losujzapisz; wybierz; until z = #27; zapisdaty; clrscr; end. po jakimś czasie stworzyłem program który zapisuje w kolejności rosnącej liczby do tablicy: program sortowanie; uses dos, crt; const n = 6; type tablica = array[1..n] of byte; var plik: text; procedure sortowanie_babelkowe(var tab : tablica); var i, j, tmp: byte; begin for i:=1 to n-1 do for j := i+1 to n do if tab[i] > tab[j] then begin tmp := tab[i]; tab[i] := tab[j]; tab[j] := tmp; end; end; procedure wyswietl(tab : tablica); var i : byte; plik: text; begin assign (plik, 'D:\lotor.txt'); append(plik); begin for i := 1 to n do write(plik, tab[i],' '); writeln; end; writeln(plik); write('Liczby zapisane do pliku txt: '); for i:=1 to n do write(tab[i],','); close(plik); end; procedure uzupelnij(var tab : tablica); var a,i,j,p : integer; spr: boolean; begin randomize; spr:=false; for p:=1 to 1 do begin for i:=1 to n do begin repeat spr:=false; a:=random(49)+1; for j:=1 to i do begin if a=tab[j] then spr:=true; end; until spr<>true; tab[i]:=a; write( tab[i],' '); end; {procedure zapisz; Begin assign(plik2, 'd:\lotos.txt'); rewrite(plik2); spr:=false; for p:=1 to 1 do begin for i:=1 to n do begin repeat spr:=false; a:=random(49)+1; for j:=1 to i do begin if a=tab[j] then spr:=true; end; until spr<>true; tab[i]:=a; write(plik2, tab[i],' '); } end; end; procedure nowy; var plik: text; Begin assign(plik, 'D:\lotor.txt'); rewrite(plik); close(plik); end; procedure zapisdaty; const dni:array[0..6] of string=('Niedz','Pon','Wto','Sro','Czw','Pia','Sob'); var plik: text; var godz, min, sek, sek100, rr, mm, dd, dztyg: word; var g2,m2,s2, rr2, mm2, dd2: String; begin clrscr; getdate(rr, mm, dd, dztyg); Str(rr,rr2); writeln(rr2); Str(mm,mm2); writeln(mm2); Str(dd,dd2); writeln(dd2); gettime(godz, min, sek, sek100); Str(godz,g2); writeln(g2); Str(min,m2); writeln(m2); Str(sek,s2); writeln(s2); rename(plik, 'D:\' +rr2+'-'+mm2+'-'+dd2+'_'+g2+';' +m2+';' +s2+ '.txt' ); end; var tab : tablica; z: char; begin nowy; repeat z:= Readkey; if z=#27 then exit; uzupelnij(tab); {wyswietl(tab);} sortowanie_babelkowe(tab); wyswietl(tab); readln; until z = #27; zapisdaty; end. ale nie działa z kolei zapis pliku pod nazwą w formacie daty i czasu utworzenia pliku, tak jakbym chciał...ma ktoś pomysł jak to dobrze zaimplementować do kodu? Z góry dzięki za pomoc. Pozdrawiam. Link do komentarza Udostępnij na innych stronach More sharing options...
babubabu Napisano Sierpień 20, 2014 Zgłoś Share Napisano Sierpień 20, 2014 Masz: Main_Unit unit Main_Unit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, Generate_Unit; type { TForm1 } TForm1 = class(TForm) Button1: TButton; Edit1: TEdit; Label1: TLabel; ProgressBar1: TProgressBar; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { private declarations } public { public declarations } end; var Form1: TForm1; Generate : TGenerate; implementation {$R *.lfm} { TForm1 } procedure TForm1.Button1Click(Sender: TObject); var Max : LongWord; Err : Word; begin Val(Edit1.Text, Max, Err); if Err <> 0 then ShowMessage('Podaj Liczbę!') else begin ProgressBar1.Position := 0; ProgressBar1.Max := Max; Generate := TGenerate.Create(false, Max); end; end; procedure TForm1.FormCreate(Sender: TObject); begin Randomize; end; end. Generate_unit: unit generate_unit; {==============================================================================} {$mode objfpc}{$H+} {==============================================================================} interface uses {$ifdef unix} cthreads, cmem, {$endif} classes; {==============================================================================} type TDate = record Day, Month : Byte; Year : Word; end; {------------------------------------------------------------------------------} type TBet = record Date : TDate; Number : array[0..5] of Byte; end; {------------------------------------------------------------------------------} type TGenerate = class(TThread) private fMax : LongWord; fStep : LongWord; procedure UpdateProgress; procedure Disable; procedure Enable; protected procedure Execute; override; public constructor Create(CreateSuspended : boolean; Max : LongInt); end; {==============================================================================} implementation {==============================================================================} uses Main_Unit; {==============================================================================} procedure Swap(var value1, value2 : Byte); var tmp : Byte; begin tmp := value1; value1 := value2; value2 := tmp; end; procedure BubbleSort(var Data : array of Byte); var i, j : LongWord; begin for i := Low(Data) to High(Data) - 1 do for j := Low(Data) to High(Data) - 1 do if Data[j] > Data[j+1] then Swap(Data[j], Data[j+1]); end; function CheckUnique(Data : TBet) : Boolean; begin result := false; if (Data.Number[0] <> Data.Number[1]) and (Data.Number[0] <> Data.Number[2]) and (Data.Number[0] <> Data.Number[3]) and (Data.Number[0] <> Data.Number[4]) and (Data.Number[0] <> Data.Number[5]) and (Data.Number[1] <> Data.Number[2]) and (Data.Number[1] <> Data.Number[3]) and (Data.Number[1] <> Data.Number[4]) and (Data.Number[1] <> Data.Number[5]) and (Data.Number[2] <> Data.Number[3]) and (Data.Number[2] <> Data.Number[4]) and (Data.Number[2] <> Data.Number[5]) and (Data.Number[3] <> Data.Number[4]) and (Data.Number[3] <> Data.Number[5]) and (Data.Number[4] <> Data.Number[5]) then result := true; end; {==============================================================================} constructor TGenerate.Create(CreateSuspended : boolean; Max : LongInt); begin FreeOnTerminate := True; fMax := Max; fStep := Max div 100; inherited Create(CreateSuspended); end; {------------------------------------------------------------------------------} procedure TGenerate.UpdateProgress; begin Form1.ProgressBar1.Position := Form1.ProgressBar1.Position + fStep; end; {------------------------------------------------------------------------------} procedure TGenerate.Disable; begin Form1.Button1.Enabled := false; end; {------------------------------------------------------------------------------} procedure TGenerate.Enable; begin Form1.Button1.Enabled := true; end; {------------------------------------------------------------------------------} procedure TGenerate.Execute; var i : LongWord; j : Byte; Bet : TBet; BFile : File of TBet; begin Synchronize(@Disable); Bet.Date.Day := 0; Bet.Date.Month := 0; Bet.Date.Year := 0; AssignFile(BFile, 'random.nrs'); Rewrite(BFile); for i := 0 to fMax - 1 do begin repeat for j := 0 to 5 do Bet.Number[j] := Random(49) + 1; until CheckUnique(Bet); BubbleSort(Bet.Number); Write(BFile, Bet); if i mod fStep = 0 then Synchronize(@UpdateProgress); end; CloseFile(BFile); Synchronize(@Enable); end; {==============================================================================} end. Link do komentarza Udostępnij na innych stronach More sharing options...
olesio Napisano Sierpień 20, 2014 Zgłoś Share Napisano Sierpień 20, 2014 @babubabu: trochę odgrzałeś stary wątek, ale ok. I Ty z tym sprawdzanie unikatów tak na poważnie? Poza tym autorowi wątku zalecam przesiadkę na FPC, o ile jeszcze tutaj zajrzy. A i formatowanie kodu po ludzku by się przydało. I chyba w przypadku odpowiedzi parser rozwalił formatowanie. Ja pokażę jak najprościej można wylosować liczy z dużego lotka, które zrobiłem kiedyś w starym programie w D3. procedure TMainForm.Losuj_Multi_Lotek; const IleLiczb = 20; IloscKul = 80; var Wyniki : array[1..IleLiczb] of Byte; I, J, Liczba : Byte; Losuj : Boolean; WynikiLosowania : string; begin for I := 1 to IleLiczb do begin Losuj := False; while not Losuj do begin Losuj := True; Liczba := Random(IloscKul) + 1; if I > 1 then for J := 1 to I - 1 do if Wyniki[J] = Liczba then Losuj := False; end; Wyniki[i] := Liczba; end; Sort_shell(Wyniki); for I := 1 to IleLiczb do begin if I = 1 then begin WynikiLosowania := IntToStr(Wyniki[i]); end else begin WynikiLosowania := WynikiLosowania + #32 + IntToStr(Wyniki[i]); end; end; TempSL.Add(WynikiLosowania); end; EDIT: tak, jednak to parser rozwala formatowanie, chyba chcąc stosować na już sformatowane kolejne. Pozdrawiam: olesio Link do komentarza Udostępnij na innych stronach More sharing options...
babubabu Napisano Wrzesień 7, 2014 Zgłoś Share Napisano Wrzesień 7, 2014 @olesio tak z tym sprawdzaniem unikatów to poważnie XD. Nie wpadłem na pomysł jak zrobić to lepiej Link do komentarza Udostępnij na innych stronach More sharing options...
Polecane posty
Zarchiwizowany
Ten temat jest archiwizowany i nie można dodawać nowych odpowiedzi.