Page 1 of 1

Create Windows with Prototypes

Posted: Wed Jun 27, 2012 9:39 am
by Frarth
While building windows for my project, a desire developed to create general procedures to handle windows events. So I started digging into the usage of Prototypes (which is fun) and came up with the solution below. Any suggestions are welcome.

Window.pbi

Code: Select all

; Window include file (P) 2012 Frarth
; -----------------------------------

Enumeration
  #Window_Key_Return
  #Window_Key_Escape
; FOR pb <= 4.51:
;   #Window_Key_Left
;   #Window_Key_Right
;   #Window_Key_Up
;   #Window_Key_Down
EndEnumeration

Prototype _Window_AddKeys(Handle.i)
Prototype _Window_Close(Handle.i)
Prototype _Window_Create(*TSelf)
Prototype _Window_DoEvents(*TSelf)
Prototype _Window_Load(*TSelf)
Prototype _Window_Open(*TSelf)
Prototype _Window_PollKeys(Handle.i, Gadget.i)
Prototype _Window_RemoveKeys(Handle.i)

Prototype Window_Create(*TSelf)
Prototype Window_Close()
Prototype Window_DoEvents(*TSelf)
Prototype Window_Event(Gadget.i, Type.i)
Prototype Window_Load(*TSelf)
Prototype Window_Move(*TSelf)
Prototype Window_Open(*TSelf)
Prototype Window_Resize(*TSelf)

Structure WindowType
  _AddKeys._Window_AddKeys
  _Close._Window_Close
  _Create._Window_Create
  _DoEvents._Window_DoEvents
  _Load._Window_Load
  _Open._Window_Open
  _PollKeys._Window_PollKeys
  _RemoveKeys._Window_RemoveKeys
  
  Close.Window_Close
  Create.Window_Create
  DoEvents.Window_DoEvents
  Event.Window_Event
  Load.Window_Load
  Move.Window_Move
  Open.Window_Open
  Resize.Window_Resize
  
  Created.i
  Loaded.i
  Opened.i
  
  ActiveGadget.i
  AllowMaximize.i
  AllowMinimize.i
  Borderless.i
  Handle.i
  Height.i
  Maximize.i
  Minimize.i
  Modal.i
  Parent.i
  Position.i
  SystemMenu.i
  Title.s
  TitleBar.i
  Tool.i
  Visible.i
  Width.i
  X.i
  Y.i
EndStructure

Declare Window_Close(*TSelf.WindowType)
Declare.i Window_Show(*TSelf.WindowType)

Global Window_Key_Return.i
Global Window_Key_Escape.i

; Global Window_Key_Left.i
; Global Window_Key_Right.i
; Global Window_Key_Up.i
; Global Window_Key_Down.i
Window.pb

Code: Select all

; Window (P) 2010-2012 Frarth
; ---------------------------
EnableExplicit

XIncludeFile "Window.pbi"

;- PRIVATE PROCEDURES

Declare _Window_AddKeys(Handle.i)
Declare _Window_Close(*TSelf.WindowType)
Declare.i _Window_Create(*TSelf.WindowType)
Declare _Window_DoEvents(*TSelf.WindowType)
Declare _Window_Load(*TSelf.WindowType)
Declare _Window_Open(*TSelf.WindowType)
Declare _Window_PollKeys(Handle.i, Gadget.i)
Declare _Window_RemoveKeys(Handle.i)

Procedure _Window_AddKeys(Handle.i)
  
  AddKeyboardShortcut(Handle, #PB_Shortcut_Return, #Window_Key_Return)
  AddKeyboardShortcut(Handle, #PB_Shortcut_Escape, #Window_Key_Escape)
;   AddKeyboardShortcut(Handle, #PB_Shortcut_Left, #Window_Key_Left)
;   AddKeyboardShortcut(Handle, #PB_Shortcut_Right, #Window_Key_Right)
;   AddKeyboardShortcut(Handle, #PB_Shortcut_Up, #Window_Key_Up)
;   AddKeyboardShortcut(Handle, #PB_Shortcut_Down, #Window_Key_Down)
  
  Window_Key_Return = #True
  Window_Key_Escape = #True
;   Window_Key_Left = #True
;   Window_Key_Right = #True
;   Window_Key_Up = #True
;   Window_Key_Down = #True
  
EndProcedure

Procedure _Window_Close(*TSelf.WindowType)
  
  With *TSelf
    
    \_RemoveKeys(\Handle)
    CloseWindow(\Handle)
    
  EndWith
  
  ClearStructure(*TSelf, WindowType)
  
EndProcedure

Procedure.i _Window_Create(*TSelf.WindowType)
  
  Protected flags.i, ID.i, created.i = #False
  
  With *TSelf
    
    ; ID
    
    If \Parent >= 0
      ID = WindowID(\Parent)
    EndIf
    
    ; flags
    
    If \AllowMaximize
      flags = #PB_Window_MaximizeGadget
    EndIf
    
    If \AllowMinimize
      flags | #PB_Window_MinimizeGadget
    EndIf
    
    If \Borderless
      flags | #PB_Window_BorderLess
    EndIf
    
    If \Maximize
      flags | #PB_Window_Maximize
    EndIf
    
    If \Minimize
      flags | #PB_Window_Minimize
    EndIf
    
    flags | \Position
    
    If \SystemMenu
      flags | #PB_Window_SystemMenu
    EndIf
    
    If \TitleBar
      flags | #PB_Window_TitleBar
    EndIf
    
    If \Tool
      flags | #PB_Window_Tool
    EndIf
    
    flags | #PB_Window_Invisible
    
    If OpenWindow(\Handle, \X, \Y, \Width, \Height, \Title, flags, ID)
      
      If \Modal
        StickyWindow(\Handle, #True)
      EndIf
      
      \Create(*TSelf)
      created = #True
      
    EndIf
    
    \Created = created
    
  EndWith
  
  ProcedureReturn created
    
EndProcedure

Procedure _Window_DoEvents(*TSelf.WindowType)
  
  Protected Event.i, Quit.i
  
  Quit = #False
  
  With *TSelf
    
    SetActiveGadget(\ActiveGadget)
  
    Repeat
      
      \_PollKeys(\Handle, \ActiveGadget)
      Event = WaitWindowEvent()
      \ActiveGadget = GetActiveGadget()
      
      If \ActiveGadget >= 0
        
        Select Event
          
        Case #PB_Event_Gadget
          Quit = \Event(EventGadget(), EventType())
          
        Case #PB_Event_Menu
          
          Select EventMenu()
            
          Case #Window_Key_Return
            Quit = \Event(\ActiveGadget, #PB_Shortcut_Return)
            
          Case #Window_Key_Escape
            Quit = \Close()
            
          EndSelect
          
        Case #PB_Event_MoveWindow
          If \Move <> 0
            \Move(*TSelf)
          EndIf
          
        Case #PB_Event_SizeWindow
          If \Resize <> 0
            \Resize(*TSelf)
          EndIf
          
        Case #PB_Event_CloseWindow
          Quit = \Close()
          
        EndSelect
        
      EndIf
      
    Until Quit
    
  EndWith
  
EndProcedure

Procedure.i _Window_Load(*TSelf.WindowType)
  
  Protected loaded.i = #True
  
  With *TSelf
    
    If \Load <> 0
      
      loaded = \Load(*TSelf)
      
    EndIf
    
    \Loaded = loaded
    
  EndWith
  
  ProcedureReturn loaded
  
EndProcedure

Procedure _Window_Open(*TSelf.WindowType)
  
  Protected opened.i = #True
  
  With *TSelf
    
    If \Open <> 0
      
      opened = \Open(*TSelf)
      
    EndIf
    
    \Opened = opened
    
  EndWith
  
  ProcedureReturn opened
  
EndProcedure

Procedure _Window_PollKeys(Handle.i, Gadget.i)
  
  If Gadget >= 0
    
    Select GadgetType(Gadget)
      
    Case #PB_GadgetType_Editor, #PB_GadgetType_Web
      RemoveKeyboardShortcut(Handle, #PB_Shortcut_Return)
;       RemoveKeyboardShortcut(Handle, #PB_Shortcut_Left)
;       RemoveKeyboardShortcut(Handle, #PB_Shortcut_Right)
;       RemoveKeyboardShortcut(Handle, #PB_Shortcut_Up)
;       RemoveKeyboardShortcut(Handle, #PB_Shortcut_Down)
      Window_Key_Return = #False
;       Window_Key_Left = #False
;       Window_Key_Right = #False
;       Window_Key_Up = #False
;       Window_Key_Down = #False
      
    Case #PB_GadgetType_String, #PB_GadgetType_IPAddress, #PB_GadgetType_Calendar, #PB_GadgetType_ComboBox, #PB_GadgetType_ListIcon, #PB_GadgetType_ListView
;       RemoveKeyboardShortcut(Handle, #PB_Shortcut_Left)
;       RemoveKeyboardShortcut(Handle, #PB_Shortcut_Right)
;       RemoveKeyboardShortcut(Handle, #PB_Shortcut_Up)
;       RemoveKeyboardShortcut(Handle, #PB_Shortcut_Down)
;       Window_Key_Left = #False
;       Window_Key_Right = #False
;       Window_Key_Up = #False
;       Window_Key_Down = #False
      
    Default
      
      If Window_Key_Return = #False
        AddKeyboardShortcut(Handle, #PB_Shortcut_Return, #Window_Key_Return)
        Window_Key_Return = #True
      EndIf
      
;       If Window_Key_Left = #False
;         AddKeyboardShortcut(Handle, #PB_Shortcut_Left, #Window_Key_Left)
;         Window_Key_Left = #True
;       EndIf
;       
;       If Window_Key_Right = #False
;         AddKeyboardShortcut(Handle, #PB_Shortcut_Right, #Window_Key_Right)
;         Window_Key_Right = #True
;       EndIf
;       
;       If Window_Key_Up = #False
;         AddKeyboardShortcut(Handle, #PB_Shortcut_Up, #Window_Key_Up)
;         Window_Key_Up = #True
;       EndIf
;       
;       If Window_Key_Down = #False
;         AddKeyboardShortcut(Handle, #PB_Shortcut_Down, #Window_Key_Down)
;         Window_Key_Down = #True
;       EndIf
      
    EndSelect
    
  EndIf
  
EndProcedure

Procedure _Window_RemoveKeys(Handle.i)
  
  RemoveKeyboardShortcut(Handle, #PB_Shortcut_Return)
  RemoveKeyboardShortcut(Handle, #PB_Shortcut_Escape)
;   RemoveKeyboardShortcut(Handle, #PB_Shortcut_Left)
;   RemoveKeyboardShortcut(Handle, #PB_Shortcut_Right)
;   RemoveKeyboardShortcut(Handle, #PB_Shortcut_Up)
;   RemoveKeyboardShortcut(Handle, #PB_Shortcut_Down)
  
  Window_Key_Return = #False
  Window_Key_Escape = #False
;   Window_Key_Left = #False
;   Window_Key_Right = #False
;   Window_Key_Up = #False
;   Window_Key_Down = #False
  
EndProcedure

;- PUBLIC PROCEDURES

Procedure Window_Close(*TSelf.WindowType)
  
  With *TSelf
    
    If \Created
      
      ; close window
      *TSelf\_Close(*TSelf)
      
    EndIf
    
  EndWith
  
EndProcedure

Procedure.i Window_Show(*TSelf.WindowType)
  
  Protected created.i = #False
  
  With *TSelf
    
    ; restore window?
    If \Created
      
      created = #True
      
      ; overwrite
      \Visible = #True
      
      ; load not successful before?
      If Not \Loaded
        Goto Window_Show_Load
      EndIf
      
      ; restore
      Goto Window_Show_Restore
      
    EndIf
    
    \_Open = @_Window_Open()
    If \_Open(*TSelf)
      
      \_Create = @_Window_Create()
      If \_Create(*TSelf)
        
        created = #True
        \_Load = @_Window_Load()
        
        Window_Show_Load:
        
        If \_Load(*TSelf)
          
          ; other procedures
          \_AddKeys = @_Window_AddKeys()
          \_Close = @_Window_Close()
          \_DoEvents = @_Window_DoEvents()
          \_PollKeys = @_Window_PollKeys()
          \_RemoveKeys = @_Window_RemoveKeys()
          
          ; add window shortcut keys
          \_AddKeys(\Handle)
          
          ; visible window?
          If \Visible
            
            Window_Show_Restore:
            
            ; child window?
            If \Parent >= 0
              DisableWindow(\Parent, #True)
            EndIf
  
            ; show window
            HideWindow(\Handle, #False)
      
            ; do window events
            If \DoEvents <> 0
              ; custom procedure
              \DoEvents(*TSelf)
            Else
              ; default
              \_DoEvents(*TSelf)
            EndIf
            
            ; hide window
            HideWindow(\Handle, #True)
            
            ; focus to parent
            If \Parent >= 0
              DisableWindow(\Parent, #False)
              SetActiveWindow(\Parent)
            EndIf
          
          EndIf
        
        EndIf
      
      EndIf
    
    EndIf
  
  EndWith
  
  ProcedureReturn created
  
EndProcedure
NewWindow.pb

Code: Select all

; wX Window template (p) 2012 Frarth
; ----------------------------------
EnableExplicit

XIncludeFile "Window.pbi"

;- PRIVATE PROCEDURES

Declare.i _wX_btCancel()
Declare.i _wX_btOK()
Declare.i _wX_Close()
Declare.i _wX_Create(*TSelf.WindowType)
Declare _wX_Gadget(Gadget.i)
Declare.i _wX_Load(*TSelf.WindowType)
Declare.i _wX_Open(*TSelf.WindowType)

Global wX_OK.i

Procedure.i _wX_btCancel()
  
  ; detect change
  
  
  ProcedureReturn #True
  
EndProcedure

Procedure.i _wX_btOK()
  
  ; confirm input
  
  ; set flag
  wX_OK = #True
  
  ; done
  ProcedureReturn #True
  
EndProcedure

Procedure.i _wX_Close()
  ; fires when window's close button or ESC is pressed
  
  ProcedureReturn #True
  
EndProcedure

Procedure _wX_Create(*TSelf.WindowType)
  
  TextGadget(1, 20, 67, 110, 28, "Something:")
  StringGadget(2, 150, 62, 440, 28, "")
  
  ButtonGadget(3, 380, 542, 100, 28, "OK")
  ButtonGadget(4, 490, 542, 100, 28, "Cancel")
  
EndProcedure

Procedure.i _wX_Event(Gadget.i, Event.i)
  ; fires when a gadget event occurs
  
  Select Gadget
    
  Case 2
    
    If Event = #PB_Shortcut_Return
      If _wX_btOK()
        ProcedureReturn #True
      EndIf
    EndIf
      
  Case 3
    
    If _wX_btOK()
      ProcedureReturn #True
    EndIf
    
  Case 4
    
    If _wX_btCancel()
      ProcedureReturn #True
    EndIf
    
  Default
    
    ; do with gadget
    _wX_Gadget(Gadget)
    
  EndSelect
    
EndProcedure

Procedure _wX_Gadget(Gadget.i)
  
  Select Gadget
  Case 2
    ; check limit
    
  EndSelect
    
EndProcedure

Procedure.i _wX_Load(*TSelf.WindowType)
  ; after window is created
  
  ; uncomment to test result
  ;ProcedureReturn #False
  
  SetGadgetText(2, "new")
  
  ProcedureReturn #True
  
EndProcedure

Procedure.i _wX_Open(*TSelf.WindowType)
  ; before window is created...
  
  ; uncomment to see result
  ;ProcedureReturn #False
  
  wX_OK = #False
  
  ProcedureReturn #True
  
EndProcedure

;- PUBLIC PROCEDURES

Procedure wX_Show(Parent.i, Handle.i, Title.s)
  
  Protected TWindow.WindowType
  
  With TWindow
    
    ; properties
    \ActiveGadget = 2
    \Handle = Handle
    \Height = 590
    \Modal = #False
    \Parent = Parent
    \Position = #PB_Window_ScreenCentered
    \SystemMenu = #True
    \Title = Title
    \TitleBar = #True
    \Visible = #True
    \Width = 610
    
    ; custom procedures
    \Close = @_wX_Close()
    \Create = @_wX_Create()
    \Event = @_wX_Event()
    \Load = @_wX_Load()
    \Open = @_wX_Open()
    
  EndWith
  
  ; show window
  If Window_Show(@TWindow)
    If TWindow\Loaded
      If wX_OK
        ; do stuff
        Debug "Input confirmed."
      Else
        Debug "Input cancelled."
      EndIf
    Else
      Debug "Error loading stuff."
    EndIf
    ; destroy window
    Window_Close(@TWindow)
  Else
    If Not TWindow\Opened
      Debug "Error opening stuff."
    EndIf
  EndIf
  
EndProcedure

wX_Show(-1, 0, "New Window")
End

XIncludeFile "Window.pb"

Re: Create Windows with Prototypes

Posted: Wed Jun 27, 2012 11:35 am
by Frarth
Edited:
- \Created, \Loaded, \Opened flags added.
- example adjusted

Re: Create Windows with Prototypes

Posted: Wed Jun 27, 2012 3:33 pm
by Frarth
Added:

- Allows custom DoEvent(), Resize() and Move()

Changed:

- window settings accessible in Open() event

Re: Create Windows with Prototypes

Posted: Wed Jun 27, 2012 4:26 pm
by PMV
You know the keyword "Interface"?
You should prefer interfaces as there you don't need to
write as much as with prototypes. And you are not
able to access the values inside of the structure when
using the interface.

just a hint :)

MFG PMV

Re: Create Windows with Prototypes

Posted: Wed Jun 27, 2012 5:04 pm
by Frarth
Yes, I know PB's Interface, but haven't worked with it yet, and wanted to explore Prototypes first. :wink:

Re: Create Windows with Prototypes

Posted: Wed Jun 27, 2012 9:45 pm
by Frarth
PMV wrote:And you are not
able to access the values inside of the structure when
using the interface.
How would you do this using an interface:

Code: Select all

With TWindow
   
    ; properties
    \ActiveGadget = 2
    \Handle = Handle
    \Height = 590
    \Modal = #False
    \Parent = Parent
    \Position = #PB_Window_ScreenCentered
    \SystemMenu = #True
    \Title = Title
    \TitleBar = #True
    \Visible = #True
    \Width = 610
   
    ; custom procedures
    \Close = @_wX_Close()
    \Create = @_wX_Create()
    \Event = @_wX_Event()
    \Load = @_wX_Load()
    \Open = @_wX_Open()
   
  EndWith
Maybe I don't understand, but it seems to me using Prototypes provides more flexibility.

Re: Create Windows with Prototypes

Posted: Wed Jun 27, 2012 10:09 pm
by idle
interesting thanks for posting

Re: Create Windows with Prototypes

Posted: Thu Jun 28, 2012 12:21 am
by PMV
Interfaces have other logic:

following code just written inside of browser!
not workable code and sorry, no time for more.
Please use forum to get working interface-examples :)

Code: Select all

Interface TWindow
  AddKeys(Handle.i)
  Close(Handle.i)
  Create()
  DoEvents()
  Load()
  Open()
  PollKeys(Handle.i, Gadget.i)
  RemoveKeys(Handle.i)

  Close()
  Event(Gadget.i, Type.i)
  Load()
EndInterface


Structure TWindow_Structure
    VTable.i

    ; properties
    ActiveGadget.i
    Handle.i
    Height.i
    Modal.i
    Parent.i
    Position.i
    SystemMenu.i
    Title.s
    TitleBar.i
    Visible.i
    Width.i
EndStructure

DataSection
  ; custom procedures
  TWindow_Procedures:
  Data.i @_Window_AddKeys()
  Data.i @_Window_Close()
  Data.i @_wX_Create()
  Data.i @_Window_DoEvents()
  Data.i @_wX_Load()
  Data.i @_wX_Open()
  Data.i @_Window_PollKeys()
  Data.i @_Window_RemoveKeys()
  Data.i @_wX_Close()
  Data.i @_wX_Event()
EndDataSection

; and if you create it, just write:
Procedure CreateTWindow()
  Protected *Window.TWindow_Struc = AllocateMemory(SizeOf(TWindow_Struc))
  *Window\VTable = ?TWindow_Procedure

  *Window\Position = #PB_Window_ScreenCentered
  ; ...
  ProcedureReturn *Window
EndProcedure

; if you use it
Define *Window.TWindow = CreateTWindow()
*Window\DoEvent()

Re: Create Windows with Prototypes

Posted: Thu Jun 28, 2012 3:08 am
by skywalk
Well, there is also OOP without Interfaces. :wink:

Re: Create Windows with Prototypes

Posted: Thu Jun 28, 2012 6:19 am
by Frarth
PMV wrote:Data.i @_wX_Close()
Data.i @_wX_Event()
Thanks PMV. I think I basically understand how Interfaces work. But I still would need Prototypes here, because custom procedures would have to be addressed; _wX_Method would be different for each window.
skywalk wrote:Well, there is also OOP without Interfaces. :wink:
Thanks skywalk, it is one of the examples I took to find out how prototypes work. :wink:

Re: Create Windows with Prototypes

Posted: Thu Jun 28, 2012 10:57 am
by PMV
You can point the VTable to everywhere ... so you could write the
pointers into the structure instead of a datasection ... and of course
you can change the VTable-value at any point ... so you could
use multiple datasections to fit your needs. Or (a little bit dirty but
it will work) you can allocate memory and write the procedure-pointers
into that ... or create a second structure ... VTable just needs to
point to memory where the procedure-pointers are stored in right
order. :wink:

At the very end ... prototypes inside of structures work like interfaces,
just that prototype-procedures are always part of the structure where
interfaces are separated from the structure. And thats the important
part for interfaces. Of course it is not much. But if you are working with
other people with real OOP ... you will understand the difference in this
pseudo-OOP. :D

MFG PMV