Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit Unit1;
- interface
- // Copyright: rhouland@epastas.lt 2018.06.19
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, jpeg, ExtCtrls, StdCtrls;
- type
- TForm1 = class(TForm)
- Image1: TImage;
- Button1: TButton;
- Label1: TLabel;
- Label2: TLabel;
- Button2: TButton;
- Button3: TButton;
- Button4: TButton;
- Edit1: TEdit;
- Button5: TButton;
- Button6: TButton;
- Label3: TLabel;
- Label4: TLabel;
- procedure Button1Click(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- procedure Button5Click(Sender: TObject);
- procedure Button3Click(Sender: TObject);
- procedure Button4Click(Sender: TObject);
- procedure Button6Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- Form1: TForm1;
- var ss, ms, mm, ss2, ms2, mm2, bb, dd, yy, sss, ssss: String;
- var int, a, x, y, z, v, ii, pp, gg, tt, rr, ff, cc, hh, kk, kk2, cik, j, u: integer;
- hours, mins, secs, milliSecs : Word;
- var flag:boolean;
- ee: Array[0..999] of Integer;
- zz: array[0..999] of integer;
- nn: array[0..999] of integer;
- res: set of 0..99;
- t: TStream;
- i:integer;
- m: array[1..999] of integer;
- f: textfile;
- { Name_g : array[1..255,1..255] of string; }
- implementation
- type
- TMEdit = class(TEdit)
- procedure CreateParams(var Params: TCreateParams); override;
- end;
- { TMEdit }
- procedure TMEdit.CreateParams(var Params: TCreateParams);
- begin
- inherited;
- Params.Style := Params.Style or ES_CENTER;
- end;
- {$R *.dfm}
- procedure TForm1.Button1Click(Sender: TObject);
- begin
- // generuojams milisekundziu taimeris:
- x:=x+1;
- ms:=IntToStr(x);
- Label2.Caption:=ms;
- DecodeTime(now, hours, mins, secs, milliSecs);
- RandSeed := milliSecs;
- begin
- int := 0 + Random(100);
- end;
- a:= int;
- ee[x]:=a;
- ss:=IntToStr(a);
- Label1.Caption:=ss;
- // o cia bus patikrinimas ar jau paskutinis elementas iskrito:
- // kiekviena masyvo elementa patikrinti ar patenka i diapazona nuo 1 iki 100:
- begin
- res:=[0..99];
- for ii:=1 to 999 do
- if ee[ii] in res then exclude(res,ee[ii]);
- if res=[] then Label3.Visible := False;
- if res=[] then gg:=gg+1;
- if gg = 1 then dd:=ms;
- if gg = 1 then tt:=x;
- if gg = 1 then rr:=1;
- if rr = 1 then sss:=dd;
- if gg = 1 then cc:=StrToInt(dd);
- if gg = 1 then ff:=ee[cc];
- if gg = 1 then ssss:=IntToStr(ff);
- if gg > 0 then bb:= 'Rinkinys pilnas: ' + dd + ' element.!';
- if res=[] then Label4.Caption := bb;
- if res=[] then Label4.Visible := True;
- end;
- end;
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- Label1.Caption:=':';
- Label2.Caption:=':';
- x:=0;
- Edit1.Text:='0';
- ee[0]:=0;
- PPointer(Edit1)^ := TMEdit;
- end;
- procedure TForm1.Button2Click(Sender: TObject);
- begin
- pp:=0;
- gg:=0;
- rr:=0;
- tt:=0;
- Label1.Caption:=':';
- Label2.Caption:=':';
- x:=0;
- Edit1.Text:='0';
- FillChar(ee, SizeOf(ee), 0); // valom masyva
- end;
- procedure TForm1.Button5Click(Sender: TObject);
- begin
- //atkurti nurodyto masyvo reiksme:
- Label1.Caption:='';
- Label2.Caption:='';
- mm:=Edit1.Text;
- y:=StrToInt(mm);
- ss2:=mm;
- z:=ee[y];
- ms2:=IntToStr(z);
- Label1.Caption:=ms2;
- Label2.Caption:=ss2;
- end;
- procedure TForm1.Button3Click(Sender: TObject);
- begin
- Label1.Caption:='';
- Label2.Caption:='';
- mm:=Edit1.Text;
- y:=StrToInt(mm);
- y:=y-1;
- mm2:=IntToStr(y);
- Edit1.Text:=mm2;
- ss2:=mm2;
- z:=ee[y];
- ms2:=IntToStr(z);
- Label1.Caption:=ms2;
- Label2.Caption:=ss2;
- end;
- procedure TForm1.Button4Click(Sender: TObject);
- begin
- Label1.Caption:='';
- Label2.Caption:='';
- mm:=Edit1.Text;
- y:=StrToInt(mm);
- y:=y+1;
- mm2:=IntToStr(y);
- Edit1.Text:=mm2;
- ss2:=mm2;
- z:=ee[y];
- ms2:=IntToStr(z);
- Label1.Caption:=ms2;
- Label2.Caption:=ss2;
- end;
- procedure TForm1.Button6Click(Sender: TObject);
- begin
- // padaryti masyvo ee turinio kopija i masyva zz:
- for hh:=1 to 999 do begin
- zz[hh]:=ee[hh];
- end;
- // surikiuoti masyva zz is masyvo ee:
- for cik:=1 to 999 do begin
- for hh:=cik to 999 do begin
- kk:=zz[cik];
- kk2:=zz[hh+1];
- if kk=kk2 then zz[hh+1]:=999;
- end;
- end;
- // rikiavimas baigtas. 999 elementu masyve zz be pasikartojimo plius 999
- // pripildyti masyva nn sutraukiant visus elementus su 999:
- u:=0;
- for j:=1 to 999 do begin
- u:=u+1;
- nn[u]:=zz[j];
- if zz[j]=999 then u:=u-1;
- end;
- // masyvas nn sutrauktas ir parengtas.
- t := TMemoryStream.Create;
- if gg <> 1 then tt:=x;
- if rr < 1 then sss:='PILNAS RINKINYS NEPASIEKTAS!';
- for i:= 1 to tt do
- m[i]:= ee[i];
- begin
- AssignFIle(F,'info.txt');
- Rewrite(f);
- yy:=IntToStr(tt);
- Writeln(f,' Visas masyvų skaičius yra: '+yy);
- Writeln(f,'');
- for i := 1 to tt do begin
- Write(f,' ',i,'=',m[i],'; ');
- end;
- Writeln(f,' ');
- Writeln(f,' ');
- Writeln(f,' Pilnas elementų rinkinys užsipildo sulig: '+sss);
- Writeln(f, ' '+sss+' -as elementas yra: '+ssss);
- Writeln(f, ' ');
- Write(f, ' pirmi 200-ai elementų eilės tvarka: ');
- Writeln(f,' ');
- Writeln(f, ' ');
- for i:=1 to 200 do begin
- Write(f, ee[i],' ');
- end;
- Writeln(f, ' ');
- Writeln(f, ' ');
- Writeln(f, ' visi 100-as atskiri ir skirtingi elementai: ');
- Writeln(f, ' ');
- for i:=1 to 16 do begin
- Write(f, nn[i],'; ');
- end;
- Writeln(f, ' ');
- for i:=17 to 32 do begin
- Write(f, nn[i],'; ');
- end;
- Writeln(f, ' ');
- for i:=33 to 49 do begin
- Write(f, nn[i],'; ');
- end;
- Writeln(f, ' ');
- for i:=50 to 66 do begin
- Write(f, nn[i],'; ');
- end;
- Writeln(f, ' ');
- for i:=67 to 83 do begin
- Write(f, nn[i],'; ');
- end;
- Writeln(f, ' ');
- for i:=84 to 100 do begin
- Write(f, nn[i],'; ');
- end;
- Writeln(f, ' ');
- CloseFile(f);
- end;
- t.Free;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement