powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Зависание GUI
53 сообщений из 53, показаны все 3 страниц
Зависание GUI
    #39590547
Не понятно почему, но при запуске программы через компилятор всё работает нормально, а при запуске exe'шника во время обработки данных (в цикле запросы через ADOQuery к Access и Progressbar.Position:=i;) частенько GUI "зависает" на 1/10 Progressbar'a. Программа "Не отвечает", хотя обработка выполняется.
Неужели, единственное решение, это отдельный поток для обработки? Мне не нужно во время выполнения кода взаимодействовать с GUI, только обновлять Progressbar.
...
Рейтинг: 0 / 0
Зависание GUI
    #39590552
Фотография JayDi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Progress-бар не отрисуется, пока код не выполнится до конца (основной поток занят выполнением). Чтобы отрисовать, надо в процессе долгой операции вызвать Application.ProcessMessages (̶г̶у̶с̶а̶р̶ы̶ любители потоков, молчать:-) ), что позволит "высвободить GUI" и обработать ожидающие команды типа отрисовки нового значения прогресс бара или нажатия на кнопки (так что с последним надо быть аккуратнее и отключать перед выполнением).
...
Рейтинг: 0 / 0
Зависание GUI
    #39590556
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Михаил Евгеньевич,

Вас пугает многопоточность и вы хотите об этом поговорить? Многопоточность делается сейчас несколькими строками кода или компонентами вообще без строчки кода (штуки 3 навскидку назову). Пробуйте, там всё просто. Не элементарно, но просто.
...
Рейтинг: 0 / 0
Зависание GUI
    #39590560
makhaon,
Меня не пугает многопоточность. Просто спросил нормально ли это и почему это происходит? И можно ли обойтись без многопоточности. Действительно ли нельзя обновлять Progressbar внутри основного потока?
Нажимаем кнопку, запускается цикл
Код: pascal
1.
2.
for i:0 to Progressbar.Max do
  Progressbar.Position:=i;


Это нормально.

а
Код: pascal
1.
2.
3.
4.
5.
for i:0 to Progressbar.Max do
  begin
    do_something;
    Progressbar.Position:=i;
  end;


уже приводит к зависанию GUI.
...
Рейтинг: 0 / 0
Зависание GUI
    #39590566
Zelius
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Михаил Евгеньевич,

Код: pascal
1.
2.
3.
4.
5.
6.
for i:0 to Progressbar.Max do
  begin
    do_something;
    Progressbar.Position:=i;
    Application.ProcessMessages; <== Про ProcessMessages уже сказали
  end;



Ну и самое главное - это узнать, на чем же подвисает главный поток, что бы дальше разбираться
...
Рейтинг: 0 / 0
Зависание GUI
    #39590586
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Михаил Евгеньевич
Код: pascal
1.
2.
3.
4.
5.
for i:0 to Progressbar.Max do
  begin
    do_something; {1}
    Progressbar.Position:=i;{2}
  end;



уже приводит к зависанию GUI.
Сначала выполнится {1}, а затем {2}. Если {1} довольно длителен по времени, то задержка отрисовки {2} уже заметна на глаз.
...
Рейтинг: 0 / 0
Зависание GUI
    #39590587
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Михаил Евгеньевич,

попробуй такой код
Код: pascal
1.
2.
3.
4.
5.
for i:0 to Progressbar.Max do
  begin
    sleep(1000);//do_something;
    Progressbar.Position:=i;
  end;


затем поиграйся с аргументом функции sleep. И поймешь, в чем дело
...
Рейтинг: 0 / 0
Зависание GUI
    #39590635
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Михаил Евгеньевича
Код: pascal
1.
2.
3.
4.
5.
for i:0 to Progressbar.Max do
  begin
    do_something;
    Progressbar.Position:=i;
  end;



уже приводит к зависанию GUI.
В 1-м ответе объяснили, почему это приведет к "зависанию". Потому, что во всём этом цикле никто не собирается обрабатывать WM_PAINT.
Думаю, с минимальными изменениями если, добавь в цикл
Код: pascal
1.
Progressbar.Update;

если такое есть или сразу (точно есть)
Код: pascal
1.
UpdateWindow( Progressbar.Handle );



Это частично поможет.
...
Рейтинг: 0 / 0
Зависание GUI
    #39590640
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ДокМихаил Евгеньевич,

