Поиск

Вход на сайт

Файлы

  • Игры 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
  • Tom Clancy's Splinter Cell: Conviction Multiplayer patch
  • Каталог статей

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

    Работа с деревьями на Паскале (Pascal)
    Задание: Дан текстовый файл с изображением целых чисел, которые переписать в стек St1. Используя стек St2, выбрать только нечетные положительные числа и построить из них сбалансированное  дерево.

    Исходный код:
    Program Lab12;
    uses crt;
    type Ptr=^Node;
         Node=record
           Dn:Integer;
           Ln,Rn:Ptr;
         end;

    Type
    TElement=^element;
     Element=record
     a:integer;
     next:TElement;
    End;

    procedure proverka(filename:string);
    var f:text;
    Begin
     {$I-}
      Assign(f,filename);
      reset(f);
     {$I+}
      if ioresult<>0 then Begin textcolor(204); writeln('ERROR FILE!!!'); readln; halt; End
      else writeln('fail "',filename,'" otkrit');
    End;

    procedure printfile(filename:string);
    var f:text;
        a:string; b:integer;
     Begin
     Assign(f,filename);
     reset(f);
     while not eof(f) do
      Begin
       readln(f,a);
       writeln(a);
      End;
     close(f);
    End;

    procedure CreateStack(var First:TElement; x:integer);
    var Q:TElement;
    Begin
     new(Q);
     Q^.a:=x;
     Q^.next:=First;
     First:=q;
    End;

    function PrintStack(var First:TElement; var x:integer):boolean;
     var q:TElement;
      begin
        if First=nil then PrintStack:=false else
         Begin
          x:=First^.a;
          Q:=First;
          First:=First^.next;
          dispose(q);
          PrintStack:=true;
         End;
      end;


     function KolEl(var T:ptr):integer;
      begin
       if T=nil then  kolel:=0
       else kolEL:=kolel(T^.Ln)+1+kolel(T^.Rn);
      end;

     procedure AddTree(var t:Ptr; D:integer);
      begin
       if t=nil then
                  begin
                   new(t);
                   t^.Dn:=D;
                   t^.Ln:=nil;
                   t^.Rn:=nil;
                  end
                else if kolEL(t^.Ln)<kolEL(t^.Rn) then AddTree(t^.Ln,D)
                                              else AddTree(t^.Rn,D);
      end;


    procedure PrintTree(t:Ptr; H:integer);
    const M=6;
    var i:integer;
     begin
      if T<>nil then
       begin
        PrintTree(t^.Ln,H+M);
        for i:=1 to H do write(' ');
        Writeln(t^.Dn);
        PrintTree(t^.Rn,H+M);
       end;
     end;

     procedure DoneTree(t:Ptr);
      begin
       if t<>nil then
                  if (t^.Ln=nil) and (t^.Rn=nil) then Dispose(t)
             else
              begin
               DoneTree(t^.Ln);  t^.Ln:=nil;
               DoneTree(t^.Rn);  t^.Rn:=nil;
               Dispose(t);
              end;
      end;
     
    procedure transfer(var First:TElement; filename:string);
    var F:text; st,sl:string; l,code,x:integer;
    Begin
     Assign(f,filename);
     reset(f);
     st:='';
     sl:='';
     while not eof(f) do
      Begin
       readln(f,st);
        for l:=1 to length(st) do
         Begin
          if st[l]<>' ' then sl:=sl+st[l] else
           Begin
            val(sl,x,code);
            CreateStack(First,x);
            sl:='';
           End;
         End;
      End;
    close(F);
    End;


    {===========================MAIN===============================}

    var  i,z,U:integer;
         t:Ptr;
         First, First2:TElement;
         
    BEGIN
    ClrScr;
    first:=nil;
    first2:=nil;
    t:=nil;
    i:=0;

    writeln('1: BBOD 4uceJl Bpy4HyIO');
    writeln('2: B39Tb 4ucJlA u3 qpauJla');
    write('-->');
    readln(u);
    writeln;

    if u=1 then
     Begin
      writeln('vvedite 4isla: ');
       readln(z);
       CreateStack(First,z);
       while z<>0 do
        Begin
         readln(z);
         CreateStack(First,z);
        End;
     End;
       
      if u=2 then
      Begin
       proverka('g:\in.txt');
       printfile('g:\in.txt');
       transfer(First,'g:\in.txt');
      End;
       writeln('sodergimoe pervogo steka: ');
       while PrintStack(First,z)<>false do
        Begin
         write(z,' ');
         if ((i mod 2<>0) and (z>0)) then CreateStack(First2,z);
         inc(i);
        End;
       writeln;
       writeln('sodergimoe vtorogo steka: ');
       while PrintStack(First2,z)<>false do Begin write(z,' '); AddTree(t,z); End;
       writeln;
       writeln('vivod dereva: ');
       writeln;
       PrintTree(t,4);
       DoneTree(t);

     readln;
    End.



    Можно найти по поисковым словам:
    delphi delphi +для начинающих delphi 2009 delphi 2009 скачать delphi 2010 исходники delphi 7 delphi 7 скачать delphi 7 скачать бесплатно delphi word исходники delphi исходник архиватор delphi исходник браузера delphi исходник графического редактора delphi исходник троян delphi исходник часы delphi исходники excel delphi исходники бд delphi исходники сеть delphi исходники скачать delphi транспортная задача исходники mysql delphi исходники opengl delphi исходники pascal psd исходники psd шаблоны rsa delphi исходник бесплатно скачать исходники delphi графика исходники delphi исходник delphi player исходник delphi плеера исходник icq клиента delphi исходник telnet delphi исходник вируса +на delphi исходник чата delphi исходники исходники +для фотошопа исходники +на delphi 7.0 исходники +на паскале исходники access delphi исходники delphi исходники delphi 2009 исходники delphi 3d исходники delphi 7 исходники delphi ado исходники delphi com порт исходники delphi firebird исходники delphi mp3 исходники delphi калькулятор исходники delphi клиент сервер исходники delphi тест исходники icq delphi исходники pascal исходники базы данных delphi исходники бесплатно delphi исходники вирусов +на delphi 7 исходники игр delphi исходники курсовых +на delphi исходники программ +на delphi исходники программ delphi 7 почтовый клиент исходник delphi программы +на pascal самоучитель delphi симплекс метод исходники delphi скачать исходники delphi 7 текстовый редактор delphi исходник шахматы исходник delphi шифрование delphi исходник
    Категория: Pascal | Добавил: _Hz_ (28.02.2010)
    Просмотров: 880 | Рейтинг: 0.0/0
    Всего комментариев: 0
    Добавлять комментарии могут только зарегистрированные пользователи.
    [ Регистрация | Вход ]

    Статистика





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

    Ссылки

    dim-dragon.ucoz.ru