algorytm.org

Implementacja w Delphi/Pascal



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Scalanie ciągów - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 1
SłabyŚwietny
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.
Dodaj komentarz