Потоки

@Hito · Регистрация: 02.09.2015

Студворк — интернет-сервис помощи студентам

Ребят, я тут с потоками чуток поэкспериментировал... Изучаю их. Почему у меня программа, вот с этим кодом, виснет через минуту, после запуска?

Кликните здесь для просмотра всего текста

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
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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
type
  Potok_1 = Class (TThread)
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Execute; Override;
  end;
 
type
  Potok_2 = Class (TThread)
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Execute; Override;
  end;
 
var
  Form1: TForm1;
  MeThred_1: Potok_1;
  MeThred_2: Potok_2;
  Potoki: Boolean;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Button2.Enabled:= False;
end;
 
procedure Potok_1.Execute;
var bmp:TBitmap;
begin
  while Potoki do
  begin
    bmp := TBitmap.Create;
    bmp.Width := 200; // Ширина скрина
    bmp.Height := 33; // Высота скрина
    BitBlt(bmp.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
    GetDC(0), 573,103,SRCCOPY); // 573,103 - Координата скрина
    Form1.Image1.Width := bmp.Width;
    Form1.Image1.Height := bmp.Height;
    Form1.Image1.Picture.Assign(bmp);
    bmp.Free;
    Sleep (55)
  end;
end;
 
procedure Potok_2.Execute;
var bmp:TBitmap;
begin
  while Potoki do
  begin
    bmp := TBitmap.Create;
    bmp.Width := 370; // Ширина скрина
    bmp.Height := 53; // Высота скрина
    BitBlt(bmp.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
    GetDC(0), 535,387,SRCCOPY); // 535,387 - Координата скрина
    Form1.Image2.Width := bmp.Width;
    Form1.Image2.Height := bmp.Height;
    Form1.Image2.Picture.Assign(bmp);
    bmp.Free;
    Sleep (55)
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Potoki := True;
 
  MeThred_1 := Potok_1.Create(True); // Создаем экземпляр класса потока
  MeThred_1.FreeOnTerminate:=True; // После выполнения потока, автоматически из него выйдет и убьет его.
  MeThred_1.Priority:=tpLower; // Приаритет потока
  MeThred_1.Resume;
 
  MeThred_2 := Potok_2.Create(True); // Создаем экземпляр класса потока
  MeThred_2.FreeOnTerminate:=True; // После выполнения потока, автоматически из него выйдет и убьет его.
  MeThred_2.Priority:=tpLower; // Приаритет потока
  MeThred_2.Resume;
 
  Button1.Enabled:= False;
  Button2.Enabled:= True;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  Potoki := False;
  Button1.Enabled:= True;
  Button2.Enabled:= False;
  Form1.Image1.Picture := nil;
  Form1.Image2.Picture := nil;
end;
 
end.

@Hito · 06.05.2016, 17:17 **[ТС]**

krapotkin, ну, разбираюсь пока... Инфы накидали вы тут все же - благодарю. Как по всей этой инфе приду в тупик, вернусь сюда ) Ну, или если решу проблему. В таком случае выложу код тут. А то у этого форума проблема есть... Лазаю тут по темам... Чел проблему описывает и код показывает - ему умными словами объясняют и он уходит. А как в итоге он все же все сделал... - Так никто и не узнал и я в том числе.

Добавлено через 50 минут
http://www.delphi-manual.ru/synchronize.php

Кликните здесь для просмотра всего текста

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TMyThread.UpdateCaption;
begin
while True do
  begin
    Form1.Caption:=IntToStr(I);//I - глобальная переменная основной программы, индекс массива
    sleep(100);
  end;
end;
 
procedure TMyThread.Execute;
begin
  Synchronize(UpdateCaption);
end;

Видим, что происходит именно то, о чём написано выше. Так как весь код потока, и модификация заголовка Формы, и цикл ожидания, выполняется в методе Synchronize, а значит в главном потоке, то приложение будет выглядеть зависшим, и его даже будет невозможно корректно завершить.
Теперь попробуем вывести цикл за пределы Synchronize:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TMyThread.UpdateCaption;
begin
  Form1.Caption:=IntToStr(Cap);
end;
 
procedure TMyThread.Execute;
begin
while True do
  begin
    Synchronize(UpdateCaption);
    sleep(100);
  end;
end;

Это правильный вариант. С помощью метода Synchronize выполняется только непосредственная модификация Заголовка Формы, а цикл ожидания выполняется в потоке, и не мешает главному потоку.

Я вот намутил вроде все, как сказано... Но у меня все равно прога просто виснет при клике на кнопку...

Кликните здесь для просмотра всего текста

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SyncObjs;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  TMyThread = class(TThread)
    private
    { Private declarations }
  protected
    procedure Execute; override;
    procedure UpdateCaption;
  end;
 
var
  Form1: TForm1;
  MyThread: TMyThread;
  I: Integer;
 
implementation
 
{$R *.dfm}
 
procedure TMyThread.UpdateCaption;
begin
  while True do
  begin
    Form1.Edit1.Text:=IntToStr(I);//I - глобальная переменная основной программы, индекс массива
  end;
end;
 
procedure TMyThread.Execute;
begin
  while True do
  begin
    Synchronize(UpdateCaption);
    sleep(100);
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  MyThread:=TMyThread.Create(False);
  MyThread.Priority:=tpNormal;
  MyThread.FreeOnTerminate:=true;
end;
 
end.

Добавлено через 19 минут
Заработала! )))

Кликните здесь для просмотра всего текста

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SyncObjs;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  TMyThread = class(TThread)
    private
    { Private declarations }
  protected
    procedure Execute; override;
    procedure UpdateCaption;
  end;
 
var
  Form1: TForm1;
  MyThread: TMyThread;
  I: Integer;
 
implementation
 
{$R *.dfm}
 
procedure TMyThread.UpdateCaption;
begin
  Form1.Edit1.Text:=IntToStr(I);
end;
 
procedure TMyThread.Execute;
begin
while True do
  begin
    Synchronize(UpdateCaption);
    I := I + 1;
    sleep(100);
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  I := 1;
  MyThread:=TMyThread.Create(False);
  MyThread.Priority:=tpNormal;
  MyThread.FreeOnTerminate:=true;
end;
 
end.

@krapotkin · 06.05.2016, 17:44

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

правильнее было бы

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
TMyThread=class(TThread)
...
  e:TEdit;
end;
 
procedure TForm1.b1Click(...);
begin
th:=TMyThread.Create(true);
th.e:=Edit;
...
th.start;
end;
 
procedure TMyThread.UpdateCaption;
begin
  E.Text:=IntToStr(I);
end;

@Hito · 06.05.2016, 18:01 **[ТС]**

Сообщение от krapotkin

все то же самое сделал бы обычный таймер

Да я согласен с этим. Но я лишь примеры привел. Просто потом в итоге мне нужно, чтобы в Image1 Экран сканировался постоянно и вот это в таймер поместить можно, а вот в Image2 экран начнет сканироваться только тогда, когда в Image1 будут соблюдены условия (найдутся нужные пиксели). Далее пойдет расшифровка капчи в Image2 (это я уже реализовал), потом определенные действия и потом пауза секунд в 5. Вот мне нужно, чтоб при этой паузе вся прога не висла.

Добавлено через 3 минуты

Сообщение от krapotkin

TMyThread=class(TThread)
...
e:TEdit;
end;

TEdit или TEdit1?

Добавлено через 3 минуты

Сообщение от Hito

Далее пойдет расшифровка капчи

Только не думайте, что я спамер какой-нибудь леплю - это не мое. В игре мне просто трудно капчу одну набирать самому, а рыбку ловить хочется...))

Добавлено через 2 минуты

Сообщение от Hito

TEdit или TEdit1?

Понял. В строке 9 Edit1...

@krapotkin · 06.05.2016, 18:03

все, что касается экрана и работы с пользователем - все всегда в главный поток
все, что касается обработки данных, связи с сервером, подключения к БД - все в отдельный поток

@Hito · 06.05.2016, 18:10 **[ТС]**

Сообщение от krapotkin

все, что касается экрана и работы с пользователем - все всегда в главный поток
все, что касается обработки данных, связи с сервером, подключения к БД - все в отдельный поток

