PureBasic Forums - English

Code: Select all

;:=============================================================================
;:- CustomPopupWindow.pbi
;:- Author          : Eddy
;:- Date            : September 1, 2013
;:- Compiler        : PureBasic 5.20 beta 15
;:- Target OS       : Windows
;:- Source --------------------------------------------------------------------
;:- http://www.purebasic.fr/english/viewtopic.php?f=40&t=56381
;:=============================================================================
EnableExplicit

Procedure.i PopupWindowCustomCallback(hWnd, message, wParam, lParam)
   
   If GetProp_(hWnd, "PurebasicPopupWindowCustomCallback")
      Protected PopupWindow=GetProp_(hWnd, "PB_WindowID")-1
      Protected *PopupWindowCallback=GetProp_(hWnd, "PurebasicPopupWindowCustomCallback")
      Select message
         Case #WM_NCACTIVATE
            ;detect if focus will be lost
            If wparam=0 : PostMessage_(hWnd, #WM_SHOWWINDOW, 0, 0) : EndIf
            
         Case #WM_SHOWWINDOW
            If wparam=0
               ;auto close popup window
               SetWindowLongPtr_(hWnd, #GWL_HWNDPARENT, 0)
               ShowWindow_(hWnd, #SW_HIDE)
               
               ;retore parent window behavior
               Protected *ParentWindow=GetProp_(hWnd, "ParentWindow")
               If *ParentWindow
                  SetWindowLongPtr_(*ParentWindow, #GWL_WNDPROC, GetProp_(*ParentWindow, "PurebasicPopupWindowParentCallback"))
                  RemoveProp_(*ParentWindow, "PurebasicPopupWindowParentCallback")
               EndIf
            EndIf
      EndSelect
      
      ProcedureReturn CallWindowProc_(*PopupWindowCallback, hWnd, message, wParam, lParam)
   EndIf
   
   If GetProp_(hWnd, "PurebasicPopupWindowParentCallback")   
      Protected *ParentWindowCallback=GetProp_(hWnd, "PurebasicPopupWindowParentCallback")   
      Select message
         Case #WM_NCACTIVATE
            ;disallow inactive titlebar drawing
            If wparam=0 : ProcedureReturn 1 : EndIf
      EndSelect
      
      ProcedureReturn CallWindowProc_(*ParentWindowCallback, hWnd, message, wParam, lParam)
   EndIf 
EndProcedure

Procedure.i CreatePopupWindow(PopupWindow, Animated=#True, GrabFocus=#False)
   Protected parent=OpenWindow(#PB_Any, 0, 0, 0, 0, "", #PB_Window_Invisible)
   Protected result=OpenWindow(PopupWindow, 0, 0, 200, 200, "Purebasic Custom Popup Window",
                               #PB_Window_BorderLess|#PB_Window_ScreenCentered|#PB_Window_NoActivate|#PB_Window_Invisible,
                               WindowID(parent))
   If PopupWindow=#PB_Any : PopupWindow=result : EndIf
   
   ;enable drop shadow style
   Protected *PopupWindow=WindowID(PopupWindow)
   SetClassLongPtr_(*PopupWindow, #GCL_STYLE, GetClassLongPtr_(*PopupWindow, #GCL_STYLE)|#CS_DROPSHADOW)
   
   ;enable popup behavior
   StickyWindow(PopupWindow, 1)
   SetProp_(*PopupWindow, "PurebasicPopupWindowCustomCallback", SetWindowLongPtr_(*PopupWindow, #GWL_WNDPROC, @PopupWindowCustomCallback()))
   
   SetProp_(*PopupWindow, "Animated", Animated)
   SetProp_(*PopupWindow, "GrabFocus", GrabFocus)
   
   ProcedureReturn result
EndProcedure

Procedure DisplayPopupWindow(PopupWindow, *WindowID, x=#PB_Ignore, y=#PB_Ignore, Width=#PB_Ignore, Height=#PB_Ignore)
   Protected *PopupWindow=WindowID(PopupWindow)
   Protected Animated=GetProp_(*PopupWindow, "Animated")
   Protected GrabFocus=GetProp_(*PopupWindow, "GrabFocus")
   
   If x=#PB_Ignore : x=DesktopMouseX() : EndIf
   If y=#PB_Ignore : y=DesktopMouseY() : EndIf
   
   ;control parent window behavior
   If GetProp_(*WindowID, "PurebasicPopupWindowParentCallback")=0 ;And GrabFocus=#False
      SetProp_(*PopupWindow, "ParentWindow", *WindowID)
      SetProp_(*WindowID, "PurebasicPopupWindowParentCallback", SetWindowLongPtr_(*WindowID, #GWL_WNDPROC, @PopupWindowCustomCallback()))
   EndIf
   
   ;reset popup window position and visibility
   HideWindow(PopupWindow, 1)
   SetWindowLongPtr_(*PopupWindow, #GWL_HWNDPARENT, *PopupWindow)
   ResizeWindow(PopupWindow, x, y, Width, Height)
   
   If Animated
      ;show inactive popup window with "fade-in" animation
      AnimateWindow_(*PopupWindow, 0, #AW_HIDE)
      AnimateWindow_(*PopupWindow, 500, #AW_BLEND|#AW_ACTIVATE)
   Else
      ;show inactive popup window
      HideWindow(PopupWindow, 0)
   EndIf
EndProcedure


CompilerIf #PB_Compiler_IsMainFile
   DisableExplicit
   
   ; ***************************************
   ; EXAMPLE 1 - custom popup menu
   ; ***************************************
   
   PopupWindow=CreatePopupWindow(#PB_Any)
   If IsWindow(PopupWindow)
      StringGadget(222, 5, 5, 150, 20, "Test...")
      ButtonGadget(111, 5, 30, 150, 20, "Ok")
      CanvasGadget(1, 5, 55, 150, 120)      
   EndIf
   
   SecondaryWindow=OpenWindow(#PB_Any, 440, 400, 500, 200, "Main Window", #PB_Window_SystemMenu)
   
   MainWindow=OpenWindow(#PB_Any, 0, 0, 300, 400, "Main Window", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   If IsWindow(MainWindow)
      SetWindowColor(MainWindow, RGB(131, 131, 182))
      
      txt=TextGadget(#PB_Any, 5, 5, WindowWidth(MainWindow), 100, "Right-click here to display popup window...")
      SetGadgetFont(txt, LoadFont(0, "Arial", 24, #PB_Font_Bold|#PB_Font_Italic|#PB_Font_HighQuality))
      SetGadgetColor(txt, #PB_Gadget_BackColor, GetWindowColor(MainWindow))
      SetGadgetColor(txt, #PB_Gadget_FrontColor, RGB(214, 189, 212))
   EndIf
   
   Repeat
      Select WaitWindowEvent()
         Case #PB_Event_ActivateWindow
         Case #PB_Event_DeactivateWindow
            
         Case #PB_Event_Gadget
            If EventGadget()=1
               StartDrawing(CanvasOutput(1))
               Plot(Random(100), Random(100), #Red)
               StopDrawing()
            EndIf
            
         Case #PB_Event_CloseWindow
            If EventWindow()=MainWindow
               Break
            ElseIf EventWindow()=SecondaryWindow
               CloseWindow(EventWindow())
            EndIf 
            
         Case #PB_Event_RightClick
            If EventWindow()=MainWindow
               DisplayPopupWindow(PopupWindow, WindowID(MainWindow))
            EndIf
      EndSelect
   ForEver   
CompilerEndIf

Code: Select all

;:=============================================================================
;:- CustomPopupWindow.pbi
;:- Author          : Eddy (modified by Bisonte)
;:- Date            : September 1, 2013 (modified: September 2, 2013)
;:- Compiler        : PureBasic 5.20 beta 15
;:- Target OS       : Windows
;:- Source --------------------------------------------------------------------
;:- http://www.purebasic.fr/english/viewtopic.php?f=40&t=56381
;:=============================================================================
DeclareModule Eddy_CPW ; Eddy's Custom PopupWindow
  
  Declare DisplayPopupWindow(PopupWindow, WindowID, x=#PB_Ignore, y=#PB_Ignore, Width=#PB_Ignore, Height=#PB_Ignore)
  Declare CreatePopupWindow(PopupWindow, Width = 200, Height = 200, Animated = #True, GrabFocus = #False)
  
EndDeclareModule
Module        Eddy_CPW
  
  DataSection
    CompilerIf Defined(CLSID_TaskBarList, #PB_Label) = #False
      CLSID_TaskBarList:
      Data.l $56FDF344
      Data.w $FD6D, $11D0
      Data.b $95, $8A, $00, $60, $97, $C9, $A0, $90
    CompilerEndIf
    CompilerIf Defined(IID_ITaskBarList, #PB_Label) = #False
      IID_ITaskBarList:
      Data.l $56FDF342
      Data.w $FD6D, $11D0
      Data.b $95, $8A, $00, $60, $97, $C9, $A0, $90
    CompilerEndIf 
  EndDataSection 
  
  EnableExplicit
  
  #PROP_EDDY_POPUPWINDOW = "EDDY:POPUPWINDOW"
  #PROP_EDDY_POPUPPARENT = "EDDY:POPUPPARENT"
  
  Structure struct_popup_window_data
    Window.i      ; PB Window
    OldProc.i     ; Default Callback
    PWindow.i     ; Parent WindowID
    PCallBack.i   ; Parent CallBack
    Animated.i    ; Anim Flag
    GrabFocus.i   ; GrabFocus Flag
  EndStructure
  
  Procedure HideWindowFromTaskBar(Window, State)
    
    Protected TBL.ITaskbarList
    Protected Result = #False
    Protected hWnd = WindowID(Window)
    
    If hWnd
      
      CoInitialize_(0)
      
      If CoCreateInstance_(?CLSID_TaskBarList, 0, 1, ?IID_ITaskBarList, @TBL) = #S_OK
        TBL\HrInit()
        If State
          TBL\DeleteTab(hWnd)
        Else
          TBL\AddTab(hWnd)
        EndIf
        TBL\Release()
      EndIf
      
      CoUninitialize_()
      Result = #True
      
    EndIf
    
    ProcedureReturn Result
    
  EndProcedure
  
  Procedure PopupWindowCustomCallback(hWnd, uMsg, wParam, lParam)
    
    Protected *p.struct_popup_window_data = GetProp_(hWnd, #PROP_EDDY_POPUPWINDOW)
    Protected ParentOldProc = GetProp_(hWnd, #PROP_EDDY_POPUPPARENT)
    Protected OldProc
    
    If *p ; If this is the popupwindow
      OldProc = *p\OldProc
      Select uMsg
        Case #WM_NCACTIVATE
          ;detect if focus will be lost
          If wParam = 0 : PostMessage_(hWnd, #WM_SHOWWINDOW, 0, 0) : EndIf          
          
        Case #WM_SHOWWINDOW
          If wParam = 0
            ;auto close popup window
            SetWindowLongPtr_(hWnd, #GWL_HWNDPARENT, 0)
            ShowWindow_(hWnd, #SW_HIDE)
            
            If IsWindow_(*p\PWindow)
              SetWindowLongPtr_(*p\PWindow, #GWL_WNDPROC, GetProp_(*p\PWindow, #PROP_EDDY_POPUPPARENT))
              RemoveProp_(*p\Window, #PROP_EDDY_POPUPPARENT)
            EndIf
          EndIf
          
        Case #WM_DESTROY
          FreeMemory(*p)
          RemoveProp_(hWnd, #PROP_EDDY_POPUPWINDOW)
          
      EndSelect
      
      If OldProc
        ProcedureReturn CallWindowProc_(OldProc, hWnd, uMsg, wParam, lParam)
      Else
        ProcedureReturn 0
      EndIf
      
    EndIf
    
    If ParentOldProc ; If this is the ParentWindow
      Select uMsg
        Case #WM_NCACTIVATE
          ;disallow inactive titlebar drawing
          If wParam = 0 : ProcedureReturn 1 : EndIf
      EndSelect
      ProcedureReturn CallWindowProc_(ParentOldProc, hWnd, uMsg, wParam, lParam)
    EndIf 
    
  EndProcedure
  Procedure DisplayPopupWindow(PopupWindow, WindowID, x=#PB_Ignore, y=#PB_Ignore, Width=#PB_Ignore, Height=#PB_Ignore)
    
    Protected hWnd, *p.struct_popup_window_data
    
    ; --- if not exist - leave
    If Not IsWindow(PopupWindow) : ProcedureReturn #False : EndIf
    If Not IsWindow_(WindowID) : ProcedureReturn #False : EndIf
    
    hWnd = WindowID(PopupWindow)
    
    ; --- where the window show by default
    If x = #PB_Ignore : x = DesktopMouseX() : EndIf
    If y = #PB_Ignore : y = DesktopMouseY() : EndIf
    
    ; --- get the datas and leave if its not "Eddy's PopupWindow"
    *p = GetProp_(hWnd, #PROP_EDDY_POPUPWINDOW)
    If Not *p : ProcedureReturn #False : EndIf
    
    ; --- If no parentwindow is defined
    If *p\PCallBack = 0
      *p\PWindow = WindowID
      SetProp_(WindowID, #PROP_EDDY_POPUPPARENT, SetWindowLongPtr_(WindowID, #GWL_WNDPROC, @PopupWindowCustomCallback()))
    EndIf
    
    ;reset popup window position and visibility
    HideWindow(*p\Window, 1)
    SetWindowLongPtr_(hWnd, #GWL_HWNDPARENT, hWnd)
    ResizeWindow(*p\Window, x, y, Width, Height)
    
    If *p\Animated
      ;show inactive popup window with "fade-in" animation
      AnimateWindow_(hWnd, 0, #AW_HIDE)
      AnimateWindow_(hWnd, 500, #AW_BLEND|#AW_ACTIVATE)
    Else
      ;show inactive popup window
      HideWindow(*p\Window, 0)
    EndIf
  
  EndProcedure
  Procedure CreatePopupWindow(PopupWindow, Width = 200, Height = 200, Animated = #True, GrabFocus = #False)
    
    Protected Result, hWnd, *p.struct_popup_window_data = AllocateMemory(SizeOf(struct_popup_window_data))
    
    ; --- no memory - leave
    If Not *p : ProcedureReturn #False : EndIf
    
    ; --- open invisible window
    Result = OpenWindow(PopupWindow, 0, 0, Width, Height, "", #PB_Window_BorderLess|#PB_Window_ScreenCentered|#PB_Window_NoActivate|#PB_Window_Invisible)
    If PopupWindow = #PB_Any : PopupWindow = Result : EndIf
    
    hWnd = WindowID(PopupWindow)
    
    ; --- Enable DropShadow
    SetClassLongPtr_(hWnd, #GCL_STYLE, GetClassLongPtr_(hWnd, #GCL_STYLE)|#CS_DROPSHADOW)
    
    ; --- fill structure
    *p\Window     = PopupWindow
    *p\Animated   = Animated
    *p\GrabFocus  = GrabFocus
    *p\OldProc    = SetWindowLongPtr_(hWnd, #GWL_WNDPROC, @PopupWindowCustomCallback())
    
    ; --- paste data to window
    SetProp_(hWnd, #PROP_EDDY_POPUPWINDOW, *p)
    
    ; --- hide from taskbar
    HideWindowFromTaskBar(*p\Window, #True)
    
    ProcedureReturn Result
    
  EndProcedure
    
EndModule
UseModule     Eddy_CPW

CompilerIf #PB_Compiler_IsMainFile
  
  ; ***************************************
  ; EXAMPLE 1 - custom popup menu
  ; ***************************************
  
  Define PopupWindow, MainWindow, SecondaryWindow, txt
  
  PopupWindow=CreatePopupWindow(#PB_Any, 160, 300)
  If IsWindow(PopupWindow)
    StringGadget(222, 5, 5, 150, 20, "Test...")
    ButtonGadget(111, 5, 30, 150, 20, "Ok")
    CanvasGadget(1, 5, 55, 150, 120)     
  EndIf
  
  SecondaryWindow=OpenWindow(#PB_Any, 440, 400, 500, 200, "Main Window Second", #PB_Window_SystemMenu)
  
  MainWindow=OpenWindow(#PB_Any, 0, 0, 300, 400, "Main Window First", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  If IsWindow(MainWindow)
    SetWindowColor(MainWindow, RGB(131, 131, 182))
    
    txt=TextGadget(#PB_Any, 5, 5, WindowWidth(MainWindow), 100, "Right-click here to display popup window...")
    SetGadgetFont(txt, LoadFont(0, "Arial", 24, #PB_Font_Bold|#PB_Font_Italic|#PB_Font_HighQuality))
    SetGadgetColor(txt, #PB_Gadget_BackColor, GetWindowColor(MainWindow))
    SetGadgetColor(txt, #PB_Gadget_FrontColor, RGB(214, 189, 212))
  EndIf
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_ActivateWindow
      Case #PB_Event_DeactivateWindow
        
      Case #PB_Event_Gadget
        If EventGadget()=1
          StartDrawing(CanvasOutput(1))
          Plot(Random(100), Random(100), #Red)
          StopDrawing()
        EndIf
        
      Case #PB_Event_CloseWindow
        If EventWindow()=MainWindow
          Break
        ElseIf EventWindow()=SecondaryWindow
          CloseWindow(EventWindow())
        EndIf
        
      Case #PB_Event_RightClick
        If EventWindow()=MainWindow
          DisplayPopupWindow(PopupWindow, WindowID(MainWindow))
        EndIf
    EndSelect
  ForEver   
CompilerEndIf