PureBasic

@PB · Регистрация: 13.03.2009

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

Есть такая замечательная разновидность диалекта бейсика именуемая PureBasic.
Сайт разработчика http://www.purebasic.com/
Рускоязычное зеркало http://pbasic.spb.ru/

Как и любой другой бейсик он прост в освоении.
Заточен полностью под винду.
С его помощью можно разрабатывать консольные, окнонные (с поддержкой стиля XP) и игровые программы.
При этом не нужно знать как работает комп или искать инфу по API функциям, т. к. есть более 800 встроеных функций различного назначения, которых в большенстве случаев достаточно чтобы написать не сложную прогу. При необходимости можно использовать API (есть встроеная поддержка) или ассемблерные вставки. При необходимости можно добавить в среду дополнительные функции из внешних библиотек, большой выбор которых есть на страничке http://www.purearea.net/pb/english/userlibs.php

Вот простоейший пример программы отображающей надпись в окне

PureBasic

; Открываем окно
OpenWindow(1,200,250,300,50,"Заголовок окна",#PB_Window_MinimizeGadget)
CreateGadgetList(WindowID(1)) ; Создаём новый список гаджетов
TextGadget(2,80,20,180,15,"Демонстрационная программа") ;Отображаем текст
 
Repeat ; Начало главного цикла Repeat-Until
 Event=WaitWindowEvent() ; Получаем текущий идентификатор события
Until Event=#PB_Event_CloseWindow ; Прерываем цикл при попытке закрыть окно (щелчёк по крестику в заголовке окна)
End ; Завершаем работу программы

Размер скомпилированого файла всего 14КБ!

В архиве есть парочка примеров.

Высказывайте выше мнение об PureBasic

@Ищу_хостинг · 10.09.2011, 21:13

О, я кокраз думал как это сделать. Совпадения конечно, но этот вопрос вы задали во время

@PB · 10.09.2011, 21:51 **[ТС]**

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

как в ПБ считать заголовки запущенных програм?

Только видимые окна.

Код

Repeat
  Temp.s=WindowsEnum()
  Debug Temp
Until Temp=""

Если нужны все, то функию нужно будет немного изменить.
Должна быть установлена библиотека Droopy Library.

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

как в ПБ находить скрытые процессы

Смотря как они будут скрыты.
Полезно посмотреть эту тему http://purebasic.info/phpBB2/viewtopic.php?t=1644

@Quiet Snow · 13.09.2011, 07:31

Есть вопрос помогите решить: работаю в полноэкранном режиме, нужно чтобы по нажатию кнопки windows, прога вылетала в систему и можно было в программу вернуться.

Вот такой код ставлю после FlipBuffers(), в систему вылетает, но обратно возвращается с ошибкой.

Код

      If IsScreenActive() = 0
         ReleaseMouse(1)
         Repeat: Until IsScreenActive()
         ReleaseMouse(0)
      EndIf

Клавиатуру в начале программы поставил так:

Код

KeyboardMode(#PB_Keyboard_AllowSystemKeys)

При отрисовке пользуюсь только Sprite и 2DDrawing и хотелось бы, чтобы все загруженные имаджи и спрайты не сбросились.

@Le Thaw · 13.09.2011, 17:33

Привет, знает кто-нибудь формулы отображения объектов на камере или как называются, чтобы в вики найти. Делаю, хотя бы ради интереса, свой 3д движок. Если я правильно понимаю, то это шейдеры.

Добавлено через 4 минуты
Или лучше взять готовый Шейдерный язык DirectX или OpenGL?

Добавлено через 1 час 59 минут
Как нарисовать треугольник на винапи?
Не получается, т.к. не знаю как создать так массив

C++

1
2
3

ptArray1[0].x = 150; ptArray1[0].y = 250;
ptArray1[1].x = 150; ptArray1[1].y = 150;
ptArray1[2].x = 250; ptArray1[2].y = 250;

@PB · 14.09.2011, 01:33 **[ТС]**

Сообщение от Le Thaw

Не получается, т.к. не знаю как создать так массив

Скорее всего структурированный массив.

Код

Dim ptArray1.POINT(3)

ptArray1(0)\x = 150 : ptArray1(0)\y = 250
ptArray1(1)\x = 150 : ptArray1(1)\y = 150
ptArray1(2)\x = 250 : ptArray1(2)\y = 250

@Le Thaw · 14.09.2011, 08:14

А откуда узнать 2 параметр функции BeginPaint_(MyWindow, ?)

@Pro_grammer · 14.09.2011, 08:47

Сообщение от Le Thaw

А откуда узнать 2 параметр функции BeginPaint_(MyWindow, ?)

Там просто готовая структура ( в PureBasic уже определена), возсращает хендл контекста устойства, окна в вашем случае.

PureBasic

 hdc = BeginPaint_(hwnd, ps.PAINTSTRUCT)
; рисуем и т.п.
 
 EndPaint_(hwnd, ps)

@PB · 14.09.2011, 12:27 **[ТС]**

Сообщение от Le Thaw

А откуда узнать 2 параметр функции BeginPaint_(MyWindow, ?)

Я обычно поступаю следующим образом.
Забиваю в гугл название функции, в нашем случае, это BeginPaint и первая же ссылка как правило, ведет на сайт майкрософт. http://msdn.microsoft.com/en-u... s.85).aspx

@Le Thaw · 14.09.2011, 15:24

Я обычно поступаю следующим образом.
Забиваю в гугл название функции, в нашем случае, это BeginPaint и первая же ссылка как правило, ведет на сайт майкрософт. http://msdn.microsoft.com/en-u... s.85).aspx

Я так делал) но проблема в другом. В разделе винапи смотрел примеры и там этот параметр задавался так

C++

1 2	PAINTSTRUCT ps BeginPaint(hwnd, &ps)

поэтому и не знал как на пб

Добавлено через 20 минут
Не получается линию нарисовать, посмотрите что не так

PureBasic

Procedure WindowCallback(hWnd, Msg, wParam, lParam)
  Shared hButton
  
  Select Msg
    Case #WM_COMMAND
       If hButton = lParam
         
       EndIf
    Case #WM_CLOSE 
      DestroyWindow_(hWnd) 
    Case #WM_DESTROY 
      PostQuitMessage_(0) : Result  = 0 
    Default 
      Result  = DefWindowProc_(hWnd, Msg, wParam, lParam) 
  EndSelect 
  
  ProcedureReturn Result 
EndProcedure  
 
InitCommonControls_()
Global MyWindow
Global hdc2
Procedure Window3D(x.l, y.l, width.l, height.l, title.s)
DefaultFont = GetStockObject_(#DEFAULT_GUI_FONT)
 
WindowClass.s    = "My_Win" 
wc.WNDCLASSEX 
wc\cbsize        = SizeOf(WNDCLASSEX) 
wc\lpfnWndProc   = @WindowCallback() 
wc\hCursor       = LoadCursor_(0, #IDC_ARROW) 
wc\hbrBackground = #COLOR_WINDOW
wc\lpszClassName = @WindowClass 
RegisterClassEx_(@wc) 
 
Win_x=GetSystemMetrics_(#SM_CXSCREEN)/2-100
Win_y=GetSystemMetrics_(#SM_CYSCREEN)/2-50
 
hWndMain  = CreateWindowEx_(0, WindowClass, title, #WS_OVERLAPPEDWINDOW|#WS_SYSMENU | #WS_MINIMIZEBOX, x, y, width, height, 0, 0, 0, 0)
 
MyWindow=hWndMain
 
ShowWindow_(hWndMain,  #SW_SHOWDEFAULT) 
UpdateWindow_(hWndMain)
 
 
ProcedureReturn hWndMain
EndProcedure
 
Procedure xRender()
  hdc2=BeginPaint_(MyWindow, ps.PAINTSTRUCT)
EndProcedure
 
Procedure xFlip()
   ValidateRect_(MyWindow, 0)
   EndPaint_(MyWindow, ps.PAINTSTRUCT)
EndProcedure
 
#Quit=0
 
Global WinEvent=0
 
Procedure WindowEvent2()
  ProcedureReturn WinEvent
EndProcedure
 
Procedure xUpdate()
  WinEvent=GetMessage_(msg.MSG, #Null, 0, 0)
  TranslateMessage_(msg)
  DispatchMessage_(msg)
EndProcedure
 
Global Pen
Pen=CreatePen_(#PS_SOLID, 1, RGB(255, 0, 255))
 
Procedure LineTo(x1.l, y1.l, x2.l, y2.l)
  SelectObject_(hdc2, Pen)
  MoveToEx_(hdc2, x1, y1, 0)
  LineTo_(hdc2, x2, y2)
EndProcedure
 
Window3D(0, 0, 200, 200, "Виндоу")
 
 
 
Repeat
  xUpdate()
  
  xRender()
  LineTo(5, 1, 20, 10)
  xFlip()
Until WindowEvent2()=#Quit
 
End

@PB · 14.09.2011, 18:28 **[ТС]**

Рисовать нужно по событию #WM_PAINT.

Код

#Quit=0

Global MyWindow
Global hdc2
Global PEN
Global WinEvent=0
PEN=CreatePen_(#PS_SOLID, 1, RGB(255, 0, 255))

Procedure xRender()
  hdc2=BeginPaint_(MyWindow, ps.PAINTSTRUCT)
EndProcedure

Procedure xFlip()
  ValidateRect_(MyWindow, 0)
  EndPaint_(MyWindow, ps.PAINTSTRUCT)
EndProcedure

Procedure LineTo(x1.l, y1.l, x2.l, y2.l)
  SelectObject_(hdc2, PEN)
  MoveToEx_(hdc2, x1, y1, 0)
  LineTo_(hdc2, x2, y2)
EndProcedure

Procedure WindowCallback(hWnd, Msg, wParam, lParam)
  Shared hButton
  
  Select Msg
    Case #WM_COMMAND
      If hButton = lParam
        
      EndIf
    Case #WM_CLOSE 
      DestroyWindow_(hWnd) 
    Case #WM_DESTROY 
      PostQuitMessage_(0) : Result  = 0 
    Case #WM_PAINT
      xRender()
      LineTo(5, 1, 20, 10)
      xFlip()
    Default 
      Result  = DefWindowProc_(hWnd, Msg, wParam, lParam) 
  EndSelect 
  
  ProcedureReturn Result 
EndProcedure  

InitCommonControls_()

Procedure Window3D(x.l, y.l, WIDTH.l, height.l, title.s)
  DefaultFont = GetStockObject_(#DEFAULT_GUI_FONT)
  
  WindowClass.s    = "My_Win" 
  wc.WNDCLASSEX 
  wc\cbsize        = SizeOf(WNDCLASSEX) 
  wc\lpfnWndProc   = @WindowCallback() 
  wc\hCursor       = LoadCursor_(0, #IDC_ARROW) 
  wc\hbrBackground = #COLOR_WINDOW
  wc\lpszClassName = @WindowClass 
  RegisterClassEx_(@wc) 
  
  Win_x=GetSystemMetrics_(#SM_CXSCREEN)/2-100
  Win_y=GetSystemMetrics_(#SM_CYSCREEN)/2-50
  
  hWndMain  = CreateWindowEx_(0, WindowClass, title, #WS_OVERLAPPEDWINDOW|#WS_SYSMENU | #WS_MINIMIZEBOX, x, y, WIDTH, height, 0, 0, 0, 0)
  
  MyWindow=hWndMain
  
  ShowWindow_(hWndMain,  #SW_SHOWDEFAULT) 
  UpdateWindow_(hWndMain)
  
  
  ProcedureReturn hWndMain
EndProcedure

Procedure WindowEvent2()
  ProcedureReturn WinEvent
EndProcedure

Procedure xUpdate()
  WinEvent=GetMessage_(msg.MSG, #Null, 0, 0)
  TranslateMessage_(msg)
  DispatchMessage_(msg)
EndProcedure


Window3D(0, 0, 200, 200, "Виндоу")

Repeat
  xUpdate()  
Until WindowEvent2()=#Quit

End

@Le Thaw · 14.09.2011, 19:43

Спасибо.
Но. В первый раз вы ошиблись) Рисовать можно не только после этого события.
Вместо этого используются функция GetDC перед рисованием и после ReleaseDC.
Инфу нашел по имени события)
Но событие #WM_PAINT все равно должно присутствовать

Добавлено через 4 минуты
Еще есть вопрос, как стереть то что нарисовано?

Добавлено через 19 минут
Нашел, функция InvalidateRect

Добавлено через 20 минут
Прошу еще помощи.
Создал таймер, для обновления окна, чтобы линия рисовалась заново с другими координатами. Но если курсор движется в области окна, она обновляется быстрее, как от этого избавиться. И от мерцания.

PureBasic

#Quit=0
 
Global MyWindow
Global hdc2
Global PEN
Global WinEvent=0
PEN=CreatePen_(#PS_SOLID, 0, RGB(0, 255, 0))
 
Procedure xRender()
  InvalidateRect_(MyWindow, 0, 1)
  hdc2=BeginPaint_(MyWindow, ps.PAINTSTRUCT)
EndProcedure
 
Procedure xFlip()
  ValidateRect_(MyWindow, 0)
  EndPaint_(MyWindow, ps.PAINTSTRUCT)
EndProcedure
 
Procedure LineTo(x1.l, y1.l, x2.l, y2.l)
  GetDC_(MyWindow)
  SelectObject_(hdc2, PEN)
  MoveToEx_(hdc2, x1, y1, 0)
  LineTo_(hdc2, x2, y2)
  ReleaseDC_(MyWindow, hdc2)
EndProcedure
 Global ld
Procedure WindowCallback(hWnd, Msg, wParam, lParam)
  Shared hButton
  
  Select Msg
    Case #WM_COMMAND
      If hButton = lParam
        
      EndIf
    Case #WM_CLOSE 
      DestroyWindow_(hWnd) 
    Case #WM_DESTROY 
      PostQuitMessage_(0) : Result  = 0
    Default 
      Result  = DefWindowProc_(hWnd, Msg, wParam, lParam) 
  EndSelect 
  
  ProcedureReturn Result 
EndProcedure  
 
InitCommonControls_()
 
Procedure Window3D(x.l, y.l, WIDTH.l, height.l, title.s)
  DefaultFont = GetStockObject_(#DEFAULT_GUI_FONT)
  
  WindowClass.s    = "My_Win" 
  wc.WNDCLASSEX 
  wc\cbsize        = SizeOf(WNDCLASSEX) 
  wc\lpfnWndProc   = @WindowCallback() 
  wc\hCursor       = LoadCursor_(0, #IDC_ARROW) 
  wc\hbrBackground = #COLOR_WINDOW
  wc\lpszClassName = @WindowClass 
  RegisterClassEx_(@wc) 
  
  Win_x=GetSystemMetrics_(#SM_CXSCREEN)/2-100
  Win_y=GetSystemMetrics_(#SM_CYSCREEN)/2-50
  
  hWndMain  = CreateWindowEx_(0, WindowClass, title, #WS_OVERLAPPEDWINDOW|#WS_SYSMENU | #WS_MINIMIZEBOX, x, y, WIDTH, height, 0, 0, 0, 0)
  SetTimer_(hWndMain, 1, 10, 0)
  MyWindow=hWndMain
  
  ShowWindow_(hWndMain,  #SW_SHOWDEFAULT) 
  UpdateWindow_(hWndMain)
  
  
  ProcedureReturn hWndMain
EndProcedure
 
Procedure WindowEvent2()
  ProcedureReturn WinEvent
EndProcedure
 
Procedure xUpdate()
  WinEvent=GetMessage_(msg.MSG, #Null, 0, 0)
  TranslateMessage_(msg)
  DispatchMessage_(msg)
EndProcedure
 
 
Window3D(0, 0, 200, 200, "Виндоу")
 
Repeat
  xUpdate()  
  xRender()
  d+1
  LineTo(10+d, 100, 200, 10)
  xFlip()
  Debug WindowEvent2()
Until WindowEvent2()=#Quit
 
End

@PB · 14.09.2011, 20:05 **[ТС]**

Сообщение от Le Thaw

Но. В первый раз вы ошиблись) Рисовать можно не только после этого события.
Вместо этого используются функция GetDC перед рисованием и после ReleaseDC.
Инфу нашел по имени события)
Но событие #WM_PAINT все равно должно присутствовать

Нужно рисовать после того, как система сообщит что требуется прорисовка.
Иначе будет пустая трата ресурсов компа.

Сообщение от Le Thaw

Но если курсор движется в области окна, она обновляется быстрее, как от этого избавиться.

Обрабатывать сообщение #WM_TIMER и если поступило, то выполнять требуемые действия.

Код

#Quit=0
 
Global MyWindow
Global hdc2
Global PEN
Global WinEvent=0
PEN=CreatePen_(#PS_SOLID, 0, RGB(0, 255, 0))
 
Procedure xRender()
  InvalidateRect_(MyWindow, 0, 1)
  hdc2=BeginPaint_(MyWindow, ps.PAINTSTRUCT)
EndProcedure
 
Procedure xFlip()
  ValidateRect_(MyWindow, 0)
  EndPaint_(MyWindow, ps.PAINTSTRUCT)
EndProcedure
 
Procedure LineTo(x1.l, y1.l, x2.l, y2.l)
  GetDC_(MyWindow)
  SelectObject_(hdc2, PEN)
  MoveToEx_(hdc2, x1, y1, 0)
  LineTo_(hdc2, x2, y2)
  ReleaseDC_(MyWindow, hdc2)
EndProcedure
 Global ld
Procedure WindowCallback(hWnd, Msg, wParam, lParam)
  Shared hButton
  Static d
  
  Select Msg
    Case #WM_COMMAND
      If hButton = lParam
        
      EndIf
    Case #WM_CLOSE 
      DestroyWindow_(hWnd) 
    Case #WM_DESTROY 
      PostQuitMessage_(0) : Result  = 0
    Case #WM_TIMER
      If wParam = 1
        d+1
        InvalidateRect_(hWnd, 0, #True)
      EndIf
    Case #WM_PAINT
      xRender()
      LineTo(10+d, 100, 200, 10)
      xFlip()
    Default 
      Result  = DefWindowProc_(hWnd, Msg, wParam, lParam) 
  EndSelect 
  
  ProcedureReturn Result 
EndProcedure  
 
InitCommonControls_()
 
Procedure Window3D(x.l, y.l, WIDTH.l, height.l, title.s)
  DefaultFont = GetStockObject_(#DEFAULT_GUI_FONT)
  
  WindowClass.s    = "My_Win" 
  wc.WNDCLASSEX 
  wc\cbsize        = SizeOf(WNDCLASSEX) 
  wc\lpfnWndProc   = @WindowCallback() 
  wc\hCursor       = LoadCursor_(0, #IDC_ARROW) 
  wc\hbrBackground = #COLOR_WINDOW
  wc\lpszClassName = @WindowClass 
  RegisterClassEx_(@wc) 
  
  Win_x=GetSystemMetrics_(#SM_CXSCREEN)/2-100
  Win_y=GetSystemMetrics_(#SM_CYSCREEN)/2-50
  
  hWndMain  = CreateWindowEx_(0, WindowClass, title, #WS_OVERLAPPEDWINDOW|#WS_SYSMENU | #WS_MINIMIZEBOX, x, y, WIDTH, height, 0, 0, 0, 0)
  SetTimer_(hWndMain, 1, 10, 0)
  MyWindow=hWndMain
  
  ShowWindow_(hWndMain,  #SW_SHOWDEFAULT) 
  UpdateWindow_(hWndMain)
  
  
  ProcedureReturn hWndMain
EndProcedure
 
Procedure WindowEvent2()
  ProcedureReturn WinEvent
EndProcedure
 
Procedure xUpdate()
  WinEvent=GetMessage_(msg.MSG, #Null, 0, 0)
  TranslateMessage_(msg)
  DispatchMessage_(msg)
EndProcedure
 
 
Window3D(0, 0, 200, 200, "Виндоу")
 
Repeat
  xUpdate()  
  Debug WindowEvent2()
Until WindowEvent2()=#Quit
 
End

@Le Thaw · 14.09.2011, 20:14

Нужно рисовать после того, как система сообщит что требуется прорисовка.
Иначе будет пустая трата ресурсов компа.

Разве в графических приложениях прорисовка идет не постоянно?

Добавлено через 57 секунд
Мерцания все равно остались.

Добавлено через 6 минут
Мне нужно сделать подобно функциям Draw, которые рисуют каждый раз

@PB · 14.09.2011, 20:46 **[ТС]**

Сообщение от Le Thaw

Разве в графических приложениях прорисовка идет не постоянно?

Это оконная программа.
Система сама сообщит когда нужно перерисовать окно.

Сообщение от Le Thaw

Мерцания все равно остались.

Из-за чего возникают мерцания и как с ними бороться.

@Le Thaw · 14.09.2011, 21:58

Ф-ция BitBlt возвращает не ноль, но не копирует изображение в окно

@PB · 14.09.2011, 22:15 **[ТС]**

Значит что-то не так было сделано.

@Le Thaw · 14.09.2011, 22:21

Сделал точно так же как там было написано

PureBasic

#Quit=0
 
Global MyWindow
Global hdc2
Global PEN
Global WinEvent=0
Global GlobalTimer=0
Global ld
Global Milliseconds
PEN=CreatePen_(#PS_SOLID, 0, RGB(0, 255, 0))
 
Procedure xRender()
 ; InvalidateRect_(MyWindow, 0, 1)
  
EndProcedure
 
Procedure xFlip()
  ;ValidateRect_(MyWindow, 0)
  
EndProcedure
 
Procedure LineTo(x1.l, y1.l, x2.l, y2.l)
 
EndProcedure
Global sds
Macro Draw
  sds+1
  LineTo(10+sds, 100, 200, 10)
EndMacro
 
Procedure WindowCallback(hWnd, Msg, wParam, lParam)
  Shared hButton
  
  Select Msg
    Case #WM_COMMAND
      If hButton = lParam
        
      EndIf
    Case #WM_CLOSE
      DestroyWindow_(hWnd)
    Case #WM_DESTROY
      PostQuitMessage_(0) : Result  = 0
    Case #WM_TIMER
      If wParam = 1
        InvalidateRect_(hWnd, 0, 1)
      EndIf
    Case #WM_PAINT
      hdc=BeginPaint_(hWnd, ps.PAINTSTRUCT)
      hdcMem = CreateCompatibleDC_(hdc)
      hbmMem = CreateCompatibleBitmap_(hdc, win_width, win_height)
      hOld   = SelectObject_(hdcMem, hbmMem)
      
      
      SelectObject_(hdcMem, PEN)
      MoveToEx_(hdcMem , 0, 0, 0)
      LineTo_(hdcMem , 100, 100)
      
      
      saa=BitBlt_(hdc, 0, 0, win_width, win_height, hdcMem, 0, 0, #SRCCOPY)
      SelectObject_(hdcMem, hOld)
      DeleteObject_(hbmMem)
      DeleteDC_(hdcMem)
      EndPaint_(hWnd, ps.PAINTSTRUCT)
    Default
      Result  = DefWindowProc_(hWnd, Msg, wParam, lParam)
  EndSelect
  
  ProcedureReturn Result
EndProcedure
 
InitCommonControls_()
 
Procedure Window3D(x.l, y.l, WIDTH.l, height.l, title.s)
  DefaultFont = GetStockObject_(#DEFAULT_GUI_FONT)
  
  WindowClass.s    = "My_Win"
  wc.WNDCLASSEX
  wc\cbsize        = SizeOf(WNDCLASSEX)
  wc\lpfnWndProc   = @WindowCallback()
  wc\hCursor       = LoadCursor_(0, #IDC_ARROW)
  wc\hbrBackground = #COLOR_WINDOW
  wc\lpszClassName = @WindowClass
  RegisterClassEx_(@wc)
  
  Win_x=x
  Win_y=y
  
  hWndMain  = CreateWindowEx_(0, WindowClass, title, #WS_OVERLAPPEDWINDOW|#WS_SYSMENU | #WS_MINIMIZEBOX, x, y, WIDTH, height, 0, 0, 0, 0)
  SetTimer_(hWndMain, 1, 1, 0)
  MyWindow=hWndMain
  
  ShowWindow_(hWndMain,  #SW_SHOWDEFAULT)
  UpdateWindow_(hWndMain)
  
  
  ProcedureReturn hWndMain
EndProcedure
 
Procedure WindowEvent2()
  ProcedureReturn WinEvent
EndProcedure
 
 
 
 
Window3D(0, 0, 200, 200, "Виндоу")
 
 
Global Dim wMouseState(2)
Global Dim wMouseStateUp(2)
Global Dim wMouseStateHit(2)
Global Dim wMouseStateDouble(2)
 
ProcedureDLL xMouseDown(state.l)
  If wMouseState(state)>0
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure
 
ProcedureDLL xMouseUp(state.l)
  ProcedureReturn wMouseStateUp(state)
EndProcedure
 
ProcedureDLL xMouseHit(state.l)
  ProcedureReturn wMouseStateHit(state)
EndProcedure
 
ProcedureDLL xMouseDouble(state.l)
  ProcedureReturn wMouseStateDouble(state)
EndProcedure
 
Global wMouseMilliLEFT.f=0
Global wMouseMilliRIGHT.f=0
Global wMDClick=0
ProcedureDLL xMouse()
  LB=GetAsyncKeyState_(#VK_LBUTTON)
  RB=GetAsyncKeyState_(#VK_RBUTTON)
  If wMDClick=1
    Debug "sd"
    LB=0
    RB=0
    wMDClick=0
  EndIf
  GetSystemTime_(sm.SYSTEMTIME)
  If wMouseMilliLEFT>1
    If wMouseMilliLEFT+150>sm\wMilliseconds
      If LB>0
        wMouseStateDouble(1)=1
        wMouseMilliLEFT=0
        wMDClick=1
      EndIf
      
    Else
      wMouseMilliLEFT=0
    EndIf
  EndIf
  
  If wMouseMilliRIGHT>1
    If wMouseMilliRIGHT+150>sm\wMilliseconds
      If RB>0
        wMouseStateDouble(2)=1
        wMouseMilliRIGHT=0
        wMDClick=1
      EndIf
    Else
      wMouseMilliRIGHT=0
    EndIf
  EndIf
  
  If wMouseState(1)>0 And LB=0
    wMouseStateUp(1)=1
    wMouseMilliLEFT=sm\wMilliseconds
  EndIf
  If wMouseState(2)>0 And RB=0
    wMouseStateUp(2)=1
    wMouseMilliRIGHT=sm\wMilliseconds
  EndIf
 
  If Not wMouseState(1)>0 And Not LB=0
    wMouseStateHit(1)=1
  EndIf
  
  
  If Not wMouseState(2)>0 And Not RB=0
    wMouseStateHit(2)=1
  EndIf
  
 
  wMouseState(1)=LB 
  wMouseState(2)=RB
 
EndProcedure
 
ProcedureDLL xMouseUpdate()
  wMouseStateUp(1)=0
  wMouseStateUp(2)=0
  wMouseStateHit(1)=0
  wMouseStateHit(2)=0
  wMouseStateDouble(1)=0
  wMouseStateDouble(2)=0
EndProcedure
 
Procedure xUpdate()
  xMouseUpdate()
  WinEvent=GetMessage_(msg.MSG, #Null, 0, 0)
  TranslateMessage_(msg)
  DispatchMessage_(msg)
  xMouse()
EndProcedure
 
Repeat
  xUpdate()
Until WindowEvent2()=#Quit
 
End

@PB · 15.09.2011, 00:41 **[ТС]**

В переменных win_width и win_height были нули в место размера окна.

Код

#Quit=0
 
Global MyWindow
Global hdc2
Global PEN
Global WinEvent=0
Global GlobalTimer=0
Global ld
Global Milliseconds
PEN=CreatePen_(#PS_SOLID, 0, RGB(0, 255, 0))
 
Procedure xRender()
 ; InvalidateRect_(MyWindow, 0, 1)
  
EndProcedure
 
Procedure xFlip()
  ;ValidateRect_(MyWindow, 0)
  
EndProcedure
 
Procedure LineTo(x1.l, y1.l, x2.l, y2.l)
 
EndProcedure
Global sds
Macro DRAW
  sds+1
  LineTo(10+sds, 100, 200, 10)
EndMacro
 
Procedure WindowCallback(hWnd, Msg, wParam, lParam)
  Shared hButton
  
  Select Msg
    Case #WM_COMMAND
      If hButton = lParam
        
      EndIf
    Case #WM_CLOSE
      DestroyWindow_(hWnd)
    Case #WM_DESTROY
      PostQuitMessage_(0) : Result  = 0
    Case #WM_TIMER
      If wParam = 1
        InvalidateRect_(hWnd, 0, 1)
      EndIf
    Case #WM_ERASEBKGND
      Result = 1
    Case #WM_PAINT
      GetWindowRect_(hWnd, WinSize.RECT)
      win_width = WinSize\right - WinSize\left
      win_height = WinSize\bottom - WinSize\top
      hdc=BeginPaint_(hWnd, ps.PAINTSTRUCT)
      
      hdcMem = CreateCompatibleDC_(hdc)
      hbmMem = CreateCompatibleBitmap_(hdc, win_width, win_height)
      hOld   = SelectObject_(hdcMem, hbmMem)
      Result  = DefWindowProc_(hWnd, #WM_ERASEBKGND, hdcMem, lParam)
      SelectObject_(hdcMem, PEN)
      MoveToEx_(hdcMem , 0, 0, 0)
      LineTo_(hdcMem , 100, 100)
      
      
      saa=BitBlt_(hdc, 0, 0, win_width, win_height, hdcMem, 0, 0, #SRCCOPY)
      SelectObject_(hdcMem, hOld)
      DeleteObject_(hbmMem)
      DeleteDC_(hdcMem)
      EndPaint_(hWnd, ps.PAINTSTRUCT)
    Default
      Result  = DefWindowProc_(hWnd, Msg, wParam, lParam)
  EndSelect
  
  ProcedureReturn Result
EndProcedure
 
InitCommonControls_()
 
Procedure Window3D(x.l, y.l, WIDTH.l, height.l, title.s)
  DefaultFont = GetStockObject_(#DEFAULT_GUI_FONT)
  
  WindowClass.s    = "My_Win"
  wc.WNDCLASSEX
  wc\cbsize        = SizeOf(WNDCLASSEX)
  wc\lpfnWndProc   = @WindowCallback()
  wc\hCursor       = LoadCursor_(0, #IDC_ARROW)
  wc\hbrBackground = #COLOR_WINDOW
  wc\lpszClassName = @WindowClass
  RegisterClassEx_(@wc)
  
  Win_x=x
  Win_y=y
  
  hWndMain  = CreateWindowEx_(0, WindowClass, title, #WS_OVERLAPPEDWINDOW|#WS_SYSMENU | #WS_MINIMIZEBOX, x, y, WIDTH, height, 0, 0, 0, 0)
  SetTimer_(hWndMain, 1, 1, 0)
  MyWindow=hWndMain
  
  ShowWindow_(hWndMain,  #SW_SHOWDEFAULT)
  UpdateWindow_(hWndMain)
  
  
  ProcedureReturn hWndMain
EndProcedure
 
Procedure WindowEvent2()
  ProcedureReturn WinEvent
EndProcedure
 
 
 
 
Window3D(0, 0, 200, 200, "Виндоу")
 
 
Global Dim wMouseState(2)
Global Dim wMouseStateUp(2)
Global Dim wMouseStateHit(2)
Global Dim wMouseStateDouble(2)
 
ProcedureDLL xMouseDown(state.l)
  If wMouseState(state)>0
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure
 
ProcedureDLL xMouseUp(state.l)
  ProcedureReturn wMouseStateUp(state)
EndProcedure
 
ProcedureDLL xMouseHit(state.l)
  ProcedureReturn wMouseStateHit(state)
EndProcedure
 
ProcedureDLL xMouseDouble(state.l)
  ProcedureReturn wMouseStateDouble(state)
EndProcedure
 
Global wMouseMilliLEFT.f=0
Global wMouseMilliRIGHT.f=0
Global wMDClick=0
ProcedureDLL xMouse()
  LB=GetAsyncKeyState_(#VK_LBUTTON)
  RB=GetAsyncKeyState_(#VK_RBUTTON)
  If wMDClick=1
    Debug "sd"
    LB=0
    RB=0
    wMDClick=0
  EndIf
  GetSystemTime_(sm.SYSTEMTIME)
  If wMouseMilliLEFT>1
    If wMouseMilliLEFT+150>sm\wMilliseconds
      If LB>0
        wMouseStateDouble(1)=1
        wMouseMilliLEFT=0
        wMDClick=1
      EndIf
      
    Else
      wMouseMilliLEFT=0
    EndIf
  EndIf
  
  If wMouseMilliRIGHT>1
    If wMouseMilliRIGHT+150>sm\wMilliseconds
      If RB>0
        wMouseStateDouble(2)=1
        wMouseMilliRIGHT=0
        wMDClick=1
      EndIf
    Else
      wMouseMilliRIGHT=0
    EndIf
  EndIf
  
  If wMouseState(1)>0 And LB=0
    wMouseStateUp(1)=1
    wMouseMilliLEFT=sm\wMilliseconds
  EndIf
  If wMouseState(2)>0 And RB=0
    wMouseStateUp(2)=1
    wMouseMilliRIGHT=sm\wMilliseconds
  EndIf
 
  If Not wMouseState(1)>0 And Not LB=0
    wMouseStateHit(1)=1
  EndIf
  
  
  If Not wMouseState(2)>0 And Not RB=0
    wMouseStateHit(2)=1
  EndIf
  
 
  wMouseState(1)=LB 
  wMouseState(2)=RB
 
EndProcedure
 
ProcedureDLL xMouseUpdate()
  wMouseStateUp(1)=0
  wMouseStateUp(2)=0
  wMouseStateHit(1)=0
  wMouseStateHit(2)=0
  wMouseStateDouble(1)=0
  wMouseStateDouble(2)=0
EndProcedure
 
Procedure xUpdate()
  xMouseUpdate()
  WinEvent=GetMessage_(msg.MSG, #Null, 0, 0)
  TranslateMessage_(msg)
  DispatchMessage_(msg)
  xMouse()
EndProcedure
 
Repeat
  xUpdate()
Until WindowEvent2()=#Quit
 
End

@Le Thaw · 15.09.2011, 11:11

Можно сделать на winapi окно в полноэкранном режиме?

@Quiet Snow · 15.09.2011, 11:33

Искал искал я это и как понял графическая библиотека пюра не даёт такой возможности.

Жалко конечно, придётся перевести все свои проги в оконный с опцией AutoStretch, развернуть их на весь экран и написать такой код:

Код

;    Сворачиваем окошко
      If KeyboardReleased(219): SetWindowState(e, #PB_Window_Minimize): EndIf
      Repeat      ;    Обрабатываем события
        Event = WindowEvent()
        Select Event 
          Case #PB_Event_CloseWindow
            End
          Case #PB_Event_RestoreWindow
          SetWindowState(e, #PB_Window_Normal)
        EndSelect
      Until Event = 0

@Ищу_хостинг 0 / 0 / 0 Регистрация: 24.08.2011 Сообщений: 8
	10.09.2011, 21:13	1181
	О, я кокраз думал как это сделать. Совпадения конечно, но этот вопрос вы задали во время 0

@PB Просто прогер 1292 / 1079 / 13 Регистрация: 13.03.2009 Сообщений: 2,502
	10.09.2011, 21:51 [ТС]	1182
	Сообщение от silveran как в ПБ считать заголовки запущенных програм? Только видимые окна. Код Repeat Temp.s=WindowsEnum() Debug Temp Until Temp="" Если нужны все, то функию нужно будет немного изменить. Должна быть установлена библиотека Droopy Library. Сообщение от silveran как в ПБ находить скрытые процессы Смотря как они будут скрыты. Полезно посмотреть эту тему http://purebasic.info/phpBB2/viewtopic.php?t=1644 1

@Quiet Snow 5001 / 1673 / 409 Регистрация: 25.04.2010 Сообщений: 4,624 Записей в блоге: 2
	13.09.2011, 07:31	1183
	Есть вопрос помогите решить: работаю в полноэкранном режиме, нужно чтобы по нажатию кнопки windows, прога вылетала в систему и можно было в программу вернуться. Вот такой код ставлю после FlipBuffers(), в систему вылетает, но обратно возвращается с ошибкой. Код If IsScreenActive() = 0 ReleaseMouse(1) Repeat: Until IsScreenActive() ReleaseMouse(0) EndIf Клавиатуру в начале программы поставил так: Код KeyboardMode(#PB_Keyboard_AllowSystemKeys) При отрисовке пользуюсь только Sprite и 2DDrawing и хотелось бы, чтобы все загруженные имаджи и спрайты не сбросились. 0

@PB Просто прогер 1292 / 1079 / 13 Регистрация: 13.03.2009 Сообщений: 2,502
	14.09.2011, 01:33 [ТС]	1185
	Сообщение от Le Thaw Не получается, т.к. не знаю как создать так массив Скорее всего структурированный массив. Код Dim ptArray1.POINT(3) ptArray1(0)\x = 150 : ptArray1(0)\y = 250 ptArray1(1)\x = 150 : ptArray1(1)\y = 150 ptArray1(2)\x = 250 : ptArray1(2)\y = 250 1

@Le Thaw 37 / 37 / 1 Регистрация: 07.09.2010 Сообщений: 752
	14.09.2011, 08:14	1186
	А откуда узнать 2 параметр функции BeginPaint_(MyWindow, ?) 0

@PB Просто прогер 1292 / 1079 / 13 Регистрация: 13.03.2009 Сообщений: 2,502
	14.09.2011, 12:27 [ТС]	1188
	Сообщение от Le Thaw А откуда узнать 2 параметр функции BeginPaint_(MyWindow, ?) Я обычно поступаю следующим образом. Забиваю в гугл название функции, в нашем случае, это BeginPaint и первая же ссылка как правило, ведет на сайт майкрософт. http://msdn.microsoft.com/en-u... s.85).aspx 1

@Le Thaw 37 / 37 / 1 Регистрация: 07.09.2010 Сообщений: 752
	14.09.2011, 20:14	1193
	Нужно рисовать после того, как система сообщит что требуется прорисовка. Иначе будет пустая трата ресурсов компа. Разве в графических приложениях прорисовка идет не постоянно? Добавлено через 57 секунд Мерцания все равно остались. Добавлено через 6 минут Мне нужно сделать подобно функциям Draw, которые рисуют каждый раз 0

@PB Просто прогер 1292 / 1079 / 13 Регистрация: 13.03.2009 Сообщений: 2,502
	14.09.2011, 20:46 [ТС]	1194
	Сообщение от Le Thaw Разве в графических приложениях прорисовка идет не постоянно? Это оконная программа. Система сама сообщит когда нужно перерисовать окно. Сообщение от Le Thaw Мерцания все равно остались. Из-за чего возникают мерцания и как с ними бороться. 1

@Le Thaw 37 / 37 / 1 Регистрация: 07.09.2010 Сообщений: 752
	14.09.2011, 21:58	1195
	Ф-ция BitBlt возвращает не ноль, но не копирует изображение в окно 0

@PB Просто прогер 1292 / 1079 / 13 Регистрация: 13.03.2009 Сообщений: 2,502
	14.09.2011, 22:15 [ТС]	1196
	Значит что-то не так было сделано. 1

@Le Thaw 37 / 37 / 1 Регистрация: 07.09.2010 Сообщений: 752
	15.09.2011, 11:11	1199
	Можно сделать на winapi окно в полноэкранном режиме? 0

@Quiet Snow 5001 / 1673 / 409 Регистрация: 25.04.2010 Сообщений: 4,624 Записей в блоге: 2
	15.09.2011, 11:33	1200
	Искал искал я это и как понял графическая библиотека пюра не даёт такой возможности. Жалко конечно, придётся перевести все свои проги в оконный с опцией AutoStretch, развернуть их на весь экран и написать такой код: Код ; Сворачиваем окошко If KeyboardReleased(219): SetWindowState(e, #PB_Window_Minimize): EndIf Repeat ; Обрабатываем события Event = WindowEvent() Select Event Case #PB_Event_CloseWindow End Case #PB_Event_RestoreWindow SetWindowState(e, #PB_Window_Normal) EndSelect Until Event = 0 0