Форум программистов, компьютерный форум, киберфорум
Наши страницы
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
Рейтинг: Рейтинг темы: голосов - 41, средняя оценка - 4.61
kolid
0 / 0 / 0
Регистрация: 30.06.2012
Сообщений: 12
#1

Создание Очереди - Delphi

01.07.2012, 21:56. Просмотров 7184. Ответов 18

Приветствую,помогите пожалуйста создать Прогу :
Разработать программу,позваляющую формировать динамическую структуру данных Очередь. Реализовать функцию добовления элементов очереди.Реализовать функцию удаления из очереди.Реализавать функцию вывода содержимого очереди.

За рание Спасибо!
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
01.07.2012, 21:56
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Создание Очереди (Delphi):

В первой очереди найти максимальный элемент и за ним вставить элементы второй очереди
задание:Создать две очереди из случайных целых чисел. В первой найти...

Заменить по очереди три слова test по очереди тремя строками из переменной Arr.Text
Есть 3 строки в переменной Arr.Text (переменная типа TStringList) Есть 3 слова...

Очереди
Помогите, пожалуйста решить пример: Элемент структуры: вещественное число...

Моделирование очереди
Помогите,пожалуйста,с программами. 1.Сформировать очередь из 6 чисел. Утроить...

Делфи. Очереди
Доброго времени суток. Дана задача: Создать очередь, информационные поля ...

Очистка очереди
Как с помощью Button5 очистить всю очередь? unit Unit1; interface ...

18
Mawrat
12821 / 5729 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
01.07.2012, 22:15 #2
Очередь на однонаправленном списке. На форму надо положить TButton и TMemo. Для TButton создать обработчик события OnClick.
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
type
  //Указатель на элемент списка (это элемент очереди или стека).
  TPElem = ^TElem;
  //Элемент списка.
  TElem = record
    Data : Integer; //Основные данные.
    PNext : TPElem; //Указатель на следующий элемент списка.
  end;
  //Очередь.
  TQueue = record
    PFirst, PLast : TPElem; //Указатели на первый и на последний элемент очереди.
  end;
 
//Инициализация очереди. Внимание! Эту процедуру можно выполнять только в том
//случае, если очередь пуста. Иначе, произойдут утечки памяти.
//Эту процедуру следует выполнять только для начальной инициализации очереди.
procedure QueueInit(var aQueue : TQueue);
begin
  aQueue.PFirst := nil;
  aQueue.PLast := nil;
end;
 
//Добавление элемента в конец очереди.
procedure QueuePush(var aQueue : TQueue; var aPElem : TPElem);
begin
  if aPElem = nil then Exit;
 
  aPElem^.PNext := nil;
  if aQueue.PFirst = nil then
    aQueue.PFirst := aPElem
  else
    aQueue.PLast^.PNext := aPElem
  ;
  aQueue.PLast := aPElem;
end;
 
//Изъятие элемента из начала очереди.
//Если очередь не пуста, то из её начала изымается элемент и возвращается
//через параметр aPElem. В этом случае, функция возвращает значение True.
//Если очередь пуста, то операция отменяется, а функция возвращает значение False.
function QueuePop(var aQueue : TQueue; var aPElem : TPElem) : Boolean;
begin
  Result := False;
  if aQueue.PFirst = nil then Exit;
 
  aPElem := aQueue.PFirst;
  aQueue.PFirst := aPElem^.PNext;
  if aQueue.PFirst = nil then aQueue.PLast := nil;
  Result := True;
end;
 
//Удаление очереди из памяти (очистка очереди).
procedure QueueFree(var aQueue : TQueue);
var
  PDel : TPElem;
begin
  while QueuePop(aQueue, PDel) do Dispose(PDel);
end;
 
//Распечатка очереди.
function QueueToStr(var aQueue : TQueue) : String;
var
  QTmp : TQueue;
  PElem : TPElem;
begin
  if aQueue.PFirst = nil then begin
    Result := 'Очередь пуста.';
    Exit;
  end;
  Result := '';
 
  //Инициализация вспомогательной очереди.
  QueueInit(QTmp);
  //Переливаем элементы из исходной очереди во временную и при этом
  //выполняем распечатку.
  while QueuePop(aQueue, PElem) do begin
    QueuePush(QTmp, PElem);
    if Result <> '' then Result := Result + ', ';
    Result := Result + IntToStr(PElem^.Data);
  end;
  
  aQueue := QTmp;
