Поиск

Вход на сайт

Файлы

  • Игры 240х400 - Сборник из 72 игр для сенсорных телефонов
  • Windows 7 активатор
  • WallHack для Call of Duty 4 Modern Warfare[multiplayer]
  • Обои для Samsung s5230 720х400
  • Kassy 0.3 + crack (печать товарных чеков)
  • Jimm 0.6.0
  • Mail Agent на телефон (jar)
  • Механоиды гонки на выживание nocd
  • Читы CS 1.6 - Wallhack v4
  • Tequilacat Book Reader 2.2.8
  • Обои для Samsung s5230 720х400
  • Обои для Samsung s5230 720х400
  • l4d_update_1013_to_1014
  • Windows 7 Activator Pack
  • Сборник виджетов для SAMSUNG S5230
  • Шпаргалка по русскому языку
  • Ad Muncher 4.9 Build 31235
  • TMS Component Pack v5.4.2.0 (C++Builder, Delphi) Full Source
  • Архив файлов для Guitar Pro
  • Шпаргалка по математике
  • KKiller v3.4.4
  • Решатель транспортных задач
  • Radmin_3.3_+_Key
  • Sound_Forge_9.0a + crack
  • GPU-Z 0.3.8 (RUS/2009)
  • Чит для Battlefield 2 || ArtificialAiming Radar v2.6
  • Игры для Nokia 5800, N97, 5230, 5530, X6 - Игры для смартфонов серии Nokia Touch, с сенсорным экраном 360 x 640 (S60 5th Edition)
  • Читы CS 1.6 - BadBoy v5.0
  • Читы для lineage 2
  • Total Commander
  • Каталог статей

    Главная » Статьи » Языки программирования » Pascal

    Работа со списками на Паскале (Pascal)
    Задание: Создать и заполнить список целыми числами. Найти минимальный и максимальный элементы списка; подсчитать количество мин. и макс. элементов в списке; вывести на экран индексы мин. и макс. элементов;вывести на экран индексы первого и последнего вхождений мин. и макс.

    Исходный код:

    Program spiski;
    uses crt;
    Type
    TElement=^element;
     Element=record
     a:integer;
     next:TElement;
    End;

    var Q,last,head:TElement; m,j,c:integer;

    {====sozdanie spiska====}

    procedure createhead(var head,last:TElement);
    Begin
     new(head);
     head^.next:=nil;
     last:=head;
    End;

    {====zapolnenie spiska=====}

    Procedure add(var last:TElement; k:integer);
    var Q:TElement;
    Begin
      new(Q);
       Q^.a:=k;
       Q^.next:=nil;
       last^.next:=Q;
       Last:=Q;
     End;

    {====vivod na ekran spiska====}

    procedure print(head:TElement);
    var Q:TElement;  l:integer;
    Begin
     Q:=head^.next;
     while Q<>nil do
      Begin
       write(Q^.a,'-->');
       Q:=Q^.next;
      End;
     writeln;
    End;

    {====vipoln9Iet...====}

    procedure poisk(head:TElement);
    var Q,O:TElement;  max,min,iax,iin,i,p:integer;
    Begin
    {====poisk min i max zna4enii iz spiska====}
     Q:=head^.next;
     max:=q^.a;
     min:=q^.a;
     while Q<>nil do
      Begin
       if q^.a<min then min:=q^.a;
       if q^.a>max then max:=q^.a;
       Q:=Q^.next;
      End;
     textcolor(9);
     writeln('max= ',max,' | min= ',min);
    {====poisk indexov min i max zna4enii povtoreni9I}
     writeln('indexi: ');
     Q:=head^.next;
     i:=1;
     iax:=0;
     iin:=0;
     while q<>nil do
      Begin
       if q^.a=min then Begin iin:=iin+1; textcolor(4); write(i,' '); End;
       if q^.a=max then Begin iax:=iax+1; textcolor(2); write(i,' '); End;
       Q:=q^.next;
       inc(i);
      End;
     textcolor(12);
     writeln;
     writeln('kol-vo max= ',iax,' | kol-vo min= ',iin);

     textcolor(4);
     write('pervoe i poslednee vhozhdenie minimalnogo: ');
     writeln;
     i:=1;
     Q:=head^.next;
     while q^.a<>min do Begin Q:=q^.next; inc(i); End;
     p:=i;
     write(p,' ');
     while q<>nil do
     Begin
      if q^.a=min then p:=i;
      Q:=q^.next;
      inc(i);
     End;
     writeln(p);

     textcolor(2);
     write('pervoe i poslednee vhozhdenie maximalnogo: ');
     writeln;
     i:=1;
     Q:=head^.next;
     while q^.a<>max do Begin Q:=q^.next; inc(i); End;
     p:=i;
     write(p,' ');
     while q<>nil do
      Begin
       if q^.a=max then p:=i;
       Q:=q^.next;
       inc(i);
      End;
     write(p);

    End;

    {Function DiskFree(Drive : Byte) : Longint;
    Function DiskSize(Drive : Byte) : Longint;}

    BEGIN
    clrscr;
    createhead(head,last);
     j:=1;
     textcolor(6);
     write(j,'. ');
     textcolor(9);
     readln(m);
     inc(j);
     if m<>0 then
      Begin
       while m<>0 do
        Begin
         add(last,m);
         textcolor(6);
         write(j,'. ');
         textcolor(9);
         readln(m);
         inc(j);
        End;
       End
     else Begin textcolor(214);Writeln('spisok pust'); readln; Exit; End;
    textcolor(13);
    print(head);
    poisk(head);
    readln;
    END.

    Категория: Pascal | Добавил: _Hz_ (28.02.2010)
    Просмотров: 1020 | Рейтинг: 0.0/0
    Всего комментариев: 0
    Добавлять комментарии могут только зарегистрированные пользователи.
    [ Регистрация | Вход ]

    Статистика





    Онлайн всего: 1
    Гостей: 1
    Пользователей: 0

    Ссылки

    dim-dragon.ucoz.ru