Ок... Давайте так... Например... Мне нужно, чтобы в Image1 часть экрана сканировалась постоянно, пока работает прога. В Image2 попадает часть экрана, только при соблюдении условий в Image1, и фиксируется там до тех пор, пока не пройдет анализ, действия и пауза, а в Image1 продолжает сканироваться экран. Как это сделать? Если в таймер запихнуть все это, то в момент, когда будет анализироваться Image2, осуществляться действия и проходить пауза, и в Image1 скан прекратиться. И вообще во время паузы вся прога повиснет...

@krapotkin · 06.05.2016, 18:18

простой таймер сканирует экран
анализ выполняется в потоке и ничего не тормозит
в image ничего грузить не нужно, нужно создавать TBitmap

в моей "заметке" написано, что событие OnTerminate производится уже в главном потоке, при этом объект потока еще содержит все нужные данные. поэтому все, что поток проанализировал, там будет доступно

Добавлено через 27 секунд
никакой паузы нет, таймер сам срабатывает когда нужно

@Hito · 06.05.2016, 18:20 **[ТС]**

Сообщение от krapotkin

простой таймер сканирует экран
анализ выполняется в потоке и ничего не тормозит
в image ничего грузить не нужно, нужно создавать TBitmap
в моей "заметке" написано, что событие OnTerminate производится уже в главном потоке, при этом объект потока еще содержит все нужные данные. поэтому все, что поток проанализировал, там будет доступно

Вы забыли про паузу, которая мне НУЖНА.

@krapotkin · 06.05.2016, 18:23

таймер сам себе пауза, что еще нужно?

@Hito · 06.05.2016, 20:13 **[ТС]**

Странная херь... У меня программа запускается и виснет через 5 минут, с кодом, в котором вообще ни одного потока нет...:

Кликните здесь для просмотра всего текста

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SyncObjs, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    Image2: TImage;
    Timer1: TTimer;
    Timer2: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  bmp1,bmp2:TBitmap;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Button2.Enabled:= False;
  Timer1.Enabled:=False;
  Timer2.Enabled:=False;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled:=True;
  Timer2.Enabled:=True;
  Button1.Enabled:= False;
  Button2.Enabled:= True;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  Timer1.Enabled:=False;
  Timer2.Enabled:=False;
  Button1.Enabled:= True;
  Button2.Enabled:= False;
  Image1.Picture := nil;
  Image2.Picture := nil;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  bmp1 := TBitmap.Create;
  bmp1.Width := 200; // Ширина скрина
  bmp1.Height := 33; // Высота скрина
  BitBlt(bmp1.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
  GetDC(0), 573,103,SRCCOPY); // 573,103 - Координата скрина
  Form1.Image1.Width := bmp1.Width;
  Form1.Image1.Height := bmp1.Height;
  Form1.Image1.Picture.Assign(bmp1);
  bmp1.Free;
end;
 
procedure TForm1.Timer2Timer(Sender: TObject);
begin
  bmp2 := TBitmap.Create;
  bmp2.Width := 370; // Ширина скрина
  bmp2.Height := 53; // Высота скрина
  BitBlt(bmp2.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
  GetDC(0), 535,387,SRCCOPY); // 535,387 - Координата скрина
  Form1.Image2.Width := bmp2.Width;
  Form1.Image2.Height := bmp2.Height;
  Form1.Image2.Picture.Assign(bmp2);
  bmp2.Free;
end;
 
end.

При чем проходит характерный такой сигнал, когда ошибка какая-нибудь вылазит, но ошибки самой никакой не показывает... Уж в этом-то коде что может быть такого...?

@mss · 06.05.2016, 21:00

Сообщение от Hito

Странная херь

Что ж странного в "хери" ?
Таймер у тебя фигачит в темпе ошпареного кота, всякий раз когда он тикает ты запрашиваешь у ОС ресурс (GetDC), а взад не возвращаешь (ReleaseDC)
И второй таймер, который вообще не нужен, у тебя занят той же чудесной "херью")

@Hito · 06.05.2016, 21:13 **[ТС]**

Сообщение от mss

всякий раз когда он тикает ты запрашиваешь у ОС ресурс

Ну, как бы у меня core i7 и при запуске программы он загружен всего на 10% Это при запущенных других программах. Я раньше писал скрипты под одну программу и там делал не один поток, у которого пауза была 50 мс и все нормально было...

Сообщение от mss

а взад не возвращаешь (ReleaseDC)

А как вернуть...? )

Сообщение от mss

И второй таймер, который вообще не нужен, у тебя занят той же чудесной "херью")

Да прога и с одним таймером так же виснет.

Добавлено через 5 минут
Вот пожалуйста... Код вообще из одного таймера и прога благополучно виснет через 5 мин...

Кликните здесь для просмотра всего текста

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  bmp:TBitmap;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
    bmp := TBitmap.Create;
    bmp.Width := 370; // Ширина скрина
    bmp.Height := 53; // Высота скрина
    BitBlt(bmp.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
    GetDC(0), 535,387,SRCCOPY); // 535,387 - Координата скрина
    Image1.Width := bmp.Width;
    Image1.Height := bmp.Height;
    Image1.Picture.Assign(bmp);
    bmp.Free;
end;
 
end.

@mss · 06.05.2016, 21:15

Сообщение от Hito

у меня core i7

Ну и любуйся им)
Речь-то о ресурсах ОС, а не о производительности процессора..

Сообщение от Hito

Я раньше писал

А надо было сначала читать.

Сообщение от Hito

как вернуть...?

Про ReleaseDC я с кем разгваривал, сам с собой ?)

Сообщение от Hito

прога и с одним таймером так же виснет

Но тебе мало - ты два забубенил)

@Hito · 06.05.2016, 21:21 **[ТС]**

Сообщение от mss

Про ReleaseDC я с кем разгваривал, сам с собой ?)

Не понял... Я всего второе сообщение от Вас вижу тут... В первом было:

Сообщение от mss

а взад не возвращаешь (ReleaseDC)

На что я и задал вопрос - "А как вернуть...?" Так что я не знаю - где Вы и с кем разговаривали про ReleaseDC.

@mss · 06.05.2016, 21:25

Ну если в моем сообщении фигурирует ReleaseDC, а в твоем коде этого вызова нет, то это я кому и для чего, по-твоему, написал ?
Самому себе что ли ?)
Или все же тебе, чтобы ты подсутелился погуглить что это за зверь ?

@Hito · 06.05.2016, 23:59 **[ТС]**

Сообщение от mss

Или все же тебе, чтобы ты подсутелился погуглить что это за зверь ?

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

Добавлено через 6 минут
Блин... Ну это попа... Это пол дня опять потратить, чтоб найти нормальный пример - как эта команда пишется... Ну, если вы знаете - неужели трудно дать пример на моем примере...?

Добавлено через 7 минут
Так?

Delphi
1
2
3
4
5
6
7
8
9
10
    ReleaseDC(0,bmp);
    bmp := TBitmap.Create;
    bmp.Width := 370; // Ширина скрина
    bmp.Height := 53; // Высота скрина
    BitBlt(bmp.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
    GetDC(0), 535,387,SRCCOPY); // 535,387 - Координата скрина
    Image1.Width := bmp.Width;
    Image1.Height := bmp.Height;
    Image1.Picture.Assign(bmp);
    bmp.Free;

Добавлено через 36 минут
Разобрался...

Delphi
1
2
3
4
5
6
7
8
9
10
    bmp := TBitmap.Create;
    bmp.Width := 370; // Ширина скрина
    bmp.Height := 53; // Высота скрина
    BitBlt(bmp.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
    GetDC(0), 535,387,SRCCOPY); // 535,387 - Координата скрина
    Image1.Width := bmp.Width;
    Image1.Height := bmp.Height;
    Image1.Picture.Assign(bmp);
    ReleaseDC(0, GetDC(0));
    bmp.Free;

Добавлено через 34 минуты
Нифига в общем не разобрался...

Добавлено через 1 час 3 минуты
Во!

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
var DC: HDC;
begin
  bmp1 := TBitmap.Create;
  bmp1.Width := 200; // Ширина скрина
  bmp1.Height := 33; // Высота скрина
  DC:=GetDC(0);
  BitBlt(bmp1.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
  DC, 573,103,SRCCOPY); // 573,103 - Координата скрина
  ReleaseDC(0, DC);
  Image1.Width := bmp1.Width;
  Image1.Height := bmp1.Height;
  Image1.Picture.Assign(bmp1);
  bmp1.Free;
end;

Добавлено через 3 минуты
Вот так все работает с двумя потоками!

Кликните здесь для просмотра всего текста

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SyncObjs, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  TPotok_1 = class(TThread)
    Image1:TImage;
    private
    { Private declarations }
  protected
    procedure Execute; override;
    procedure ScreenImage1;
  end;
 
  TPotok_2 = class(TThread)
    Image2:TImage;
    private
    { Private declarations }
  protected
    procedure Execute; override;
    procedure ScreenImage2;
  end;
 
var
  Form1: TForm1;
  Potok_1: TPotok_1;
  Potok_2: TPotok_2;
  Potoki: Boolean;
  bmp1,bmp2:TBitmap;
 
implementation
 
{$R *.dfm}
 
procedure TPotok_1.ScreenImage1;
var DC: HDC;
begin
  bmp1 := TBitmap.Create;
  bmp1.Width := 200; // Ширина скрина
  bmp1.Height := 33; // Высота скрина
  DC:=GetDC(0);
  BitBlt(bmp1.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
  DC, 573,103,SRCCOPY); // 573,103 - Координата скрина
  ReleaseDC(0, DC);
  Image1.Width := bmp1.Width;
  Image1.Height := bmp1.Height;
  Image1.Picture.Assign(bmp1);
  bmp1.Free;
end;
 
procedure TPotok_2.ScreenImage2;
var DC: HDC;
begin
  bmp2 := TBitmap.Create;
  bmp2.Width := 370; // Ширина скрина
  bmp2.Height := 53; // Высота скрина
  DC:=GetDC(0);
  BitBlt(bmp2.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
  DC, 535,387,SRCCOPY); // 573,103 - Координата скрина
  ReleaseDC(0, DC);
  Image2.Width := bmp2.Width;
  Image2.Height := bmp2.Height;
  Image2.Picture.Assign(bmp2);
  bmp2.Free;
end;
 
procedure TPotok_1.Execute;
begin
while Potoki do
  begin
    Synchronize(ScreenImage1);
    Sleep (55)
  end;
end;
 
procedure TPotok_2.Execute;
begin
while Potoki do
  begin
    Synchronize(ScreenImage2);
    Sleep (55)
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Potoki := True;
 
  Potok_1:=TPotok_1.Create(False);
  Potok_1.Image1:=Image1;
  Potok_1.Priority:=tpNormal;
  Potok_1.FreeOnTerminate:=true;
 
  Potok_2:=TPotok_2.Create(False);
  Potok_2.Image2:=Image2;
  Potok_2.Priority:=tpNormal;
  Potok_2.FreeOnTerminate:=true;
 
  Button1.Enabled:= False;
  Button2.Enabled:= True;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  Potoki := False;
  Button1.Enabled:= True;
  Button2.Enabled:= False;
  Image1.Picture := nil;
  Image2.Picture := nil;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Button2.Enabled:= False;
end;
 
end.

Фух!... Можно расслабиться...

@northener · 07.05.2016, 00:23

Сообщение от Hito

Ребят, я тут с потоками чуток поэкспериментировал

Лучше бы ты с таймером разобрался. Понял как он работает и как его правильно использовать в твоей задаче. Но какие-то троешники убедили тебя что потоки это панацея.
ССЗБ

@Hito · 07.05.2016, 00:27 **[ТС]**

Сообщение от northener

Лучше бы ты с таймером разобрался

В том-то и дело, что с ним я уже разобрался )) Вот и мучаю потоки ))) Ребят, никто не говорит, что я в потоках оставлю скрины экрана. Но разобраться мне в этом НАДО было..

Добавлено через 1 минуту

Сообщение от northener

ССЗБ

Эт че такое..?

@northener · 07.05.2016, 00:31

Сообщение от Hito

В том-то и дело, что с ним я уже разобрался )) Вот и мучаю потоки ))) Ребят, никто не говорит, что я в потоках оставлю скрины экрана. Но разобраться мне в этом НАДО было..

В потоках ты разобрался на тройку с минусом. С таймером тоже также?

Сообщение от Hito

Эт че такое..?

https://yandex.ru/yandsearch?c... 0%B7%D0%B1

@Hito · 07.05.2016, 00:37 **[ТС]**

Сообщение от northener

В потоках ты разобрался на тройку с минусом.

Я разобрался на уровне РАБОЧЕГО кода. Я благодарю конечно за ссылки, которые мне тут давали, но для того, чтобы дать оценку моей работе, нужен эталон, а из вас тут НИ ОДИН, НИ МАЛЕЙШЕГО примера так и не дал. Ну, вот только krapotkin дал пример один...

@northener · 07.05.2016, 00:46

Сообщение от Hito

Я разобрался на уровне РАБОЧЕГО кода

Нифига не разобрался! В твоих потоках не выполняется ничего, кроме

Delphi
1
Sleep (55)

Т.е. они представляют собой только кривые костыли для замены таймера.

Новые блоги и статьи Все статьи Все блоги /
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .	Программа опроса у.з. расходомера SLS-720F Argus19 02.09.2026 Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .	Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0. Maks 31.08.2026 При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .	Архитектура биовида Стива в Майнкрафте: Зачем бонобо кубический каннибализм anaschu 30.08.2026 Кубический Вагинокапитализм в Minecraft: Математический инвариант ОДУ и рок Стивов-бонобо Главная задача разработанной «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы». . .
Оттачиваю умение писать js программы. russiannick 30.08.2026 Проектом выходного дня стало написание Книги шифров Виженера. Итогом стала версия 200, синий туман. Синий туман назван так, потому что замораживает текст под собой. Нажатие синих кнопок управляют. . .	мат медиц модель 30. презентация проекта anaschu 27.08.2026 хоп хоп хоп хидахоп, а я кладую))	Как у меня протекала болезнь zorxor 27.08.2026 Здравствуйте, друзья! Эта запись блога предназначена именно для вас - для моих дорогих друзей, которые знали меня лично. Чтобы ответить на вопрос - а что же со мной произошло на самом деле? Я учился. . .	Нашел вот забавное видео о измерениях. Лучшее что я видел на эту тему kumehtar 26.08.2026 ILETXiw9bMQ Основная суть и тезисы по измерениям: 0D (Нулевое измерение): точка, не имеющая длины, ширины, высоты или объема. Объект не может перемещаться в 0D. 1D (Первое измерение):. . .

@krapotkin 6854 / 4680 / 1465 Регистрация: 14.04.2014 Сообщений: 20,684 Записей в блоге: 21
	06.05.2016, 18:03
	все, что касается экрана и работы с пользователем - все всегда в главный поток все, что касается обработки данных, связи с сервером, подключения к БД - все в отдельный поток 0

@krapotkin 6854 / 4680 / 1465 Регистрация: 14.04.2014 Сообщений: 20,684 Записей в блоге: 21
	06.05.2016, 18:18
	простой таймер сканирует экран анализ выполняется в потоке и ничего не тормозит в image ничего грузить не нужно, нужно создавать TBitmap в моей "заметке" написано, что событие OnTerminate производится уже в главном потоке, при этом объект потока еще содержит все нужные данные. поэтому все, что поток проанализировал, там будет доступно Добавлено через 27 секунд никакой паузы нет, таймер сам срабатывает когда нужно 0

@krapotkin 6854 / 4680 / 1465 Регистрация: 14.04.2014 Сообщений: 20,684 Записей в блоге: 21
	06.05.2016, 18:23
	таймер сам себе пауза, что еще нужно? 0

@mss 3530 / 2270 / 279 Регистрация: 24.12.2010 Сообщений: 13,723
	06.05.2016, 21:25
	Ну если в моем сообщении фигурирует ReleaseDC, а в твоем коде этого вызова нет, то это я кому и для чего, по-твоему, написал ? Самому себе что ли ?) Или все же тебе, чтобы ты подсутелился погуглить что это за зверь ? 0