program PROBA4; uses CRT,Graph; type pt = ^elem; elem = record info: Integer; next : pt; end; var p1, first, last: pt; Const X = 195; L = 30; R = 10; function GetX(i: integer): integer; begin GetX := X + Pred(i) * (R + L); end; {---------------------------------------------------------------------------} Procedure ShowListBoxes; var j: integer; begin SetFillStyle(SolidFill, White); For j := 1 To 10 Do Bar(GetX(j), 40, GetX(j) + L, 55); SetColor(White); SetLineStyle(SolidLn, 0, 2); Line(225,47,560,47); end; Procedure ShowListItem(yPos, n: integer; p: pt); var s: string; begin str(p^.info, s); SetColor(Black); OutTextXY(GetX(n) + 5, yPos, s); end; procedure Create_list(var p, first, last: pt); {Creation of new list} var n, A: byte; curr: pt; begin first := nil; last := nil; for n:=1 to 10 do begin A:=Random(99)+1; new(curr); curr^.info := A; curr^.next := nil; ShowListItem(45, n, curr); if first=nil then first:=curr else last^.next:=curr; last:=curr; end; p := first; end; {--------------------------------------------------------------------------} function Cearch_element(const first: pt; V: integer): pt; var p: pt; M:integer; begin Cearch_element := nil; p := first; while ((p^.next<>nil) and (p^.info <> V)) do p:=p^.next; if (p^.info = V) then Cearch_element := p; end; {----------------------------------------------------------------------------} procedure Insert(var q:pt); var newelem:pt; n,X:byte; p: pt; begin New(newelem); X:=Random(98)+1; newelem^.info := X; newelem^.next := q^.next; q^.next:=newelem; p := p1; n := 1; while p<>nil do begin ShowListItem(120, n, p); inc(n); p:=p^.next; end; end; const maxItems = 6; items: array[1 .. maxItems] of string = ( 'Create new list', 'Paste cell', 'Delete cell', 'Find cell ', 'Move last cell', 'Exit' ); {----------------------------------------------------------------------------} procedure Inface;{Support grafic interface and invocation the rest procedures} Const h = 15; function GetY(i: integer): integer; begin GetY := 40 + Pred(i) * 75; end; procedure ShowBorder(Y: Integer; b: Boolean); begin If b Then SetColor(Red) Else SetColor(White); Rectangle(155, GetY(Y), 185, GetY(Y)+h); end; function CheckZero(i: Integer; Ch: Char): Boolean; begin CheckZero := false; If Ch = '0' Then Begin CheckZero := true; SetColor(LightRed); OutTextXY(200, GetY(i) + 5, 'You input 0. Input another number'); End; end; function CheckValueZero(i: Integer; V: Integer): Boolean; begin CheckValueZero := false; If V = 0 Then Begin CheckValueZero := true; SetColor(LightRed); OutTextXY(200, GetY(i) + 5, 'You input 0. Input another number'); End; end; procedure P(i: integer; Ch: Char); begin SetFillStyle(SolidFill, White); Bar(156, 5 + GetY(i) - 4, 184, 5 + GetY(i) + 9); SetColor(Black); OutTextXY(160, 5 + GetY(i), Ch); SetColor(DarkGray); SetFillStyle(SolidFill, DarkGray); Bar(195, 5 + GetY(i) - (10 + (4 - i)*5), GetMaxX-5, 5 + GetY(i) - (10 + (4 - i)*5) + 30); end; var ch:char; M:integer; const n: array[2 .. 4] of boolean = ( true, true, true ); var i, j, iY: integer; y: string; q: pt; begin iY := 1; SetColor(LightGray); SetFillStyle(SolidFill, LightGray); Bar(0,0,190,GetMaxY); SetColor(DarkGray); SetFillStyle(SolidFill, DarkGray); Bar(190,0,GetMaxX,GetMaxY); SetColor(Blue); SetLineStyle(SolidLn,0,ThickWidth); Rectangle(0, 0, GetMaxX, GetMaxY); Line(190,0,190,GetMaxY); SetFillStyle(SolidFill, White); For j := 1 To 6 Do Bar(155,GetY(j),185,GetY(j)+h); SetColor(Green); SetFillStyle(SolidFill, Green); Bar(160,43,180,52); SetColor(Cyan); SetFillStyle(SolidFill, Cyan); Bar(160,343,180,352); SetColor(Red); SetFillStyle(SolidFill, Red); Bar(160,418,180,427); SetColor(Blue); SetTextStyle(DefaultFont, HorizDir, 2); OutTextXY(300,20,'The First list'); SetTextStyle(DefaultFont, HorizDir, 1); For i := 1 to maxItems do OutTextXY(10, 45 + pred(i)*75, items[i]); While ch <> #27 do begin ch:=Readkey; case ch of {SIMPLE} #0: case ReadKey of {HARD} {Down} #80: begin ShowBorder(iY, false); if iY <> 6 then inc(iY) else iY := 1; ShowBorder(iY, true); end; {end Down} {Up} #72: begin ShowBorder(iY, false); if iY <> 1 then dec(iY) else iY := 6; ShowBorder(iY, true); end; {end Up} end; {end case HARD} #27: break; '0'..'9': begin Case iY Of 2: begin if n[iY] then begin If not CheckZero(2, Ch) then begin P(iY, Ch); n[iY] := false; M := Ord(ch)-48; end; end else begin SetColor(Black); OutTextXY(168,120,ch); n[iY] := true; M:=M*10+(Ord(ch)-48); end; SetFillStyle(SolidFill, White); For j := 1 To 11 Do Bar(GetX(j), 115, GetX(j) + L, 130); SetColor(White); SetLineStyle(SolidLn, 0, 2); Line(225,122,600,122); end; 3: begin if n[iY] then begin If not CheckZero(3, Ch) then begin P(iY, Ch); n[iY] := false; SetColor(Red); OutTextXY(200,195,'Delete cell'); end; end else begin SetColor(Black); OutTextXY(168, GetY(iY), Ch); n[iY] := true; end; end; 4: begin if n[iY] then begin If not CheckZero(4, Ch) then begin P(iY, Ch); n[iY] := false; SetColor(Red); OutTextXY(200,270,'Find cell'); end; end else begin SetColor(Black); OutTextXY(168, GetY(iY), Ch); n[iY] := true; end; end; end; { Case iY Of } continue; end; {end 0...9} #13: begin Case iY Of 6: break; 1: begin SetColor(DarkGray); SetFillStyle(SolidFill, DarkGray); Bar(195,35,GetMaxX-10,GetMaxY-10); SetFillStyle(SolidFill, White); For i := 1 To 3 Do Bar(155, GetY(j), 185, GetY(j) + h); ShowListBoxes; Create_List(p1, first, last); end; 2: begin if not CheckValueZero(2, M) then begin SetFillStyle(SolidFill, White); For j := 1 To 11 Do Bar(GetX(j), 115, GetX(j) + L, 130); q := Cearch_element(p1, M); if q <> nil then Insert(q); end end; 5: begin SetColor(DarkGray); SetFillStyle(SolidFill, DarkGray); Bar(195,335,GetMaxX-10,GetMaxY-10); SetColor(Red); OutTextXY(200,345,'Move last cell'); end; end; { Case iY Of } continue; end; end; {end case SIMPLE} end;{end while} end; var gd, gm: integer; {---------------------------------------------------------------------------} Begin clrscr; gd:=detect; initgraph(gd, gm, ''); InFace; Randomize; CloseGraph; End.