Nadesłany przez Michał Knasiecki, 12 sierpnia 2005 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
scalanie_d/Unit1.pas:
//Program został pobrany ze strony www.algorytm.org //Opracował Michał Knasiecki unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Gauges, ComCtrls; type TForm1 = class(TForm) ListBox1: TListBox; Label1: TLabel; Button1: TButton; Button2: TButton; Button3: TButton; Label2: TLabel; Label3: TLabel; Label4: TLabel; Edit1: TEdit; UpDown1: TUpDown; ListBox2: TListBox; procedure Button3Click(Sender: TObject); procedure FormActivate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Edit1Change(Sender: TObject); private { Private declarations } public { Public declarations } end; Type tablica=array[1..100000] of integer; var Form1: TForm1; Ciag1,Ciag2,Ciag3:tablica; implementation uses Unit2; {$R *.DFM} procedure przegladaj(const nr:integer); var f:textfile; s:string; begin if fileexists('Plik'+inttostr(nr)+'.txt') then begin form1.listbox2.clear; assignfile(f,'Plik'+inttostr(nr)+'.txt'); reset(f); while not(eof(f)) do begin readln(f,s); form1.listbox2.items.add(s); end; closefile(f); end; end; procedure scal_ciagi(Liczba_wyrazow1,Liczba_wyrazow2:integer); var i,i1,i2,i3:integer; koniec:boolean; begin i1:=1; i2:=1; i3:=1; koniec:=false; repeat if ciag1[i1]<=ciag2[i2] then begin ciag3[i3]:=ciag1[i1]; inc(i3); inc(i1); end; if ciag1[i1]>ciag2[i2] then begin ciag3[i3]:=ciag2[i2]; inc(i3); inc(i2); end; if i1=(Liczba_wyrazow1+1) then for i:=i2 to Liczba_wyrazow2+1 do begin ciag3[i3]:=ciag2[i]; inc(i3); koniec:=true; end; if i2=(Liczba_wyrazow2+1) then for i:=i1 to Liczba_wyrazow1+1 do begin ciag3[i3]:=ciag1[i]; inc(i3); koniec:=true; end; until (koniec=true)or((i1>Liczba_wyrazow1)and(i2>Liczba_wyrazow2)); end; Procedure wczytaj_ciag(const numer_pliku:integer; Numer_tablicy:integer;out rozmiar:integer); var f:textfile; s:string; i:integer; begin i:=1; assignfile(f,'Plik'+inttostr(numer_pliku)+'.txt'); reset(f); while not(EOF(f)) do begin readln(f,s); if Numer_tablicy=1 then Ciag1[i]:=strtoint(s); if Numer_tablicy=2 then Ciag2[i]:=strtoint(s); inc(i); end; rozmiar:=i-1; closefile(f); end; procedure TForm1.Button3Click(Sender: TObject); begin application.terminate; end; function ile_ciagow:integer; var i:integer; t:boolean; begin i:=1; t:=false; while t=false do begin if not(fileexists('Plik'+inttostr(i)+'.txt')) then t:=true else inc(i); end; result:=i-1; end; procedure TForm1.FormActivate(Sender: TObject); begin if ile_ciagow>=2 then begin updown1.enabled:=true; updown1.Max:=ile_ciagow; button2.enabled:=true; label3.Caption:=inttostr(ile_ciagow); przegladaj(1); end else begin updown1.enabled:=false; button2.enabled:=false; label3.Caption:=inttostr(ile_ciagow); end; end; procedure TForm1.Button1Click(Sender: TObject); begin form2.show; end; procedure TForm1.Button2Click(Sender: TObject); var i,l,rozmiar1,rozmiar2:integer; f:textfile; begin listbox2.Clear; updown1.enabled:=false; for i:=1 to strtoint(label3.caption)-1 do begin wczytaj_ciag(i,1,Rozmiar1); wczytaj_ciag(i+1,2,Rozmiar2); scal_ciagi(Rozmiar1,Rozmiar2); assignfile(f,'Plik'+inttostr(i)+'.txt'); erase(f); assignfile(f,'Plik'+inttostr(i+1)+'.txt'); rewrite(f); for l:=1 to Rozmiar1+rozmiar2 do writeln(f,ciag3[l]); closefile(f); end; assignfile(f,'Plik'+label3.caption+'.txt'); erase(f); listbox1.clear; for i:=1 to rozmiar1+rozmiar2 do listbox1.items.add(inttostr(ciag3[i])); button2.enabled:=false; end; procedure TForm1.Edit1Change(Sender: TObject); begin przegladaj(updown1.position); end; end.