попробуй такой код
Код: pascal
1.
2.
3.
4.
5.
for i:0 to Progressbar.Max do
  begin
    sleep(1000);//do_something;
    Progressbar.Position:=i;
  end;



затем поиграйся с аргументом функции sleep. И поймешь, в чем дело
Код не пробовал с телефона пишу.
По идее этот код должен так же "зависать", как и у ТС.

Док, возможно, если ты это на Лазаре написал, там могли впихнуть и Update, а не только Invalidate, внутрь "Position:=".
...
Рейтинг: 0 / 0
Зависание GUI
    #39590645
YuRock,

Спасибо!
Код: pascal
1.
Progressbar.Update;
...
Рейтинг: 0 / 0
Зависание GUI
    #39590652
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Zelius
Код: pascal
1.
Application.ProcessMessages; <== Про ProcessMessages уже сказали


Это так себе способ перерисовать конкретное окно. Недостатки:
1. Обработаются все накопившиеся сообщения, что долго и в данном случае не нужно;
2. Самое главное. После InvalidateRect (которая будет вызвана при изменении прогрессбара) далеко не всегда делается посылка WM_PAINT:

The system sends a WM_PAINT message to a window whenever its update region is not empty and there are no other messages in the application queue for that window.

Поэтому это может просто не помочь.
Для этого случая существует специальная функция - UpdateWindow.
...
Рейтинг: 0 / 0
Зависание GUI
    #39590667
YuRock,

Код: pascal
1.
2.
3.
4.
5.
6.
7.
for i:0 to Progressbar.Max do
  begin
    Progressbar.Position:=i;
    Progressbar.Update;
    do_something;
    
  end;


Подвисает, но почти в конце цикла.


Код: pascal
1.
2.
3.
4.
5.
6.
7.
for i:0 to Progressbar.Max do
  begin
    Progressbar.Position:=i;
    Application.ProcessMessages;
    do_something;
 
  end;



Не подвисает.
...
Рейтинг: 0 / 0
Зависание GUI
    #39590673
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
begin
  progressbar1.Max:=1000;
  for i := 0 to 1000 do
    begin
      Progressbar1.Position:=i;
      //Progressbar1.Update;
      Application.ProcessMessages;
      Sleep(100);
    end;

end;


Для экспериментов.
Код: pascal
1.
Progressbar1.Update;


Зависает.
...
Рейтинг: 0 / 0
Зависание GUI
    #39590701
white_nigger
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Михаил Евгеньевич
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
begin
  progressbar1.Max:=1000;
  for i := 0 to 1000 do
    begin
      Progressbar1.Position:=i;
      //Progressbar1.Update;
      Application.ProcessMessages;
      Sleep(100);
    end;

end;



Для экспериментов.
Код: pascal
1.
Progressbar1.Update;



Зависает.Всё именно так и должно работать
...
Рейтинг: 0 / 0
Зависание GUI
    #39590770
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Михаил Евгеньевич,

так и должно быть. если у тебя do_something делается 100 миллисекунд и больше, готовься к тормозам. ну или делай сразу нормально, то есть с потоками.
...
Рейтинг: 0 / 0
Зависание GUI
    #39590825
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Михаил Евгеньевич
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
begin
  progressbar1.Max:=1000;
  for i := 0 to 1000 do
    begin
      Progressbar1.Position:=i;
      //Progressbar1.Update;
      Application.ProcessMessages;
      Sleep(100);
    end;

end;



Для экспериментов.
Код: pascal
1.
Progressbar1.Update;



Зависает.
Зависать может что-то другое, но не прорисовка прогрессбара при Progressbar1.Update. В отличие от прорисовки путем выкрутки сообщений (которых может еще и не быть).
...
Рейтинг: 0 / 0
Зависание GUI
    #39590826
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Михаил Евгеньевич,

т.ч. НЕ ВЕРЮ (с)
...
Рейтинг: 0 / 0
Зависание GUI
    #39590851
YuRock,

"Зависает" всё приложение. Вместе с прогрессбаром. В диспетчере задач "Не отвечает". Прогресс бар не движется. Код выполняется.
...
Рейтинг: 0 / 0
Зависание GUI
    #39590871
Zelius
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Михаил Евгеньевич,

если в программе ADO, то попробуйте асинхронное соединение и выполнение
...
Рейтинг: 0 / 0
Зависание GUI
    #39590876
Фотография krapotkin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
progressbar.update решит вопрос Прогресс не движется
но если окно перекрыть другим окном, то останется только один прогрессбар
если написать форме update то все будет перерисовываться но все равно "висеть". ибо "висение" суть "нереакция на клаву/мышь"
если написать Application.ProcessMessage, то все начнет двигаться, но заодно будут вызваться и другие обработчики, что может привести даже и к новому входу и в этот же обработчик и другим спецэффектам...
т.е. побочка при лечении может быть и страшнее самой болезни.

так что нормальный вариант это именно вынос долгих кусков в отдельный поток
...
Рейтинг: 0 / 0
Зависание GUI
    #39590886
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Михаил ЕвгеньевичYuRock,

"Зависает" всё приложение. Вместе с прогрессбаром. В диспетчере задач "Не отвечает". Прогресс бар не движется. Код выполняется.
А, понятно, это в XP и в 7-ке такой баг был, когда винда запоминала картинку окна и не перерисовывала её даже при корректной перерисовке, пока не обработаешь какое-то там сообщение. В 10-ке пофиксили наконец-то вроде - у меня такое не повторяется.
...
Рейтинг: 0 / 0
Зависание GUI
    #39590909
энди
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Посмотрите AsyncCalls + TaskEx. Можно прямо по тексту программы практически ничего не меняя убрать часть кода в отдельный тред, а в основном просто сделаете свой прогресс. Я так сделал, правда у меня в основном потоке форма с анимационных гифом показывается, но прицип тот же.
...
Рейтинг: 0 / 0
Зависание GUI
    #39590925
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
кстати AsyncCalls на x64 работает?
...
Рейтинг: 0 / 0
Зависание GUI
    #39590934
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
krapotkinтак что нормальный вариант это именно вынос долгих кусков в отдельный поток
Ну это понятно, но ТС не хочет
Михаил ЕвгеньевичНеужели, единственное решение, это отдельный поток для обработки? Мне не нужно во время выполнения кода взаимодействовать с GUI
Ведь это же чудесно, что не нужно. Значит никаких проблем при вынесении логики в отдельный поток вообще не будет.
Михаил Евгеньевичтолько обновлять Progressbar
1-й вариант:
Код: pascal
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.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SyncObjs, ComCtrls, CommCtrl;

type
  TTestThread = class( TThread )
  private
    FProgressBarHandle: HWND;
    FMax: Integer;
    FWaitEvent: TSimpleEvent;
  protected
    procedure Execute; override;
  public
    constructor Create( AProgressBarHandle: HWND; AMax: Integer );
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    btnStart: TButton;
    ProgressBar1: TProgressBar;
    procedure btnStartClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FThread: TTestThread;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TTestThread.Create( AProgressBarHandle: HWND; AMax: Integer );
begin
  FProgressBarHandle := AProgressBarHandle;
  FMax := AMax;
  FWaitEvent := TSimpleEvent.Create;
  inherited Create( False );
end;

destructor TTestThread.Destroy;
begin
  Terminate;
  FWaitEvent.SetEvent;
  inherited;
  FWaitEvent.Free;
end;

procedure TTestThread.Execute;
var
  i: Integer;
begin
  SendMessage( FProgressBarHandle, PBM_SETRANGE, 0, MakeLong( 0, FMax ) );
  for i := 0 to FMax do begin
    SendMessage( FProgressBarHandle, PBM_SETPOS, i, 0 );
    FWaitEvent.WaitFor( 100 );
    if Terminated then
      Exit;
  end;
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
  FThread.Free;
  FThread := TTestThread.Create( ProgressBar1.Handle, 1000 );
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeAndNil( FThread );
end;

end.


2-й вариант:
Код: pascal
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.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SyncObjs, ComCtrls;

const
  WM_SET_PROGRESS_STEP = WM_USER + 1;

type
  TTestThread = class( TThread )
  private
    FFormHandle: HWND;
    FMax: Integer;
    FWaitEvent: TSimpleEvent;
  protected
    procedure Execute; override;
  public
    constructor Create( AFormHandle: HWND; AMax: Integer );
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    btnStart: TButton;
    ProgressBar1: TProgressBar;
    procedure btnStartClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FThread: TTestThread;
    procedure OnNeedStep( var Msg: TMessage ); message WM_SET_PROGRESS_STEP;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TTestThread.Create( AFormHandle: HWND; AMax: Integer );
begin
  FFormHandle := AFormHandle;
  FMax := AMax;
  FWaitEvent := TSimpleEvent.Create;
  inherited Create( False );
end;

destructor TTestThread.Destroy;
begin
  Terminate;
  FWaitEvent.SetEvent;
  inherited;
  FWaitEvent.Free;
end;

procedure TTestThread.Execute;
var
  i: Integer;
begin
  for i := 0 to FMax do begin
    SendMessage( FFormHandle, WM_SET_PROGRESS_STEP, i, 0 );
    FWaitEvent.WaitFor( 100 );
    if Terminated then
      Exit;
  end;
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
  FThread.Free;
  ProgressBar1.Max := 1000;
  FThread := TTestThread.Create( Handle, ProgressBar1.Max );
end;

procedure TForm1.OnNeedStep( var Msg: TMessage );
begin
  ProgressBar1.Position := Msg.WParam;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeAndNil( FThread );
end;

end.


В обоих вариантах можно SendMessage заменить на PostMessage, если на самом деле нет необходимости в мгновенной синхронной перерисовке.

И еще нюанс. Если во время выполнения потока изменится Handle формы (это может произойти, например, при изменении BorderStyle) - то, конечно, все поламается (сообщения перестанут отправляться и интерфейс обновляться соответственно тоже). Но это лучше, чем отгрести полный крах при использовании в потоке Form1.Handle в этот момент.
Т.ч. если надумаешь "сильно" менять интерфейс - останови вначале этот поток.
...
Рейтинг: 0 / 0
Зависание GUI
    #39591019
энди
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
rgreat,

Сам лично не проверял, но написано
Supported compilers: Delphi 5 to 10.1
Supported platforms: Win32, Win64
...
Рейтинг: 0 / 0
Зависание GUI
    #39591084
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Самый простой, пример кода - который демонстрирует, удобство использования потоков

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
procedure TForm1.Button1Click(Sender: TObject);
begin
  TThread.Synchronize(TThread.CurrentThread,
    procedure
    begin
      while ProgressBar1.Position < ProgressBar1.Max do
      begin
        ProgressBar1.Position := ProgressBar1.Position + 1;

        SleepEx(10, true);
      end;
    end);
end;
...
Рейтинг: 0 / 0
Зависание GUI
    #39591087
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А вот так, создавать анонимные потоки. Не связывая с внешным потоком

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
procedure TForm1.Button1Click(Sender: TObject);
var
  Thread: TThread;
begin
  Thread := TThread.CreateAnonymousThread(
    procedure
    begin
      while ProgressBar1.Position < ProgressBar1.Max do
      begin
        ProgressBar1.Position := ProgressBar1.Position + 1;

        SleepEx(10, true);
      end;
    end);
  Thread.Start;
end;
...
Рейтинг: 0 / 0
Зависание GUI
    #39591125
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшиккоторый демонстрирует, удобство использования потоковЗапускать пробовал?
...
Рейтинг: 0 / 0
Зависание GUI
    #39591127
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
YuRockКод не пробовал с телефона пишу.
По идее этот код должен так же "зависать", как и у ТС.

Док, возможно, если ты это на Лазаре написал, там могли впихнуть и Update, а не только Invalidate, внутрь "Position:=".
я про sleep написал, потому что это наиболее близкая и понятная аналогия его do_something :)

В Лазаре все устроено абсолютно точно также, как и внутри Дельфей. Поэтому, без многопоточности здесь не обойтись, как бы ТС не пытался избежать понимания этого :)
...
Рейтинг: 0 / 0
Зависание GUI
    #39591129
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

На Токио всё работает. А что???
...
Рейтинг: 0 / 0
Зависание GUI
    #39591130
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Для лазура

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
procedure Test;
begin
   while Form1.ProgressBar1.Position < Form1.ProgressBar1.Max do
   begin
     Form1.ProgressBar1.Position := Form1.ProgressBar1.Position + 1;
     Sleep(10);
   end;
 end;


procedure TForm1.Button1Click(Sender: TObject);
var
  Thread: TThread;
begin
  Thread := TThread.CreateAnonymousThread(  @Test);
  Thread.Start;
end;   
...
Рейтинг: 0 / 0
Зависание GUI
    #39591131
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикНа Токио всё работает. А что???Пытаюсь уразуметь смысл вызова Synchronize из главного потока
...
Рейтинг: 0 / 0
Зависание GUI
    #39591149
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

Это просто два примера - лёгких. Которые демонстрируют, что страшные ленты потоков остались в прошлом
...
Рейтинг: 0 / 0
Зависание GUI
    #39591157
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикЭто просто два примераЭти два примера - идиотские. Первый вызывает Syncrinize в главном потоке, хотя четко же написаноWarning: Do not call Synchronize from within the main thread. This can cause an infinite loop.
Второй создает новый поток и из него обращается с свойствам VCL-объектов
...
Рейтинг: 0 / 0
Зависание GUI
    #39591167
kealon(Ruslan)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Михаил Евгеньевич,

win 10 FaCkingUpdate?
...
Рейтинг: 0 / 0
Зависание GUI
    #39591175
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикСамый простой, пример кода - который демонстрирует, удобство использования потоков
Кроме того, что сказал Василиск, хочу отметить еще одно.
Всё это "удобство" улетает в трубу, когда необходимо завершить поток.
А иметь возможность завершать потоки вручную (а не дожидаясь, пока он сам закончится) необходимо практически всегда, как показывает практика.
...
Рейтинг: 0 / 0
Зависание GUI
    #39591176
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшикчто страшные ленты потоков остались в прошлом
Да, предыдущее моё сообщение - как раз про отсутствие "страшных лент".
...
Рейтинг: 0 / 0
Зависание GUI
    #39591213
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вот вам пример с кнопками старт и стоп.

И всё работает - обращение к компонентам нормально.

Код: pascal
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.
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Thread: TThread;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Thread.Resume;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Thread.Suspend;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.Caption := 'start';
  Button2.Caption := 'stop';
  ProgressBar1.Max := 1000;

  Thread := TThread.CreateAnonymousThread(
    procedure
    begin
      while ProgressBar1.Position < ProgressBar1.Max do
      begin
        ProgressBar1.Position := ProgressBar1.Position + 1;

        Form1.Caption := ProgressBar1.Position.ToString;
      end;
    end);
end;

end.



YuRock,
Посмотри как реализован CreateAnonymousThread. Он заменяет и твою ленту
...
Рейтинг: 0 / 0
Зависание GUI
    #39591217
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я хочу подметить один факт

- Потоки не надо создавать бесконечно. Достаточно 1 - 5 ... Пусть живут всю программу, и с ними работаем.

И не важно, создался ли новый класс этот анонимный. Вы такой же класс пишите ручками.
...
Рейтинг: 0 / 0
Зависание GUI
    #39591224
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Забыл в пример добавить завершение для формы

Код: pascal
1.
2.
3.
4.
5.
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Thread.Suspend;
  Thread.Terminate;
end;



Но опять - же, две строчки.. И поток убит
...
Рейтинг: 0 / 0
Зависание GUI
    #39591233
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикИ всё работает - обращение к компонентам нормально.
1. Работает случайно, пока везёт (обращения к объектам-компонентам ни разу не синхронизированы);
2. Работает только один раз (Resume и Suspend не помогут начать сначала).

НяшикYuRock, Посмотри как реализован CreateAnonymousThread. Он заменяет и твою ленту
Мне негде посмотреть, но мне хватило доку почитать, чтобы понять, что он FreeOnTerminate-only (как я и ожидал), а значит практически всегда не пригоден для использования.
...
Рейтинг: 0 / 0
Зависание GUI
    #39591240
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикЗабыл в пример добавить завершение для формы

Код: pascal
1.
2.
3.
4.
5.
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Thread.Suspend;
  Thread.Terminate;
end;




Но опять - же, две строчки.. И поток убит
удивительная способность делать простое сложным
...
Рейтинг: 0 / 0
Зависание GUI
    #39591243
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик
Код: pascal
1.
2.
3.
4.
5.
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Thread.Suspend;
  Thread.Terminate;
end;



Но опять - же, две строчки.. И поток убит
Ты, похоже, никогда не программировал, используя несколько потоков, раз пишешь (да еще и советуешь) такое.
Если б хоть раз попробовал - отпало бы желание прерывать свой код некорректно (в неизвестном месте).
...
Рейтинг: 0 / 0
Зависание GUI
    #39591251
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

увы, всё не настолько просто. но в случае тс только один вызов синхронизировать нужно.
...
Рейтинг: 0 / 0
Зависание GUI
    #39591252
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Докудивительная способность делать простое сложным
Больше похоже на попытки рандомного программирования. Вызовы первых попавшихся под руку функций в случайном порядке, не парясь на счет того, что они делают и зачем нужны.
...
Рейтинг: 0 / 0
Зависание GUI
    #39591253
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
YuRock,

так и есть
...
Рейтинг: 0 / 0
Зависание GUI
    #39591256
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
есть такой устоявшийся термин - "судорожное программирование"
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Зависание GUI
    #39591259
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
вот, к слову, упомянутая либа:

https://github.com/ahausladen/AsyncCalls

Requirements
Supported compilers: Delphi 5 to 10.1
Supported platforms: Win32, Win64

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
procedure TForm1.Button3Click(Sender: TObject); 
var 
  Value: Integer; 
begin 
  TAsyncCalls.Invoke(procedure 
  begin 
    // Executed in a thread
    Value := 10; 
    TAsyncCalls.VCLInvoke(procedure 
    begin 
      ShowMessage('The value may not equal 10: ' + IntToStr(Value)); 
    end); 
    Value := 20; 
    TAsyncCalls.VCLSync(procedure 
    begin 
      ShowMessage('The value equals 20: ' + IntToStr(Value)); 
    end); 
    Value := 30; 
  end); 

  Sleep(1000); 
end; // If the async. function is run yet, the "end" will sync it


Я у себя из компонент использую жедаевский TJvThread. И самописанный TThreadTimer.
Тут на форуме Wadman своё изобразил ещё :)
Жедаевский довольно удобный. Кинул, OnExecute обработал. Синхронно поменял прогресс и забыл весь кошмар как жуткий сон.
Синхронное продвижение прогресса:
TThread.Synchronize, TThread.Queue, SendMessage, PostMessage, можно выбрать, любой будет работать.
...
Рейтинг: 0 / 0
Зависание GUI
    #39591282
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикНо опять - же, две строчки.. И поток убитУверен? А спорим, что нет?
...
Рейтинг: 0 / 0
Зависание GUI
    #39591310
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
makhaon,

Я правильно понял, что `TAsyncCalls.VCLSync()` будет ждать исполнения ShowMessage() в основном потоке, а основной поток в этот момент будет ждать завершения `TAsyncCalls.Invoke()` на строчке
Код: pascal
1.
end; // If the async. function is run yet, the "end" will sync it

?.. Т.е. программа тупо зависнет? :)
...
Рейтинг: 0 / 0
Зависание GUI
    #39591318
kealon(Ruslan)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикСамый простой, пример кода - который демонстрирует, удобство использования потоков

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
procedure TForm1.Button1Click(Sender: TObject);
begin
  TThread.Synchronize(TThread.CurrentThread,
    procedure
    begin
      while ProgressBar1.Position < ProgressBar1.Max do
      begin
        ProgressBar1.Position := ProgressBar1.Position + 1;

        SleepEx(10, true);
      end;
    end);
end;


зачот!!!!!!!!!!!!!
добавлю к задачам "найди и расскажи ..."
...
Рейтинг: 0 / 0
Зависание GUI
    #39591328
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alekcvp,

как я понимаю, не тупо зависнет :) а будет ждать нажатия (иначе - смысл?). Впрочем - можно взять попробовать, там один файл всего.
...
Рейтинг: 0 / 0
Зависание GUI
    #39591412
энди
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
вот как выглядит кусок кода с использованием asynccalls+taskex, такое оформление мне понравилось именно простым способом завернуть код в дочерний поток, в данном примере датасет открывается в потоке, а в основном потоке работает WaitShow представляющий собой вызов формы с анимационным гифом. Код меняется минимально и его читаемость остается на приличном уровне.

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
    dm.qSchet.DisableControls;
    WaitShow;
    try
      EnterWorkerThread;
      try
        dm.qSchet.Open;
        CheckAbort;
      finally
        LeaveWorkerThread;
      end;
    except
      on E:Exception do Error:= E.Message;
    end;
    dm.qSchet.EnableControls;
    WaitHide;
    if Error<>'' then ShowMessage(Error);
...
Рейтинг: 0 / 0
53 сообщений из 53, показаны все 3 страниц
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Зависание GUI
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]