Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
1 / 1 / 0
Регистрация: 11.12.2014
Сообщений: 135
1

Написать процедуру удаления указанного поддерева

19.02.2015, 21:24. Показов 416. Ответов 0
Метки нет (Все метки)

Author24 — интернет-сервис помощи студентам
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
unit Unit1; 
 
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, Menus;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    BitBtn4: TBitBtn;
    btn1: TButton;
    btn3: TButton;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    procedure BitBtn4Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
 uktr=^uz;
 uz=record
     data:integer;
     row,col,col1:integer; {kol2-âî âðåìÿ îáõîäà}
     ur:integer;
     left,right:uktr;
    end;
var
 Form1: TForm1;
 kor:uktr;
 ver:uz;
 ft :text;
 n,i,k,k1,l,r:integer;
 fout:TextFile;
implementation
 
{$R *.dfm}
function st2(n:integer):integer;
//Степень 2 необходимая для вывода изображения дерева
var
 m,j:integer;
begin
 m:=1;
 for j:=1 to n do
  m:=m*2;
 st2:=m;
end;
procedure addtree(var base:uktr;inf:integer);
//Добавление узла
begin
 if base=nil then
 begin
  new(base);
  base^.data:=inf;
  base^.left:=nil;
  base^.right:=nil;
  base^.row:=l;
  base^.col:=k;
  base^.col1:=k1;
  base^.ur:=r;
 end
 else
 begin
  inc(r);
  l:=base^.row+8;
  if base^.data>inf then
  begin
   k:=base^.col -st2(4-base^.ur);
   k1:=base^.col-st2(3-base^.ur);
   addtree(base^.left,inf);
  end
  else
  begin
   k:=base^.col+st2(4-base^.ur);
   k1:=base^.col+st2(3-base^.ur);
   addtree(base^.right,inf);
  end
 end;
end;
procedure TForm1.BitBtn4Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.btn1Click(Sender: TObject);
var
  ft:TextFile;
begin
 assignfile(ft,'tree1.txt');
 reset(ft);
 k:=32;
 l:=1;
 Чтение элементов из файла и добавление их в дерево
 while not eoln(ft) do
 begin
  r:=0;
  read(ft,ver.data);
  addtree(kor,ver.data);
 end;
 closefile(ft);
end;
 
procedure obchod3(base:uktr);
//Обход для вывода изображения дерева 
var
  dt:string;
begin
 if base<>nil then
 begin
  obchod3(base^.left);
  with Form1.Image1 do
  begin
   dt:=IntToStr(base^.data);
   canvas.Ellipse(base^.col*10-20,base^.row*10,base^.col*10+20,base^.row*10+40);
   canvas.TextOut(base^.col*10-5,base^.row*10+13,dt);
   canvas.moveTo(base^.col*10,base^.row*10);
   if base^.ur>0 then
   begin
    if base^.col<base^.col1 then
     canvas.lineTo(base^.col1*10+st2(4-base^.ur)*10,base^.row*10-40)
    else
     canvas.lineTo(base^.col1*10-st2(4-base^.ur)*10,base^.row*10-40);
   end;
   obchod3(base^.right);
  end;
 end;
  if kor=nil then
  begin
  with Form1.Image1 do
  begin
   canvas.Ellipse(10+310,10*5,10*5+310,10);
   canvas.TextOut(10*20+133,2*10,'nil');
   canvas.moveTo(338,50);
   canvas.lineTo(320,75);
   canvas.moveTo(338,50);
   canvas.lineTo(360,75);
  end;
   end;
end;
procedure TForm1.btn3Click(Sender: TObject);
begin
 Image1.Canvas.Brush.Color:=clwhite;
 Image1.Canvas.FillRect(ClientRect);
 Image1.Canvas.Brush.Color:=clred;
 Image1.Canvas.Font.Color:=clwhite;
 Image1.Canvas.Pen.Width:=2;
 Image1.Canvas.Pen.Color:=clgreen;
 obchod3(kor);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 Image1.Canvas.Brush.Color:=clwhite;
 Image1.Canvas.FillRect(ClientRect);
 r:=0;
 ver.data:=strtoint(edit1.text);
 addtree(kor,ver.data);
 Image1.Canvas.Brush.Color:=clred;
 Image1.Canvas.Font.Color:=clwhite;
 Image1.Canvas.Pen.Width:=2;
 Image1.Canvas.Pen.Color:=clgreen;
 obchod3(kor);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 
end;
end.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
19.02.2015, 21:24
Ответы с готовыми решениями:

Прошу исправить процедуру удаления из типизированного файла и процедуру сортировки!
Ребятки!Help!!!Помогите пожалуйста...завтра сдавать работу. Посмотрите процедуру сортировки...

Создать собственную процедуру для удаления из строки n элементов, начиная с позиции Poz
Помогите пожалуйста. Нужно создать собственную процедуру для удаления из строки, n элементов,...

Написать процедуру удаления
Написать процедуру удаления из строки S всех вхождений подстроки Subs.

Написать процедуру удаления записи из файла
Program Term_paper; Uses Crt; Type programma=record {Zapis, sootvetstvuyushaya programme}...

0
19.02.2015, 21:24
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
19.02.2015, 21:24
Помогаю со студенческими работами здесь

Написать процедуру удаления полного стэка к программе
type ptr = ^stack; stack = record inf: integer; next: ptr end; var kon,...

Написать процедуру удаления максимального элемента очереди
Написать процедуру удаления максимального элемента очереди лабораторная помогите

Написать процедуру удаления из строки всех кратных символов
Всем доброго времени суток. Давно просматриваю ваш форум по Паскалю, но вот только сейчас решил...

Написать процедуру удаления из текстового файла каждого второго символа
Здравствуйте. Помогите решить задание. Дан файл произвольных символов. Написать процедуру удаления...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
1
Ответ Создать тему
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru