Imports System
Imports System.Web
Imports System.Web.UI
Imports System.Web.UI.HtmlControls
Imports System.Web.UI.WebControls
Imports System.Collections.Specialized

Namespace Stonebroom

  Public Class AdaptiveSpinBox

    ' specify base class to extend
    Inherits WebControl

    ' need to be able to handle postbacks
    Implements IPostBackDataHandler

    ' ----------------------------------------------

    ' enumeration of target browser types
    Public Enum ClientTargetType
      AutoDetect = 0
      UpLevel = 1
      DownLevel = 2
    End Enum

    ' ----------------------------------------------

    ' private internal variables
    Private _autopostback As Boolean = False
    Private _caption As String = ""
    Private _client As ClientTargetType = ClientTargetType.AutoDetect
    Private _columns As Integer = 3
    Private _cssclass As String = ""
    Private _increment As Integer = 1
    Private _maxvalue As Integer = 99
    Private _minvalue As Integer = 0
    Private _text As String = ""
    Private _usetable As Boolean = True
    Private _usecss2 As Boolean = False

    ' to hold child control references
    Private oTextBox As TextBox
    Private oImageUp, oImageDown As ImageButton
    Private oSpan As HtmlGenericControl

    ' to hold control ID value for building script
    Dim sCID As String

    ' ----------------------------------------------

    ' public event
    Public Event ValueChanged As EventHandler

    ' ----------------------------------------------

    ' public constructor
    Public Sub New()

      ' call base method first with element type
      ' root element for control will be a SPAN
      MyBase.New("span")

    End Sub


    ' ----------------------------------------------

    OverRides Protected Sub OnInit(e As EventArgs)

      ' first event that control can handle
      ' must always call base method first
      MyBase.OnInit(e)

      ' must register to receive postback events
      ' required because "root" control is a SPAN
      ' does not receive postback events by default
      Page.RegisterRequiresPostBack(Me)

    End Sub

    ' ----------------------------------------------

    Overridable Function LoadPostData(key As String, _
                         vals As NameValueCollection) _
                         As Boolean _
      Implements IPostBackDataHandler.LoadPostData

      ' occurs when data in postback is available to control

      ' get value of control from postback collection
      Dim sNewValue As String = vals(key & "_textbox")
      Context.Trace.Write("LoadPostData:" & key, _
        "Loaded postback value '" & sNewValue & "' from Request")

      ' get value from viewstate - i.e. when page was last created
      Dim sExistingValue As String = ViewState(key & "_textbox")
      Context.Trace.Write("LoadPostData:" & key, _
        "Loaded existing value '" & sExistingValue & "' from viewstate")

      ' get client target type from viewstate
      Dim sClientType As String = ViewState(key & "_target")
      Context.Trace.Write("LoadPostData:" & key, _
        "Loaded target '" & sClientType & "' from viewstate")

      If (sClientType = ClientTargetType.UpLevel.ToString()) _
      Or (sNewValue <> sExistingValue) Then

        ' either client type is "UpLevel" and value was
        ' incremented by client-side script, or user typed
        ' new value in Textbox in "DownLevel" client

        If sNewValue <> sExistingValue Then

          ' value in control has been changed by user
          ' set internal member to posted value and return True
          ' so that PostDataChangedEvent will be raised
          _text = sNewValue
          Return True

        Else

          ' value in control has not changed
          ' set internal member to viewstate value and write message
          ' return False because no need to raise ValueChanged event
          _text = sExistingValue
          Return False

        End If

      Else

        ' client type may be "DownLevel" and value was not incremented
        ' so check if "up" or "down" button caused the postback
        If vals(key & "_imageup.x") <> "" Then

          ' "up" image button was clicked so increment value
          ' new value will be checked in CreateChildControls event
          ' to ensure its within maximum and minimum value limits
          ' use Try..Catch in case viewstate empty or text not a number
          Try
            _text = CType(Int32.Parse(sExistingValue) + _increment, String)
            Context.Trace.Write("LoadPostData:" & key, _
                                "Incremented value to '" & _text)
          Catch
            Context.Trace.Write("LoadPostData:" & key, _
              "Error reading viewstate: " & sExistingValue)
          End Try
          ' return True so that PostDataChangedEvent will be raised
          Return True

        End If

        If vals(key & "_imagedown.x") <> "" Then

          ' "down" image button was clicked so decrement value
          Try
            _text = CType(Int32.Parse(sExistingValue) - _increment, String)
            Context.Trace.Write("LoadPostData:" & key, _
              "Decremented value to '" & _text)
          Catch
            Context.Trace.Write("LoadPostData:" & key, _
              "Error reading viewstate: " & sExistingValue)
          End Try
          ' return True so that PostDataChangedEvent will be raised
          Return True

        End If

      End If

    End Function

    ' ----------------------------------------------

    Overridable Sub RaisePostBackDataChangedEvent() _
           Implements IPostBackDataHandler.RaisePostDataChangedEvent

      ' called after all controls have loaded postback data,
      ' but only if LoadPostData handler (above) returned True
      ' call event handler for ValueChanged event
      OnValueChanged(EventArgs.Empty)

    End Sub

    ' ----------------------------------------------

    Protected OverRidable Sub OnValueChanged(e As EventArgs)

      ' write message to Trace and raise public ValueChanged
      ' event with appropriate EventArgs values
      Context.Trace.Write("OnValueChanged:" & Me.UniqueID, _
                          "Raising ValueChanged event")
      RaiseEvent ValueChanged(Me, e)

    End Sub

    ' ----------------------------------------------

    ' public property accessor declarations

    Public Property AutoPostback As Boolean
      Get
        Return _autopostback
      End Get
      Set
        _autopostback = value
      End Set
    End Property

    Public Property Caption As String
      Get
        Return _caption
      End Get
      Set
        _caption = value
      End Set
    End Property

    Public WriteOnly Property ClientTarget As ClientTargetType
      Set
        _client = value
      End Set
    End Property

    Public Property Columns As Integer
      Get
        Return _columns
      End Get
      Set
        If (value > 0) And (value < 1000) Then
          _columns = value
        Else
          Throw New Exception("Columns must be between 1 and 999")
        End If
      End Set
    End Property

    Public OverRides Property CssClass As String
      Get
        Return _cssclass
      End Get
      Set
        _cssclass = value
      End Set
    End Property

    Public Property Increment As Integer
      Get
        Return _increment
      End Get
      Set
        If value > 0 Then
          _increment = value
        Else
          Throw New Exception("Increment must be greater than zero")
        End If
      End Set
    End Property

    Public Property MaximumValue As Integer
      Get
        Return _maxvalue
      End Get
      Set
        If value > _minvalue Then
          _maxvalue = value
        Else
          Throw New Exception("MaximumValue must be greater than " _
                    & "the current MinimumValue")
        End If
      End Set
    End Property

    Public Property MinimumValue As Integer
      Get
        Return _minvalue
      End Get
      Set
        If value < _maxvalue Then
          _minvalue = value
        Else
          Throw New Exception("MinimumValue must be less than " _
                    & "the current MaximumValue")
        End If
      End Set
    End Property

    Public Property Text As String
      Get
        Return _text
      End Get
      Set
        Dim iValue As Integer
        Try
          iValue = Int32.Parse(value)
        Catch
          Throw New Exception("Text property must represent " _
                    & "a valid Integer value")
        End Try
        If (value >= _minvalue) And (value <= _maxvalue)
          _text = value
          SetMaxMinValues()
        Else
          Throw New Exception("Text property must be within" _
                    & "the current MinimumValue and MaximumValue")
        End If
      End Set
    End Property

    Public Property Value As Integer
      Get
        Try
          Return Int32.Parse(_text)
        Catch
        End Try
      End Get
      Set
        If (value >= _minvalue) And (value <= _maxvalue)
          _text = value.ToString()
        Else
          Throw New Exception("Value property must be within the " _
                    & "current MinimumValue and MaximumValue")
        End If
      End Set
    End Property

    ' ----------------------------------------------

    OverRides Protected Sub CreateChildControls()
      ' called when its time to create the child controls
      ' create HTML elements and ASP.NET server controls
      ' set properties and add to Controls collection

      ' set control ID prefix for contained controls
      sCID = Me.UniqueID & "_"

      ' check if value is within max and min limits
      SetMaxMinValues()

      ' save current value of Textbox in viewstate
      ViewState(sCID & "textbox") = _text
      Context.Trace.Write("CreateChildControls:" & Me.UniqueID, _
                          "Saved value '" & _text & "' in viewstate")

      ' check if the current browser supports features
      ' required for "smart" operation and if user specified
      ' the mode they want (Version6 or Downlevel)
      If _client <> ClientTargetType.DownLevel Then

        ' start by assuming DownLevel
        _client = ClientTargetType.DownLevel

        ' get reference to BrowserCapabilities object
        Dim oBrowser As HttpBrowserCapabilities = Context.Request.Browser

        ' must support client-side JavaScript
        If oBrowser("JavaScript") = True Then

          ' get browser type and version
          Dim sUAType As String = oBrowser("Browser")
          Dim sUAVer As String = oBrowser("MajorVersion")

          ' see if the current client is IE5 or above
          If (sUAType = "IE") And (sUAVer >= 5) Then
            _client = ClientTargetType.UpLevel
            _usetable = False
            _usecss2 = True
          End If

          ' see if the current client is Netscape 6.0/Mozilla 1.0
          If (sUAType = "Netscape") And (sUAVer >= 5)  Then
            _client = ClientTargetType.UpLevel
            _usetable = True
            _usecss2 = True
          End If

          ' see if the current client is Opera 6.0
          If (sUAType = "Opera" And sUAVer >= 6) Then
            _client = ClientTargetType.UpLevel
            _usetable = False
            _usecss2 = True
          End If

        End If

      End If

      ' save current value of _client in viewstate
      ViewState(sCID & "target") = _client.ToString()

      ' display detected client type value in Trace
      Context.Trace.Write("CreateChildControls:" & Me.UniqueID, _
              "Saved target '" & _client.ToString() & "' in viewstate")

      ' now ready to create the appropriate set of controls
      If _usetable = False Then

        ' serving to version-6 client, use absolute positioning
        ' (but not for Netscape 6.x or Mozilla 1.x)
        CreateCSS2Controls()

      Else

        ' serving to down-level client, create HTML table
        ' (including Netscape 6.x or Mozilla 1.x)
        CreateHTMLTable()

      End If

      If _usecss2 = True Then

        ' serving to client that supports CSS2 so inject script
        InjectClientScript()

      End If

      ' display control property values in Trace
      Context.Trace.Write("Property Values", Me.UniqueID _
        & ".AutoPostback = " & Me.AutoPostback.ToString())
      Context.Trace.Write("Property Values", Me.UniqueID _
        & ".Caption = '" & Context.Server.HtmlEncode(Me.Caption) & "'")
      Context.Trace.Write("Property Values", Me.UniqueID _
        & ".Columns = " & Me.Columns.ToString())
      Context.Trace.Write("Property Values", Me.UniqueID _
        & ".CssClass = '" & Me.CssClass & "'")
      Context.Trace.Write("Property Values", Me.UniqueID _
        & ".Increment = " & Me.Increment.ToString())
      Context.Trace.Write("Property Values", Me.UniqueID _
        & ".MaximumValue = " & Me.MaximumValue.ToString())
      Context.Trace.Write("Property Values", Me.UniqueID _
        & ".MinimumValue = " & Me.MinimumValue.ToString())
      Context.Trace.Write("Property Values", Me.UniqueID _
        & ".Text = '" & Me.Text & "'")
      Context.Trace.Write("Property Values", Me.UniqueID _
        & ".Value = " & Me.Value.ToString())

    End Sub

    ' ----------------------------------------------

    ' check if current value of Textbox (in _text member variable)
    ' is within current max and min limits, and reset if not
    Private Sub SetMaxMinValues()
      Dim iValue As Integer
      Try
        iValue = Int32.Parse(_text)
      Catch
        iValue = _minvalue
      End Try
      If iValue < _minvalue Then
        iValue = _minvalue
      End If
      If iValue > _maxvalue Then
        iValue = _maxvalue
      End If
      _text = iValue.ToString()
    End Sub

    ' ----------------------------------------------

    ' ----------------------------------------------

    Private Sub CreateCSS2Controls()
    ' create <span> containing caption and positioned controls

      ' add caption to "root" SPAN element
      Me.Controls.Add(New LiteralControl(_caption))

      ' create contained SPAN element for textbox
      ' and image buttons, and set properties
      Dim oSpan As New HtmlGenericControl("span")
      oSpan.Style("position") = "relative"
      Controls.Add(oSpan)

      ' create Textbox control, set properties
      ' and add to Controls collection
      oTextBox = New TextBox()
      With oTextBox
        .id = sCID & "textbox"
        If _cssclass <> "" Then
          .CssClass = _cssclass
        End If
        .Columns = _columns
        .Style("top") = "0"
        .Style("left") = "0"
        .Style("width") = _columns * 10
        .Style("text-align") = "right"
        .Text = _text
      End With
      oSpan.Controls.Add(oTextBox)

      ' create "up" ImageButton control, set
      ' properties and add to Controls collection
      oImageUp = New ImageButton()
      With oImageUp
        .id = sCID & "imageup"
        .Style("position") = "absolute"
        .Style("top") = "0"
        .Style("left") = oTextBox.Style("width")
        .Width = New Unit(16)
        .Height = New Unit(10)
        .ImageUrl = "~/images/spin-up.gif"
        .AlternateText = "+" & _increment.ToString()
        .BorderStyle = BorderStyle.None
        .BorderWidth = New Unit(0)
        .Attributes.Add("border", "0")
      End With
      oSpan.Controls.Add(oImageUp)

      ' create "down" ImageButton control, set
      ' properties and add to Controls collection
      oImageDown = New ImageButton()
      With oImageDown
        .id = sCID & "imagedown"
        .Style("position") = "absolute"
        .Style("top") = "10"
        .Style("left") = oTextBox.Style("width")
        .Width = New Unit(16)
        .Height = New Unit(10)
        .ImageUrl = "~/images/spin-down.gif"
        .AlternateText = "-" & _increment.ToString()
        .BorderStyle = BorderStyle.None
        .BorderWidth = New Unit(0)
        .Attributes.Add("border", "0")
      End With
      oSpan.Controls.Add(oImageDown)

    End Sub

    ' ----------------------------------------------

    Private Sub CreateHTMLTable()
    ' create HTML table containing caption and controls

      ' create Table control and set properties
      Dim oTable As New Table()
      With oTable
        .BorderStyle = BorderStyle.None
        .BorderWidth = New Unit(0)
        .CellPadding = 0
        .CellSpacing = 0
      End With

      ' create TableRow and add to Table
      Dim oRow As New TableRow()
      oTable.Controls.Add(oRow)
      With oRow
        .BorderStyle = BorderStyle.None
        .BorderWidth = New Unit(0)
      End With

      ' create first TableCell and add to Row
      ' insert value of Caption property
      Dim oCell As New TableCell
      oRow.Controls.Add(oCell)
      With oCell
        .Controls.Add(New LiteralControl(_caption))
        .BorderStyle = BorderStyle.None
        .BorderWidth = New Unit(0)
        .VerticalAlign = VerticalAlign.Middle
      End With

      ' create second TableCell and add to Row
      oCell = New TableCell()
      oRow.Controls.Add(oCell)
      With oCell
        .BorderStyle = BorderStyle.None
        .BorderWidth = New Unit(0)
        .VerticalAlign = VerticalAlign.Middle
      End With

      ' create Textbox control, set properties
      ' and add to second cell in table
      oTextBox = New TextBox()
      oCell.Controls.Add(oTextBox)
      With oTextBox
        .id = sCID & "textbox"
        If _cssclass <> "" Then
          .CssClass = _cssclass
        End If
        .Columns = _columns
        .Style("width") = _columns * 10
        .Style("text-align") = "right"
        .Text = _text
      End With

      ' create third TableCell and add to Row
      oCell = New TableCell()
      oRow.Controls.Add(oCell)
      With oCell
        .BorderStyle = BorderStyle.None
        .BorderWidth = New Unit(0)
        .VerticalAlign = VerticalAlign.Middle
      End With

      ' create "up" ImageButton control, set
      ' properties and add to third cell in table
      oImageUp = New ImageButton()
      With oImageUp
        .id = sCID & "imageup"
        .Width = New Unit(16)
        .Height = New Unit(10)
        .ImageUrl = "~/images/spin-up.gif"
        .AlternateText = "+" & _increment.ToString()
        .BorderStyle = BorderStyle.None
        .BorderWidth = New Unit(0)
        .Attributes.Add("border", "0")
      End With
      oCell.Controls.Add(oImageUp)

      ' create an HTML <br /> element - use LiteralControl
      ' because HtmlGenericControl creates <br></br> which
      ' causes blank line to appear in some browsers
      ' add to cell so down image wraps to next line
      Dim oBR As New LiteralControl("<br />")
      oCell.Controls.Add(oBR)

      ' create "down" ImageButton control, set
      ' properties and add to third cell in table
      oImageDown = New ImageButton()
      With oImageDown
        .id = sCID & "imagedown"
        .Width = New Unit(16)
        .Height = New Unit(10)
        .ImageUrl = "~/images/spin-down.gif"
        .AlternateText = "-" & _increment.ToString()
        .BorderStyle = BorderStyle.None
        .BorderWidth = New Unit(0)
        .Attributes.Add("border", "0")
      End With
      oCell.Controls.Add(oImageDown)

      ' add Table control to SPAN element Controls collection
      Controls.Add(oTable)

    End Sub

    ' ----------------------------------------------

    Private Sub InjectClientScript()
    ' create <script> element and connect event handlers

      ' create true/false string for JavaScript code
      Dim sAutoPostback As String = "false"
      If _autopostback Then
        sAutoPostback = "true"
      End If

      ' create JavaScript parameter string - used to set
      ' parameters for client-side control event handlers
      Dim sParams As String = "'" & sCID & "textbox', " _
        & _minvalue.ToString() & ", " _
        & _maxvalue.ToString() & ", " _
        & _increment.ToString() & ", " _
        & sAutoPostback

      ' see if previous instance of this control has already
      ' added the required JavaScript code reference to the page
      If Not Page.IsClientScriptBlockRegistered("StonebroomAdaptiveSpinBox") Then
        Dim sPath As String = "/aspnet_client/custom/"
        Dim sScript As String = "<script language='javascript' " _
          & "src='" & sPath & "spinbox.js'><" & "/script>"
        ' add this JavaScript code to the page
        Page.RegisterClientScriptBlock("StonebroomAdaptiveSpinBox", sScript)
      End If

      ' set client-side event handlers for controls
      oImageUp.Attributes.Add("onclick", "return incrementValue(" & sParams & ")")
      oImageDown.Attributes.Add("onclick", "return decrementValue(" & sParams & ")")
      oTextBox.Attributes.Add("onblur", "return checkValue(" & sParams & ")")
      oTextBox.Attributes.Add("onkeydown", "return keyDown(event, " & sParams & ")")

    End Sub

    ' ----------------------------------------------

  End Class

End Namespace