end;
 
//Демонстрация работы с очередью.
procedure TForm1.Button1Click(Sender: TObject);
const
  //Количество элементов в очереди.
  M = 10;
var
  Q1, Q2 : TQueue;
  PElem : TPElem;
  i : Integer;
begin
  Memo1.Clear;
 
  //Начальная нициализация очередей.
  QueueInit(Q1);
  QueueInit(Q2);
 
  for i := 1 to M do begin
    New(PElem);
    PElem^.Data := i;
    QueuePush(Q1, PElem);
  end;
  Memo1.Lines.Add('--------------------------------------------------');
  Memo1.Lines.Add('Составлена первая очередь:');
  Memo1.Lines.Add(QueueToStr(Q1));
 
  for i := 1 to M do begin
    New(PElem);
    PElem^.Data := i * 100;
    QueuePush(Q2, PElem);
  end;
  Memo1.Lines.Add('Составлена вторая очередь:');
  Memo1.Lines.Add(QueueToStr(Q2));
 
  Memo1.Lines.Add('Переливаем элементы из первой очереди'
    + ' во вторую и распечатываем элементы второй очереди:');
  while QueuePop(Q1, PElem) do QueuePush(Q2, PElem);
  Memo1.Lines.Add(QueueToStr(Q2));
 
  //Удаление очередей из памяти.
  QueueFree(Q1);
  QueueFree(Q2);
  Memo1.Lines.Add('Работа завершена. Очереди удалены из памяти.');
end;
1
kolid
0 / 0 / 0
Регистрация: 30.06.2012
Сообщений: 12
01.07.2012, 22:25  [ТС] #3
Эмм,не могли бы вы скинуть в архиве эту программу? За рание Спасибо
0
Mawrat
12821 / 5729 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
01.07.2012, 22:32 #4
Приложил проект.
1
Вложения
Тип файла: rar BasicActionWithQueue.rar (165.6 Кб, 160 просмотров)
kolid
0 / 0 / 0
Регистрация: 30.06.2012
Сообщений: 12
01.07.2012, 22:44  [ТС] #5
Дак мне нужны функции добовления,удаления и вывода элемента очереди,а тут как я понимаю состовление и слияние
0
Mawrat
12821 / 5729 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
01.07.2012, 22:53 #6
В проекте, собственно, представлен полный набор функций для работы с очередью.
Функция добавления в конец очереди: QueuePush().
Удаление (изъятие) элемента из начала очереди: QueuePop().
Распечатка очереди: QueueToStr().
Удаление всей очереди из памяти: QueueFree().
0
kolid
0 / 0 / 0
Регистрация: 30.06.2012
Сообщений: 12
01.07.2012, 22:57  [ТС] #7
тогда мне не совсем понятно как реализовать эти функции
0
Mawrat
12821 / 5729 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
01.07.2012, 23:20 #8
Да они уже реализованы. Здесь, видимо, дело в другом - наверное, нужно, чтобы на форме были кнопки, которые эти функции будут выполнять. Сейчас с кнопками проект сделаю...
---
Готово. Приложил проект с кнопками для выполнения действий.
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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
type
  //Указатель на элемент списка (это элемент очереди или стека).
  TPElem = ^TElem;
  //Элемент списка.
  TElem = record
    Data : String; //Основные данные.
    PNext : TPElem; //Указатель на следующий элемент списка.
  end;
  //Очередь.
  TQueue = record
    PFirst, PLast : TPElem; //Указатели на первый и на последний элемент очереди.
  end;
 
//Инициализация очереди. Внимание! Эту процедуру можно выполнять только в том
//случае, если очередь пуста. Иначе, произойдут утечки памяти.
//Эту процедуру следует выполнять только для начальной инициализации очереди.
procedure QueueInit(var aQueue : TQueue);
begin
  aQueue.PFirst := nil;
  aQueue.PLast := nil;
end;
 
//Добавление элемента в конец очереди.
procedure QueuePush(var aQueue : TQueue; var aPElem : TPElem);
begin
  if aPElem = nil then Exit;
 
  aPElem^.PNext := nil;
  if aQueue.PFirst = nil then
    aQueue.PFirst := aPElem
  else
    aQueue.PLast^.PNext := aPElem
  ;
  aQueue.PLast := aPElem;
end;
 
//Изъятие элемента из начала очереди.
//Если очередь не пуста, то из её начала изымается элемент и возвращается
//через параметр aPElem. В этом случае, функция возвращает значение True.
//Если очередь пуста, то операция отменяется, а функция возвращает значение False.
function QueuePop(var aQueue : TQueue; var aPElem : TPElem) : Boolean;
begin
  Result := False;
  if aQueue.PFirst = nil then Exit;
 
  aPElem := aQueue.PFirst;
  aQueue.PFirst := aPElem^.PNext;
  if aQueue.PFirst = nil then aQueue.PLast := nil;
  Result := True;
end;
 
//Удаление очереди из памяти (очистка очереди).
procedure QueueFree(var aQueue : TQueue);
var
  PDel : TPElem;
begin
  while QueuePop(aQueue, PDel) do Dispose(PDel);
end;
 
//Распечатка очереди.
function QueueToStr(var aQueue : TQueue) : String;
var
  QTmp : TQueue;
  PElem : TPElem;
begin
  if aQueue.PFirst = nil then begin
    Result := 'Очередь пуста.';
    Exit;
  end;
  Result := '';
 
  //Инициализация вспомогательной очереди.
  QueueInit(QTmp);
  //Переливаем элементы из исходной очереди во временную и при этом
  //выполняем распечатку.
  while QueuePop(aQueue, PElem) do begin
    QueuePush(QTmp, PElem);
    if Result <> '' then Result := Result + ', ';
    Result := Result + PElem^.Data;
  end;
 
  aQueue := QTmp;
end;
 
var
  //Очередь.
  Q : TQueue;
 
//Обработчик события, которое возникает сразу после создания формы.
procedure TForm1.FormCreate(Sender: TObject);
begin
  //Начальная инициализация очереди.
  QueueInit(Q);
end;
 
//Обработчик события, которое возникает перед уничтожением формы.
procedure TForm1.FormDestroy(Sender: TObject);
begin
  //Удаление очереди из памяти.
  QueueFree(Q);
end;
 
//Добавление элемента в конец очереди.
procedure TForm1.Button1Click(Sender: TObject);
var
  PElem : TPElem;
  S : String;
begin
  S := Edit1.Text;
  if S = '' then begin
    ShowMessage('Пустая строка не будет добавлена в очередь. Действие отменено.');
    Exit;
  end;
  New(PElem);
  PElem^.Data := S;
  QueuePush(Q, PElem);
  Memo1.Lines.Add('В конец очереди добавлен элемент: ' + S);
end;
 
//Изъятие элемента из начала очереди.
procedure TForm1.Button2Click(Sender: TObject);
var
  PElem : TPElem;
begin
  if QueuePop(Q, PElem) then begin
    Memo1.Lines.Add('Из начала очереди взят элемент: ' + PElem.Data);
    Dispose(PElem); //Удаляем элемент из памяти.
  end else
    ShowMessage('Очередь пуста. Действие отменено.');
end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
  Memo1.Lines.Add('Очередь (начало - конец):');
  Memo1.Lines.Add(QueueToStr(Q));
end;
 
end.
1
Вложения
Тип файла: rar BasicActionWithQueue-02.rar (172.8 Кб, 134 просмотров)
Mawrat
12821 / 5729 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
01.07.2012, 23:37 #9
И ещё один вариант. Здесь функциональность та же. Но действия по выделению/освобождению памяти для элементов перенесены в процедуры QueuePush() и QueuePop().
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;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
type
  //Тип основных данных.
  TData = String;
  //Указатель на элемент списка (это элемент очереди).
  TPElem = ^TElem;
  //Элемент списка.
  TElem = record
    Data : TData; //Основные данные.
    PNext : TPElem; //Указатель на следующий элемент списка.
  end;
  //Очередь.
  TQueue = record
    PFirst, PLast : TPElem; //Указатели на первый и на последний элемент очереди.
  end;
 
//Инициализация очереди. Внимание! Эту процедуру можно выполнять только в том
//случае, если очередь пуста. Иначе, произойдут утечки памяти.
//Эту процедуру следует выполнять только для начальной инициализации очереди.
procedure QueueInit(var aQueue : TQueue);
begin
  aQueue.PFirst := nil;
  aQueue.PLast := nil;
end;
 
//Добавление элемента в конец очереди.
procedure QueuePush(var aQueue : TQueue; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  PElem^.Data := aData;
  PElem^.PNext := nil;
  if aQueue.PFirst = nil then
    aQueue.PFirst := PElem
  else
    aQueue.PLast^.PNext := PElem
  ;
  aQueue.PLast := PElem;
end;
 
//Изъятие элемента из начала очереди.
//Если очередь не пуста, то из её начала изымается элемент и возвращается
//через параметр aData. В этом случае, функция возвращает значение True.
//Если очередь пуста, то операция отменяется, а функция возвращает значение False.
function QueuePop(var aQueue : TQueue; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Result := False;
  if aQueue.PFirst = nil then Exit;
 
  PElem := aQueue.PFirst;
  aData := PElem^.Data;
  aQueue.PFirst := PElem^.PNext;
  if aQueue.PFirst = nil then aQueue.PLast := nil;
  Dispose(PElem);
  Result := True;
end;
 
//Удаление очереди из памяти (очистка очереди).
procedure QueueFree(var aQueue : TQueue);
var
  Data : TData;
begin
  while QueuePop(aQueue, Data) do;
end;
 
//Распечатка очереди.
function QueueToStr(var aQueue : TQueue) : String;
var
  QTmp : TQueue;
  Data : TData;
begin
  if aQueue.PFirst = nil then begin
    Result := 'Очередь пуста.';
    Exit;
  end;
  Result := '';
 
  //Инициализация вспомогательной очереди.
  QueueInit(QTmp);
  //Переливаем элементы из исходной очереди во временную и при этом
  //выполняем распечатку.
  while QueuePop(aQueue, Data) do begin
    QueuePush(QTmp, Data);
    if Result <> '' then Result := Result + ', ';
    Result := Result + Data;
  end;
 
  aQueue := QTmp;
end;
 
var
  //Очередь.
  Q : TQueue;
 
//Обработчик события, которое возникает сразу после создания формы.
procedure TForm1.FormCreate(Sender: TObject);
begin
  //Начальная инициализация очереди.
  QueueInit(Q);
end;
 
//Обработчик события, которое возникает перед уничтожением формы.
procedure TForm1.FormDestroy(Sender: TObject);
begin
  //Удаление очереди из памяти.
  QueueFree(Q);
end;
 
//Добавление элемента в конец очереди.
procedure TForm1.Button1Click(Sender: TObject);
var
  S : String;
begin
  S := Edit1.Text;
  if S = '' then begin
    ShowMessage('Пустая строка не будет добавлена в очередь. Действие отменено.');
    Exit;
  end;
  QueuePush(Q, S);
  Memo1.Lines.Add('В конец очереди добавлен элемент: ' + S);
end;
 
//Изъятие элемента из начала очереди.
procedure TForm1.Button2Click(Sender: TObject);
var
  S : String;
begin
  if QueuePop(Q, S) then
    Memo1.Lines.Add('Из начала очереди взят элемент: ' + S)
  else
    ShowMessage('Очередь пуста. Действие отменено.');
end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
  Memo1.Lines.Add('Очередь (начало - конец):');
  Memo1.Lines.Add(QueueToStr(Q));
end;
 
end.
4
Вложения
Тип файла: rar BasicActionWithQueue-03.rar (172.9 Кб, 102 просмотров)
Петррр
6155 / 3455 / 896
Регистрация: 28.10.2010
Сообщений: 5,926
01.07.2012, 23:43 #10
kolid, http://www.cyberforum.ru/turbo-pascal/thread77419.html

Поиском пользоваться нужно.
0
kolid
0 / 0 / 0
Регистрация: 30.06.2012
Сообщений: 12
02.07.2012, 00:33  [ТС] #11
Все замечательно осталось только удаление туда закинуть,за место распечатония
0
Mawrat
12821 / 5729 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
02.07.2012, 09:13 #12
В программе кнопка "Взять элемент из начала очереди" - это и есть удаление элемента из очереди. Для работы с очередью применяются две основные процедуры:
QueuePush() - добавить элемент в конец очереди.
QueuePop() - взять элемент из начала очереди.
Функция QueuePop() изымает (удаляет) элемент из начала очереди и возвращает его значение через параметр aData.
1
kolid
0 / 0 / 0
Регистрация: 30.06.2012
Сообщений: 12
02.07.2012, 13:20  [ТС] #13
Все хорошо тоько надо еще удаление сделать в это программе элемента с головы Очереде,поможите?

Добавлено через 1 минуту
сорри вторую страницу не увидел)

Добавлено через 3 минуты
Отлично все спасибо Огромное!!)
0
orlanblxvst
0 / 0 / 0
Регистрация: 08.05.2013
Сообщений: 27
08.05.2013, 01:55 #14
Зарегался только для того, чтобы сказать: Mawrat, ты святой человек. Если б не ты, столько бы народу погорело! Спасибо тебе!
0
Mawrat
12821 / 5729 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
08.05.2013, 09:19 #15
Цитата Сообщение от orlanblxvst Посмотреть сообщение
Спасибо тебе!
Пожалуйста. И спасибо за добрые слова!
0
UNDEADJ3THUO
0 / 0 / 0
Регистрация: 25.05.2015
Сообщений: 13
25.05.2015, 16:16 #16
Mawrat, очень нужна помощь! Хорошая работа,но в моем случае задание таково : "Функции: создание очереди, удаление очереди, добавление нового элемента в очередь, удаление элемента из очереди". Если не трудно
можешь добавить в программу это?
0
Mawrat
12821 / 5729 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
26.05.2015, 14:24 #17
Цитата Сообщение от UNDEADJ3THUO Посмотреть сообщение
Функции: создание очереди, удаление очереди, добавление нового элемента в очередь, удаление элемента из очереди
Решение в виде GUI приложения. Показ состояния очереди осуществляется с помощью экземпляра TStringGrid.
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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls;
 
type
  //Тип основных данных.
  TData = String;
  //Тип указателя на элемент списка (это элемент очереди).
  TPElem = ^TElem;
  //Тип элемента списка (очереди).
  TElem = record
    Data : TData;   //Основные данные.
    PNext : TPElem; //Указатель на следующий элемент списка (очереди).
  end;
  //Очередь.
  TQueue = record
    PFirst, PLast : TPElem; //Указатели на первый и на последний элементы очереди.
  end;
 
  //Это объявление сделано для того, чтобы в пределах модуля стали доступными методы
  //из раздела protected класса TStringGrid. - Нам нужен метод TStringGrid.RowMoved().
  //Объяснение: По правилам Delphi, в модуле, где объявлен класс, становятся доступными
  //все унаследованные этим классом члены (поля, методы и свойства).
  TStringGrid = class(Grids.TStringGrid);
 
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    StringGrid1: TStringGrid;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
    FQueue : TQueue; //Очередь.
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{ TQueue }
 
//Добавление элемента в конец очереди.
procedure QueuePush(var aQ : TQueue; const aData : TData);
var
  P : TPElem;
begin
  New(P);                  //Выделяем память для элемента и указатель на него записываем в переменную P.
  P^.Data := aData;        //Запись основных данных.
  P^.PNext := nil;         //Обнуление указателя на следующий элемент.
  if aQ.PFirst = nil then  //Если список пуст,
    aQ.PFirst := P         //то новый элемент становится первым в списке.
  else                     //Иначе, если список не пустой,
    aQ.PLast^.PNext := P;    //то новый элемент прикрепляем за последним элементом списка.
  aQ.PLast := P;           //Новый элемент назначаем последним элементом списка.
end;
 
{Изъятие элемента из начала очереди.
Если очередь не пуста, то из её начала изымается элемент и возвращается
через параметр aData. В этом случае, функция возвращает значение True.
Если очередь пуста, то операция отменяется, а функция возвращает значение False.}
function QueuePop(var aQ : TQueue; var aData : TData) : Boolean;
var
  P : TPElem;
begin
  Result := False;          //Отмечаем, что действие пока не выполнено.
  if aQ.PFirst <> nil then  //Если список не пустой.
  begin
    P := aQ.PFirst;         //Запоминаем указатель на первый элемент списка.
    aData := P^.Data;       //Возвращаем данные первого элемента.
    aQ.PFirst := P^.PNext;  //Исключаем первый элемент из списка.
    if aQ.PFirst = nil then //Если список стал пустым,
      aQ.PLast := nil;        //то обнуляем указатель на последний элемент.
    Dispose(P);             //Освобождаем память, занятую под исключённый элемент.
    Result := True;         //Отмечаем, что действие выполнено.
  end;
end;
 
//Освобождение памяти, занятой для элементов очереди (очистка очереди).
procedure QueueFree(var aQ : TQueue);
var
  Data : TData;
begin
  while QueuePop(aQ, Data) do;
end;
 
{ TForm1 }
 
//Добавить элемент в конец очереди.
procedure TForm1.Button1Click(Sender: TObject);
var
  Data : TData;
  Sg : TStringGrid;
begin
  Data := Edit1.Text;
  if Data = '' then
  begin
    MessageBox(0, 'Значение не должно быть пустой строкой.', 'Повторите ввод',
      MB_OK + MB_ICONEXCLAMATION + MB_APPLMODAL);
    Exit;
  end;
 
  QueuePush(FQueue, Data);              //Добавляем элемент в конец очереди.
  //Показываем изменения в таблице.
  Sg := StringGrid1;                    //Ссылка на экземпляр типа TStringGrid.
  if Sg.Cells[0, 0] <> '' then          //Если таблица пустая,
    Sg.RowCount := Sg.RowCount + 1;       //то добавляем в её конец новую строку.
  Sg.Cells[0, Sg.RowCount - 1] := Data; //Запись данных в последнюю строку таблицы.
end;
 
//Извлечь элемент из начала очереди.
procedure TForm1.Button2Click(Sender: TObject);
var
  Data : TData;
  Sg : TStringGrid;
begin
  if QueuePop(FQueue, Data) then       //Извлекаем элемент из начала очереди.
  begin
    Edit1.Text := Data;                //Запись взятого элемента в Edit.
    //Показываем изменения в таблице.
    Sg := StringGrid1;                 //Ссылка на экземпляр типа TStringGrid.
    Sg.Rows[0].Clear;                  //Очистка верхней строки таблицы.
    if Sg.RowCount > 1 then            //Если в таблице более одной строки, то удаляем первую строку.
    begin
      Sg.RowMoved(0, Sg.RowCount - 1); //Перенос первой строки в конец таблицы.
      Sg.RowCount := Sg.RowCount - 1;  //Уменьшение числа строк таблицы на единицу.
    end;
  end;
end;
 
//Очистить очередь.
procedure TForm1.Button3Click(Sender: TObject);
begin
  QueueFree(FQueue); //Освобождение памяти, выделенной для элементов очереди.
  //Показываем изменения в таблице.
  StringGrid1.Cols[0].Clear; //Очистка первого столбца таблицы.
  StringGrid1.RowCount := 1; //Сброс количества строк.
end;
 
//Перед закрытием формы.
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;  //Задаём действие - уничтожение формы.
  QueueFree(FQueue); //Освобождение памяти, выделенной для элементов очереди.
end;
 
end.
1
Миниатюры
Создание Очереди  
Вложения
Тип файла: 7z QueueDynListGUI-01.7z (179.6 Кб, 30 просмотров)
Mawrat
12821 / 5729 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
27.05.2015, 07:41 #18
Вариант с показом изменений в Memo. В данном случае работа с Memo на много проще, чем со StringGrid.
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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  //Тип основных данных.
  TData = String;
  //Тип указателя на элемент списка (это элемент очереди).
  TPElem = ^TElem;
  //Тип элемента списка (очереди).
  TElem = record
    Data : TData;   //Основные данные.
    PNext : TPElem; //Указатель на следующий элемент списка (очереди).
  end;
  //Очередь.
  TQueue = record
    PFirst, PLast : TPElem; //Указатели на первый и на последний элементы очереди.
  end;
 
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
    FQueue : TQueue; //Очередь.
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{ TQueue }
 
//Добавление элемента в конец очереди.
procedure QueuePush(var aQ : TQueue; const aData : TData);
var
  P : TPElem;
begin
  New(P);                  //Выделяем память для элемента и указатель на него записываем в переменную P.
  P^.Data := aData;        //Запись основных данных.
  P^.PNext := nil;         //Обнуление указателя на следующий элемент.
  if aQ.PFirst = nil then  //Если список пуст,
    aQ.PFirst := P         //то новый элемент становится первым в списке.
  else                     //Иначе, если список не пустой,
    aQ.PLast^.PNext := P;    //то новый элемент прикрепляем за последним элементом списка.
  aQ.PLast := P;           //Новый элемент назначаем последним элементом списка.
end;
 
{Изъятие элемента из начала очереди.
Если очередь не пуста, то из её начала изымается элемент и возвращается
через параметр aData. В этом случае, функция возвращает значение True.
Если очередь пуста, то операция отменяется, а функция возвращает значение False.}
function QueuePop(var aQ : TQueue; var aData : TData) : Boolean;
var
  P : TPElem;
begin
  Result := False;          //Отмечаем, что действие пока не выполнено.
  if aQ.PFirst <> nil then  //Если список не пустой.
  begin
    P := aQ.PFirst;         //Запоминаем указатель на первый элемент списка.
    aData := P^.Data;       //Возвращаем данные первого элемента.
    aQ.PFirst := P^.PNext;  //Исключаем первый элемент из списка.
    if aQ.PFirst = nil then //Если список стал пустым,
      aQ.PLast := nil;        //то обнуляем указатель на последний элемент.
    Dispose(P);             //Освобождаем память, занятую под исключённый элемент.
    Result := True;         //Отмечаем, что действие выполнено.
  end;
end;
 
//Освобождение памяти, занятой для элементов очереди (очистка очереди).
procedure QueueFree(var aQ : TQueue);
var
  Data : TData;
begin
  while QueuePop(aQ, Data) do;
end;
 
{ TForm1 }
 
//Добавить элемент в конец очереди.
procedure TForm1.Button1Click(Sender: TObject);
var
  Data : TData;
begin
  Data := Edit1.Text;
  if Data = '' then
  begin
    MessageBox(Handle, 'Значение не должно быть пустой строкой.', 'Повторите ввод',
      MB_OK + MB_ICONEXCLAMATION + MB_APPLMODAL);
    Exit;
  end;
 
  QueuePush(FQueue, Data); //Добавляем элемент в конец очереди.
  Memo1.Lines.Add(Data);   //Показываем изменения в Memo.
end;
 
//Извлечь элемент из начала очереди.
procedure TForm1.Button2Click(Sender: TObject);
var
  Data : TData;
begin
  if QueuePop(FQueue, Data) then //Извлекаем элемент из начала очереди.
  begin
    Edit1.Text := Data;          //Запись взятого элемента в Edit.
    Memo1.Lines.Delete(0);       //Показываем изменения в Memo.
  end;
end;
 
//Очистить очередь.
procedure TForm1.Button3Click(Sender: TObject);
begin
  QueueFree(FQueue); //Освобождение памяти, выделенной для элементов очереди.
  Memo1.Clear;       //Показываем изменения в Memo.
end;
 
//Перед закрытием формы.
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;  //Задаём действие - уничтожение формы.
  QueueFree(FQueue); //Освобождение памяти, выделенной для элементов очереди.
end;
 
end.
1
Вложения
Тип файла: 7z QueueDynListGUI-02.7z (157.5 Кб, 42 просмотров)
UNDEADJ3THUO
0 / 0 / 0
Регистрация: 25.05.2015
Сообщений: 13
31.05.2015, 01:16 #19
Mawrat, спасибо большое.
0
31.05.2015, 01:16
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
31.05.2015, 01:16
Привет! Вот еще темы с решениями:

Организация очереди
Добрый день. Передомной постала задача в организации очереди, посмотрел я...

Упорядочивание очереди
Cформировать очередь, содержащий целые числа. Упорядочить элементы очереди, не...

Перехват очереди печати
код моей проги: uses Windows, Messages, SysUtils, Variants, Classes,...

Многопоточный доступ к очереди
Всем привет. Пишу программку, которая синхронизирует файлы между неким сервером...


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

Или воспользуйтесь поиском по форуму:
19
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru