Advertisement
rhouland

millisecs stoping random number

Jun 20th, 2018
332
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 6.12 KB | None | 0 0
  1. unit Unit1;
  2.  
  3. interface
  4. // Copyright:  rhouland@epastas.lt  2018.06.19
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, jpeg, ExtCtrls, StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Image1: TImage;
  12.     Button1: TButton;
  13.     Label1: TLabel;
  14.     Label2: TLabel;
  15.     Button2: TButton;
  16.     Button3: TButton;
  17.     Button4: TButton;
  18.     Edit1: TEdit;
  19.     Button5: TButton;
  20.     Button6: TButton;
  21.     Label3: TLabel;
  22.     Label4: TLabel;
  23.     procedure Button1Click(Sender: TObject);
  24.     procedure FormCreate(Sender: TObject);
  25.     procedure Button2Click(Sender: TObject);
  26.     procedure Button5Click(Sender: TObject);
  27.     procedure Button3Click(Sender: TObject);
  28.     procedure Button4Click(Sender: TObject);
  29.     procedure Button6Click(Sender: TObject);
  30.   private
  31.     { Private declarations }
  32.   public
  33.     { Public declarations }
  34.   end;
  35.  
  36. var
  37.   Form1: TForm1;
  38. var ss, ms, mm, ss2, ms2, mm2, bb, dd, yy, sss, ssss: String;
  39. var int, a, x, y, z, v, ii, pp, gg, tt, rr, ff, cc, hh, kk, kk2, cik, j, u: integer;
  40. hours, mins, secs, milliSecs : Word;
  41. var flag:boolean;
  42. ee: Array[0..999] of Integer;
  43. zz: array[0..999] of integer;
  44. nn: array[0..999] of integer;
  45. res: set of 0..99;
  46.  
  47. t: TStream;
  48. i:integer;
  49. m: array[1..999] of integer;
  50. f: textfile;
  51. { Name_g : array[1..255,1..255] of string;  }
  52.  
  53. implementation
  54.  
  55. type
  56.   TMEdit = class(TEdit)
  57.     procedure CreateParams(var Params: TCreateParams); override;
  58.   end;
  59.  
  60. { TMEdit }
  61.  
  62. procedure TMEdit.CreateParams(var Params: TCreateParams);
  63. begin
  64.   inherited;
  65.   Params.Style := Params.Style or ES_CENTER;
  66. end;
  67.  
  68. {$R *.dfm}
  69.  
  70. procedure TForm1.Button1Click(Sender: TObject);
  71. begin
  72. // generuojams milisekundziu taimeris:
  73.  
  74. x:=x+1;
  75. ms:=IntToStr(x);
  76. Label2.Caption:=ms;
  77.  
  78. DecodeTime(now, hours, mins, secs, milliSecs);
  79. RandSeed := milliSecs;
  80. begin
  81. int := 0 + Random(100);
  82. end;
  83. a:= int;
  84. ee[x]:=a;
  85. ss:=IntToStr(a);
  86. Label1.Caption:=ss;
  87.  
  88. // o cia bus patikrinimas ar jau paskutinis elementas iskrito:
  89. // kiekviena masyvo elementa patikrinti ar patenka i diapazona nuo 1 iki 100:
  90.  
  91. begin
  92.  
  93. res:=[0..99];
  94. for ii:=1 to 999 do
  95. if ee[ii] in res then exclude(res,ee[ii]);
  96. if res=[] then Label3.Visible := False;
  97. if res=[] then gg:=gg+1;
  98. if gg = 1 then dd:=ms;
  99. if gg = 1 then tt:=x;
  100. if gg = 1 then rr:=1;
  101. if rr = 1 then sss:=dd;
  102. if gg = 1 then cc:=StrToInt(dd);
  103. if gg = 1 then ff:=ee[cc];
  104. if gg = 1 then ssss:=IntToStr(ff);
  105. if gg > 0 then bb:= 'Rinkinys pilnas: ' + dd + ' element.!';
  106. if res=[] then Label4.Caption := bb;
  107. if res=[] then Label4.Visible := True;
  108.  
  109. end;
  110.  
  111. end;
  112.  
  113. procedure TForm1.FormCreate(Sender: TObject);
  114. begin
  115. Label1.Caption:=':';
  116. Label2.Caption:=':';
  117. x:=0;
  118. Edit1.Text:='0';
  119. ee[0]:=0;
  120. PPointer(Edit1)^ := TMEdit;
  121. end;
  122.  
  123. procedure TForm1.Button2Click(Sender: TObject);
  124. begin
  125. pp:=0;
  126. gg:=0;
  127. rr:=0;
  128. tt:=0;
  129. Label1.Caption:=':';
  130. Label2.Caption:=':';
  131. x:=0;
  132. Edit1.Text:='0';
  133. FillChar(ee, SizeOf(ee), 0);  // valom masyva
  134. end;
  135.  
  136. procedure TForm1.Button5Click(Sender: TObject);
  137. begin
  138. //atkurti nurodyto masyvo reiksme:
  139. Label1.Caption:='';
  140. Label2.Caption:='';
  141. mm:=Edit1.Text;
  142. y:=StrToInt(mm);
  143. ss2:=mm;
  144. z:=ee[y];
  145. ms2:=IntToStr(z);
  146. Label1.Caption:=ms2;
  147. Label2.Caption:=ss2;
  148.  
  149. end;
  150.  
  151. procedure TForm1.Button3Click(Sender: TObject);
  152. begin
  153. Label1.Caption:='';
  154. Label2.Caption:='';
  155. mm:=Edit1.Text;
  156. y:=StrToInt(mm);
  157. y:=y-1;
  158. mm2:=IntToStr(y);
  159. Edit1.Text:=mm2;
  160. ss2:=mm2;
  161. z:=ee[y];
  162. ms2:=IntToStr(z);
  163. Label1.Caption:=ms2;
  164. Label2.Caption:=ss2;
  165. end;
  166.  
  167. procedure TForm1.Button4Click(Sender: TObject);
  168. begin
  169. Label1.Caption:='';
  170. Label2.Caption:='';
  171. mm:=Edit1.Text;
  172. y:=StrToInt(mm);
  173. y:=y+1;
  174. mm2:=IntToStr(y);
  175. Edit1.Text:=mm2;
  176. ss2:=mm2;
  177. z:=ee[y];
  178. ms2:=IntToStr(z);
  179. Label1.Caption:=ms2;
  180. Label2.Caption:=ss2;
  181. end;
  182.  
  183. procedure TForm1.Button6Click(Sender: TObject);
  184. begin
  185.  
  186. // padaryti masyvo ee turinio kopija i masyva zz:
  187. for hh:=1 to 999 do begin
  188. zz[hh]:=ee[hh];
  189. end;
  190.  
  191. // surikiuoti masyva zz is masyvo ee:
  192. for cik:=1 to 999 do begin
  193. for hh:=cik to 999 do begin
  194. kk:=zz[cik];
  195. kk2:=zz[hh+1];
  196. if kk=kk2 then zz[hh+1]:=999;
  197. end;
  198. end;
  199. // rikiavimas baigtas. 999 elementu masyve zz be pasikartojimo plius 999
  200.  
  201. // pripildyti masyva nn sutraukiant visus elementus su 999:
  202. u:=0;
  203. for j:=1 to 999 do begin
  204. u:=u+1;
  205. nn[u]:=zz[j];
  206. if zz[j]=999 then u:=u-1;
  207. end;
  208. // masyvas nn sutrauktas ir parengtas.
  209.  
  210.   t := TMemoryStream.Create;
  211.   if gg <> 1 then tt:=x;
  212. if rr < 1 then sss:='PILNAS RINKINYS NEPASIEKTAS!';
  213.     for i:= 1 to tt do
  214.       m[i]:= ee[i];
  215.         begin
  216.           AssignFIle(F,'info.txt');
  217.           Rewrite(f);
  218.             yy:=IntToStr(tt);
  219.             Writeln(f,' Visas masyvų skaičius yra: '+yy);
  220.             Writeln(f,'');
  221.             for i := 1 to tt do begin
  222.             Write(f,' ',i,'=',m[i],';  ');
  223.             end;
  224.             Writeln(f,' ');
  225.             Writeln(f,' ');
  226.             Writeln(f,' Pilnas elementų rinkinys užsipildo sulig: '+sss);
  227.             Writeln(f, ' '+sss+' -as elementas yra: '+ssss);
  228.             Writeln(f, ' ');
  229.             Write(f, ' pirmi 200-ai elementų eilės tvarka: ');
  230.             Writeln(f,' ');
  231.             Writeln(f, ' ');
  232.             for i:=1 to 200 do begin
  233.             Write(f, ee[i],'  ');
  234.             end;
  235.             Writeln(f, '  ');
  236.             Writeln(f, '  ');
  237.             Writeln(f, '  visi 100-as atskiri ir skirtingi elementai: ');
  238.             Writeln(f, '  ');
  239.             for i:=1 to 16 do begin
  240.             Write(f, nn[i],'; ');
  241.             end;
  242.             Writeln(f, '  ');
  243.             for i:=17 to 32 do begin
  244.             Write(f, nn[i],'; ');
  245.             end;
  246.             Writeln(f, '  ');
  247.             for i:=33 to 49 do begin
  248.             Write(f, nn[i],'; ');
  249.             end;
  250.             Writeln(f, '  ');
  251.             for i:=50 to 66 do begin
  252.             Write(f, nn[i],'; ');
  253.             end;
  254.             Writeln(f, '  ');
  255.             for i:=67 to 83 do begin
  256.             Write(f, nn[i],'; ');
  257.             end;
  258.             Writeln(f, '  ');
  259.             for i:=84 to 100 do begin
  260.             Write(f, nn[i],'; ');
  261.             end;
  262.             Writeln(f, '  ');
  263.          CloseFile(f);
  264.         end;
  265.       t.Free;
  266. end;
  267.  
  268. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement