Помогите решить проблему.
Есть 2-е процедуры.
К примеру по нажатию кнопки 1 запускается процедура 1.
Процедура выполняется долго к примеру 10 секунд.
Если на 5-й секунде нажатием кнопки 2 запустить процедуру 2,
процедура 1 останавливается, выполняется процедура 2,
после чего продолжает выполняться процедура 1.
Что можно придумать, не перенося процедуры в потоки,
чтобы при нажатии кнопки 2, процедура 1 доработала до конца
и только после этого исполнилась процедура 2?
Одним словом необходимо чтобы процедуры ваполнялись до конца в порядке их вызовов.
Простейший пример ниже.
procedure TForm1.Button5Click(Sender: TObject);
var i:integer;
begin
for i:=0 to 100 do
begin
sleep(100);
Application.ProcessMessages;
progressbar1.Position:=i;
end;
end;
procedure TForm1.Button6Click(Sender: TObject);
var i:integer;
begin
for i:=0 to 100 do
begin
sleep(100);
Application.ProcessMessages;
progressbar2.Position:=i;
end;
end;
Уважаемые авторы вопросов! Большая просьба сообщить о результатах решения проблемы на этой странице. Иначе, следящие за обсуждением, возможно имеющие аналогичные проблемы, не получают ясного представления об их решении. А авторы ответов не получают обратной связи. Что можно расценивать, как проявление неуважения к отвечающим от автора вопроса.
18-05-2009 05:37 | Сообщение от автора вопроса
Всем спасибо.
Вопрос решен.
Принято решение организовать список(стек) задач,
с последовательным исполнением задач из списка.
Отдельная благодарность NS за развернутый ответ.
Если требуется последовательное исполнение, приходит мысль сделать ОЧЕРЕДЬ, куда записывать элементы по нажатию кнопок и исполнять нужные методы, извлекая эти элементы оттуда.
Следуя примеру предыдущего оратора, должен заметить, что в моём примере тоже не всё гладко :)) Не хватает одной строки в методе ApplicationEvents1Idle где-нибудь между if ... begin ... end нужно добавить Done:= false
Хочу так-же предупредить, что я вряд-ли стал бы писать такое на трезвую голову :)
Прошу прощения, в моём сообщении от 15-05-2009 11:47 содержатся неточности.
Во-первых, использование простых флагов вполне корректно в пределах одной нити.
Во-вторых, приведенный мной код проигнорирует, а не отложит запуск второй процедуры при выполнении первой.
Но есть и случайный плюс: будет заблокирован случайный повторный запуск уже запущенной процедуры.
Ну тогда можно флагами. Не уверен насчет абсолютной корректности такого простого подхода, но если события не очень частые, то сбоев почти не будет. Для абсолютной уверенности можно воспользоваться системными способами синхронизации.
var MyFlagOn:boolean=false;
procedure TForm1.Button5Click(Sender: TObject);
var i:integer;
begin
if MyFlagOn then exit else MyFlagOn:=true;
for i:=0 to 100 do
begin
sleep(100);
Application.ProcessMessages;
progressbar1.Position:=i;
end;
MyFlagOn:=false;
end;
procedure TForm1.Button6Click(Sender: TObject);
var i:integer;
begin
if MyFlagOn then exit else MyFlagOn:=true;
for i:=0 to 100 do
begin
sleep(100);
Application.ProcessMessages;
progressbar2.Position:=i;
end;
MyFlagOn:=false;
end;
function CreateFiber(dwStackSize: DWORD; lpStartAddress: TFNFiberStartRoutine;
lpParameter: Pointer): Pointer; stdcall; external kernel32 name 'CreateFiber';
function ConvertFiberToThread(): BOOL; stdcall;
external kernel32 name 'ConvertFiberToThread';
function ConvertThreadToFiber(lpParameter: Pointer): Pointer; stdcall;
external kernel32 name 'ConvertThreadToFiber';
var
MainFiber, Fiber: pointer;
procedure Proc1();
var
n: integer;
begin
for n:= 0 to 100 do
begin
Sleep(100);
if GetQueueStatus(QS_ALLINPUT) <> 0 then
SwitchToFiber(MainFiber);
end;
end;
procedure Proc2();
var
n: integer;
begin
for n:= 0 to 100 do
begin
Sleep(100);
if GetQueueStatus(QS_ALLINPUT) <> 0 then
SwitchToFiber(MainFiber);
end;
end;
procedure FiberFunc(List: TList); stdcall;
var
P: TProcedure;
begin
while true do
begin
if List.Count <> 0 then
begin
P:= List[0];
if @P <> nil then P();
List.Delete(0);
end else
SwitchToFiber(MainFiber);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FList:= TList.Create;
MainFiber:= ConvertThreadToFiber(nil);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FList.Add(Addr(Proc1));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
FList.Add(Addr(Proc2));
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Fiber <> nil then DeleteFiber(Fiber);
ConvertFiberToThread();
FList.Free;
end;
procedure TForm1.ApplicationEvents1Idle(Sender: TObject;
var Done: Boolean);
begin
if FList.Count <> 0 then
begin
if Fiber = nil then Fiber:= CreateFiber($100000, @FiberFunc, FList);
SwitchToFiber(Fiber);
end;
end;
end.
Это конечно извращение, но и задача у Вас не лучше :)
15-05-2009 11:04 | Комментарий к предыдущим ответам
Не все так просто.
Форма должна оставаться активной.
Процедуры в реальной задаче запускаются 3-мя способами: Кнопка/Таймер/По факту коннекта сокета.
Эти события нельзя блокировать, нужно просто выполнять процедуры последовательно и до конца.
Если вы заметили орфографическую ошибку на этой странице, просто выделите ошибку мышью и нажмите Ctrl+Enter. Функция может не работать в некоторых версиях броузеров.
