PureBasic Forums - English

Code: Select all

blablabla...
;
If EventType=#PB_EventType_RightClick
    ;
    ; Ouvre le menu contextuel dans le canvas_0 si une ligne ou un arc est selectionné
    ;
    If (DataTreeItem >= 3 + nbpoint And DataTreeItem <= 2 + nbpoint + NbLig) Or (DataTreeItem >= 4 + nbpoint + NbLig And DataTreeItem <= 3 + nbpoint + NbLig + NbArc)   
      If CreatePopupMenu(1)      
        MenuItem(1, "Discrétiser")      
        MenuItem(2, "Retourner discrétisation")
        CloseSubMenu()
      EndIf
      DisplayPopupMenu(1, Canvas_0)
    EndIf
    ;
  EndIf
  ;
  If EventType=#PB_Event_Menu
    ;
    Debug EventMenu()
    ;
    Select EventMenu()
        ;
      Case 1
        ;
        Debug "Discrétiser"
        ;
      Case 2
        ;
        Debug "Retourner"
        ;
    EndSelect
    ;
  EndIf
  ;
  If EventType=#PB_EventType_LeftClick
    ;
blablabla....

Code: Select all

blablabla...
;

If CreatePopupMenu(1)      
  MenuItem(1, "Discrétiser")      
  MenuItem(2, "Retourner discrétisation")
Else
  Debug "Failed"
EndIf

If EventType=#PB_EventType_RightClick
    ;
    ; Ouvre le menu contextuel dans le canvas_0 si une ligne ou un arc est selectionné
    ;
    If (DataTreeItem >= 3 + nbpoint And DataTreeItem <= 2 + nbpoint + NbLig) Or (DataTreeItem >= 4 + nbpoint + NbLig And DataTreeItem <= 3 + nbpoint + NbLig + NbArc)   
      DisplayPopupMenu(1, WindowID(0))
    EndIf
    ;
  EndIf
  ;
  If EventType=#PB_Event_Menu
    ;
    Debug EventMenu()
    ;
    Select EventMenu()
        ;
      Case 1
        ;
        Debug "Discrétiser"
        ;
      Case 2
        ;
        Debug "Retourner"
        ;
    EndSelect
    ;
  EndIf
  ;
  If EventType=#PB_EventType_LeftClick
    ;
blablabla....

Code: Select all

  If EventType=#PB_Event_Gadget
     ;
    Select EventGadget()
        ;
      Case Canvas_0
        Select EventType()          
          Case #PB_EventType_RightButtonUp   
            DisplayPopupMenu(1, WindowID(0))
        EndSelect
        ;
    EndSelect
    ;
  EndIf

Code: Select all

;-TOP

