Форум программистов, компьютерный форум, киберфорум
Pure Basic
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
 
Рейтинг 4.76/34: Рейтинг темы: голосов - 34, средняя оценка - 4.76
Кормпилятор
 Аватар для Quiet Snow
5044 / 1718 / 409
Регистрация: 25.04.2010
Сообщений: 4,827
Записей в блоге: 2

Отрисовка в разных потоках

26.11.2011, 02:02. Показов 6635. Ответов 21
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Господа, давайте делиться опытом, какой код наиболее грамотный.
Суть вопроса: В справке написано - нельзя, но как говорится, если очень
хочется - то можно.
Опытным путём я умудрился понять, что в потоках рисует более чем отлично.
Делаю так: создаю окно, в окне скрин, гружу парочку прозрачных спрайтов или создаю их в
имаджах и переделываю в спрайт(прогу уже выкладывал тут). Создаю поток, в котором эти
спрайты в бесконечном цикле многократно рисуются. Пользую функции:

DisplaySprite
DisplayTransparentSprite
DisplayTranslucentSprite


В основной программе сканирую клавиатуру, мышку и ВНИМАНИЕ!!!
очень осторожно сканирую события таким образом, чтобы в момент отрисови в потоке, не
вызывалась функция WindowEvent().
Так вот вопрос как при таком раскладе сделать так, чтобы нажав кнопку Win можно было выйти в
винду ( ReleaseMouse(1) ) и соответственно войти обратно без последствий( у меня либо появляется
серый экран взаместо рисуемой области, либо мыша приобретает форму весов и при клике на окно
не заходит обратно). Функцию WaitWindowEvent() я по понятным причинам не рассматриваю т.к. она
блокирует программу, а мне нужно, чтобы и в основной программе(не в потоке) мог что-то ещё
обрабатывать.

В потоке у меня примерно так:

Code
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
 Global NowDrawing, NoThreadDraw
 Procedure OtdPotok (*Prm)
  Repeat
 
        If NoThreadDraw = 0     ; Рисуем если допустимо
           NowDrawing = 1   ;  Оповещаем основную прогу, что рисуем
                                   ;   чтобы она не делала ничего "лишнего"
          ClearScreen($FFFFFF)  ;  Очистим экран белым
 
           For i = 1 To 20      ; Рисуем кучу спрайтиков сеткой, для теста
              For y = my To my + 750 Step 16: For x = mx To mx + 1200 Step 16
                  DisplaySprite(NewSPR, x, y)
              Next: Next
           Next
 
          SimpleCur ()   ; Нарисуем курсор
          FlipBuffers()
          ;Delay(1)           ;  Ожидание, думаю аппаратная отрисовка
                                 ;  может тут ещё какое-то время работать
                                 ;  Чисто предположение
           NowDrawing = 0  ; Оповестим программу, что она может делать
                                  ; всё, что запрещено во время отрисовки
          Delay(1)           ; Время на выполнение инструкций основной программой
      EndIf
 
  Until All_Threads_End
 EndProcedure
В основной программе примерно так:
Code
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
  MyThread = CreateThread (@OtdPotok(), 0)    ; Создать поток
  Delay(50)       ; Подождать пока он активируется
  ThreadPriority(MyThread, 32)   ;  Сделаем поток "ненасытным"
 
 
Repeat
   InputALL ()   ; Опрос клавы, мышки и калькуляция координат мышки(своя ф-ция)
 
     ; Если ничего не рисуем, то опросим окно на наличие событий
    If NowDrawing = 0
       Event = WindowEvent()
    EndIf
     ;  Вот с этим работает всё нормально, но нам это не нужно
     ;Event = WaitWindowEvent()
 
       If KeyboardReleased(219)   ;  Кнопка Win
         Repeat: Until NowDrawing = 0
         ReleaseMouse(1): FirstClick = 1: NoThreadDraw = 1
       EndIf
 
       ;  Вот эту вставку написал давно, поэтому немного подзабыл
       ;  что она делает, в программе без потоков она работает отлично
       Select Event 
          Case #PB_Event_CloseWindow: End     ; Закрыть окно
          Case #PB_Event_RestoreWindow
          Repeat: Until NowDrawing = 0
          ReleaseMouse(0): NoThreadDraw = 0
          Case 513                                        ; Возврат в программу
            Repeat: Until NowDrawing = 0
            ReleaseMouse(0)
            If FirstClick: SetMouseXY (WindowMouseX(f), WindowMouseY(f))
            NoThreadDraw = 0
            FirstClick = 0: EndIf
        EndSelect
 
  Delay(5)    ;  Чтобы прога не жрала весь процессор
Until KeyboardReleased(#PB_Key_Escape)
All_Threads_End = 1   ; Говорим потоку, чтобы он сворачивался
Delay(50)                 ; Время чтобы "убился" поток
Короче говоря, хочется узнать, как всё это заставить нормально работать, а если это
невозможно - убедиться в этом.
С потоками работал мало и многого не представляю, как использовать семафоры и мьютексы пока
не допёр, не очень хочется юзать какие-либо суперсложные механизмы...

Доп информация: Если убрать Delay в 36 строчке - прога заработает, но опять же, как тогда
в основной программе "что-либо делать"? Нужно, чтобы она и через такие промежутки могла
нормально среагировать.
0
IT_Exp
Эксперт
34794 / 4073 / 2104
Регистрация: 17.06.2006
Сообщений: 32,602
Блог
26.11.2011, 02:02
Ответы с готовыми решениями:

Отрисовка в потоках
Подскажите пожалуйста где можно почитать? Нужно организовать отрисовку приведений и пакмана(в разных потоках)

Метод выполнить в 11 разных потоках, соответственно для разных входных массивов
Здравствуйте, начал потихоньку разбираться в многопоточном программирование и не могу до конца разобраться. Допустим есть некий метод в...

Циклы обработки сообщений разных форм в разных потоках
Здравствуйте! Подскажите как реализовать циклы обработки сообщений разных форм в разных потоках. У коде одной формы сделал так: ...

21
PB
Просто прогер
1292 / 1079 / 13
Регистрация: 13.03.2009
Сообщений: 2,502
26.11.2011, 03:08
Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
Суть вопроса: В справке написано - нельзя, но как говорится, если очень
хочется - то можно.
Рисовать-то можно, только нужно все синхронизировать. Обычно проблемы бывают если одновременно рисовать из нескольких потоков. Точнее, одновременно обращаться к одному и тому же объекту (в данном случае, экранному буферу). Например, один поток рисует, а другой закончил рисование и скажем сменил буфер FlipBuffers() или очистил экран ClearScreen() что в итоге приведет к тому, что на экране отобразится совсем не то, что задумано, хотя в коде ошибок нет. И это в лучшем случае, а в худшем, программа может завершится с ошибкой.

Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
очень осторожно сканирую события таким образом, чтобы в момент отрисови в потоке, не
вызывалась функция WindowEvent().
Если этого не сделать, что происходят ошибки или что?

В справке написано что WindowEvent() обрабатывает события окон текущего потока http://purebasic.ru/manual.php?id=1354&lng=rus


Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
С потоками работал мало и многого не представляю, как использовать семафоры и мьютексы
Для синхронизации можно использовать мьютексы.
Ими можно заменить уже существубщие переменные-флаги, типа NoThreadDraw и NowDrawing.

Если в программе есть один или более поток, нужно в настройках компилятора обязательно поставить галку в пункте "Создать приложение с безопасным потоком". Иначе программа может вылетать на "ровном месте".
1
Кормпилятор
 Аватар для Quiet Snow
5044 / 1718 / 409
Регистрация: 25.04.2010
Сообщений: 4,827
Записей в блоге: 2
26.11.2011, 16:32  [ТС]
Если этого не сделать, что происходят ошибки или что?
После вызова WindowEvent() во время отрисовки спрайтов окно становится серым и всё, механизмы
продолжают работать(т.к. эскейпом можно выйти из программы), но экран серый, т.е. как я понимаю
не отображается поверхность буфера, видимо происходит какая-то ошибка в самом DirectX...

Иначе программа может вылетать на "ровном месте".
Да так и происходит, то вылетает не успев стартануть, то просто экран серый.
Вот сейчас вроде бы что-то уже заработало, но при сдвигании окна за экран и обратно, та область,
которая была буфером, становится серой и даже если окно вышло за экран на 1 пиксель весь буфер
перестаёт отрисовываться. Уже начинаю понимать, что не лечится это... Но это в принципе не так
уже важно, кому придёт в голову выходить из приложения и двигать окно за экран, глюк конечно
неприятный, но не критичный. Хочется просто чтобы можно было выйти из приложения, допустим,
чтобы сделать какие-то минимальные вещи, типа снять скрин, ответить в скайпе и т.д.
Свернуть такое окошко тоже не получится, но зато другие окна могут быть поверх этого и всё
работает.

Ими можно заменить уже существубщие переменные-флаги, типа NoThreadDraw и NowDrawing.
Ага, понятно...
Если LockMutex(), то другие потоки не выполняются(только текущий), а когда UnlockMutex(), то
выполняются.
Это я не ошибаюсь?

Если в программе есть один или более поток, нужно в настройках компилятора обязательно
поставить галку в пункте "Создать приложение с безопасным потоком".
Это я пробовал, иногда больше глюков, иногда меньше, так и не понял как влияет в данной ситуации.

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

Вот сейчас получил более или менее стабильный код. Как приведу в порядок, выложу сюда
на тестирование. Отрисовка идёт из потока, в основной программе можно полностью нагружать одно
ядро, но единственное, нужно выделять небольшие промежутки времени для выполнения обработчика
событий, устанавливается в алгоритм на усмотрение программиста. Опрос клавиатуры и мышки идёт из
отдельного потока.




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

Хотелось бы знать:
  • Много ли раз вылетает с ошибкой
  • Насколько быстро рисует у вас и на какой модели видеокарты
  • Работает ли кнопка Win (выход в винду)
  • Работает ли программа после перетаскивания окна за экран и обратно.

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

Code
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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
Global ScrRezX.w, ScrRezY.w          ; Разрешение экрана
Global a, b, c, d, e, f, g
Global IsWnd.l = 1                   ; Оконное?
Global All_Threads_End.w             ; Завершить все потоки
Global Dim Fonts(10)                 ; Шрифты
 
 
 Procedure InitProgramm ()
     ScrRezX = 1024: ScrRezY = 768
 
     a = InitMouse()
     b = InitKeyboard()
     c = InitSprite()
     ;d = InitSprite3D()
 
     f = OpenWindow (#PB_Any, 0, 0, ScrRezX + 6, ScrRezY + 6, "Thread Drawing", #PB_Window_ScreenCentered)
     SetWindowColor (f, 0)
     g = OpenWindowedScreen(WindowID(f), 3, 3, ScrRezX, ScrRezY, 0, 0, 0, #PB_Screen_NoSynchronization)
 
     Fonts(1) = LoadFont(1, "Arial", 20)
     Fonts(2) = LoadFont(2, "Tahoma", 50, #PB_Font_Bold | #PB_Font_HighQuality)
 EndProcedure
 
 Global mx, my
 Procedure SimpleCur ()
   StartDrawing(ScreenOutput())
      LineXY(mx+3, my+3, mx+27, my+15, 0)
      LineXY(mx+3, my+3, mx+14, my+25, 0)
      LineXY(mx, my, mx, my, $FFFFFF)
      LineXY(mx+1, my+1, mx+25, my+13, $FFFFFF)
      LineXY(mx+1, my+1, mx+12, my+23, $FFFFFF)
   StopDrawing()
 EndProcedure
 
 #SprProperty = #PB_Sprite_Memory | #PB_Sprite_Texture | #PB_Sprite_AlphaBlending
 Procedure Img2Spr (ImgHandle, SprHandle, NeedCreateSpr)
 
 If NeedCreateSpr
   NewSprHandle_x_9q = CreateSprite(SprHandle, ImageWidth(ImgHandle), ImageHeight(ImgHandle), #SprProperty)
 Else
   NewSprHandle_x_9q = SprHandle
 EndIf
     ;  Определяем смещения в памяти
 StartDrawing(SpriteOutput(NewSprHandle_x_9q))
   *OutBuf_x_9q = DrawingBuffer()
 StopDrawing()
 StartDrawing(ImageOutput(ImgHandle))
   *InpBuf_x_9q = DrawingBuffer()
 StopDrawing()
     ;  Выясняем объём данных для 32 битного цвета
  Shirina_x_9q = ImageWidth(ImgHandle)
  Visota_x_9q = ImageHeight(ImgHandle)
  DataBegin_x_9q = (Shirina_x_9q * ImageHeight(ImgHandle) - Shirina_x_9q) << 2
  *InpBuf_x_9q = *InpBuf_x_9q + DataBegin_x_9q
 
     EnableASM
       PUSH ebx
       PUSH edi
       PUSH esi
       ADD esp, 12
         MOV ecx, Shirina_x_9q
         MOV ebx, Visota_x_9q
         MOV esi, *InpBuf_x_9q
         MOV edi, *OutBuf_x_9q
       SUB esp, 12
       Cykl_x_9q:
           PUSH ecx
             REP MOVSD
           POP ecx
           PUSH ecx
             SHL ecx, 3
             SUB esi, ecx
           POP ecx
         DEC ebx
         JNZ l_cykl_x_9q
       POP esi
       POP edi
       POP ebx
     DisableASM
 If NeedCreateSpr: ProcedureReturn NewSprHandle_x_9q: EndIf
 EndProcedure
 
 Global Dim NewSPR.l(20)             ;  Спрайтики
 Global ClearSPR, Checker
 
 Procedure GenerateSprites ()
 NewSCL.l: Cv.l
 
  ;  Чекер
 NewSCL = CreateImage (#PB_Any, ScrRezX, ScrRezY, 32) ; Создаём чекер
   StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
   For y = 0 To ScrRezY >> 5
      For x = 0 To ScrRezX >> 5
         If (x & 1) = (y & 1): Cv = $FFFFFF
         Else: Cv = $707070
         EndIf
         Box (x << 5, y << 5, 32, 32, Cv)
      Next
   Next
   StopDrawing()
 Checker = Img2Spr (NewSCL, #PB_Any, 1)               ; -> В спрайт его
 FreeImage(NewSCL)                                    ;    Удалим имадж
 
 
  ;  Пустой спрайт
 NewSCL = CreateImage (#PB_Any, 5, 5, 32)             ; Создаём пустой спрайт
 ClearSPR = Img2Spr (NewSCL, #PB_Any, 1)              ; -> В спрайт его
 FreeImage(NewSCL)                                    ;    Удалим имадж
 
 
   ;   Создаём спрайтики
   For i = 0 To 20         ; 10 штук
 
      NewSCL = CreateImage (#PB_Any, 25, 25, 32)         ; Создаём имадж 25x25
 
      StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
         For k = 1 To 15
           DrawingMode (#PB_2DDrawing_AllChannels)   ; Все каналы, т.е. RGB+Alpha
           Box (0, 0, 25, 25, 0)                     ; Полностью прозрачный
           Cv = RGBA(Random(255), Random(255), Random(255), 80 + Random(60))
           LineXY (Random(25), Random(25), Random(25), Random(25), Cv)
         Next k
         ResizeImage (NewSCL, 50, 50, #PB_Image_Smooth)
      StopDrawing()
 
      NewSPR(i) = Img2Spr (NewSCL, #PB_Any, 1)
   Next i
 
 EndProcedure
 
  Global LastEVT, FirstClick, Event
  Global NoThreadDraw
 
 
 
; _____________ /  * * * * * *  \ _____________
;         _____ >    I N I T    < _____
; _____________ \  * * * * * *  / _____________
 
 
      InitProgramm ()
 
      GenerateSprites ()
 
 
 
; _____________ /  * * * * * *  \ _____________
;         _____ >   S T A R T   < _____
; _____________ \  * * * * * *  / _____________
 
 
Global q, NowDrawing
Global Dim Sobytij(500), Schetch.l
 Procedure OtdPotok (*Prm)
 
  Repeat
       ;  Это обработка событий, полученных из основной программы
       If Schetch > 0
         Repeat
         Schetch = Schetch - 1
           Select Sobytij(Schetch) 
              Case #PB_Event_CloseWindow: End
              Case #PB_Event_RestoreWindow 
              ReleaseMouse(0): NoThreadDraw = 0
              Case 513
                ReleaseMouse(0)
                If FirstClick: ;SetMouseXY (WindowMouseX(f), WindowMouseY(f))
                FirstClick = 0: NoThreadDraw = 0
                EndIf
           EndSelect
          
         Until Schetch = 0
       EndIf
 
           ;  Это предшествует отрисовке и сохраняет проц. ресурс
           NowDrawing = 2   ;  Можно обработать события 
           Delay(2)
           NowDrawing = 1   ;  Dead Zone для обработчика событий в основной проге
           Delay(1)         ;  Чем больше - тем лучше, но нежелательно для нас
 
         ;  Тут рисуем что хотим и как хотим
     If NoThreadDraw = 0
        ;ClearScreen($FFFFFF)      ;  Очистим экран
        DisplaySprite(Checker, 0, 0)   ;  Чекер на заднем плане
        
           ;  Надпись
           StartDrawing(ScreenOutput())
              DrawingFont(Fonts(2))
              DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_AlphaBlend)
              DrawText (0, 0, "6000 Прозрачных спрайтов", 0)
           StopDrawing()
 
         ;  Нарисуем 6 тысяч прозрачных спрайтов
         For u = 1 To 20
            mx2 = mx: my2 = my
            For y = my2 To my2 + ScrRezY - 50 Step 50
               For x = mx2 To mx2 + ScrRezX - 50 Step 50
               
               DisplayTransparentSprite(NewSPR(u), x, y)
 
               Next
            Next
         Next u
 
        SimpleCur ()                     ;  Простой курсорчик
     EndIf
         ;  Конец отрисовки
      ;q = q + 1     ;  Если надо посчитаем FPS
  Until All_Threads_End
 EndProcedure
 
 ;  Этот поток для опроса клавиатуры и мыши
 ;  + выполняется ReleaseMouse по кнопке Win
 Procedure OtdPotok2 (*Prm)
  Repeat
        ExamineKeyboard()
       If KeyboardReleased(219)
         ReleaseMouse(1): FirstClick = 1: NoThreadDraw = 1
       EndIf
        ExamineMouse()
        mx = MouseX(): my = MouseY()
    Delay(5)
  Until All_Threads_End
 EndProcedure
 
 
 
      ;  Самый первый опрос мыши и клавиатуры
      ;  Устраняет некоторые баги
      ExamineMouse()
      ExamineKeyboard()
      ReleaseMouse(0)
 
   ;  Создаём потоки
 MyThread = CreateThread (@OtdPotok(), 0)
 MyThread2 = CreateThread (@OtdPotok2(), 0)
 Delay(50)
 
   ;  Приоритеты
 ThreadPriority(MyThread, 31)
 ThreadPriority(MyThread2, 32)
 
 
Repeat
 
   If NowDrawing = 2
   ;  Чистый спрайт, нужен для того, чтобы программа думала
   ;  что мы рисуем с основной программы и производила все
   ;  необходимые для этого операции
   DisplayTransparentSprite(ClearSPR, 0, 0)
   EndIf
 
 
   If NowDrawing = 2
   ;   Получим все события, произошедшие в окне
   ;   и запишем их в спец. массив.
   Repeat
      If NowDrawing = 2 Or NowDrawing = 0
         Event = WindowEvent()
        If Event
           Sobytij(Schetch) = Event
           Schetch = Schetch + 1
        EndIf
      EndIf
   Until Event = 0
   EndIf
 
 
   Repeat: Until NowDrawing = 2    ;  Подождём для флипа
   FlipBuffers()                    ;  Флипуем в основной программе
 
   Delay(5)      ;  Допустим что выполняем какие-либо операции
 
Until KeyboardReleased(#PB_Key_Escape)
All_Threads_End = 1
Delay(500)     ;  Время на завершение всех потоков, пол секунды - оптимально
 
; IDE Options = PureBasic 4.51 (Windows - x86)
; EnableAsm
; EnableThread
; EnableXP
0
PB
Просто прогер
1292 / 1079 / 13
Регистрация: 13.03.2009
Сообщений: 2,502
26.11.2011, 17:40
Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
Вот сейчас вроде бы что-то уже заработало, но при сдвигании окна за экран и обратно, та область,
которая была буфером, становится серой и даже если окно вышло за экран на 1 пиксель весь буфер
перестаёт отрисовываться.
Если перейти на DirectX 7, то все нормально.

Немного поэкспериментировал и вроде этот код нормально работает.
Code
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
Procedure DrawScreen(*z)
  Shared Kill_Flag
  Protected Wind
  
  Delay(400)
  direction = 2
  While Kill_Flag=0
    Wind=GetActiveWindow()
    If Wind=0
      UpdateWindow_(WindowID(0))
      FlipBuffers() 
      ClearScreen(RGB(0, 0, 0))
      DisplaySprite(0, x, x)
      x + direction
      If x > 140 : direction = -2 : EndIf
      If x < 0   : direction =  2 : EndIf
    EndIf
    Delay(1)
  Wend
EndProcedure
 
 
If InitSprite() = 0
  MessageRequester("Error", "Can't open screen & sprite enviroment!", 0)
  End
EndIf
 
If OpenWindow(0, 0, 0, 220, 160, "A screen in a window...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  ButtonGadget(0, 170, 135, 45, 20, "Quit")
  
  If OpenWindowedScreen(WindowID(0), 0, 0, 160, 160, 0, 0, 0)
    CreateSprite(0, 20, 20)
    If StartDrawing(SpriteOutput(0))
      Box(0, 0, 20, 20, RGB(255, 0, 155))
      Box(5, 5, 10, 10, RGB(155, 0, 255))
      StopDrawing()
    EndIf
  Else
    MessageRequester("Error", "Can't open windowed screen!", 0)
    End
  EndIf
EndIf
Kill_Flag = 0
CreateThread(@DrawScreen(), 0)
 
Repeat
  Event = WindowEvent()
  Select Event 
    Case #PB_Event_Gadget
      If EventGadget() = 0
        Break
      EndIf
      
    Case #PB_Event_CloseWindow
      Break 
  EndSelect
  
  Delay(2)
ForEver
 
Kill_Flag = 1
Delay(200)
Добавлено через 44 минуты
Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
Выкладываю код
Честно, не понял зачем рисовать в одном потоке, переключать экранные буферы в другом, а опрашивать клавиатуру в третьем? Это все нужно делать в одном потоке, а не разделять на несколько, иначе будет сложно синхронизировать работу отдельных участков кода!

Обычно все что связанно с выводом на экран, опросом клавиатуры и мышки, выполняют в одном потоке, а ресурсосбережение операции (скажем, создание сложного спрайта), в отдельном потоке.


Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
Работает ли кнопка Win (выход в винду)
Работать-то она работает, только программа виснет при этом.

Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
Работает ли программа после перетаскивания окна за экран и обратно.
Программа захватывает мышку, поэтому не получается выйти за область, созданую OpenWindowedScreen.

-------

Из-за чего возникла необходимость перенести вывод на экран в отдельный поток?
1
Кормпилятор
 Аватар для Quiet Snow
5044 / 1718 / 409
Регистрация: 25.04.2010
Сообщений: 4,827
Записей в блоге: 2
26.11.2011, 18:34  [ТС]
Если перейти на DirectX 7, то все нормально.
Да там проблем меньше в разы, но я как-то тестировал скорость отрисовки, вроде бы там медленнее, да и некоторые вещи не работают так, как хотелось бы, т.е. не идентичны DirectX 9.
Посмотрите мою прогу, что будет, если поставить DirectX7.
Просто часто использую функции:

DisplaySprite
DisplayTransparentSprite
DisplayTranslucentSprite

Добавлено через 17 минут
Работать-то она работает, только программа виснет при этом.
А если нажать Win а потом тащить мышку, курсор кстати не появляется в области отрисовки, у меня по крайней мере так, неочевидно знаю, но что делать, не я эти интерфейсы разрабатывал. При этом чтобы перетащить окно, этот "невидимый курсор" нужно умудриться поставить на заголовок окна и только потом перетаскивать, за пределами окна кго конечно видно.

Работать-то она работает, только программа виснет при этом.
Отключается отрисовка, когда наводишь мышку на окно и кликаешь всё должно продолжаться.

Честно, не понял зачем рисовать в одном потоке, переключать экранные буферы в другом
Честно признаться мне сложно ответить на этот вопрос. Я приследовал цели: отделить отрисовку от обработки механизмов, сделать так чтобы кнопка WIN срабатывала почти при любой загрузке основной программы и чтобы окно можно было вытаскивать за экран и обратно, всё это естественно в DirectX9, чтобы нормально работала ф-ция DisplayTransparentSprite. После кучи багов и перестановок разных кусков кода, после кучи изменений и проверок в разных потоках разных функций сформировался вот такой вариант, который работает на моём компе, поэтому хотелось бы понять, работает ли он на других компах?

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

Добавлено через 12 минут
иначе будет сложно синхронизировать работу отдельных участков кода!
Да тут сложно поспорить, из-за этих извращений кода много, при каких-либо изменениях его придётся тестировать, т.к. часто возникает проблема с функциями StartDrawing()/StopDrawing(), т.к. они в любом случае нужны, чтобы допустим вывести текст или примитивы, одними спрайтами как говорится сыт не будешь. Из-за всего этого при такой структуре приходится жёстко подстраиваться.
DirectX 7 хорош тем, что в полноэкранном режиме программа нормально выходит в винду, но опять же работа кроссплатформенных функций неидентична при DirectX 9, что конечно не очень хорошо.
Я ещё пока не все варианты прочухал из серии "что можно, а что нельзя". Например в подсистеме DirectX9 в пюре нельзя отрисовать примитивы с прозрачностью в спрайт, а таких нюансов там много, нужно всё смотреть и тестировать.
0
PB
Просто прогер
1292 / 1079 / 13
Регистрация: 13.03.2009
Сообщений: 2,502
26.11.2011, 21:37
Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
Я приследовал цели: отделить отрисовку от обработки механизмов, сделать так чтобы кнопка WIN срабатывала почти при любой загрузке основной программы
Основной цикл в котором выполняется отрисовка должен выполнятся как минимум 20 раз в секунду чтобы картинка на экране была динамичной. Этого вполне достаточно для быстрой реакции на нажатие кнопки "WIN".

Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
Первоначально я подумал, что оптимально будет рисовать в главном потоке, а какие либо вычисления класть на другие потоки
Обычно так и поступают. Работа с клавиатурой, мышкой и вывод на экран выполняют в главном потоке, а ресурсоемкие вычисление в другом потоке.
0
Кормпилятор
 Аватар для Quiet Snow
5044 / 1718 / 409
Регистрация: 25.04.2010
Сообщений: 4,827
Записей в блоге: 2
26.11.2011, 23:08  [ТС]
Пофиксил немного косяков, сделал широкоформатку.
Проверено, пока на 2-х компах с XP, ещё на 3-х проверю сегодня.
Тестируйте на разных ОС'ках и отписывайтесь так я буду иметь представление
о работоспособности кода.
Code
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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
  ;
  ;  Отрисовка в отдельном потоке
  ;
 
Global ScrRezX.w, ScrRezY.w          ; Разрешение экрана
Global a, b, c, d, e, f, g
Global All_Threads_End.w             ; Завершить все потоки
Global Dim Fonts(10)                 ; Шрифты
 
 Procedure InitProgramm ()
     ScrRezX = 1280: ScrRezY = 800
 
     a = InitMouse()
     b = InitKeyboard()
     c = InitSprite()
 
     f = OpenWindow (#PB_Any, 0, 0, ScrRezX + 6, ScrRezY + 6, "Thread Drawing", #PB_Window_ScreenCentered)
     SetWindowColor (f, 0)
     g = OpenWindowedScreen(WindowID(f), 3, 3, ScrRezX, ScrRezY, 0, 0, 0, #PB_Screen_NoSynchronization)
 
     Fonts(1) = LoadFont(1, "Arial", 20)
     Fonts(2) = LoadFont(2, "Tahoma", 40, #PB_Font_Bold | #PB_Font_HighQuality)
 EndProcedure
 
 Global mx, my
 Procedure SimpleCur ()
   StartDrawing(ScreenOutput())
      LineXY(mx+3, my+3, mx+27, my+15, 0)
      LineXY(mx+3, my+3, mx+14, my+25, 0)
      LineXY(mx, my, mx, my, $FFFFFF)
      LineXY(mx+1, my+1, mx+25, my+13, $FFFFFF)
      LineXY(mx+1, my+1, mx+12, my+23, $FFFFFF)
   StopDrawing()
 EndProcedure
 
 #SprProperty = #PB_Sprite_Memory | #PB_Sprite_Texture | #PB_Sprite_AlphaBlending
 Procedure Img2Spr (ImgHandle, SprHandle, NeedCreateSpr)
 
 If NeedCreateSpr
   NewSprHandle_x_9q = CreateSprite(SprHandle, ImageWidth(ImgHandle), ImageHeight(ImgHandle), #SprProperty)
 Else
   NewSprHandle_x_9q = SprHandle
 EndIf
     ;  Определяем смещения в памяти
 StartDrawing(SpriteOutput(NewSprHandle_x_9q))
   *OutBuf_x_9q = DrawingBuffer()
 StopDrawing()
 StartDrawing(ImageOutput(ImgHandle))
   *InpBuf_x_9q = DrawingBuffer()
 StopDrawing()
     ;  Выясняем объём данных для 32 битного цвета
  Shirina_x_9q = ImageWidth(ImgHandle)
  Visota_x_9q = ImageHeight(ImgHandle)
  DataBegin_x_9q = (Shirina_x_9q * ImageHeight(ImgHandle) - Shirina_x_9q) << 2
  *InpBuf_x_9q = *InpBuf_x_9q + DataBegin_x_9q
 
     EnableASM
       PUSH ebx
       PUSH edi
       PUSH esi
       ADD esp, 12
         MOV ecx, Shirina_x_9q
         MOV ebx, Visota_x_9q
         MOV esi, *InpBuf_x_9q
         MOV edi, *OutBuf_x_9q
       SUB esp, 12
       Cykl_x_9q:
           PUSH ecx
             REP MOVSD
           POP ecx
           PUSH ecx
             SHL ecx, 3
             SUB esi, ecx
           POP ecx
         DEC ebx
         JNZ l_cykl_x_9q
       POP esi
       POP edi
       POP ebx
     DisableASM
 If NeedCreateSpr: ProcedureReturn NewSprHandle_x_9q: EndIf
 EndProcedure
 
 Global Dim NewSPR.l(5)             ;  Спрайтики
 Global ClearSPR, Checker
 
 Procedure GenerateSprites ()
 NewSCL.l: Cv.l
 
  ;  Чекер
 NewSCL = CreateImage (#PB_Any, ScrRezX, ScrRezY, 32) ; Создаём чекер
   StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
   For y = 0 To ScrRezY >> 5
      For x = 0 To ScrRezX >> 5
         If (x & 1) = (y & 1): Cv = $FFFFFF
         Else: Cv = $707070
         EndIf
         Box (x << 5, y << 5, 32, 32, Cv)
      Next
   Next
   StopDrawing()
   StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
   DrawingMode(#PB_2DDrawing_AlphaBlend)
     For y = 0 To 255
        Line(0, y, ScrRezX, 1, RGBA(255, 255, 255, 255-y))
     Next y
   StopDrawing()
 Checker = Img2Spr (NewSCL, #PB_Any, 1)               ; -> В спрайт его
 FreeImage(NewSCL)                                    ;    Удалим имадж
 
 
  ;  Пустой спрайт
 NewSCL = CreateImage (#PB_Any, 5, 5, 32)             ; Создаём пустой спрайт
   StartDrawing(ImageOutput(NewSCL))                  ; Рисуем на нём
   DrawingMode (#PB_2DDrawing_AlphaChannel)           ; Все каналы, т.е. RGB+Alpha
   Box (0, 0, 5, 5, 0)                                ; Полностью прозрачный
   StopDrawing()
 ClearSPR = Img2Spr (NewSCL, #PB_Any, 1)              ; -> В спрайт его
 FreeImage(NewSCL)                                    ;    Удалим имадж
 
 
   ;   Создаём спрайтики
   For i = 0 To 5         ; 5 штук
 
      NewSCL = CreateImage (#PB_Any, 50, 50, 32)         ; Создаём имадж 25x25
 
      StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
      DrawingFont(Fonts(1))
      DrawingMode (#PB_2DDrawing_AllChannels)   ; Все каналы, т.е. RGB+Alpha
         Box (0, 0, 50, 50, 0)                  ; Полностью прозрачный
         For k = 1 To 3500
           Cv = RGBA(Random(255), Random(255), Random(255), 25 + Random(10))
           LineXY (Random(50), Random(50), Random(50), Random(50), Cv)
         Next
 
         DrawingMode (#PB_2DDrawing_AlphaChannel)  ; Alpha канал(прозрачность)
         Box (13, 13, 27, 27, RGBA(200, 200, 200, 25))
         DrawingMode (#PB_2DDrawing_AlphaChannel | #PB_2DDrawing_Outlined)  ; Alpha канал(прозрачность)
         
         For k = 12 To 25
           Box (25 - k, 25 - k, k << 1, k << 1, RGBA(200, 200, 200, 28 - (k - 12) << 1))
         Next
 
         DrawingMode(#PB_2DDrawing_Transparent |#PB_2DDrawing_AlphaChannel)
         DrawText (0, 0, "Spr", RGBA(255, 255, 255, 0))
         DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_AlphaBlend)
         DrawText (0, 0, "Spr", RGBA(0, 55, 55, 5))
         
      StopDrawing()
         ;ResizeImage (NewSCL, 50, 50, #PB_Image_Smooth)
      NewSPR(i) = Img2Spr (NewSCL, #PB_Any, 1)
   Next i
 
 EndProcedure
 
  Global LastEVT, FirstClick, Event
  Global NoThreadDraw
 
Global q, NowDrawing
Global Dim Sobytij(500), Schetch.l
 Procedure OtdPotok (*Prm)        ;  Поток для рисования
 
  Repeat
       ;  Это обработка событий, полученных из основной программы
       If Schetch > 0
         Repeat
         Schetch = Schetch - 1
           Select Sobytij(Schetch) 
              Case #PB_Event_CloseWindow: End
              Case #PB_Event_RestoreWindow 
              ReleaseMouse(0): NoThreadDraw = 0
              Case 513
                ReleaseMouse(0)
                If FirstClick: ;SetMouseXY (WindowMouseX(f), WindowMouseY(f))
                FirstClick = 0: NoThreadDraw = 0
                EndIf
           EndSelect
          
         Until Schetch = 0
       EndIf
 
           ;  Это предшествует отрисовке и сохраняет проц. ресурс
           NowDrawing = 2   ;  Можно обработать события 
           Delay(7)
           NowDrawing = 1   ;  Dead Zone для обработчика событий в основной проге
           Delay(1)         ;  Чем больше - тем лучше, но нежелательно для нас
 
         ;  Тут рисуем что хотим и как хотим
     If NoThreadDraw = 0
        ;ClearScreen($FFFFFF)      ;  Очистим экран
        DisplaySprite(Checker, 0, 0)   ;  Чекер на заднем плане
 
         ;  Нарисуем 5.5 тысяч прозрачных спрайтов
         mx2 = mx: my2 = my
         For u = 1 To 5
            For y = my2 To my2 + ScrRezY - 100 Step 50
               For x = mx2 To mx2 + ScrRezX - 100 Step 50
 
               DisplayTransparentSprite(NewSPR(u), x, y)
               DisplayTransparentSprite(NewSPR(u), x, y)
               DisplayTransparentSprite(NewSPR(u), x, y)
 
               Next
            Next
         Next u
 
         ;  Надпись
         StartDrawing(ScreenOutput())
            DrawingFont(Fonts(2))
            DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_AlphaBlend)
            DrawText (0, 0, "5400 Прозрачных спрайтов   50x50", $3A2F2B)
            DrawText (0, 50, "DirectX 9", $3A2F2B)
         StopDrawing()
         SimpleCur ()                     ;  Простой курсорчик
         FlipBuffers()                    ;  Флипуем в основной программе
        Delay(1)
        NowDrawing = 0
     EndIf
         ;  Конец отрисовки
 
  Until All_Threads_End
 EndProcedure
 
 ;  Этот поток для опроса клавиатуры и мыши
 ;  + выполняется ReleaseMouse по кнопке Win
 Procedure OtdPotok2 (*Prm)       ;  Поток для опроса клавы & мыши
  Repeat
        ExamineKeyboard()
       If KeyboardReleased(219)
         ReleaseMouse(1): FirstClick = 1: NoThreadDraw = 1
       EndIf
        ExamineMouse()
        mx = MouseX(): my = MouseY()
    Delay(5)
  Until All_Threads_End
 EndProcedure
 
; _____________ /  * * * * * *  \ _____________
;         _____ >    I N I T    < _____
; _____________ \  * * * * * *  / _____________
 
 
      InitProgramm ()
 
      GenerateSprites ()
 
 
 
      ;  Самый первый опрос мыши и клавиатуры
      ;  Устраняет некоторые баги
      ExamineMouse()
      ExamineKeyboard()
      ReleaseMouse(0)
 
   ;  Создаём потоки
 MyThread = CreateThread (@OtdPotok(), 0)
 MyThread2 = CreateThread (@OtdPotok2(), 0)
 Delay(50)
 
   ;  Приоритеты
 ThreadPriority(MyThread, 31)
 ThreadPriority(MyThread2, 32)
 
 
; _____________ /  * * * * * *  \ _____________
;         _____ >   S T A R T   < _____
; _____________ \  * * * * * *  / _____________
 
 
 
Repeat
 
   If NowDrawing = 2
   ;  Чистый спрайт, нужен для того, чтобы программа думала
   ;  что мы рисуем с основной программы и производила все
   ;  необходимые для этого операции
   DisplayTransparentSprite(ClearSPR, 0, 0)
   EndIf
 
 
   If NowDrawing = 2
   ;   Получим все события, произошедшие в окне
   ;   и запишем их в спец. массив.
   Repeat
      If NowDrawing = 2
         Event = WindowEvent()
        If Event
           Sobytij(Schetch) = Event
           Schetch = Schetch + 1
        EndIf
      EndIf
   Until Event = 0
   EndIf
 
   Repeat: Until NowDrawing = 2    ;  Подождём для флипа
 
   Delay(150)      ;  Допустим что выполняем какие-либо операции (150 мс это много)
 
Until KeyboardReleased(#PB_Key_Escape)
All_Threads_End = 1
Delay(500)     ;  Время на завершение всех потоков, пол секунды - оптимально
 
; IDE Options = PureBasic 4.51 (Windows - x86)
; EnableAsm
; EnableThread
; EnableXP
0
PB
Просто прогер
1292 / 1079 / 13
Регистрация: 13.03.2009
Сообщений: 2,502
27.11.2011, 00:07
Когда перетаскивал мышкой окно программы, прога вылетела на строке 288, сообщив что "Указатель массива больше допустимого диапазона". Короче произошла запись в индекс, превышающий размер массива.
Непонятно вообще зачем было выносить обработку событий в отдельный поток, но раз так сделано. то нужно было использовать не массив, а динамически связанный список, или в крайнем случае, изменять размер массива оператором ReDim.
0
Кормпилятор
 Аватар для Quiet Snow
5044 / 1718 / 409
Регистрация: 25.04.2010
Сообщений: 4,827
Записей в блоге: 2
27.11.2011, 00:34  [ТС]


Прога протестирована на 5 компах с XP(пришлось попросить пару человек, чтобы помогли),
отклонений в работе не заметил. Даже на самом медленном из них - одноядерном целероне 1200MHz
со слабеньким радеоном не повисла, а нормально отработала при жутком слайд шоу и 100%
загруженности процессора.
Как я уже говорил код более или менее стабилен, с него уже можно писать нормальный шаблон для
каких-то своих нужд.
Мышку с клавой оставил в отдельном потоке, флип перенёс в поток с отрисовкой, настроил делеи.
Делей в 184 строчке настраивается в зависимости от кол-ва графики, чем её больше тем больше
должен быть делей, недостаточный промежуток приведёт к невозможности возврата в программу,
или придётся очень долго кликать, меньше двух мс ставить не рекомендуется.
Делей в 186 строчке настраивается пропорционально делею в 184 строчке, влияет на стабильность
сильно лучше не увеличивать).
Делей в 297 строчке можно убрать и поставить какие-либо свои вычисления взаместо него.
Также в программе можно найти полезные фичи, типа функции перевода из прозрачного имаджа в
прозрачный спрайт с автоматическим созданием спрайта. Она может пригодится при использовании
прозрачных 3D спрайтов, которые работают также на подсистеме DirectX7.
0
PB
Просто прогер
1292 / 1079 / 13
Регистрация: 13.03.2009
Сообщений: 2,502
27.11.2011, 00:41
Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
Мышку с клавой оставил в отдельном потоке, флип перенёс в поток
Лучше все же в основном потоке производить отрисовку и работать с клавой и мышкой.
Потому что нет преимуществ в переносе всего это в отдельных поток, но появляются потенциальные места, где программа может заглючить или завершится с ошибкой особенно если не синхронизировать работу потоков.
0
Кормпилятор
 Аватар для Quiet Snow
5044 / 1718 / 409
Регистрация: 25.04.2010
Сообщений: 4,827
Записей в блоге: 2
27.11.2011, 01:08  [ТС]
Когда перетаскивал мышкой окно программы, прога вылетела на строке 288, сообщив что "Указатель массива больше допустимого диапазона". Короче произошла запись в индекс, превышающий размер массива.
Как долго работала программа? Окно перетаскивалось из-за экрана или наоборот за экран?
Скорость отрисовки была приемлемая или меньше 10 кадров?

Непонятно вообще зачем было выносить обработку событий в отдельный поток, но раз так сделано. то нужно было использовать не массив, а динамически связанный список, или в крайнем случае, изменять размер массива оператором ReDim.
Я её перенёс в отдельный поток, чтобы она не вызывалась параллельно с отрисовкой, иначе пришлось бы ставить ещё условия ожидания соотв. триггеров, не хотелось сильно замедлять основной поток. В потоке с графикой эта очередь обрабатывается как раз как нужно. К тому же в реальности никто так перегружать отрисовку не будет, это креш тест.

изменять размер массива оператором ReDim
Я завёл достаточно большой массив, который в реал тайме опустошался, не думал, что он может переполниться, по крайней мере у меня таких ошибок не было, сколько же событий поступило в окно сразу? Думаю если увеличить его ещё в 2-3 раза, то таких случаев вообще не будет. Позже попробую посмотреть сколько туда поступает событий. ReDim не хотелось использовать, хотя думал об этом, но более накладно с точки зрения ЦП, лучше пусть массив заведомо будет превышать максимально возможное кол-во событий.

Добавлено через 14 минут
Лучше все же в основном потоке производить отрисовку и работать с клавой и мышкой.
Да я знаю, просто эта тема как альтернативный вариант, может быть кому нибудь пригодится.
Всё же вопрос достаточно нетривиальный, по крайней мере в справке написано нельзя, а у меня в проге такая возможность имеется, ошибки, появляющиеся закономерно, по мере их выявления будут мной фикситься.
0
PB
Просто прогер
1292 / 1079 / 13
Регистрация: 13.03.2009
Сообщений: 2,502
27.11.2011, 01:25
Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
Как долго работала программа? Окно перетаскивалось из-за экрана или наоборот за экран?
Дело не в этом. Когда перетаскивают окно за заголовок, то обработчик событий не получает данных о них, а когда прекращают тащить окно и отпускают левую кнопку мышки, все события тут же отсылаются в обработчик. Получилось так, что за время перетаскивания, скопилась очередь, состоящая больше чем из 500 отдельных событий, которые программа попыталась записывать в массив. Поэтому произошло переполнение массива.

Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
Думаю если увеличить его ещё в 2-3 раза, то таких случаев вообще не будет.
Это смотря как долго перетаскивать окно за заголовок.
Можно не записывать в массив ID событий, если нет свободного места в нем. Это конечно "грязный ход", но сама система с потоками в данном случае явно лишняя. Примерно тоже самое как ехать из Москвы в Питер через Камчатку.


Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
ReDim не хотелось использовать
Можно использовать список, который нереально будет переполнить событиями, но работу с ним из нескольких потоков придется синхронизировать мьютексами, иначе будут глюки из-за особенностей работы со списком.

Добавлено через 5 минут
Работа со списком из нескольких потоков.
Взято с другого форума.
Пример, демонстрирующий это.
Если не блокировать мьютексом работу со списком, то может получится такая ситуация, что данные будут прочитаны или записаны не в тот элемент.
Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Global NewList TestList.l() 
 
 Procedure Thread(Number) 
   Repeat 
     SelectElement(TestList(), Number-1) 
     Delay(Random(400)+200) 
     Debug "Поток №"+Str(Number)+" данные "+Str(TestList()) 
   ForEver 
 EndProcedure 
 
 For i=1 To 4 
   AddElement(TestList()) 
   TestList() = i 
 Next 
 
 For i=1 To 4 
   CreateThread(@Thread(), i) 
 Next 
 
 MessageRequester("", "Нажниме 'OK' для закрытия программы")
Номер элемента и данные должны быть одинаковыми.
Если цифры разные, то это значит что во время выполнения функции Delay(), другой поток изменил текущий элемент списка - глюк.
Мьюльтексы полностью решают эту проблему - другие потоки джут пока будет разблокирован мьюльтекс и только после этого, один из потоков сможет захватить мьюльтекс и получить доступ к списку, а другие потоки будут ожидать пока этот поток разблокирует мьюльтекс.
Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Global NewList TestList.l() 
Global Mutex = CreateMutex() 
 
 
Procedure Thread(Number) 
   Repeat 
     LockMutex(Mutex) 
     SelectElement(TestList(), Number-1) 
     Delay(Random(400)+200) 
     Debug "Поток №"+Str(Number)+" данные "+Str(TestList()) 
     UnlockMutex(Mutex) 
   ForEver 
 EndProcedure 
 
 For i=1 To 4 
   AddElement(TestList()) 
   TestList() = i 
 Next 
 
 For i=1 To 4 
   CreateThread(@Thread(), i) 
 Next 
 
 MessageRequester("", "Нажниме 'OK' для закрытия программы")
0
Кормпилятор
 Аватар для Quiet Snow
5044 / 1718 / 409
Регистрация: 25.04.2010
Сообщений: 4,827
Записей в блоге: 2
27.11.2011, 15:17  [ТС]
Я так подумал и решил, что простая проблема требует простого решения.

BugFix:
Вставить после 289 строчки:
Code
1
           If Schetch > ArraySize(Sobytij()): ReDim Sobytij(ArraySize(Sobytij()) << 1): EndIf
Изменить в 160 строчке размер массива Sobytij на 8000 элементов.


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

Всё таки объясню посему мышка и клавиатура обрабатываются в отдельном потоке, если обрабатывать их в главном потоке, на который в данном случае возложена миссия выполнять все вычисления, то существует вероятность(немалая надо сказать), что опрос мыши будет производиться через большие промежутки и следовательно мышь будет очень плохо реагировать, клавиатура - то же самое. Отрисовка сейчас полностью выполняется в отдельном потоке и при нормальном обновлении координат мыши, визуально всё будет гладко. Я сейчас не рассматриваю случаи, когда остальные ядра процессора уже загружены.
0
PB
Просто прогер
1292 / 1079 / 13
Регистрация: 13.03.2009
Сообщений: 2,502
27.11.2011, 15:49
Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
раз мьютекс блокирует все потоки
Он не блокирует все потоки.
Поток будет заблокирован функцией LockMutex() только в том случае, если мьютекс захвачен другим потоком. Если занятый мьютекс не пытаться захватить, по поток работает без остановок.


Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
если обрабатывать их в главном потоке, на который в данном случае возложена миссия выполнять все вычисления, то существует вероятность(немалая надо сказать), что опрос мыши будет производиться через большие промежутки и следовательно мышь будет очень плохо реагировать, клавиатура - то же самое. Отрисовка сейчас полностью выполняется в отдельном потоке
Обычно в главном потоке выполняется отрисова и работа с мышкой и клавой, а вычисления (если они требуют много времени) в отдельном потоке.
1
Кормпилятор
 Аватар для Quiet Snow
5044 / 1718 / 409
Регистрация: 25.04.2010
Сообщений: 4,827
Записей в блоге: 2
27.11.2011, 16:13  [ТС]
Если занятый мьютекс не пытаться захватить, по поток работает без остановок.
Ладно, если я сразу не врубился, значит и не врублюсь, видимо не для моей головы сие чудо. Мне проще самому назначать переменные и так хотя бы вижу, что происходит в программе, а когда что-то неконтролирую, то получается что баги вылазят уже не из-за меня.

Обычно в главном потоке выполняется отрисова и работа с мышкой и клавой, а вычисления (если они требуют много времени) в отдельном потоке.
Создать такой код не вызывает особых трудностей, т.к. отрисовка под DirectX 9 в окне работает нормально, когда всё делается в основном потоке. Позже я добавлю стандартный вариант в данную тему для сравнения.
0
PB
Просто прогер
1292 / 1079 / 13
Регистрация: 13.03.2009
Сообщений: 2,502
27.11.2011, 16:52
Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
Мне проще самому назначать переменные
Это не одно и тоже.
Переменная работает на уровне приложения, а мьютекс на уровне системы. Синхронизация потоков на системном уровне гораздо эффективнее, чем на уровне приложения.
Может этот материал немного прояснит ситуацию.
http://ru.wikipedia.org/wiki/Мьютекс
http://ru.wikipedia.org/wiki/Критическая_секция
1
Кормпилятор
 Аватар для Quiet Snow
5044 / 1718 / 409
Регистрация: 25.04.2010
Сообщений: 4,827
Записей в блоге: 2
27.11.2011, 17:31  [ТС]

Сравнение программ:
Отрисовка в основной программе(главный поток)
Code
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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
  ;
  ;  Отрисовка в главном потоке
  ;
 
Global ScrRezX.w, ScrRezY.w          ; Разрешение экрана
Global a, b, c, d, e, f, g
Global Dim Fonts(10)                 ; Шрифты
 
      ; Создание окна, иниц. экрана и загрузка шрифтов
 Procedure InitProgramm ()
     ScrRezX = 1280: ScrRezY = 800
 
     a = InitMouse()
     b = InitKeyboard()
     c = InitSprite()
 
     f = OpenWindow (#PB_Any, 0, 0, ScrRezX + 6, ScrRezY + 6, "Thread Drawing", #PB_Window_ScreenCentered)
     SetWindowColor (f, 0)
     g = OpenWindowedScreen(WindowID(f), 3, 3, ScrRezX, ScrRezY, 0, 0, 0, #PB_Screen_NoSynchronization)
 
     Fonts(1) = LoadFont(1, "Arial", 20)
     Fonts(2) = LoadFont(2, "Tahoma", 40, #PB_Font_Bold | #PB_Font_HighQuality)
 EndProcedure
 
 Global mx, my
 Procedure SimpleCur ()
   StartDrawing(ScreenOutput())
      LineXY(mx+3, my+3, mx+27, my+15, 0)
      LineXY(mx+3, my+3, mx+14, my+25, 0)
      LineXY(mx, my, mx, my, $FFFFFF)
      LineXY(mx+1, my+1, mx+25, my+13, $FFFFFF)
      LineXY(mx+1, my+1, mx+12, my+23, $FFFFFF)
   StopDrawing()
 EndProcedure
 Procedure ProcessingMouse ()
   mx + MouseDeltaX(): my + MouseDeltaY()
     If mx > ScrRezX: mx = ScrRezX: EndIf
     If mx < 0: mx = 0: EndIf
     If my > ScrRezY: my = ScrRezY: EndIf
     If my < 0: my = 0: EndIf
 EndProcedure
 
      ; События свёртывания и развёртывания окна
 Global LastEVT, FirstClick
 Procedure ProcessingEvents ()
     ;    Сворачиваем окошко
      If KeyboardReleased(219): ReleaseMouse(1): FirstClick = 1: EndIf
      Repeat      ;    Обрабатываем события
        Event = WindowEvent()
        If Event <> 0: LastEVT = Event: EndIf
        Select Event 
          Case #PB_Event_CloseWindow: End
          Case #PB_Event_RestoreWindow: ReleaseMouse(0)
          Case 513
            ReleaseMouse(0)
            If FirstClick: mx = WindowMouseX(f): my = WindowMouseY(f)
            FirstClick = 0: EndIf
        EndSelect
      Until Event = 0
 EndProcedure
 
      ; Процедура преобразования Image в Sprite
 #SprProperty = #PB_Sprite_Memory | #PB_Sprite_Texture | #PB_Sprite_AlphaBlending
 Procedure Img2Spr (ImgHandle, SprHandle, NeedCreateSpr)
 
 If NeedCreateSpr
   NewSprHandle_x_9q = CreateSprite(SprHandle, ImageWidth(ImgHandle), ImageHeight(ImgHandle), #SprProperty)
 Else
   NewSprHandle_x_9q = SprHandle
 EndIf
     ;  Определяем смещения в памяти
 StartDrawing(SpriteOutput(NewSprHandle_x_9q))
   *OutBuf_x_9q = DrawingBuffer()
 StopDrawing()
 StartDrawing(ImageOutput(ImgHandle))
   *InpBuf_x_9q = DrawingBuffer()
 StopDrawing()
     ;  Выясняем объём данных для 32 битного цвета
  Shirina_x_9q = ImageWidth(ImgHandle)
  Visota_x_9q = ImageHeight(ImgHandle)
  DataBegin_x_9q = (Shirina_x_9q * ImageHeight(ImgHandle) - Shirina_x_9q) << 2
  *InpBuf_x_9q = *InpBuf_x_9q + DataBegin_x_9q
 
     EnableASM
       PUSH ebx
       PUSH edi
       PUSH esi
       ADD esp, 12
         MOV ecx, Shirina_x_9q
         MOV ebx, Visota_x_9q
         MOV esi, *InpBuf_x_9q
         MOV edi, *OutBuf_x_9q
       SUB esp, 12
       Cykl_x_9q:
           PUSH ecx
             REP MOVSD
           POP ecx
           PUSH ecx
             SHL ecx, 3
             SUB esi, ecx
           POP ecx
         DEC ebx
         JNZ l_cykl_x_9q
       POP esi
       POP edi
       POP ebx
     DisableASM
 If NeedCreateSpr: ProcedureReturn NewSprHandle_x_9q: EndIf
 EndProcedure
 
 Global Dim NewSPR.l(5)             ;  Спрайтики
 Global ClearSPR, Checker
 
 Procedure GenerateSprites ()
 NewSCL.l: Cv.l
 
  ;  Чекер
 NewSCL = CreateImage (#PB_Any, ScrRezX, ScrRezY, 32) ; Создаём чекер
   StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
   For y = 0 To ScrRezY >> 5
      For x = 0 To ScrRezX >> 5
         If (x & 1) = (y & 1): Cv = $FFFFFF
         Else: Cv = $707070
         EndIf
         Box (x << 5, y << 5, 32, 32, Cv)
      Next
   Next
   StopDrawing()
   StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
   DrawingMode(#PB_2DDrawing_AlphaBlend)
     For y = 0 To 255
        Line(0, y, ScrRezX, 1, RGBA(255, 255, 255, 255-y))
     Next y
   StopDrawing()
 Checker = Img2Spr (NewSCL, #PB_Any, 1)               ; -> В спрайт его
 FreeImage(NewSCL)                                    ;    Удалим имадж
 
 
  ;  Пустой спрайт
 NewSCL = CreateImage (#PB_Any, 5, 5, 32)             ; Создаём пустой спрайт
   StartDrawing(ImageOutput(NewSCL))                  ; Рисуем на нём
   DrawingMode (#PB_2DDrawing_AlphaChannel)           ; Все каналы, т.е. RGB+Alpha
   Box (0, 0, 5, 5, 0)                                ; Полностью прозрачный
   StopDrawing()
 ClearSPR = Img2Spr (NewSCL, #PB_Any, 1)              ; -> В спрайт его
 FreeImage(NewSCL)                                    ;    Удалим имадж
 
 
   ;   Создаём спрайтики
   For i = 0 To 5         ; 5 штук
 
      NewSCL = CreateImage (#PB_Any, 50, 50, 32)         ; Создаём имадж 25x25
 
      StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
      DrawingFont(Fonts(1))
      DrawingMode (#PB_2DDrawing_AllChannels)   ; Все каналы, т.е. RGB+Alpha
         Box (0, 0, 50, 50, 0)                  ; Полностью прозрачный
         For k = 1 To 3500
           Cv = RGBA(Random(255), Random(255), Random(255), 25 + Random(10))
           LineXY (Random(50), Random(50), Random(50), Random(50), Cv)
         Next
 
         DrawingMode (#PB_2DDrawing_AlphaChannel)  ; Alpha канал(прозрачность)
         Box (13, 13, 27, 27, RGBA(200, 200, 200, 25))
         DrawingMode (#PB_2DDrawing_AlphaChannel | #PB_2DDrawing_Outlined)  ; Alpha канал(прозрачность)
         
         For k = 12 To 25
           Box (25 - k, 25 - k, k << 1, k << 1, RGBA(200, 200, 200, 28 - (k - 12) << 1))
         Next
 
         DrawingMode(#PB_2DDrawing_Transparent |#PB_2DDrawing_AlphaChannel)
         DrawText (0, 0, "Spr", RGBA(255, 255, 255, 0))
         DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_AlphaBlend)
         DrawText (0, 0, "Spr", RGBA(0, 55, 55, 5))
         
      StopDrawing()
 
      NewSPR(i) = Img2Spr (NewSCL, #PB_Any, 1)
   Next i
 
 EndProcedure
 
; _____________ /  * * * * * *  \ _____________
;         _____ >    I N I T    < _____
; _____________ \  * * * * * *  / _____________
 
 
      InitProgramm ()
 
      GenerateSprites ()
 
 
; _____________ /  * * * * * *  \ _____________
;         _____ >   S T A R T   < _____
; _____________ \  * * * * * *  / _____________
 
  Repeat
      ExamineKeyboard()
      ExamineMouse()
      ProcessingMouse ()
      ProcessingEvents ()
 
 
        DisplaySprite(Checker, 0, 0)   ;  Чекер на заднем плане
 
         ;  Нарисуем 5.5 тысяч прозрачных спрайтов
         mx2 = mx: my2 = my
         For u = 1 To 5
            For y = my2 To my2 + ScrRezY - 100 Step 50
               For x = mx2 To mx2 + ScrRezX - 100 Step 50
 
               DisplayTransparentSprite(NewSPR(u), x, y)
               DisplayTransparentSprite(NewSPR(u), x, y)
               DisplayTransparentSprite(NewSPR(u), x, y)
 
               Next
            Next
         Next
 
         ;  Надпись
         StartDrawing(ScreenOutput())
            DrawingFont(Fonts(2))
            DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_AlphaBlend)
            DrawText (0, 0, "5400 Прозрачных спрайтов   50x50", $3A2F2B)
            DrawText (0, 50, "DirectX 9", $3A2F2B)
         StopDrawing()
 
      SimpleCur ()                     ;  Простой курсорчик
      FlipBuffers()                    ;  Флипуем в основной программе
 
  Until  KeyboardReleased(#PB_Key_Escape)
; IDE Options = PureBasic 4.51 (Windows - x86)
; EnableAsm
; EnableXP

Отрисовка в отдельном потоке
Code
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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
  ;
  ;  Отрисовка в отдельном потоке
  ;
 
Global ScrRezX.w, ScrRezY.w          ; Разрешение экрана
Global a, b, c, d, e, f, g
Global All_Threads_End.w             ; Завершить все потоки
Global Dim Fonts(10)                 ; Шрифты
 
 Procedure InitProgramm ()
     ScrRezX = 1280: ScrRezY = 800
 
     a = InitMouse()
     b = InitKeyboard()
     c = InitSprite()
     ;d = InitSprite3D()
 
     f = OpenWindow (#PB_Any, 0, 0, ScrRezX + 6, ScrRezY + 6, "Thread Drawing", #PB_Window_ScreenCentered)
     SetWindowColor (f, 0)
     g = OpenWindowedScreen(WindowID(f), 3, 3, ScrRezX, ScrRezY, 0, 0, 0, #PB_Screen_NoSynchronization)
 
     Fonts(1) = LoadFont(1, "Arial", 20)
     Fonts(2) = LoadFont(2, "Tahoma", 40, #PB_Font_Bold | #PB_Font_HighQuality)
 EndProcedure
 
 Global mx, my
 Procedure SimpleCur ()
   StartDrawing(ScreenOutput())
      LineXY(mx+3, my+3, mx+27, my+15, 0)
      LineXY(mx+3, my+3, mx+14, my+25, 0)
      LineXY(mx, my, mx, my, $FFFFFF)
      LineXY(mx+1, my+1, mx+25, my+13, $FFFFFF)
      LineXY(mx+1, my+1, mx+12, my+23, $FFFFFF)
   StopDrawing()
 EndProcedure
 
 #SprProperty = #PB_Sprite_Memory | #PB_Sprite_Texture | #PB_Sprite_AlphaBlending
 Procedure Img2Spr (ImgHandle, SprHandle, NeedCreateSpr)
 
 If NeedCreateSpr
   NewSprHandle_x_9q = CreateSprite(SprHandle, ImageWidth(ImgHandle), ImageHeight(ImgHandle), #SprProperty)
 Else
   NewSprHandle_x_9q = SprHandle
 EndIf
     ;  Определяем смещения в памяти
 StartDrawing(SpriteOutput(NewSprHandle_x_9q))
   *OutBuf_x_9q = DrawingBuffer()
 StopDrawing()
 StartDrawing(ImageOutput(ImgHandle))
   *InpBuf_x_9q = DrawingBuffer()
 StopDrawing()
     ;  Выясняем объём данных для 32 битного цвета
  Shirina_x_9q = ImageWidth(ImgHandle)
  Visota_x_9q = ImageHeight(ImgHandle)
  DataBegin_x_9q = (Shirina_x_9q * ImageHeight(ImgHandle) - Shirina_x_9q) << 2
  *InpBuf_x_9q = *InpBuf_x_9q + DataBegin_x_9q
 
     EnableASM
       PUSH ebx
       PUSH edi
       PUSH esi
       ADD esp, 12
         MOV ecx, Shirina_x_9q
         MOV ebx, Visota_x_9q
         MOV esi, *InpBuf_x_9q
         MOV edi, *OutBuf_x_9q
       SUB esp, 12
       Cykl_x_9q:
           PUSH ecx
             REP MOVSD
           POP ecx
           PUSH ecx
             SHL ecx, 3
             SUB esi, ecx
           POP ecx
         DEC ebx
         JNZ l_cykl_x_9q
       POP esi
       POP edi
       POP ebx
     DisableASM
 If NeedCreateSpr: ProcedureReturn NewSprHandle_x_9q: EndIf
 EndProcedure
 
 Global Dim NewSPR.l(5)             ;  Спрайтики
 Global ClearSPR, Checker
 
 Procedure GenerateSprites ()
 NewSCL.l: Cv.l
 
  ;  Чекер
 NewSCL = CreateImage (#PB_Any, ScrRezX, ScrRezY, 32) ; Создаём чекер
   StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
   For y = 0 To ScrRezY >> 5
      For x = 0 To ScrRezX >> 5
         If (x & 1) = (y & 1): Cv = $FFFFFF
         Else: Cv = $707070
         EndIf
         Box (x << 5, y << 5, 32, 32, Cv)
      Next
   Next
   StopDrawing()
   StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
   DrawingMode(#PB_2DDrawing_AlphaBlend)
     For y = 0 To 255
        Line(0, y, ScrRezX, 1, RGBA(255, 255, 255, 255-y))
     Next y
   StopDrawing()
 Checker = Img2Spr (NewSCL, #PB_Any, 1)               ; -> В спрайт его
 FreeImage(NewSCL)                                    ;    Удалим имадж
 
 
  ;  Пустой спрайт
 NewSCL = CreateImage (#PB_Any, 5, 5, 32)             ; Создаём пустой спрайт
   StartDrawing(ImageOutput(NewSCL))                  ; Рисуем на нём
   DrawingMode (#PB_2DDrawing_AlphaChannel)           ; Все каналы, т.е. RGB+Alpha
   Box (0, 0, 5, 5, 0)                                ; Полностью прозрачный
   StopDrawing()
 ClearSPR = Img2Spr (NewSCL, #PB_Any, 1)              ; -> В спрайт его
 FreeImage(NewSCL)                                    ;    Удалим имадж
 
 
   ;   Создаём спрайтики
   For i = 0 To 5         ; 5 штук
 
      NewSCL = CreateImage (#PB_Any, 50, 50, 32)         ; Создаём имадж 25x25
 
      StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
      DrawingFont(Fonts(1))
      DrawingMode (#PB_2DDrawing_AllChannels)   ; Все каналы, т.е. RGB+Alpha
         Box (0, 0, 50, 50, 0)                  ; Полностью прозрачный
         For k = 1 To 3500
           Cv = RGBA(Random(255), Random(255), Random(255), 25 + Random(10))
           LineXY (Random(50), Random(50), Random(50), Random(50), Cv)
         Next
 
         DrawingMode (#PB_2DDrawing_AlphaChannel)  ; Alpha канал(прозрачность)
         Box (13, 13, 27, 27, RGBA(200, 200, 200, 25))
         DrawingMode (#PB_2DDrawing_AlphaChannel | #PB_2DDrawing_Outlined)  ; Alpha канал(прозрачность)
         
         For k = 12 To 25
           Box (25 - k, 25 - k, k << 1, k << 1, RGBA(200, 200, 200, 28 - (k - 12) << 1))
         Next
 
         DrawingMode(#PB_2DDrawing_Transparent |#PB_2DDrawing_AlphaChannel)
         DrawText (0, 0, "Spr", RGBA(255, 255, 255, 0))
         DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_AlphaBlend)
         DrawText (0, 0, "Spr", RGBA(0, 55, 55, 5))
         
      StopDrawing()
         ;ResizeImage (NewSCL, 50, 50, #PB_Image_Smooth)
      NewSPR(i) = Img2Spr (NewSCL, #PB_Any, 1)
   Next i
 
 EndProcedure
 
  Global LastEVT, FirstClick, Event
  Global NoThreadDraw
 
Global q, NowDrawing
Global Dim Sobytij(8000), Schetch.l
 Procedure OtdPotok (*Prm)        ;  Поток для рисования
 
  Repeat
       ;  Это обработка событий, полученных из основной программы
       If Schetch > 0
         Repeat
         Schetch = Schetch - 1
           Select Sobytij(Schetch) 
              Case #PB_Event_CloseWindow: End
              Case #PB_Event_RestoreWindow 
              ReleaseMouse(0): NoThreadDraw = 0
              Case 513
                ReleaseMouse(0)
                If FirstClick: ;SetMouseXY (WindowMouseX(f), WindowMouseY(f))
                FirstClick = 0: NoThreadDraw = 0
                EndIf
           EndSelect
          
         Until Schetch = 0
       EndIf
 
           ;  Это предшествует отрисовке и сохраняет проц. ресурс
           NowDrawing = 2   ;  Можно обработать события 
           Delay(7)
           NowDrawing = 1   ;  Dead Zone для обработчика событий в основной проге
           Delay(1)         ;  Чем больше - тем лучше, но нежелательно для нас
 
         ;  Тут рисуем что хотим и как хотим
     If NoThreadDraw = 0
        ;ClearScreen($FFFFFF)      ;  Очистим экран
        DisplaySprite(Checker, 0, 0)   ;  Чекер на заднем плане
 
         ;  Нарисуем 5.5 тысяч прозрачных спрайтов
         mx2 = mx: my2 = my
         For u = 1 To 5
            For y = my2 To my2 + ScrRezY - 100 Step 50
               For x = mx2 To mx2 + ScrRezX - 100 Step 50
 
               DisplayTransparentSprite(NewSPR(u), x, y)
               DisplayTransparentSprite(NewSPR(u), x, y)
               DisplayTransparentSprite(NewSPR(u), x, y)
 
               Next
            Next
         Next u
 
         ;  Надпись
         StartDrawing(ScreenOutput())
            DrawingFont(Fonts(2))
            DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_AlphaBlend)
            DrawText (0, 0, "5400 Прозрачных спрайтов   50x50", $3A2F2B)
            DrawText (0, 50, "DirectX 9", $3A2F2B)
         StopDrawing()
         SimpleCur ()                     ;  Простой курсорчик
         FlipBuffers()                    ;  Флипуем в основной программе
        Delay(1)
        NowDrawing = 0
     EndIf
         ;  Конец отрисовки
      ;q = q + 1     ;  Если надо посчитаем FPS
  Until All_Threads_End
 EndProcedure
 
 ;  Этот поток для опроса клавиатуры и мыши
 ;  + выполняется ReleaseMouse по кнопке Win
 Procedure OtdPotok2 (*Prm)       ;  Поток для опроса клавы & мыши
  Repeat
        ExamineKeyboard()
       If KeyboardReleased(219)
         ReleaseMouse(1): FirstClick = 1: NoThreadDraw = 1
       EndIf
        ExamineMouse()
        mx = MouseX(): my = MouseY()
    Delay(5)
  Until All_Threads_End
 EndProcedure
 
; _____________ /  * * * * * *  \ _____________
;         _____ >    I N I T    < _____
; _____________ \  * * * * * *  / _____________
 
 
      InitProgramm ()
 
      GenerateSprites ()
 
 
      ;  Самый первый опрос мыши и клавиатуры
      ;  Устраняет некоторые баги
      ExamineMouse()
      ExamineKeyboard()
      ReleaseMouse(0)
 
   ;  Создаём потоки
 MyThread = CreateThread (@OtdPotok(), 0)
 MyThread2 = CreateThread (@OtdPotok2(), 0)
 Delay(50)
 
   ;  Приоритеты
 ThreadPriority(MyThread, 31)
 ThreadPriority(MyThread2, 32)
 
 
; _____________ /  * * * * * *  \ _____________
;         _____ >   S T A R T   < _____
; _____________ \  * * * * * *  / _____________
 
 
Repeat
 
   If NowDrawing = 2
   ;  Чистый спрайт, нужен для того, чтобы программа думала
   ;  что мы рисуем с основной программы и производила все
   ;  необходимые для этого операции
   DisplayTransparentSprite(ClearSPR, 0, 0)
   EndIf
 
 
   If NowDrawing = 2
   ;   Получим все события, произошедшие в окне
   ;   и запишем их в спец. массив.
   Repeat
      If NowDrawing = 2
         Event = WindowEvent()
        If Event
           Sobytij(Schetch) = Event
           Schetch = Schetch + 1
           If Schetch > ArraySize(Sobytij()): ReDim Sobytij(ArraySize(Sobytij()) << 1): EndIf
        EndIf
      EndIf
   Until Event = 0
   EndIf
 
 
   Repeat: Until NowDrawing = 2    ;  Подождём для флипа
 
   Delay(150)      ;  Допустим что выполняем какие-либо операции (150 мс это много)
 
Until KeyboardReleased(#PB_Key_Escape)
All_Threads_End = 1
Delay(500)     ;  Время на завершение всех потоков, пол секунды - оптимально
 
; IDE Options = PureBasic 4.51 (Windows - x86)
; EnableAsm
; EnableThread
; EnableXP




Добавлено через 31 минуту
Всё я понял как оно работает, спасибо PB. Принцип достаточно сложный.
Ну допустим поток изменил внутренний триггер мьютекса, посмотрев что он свободен, другие потоки
при попытке обратиться к коду объекта натолкнутся на LockMutex(), который не даст добро на захват
объекта, потоки остановятся, проц время перейдёт к системе, но приложению от этого лучше не станет,
т.к. потоки будут ждать освобождения внутреннего триггера мьютекса.
Эффективнее выходит с точки зрения взаимодействия с системой, таким образом это накладывает
ограничение на выполнение в таких потоках ещё чего-либо, кроме работы с общим объектом(кот.
пытаются взять другие потоки).
0
PB
Просто прогер
1292 / 1079 / 13
Регистрация: 13.03.2009
Сообщений: 2,502
27.11.2011, 17:57
Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
Принцип достаточно сложный.
Не очень - захватить мьютекс, освободить мьютекст. Вот и весь принцип.

Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
при попытке обратиться к коду объекта натолкнутся на LockMutex(), который не даст добро на захват
объекта, потоки остановятся, проц время перейдёт к системе, но приложению от этого лучше не станет,
т.к. потоки будут ждать освобождения внутреннего триггера мьютекса
Не нужно захватывать мьютекст на все время работы потока. Допустим, нужно защитить доступ к связанному списку.
В этом случае, нужно захватить мьютекс, быстро выполнить все требуемые операции со списком (если они требуют много времени, то целесообразно только скопировать данные из списка в локальные переменные, а действия выполнять после освобождения мьютекса), а затем освободить мьютекс.
Таким образом, мьютекс будет захватываться на очень короткие промежутки времени и почти не повлияет на производительность, но позволит со 100% гарантией предотвратить возможные конфликты потоков при доступе к связанному списку.

В программах лучше добавить обработку еще одного события
Code
1
Case #PB_Event_RestoreWindow, #PB_Event_ActivateWindow: ReleaseMouse(0)
Событие #PB_Event_ActivateWindow появляется после активации окна.

Добавлено через 8 минут
Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
Сравнение программ:
Сравним FPS.
Отрисовка в основной программе(главный поток)
Code
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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
  ;
  ;  Отрисовка в главном потоке
  ;
 
Global ScrRezX.w, ScrRezY.w          ; Разрешение экрана
Global a, b, c, d, e, f, g
Global Dim Fonts(10)                 ; Шрифты
 
      ; Создание окна, иниц. экрана и загрузка шрифтов
 Procedure InitProgramm ()
     ScrRezX = 1280: ScrRezY = 800
 
     a = InitMouse()
     b = InitKeyboard()
     c = InitSprite()
 
     f = OpenWindow (#PB_Any, 0, 0, ScrRezX + 6, ScrRezY + 6, "Thread Drawing", #PB_Window_ScreenCentered)
     SetWindowColor (f, 0)
     g = OpenWindowedScreen(WindowID(f), 3, 3, ScrRezX, ScrRezY, 0, 0, 0, #PB_Screen_NoSynchronization)
 
     Fonts(1) = LoadFont(1, "Arial", 20)
     Fonts(2) = LoadFont(2, "Tahoma", 40, #PB_Font_Bold | #PB_Font_HighQuality)
 EndProcedure
 
 Global mx, my
 Procedure SimpleCur ()
   StartDrawing(ScreenOutput())
      LineXY(mx+3, my+3, mx+27, my+15, 0)
      LineXY(mx+3, my+3, mx+14, my+25, 0)
      LineXY(mx, my, mx, my, $FFFFFF)
      LineXY(mx+1, my+1, mx+25, my+13, $FFFFFF)
      LineXY(mx+1, my+1, mx+12, my+23, $FFFFFF)
   StopDrawing()
 EndProcedure
 Procedure ProcessingMouse ()
   mx + MouseDeltaX(): my + MouseDeltaY()
     If mx > ScrRezX: mx = ScrRezX: EndIf
     If mx < 0: mx = 0: EndIf
     If my > ScrRezY: my = ScrRezY: EndIf
     If my < 0: my = 0: EndIf
 EndProcedure
 
      ; События свёртывания и развёртывания окна
 Global LastEVT, FirstClick
 Procedure ProcessingEvents ()
     ;    Сворачиваем окошко
      If KeyboardReleased(219): ReleaseMouse(1): FirstClick = 1: EndIf
      Repeat      ;    Обрабатываем события
        Event = WindowEvent()
        If Event <> 0: LastEVT = Event: EndIf
        Select Event 
          Case #PB_Event_CloseWindow: End
          Case #PB_Event_RestoreWindow, #PB_Event_ActivateWindow: ReleaseMouse(0)
          Case 513
            ReleaseMouse(0)
            If FirstClick: mx = WindowMouseX(f): my = WindowMouseY(f)
            FirstClick = 0: EndIf
        EndSelect
      Until Event = 0
 EndProcedure
 
      ; Процедура преобразования Image в Sprite
 #SprProperty = #PB_Sprite_Memory | #PB_Sprite_Texture | #PB_Sprite_AlphaBlending
 Procedure Img2Spr (ImgHandle, SprHandle, NeedCreateSpr)
 
 If NeedCreateSpr
   NewSprHandle_x_9q = CreateSprite(SprHandle, ImageWidth(ImgHandle), ImageHeight(ImgHandle), #SprProperty)
 Else
   NewSprHandle_x_9q = SprHandle
 EndIf
     ;  Определяем смещения в памяти
 StartDrawing(SpriteOutput(NewSprHandle_x_9q))
   *OutBuf_x_9q = DrawingBuffer()
 StopDrawing()
 StartDrawing(ImageOutput(ImgHandle))
   *InpBuf_x_9q = DrawingBuffer()
 StopDrawing()
     ;  Выясняем объём данных для 32 битного цвета
  Shirina_x_9q = ImageWidth(ImgHandle)
  Visota_x_9q = ImageHeight(ImgHandle)
  DataBegin_x_9q = (Shirina_x_9q * ImageHeight(ImgHandle) - Shirina_x_9q) << 2
  *InpBuf_x_9q = *InpBuf_x_9q + DataBegin_x_9q
 
     EnableASM
       PUSH ebx
       PUSH edi
       PUSH esi
       ADD esp, 12
         MOV ecx, Shirina_x_9q
         MOV ebx, Visota_x_9q
         MOV esi, *InpBuf_x_9q
         MOV edi, *OutBuf_x_9q
       SUB esp, 12
       Cykl_x_9q:
           PUSH ecx
             REP MOVSD
           POP ecx
           PUSH ecx
             SHL ecx, 3
             SUB esi, ecx
           POP ecx
         DEC ebx
         JNZ l_cykl_x_9q
       POP esi
       POP edi
       POP ebx
     DisableASM
 If NeedCreateSpr: ProcedureReturn NewSprHandle_x_9q: EndIf
 EndProcedure
 
 Global Dim NewSPR.l(5)             ;  Спрайтики
 Global ClearSPR, Checker
 
 Procedure GenerateSprites ()
 NewSCL.l: Cv.l
 
  ;  Чекер
 NewSCL = CreateImage (#PB_Any, ScrRezX, ScrRezY, 32) ; Создаём чекер
   StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
   For y = 0 To ScrRezY >> 5
      For x = 0 To ScrRezX >> 5
         If (x & 1) = (y & 1): Cv = $FFFFFF
         Else: Cv = $707070
         EndIf
         Box (x << 5, y << 5, 32, 32, Cv)
      Next
   Next
   StopDrawing()
   StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
   DrawingMode(#PB_2DDrawing_AlphaBlend)
     For y = 0 To 255
        Line(0, y, ScrRezX, 1, RGBA(255, 255, 255, 255-y))
     Next y
   StopDrawing()
 Checker = Img2Spr (NewSCL, #PB_Any, 1)               ; -> В спрайт его
 FreeImage(NewSCL)                                    ;    Удалим имадж
 
 
  ;  Пустой спрайт
 NewSCL = CreateImage (#PB_Any, 5, 5, 32)             ; Создаём пустой спрайт
   StartDrawing(ImageOutput(NewSCL))                  ; Рисуем на нём
   DrawingMode (#PB_2DDrawing_AlphaChannel)           ; Все каналы, т.е. RGB+Alpha
   Box (0, 0, 5, 5, 0)                                ; Полностью прозрачный
   StopDrawing()
 ClearSPR = Img2Spr (NewSCL, #PB_Any, 1)              ; -> В спрайт его
 FreeImage(NewSCL)                                    ;    Удалим имадж
 
 
   ;   Создаём спрайтики
   For i = 0 To 5         ; 5 штук
 
      NewSCL = CreateImage (#PB_Any, 50, 50, 32)         ; Создаём имадж 25x25
 
      StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
      DrawingFont(Fonts(1))
      DrawingMode (#PB_2DDrawing_AllChannels)   ; Все каналы, т.е. RGB+Alpha
         Box (0, 0, 50, 50, 0)                  ; Полностью прозрачный
         For k = 1 To 3500
           Cv = RGBA(Random(255), Random(255), Random(255), 25 + Random(10))
           LineXY (Random(50), Random(50), Random(50), Random(50), Cv)
         Next
 
         DrawingMode (#PB_2DDrawing_AlphaChannel)  ; Alpha канал(прозрачность)
         Box (13, 13, 27, 27, RGBA(200, 200, 200, 25))
         DrawingMode (#PB_2DDrawing_AlphaChannel | #PB_2DDrawing_Outlined)  ; Alpha канал(прозрачность)
         
         For k = 12 To 25
           Box (25 - k, 25 - k, k << 1, k << 1, RGBA(200, 200, 200, 28 - (k - 12) << 1))
         Next
 
         DrawingMode(#PB_2DDrawing_Transparent |#PB_2DDrawing_AlphaChannel)
         DrawText (0, 0, "Spr", RGBA(255, 255, 255, 0))
         DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_AlphaBlend)
         DrawText (0, 0, "Spr", RGBA(0, 55, 55, 5))
         
      StopDrawing()
 
      NewSPR(i) = Img2Spr (NewSCL, #PB_Any, 1)
   Next i
 
 EndProcedure
 
 Procedure GetFPS()
  Static StartProc
  Static GetFPS_Count.l, GetFPS_FPS.l, GetFPS_Start.l
  GetFPS_Count + 1 
  If GetFPS_Start = 0 
    GetFPS_Start = GetTickCount_() 
  EndIf 
  If GetTickCount_() - GetFPS_Start >= 1000 ;Or StartProc = 0
    GetFPS_FPS   = GetFPS_Count 
    GetFPS_Count = 0 
    GetFPS_Start + 1000 
    StartProc = 1
  EndIf 
  ProcedureReturn GetFPS_FPS 
EndProcedure 
 
 
 
; _____________ /  * * * * * *  \ _____________
;         _____ >    I N I T    < _____
; _____________ \  * * * * * *  / _____________
 
 
      InitProgramm ()
 
      GenerateSprites ()
 
 
; _____________ /  * * * * * *  \ _____________
;         _____ >   S T A R T   < _____
; _____________ \  * * * * * *  / _____________
 
  Repeat
      ExamineKeyboard()
      ExamineMouse()
      ProcessingMouse ()
      ProcessingEvents ()
 
 
        DisplaySprite(Checker, 0, 0)   ;  Чекер на заднем плане
 
         ;  Нарисуем 5.5 тысяч прозрачных спрайтов
         mx2 = mx: my2 = my
         For u = 1 To 5
            For y = my2 To my2 + ScrRezY - 100 Step 50
               For x = mx2 To mx2 + ScrRezX - 100 Step 50
 
               DisplayTransparentSprite(NewSPR(u), x, y)
               DisplayTransparentSprite(NewSPR(u), x, y)
               DisplayTransparentSprite(NewSPR(u), x, y)
 
               Next
            Next
         Next
 
         ;  Надпись
         StartDrawing(ScreenOutput())
            DrawingFont(Fonts(2))
            DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_AlphaBlend)
            DrawText (0, 0, "5400 Прозрачных спрайтов   50x50", $3A2F2B)
            DrawText (0, 50, "DirectX 9", $3A2F2B)
            DrawText (0, 100, "FPS: "+Str(GetFPS()), $3A2F2B)
         StopDrawing()
 
      SimpleCur ()                     ;  Простой курсорчик
      FlipBuffers()                    ;  Флипуем в основной программе
      
 
  Until  KeyboardReleased(#PB_Key_Escape)

Отрисовка в отдельном потоке
Code
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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
  ;
  ;  Отрисовка в отдельном потоке
  ;
 
Global ScrRezX.w, ScrRezY.w          ; Разрешение экрана
Global a, b, c, d, e, f, g
Global All_Threads_End.w             ; Завершить все потоки
Global Dim Fonts(10)                 ; Шрифты
 
 Procedure GetFPS()
  Static StartProc
  Static GetFPS_Count.l, GetFPS_FPS.l, GetFPS_Start.l
  GetFPS_Count + 1 
  If GetFPS_Start = 0 
    GetFPS_Start = GetTickCount_() 
  EndIf 
  If GetTickCount_() - GetFPS_Start >= 1000 ;Or StartProc = 0
    GetFPS_FPS   = GetFPS_Count 
    GetFPS_Count = 0 
    GetFPS_Start + 1000 
    StartProc = 1
  EndIf 
  ProcedureReturn GetFPS_FPS 
EndProcedure 
 
 
 Procedure InitProgramm ()
     ScrRezX = 1280: ScrRezY = 800
 
     a = InitMouse()
     b = InitKeyboard()
     c = InitSprite()
     ;d = InitSprite3D()
 
     f = OpenWindow (#PB_Any, 0, 0, ScrRezX + 6, ScrRezY + 6, "Thread Drawing", #PB_Window_ScreenCentered)
     SetWindowColor (f, 0)
     g = OpenWindowedScreen(WindowID(f), 3, 3, ScrRezX, ScrRezY, 0, 0, 0, #PB_Screen_NoSynchronization)
 
     Fonts(1) = LoadFont(1, "Arial", 20)
     Fonts(2) = LoadFont(2, "Tahoma", 40, #PB_Font_Bold | #PB_Font_HighQuality)
 EndProcedure
 
 Global mx, my
 Procedure SimpleCur ()
   StartDrawing(ScreenOutput())
      LineXY(mx+3, my+3, mx+27, my+15, 0)
      LineXY(mx+3, my+3, mx+14, my+25, 0)
      LineXY(mx, my, mx, my, $FFFFFF)
      LineXY(mx+1, my+1, mx+25, my+13, $FFFFFF)
      LineXY(mx+1, my+1, mx+12, my+23, $FFFFFF)
   StopDrawing()
 EndProcedure
 
 #SprProperty = #PB_Sprite_Memory | #PB_Sprite_Texture | #PB_Sprite_AlphaBlending
 Procedure Img2Spr (ImgHandle, SprHandle, NeedCreateSpr)
 
 If NeedCreateSpr
   NewSprHandle_x_9q = CreateSprite(SprHandle, ImageWidth(ImgHandle), ImageHeight(ImgHandle), #SprProperty)
 Else
   NewSprHandle_x_9q = SprHandle
 EndIf
     ;  Определяем смещения в памяти
 StartDrawing(SpriteOutput(NewSprHandle_x_9q))
   *OutBuf_x_9q = DrawingBuffer()
 StopDrawing()
 StartDrawing(ImageOutput(ImgHandle))
   *InpBuf_x_9q = DrawingBuffer()
 StopDrawing()
     ;  Выясняем объём данных для 32 битного цвета
  Shirina_x_9q = ImageWidth(ImgHandle)
  Visota_x_9q = ImageHeight(ImgHandle)
  DataBegin_x_9q = (Shirina_x_9q * ImageHeight(ImgHandle) - Shirina_x_9q) << 2
  *InpBuf_x_9q = *InpBuf_x_9q + DataBegin_x_9q
 
     EnableASM
       PUSH ebx
       PUSH edi
       PUSH esi
       ADD esp, 12
         MOV ecx, Shirina_x_9q
         MOV ebx, Visota_x_9q
         MOV esi, *InpBuf_x_9q
         MOV edi, *OutBuf_x_9q
       SUB esp, 12
       Cykl_x_9q:
           PUSH ecx
             REP MOVSD
           POP ecx
           PUSH ecx
             SHL ecx, 3
             SUB esi, ecx
           POP ecx
         DEC ebx
         JNZ l_cykl_x_9q
       POP esi
       POP edi
       POP ebx
     DisableASM
 If NeedCreateSpr: ProcedureReturn NewSprHandle_x_9q: EndIf
 EndProcedure
 
 Global Dim NewSPR.l(5)             ;  Спрайтики
 Global ClearSPR, Checker
 
 Procedure GenerateSprites ()
 NewSCL.l: Cv.l
 
  ;  Чекер
 NewSCL = CreateImage (#PB_Any, ScrRezX, ScrRezY, 32) ; Создаём чекер
   StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
   For y = 0 To ScrRezY >> 5
      For x = 0 To ScrRezX >> 5
         If (x & 1) = (y & 1): Cv = $FFFFFF
         Else: Cv = $707070
         EndIf
         Box (x << 5, y << 5, 32, 32, Cv)
      Next
   Next
   StopDrawing()
   StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
   DrawingMode(#PB_2DDrawing_AlphaBlend)
     For y = 0 To 255
        Line(0, y, ScrRezX, 1, RGBA(255, 255, 255, 255-y))
     Next y
   StopDrawing()
 Checker = Img2Spr (NewSCL, #PB_Any, 1)               ; -> В спрайт его
 FreeImage(NewSCL)                                    ;    Удалим имадж
 
 
  ;  Пустой спрайт
 NewSCL = CreateImage (#PB_Any, 5, 5, 32)             ; Создаём пустой спрайт
   StartDrawing(ImageOutput(NewSCL))                  ; Рисуем на нём
   DrawingMode (#PB_2DDrawing_AlphaChannel)           ; Все каналы, т.е. RGB+Alpha
   Box (0, 0, 5, 5, 0)                                ; Полностью прозрачный
   StopDrawing()
 ClearSPR = Img2Spr (NewSCL, #PB_Any, 1)              ; -> В спрайт его
 FreeImage(NewSCL)                                    ;    Удалим имадж
 
 
   ;   Создаём спрайтики
   For i = 0 To 5         ; 5 штук
 
      NewSCL = CreateImage (#PB_Any, 50, 50, 32)         ; Создаём имадж 25x25
 
      StartDrawing(ImageOutput(NewSCL))  ; Рисуем на нём
      DrawingFont(Fonts(1))
      DrawingMode (#PB_2DDrawing_AllChannels)   ; Все каналы, т.е. RGB+Alpha
         Box (0, 0, 50, 50, 0)                  ; Полностью прозрачный
         For k = 1 To 3500
           Cv = RGBA(Random(255), Random(255), Random(255), 25 + Random(10))
           LineXY (Random(50), Random(50), Random(50), Random(50), Cv)
         Next
 
         DrawingMode (#PB_2DDrawing_AlphaChannel)  ; Alpha канал(прозрачность)
         Box (13, 13, 27, 27, RGBA(200, 200, 200, 25))
         DrawingMode (#PB_2DDrawing_AlphaChannel | #PB_2DDrawing_Outlined)  ; Alpha канал(прозрачность)
         
         For k = 12 To 25
           Box (25 - k, 25 - k, k << 1, k << 1, RGBA(200, 200, 200, 28 - (k - 12) << 1))
         Next
 
         DrawingMode(#PB_2DDrawing_Transparent |#PB_2DDrawing_AlphaChannel)
         DrawText (0, 0, "Spr", RGBA(255, 255, 255, 0))
         DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_AlphaBlend)
         DrawText (0, 0, "Spr", RGBA(0, 55, 55, 5))
         
      StopDrawing()
         ;ResizeImage (NewSCL, 50, 50, #PB_Image_Smooth)
      NewSPR(i) = Img2Spr (NewSCL, #PB_Any, 1)
   Next i
 
 EndProcedure
 
  Global LastEVT, FirstClick, Event
  Global NoThreadDraw
 
Global q, NowDrawing
Global Dim Sobytij(8000), Schetch.l
 Procedure OtdPotok (*Prm)        ;  Поток для рисования
 
  Repeat
       ;  Это обработка событий, полученных из основной программы
       If Schetch > 0
         Repeat
         Schetch = Schetch - 1
           Select Sobytij(Schetch) 
              Case #PB_Event_CloseWindow: End
              Case #PB_Event_RestoreWindow 
              ReleaseMouse(0): NoThreadDraw = 0
              Case 513
                ReleaseMouse(0)
                If FirstClick: ;SetMouseXY (WindowMouseX(f), WindowMouseY(f))
                FirstClick = 0: NoThreadDraw = 0
                EndIf
           EndSelect
          
         Until Schetch = 0
       EndIf
 
           ;  Это предшествует отрисовке и сохраняет проц. ресурс
           NowDrawing = 2   ;  Можно обработать события 
           Delay(7)
           NowDrawing = 1   ;  Dead Zone для обработчика событий в основной проге
           Delay(1)         ;  Чем больше - тем лучше, но нежелательно для нас
 
         ;  Тут рисуем что хотим и как хотим
     If NoThreadDraw = 0
        ;ClearScreen($FFFFFF)      ;  Очистим экран
        DisplaySprite(Checker, 0, 0)   ;  Чекер на заднем плане
 
         ;  Нарисуем 5.5 тысяч прозрачных спрайтов
         mx2 = mx: my2 = my
         For u = 1 To 5
            For y = my2 To my2 + ScrRezY - 100 Step 50
               For x = mx2 To mx2 + ScrRezX - 100 Step 50
 
               DisplayTransparentSprite(NewSPR(u), x, y)
               DisplayTransparentSprite(NewSPR(u), x, y)
               DisplayTransparentSprite(NewSPR(u), x, y)
 
               Next
            Next
         Next u
 
         ;  Надпись
         StartDrawing(ScreenOutput())
            DrawingFont(Fonts(2))
            DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_AlphaBlend)
            DrawText (0, 0, "5400 Прозрачных спрайтов   50x50", $3A2F2B)
            DrawText (0, 50, "DirectX 9", $3A2F2B)
            DrawText (0, 100, "FPS: "+Str(GetFPS()), $3A2F2B)
         StopDrawing()
         SimpleCur ()                     ;  Простой курсорчик
         FlipBuffers()                    ;  Флипуем в основной программе
        Delay(1)
        NowDrawing = 0
     EndIf
         ;  Конец отрисовки
      ;q = q + 1     ;  Если надо посчитаем FPS
  Until All_Threads_End
 EndProcedure
 
 ;  Этот поток для опроса клавиатуры и мыши
 ;  + выполняется ReleaseMouse по кнопке Win
 Procedure OtdPotok2 (*Prm)       ;  Поток для опроса клавы & мыши
  Repeat
        ExamineKeyboard()
       If KeyboardReleased(219)
         ReleaseMouse(1): FirstClick = 1: NoThreadDraw = 1
       EndIf
        ExamineMouse()
        mx = MouseX(): my = MouseY()
    Delay(5)
  Until All_Threads_End
 EndProcedure
 
; _____________ /  * * * * * *  \ _____________
;         _____ >    I N I T    < _____
; _____________ \  * * * * * *  / _____________
 
 
      InitProgramm ()
 
      GenerateSprites ()
 
 
      ;  Самый первый опрос мыши и клавиатуры
      ;  Устраняет некоторые баги
      ExamineMouse()
      ExamineKeyboard()
      ReleaseMouse(0)
 
   ;  Создаём потоки
 MyThread = CreateThread (@OtdPotok(), 0)
 MyThread2 = CreateThread (@OtdPotok2(), 0)
 Delay(50)
 
   ;  Приоритеты
 ThreadPriority(MyThread, 31)
 ThreadPriority(MyThread2, 32)
 
 
; _____________ /  * * * * * *  \ _____________
;         _____ >   S T A R T   < _____
; _____________ \  * * * * * *  / _____________
 
 
Repeat
 
   If NowDrawing = 2
   ;  Чистый спрайт, нужен для того, чтобы программа думала
   ;  что мы рисуем с основной программы и производила все
   ;  необходимые для этого операции
   DisplayTransparentSprite(ClearSPR, 0, 0)
   EndIf
 
 
   If NowDrawing = 2
   ;   Получим все события, произошедшие в окне
   ;   и запишем их в спец. массив.
   Repeat
      If NowDrawing = 2
         Event = WindowEvent()
        If Event
           Sobytij(Schetch) = Event
           Schetch = Schetch + 1
           If Schetch > ArraySize(Sobytij()): ReDim Sobytij(ArraySize(Sobytij()) << 1): EndIf
        EndIf
      EndIf
   Until Event = 0
   EndIf
 
 
   Repeat: Until NowDrawing = 2    ;  Подождём для флипа
 
   Delay(150)      ;  Допустим что выполняем какие-либо операции (150 мс это много)
 
Until KeyboardReleased(#PB_Key_Escape)
All_Threads_End = 1
Delay(500)     ;  Время на завершение всех потоков, пол секунды - оптимально


FPS в первом случае (отрисовка в главном потоке) выше чем при разделении на несколько потоков.
0
Кормпилятор
 Аватар для Quiet Snow
5044 / 1718 / 409
Регистрация: 25.04.2010
Сообщений: 4,827
Записей в блоге: 2
27.11.2011, 18:20  [ТС]
FPS в первом случае (отрисовка в главном потоке) выше чем при разделении на несколько потоков.
Я примерно на это и рассчитывал, отчасти из-за кривой реализации(эта дурацкая обработка событий, полагаю можно что-то придумать), а отчасти из-за того, что другим потокам не даётся столько проц времени.
У меня на Geforce 6600 показывает 30 и 23 соотв.

Событие #PB_Event_ActivateWindow появляется после активации окна.
Ясно, у меня где-то была программа, которая отображает все эти события, приходящие в окно. Догадывался, что упустил что-то.
0
Эксперт по электронике
6806 / 3233 / 335
Регистрация: 28.10.2011
Сообщений: 12,620
Записей в блоге: 7
27.11.2011, 19:40
Хочу заметить что мьютексы нужно использовать очень осторожно, иначе может возникнуть очень специфическая ошибка - "Взаимная блокировка потоков".
Я столкнулся с ней в одном их моих проектов. Взаимная блокировка потоков
Чтобы избавится от этой ошибки, пришлось переписать много кода с учетом всех возможных ситуаций.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
BasicMan
Эксперт
29316 / 5623 / 2384
Регистрация: 17.02.2009
Сообщений: 30,364
Блог
27.11.2011, 19:40
Помогаю со студенческими работами здесь

Изменение разных элементов вектора в разных потоках даёт отличный от join() результат, нежели при detach()
Имеется using V = vector&lt;double&gt;; using M = vector&lt;V&gt;; Есть функция матричного умножения A*B. На каждую вектор-строку матрицы A я...

ShellExecute в разных потоках
Возникла трудность с ShellExecute, делаю запуск telegramma из своего приложения с параметрами, все открывается параметры передаются, но...

Перменные в разных потоках
К примеру у меня есть поток со своей переменной внутри(+ я в создание потока даю значения) Thr1 = new Thread(delegate () { thrvd(1); }); ...

2 цикла в разных потоках
Здравствуйте! Научите! Как правильно делать &quot;что-то&quot; в отдельном фоновом потоке в C++. Пожалуйста код! К примеру: void...

QTimer в разных потоках
Вообщем у меня программа состоит из нескольких потоков. Дабы разгрузить граф поток и так же сымитировать несколько отдельных программ в...


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

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Новые блоги и статьи
SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий
8Observer8 02.03.2026
Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11680&amp;d=1772460536 Одним из. . .
Реалии
Hrethgir 01.03.2026
Нет, я не закончил до сих пор симулятор. Эта задача сложнее. Не получилось уйти в плавсостав, но оно и к лучшему, возможно. Точнее получалось - но сварщиком в палубную команду, а это значит, в моём. . .
Ритм жизни
kumehtar 27.02.2026
Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .
SDL3 для Web (WebAssembly): Сборка библиотек: SDL3, Box2D, FreeType, SDL3_ttf, SDL3_mixer и SDL3_image из исходников с помощью CMake и Emscripten
8Observer8 27.02.2026
Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами
8Observer8 20.02.2026
Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .
Конвертировать закладки radiotray-ng в m3u-плейлист
damix 19.02.2026
Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .
Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI
Eddy_Em 18.02.2026
Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .
Камера Toupcam IUA500KMA
Eddy_Em 12.02.2026
Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru