PureBasic - форум |
Привет, Гость! Войдите или зарегистрируйтесь.
Вы здесь » PureBasic - форум » Вопросы по PureBasic » Многооконное приложение
WindowWidth() и другие подобные функции, принимают идентификатор окна, а не его хендл.
Кстати, функция WindowID() как раз позволяет получить хендл из идентификатора окна.
А размер окна, можно узнать с помощью WinAPI функции GetWindowRect_().
мерцание не уходит
Добавь стили #WS_CLIPCHILDREN и #WS_CLIPSIBLINGS к окнам.
Пётр
Procedure hDrawPoints(hWnd)
GetWindowRect_(hWnd,@rect)
rc.RECT
Debug rc\bottom
EndProcedure
вот так что ли?
Почему не работает?
Procedure DrawPoints(Windows)
If LoadFont(1, "Arial", 8)
If CreateImage(0, WindowWidth(Windows), WindowHeight(Windows)) And StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_Transparent)
Box(0, 0, WindowWidth(Windows), WindowHeight(Windows), RGB(245,245,245))
For i = 8 To (WindowWidth(Windows)) Step 10
DrawingFont(FontID(1))
DrawText( i,-2, ".", RGB(55, 55, 55))
For j = 8 To (WindowHeight(Windows)) Step 10
DrawingFont(FontID(1))
DrawText( i,j, ".", RGB(55, 55, 55))
Next
Next
StopDrawing()
ImageGadget(#PB_Any, 0, 0, 200, 200, ImageID(0))
EndIf
EndIf
EndProcedure
Procedure hDrawPoints(hWnd)
WindowSize.RECT
name.s = Space(100)
GetWindowRect_(hWnd, @WindowSize)
GetWindowText_(hWnd, @name, 100)
Width=WindowSize\Right - WindowSize\Left
Height=WindowSize\Bottom - WindowSize\Top
Left=WindowSize\Left
Top=WindowSize\Top
If LoadFont(1, "Arial", 8)
If CreateImage(0, Width, Height) And StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_Transparent)
Box(0, 0, Width, Height, RGB(245,245,245))
For i = 8 To Width Step 10
DrawingFont(FontID(1))
DrawText( i,-2, ".", RGB(55, 55, 55))
For j = 8 To Height Step 10
DrawingFont(FontID(1))
DrawText( i,j, ".", RGB(55, 55, 55))
Next
Next
StopDrawing()
ImageGadget(#PB_Any, 0, 0, 200, 200, ImageID(0))
EndIf
EndIf
EndProcedure
Procedure WinChildCallback(hWnd, Msg, wParam, lParam)
Select Msg
Case #WM_CLOSE
DestroyWindow_(hWnd)
Case #WM_DESTROY
PostQuitMessage_(0) : Result = 0
Case #WM_SIZE
;Debug hWnd
RedrawWindow_(hWnd, 0, 0, #RDW_UPDATENOW|#RDW_UPDATENOW) ; Уменьшаем мерцания окна с помошью Api при изменении его размеров.
hDrawPoints(hWnd)
Default
Result = DefWindowProc_(hWnd, Msg, wParam, lParam)
EndSelect
ProcedureReturn Result
EndProcedure
;- Изменяем размеры и Уменьшаем мерцание
Procedure WindowResize(WindowID, Message, wParam, lParam)
Result = #PB_ProcessPureBasicEvents
If Message = #WM_SIZE
; Debug 1
DrawPoints(hWnd)
EndIf
ProcedureReturn Result
EndProcedure
Procedure WinChild(Class.s, x, y, width, height,Caption$,Win)
wc.WNDCLASSEX
wc\cbsize = SizeOf(WNDCLASSEX)
wc\lpfnWndProc = @WinChildCallback()
wc\hCursor = LoadCursor_(0, #IDC_ARROW)
wc\hbrBackground = #COLOR_WINDOW
wc\lpszClassName = @Class
RegisterClassEx_(@wc)
ProcedureReturn CreateWindowEx_(0, Class, Caption$, #WS_VISIBLE|#WS_SYSMENU | #WS_MINIMIZEBOX|#WS_MAXIMIZEBOX|#WS_SIZEBOX | #WS_CLIPCHILDREN | #WS_CLIPSIBLINGS, x, y, width, height, Win,0, 0, 0)
EndProcedure
hWnd = OpenWindow(0, 0, 0, 800, 600, "Средствами PureBasic - "+Chr(34)+" Главное окно "+Chr(34),#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
;SetThemeAppProperties_(0)
OpenWindow(1, 0, 0, 280, 220, "Дочернее окно",#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget, WindowID(0))
SetWindowCallback(@WindowResize())
SetParent_(WindowID(1), WindowID(0))
hWnd1=WinChild("Win2", 0, 0, 280, 230, "Дочернее окно", hWnd)
HideWindow(0,0)
HideWindow(1,0)
Repeat
Event=WaitWindowEvent()
Until Event=#PB_Event_CloseWindowМне нужно догадаться что именно не работает?
Мне нужно догадаться что именно не работает?
Зачем, запусти и увидишь что в окне созданном при помощи API не рисуются точки.
Во первых в твоем коде, нет ImageList'a для тех окон, а во вторых, знаешь как работает такая конструкция и к каких последствиям приведет ее использование?
ImageGadget(#PB_Any, 0, 0, 200, 200, ImageID(0))
Сначала ознакомься с элементарными основами, а потом берись за подобные программы.
Используй CanvasGadget и меньше ошибок наделаешь.
Пётр
Суть не в этом, просто использовал пример который был. Я могу прямо на окно рисовать вот так:
Procedure hDrawPoints(hWnd)
WindowSize.RECT
name.s = Space(100)
GetWindowRect_(hWnd, @WindowSize)
GetWindowText_(hWnd, @name, 100)
Width=WindowSize\Right - WindowSize\Left
Height=WindowSize\Bottom - WindowSize\Top
Left=WindowSize\Left
Top=WindowSize\Top
If LoadFont(1, "Arial", 8)
If StartDrawing(WindowOutput(hWnd))
DrawingMode(#PB_2DDrawing_Transparent)
Box(0, 0, Width, Height, RGB(245,245,245))
For i = 8 To Width Step 10
DrawingFont(FontID(1))
DrawText( i,-2, ".", RGB(55, 55, 55))
For j = 8 To Height Step 10
DrawingFont(FontID(1))
DrawText( i,j, ".", RGB(55, 55, 55))
Next
Next
StopDrawing()
EndIf
EndIf
EndProcedure
Procedure WinChildCallback(hWnd, Msg, wParam, lParam)У меня проблема в другом, на окне созданом на winApi не получается, а на purebasic работает. С Handle никак не могу разобратся.
Сначала ознакомься с элементарными основами, а потом берись за подобные программы.
почему ты так говоришь?
CreateGadgetList(hWnd) ButtonGadget(100,10,10,80,24,"Drьck mich")
так тоже не получается. Почему?
почему ты так говоришь?
Скажи сколько ImageGadget'ов будет создано в программе?
У меня проблема в другом, на окне созданом на winApi не получается
Все работает.
Procedure hDrawPoints(hWnd)
WindowSize.RECT
name.s = Space(100)
GetClientRect_(hWnd, @WindowSize)
GetWindowText_(hWnd, @name, 100)
Width=WindowSize\Right - WindowSize\Left
Height=WindowSize\Bottom - WindowSize\Top
Left=WindowSize\Left
Top=WindowSize\Top
If CreateImage(0, Width, Height) And StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_Transparent)
Box(0, 0, Width, Height, RGB(245,245,245))
For i = 8 To Width Step 10
DrawingFont(FontID(1))
DrawText( i,-2, ".", RGB(55, 55, 55))
For j = 8 To Height Step 10
DrawingFont(FontID(1))
DrawText( i,j, ".", RGB(55, 55, 55))
Next
Next
StopDrawing()
SetGadgetState(10, ImageID(0))
EndIf
EndProcedure
Procedure WinChildCallback(hWnd, Msg, wParam, lParam)
Select Msg
Case #WM_CREATE
UseGadgetList(hWnd)
ImageGadget(10, 0, 0, 200, 200, 0)
Case #WM_CLOSE
DestroyWindow_(hWnd)
Case #WM_DESTROY
PostQuitMessage_(0) : Result = 0
Case #WM_SIZE
hDrawPoints(hWnd)
RedrawWindow_(hWnd, 0, 0, #RDW_UPDATENOW|#RDW_UPDATENOW) ; Уменьшаем мерцания окна с помошью Api при изменении его размеров.
Default
Result = DefWindowProc_(hWnd, Msg, wParam, lParam)
EndSelect
ProcedureReturn Result
EndProcedure
Procedure WinChild(Class.s, x, y, width, height,Caption$,Win)
wc.WNDCLASSEX
wc\cbsize = SizeOf(WNDCLASSEX)
wc\lpfnWndProc = @WinChildCallback()
wc\hCursor = LoadCursor_(0, #IDC_ARROW)
wc\hbrBackground = #COLOR_WINDOW
wc\lpszClassName = @Class
RegisterClassEx_(@wc)
hWnd=CreateWindowEx_(0, Class, Caption$, #WS_SYSMENU | #WS_MINIMIZEBOX|#WS_MAXIMIZEBOX|#WS_SIZEBOX | #WS_CLIPCHILDREN | #WS_CLIPSIBLINGS, x, y, width, height, Win,0, 0, 0)
ProcedureReturn hWnd
EndProcedure
LoadFont(1, "Arial", 8)
hWnd = OpenWindow(0, 0, 0, 800, 600, "Средствами PureBasic - "+Chr(34)+" Главное окно "+Chr(34),#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
SetWindowLongPtr_(hWnd, #GWL_EXSTYLE, GetWindowLongPtr_(hWnd, #GWL_EXSTYLE)|#WS_EX_COMPOSITED)
hWnd1=WinChild("Win2", 0, 0, 280, 230, "Дочернее окно", hWnd)
SetParent_(hWnd1, hWnd)
HideWindow(0,0)
ShowWindow_(hWnd1, #SW_RESTORE)
Repeat
Event=WaitWindowEvent()
Until Event=#PB_Event_CloseWindowУ меня проблема в другом, на окне созданом на winApi не получается
вот это не знал
UseGadgetList(hWnd)
спасибо.
Теперь вот что, касается моего вопроса в начале поста
Почему дочерное окно, принимает отступ с верху и отступ с лева, главного окна при растягивании дочерного окна?
надо было добавить эту строку
SetWindowLongPtr_(WindowID(1), #GWL_STYLE, GetWindowLongPtr_(WindowID(1), #GWL_STYLE) | #WS_CHILD)
.
Всё бы хорошо, но окно не выделяется, то есть как будто не получает фокус. Как можно решить этот вопрос?
Отредактировано mestnyi (25.08.2013 14:45:00)
Пётр
У тебя аска есть? Хотел по аске вопросы задавать, там удобно.
не получает фокус.
SetWindowLongPtr_(WindowID(1), #GWL_STYLE, GetWindowLongPtr_(WindowID(1), #GWL_STYLE) | #WS_CHILD|#WS_POPUP)
Но можно обойтись без SetWindowLongPtr, если эти флаги добавить в OpenWindow.
Пётр
Но можно обойтись без SetWindowLongPtr, если эти флаги добавить в OpenWindow.
нет не работает
Разве?
OpenWindow(0, 0, 0, 800, 600, "Главное окно",#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered)
OpenWindow(1, 0, 0, 280, 60, "Дочернее окно",#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget| #WS_CHILD|#WS_POPUP, WindowID(0))
SetParent_(WindowID(1), WindowID(0))
HideWindow(0,0)
HideWindow(1,0)
Repeat
Event=WaitWindowEvent()
Until Event=#PB_Event_CloseWindowПётр
Разве?
Да , действительно работает. А я вот так проверил он не заработал.
OpenWindow(0, 0, 0, 800, 600, "Главное окно",#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered)
OpenWindow(1, 0, 0, 280, 60, "Дочернее окно",#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget| #WS_CHILD|#WS_POPUP)
SetParent_(WindowID(1), WindowID(0))
HideWindow(0,0)
HideWindow(1,0)
Repeat
Event=WaitWindowEvent()
Until Event=#PB_Event_CloseWindow; ---------------------------------------
;{- процедура для рисования точек
;----- процедура для рисования точек ----
; ---------------------------------------
Enumeration #PB_Compiler_EnumerationValue
#CanvasGadget
EndEnumeration
Procedure DrawPoints(Windows)
;
If IsWindow(Windows) ; Проверяем есть ли такое окно с "WindowID(Windows)"
;SetFocus_(WindowID(Windows)) ; Установыть фокус на окно с "WindowID(Windows)"
OldGadgetList = UseGadgetList(WindowID(Windows)) ; Выбирает окно с "WindowID(Windows)", к которому будут добавлятся гаджеты
If LoadFont(1, "Arial", 8) ; Получаем шрифт "Arial"
CanvasGadget(#CanvasGadget, 0, 0, WindowWidth(Windows), WindowHeight(Windows))
If StartDrawing(CanvasOutput(#CanvasGadget)) ; рисуем на канвасе.
DrawingMode(#PB_2DDrawing_Transparent); прозрачный режим
Box(0, 0, WindowWidth(Windows), WindowHeight(Windows), RGB(245,245,245))
For i = 8 To (WindowWidth(Windows)) Step 10
DrawingFont(FontID(1))
DrawText( i,-2, ".", RGB(55, 55, 55))
For j = 8 To (WindowHeight(Windows)) Step 10
DrawingFont(FontID(1))
DrawText( i,j, ".", RGB(55, 55, 55))
Next :Next
StopDrawing()
EndIf :EndIf
UseGadgetList(OldGadgetList) ; Возвращает WindowID предыдущего окна.
Else
MessageBox_(0,"В процедуре - DrawPoints"+#CRLF$+" (Window) - ID не указан,"+#CRLF$+"или указан не сушествующий - ID!","Сообщение",0)
EndIf
;Уменьшаем мерцания окна с помошью Api при изменении его размеров.
;RedrawWindow_(WindowID(Windows), 0, 0, #RDW_UPDATENOW|#RDW_ALLCHILDREN)
EndProcedure
;}---------------------------------------
; ---------------------------------------
OpenWindow(1,0,0,400,400,"Mega Mouse Selector",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible| #PB_Window_SizeGadget)
DrawPoints(1)
ButtonGadget(2,5,5,155,55,"ButtonGadget" )
HideWindow(1,0)
Repeat
Select WaitWindowEvent()
Case #PB_Event_SizeWindow
DrawPoints(1)
Case #PB_Event_CloseWindow
End
EndSelect
ForEverгаджет появляется только при наведении курсора, как это исправить?
Отредактировано mestnyi (27.08.2013 20:53:54)
Нужно создавать канвас при создании окна, а не при каждой прорисовке и нужно сделать его неактивным. Но канвас не очень дружит с другими гаджетами, которые располагают сверху него. В этом случае, лучше использовать ImageGadget.
; ---------------------------------------
;{- процедура для рисования точек
;----- процедура для рисования точек ----
; ---------------------------------------
Enumeration
#ImageGadget
EndEnumeration
Enumeration
#Image
EndEnumeration
Procedure DrawPoints(Windows)
;
If IsWindow(Windows) ; Проверяем есть ли такое окно с "WindowID(Windows)"
If CreateImage(#Image, WindowWidth(Windows), WindowHeight(Windows))
If StartDrawing(ImageOutput(#Image)) ; рисуем на канвасе.
DrawingMode(#PB_2DDrawing_Transparent); прозрачный режим
Box(0, 0, OutputWidth(), OutputHeight(), RGB(245,245,245))
For i = 8 To (WindowWidth(Windows)) Step 10
DrawingFont(FontID(1))
DrawText( i,-2, ".", RGB(55, 55, 55))
For j = 8 To (WindowHeight(Windows)) Step 10
DrawingFont(FontID(1))
DrawText( i,j, ".", RGB(55, 55, 55))
Next :Next
StopDrawing()
EndIf
EndIf
Else
MessageBox_(0,"В процедуре - DrawPoints"+#CRLF$+" (Window) - ID не указан,"+#CRLF$+"или указан не сушествующий - ID!","Сообщение",0)
EndIf
EndProcedure
;}---------------------------------------
; ---------------------------------------
LoadFont(1, "Arial", 8) ; Получаем шрифт "Arial"
OpenWindow(1,0,0,400,400,"Mega Mouse Selector",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible| #PB_Window_SizeGadget)
SmartWindowRefresh(1, 1)
DrawPoints(1)
ImageGadget(#ImageGadget, 0,0, WindowWidth(1), WindowHeight(1), ImageID(#Image))
UseGadgetList(GadgetID(#ImageGadget))
ButtonGadget(2,5,5,155,55,"ButtonGadget")
HideWindow(1,0)
Repeat
Select WaitWindowEvent()
Case #PB_Event_SizeWindow
DrawPoints(1)
SetGadgetState(#ImageGadget, ImageID(#Image))
Case #PB_Event_CloseWindow
End
EndSelect
ForEverПётр
вот так сделал, теперь никаких проблем, вот бы всё так хорошо получалось.
; ---------------------------------------
;{- процедура для рисования точек
;----- процедура для рисования точек ----
; ---------------------------------------
Procedure DrawPointsPlot(Window,distance=6)
Protected hDC,Arial,indent,size;,distance
Arial =LoadFont(#PB_Any, "Arial", 8) ; Получаем шрифт "Arial"
;distance = 5
size =2+distance
indent=-(9-distance)
hDC = CreateImage(#PB_Any, size, size)
If hDC
If StartDrawing(ImageOutput(hDC)) ; рисуем на канвасе.
DrawingMode(#PB_2DDrawing_Transparent); прозрачный режим
Box(0, 0, size, size, RGB(240,240,240))
DrawingFont(FontID(Arial))
DrawText( distance,indent, ".", RGB(0,0,0))
StopDrawing()
EndIf
EndIf
SetClassLongPtr_(WindowID(Window), #GCL_HBRBACKGROUND, CreatePatternBrush_(ImageID(hDC)))
InvalidateRect_(WindowID(Window), 0, 1)
EndProcedure
;}---------------------------------------
; ---------------------------------------
OpenWindow(1,0,0,400,400,"Mega Mouse Selector",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible| #PB_Window_SizeGadget)
DrawPointsPlot(1)
ButtonGadget(2,5,5,155,55,"ButtonGadget" )
HideWindow(1,0)
Repeat
Select WaitWindowEvent()
Case #PB_Event_SizeWindow
Case #PB_Event_CloseWindow
End
EndSelect
ForEverа не знаешь как нарисовать точку средствами winapi?
Лучше точку рисовать не текстом, а функцией Plot.
Plot(size/2, size/2, RGB(0,0,0))
нужно добавить scroll при увеличении размера дочерного окна. Как cделать это?
знаю что стил #WS_HSCROLL | #WS_VSCROLL добавляют скроллы. Пытался вот так
SetWindowLong_(WindowID(0), #GWL_STYLE, GetWindowLong_(WindowID(0), #GWL_STYLE)| #WS_HSCROLL | #WS_VSCROLL)
но не выходить.
вот так добавился
ShowScrollBar_(WindowID(0),#SB_VERT,#False)
#SB_VERT- горизонтальную добавляет, а #SB_HORZ -вертикальную
А как управлять ими?
Отредактировано mestnyi (05.10.2013 00:53:51)
hWnd = OpenWindow(0, 0, 0, 400, 100, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #WS_HSCROLL | #WS_VSCROLL) Repeat Event = WaitWindowEvent() Until Event = #PB_Event_CloseWindow
А как управлять ими?
В CB процедуре окна нужно обрабатывать события #WM_VSCROLL и #WM_HSCROLL.
Procedure WindowCallback(hWnd, Msg, wParam, lParam)
Result = #PB_ProcessPureBasicEvents
Scroll.SCROLLINFO
If Msg = #WM_VSCROLL Or Msg = #WM_HSCROLL
Scroll\cbSize = SizeOf(SCROLLINFO)
Scroll\fMask = #SIF_POS | #SIF_PAGE | #SIF_RANGE
If Msg = #WM_VSCROLL
GetScrollInfo_(hWnd, #SB_VERT, @Scroll)
Else
GetScrollInfo_(hWnd, #SB_HORZ, @Scroll)
EndIf
Select wParam & $FFFF
Case #SB_THUMBTRACK
nNewPos = (wParam>>16) & $FFFF
Case #SB_LINELEFT
nNewPos = Scroll\nPos - Scroll\nPage
Case #SB_LINERIGHT
nNewPos = Scroll\nPos + Scroll\nPage
Case #SB_PAGELEFT
nNewPos = Scroll\nPos - Scroll\nPage
Case #SB_PAGERIGHT
nNewPos = Scroll\nPos + Scroll\nPage
Default
ProcedureReturn 0
EndSelect
Scroll\fMask = #SIF_POS
Scroll\nPos = nNewPos
If Scroll\nPos<0
Scroll\nPos = 0
Pos=Scroll\nPos
ElseIf Scroll\nPos > Scroll\nMax-Scroll\nPage
Scroll\nPos=Scroll\nMax
Pos=Scroll\nPos-Scroll\nPage+1
Else
Pos=Scroll\nPos
EndIf
If Msg = #WM_VSCROLL
SetScrollInfo_(hWnd, #SB_VERT, @Scroll, #True)
Debug "VSCROLL "+Pos
Else
SetScrollInfo_(hWnd, #SB_HORZ, @Scroll, #True)
Debug "HSCROLL "+Pos
EndIf
Result = 0
EndIf
ProcedureReturn Result
EndProcedure
hWnd = OpenWindow(0, 0, 0, 400, 100, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered |
#WS_HSCROLL | #WS_VSCROLL)
SetWindowCallback(@WindowCallback(), 0)
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindowНо проще использовать ScrollAreaGadget().
знаю что стил #WS_HSCROLL | #WS_VSCROLL
а мне надо чтоб не постоянно они были только тогда когда "дочернее" окно срявняеться с "главним" окном. А если явно указать как ты сделал он же постоянно будет.
Но проще использовать ScrollAreaGadget().
Ты думаешь мне это гиморой нужен? С ним не получилось вот и перешел на это, вот пример того что не получилось.
Global DesktopMouse.POINT
OpenWindow(0, 0, 0, 800, 600, "Главное окно",#WS_EX_COMPOSITED |#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered)
ScrollAreaGadget(5, 0,0, 800, 600,0,0,0);,#WS_EX_COMPOSITED)
SetGadgetColor(5,#PB_Gadget_BackColor, RGB(239,0,239)) ; установить цветь фона
CloseGadgetList():HideGadget(5,1)
OpenWindow(1, 0, 0, 280, 60, "Дочернее окно",#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget| #WS_CHILD|#WS_POPUP, WindowID(0))
SetParent_(WindowID(1), WindowID(0))
HideWindow(0,0)
HideWindow(1,0)
SetParent_(WindowID(1), GadgetID(5)) :HideGadget(5,0); заменяем родительское окно заданного дочернего окна.
Repeat
Event=WaitWindowEvent()
Select Event
Case #WM_MOUSEMOVE
DesktopMouse\x=DesktopMouseX()-WindowX(0)
DesktopMouse\y=DesktopMouseY()-WindowY(0)
Case #WM_SIZE, #WM_MOVE
SetGadgetAttribute(5,#PB_ScrollArea_InnerWidth,DesktopMouse\x)
SetGadgetAttribute(5,#PB_ScrollArea_InnerHeight,DesktopMouse\y)
;RedrawWindow_(GadgetID(5), 0, 0, #RDW_UPDATENOW|#RDW_ALLCHILDREN) ; убирает мерцание #DesignerWindow
;InvalidateRect_(WindowID(1),0,1)
;UpdateWindow_(WindowID(1))
;InvalidateRect_(WindowID(0),0,1)
;UpdateWindow_(WindowID(0))
EndSelect
Until Event=#PB_Event_CloseWindowGlobal DesktopMouse.POINT
OpenWindow(0, 0, 0, 800, 600, "Главное окно",#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered)
ScrollAreaGadget(5, 0,0, 800, 600,0,0,0);, WindowID(0));,#WS_EX_COMPOSITED)
SetGadgetColor(5,#PB_Gadget_BackColor, RGB(239,0,239)) ; установить цветь фона
CloseGadgetList():HideGadget(5,1)
OpenWindow(1, 0, 0, 800, 600, "Дочернее окно",#WS_EX_COMPOSITED |#PB_Window_Invisible | #PB_Window_BorderLess |#WS_CHILD|#WS_POPUP, GadgetID(5))
OpenWindow(3, 0, 0, 280, 60, "Дочернее окно",#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget| #WS_CHILD|#WS_POPUP, WindowID(1))
HideWindow(0,0)
HideWindow(1,0)
HideWindow(3,0)
SetParent_(WindowID(1), GadgetID(5)) :HideGadget(5,0); заменяем родительское окно заданного дочернего окна.
SetParent_(WindowID(3), WindowID(1))
Repeat
Event=WaitWindowEvent()
Select Event
Case #WM_MOUSEMOVE
DesktopMouse\x=DesktopMouseX()-WindowX(0)
DesktopMouse\y=DesktopMouseY()-WindowY(0)
Case #WM_SIZE, #WM_MOVE
SetGadgetAttribute(5,#PB_ScrollArea_InnerWidth,DesktopMouse\x)
SetGadgetAttribute(5,#PB_ScrollArea_InnerHeight,DesktopMouse\y)
;RedrawWindow_(GadgetID(5), 0, 0, #RDW_UPDATENOW|#RDW_ALLCHILDREN) ; убирает мерцание #DesignerWindow
InvalidateRect_(WindowID(1),0,1)
UpdateWindow_(WindowID(1))
EndSelect
Until Event=#PB_Event_CloseWindowОтредактировано mestnyi (05.10.2013 13:33:21)
а мне надо чтоб не постоянно они были только тогда когда "дочернее" окно срявняеться с "главним" окном.
Проверяй выход дочернего окна за пределы родительского и если вышло, то отображай полосы прокрутки.
Проверяй выход дочернего окна за пределы родительского и если вышло, то отображай полосы прокрутки
. очень смешно.
Что смешного?
Это должно делать приложение, а не система.
Procedure WindowCallback(hWnd, Msg, wParam, lParam)
Result = #PB_ProcessPureBasicEvents
Scroll.SCROLLINFO
If Msg = #WM_VSCROLL Or Msg = #WM_HSCROLL
Scroll\cbSize = SizeOf(SCROLLINFO)
Scroll\fMask = #SIF_POS | #SIF_PAGE | #SIF_RANGE
If Msg = #WM_VSCROLL
GetScrollInfo_(hWnd, #SB_VERT, @Scroll)
Else
GetScrollInfo_(hWnd, #SB_HORZ, @Scroll)
EndIf
Select wParam & $FFFF
Case #SB_THUMBTRACK
nNewPos = (wParam>>16) & $FFFF
;Debug "#SB_THUMBTRACK"
Case #SB_LINELEFT
nNewPos = Scroll\nPos - Scroll\nPage
;Debug "#SB_LINELEFT"
Case #SB_LINERIGHT
nNewPos = Scroll\nPos + Scroll\nPage
;Debug "#SB_LINERIGHT"
Case #SB_LINEUP
nNewPos = Scroll\nPos - Scroll\nPage
Case #SB_LINEDOWN
nNewPos = Scroll\nPos + Scroll\nPage
Case #SB_PAGELEFT
nNewPos = Scroll\nPos - Scroll\nPage
;Debug "#SB_PAGELEFT"
Case #SB_PAGERIGHT
nNewPos = Scroll\nPos + Scroll\nPage
;Debug "#SB_PAGERIGHT"
Default
ProcedureReturn 0
EndSelect
Scroll\fMask = #SIF_POS
Scroll\nPos = nNewPos
;Debug nNewPos
If Scroll\nPos<0
Scroll\nPos = 0
Pos=Scroll\nPos
ElseIf Scroll\nPos > Scroll\nMax-Scroll\nPage
Scroll\nPos=Scroll\nMax
Pos=Scroll\nPos-Scroll\nPage+1
Else
Pos=Scroll\nPos
EndIf
If Msg = #WM_VSCROLL
SetScrollInfo_(hWnd, #SB_VERT, @Scroll, #True)
Debug "VSCROLL "+Pos
ScrollWindow_(WindowID(1), #Null, Pos,#Null , #Null)
Else
SetScrollInfo_(hWnd, #SB_HORZ, @Scroll, #True)
Debug "HSCROLL "+Pos
ScrollWindow_(WindowID(1), Pos, #Null,#Null , #Null)
EndIf
Result = 0
EndIf
ProcedureReturn Result
EndProcedure
OpenWindow(0, 0, 0, 800, 600, "Главное окно",#WS_EX_COMPOSITED |#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered | #WS_HSCROLL | #WS_VSCROLL)
OpenWindow(1, 0, 0, 280, 60, "Дочернее окно",#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget| #WS_CHILD|#WS_POPUP, WindowID(0))
SetParent_(WindowID(1), WindowID(0))
HideWindow(0,0)
HideWindow(1,0)
;SetWindowLong_(WindowID(0), #GWL_STYLE, GetWindowLong_(WindowID(0), #GWL_STYLE)| #WS_HSCROLL | #WS_VSCROLL)
;ShowScrollBar_(WindowID(0),#SB_HORZ,#False)
SetWindowCallback(@WindowCallback(), 0)
Repeat
Event=WaitWindowEvent()
Until Event=#PB_Event_CloseWindowне разберусь никак.
что задает (высоту, или сколько нужно прокрутить)?
Procedure WindowCallback(hWnd, Msg, wParam, lParam)
Result = #PB_ProcessPureBasicEvents
Scroll.SCROLLINFO
If Msg = #WM_VSCROLL Or Msg = #WM_HSCROLL
Scroll\cbSize = SizeOf(SCROLLINFO)
Scroll\fMask = #SIF_POS | #SIF_PAGE | #SIF_RANGE
If Msg = #WM_VSCROLL
GetScrollInfo_(hWnd, #SB_VERT, @Scroll)
Else
GetScrollInfo_(hWnd, #SB_HORZ, @Scroll)
EndIf
Select wParam & $FFFF
Case #SB_THUMBTRACK
nNewPos = (wParam>>16) & $FFFF
;Debug "#SB_THUMBTRACK"
Case #SB_LINELEFT
nNewPos = Scroll\nPos - Scroll\nPage
;Debug "#SB_LINELEFT"
Case #SB_LINERIGHT
nNewPos = Scroll\nPos + Scroll\nPage
;Debug "#SB_LINERIGHT"
Case #SB_LINEUP
nNewPos = Scroll\nPos - Scroll\nPage
Case #SB_LINEDOWN
nNewPos = Scroll\nPos + Scroll\nPage
Case #SB_PAGELEFT
nNewPos = Scroll\nPos - Scroll\nPage
;Debug "#SB_PAGELEFT"
Case #SB_PAGERIGHT
nNewPos = Scroll\nPos + Scroll\nPage
;Debug "#SB_PAGERIGHT"
Default
ProcedureReturn 0
EndSelect
Scroll\fMask = #SIF_POS
Scroll\nPos = nNewPos
;Debug nNewPos
If Scroll\nPos<0
Scroll\nPos = 0
Pos=Scroll\nPos
ElseIf Scroll\nPos > Scroll\nMax-Scroll\nPage
Scroll\nPos=Scroll\nMax
Pos=Scroll\nPos-Scroll\nPage+1
Else
Pos=Scroll\nPos
EndIf
If Msg = #WM_VSCROLL
SetScrollInfo_(hWnd, #SB_VERT, @Scroll, #True)
Debug "VSCROLL "+Pos
ScrollWindow_(WindowID(1), #Null, Pos,#Null , #Null)
Else
SetScrollInfo_(hWnd, #SB_HORZ, @Scroll, #True)
Debug "HSCROLL "+Pos
ScrollWindow_(WindowID(1), Pos, #Null,#Null , #Null)
EndIf
Result = 0
EndIf
ProcedureReturn Result
EndProcedure
hWnd=OpenWindow(0, 0, 0, 800, 600, "Главное окно",#WS_EX_COMPOSITED |#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered | #WS_HSCROLL | #WS_VSCROLL)
OpenWindow(1, 0, 0, 280, 60, "Дочернее окно",#PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget| #WS_CHILD|#WS_POPUP, WindowID(0))
SetParent_(WindowID(1), WindowID(0))
HideWindow(0,0)
HideWindow(1,0)
;SetWindowLong_(WindowID(0), #GWL_STYLE, GetWindowLong_(WindowID(0), #GWL_STYLE)| #WS_HSCROLL | #WS_VSCROLL)
;ShowScrollBar_(WindowID(0),#SB_HORZ,#False)
SetWindowCallback(@WindowCallback(), 0)
Scroll.SCROLLINFO
Scroll\cbSize = SizeOf(SCROLLINFO)
Scroll\fMask = #SIF_RANGE|#SIF_POS|#SIF_PAGE
Scroll\nMin = 0
Scroll\nMax = 334
Scroll\nPage = 10
Scroll\nPos = 0
SetScrollInfo_(hWnd,#SB_VERT,@Scroll,1)
EnableScrollBar_(hWnd,#SB_VERT,#ESB_ENABLE_BOTH)
SetScrollInfo_(hWnd,#SB_HORZ,@Scroll,1)
EnableScrollBar_(hWnd,#SB_HORZ,#ESB_ENABLE_BOTH)
Repeat
Event=WaitWindowEvent()
Until Event=#PB_Event_CloseWindowВы здесь » PureBasic - форум » Вопросы по PureBasic » Многооконное приложение