Procedure MouseInRange(Gadget, x, y, Width, Heigth)
  Protected pos_x, pos_y, x2, y2
  pos_x = GetGadgetAttribute(Gadget, #PB_Canvas_MouseX)
  pos_y = GetGadgetAttribute(Gadget, #PB_Canvas_MouseY)
  x2 = x + Width
  y2 = y + Heigth
  If pos_x >= x And pos_x < x2
    If pos_y >= y And pos_y < y2
      ProcedureReturn #True
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure

; ----

Procedure UpdateWindow()
  Protected dx, dy
  dx = WindowWidth(0)
  dy = WindowHeight(0) - StatusBarHeight(0) - MenuHeight()
  ; Resize Gadgets
  ResizeGadget(0, 5, 5, dx - 10, dy - 10)
EndProcedure

; ----

Procedure Main()
  Protected dx, dy
  
  #WinStyle = #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget
  
  If OpenWindow(0, #PB_Ignore, #PB_Ignore, 600, 400, "Test Window", #WinStyle)
    ; MenuBar
    CreateMenu(0, WindowID(0))
    MenuTitle("File")
    
    ; StatusBar
    CreateStatusBar(0, WindowID(0))
    AddStatusBarField(#PB_Ignore)
    
    ; Gadgets
    dx = WindowWidth(0)
    dy = WindowHeight(0) - StatusBarHeight(0) - MenuHeight()
    CanvasGadget(0, 5, 5, dx - 10, dy - 10, #PB_Canvas_Border)
    If StartDrawing(CanvasOutput(0))
      Box(20, 20, 80, 80, #Red)
      StopDrawing()
    EndIf
    
    ; PopUpMenu
    CreatePopupMenu(1)
    MenuItem(1, "Menu 1")
    MenuItem(2, "Menu 2")
    
    ; Bind Events
    BindEvent(#PB_Event_SizeWindow, @UpdateWindow(), 0)
    
    ; Main Loop
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Select EventWindow()
            Case 0
              Break
          EndSelect
          
        Case #PB_Event_Menu
          Select EventMenu()
            Case 1
              ;
            Case 2
              ;
              
          EndSelect
          
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 0
              Select EventType()
                Case #PB_EventType_RightClick
                  If MouseInRange(0, 20, 20, 80, 80)
                    DisplayPopupMenu(1, WindowID(0))
                  EndIf
                  
              EndSelect
              
          EndSelect
          
      EndSelect
    ForEver
    
  EndIf
  
EndProcedure : Main()

Code: Select all

Procedure CanvasGad(EventType)
  Select EventType
    Case #PB_EventType_RightClick
      DisplayPopupMenu(1, WindowID(0))
      
  EndSelect
EndProcedure

Code: Select all

;
; This code is automatically generated by the FormDesigner.
; Manual modification is possible to adjust existing commands, but anything else will be dropped when the code is compiled.
; Event procedures needs to be put in another source file.
;

Enumeration FormWindow
  #MainWindow
EndEnumeration

Enumeration FormGadget
  #Canvas_Gad
EndEnumeration

Enumeration FormMenu
  #MenuItem_Exit
EndEnumeration

Declare DoMenuEvent(Event)
Declare DoCanvasEvent(EventType)

Procedure OpenMainWindow(x = 0, y = 0, width = 600, height = 400)
  OpenWindow(#MainWindow, x, y, width, height, "", #PB_Window_SystemMenu)
  CreateMenu(0, WindowID(#MainWindow))
  MenuTitle("File")
  MenuItem(#MenuItem_Exit, "Exit")
  CanvasGadget(#Canvas_Gad, 10, 10, 580, 380)
EndProcedure

Procedure MainWindow_Events(event)
  Select event
    Case #PB_Event_CloseWindow
      ProcedureReturn #False

    Case #PB_Event_Menu
      Select EventMenu()
        Case #MenuItem_Exit
          DoMenuEvent(EventMenu())
      EndSelect

    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Canvas_Gad
          DoCanvasEvent(EventType())          
      EndSelect
  EndSelect
  ProcedureReturn #True
EndProcedure

Code: Select all

IncludeFile "MainForm.pbf" ; Include the first window definition

Enumeration FormMenu ; <- Same name of form file
  #PopupMenu_1
  #PopupMenu_2
EndEnumeration

; Create PopupMenu
CreatePopupMenu(1)
MenuItem(#PopupMenu_1, "Menu 1")
MenuItem(#PopupMenu_2, "Menu 2")

; The event procedures, as specified in the 'event procedure' property of each gadget
Procedure DoCanvasEvent(EventType)
  Select EventType
    Case #PB_EventType_RightClick
      DisplayPopupMenu(1, WindowID(#MainWindow))
      
  EndSelect
EndProcedure

Procedure DoMenuEvent(EventMenu)
  Select EventMenu
    Case #MenuItem_Exit
      PostEvent(#PB_Event_CloseWindow, #MainWindow, 0)
    
  EndSelect
EndProcedure

Procedure DoPopupMenuEvent(EventMenu)
  Select EventMenu
    Case #PopupMenu_1
      Debug "Popup Menu 1"
      
    Case #PopupMenu_2
      Debug "Popup Menu 2"

  EndSelect
EndProcedure

;- Open Main
OpenMainWindow() ; Open the first window. This procedure name is always 'Open' followed by the window name

If IsWindow(#MainWindow)
  ; The main event loop as usual, the only change is to call the automatically
  ; generated event procedure for each window.
  Repeat
    Event = WaitWindowEvent()
    
    Select EventWindow()
      Case #MainWindow
        If MainWindow_Events(Event) = #False ; This procedure name is always window name followed by '_Events'
          Break
        EndIf
    EndSelect
    
    ; Own Event management
    Select Event
      Case #PB_Event_Menu
        DoPopupMenuEvent(EventMenu())
        
    EndSelect
    
  ForEver
EndIf