uses Graph, CRT; Type ps = ^el; el = record data : integer; prev : ps; end; var taba : array [1..50] of ps; tabb : array [1..50] of ps; A,B,tm,t1,t2 : ps; Procedure PUSH(i:integer;var head:ps); var ne : ps; begin New(ne); ne^.data := i; ne^.prev := head; head := ne; end; Function POP(var head:ps):integer; var ret:integer;newhead:ps; begin if (head=nil) then begin POP:=0; exit; end; ret := head^.data; newhead := head^.prev; Dispose(head); head := newhead; POP := ret; end; Procedure Init; var grDriver, grMode : integer; Errcode : Integer; begin grDriver := Detect; InitGraph(grDriver, grMode,' '); { SetWriteMode(XORPut);} ErrCode := GraphResult; if ErrCode <> grOk then begin writeln('Нет графики!!!');Halt(2);end; SetFillStyle(XHatchFill,Green); SetColor(Blue); Bar(0,0,639,479); SetfillStyle(SolidFill,Black); Setcolor(black); Bar(20,20,620,460); end;{Init} {-----------} Procedure ShowOne(num : word;it:string;color:byte); var x, y, offs : integer; begin x:=0;y:=0; offs:=0; if (num>50) then begin y:=200; dec(num,50);offs:=-10;end; inc(y,100); x := 30+num*40; SetColor(color); rectangle(x,y,x+30,y+30); line(x,y+20+offs,x+30,y+20+offs); line(x+15,y+20+offs,x+15,y+30+(offs*3)); SetTextJustify(CenterText,CenterText); outtextxy(x+15,y-offs+10,it); end;{ShowOne} {-------------------} Function GetNum(elem:ps):integer; var i:word; begin i:=1; while (taba[i+1]<>nil) and (taba[i]<>elem) do inc(i); if taba[i]<>elem then begin i:=1; while (tabb[i+1]<>nil) and (tabb[i]<>elem) do inc(i); if tabb[i]<>elem then GetNum:=0 else GetNum:=i+50; end else GetNum:=i; end; {GetNum} {------------------} Procedure Link(n1,n2:word;color:byte); var offs1,offs2,x1,x2,y1,y2:integer; begin x1:=0;y1:=0;x2:=0;y2:=0;offs1:=0;offs2:=0; if (n1>50) then begin y1:=200; dec(n1,50);offs1:=-10;end; if (n2>50) then begin y2:=200; dec(n2,50);offs2:=-10;end; inc(y1,100); inc(y2,100); x1 := 30+n1*40; x2 := 30+n2*40; SetColor(color); line(x1,y1+30+2*offs1,x1+15,y1+20+2*offs1); line(x1+8,y1+25+2*offs1,x2+22,y2+25+2*offs2); end; {Link} {---------------------} Procedure ShowLists; var i : integer; itt : string; begin i:=1; while (taba[i]<>nil) do begin str(taba[i]^.data,itt); ShowOne(i,itt,Blue); inc(i); end; i :=1; while (tabb[i]<>nil) do begin str(tabb[i]^.data,itt); ShowOne(i+50,itt,Red); inc(i); end; end; {ShowList} {-----------} Var fA,fB,fO : text; item,i : integer; Begin Init; Assign(fA,'a.txt'); Assign(fB,'b.txt'); Assign(fO,'res.txt'); Reset(fa);Reset(fB);Rewrite(fO); A:=nil;B:=nil; i:=1; fillchar(taba,50,0); while not eof(FA) do begin read(fA,item); PUSH(item,A);taba[i]:=A;inc(i)end; i:=1; fillchar(tabb,50,0); while not eof(FB) do begin read(fB,item); PUSH(item,B);tabb[i]:=B;inc(i)end; close(fA);close(fB); ShowLists; if (A^.datanil) do begin if (t1^.prev^.data0) then PUSH(item,B); until item=0; repeat item:=POP(B); if (item<>0) then WriteLn(fO,item); until item=0; Close(fO); ReadKey; End.