PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

managed windowed screen XP/vista/win7

https://www.purebasic.fr/english/viewtopic.php?t=43025

Page 1 of 1

managed windowed screen XP/vista/win7

Posted: Mon Jul 26, 2010 8:33 am
by idle
A managed Windowed Screen class
Resize,maximize,minimize,FullScreen,Restore
Non blocking control window

You need to utilize two procedures from within the class, these can be anywhere in your code
Procedure Controls(*this.ScreenEX)
Procedure DrawScene(*this.ScreenEX)

The Controls window is opened by the class so you only need to put your gadgets and event loop in it
and define it with "SetControlsWindow" before opening the windowed screen
(will probably change this in the next version as it was previously registering a callback which was no longer needed)

DrawScene procedure you only need to put in your drawing commands, the class calls it from the event loop

Code: Select all

;A Managed WindowedScreen Class
;Compile as Thread Safe 

;Resize,maximize,minimize,FullScreen,Restore
;Non blocking controls window

;There are two functions that need to be defined in you application 

;Procedure Controls(*this.mScreen)  :Gui controls  
;Procedure DrawScene(*this.mscreen) :the drawing code  


EnableExplicit 

Structure window 
  style.i
  left.i
  top.i
  width.i
  height.i
  window.i
  flags.i
  title.s
EndStructure 

Structure mScreen
  *vtable.i
  FullWidth.i
  FullHeight.i
  Width.i
  Height.i
  Hwnd.i
  WindowID.i
  ParentID.i
  bFullScreen.i
  bStretch.i
  Flipmode.i
  Flags.i
  Title.s
  Left.i
  Top.i
  Toggle.i
  Thread.i
  Screen.i
  Close.i
  LoadControls.i
  ControlThread.i
  *ControlLoop.i
  wnd.window
  Controls.window 
EndStructure   

Declare.i  OpenWindowedScreen_EX(*this.mScreen,left.i,top.i,width.i,height.i,title.s,flags=0,parentId=0,flipmode=0,stretch=0)
Declare.i  DestroyScreen_Ex(*this.mScreen)
Declare.i  FullScreen_EX(*this.mScreen)
Declare.i  ToggleFullScreenOn_EX(*this.mScreen,MouseButton.i)
Declare.i  StartDrawing_EX(*this.mScreen)
Declare.i  IsScreen_EX(*this.mScreen) 
Declare.i  ScreenCallBack_EX(hwnd,msg,wparam,lparam)
Declare.i  StopDrawing_EX(*this.mscreen)
Declare.i  ScreenWidth_EX(*this.mScreen)
Declare.i  ScreenHeight_EX(*this.mScreen)
Declare.i  SetControlsWindow_EX(*this.mScreen,left.i,top.i,width.i,height.i,title.s,flags.i=0,OpenWithButton.i=0,*LoopProcedure.i=0)
Declare.i  OpenControls_EX(*this.mScreen)
Declare.i  Controls(*this.mScreen)
Declare.i  DrawScene(*this.mscreen)

Interface ScreenEX 
  OpenWindowedScreen(left.i,top.i,width.i,height.i,title.s,flags.i=0,parentId.i=0,flipmode.i=0,stretch.i=0)
  DestroyScreen()
  FullScreen()
  SetToggleFullScreenOn(MouseButton.i)
  IsScreen()
  Width()
  Height()
  SetControlsWindow(left.i,top.i,width.i,height.i,title.s,flags.i=0,OpenWithButton.i=0,*LoopProcedure.i=0)
  OpenControlWindow(*this.mScreen)
EndInterface 

Global myScreen.ScreenEx

Procedure ScreenWidth_EX(*this.mScreen)
  If *this\bStretch = 0
    *this\width = WindowWidth(*this\WindowID)
    ProcedureReturn *this\width
  Else 
    ProcedureReturn *this\FullWidth
  EndIf   
EndProcedure 

Procedure ScreenHeight_EX(*this.mScreen)
  If *this\bStretch = 0
    *this\Height = WindowHeight(*this\WindowID)
    ProcedureReturn *this\Height
  Else 
    ProcedureReturn *this\FullHeight
  EndIf     
EndProcedure 

Procedure ToggleFullScreenOn_EX(*this.mScreen,MouseButton.i)
  If mousebutton = #PB_MouseButton_Left
    *this\toggle = #WM_LBUTTONDOWN
  ElseIf MouseButton = #PB_MouseButton_Right 
    *this\toggle = #WM_RBUTTONDOWN 
  EndIf   
EndProcedure 

Procedure Screen_EX(*this.mScreen)
  Protected Event.i,EventWindow.i,bclose.i
  *this\windowID = OpenWindow(#PB_Any,*this\left,*this\top,*this\width,*this\height,*this\title,*this\flags,*this\parentID)
  *this\hwnd = WindowID(*this\windowID)
  *this\screen = OpenWindowedScreen(*this\hwnd,0,0,*this\FullWidth,*this\FullHeight,*this\bstretch,0,0,*this\flipmode)
    
  If *this\hwnd  And *this\screen 
    
     Repeat 
       
       DrawScene(*this)
    
       Repeat  
                          
         Event = WindowEvent()  
         EventWindow = EventWindow()
         If EventWindow = *this\WindowID       
           
             Select Event   
                 
             Case #WM_RBUTTONDOWN  
               
               If *this\toggle = #WM_RBUTTONDOWN 
                 FullScreen_EX(*this)
               EndIf
               If *this\loadControls = #WM_RBUTTONDOWN 
                 If Not IsThread(*this\Controlthread)
                    OpenControls_EX(*this)
                 EndIf   
               EndIf   
             Case #WM_LBUTTONDOWN  
               If *this\loadControls = #WM_LBUTTONDOWN 
                 If Not IsThread(*this\Controlthread)
                    OpenControls_EX(*this)
                 EndIf   
               EndIf     
               If *this\toggle = #WM_LBUTTONDOWN 
                 FullScreen_EX(*this)
               EndIf       
             Case #PB_Event_CloseWindow   
              *this\screen=0
              bclose = 1 
            EndSelect 
        EndIf  
                
      Until Event = 0 
      
    Until bclose =1 
         
   EndIf 
   
   CloseScreen()
   
EndProcedure

Procedure OpenWindowedScreen_EX(*this.mScreen,left.i,top.i,width.i,height.i,title.s,flags.i=0,parentId.i=0,flipmode.i=0,stretch.i=0)
  Protected timeout.i
  If InitSprite() And InitSprite3D()
    
    ExamineDesktops()
    *this\FullWidth = DesktopWidth(0)
    *this\FullHeight = DesktopHeight(0)
    *this\left = left 
    *this\top = top 
    *this\ParentID = parentID
    *this\flipmode = flipmode
    *this\bstretch= stretch
    *this\Width = width
    *this\Height = Height
    *this\title = title 
    
    If Flags = 0 
      *this\flags = #PB_Window_SizeGadget | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget |#PB_Window_MaximizeGadget | #PB_Window_ScreenCentered
    Else 
      *this\flags = flags 
    EndIf 
    
    If *this\Width <> *this\FullWidth 
      *this\bFullScreen = #False
    Else 
      *this\bFullScreen = #True
    EndIf   
    
    If stretch = 1
      *this\FullWidth = width
      *this\FullHeight = height
    EndIf 
    
    *this\thread = CreateThread(@Screen_EX(),*this)
    timeout = ElapsedMilliseconds()+1000 
    While Not *this\screen Or ElapsedMilliseconds() > timeout  
       Delay(20)
    Wend
    
    WaitThread(*this\Thread) 
       
    ProcedureReturn 1
   
Else 
  ProcedureReturn 0

EndIf     

EndProcedure 

Procedure DestroyScreen_Ex(*this.mScreen)
  If *this 
    If *this\Screen
      *this\screen = 0
      CloseScreen()
      CloseWindow(*this\WindowID)
    EndIf   
    
    ClearStructure(*this,mScreen)
    FreeMemory(*this)
    *this = 0   
  EndIf   
EndProcedure   

Procedure IsScreen_EX(*this.mScreen) 
  If *this\screen  
    ProcedureReturn 1
  Else 
    ProcedureReturn 0
  EndIf  
EndProcedure 

Procedure FullScreen_EX(*this.mScreen)
  Protected rc.rect 
  
  *this\bFullScreen ! 1
  
  If IsWindow(*this\windowID)
    
    If *this\bFullScreen = #True  
      GetWindowRect_(*this\hwnd,@rc)
      *this\wnd\Style=GetWindowLong_(*this\hwnd,#GWL_STYLE)
      *this\wnd\left=rc\left  
      *this\wnd\top=rc\top ; 
      *this\wnd\width=rc\right - rc\left  
      *this\wnd\height=rc\bottom - rc\top  
      SetWindowLong_(*this\hwnd,#GWL_STYLE,#WS_POPUP)
      SetWindowPos_(*this\hwnd,#HWND_TOP,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE|#SWP_NOZORDER|#SWP_FRAMECHANGED)
      ShowWindow_(*this\hwnd,#SW_MAXIMIZE)
       
    ElseIf *this\bFullScreen = #False  
      SetWindowLong_(*this\hwnd,#GWL_STYLE,*this\wnd\style)
      SetWindowPos_(*this\hwnd,#HWND_NOTOPMOST,*this\wnd\left,*this\wnd\top,*this\wnd\width,*this\wnd\height,#SWP_FRAMECHANGED)
      ShowWindow_(*this\hwnd,#SW_NORMAL)
      
    EndIf
       
 EndIf   
  
EndProcedure

Procedure OpenControls_EX(*this.mScreen)
  If *this\ControlLoop <> 0 
    If Not IsThread(*this\Controlthread)
       *this\Controlthread = CreateThread(*this\ControlLoop,*this)
    EndIf 
  EndIf 
EndProcedure   

Procedure SetControlsWindow_EX(*this.mScreen,left.i,top.i,width.i,height.i,title.s,flags.i=0,OpenWithButton.i=0,*LoopProcedure.i=0)
  
 If flags = 0 
    *this\controls\flags = #PB_Window_WindowCentered| #PB_Window_SystemMenu | #PB_Window_TitleBar
 EndIf   
 
 If OpenWithButton = #PB_MouseButton_Right 
   *this\LoadControls = #WM_RBUTTONDOWN
 ElseIf OpenWithButton = #PB_MouseButton_Left
   *this\LoadControls = #WM_LBUTTONDOWN
 EndIf 
 *this\ControlLoop = @Controls()
 *this\controls\left = left
 *this\controls\top = top
 *this\controls\width = width 
 *this\controls\height = height
 *this\controls\title = title
   
EndProcedure 


Procedure New_ScreenEx(*obj.mScreen)
  *obj = AllocateMemory(SizeOf(mScreen))
  If *obj
    *obj\vtable=?vt_ScreenEx
  EndIf
  ProcedureReturn *obj 
EndProcedure  

DataSection: 
  vt_ScreenEx: 
  Data.i @OpenWindowedScreen_EX()
  Data.i @DestroyScreen_EX()
  Data.i @FullScreen_EX()
  Data.i @ToggleFullScreenOn_EX()
  Data.i @IsScreen_EX() 
  Data.i @ScreenWidth_EX()
  Data.i @ScreenHeight_EX()
  Data.i @SetControlsWindow_EX()
  Data.i @OpenControls_EX()
EndDataSection  
;########################End of PBI################################## 

;Sample app
;left click pops up Gui 
;Right click toggles Full Screen 
Structure star
   speed.f
   x.f
   y.f
EndStructure 
Global Dim stars.Star(3000)
Declare Reset()
#D3DBLEND_SRCALPHA        = 5
#D3DBLEND_SRCCOLOR        = 3
#D3DBLEND_ONE             = 2
Global gr.f=1.0,gg.f=0.6,gb.f=0.2,ss.i=32,gRedo,gBlend,gain.f=1.0 
 
;###################### Default GUI Control Procedure ############### 
;The control gui is managed by the class
;The window is set up by calling the "SetControlsWindow" member 
Procedure Controls(*this.mScreen)
 
 *this\controls\window = OpenWindow(#PB_Any,*this\controls\left,*this\controls\top,*this\controls\width,*this\controls\height,*this\controls\title,*this\controls\flags,*this\hwnd)
 
 ;Your Gadgets and GUI controls here 
 Protected Event.i,EventGadget.i,EventWindow.i,bClose.i 
 Protected ButOK.i,slsize,slr,slg,slb,chkB,sla
 
 ButOK = ButtonGadget(#PB_Any,10,10,60,20,"Ok")
 chkB = CheckBoxGadget(#PB_Any,100,10,60,20,"Blend")
 slsize = TrackBarGadget(#PB_Any,45,40,160,20,2,64)
 slr = TrackBarGadget(#PB_Any,45,70,160,20,1,255) 
 slg = TrackBarGadget(#PB_Any,45,100,160,20,1,255) 
 slb = TrackBarGadget(#PB_Any,45,130,160,20,1,255) 
 sla = TrackBarGadget(#PB_Any,45,160,160,20,1,255) 
 
 TextGadget(#PB_Any,10,40,40,20,"Size")
 TextGadget(#PB_Any,10,65,40,20,"Red")
 TextGadget(#PB_Any,10,95,40,20,"Green")
 TextGadget(#PB_Any,10,125,40,20,"Blue")
 TextGadget(#PB_Any,10,155,40,20,"Gain")
 
 SetGadgetState(slsize,64)
 SetGadgetState(slr,255)
 SetGadgetState(slg,153)
 SetGadgetState(slb,51)
 SetGadgetState(sla,255)
 Repeat 
   
   Event = WaitWindowEvent()
   EventWindow = EventWindow() 
   EventGadget = EventGadget()
   
   If EventWindow = *this\Controls\window
     
     Select Event
      Case #PB_Event_Gadget
        Select EventGadget 
          Case ButOK 
            MessageRequester("WindowedScreenEx","ReNova")
          Case slsize 
            ss = GetGadgetState(slsize)
            gredo=1
          Case slr
            gr = GetGadgetState(slr) / 255.0
            gredo=1
          Case slg
            gg = GetGadgetState(slg) / 255.0
            gredo=1
          Case slb
            gb = GetGadgetState(slb) / 255.0
            gredo=1
          Case chkB 
            gBlend = GetGadgetState(chkB) ! 0
          Case sla
            gain = GetGadgetState(sla) * 0.0039
            gredo=1  
       EndSelect      
     Case #PB_Event_CloseWindow 
       bClose=1   
     EndSelect
   
   EndIf 
   
 Until bClose = 1  
 
EndProcedure 

;###################### ScreenEX Default Drawing Procedure ###############
;all your drawing stuff in here 
Procedure DrawScene(*this.mscreen)
 Static sP1,sPR,ux,uy,uz,hc.i,ef.f=65.0
 Protected iy,ix,iyy.f,dr.f,cts
 Protected dx.f,dy.f,dz.f,cx,cy,mx.f,speed.i,px.i,py.i
 
 If Not IsSprite(sP1) Or gRedo Or gBlend
    gredo=0
    If gBlend 
      ux = (Random(1)+1) << 4
    Else 
      ux = ss
    EndIf   
      uz = ux/2
    uy = 256 / ux
    If IsSprite(sP1)
      FreeSprite(sP1)
      FreeSprite3D(sPR)
    EndIf   
    sP1=CreateSprite(#PB_Any,ux,ux,#PB_Sprite_Texture | #PB_Sprite_AlphaBlending )
    sPR=CreateSprite3D(#PB_Any,sP1)
    StartDrawing(SpriteOutput(sP1));
        
      For iy = -uz To uz
        iyy = iY * iY
        For ix = -uz To uz
         dr = Sqr(ix * ix + iyy )  
         If dr < uz
            dr = (uz - dr) * uy
            Plot(uz+ix,uz+iy,RGB(dr*gr*gain,dr*gg*gain,dr*gb*gain))
         EndIf
        Next
      Next
   
      StopDrawing()
 EndIf
 
 If Not gblend   
  ClearScreen(0)
 EndIf  
 
 If Start3D()
    Sprite3DQuality(#PB_Sprite3D_BilinearFiltering)    
    Sprite3DBlendingMode (#D3DBLEND_SRCCOLOR,#D3DBLEND_ONE)
    ;need to update the width so currently call the raw function     
    cx = (ScreenWidth_EX(*this) * 0.5) - uz
    cy = (ScreenHeight_EX(*this) * 0.5)- uz
        
    While cts < 3000
      dx = stars(cts)\x  
      dy = stars(cts)\y   
      dz = Sqr(dx*dx+dy*dy) 
      If dz = 0 : dz = 1 : EndIf   
      mx = (stars(cts)\speed * dz)
      px = (cx + (Sin(dx) + Cos(dy)) * mx)   
      py = (cy + (Cos(dx) - Sin(dy)) * mx)
      stars(cts)\x + (px/ef) 
      stars(cts)\y + (py/ef) 
      stars(cts)\speed + 1/dz   
      
      DisplaySprite3D(sPR,px,py,128)
      
      If px > *this\Width*1.5 Or py > *this\height*1.5 
        stars(cts)\x = Random(*this\width)
        stars(cts)\y = Random(*this\height)
        stars(cts)\speed = 1/Sqr(stars(cts)\x*stars(cts)\x + stars(cts)\y*stars(cts)\y)
        hc+1 
        If hc > 500 
          Reset()
          ef = Random(1000)-500
          hc=0
        EndIf   
      EndIf   
      cts+1
    Wend    
    Stop3D()
  EndIf   
  
  FlipBuffers()
  Delay(1) 
  
EndProcedure   

Procedure Reset()
  Protected ct1
  ct1 = 0
  While ct1 < 3000
    stars(ct1)\x = Random(3000)
    stars(ct1)\y = Random(3000)
    stars(ct1)\speed = 1/Sqr(stars(ct1)\x*stars(ct1)\x + stars(ct1)\y*stars(ct1)\y)
    ct1+1
  Wend 
    
EndProcedure   

reset()

;set instance of ScreenEx
myScreen.ScreenEx = New_ScreenEx(@myScreen)
;set fullscreen toggle 
MyScreen\SetToggleFullScreenOn(#PB_MouseButton_Right)  
; set up a control gui 
MyScreen\SetControlsWindow(0,0,270,200,"Controls",0,#PB_MouseButton_Left)
;open a windowed screen 
If MyScreen\OpenWindowedScreen(0,0,600,480,"Renova",0,0,#PB_Screen_SmartSynchronization,0)
   myScreen\DestroyScreen()  
EndIf    

Debug "ended"

Re: managed windowed screen

Posted: Mon Jul 26, 2010 9:23 am
by moogle
Doesn't show a windowedscreen just window and gives

Code: Select all

[09:20:53]
[09:22:09] [ERROR] Line: 339
[09:22:09] [ERROR] Invalid memory access. (read error at address 8)
when I close it, PB 4.51 (RC1) x86, Vista x64 SP2

Re: managed windowed screen

Posted: Mon Jul 26, 2010 5:45 pm
by idle
not sure what the issue could be on vista, did you compile it as thread safe?
or maybe it's an issue with the desktop composition.

Code: Select all

Procedure DWMEnableDisable(onoff.l)
  Protected *pAfunc,Lib = LoadLibrary_("dwmapi.dll")

  If Lib
    *pAfunc = GetProcAddress_(Lib, "DwmEnableComposition") 
    If *pAfunc
        CallFunctionFast(*pAfunc, onoff) 
    EndIf 
    FreeLibrary_(Lib) 
  EndIf
EndProcedure

Re: managed windowed screen

Posted: Mon Jul 26, 2010 6:35 pm
by moogle
idle wrote:not sure what the issue could be on vista, did you compile it as thread safe?
Yeah I had threadsafe on, it shows the screen sometimes now but still an error

Code: Select all

[18:32:57] Waiting for executable to start...
[18:32:57] Executable type: Windows - x86  (32bit)
[18:32:57] Executable started.
[18:33:02] [ERROR] Line: 340
[18:33:02] [ERROR] Invalid memory access. (read error at address 8)
[18:33:02] The Program execution has finished.
and sometimes when rightclicking it will work or sometimes lose the windowedscreen.

Re: managed windowed screen

Posted: Mon Jul 26, 2010 7:07 pm
by idle
I've just rehashed it to keep the drawing and eventloop in the same thread.

Re: managed windowed screen

Posted: Mon Jul 26, 2010 7:48 pm
by moogle
seems to work fine now :)

Re: managed windowed screen

Posted: Mon Jul 26, 2010 10:32 pm
by netmaestro
Works fine here on Windows 7 8)

Re: managed windowed screen XP/vista/win7

Posted: Tue Jul 27, 2010 4:34 am
by idle
Thanks for testing guys. :)
edited and added a demo

one issue when you restore from full screen the restored window is shrinking and I can't see why.
maybe I need to query system metrics for the borders and title bar height.

Re: managed windowed screen XP/vista/win7

Posted: Tue Jul 27, 2010 6:10 pm
by Kwai chang caine
Hello IDLE....very nice effect :shock:
Works fine on VISTA :wink:
Thanks for sharing 8)
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited