App.vb
'----------------------------------------------------------------
Imports System.Windows.Forms
Public Class App
Public Shared Stack As FormStack
'note this is the entry point for the application. Check Startup object settings
Public Shared Sub Main()
'Do any preloading here
Stack = New FormStack
'Push our first form onto the form stack
Stack.Push(GetType(frmMain))
Try
Stack.Run()
Catch ex As Exception
' As an illustration, when you exit the app all Forms will
' get popped off the stack, which will throw an exception
' that gets caught here.
' Do nothing, just exit app
End Try
End Sub
End Class
'----------------------------------------------------------------
FormStack.vb
'----------------------------------------------------------------
Imports System
Imports System.Collections
Imports System.Runtime.InteropServices
Imports System.Threading
Public Class FormStack
#Region "FormStack Variables"
Inherits CollectionBase
Private theStack As System.Collections.ArrayList = New ArrayList
Private theBuffer As System.Collections.ArrayList = New ArrayList
Private Const app_msg As String = "IOGC POS"
#End Region
#Region "API Calls"
Public Structure POINTAPI
Public x As Int32
Public y As Int32
End Structure
Public Structure MSG
Public hwnd As Int32
Public message As Int32
Public wParam As Int32
Public lParam As Int32
Public time As Int32
Public pt As POINTAPI
End Structure
Private Declare Function GetMessage Lib "Coredll.dll" (ByRef lpMsg As MSG, ByVal hwnd As Int32, ByVal wMsgFilterMin As Int32, ByVal wMsgFilterMax As Int32) As Int32
Private Declare Function TranslateMessage Lib "Coredll.dll" (ByRef lpMsg As MSG) As Int32
Private Declare Function DispatchMessage Lib "Coredll.dll" (ByRef lpMsg As MSG) As Int32
#End Region
#Region "Run Loop"
'-------------------------------------------------------------------------------
' Run - Main application loop. it pulls windows messages off of the stack,
' translates them, and dispatches them.
'-------------------------------------------------------------------------------
' I changed the run loop from Chris's example after experiencing
' unusual delays in messagewindows in combination with
' Symbol scanner technologies.
'
' One thing to consider, however, is I think this message loop
' implementation is much more aggressive, and may drain the
' battery at a faster rate. I have not confirmed this, however.
'-------------------------------------------------------------------------------
Public Sub Run()
Dim msg As MSG
'While we have messages and forms, translate and dispatch messages
While theStack.Count > 0 AndAlso GetMessage(msg, 0, 0, 0) = 1
TranslateMessage(msg)
DispatchMessage(msg)
End While
End Sub
#End Region
'-------------------------------------------------------------------------------
' Push - Pushes a form onto the stack, and then displays it. This is how you
' navigate to a form. Notice it needs the type of the form, not an instance
' of a form. You must only push only forms that implement IStackable.
'-------------------------------------------------------------------------------
Public Sub Push(ByVal frm As System.Type)
'Only allow 1 Push at a time to maintain cache and stack integrity
Monitor.Enter(Me)
'Check if form has been buffered
If theBuffer.Count > 0 Then
Dim sf As IStackable = theBuffer.Item(theBuffer.Count() - 1)
If frm.Name = sf.This.GetType().Name Then
buffer_to_stack()
Return
End If
End If
'Hide the current form prior to loading the next form
If theStack.Count > 0 Then
Dim hf As IStackable = theStack.Item(theStack.Count() - 1)
hf.This.Text = ""
End If
'The form wasn't cached, so create it
Dim form As IStackable = Preload(frm)
'Update its data and display it
form.UpdateData()
form.This.Visible = True
form.This.Text = app_msg
'Add a self referential event handler to prevent closing
AddHandler form.This.Closing, AddressOf FormClosing
Monitor.Exit(Me)
End Sub
'Prevents forms from closing when a close is requested, and instead sets them invisible
'This is essential to the stacking architecture because a closed form is subsequently disposed.
Private Sub FormClosing(ByVal sender As Object, ByVal args As System.ComponentModel.CancelEventArgs)
Dim frm As Form = DirectCast(sender, Form)
frm.Visible = False
args.Cancel = True
End Sub
'-------------------------------------------------------------------------------
' Preload - This creates an instance of a form of the specified type and returns
' The IStackable interface.
'-------------------------------------------------------------------------------
Public Function Preload(ByVal FormType As Type) As IStackable
Dim form As IStackable = CType(Activator.CreateInstance(FormType), IStackable)
'Create the user interface
form.InitUI()
'Required to get close event on PPC!
form.This.MinimizeBox = False
'Add it to the cache
theStack.Add(form)
Return form
End Function
'2006.05.18 NJE ~ Modified Pop to prevent buffering
'It will only pop off one form from each arraylist at a time
'If Buffer is selected it will buffer the form in the buffer
Public Sub Pop()
Monitor.Enter(Me)
If theStack.Count < 1 Then
ExitApp()
Return
End If
Dim form_to_pop As IStackable = theStack.Item(theStack.Count - 1)
form_to_pop.This.Close()
theStack.RemoveAt(theStack.Count - 1)
Dim form_to_view As IStackable = theStack.Item(theStack.Count - 1)
form_to_view.UpdateData()
form_to_view.This.Visible = True
form_to_view.This.Text = app_msg
Monitor.Exit(Me)
GC.Collect()
End Sub
'2006.0519 NJE
'Pop all forms off of the stack except the first form &
'clear out buffered forms
Public Sub Finish()
Monitor.Enter(Me)
'Pop all froms except the navigation form off of the stack
While theStack.Count > 1
Pop()
End While
'Clear out all buffered forms
theBuffer.Clear()
App.amgr.clear()
Monitor.Exit(Me)
GC.Collect()
End Sub
'Public interface to buffer a form
Public Sub Buffer()
stack_to_buffer()
End Sub
'Pop the form off of the stack an push it onto the buffer
Private Sub stack_to_buffer()
Monitor.Enter(Me)
Dim bf As IStackable
If theStack.Count > 0 Then
bf = theStack.Item(theStack.Count() - 1)
bf.This.Visible = False
bf.This.Text = ""
theBuffer.Add(bf.This)
theStack.Remove(bf)
Dim sf As IStackable = theStack.Item(theStack.Count - 1)
sf.UpdateData()
sf.This.Visible = True
sf.This.Text = app_msg
End If
Monitor.Exit(Me)
End Sub
'Pop the form off of the buffer and push it onto the stack
Private Sub buffer_to_stack()
Monitor.Enter(Me)
Dim sf As IStackable
If theBuffer.Count > 0 Then
sf = theBuffer.Item(theBuffer.Count() - 1)
sf.This.Visible = False
sf.This.Text = ""
theStack.Add(sf.This)
theBuffer.Remove(sf)
Dim bf As IStackable = theStack.Item(theStack.Count - 1)
sf.UpdateData()
sf.This.Visible = True
sf.This.Text = app_msg
End If
Monitor.Exit(Me)
End Sub
'Tells you how many forms are cached on the form stack
Public Function StackToString() As String
Dim sMessage As String = "There are " & theStack.Count.ToString() & " forms cached" & vbNewLine
sMessage &= "the Stack contents:"
For i As Int32 = theStack.Count - 1 To 0 Step -1
sMessage &= vbNewLine & theStack(i).ToString
Next
Return sMessage
End Function
'Tells you how many forms are cached on the buffer stack
Public Function BufferToString() As String
Dim sMessage As String = "There are " & theBuffer.Count.ToString() & " forms buffered" & vbNewLine
sMessage &= "Buffer contents:"
For i As Int32 = theBuffer.Count - 1 To 0 Step -1
sMessage &= vbNewLine & theBuffer(i).ToString
Next
Return sMessage
End Function
'The unified way to exit the application
Public Sub ExitApp()
Finish()
GC.Collect()
Application.Exit()
End Sub
End Class
'----------------------------------------------------------------
Check out the view from the Ridge