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.

