Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 2 182

Раздел: Delphi » Работа с компонентами и библиотеками
/ вопрос открыт /

Доброго времени суток, уважаемые эксперты!
Я все с той же темой про компонент на палитре TThreadList. Пытаюсь написать вот так. В чем проблема и как решить. Что за ошибки выдает понимаю, непонимаю почему.

Приложение:
  1. unit UNsThreadList;
  2.  
  3. interface
  4.  
  5. uses
  6. Classes;
  7.  
  8. type
  9. TNsThread = class(TThread)
  10. private
  11. { Private declarations }
  12. public
  13. Index: Integer;
  14. procedure Execute; override;
  15. end;
  16.  
  17. TNsEvent = procedure (Sender: TObject; Index: Integer) of object;
  18.  
  19. TNsThreadList = class(TComponent)
  20. protected
  21. { Protected declarations }
  22. NsList: TList;
  23. NsThread: TNsThread;
  24. NsOnCreate,
  25. NsOnDestroy: TNotifyEvent;
  26. NsOnExecute: TNsEvent;
  27. public
  28. { Public declarations }
  29. Count: Integer;
  30. published
  31. { Published declarations }
  32. function Add: Integer;
  33. procedure Resume(Index: Integer);
  34. procedure Suspend(Index: Integer);
  35. procedure Terminate(Index: Integer);
  36. property OnCreate: TNotifyEvent read NsOnCreate write NsOnCreate;
  37. property OnExecute: TNsEvent read NsOnExecute write NsOnExecute;
  38. property OnDestroy: TNotifyEvent read NsOnDestroy write NsOnDestroy;
  39. constructor Create(AOwner: TComponent); override;
  40. destructor Destroy; override;
  41. end;
  42.  
  43. procedure Register;
  44.  
  45. implementation
  46.  
  47. procedure Register;
  48. begin
  49. RegisterComponents('Nsgool Soft', [TNsThreadList]);
  50. end;
  51.  
  52. { TNsThreadList }
  53.  
  54. function TNsThreadList.Add: Integer;
  55. begin
  56. Result := NsList.Add(GetMemory(SizeOf(NsThread)));
  57. TNsThread(NsList.Items[Result]^) := TNsThread.Create(True);
  58. TNsThread(NsList.Items[Result]^).FreeOnTerminate := True;
  59. TNsThread(NsList.Items[Result]^).Index := Result;
  60. end;
  61.  
  62. constructor TNsThreadList.Create(AOwner: TComponent);
  63. begin
  64. inherited Create(AOwner);
  65. NsList := TList.Create;
  66. NsThread := TNsThread.Create(True);
  67. NsThread.FreeOnTerminate := True;
  68. if Assigned(NsOnCreate)
  69. then
  70. NsOnCreate(Self);
  71. end;
  72.  
  73. destructor TNsThreadList.Destroy;
  74. var
  75. I: Integer;
  76. begin
  77. if Count > 0
  78. then
  79. for I := 0 to Count - 1
  80. do
  81. begin
  82. TNsThread(NsList.Items[I]^).Terminate;
  83. if TNsThread(NsList.Items[I]^).Suspended
  84. then
  85. TNsThread(NsList.Items[I]^).Resume;
  86. TNsThread(NsList.Items[I]^).WaitFor;
  87. end;
  88. NsThread.Free;
  89. NsList.Free;
  90. if Assigned(NsOnDestroy)
  91. then
  92. NsOnDestroy(Self);
  93. inherited Destroy;
  94. end;
  95.  
  96. procedure TNsThreadList.Resume(Index: Integer);
  97. begin
  98. if TNsThread(NsList.Items[Index]^).Suspended
  99. then
  100. TNsThread(NsList.Items[Index]^).Resume;
  101. end;
  102.  
  103. procedure TNsThreadList.Suspend(Index: Integer);
  104. begin
  105. if not TNsThread(NsList.Items[Index]^).Suspended
  106. then
  107. TNsThread(NsList.Items[Index]^).Suspend;
  108. end;
  109.  
  110. procedure TNsThreadList.Terminate(Index: Integer);
  111. var
  112. I: Integer;
  113. begin
  114. TNsThread(NsList.Items[Index]^).Terminate;
  115. TNsThread(NsList.Items[Index]^).WaitFor;
  116. NsList.Delete(Index);
  117. if Count > 0
  118. then
  119. for I := 0 to Count - 1
  120. do
  121. TNsThread(NsList.Items[Index]^).Index := I;
  122. end;
  123.  
  124. { TNsThread }
  125.  
  126. procedure TNsThread.Execute;
  127. begin
  128. while True
  129. do
  130. begin
  131. if Assigned(NsOnExecute)//[Pascal Error] UNsThreadList.pas(131): E2003 Undeclared identifier: 'NsOnExecute'
  132. then//[Pascal Error] UNsThreadList.pas(131): E2003 Undeclared identifier: 'NsOnExecute'
  133. NsOnExecute(Self, Index);
  134. if Terminated
  135. then
  136. Exit;
  137. end;
  138. end;
  139.  
  140. end.


Nasgool Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Nasgool (статус: 2-ой класс)
Вопрос отправлен: 10 декабря 2008, 14:05
Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: min@y™

Цитата:

Что за ошибки выдает понимаю, непонимаю почему.


Перевожу на русский язык:

{ TNsThread }
 
procedure TNsThread.Execute;
begin
  while True
  do
    begin
      if Assigned(NsOnExecute) // <---- У класса TNsThread нет поля NsOnExecute
      then 
        NsOnExecute(Self, Index);  // <---- У класса TNsThread нет поля NsOnExecute
      if Terminated
      then
        Exit;
    end;
end;

Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 10 декабря 2008, 18:17


Мини-форум вопроса

Всего сообщений: 6; последнее сообщение — 10 декабря 2008, 20:05; участников в обсуждении: 3.
Вадим К

Вадим К (статус: Академик), 10 декабря 2008, 14:12 [#1]:

Ну сколько раз писать - смешивание потоков и VCL кода ничем хорошим не обернётся.
Хотя с другой стороны, если посмотреть, то у класса TNsThread нет свойства NsOnExecute - оно вот и ругается.
Галочка "подтверждения прочтения" - вселенское зло.
Вадим К

Вадим К (статус: Академик), 10 декабря 2008, 18:33 [#2]:

to min@y™
Не находите, что Ваш "ответ" есть просто почти копия моего сообщения выше?
Галочка "подтверждения прочтения" - вселенское зло.
min@y™

min@y™ (статус: Доктор наук), 10 декабря 2008, 18:43 [#3]:

Цитата:


Не находите, что Ваш "ответ" есть просто почти копия моего сообщения выше?


А я и не видел сообщения, т.к. отвечаю всегда из формы, которая мне приходит по почте. Увидел, только когда ответил. Что теперь делать?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
Вадим К

Вадим К (статус: Академик), 10 декабря 2008, 18:48 [#4]:

Застрелиться наверно:)
Галочка "подтверждения прочтения" - вселенское зло.
Nasgool

Nasgool (статус: 2-ой класс), 10 декабря 2008, 19:23 [#5]:

Спасибо за то, что ткнули носом!
Переделал. Откомпилил без ошибок. Буду тестировать. Вот что получилось:

unit UNsThreadList;

interface

uses
Classes;

type
TNsEvent = procedure (Index: Integer) of object;

TNsThread = class(TThread)
private
{ Private declarations }
public
Index: Integer;
NsPExesute: Pointer;
procedure Execute; override;
end;

TNsThreadList = class(TComponent)
protected
{ Protected declarations }
NsList: TList;
NsThread: TNsThread;
NsOnExecute: TNsEvent;
NsOnCreate,
NsOnDestroy: TNotifyEvent;
public
{ Public declarations }
Count: Integer;
published
{ Published declarations }
function Add: Integer;
procedure Resume(Index: Integer);
procedure Suspend(Index: Integer);
procedure Terminate(Index: Integer);
property OnCreate: TNotifyEvent read NsOnCreate write NsOnCreate;
property OnExecute: TNsEvent read NsOnExecute write NsOnExecute;
property OnDestroy: TNotifyEvent read NsOnDestroy write NsOnDestroy;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Nsgool Soft', [TNsThreadList]);
end;

{ TNsThreadList }

function TNsThreadList.Add: Integer;
begin
Result := NsList.Add(GetMemory(SizeOf(NsThread)));
TNsThread(NsList.Items[Result]^) := TNsThread.Create(True);
TNsThread(NsList.Items[Result]^).FreeOnTerminate := True;
TNsThread(NsList.Items[Result]^).Index := Result;
end;

constructor TNsThreadList.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
NsList := TList.Create;
NsThread := TNsThread.Create(True);
NsThread.FreeOnTerminate := True;
if Assigned(NsOnExecute)
then
NsThread.NsPExesute := @NsOnExecute;
if Assigned(NsOnCreate)
then
NsOnCreate(Self);
end;

destructor TNsThreadList.Destroy;
var
I: Integer;
begin
if Count > 0
then
for I := 0 to Count - 1
do
begin
TNsThread(NsList.Items[I]^).Terminate;
if TNsThread(NsList.Items[I]^).Suspended
then
TNsThread(NsList.Items[I]^).Resume;
TNsThread(NsList.Items[I]^).WaitFor;
end;
NsThread.Free;
NsList.Free;
if Assigned(NsOnDestroy)
then
NsOnDestroy(Self);
inherited Destroy;
end;

procedure TNsThreadList.Resume(Index: Integer);
begin
if TNsThread(NsList.Items[Index]^).Suspended
then
TNsThread(NsList.Items[Index]^).Resume;
end;

procedure TNsThreadList.Suspend(Index: Integer);
begin
if not TNsThread(NsList.Items[Index]^).Suspended
then
TNsThread(NsList.Items[Index]^).Suspend;
end;

procedure TNsThreadList.Terminate(Index: Integer);
var
I: Integer;
begin
TNsThread(NsList.Items[Index]^).Terminate;
TNsThread(NsList.Items[Index]^).WaitFor;
NsList.Delete(Index);
if Count > 0
then
for I := 0 to Count - 1
do
TNsThread(NsList.Items[Index]^).Index := I;
end;

{ TNsThread }

procedure TNsThread.Execute;
begin
while True
do
begin
TNsEvent(NsPExesute^)(Index);
if Terminated
then
Exit;
end;
end;

end.
min@y™

min@y™ (статус: Доктор наук), 10 декабря 2008, 20:05 [#6]:

Я бы тебе посоветовал стереть всё нафиг и написать по-нормальному. Ну, вот, что за изврат:
  Result := NsList.Add(GetMemory(SizeOf(NsThread)));  
  TNsThread(NsList.Items[Result]^) := TNsThread.Create(True);
  TNsThread(NsList.Items[Result]^).FreeOnTerminate := True;
  TNsThread(NsList.Items[Result]^).Index := Result;
Ну нафига тут ещё указатели на указатели? Давай я тебе на простом примере объясню, как проще.

Написал я тебе пример, отправил в личку. Изучай.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 22 февраля 2025, 16:16
Выполнено за 0.03 сек.