Click here to Skip to main content
15,879,095 members
Articles / Programming Languages / Visual Basic

Open Door - Reporting, Charts, Enquiry Drill-Downs

Rate me:
Please Sign up or sign in to vote.
4.37/5 (11 votes)
2 Feb 2009CPOL6 min read 39.1K   2K   59  
A utility for generating user editable reports, charts, documents, enquiries
Imports System.ComponentModel
Imports System.IO
Imports System.Reflection
Imports System.Runtime.Serialization
Public Class nbfTextSelect
    Inherits System.Windows.Forms.Control
    dim TextBox1 as New TextBox
    dim Button1 as New Button
    Private pvHDB As nbfdb.HDBC
    private pvSelectedDescription as string
    private pvGridDropParameters as nbfGridDropParameters
    private pvTabOnSelect as boolean
    private pvCheckValidonLeave as boolean = true
    private pvSavedText as String = ""
    private pvBindType as String
    private pvnbfCtlType as string
    private pvUserAdded as boolean
    private pvHidden as boolean
    public StyleInfo as nbfStyleInfo.AppStyle
    public Event TextDropValueChanged as TextDropValueChangedEventHandler
    Public Delegate Sub TextDropValueChangedEventHandler(sender As Object, e As nbfTextDropValueChangedArgs)
    Protected Overridable Sub OnTextDropValueChanged(e As nbfTextDropValueChangedArgs)
        'Invokes the delegates.
        RaiseEvent TextDropValueChanged(Me, e)
    End Sub
    public Event ButtonClicked as ButtonClickedEventHandler
    Public Delegate Sub ButtonClickedEventHandler(sender As nbfTextSelect, e As EventArgs)
    Protected Overridable Sub OnButtonClicked(e As EventArgs)
        'Invokes the delegates.
        RaiseEvent ButtonClicked(Me, e)
    End Sub
    Private Sub TB1Changed(ByVal sender As Object, ByVal e As System.EventArgs)
        dim et As new nbfTextDropValueChangedArgs(textbox1.text)
        OnTextDropValueChanged(et)
    End Sub
#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call
        pvGridDropParameters = new nbfGridDropParameters
        pvTabOnSelect = true
        Button1.TabStop = false
        Button1.Width = 20
        Try
            Dim myAssembly As System.Reflection.Assembly = System.Reflection.Assembly.GetExecutingAssembly()
            Dim myStream As Stream = myAssembly.GetManifestResourceStream("GridControls.ARW05DN.ICO")
            Dim image As New Bitmap(myStream)
            Button1.Image = image
        catch ex as exception
        end try
        AddHandler TextBox1.TextChanged, AddressOf TB1Changed
        AddHandler TextBox1.KeyDown, AddressOf TBKeyDown
        AddHandler TextBox1.KeyUp, AddressOf TBKeyUp
        AddHandler Button1.Click, AddressOf ButtonClick         
        TextBox1.Autosize = False
        SizeBoxes
        SuspendLayout
        Me.Controls.Add(TextBox1)
        Me.Controls.Add(Button1)
        ResumeLayout
    End Sub
    'UserControl overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub
    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        components = New System.ComponentModel.Container()
    End Sub

#End Region
    Public Property HDB as nbfDB.HDBC
    Get
        Return pvHDB
    End Get
    Set
        pvHDB = Value
    End Set
    End Property
    Private Sub SizeBoxes()
        TextBox1.Top = 0
        TextBox1.Left = 0
        Button1.Top = 0
        if Me.Width > Button1.Width then
            TextBox1.Width = Me.Width - Button1.Width
            Button1.Left = Me.Width - Button1.Width
        end if        
        TextBox1.Height = Me.Height
        Button1.Height = Me.Height
    End Sub
    Protected Overrides Sub OnResize(ByVal e As System.EventArgs)
        MyBase.OnResize(e)
        Try
            SizeBoxes
            'if not styleInfo is nothing then
            '    TextBox1.Height = StyleInfo.StdTextBoxHeight
            '    Button1.Height = StyleInfo.StdTextBoxHeight + 2 'Me.Height
            'end if
            'TextBox1.Width = Me.Width - Button1.Width
            'Button1.Left = Me.Width - Button1.Width
        Catch ex As Exception
            Exit Sub
        End Try
    End Sub
    public property BindType() as String
                Get
                    return pvBindType
                End Get
                Set
                    pvBindType = Value
                End Set
    End Property
    Public Property nbfCtlType() as String
        Get
            return pvNbfCtlType
        End Get
        Set
            pvnbfCtlType = Value
        End Set
    End Property
    public Property TabOnSelect() as boolean
        Get
            return pvTabOnSelect
        End Get
        Set(byval Value as Boolean)
            pvTabOnSelect = Value
        End Set
    End Property
    Public Property MultiLine as Boolean
    Get
        Return TextBox1.Multiline
    End Get
    Set
        TextBox1.Multiline = Value
    End Set
    End Property
    public property TextBoxEnabled() as boolean
        Get
            return TextBox1.enabled
        End Get
        Set
            TextBox1.enabled = Value
        End Set
    End Property
    public property ButtonEnabled() as boolean
        Get
            return Button1.enabled
        End Get
        Set
            Button1.enabled = Value
        End Set
    End Property
    public property CheckValidonLeave() as Boolean
    Get
            return pvCheckValidonLeave
    End Get
    Set (byval Value as Boolean)
        pvCheckValidonLeave = Value
    End Set
    End Property
    Protected Overrides Sub OnLeave(ByVal e As System.EventArgs)
        mybase.onLeave(e)
        if not pvHDB is nothing and trim(textbox1.Text) <> "" then
            if pvCheckValidonLeave then
                if not pvGridDropParameters is nothing
                    if pvGridDropParameters.DropTypeCollection then
                        dim io as LookUpValue
                        for each io in pvGridDropParameters.nbfCollection
                            if io.Code = textbox1.Text then
                                exit sub
                            End If
                        Next
                        exit sub
                    else
                        dim s as String
                        dim ds as nbfDB.SNbfResultSet
                        s = GetSQL(True)
                        if s = "" then
                            exit Sub
                        end if
                        ds = HDB.CreateSNbfResultSet(s)
                        if ds.fetch() then
                            ds.dispose
                            exit Sub
                        end if
                        ds.dispose
                    End if
                    MsgBox("Value entered is not valid")
                    textbox1.SelectedText = textbox1.text
                    textbox1.focus
                End If
            end if
        End If        
    End Sub
    public property TextBoxForeColor() as System.Drawing.Color
    Get
            return textbox1.ForeColor
    End Get
    Set(byval Value as System.Drawing.Color)
        textbox1.ForeColor = Value
    End Set
    End Property
    public property TextBoxBackColor() as System.Drawing.Color
    Get
            return textbox1.BackColor
    End Get
    Set(byval Value as System.Drawing.Color)
        textbox1.BackColor = Value
    End Set
    End Property
public property ButtonBackColor() as System.drawing.color
    get
        return Button1.BackColor
    End Get
        Set
            Button1.BackColor = value
        End Set
End Property
public property ButtonForeColor() as System.drawing.color
    get
        return Button1.ForeColor
    End Get
        set
            Button1.ForeColor = value
        End Set
End Property
public property BorderStyle() as BorderStyle
    Get
        return textbox1.BorderStyle
    End Get
    Set (byval Value as BorderStyle)
        textbox1.BorderStyle = value
    End Set
end property
    public property MaxLength() as Integer
        Get
            return textbox1.MaxLength

        End Get
        set
            textbox1.MaxLength = Value
        End Set
    End Property
    public property GridDropParameters() as nbfGridDropParameters
        get
            GridDropParameters = pvGridDropParameters
        end get
        Set(byval Value as nbfGridDropParameters)
            pvGridDropParameters = Value
        End Set
    End Property
    public property TextBoxFont() as System.Drawing.Font
    Get
            return textbox1.Font
    End Get
    Set(byval Value as System.Drawing.font)
        textbox1.Font = Value
    End Set
    End Property
    Public Sub SetUp(ByRef bo as Object)
        'pvOpApp = po
        'pvTextDropParameters = TextDropParams
        'pvSourceSQL = inSQL
        textbox1.BindObject = bo
    End Sub
    'Public overloads Sub SetUp(ByRef po As AOBO0002.Application, ByVal inCodeField As String, ByVal inDesField As String, ByVal inTableName As String)
    '    pvOpApp = po
    '    pvSourceCodeField = inCodeField
    '    pvSourceDescriptionField = inDesField
    '    pvSourceTableName = inTableName'
'
    'End Sub
    'Public overloads Sub SetUp(ByRef po As AOBO0002.Application, ByVal inCodeField As String, ByVal inDesField As String, ByVal inTableName As String, ByVal inTablePrefix As String)
    '    pvOpApp = po
    '    pvSourceCodeField = inCodeField
    '    pvSourceDescriptionField = inDesField
    '    pvSourceTableName = inTableName
    '    pvSourceOverrideTablePrefix = inTablePrefix
    'End Sub
    'Public Property SourceSQL() As String
    '    Get
    '        Return pvSourceSQL
    '    End Get
    '    Set(ByVal Value As String)
    '        pvSourceSQL = Value
    '    End Set
    'End Property
    Private Sub ButtonClick(ByVal sender As Object, ByVal e As System.EventArgs)
        OnButtonClicked(e)
    End Sub
    public overrides property Text() as string
    get
        return textbox1.text
    End Get
    set (byval value as String)
        textbox1.Text = value
    End Set
    end property
    public property TextAlign() as HorizontalAlignment
    get
        return textbox1.TextAlign
    End Get
    set
        textbox1.TextAlign = value
    End Set
    end property
    public property SelectionStart() as Integer
    get
        return textbox1.SelectionStart
    End Get
    set
        textbox1.SelectionStart = value
    End Set
    end property
    public property SelectionLength() as Integer
    get
        return textbox1.SelectionLength
    End Get
    set
        textbox1.SelectionLength = value
    End Set
    end property
    public readonly property PreferredHeight() as integer
    get
            return 20
    End Get
    End Property
    Private Sub TBKeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs)
        if e.KeyCode = Keys.F4 then
            dim ev As new EventArgs
            e.Handled = true
            if e.Shift then
                OnButtonClicked(ev)
            else
                OnButtonClicked(ev)
            End If
        else
            OnKeyDown(e)
        'elseif e.KeyCode = Keys.enter then
        '    e.Handled = true
        '    sendkeys.Send("{TAB}")
        End If
    End Sub
    Private Sub TBKeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs)
        if e.KeyCode = Keys.F4 then
            e.Handled = true
        else
            OnKeyUp(e)
        'elseif e.KeyCode = Keys.enter then
        '    e.Handled = true
        '    sendkeys.Send("{TAB}")
        End If
    End Sub
    private function GetSQL(optional validate as Boolean = false) as string
    try
        dim sql as string
        if pvGridDropParameters.SourceCodeField <> "" and pvGridDropParameters.SourceTableName <> "" then
            sql = "SELECT " & pvGridDropParameters.SourceCodeField
            if pvGridDropParameters.SourceDescriptionField <> "" then
                sql &= "," & pvGridDropParameters.SourceDescriptionField
            End If
            if pvGridDropParameters.SourceOverrideTablePrefix then                    
                sql &= " FROM " & pvGridDropParameters.OverrideTablePrefix & pvGridDropParameters.SourceTableName
            else
               sql &= " FROM " & pvGridDropParameters.SourceTableName
            End If
            if trim(pvGridDropParameters.SQLFilterString) <> "" then
                if mid(ucase(trim(pvGridDropParameters.SqlFilterString)),1,6) <> "WHERE " then
                    pvGridDropParameters.SqlFilterString = "WHERE " & pvGridDropParameters.SqlFilterString
                End If
                sql &= " " & pvGridDropParameters.SqlFilterString
                if validate then
                    sql &= " AND " & pvGridDropParameters.SourceCodeField & " = " & fnds(TextBox1.Text)
                End If
            else
                if validate then
                    sql &= " WHERE " & pvGridDropParameters.SourceCodeField & " = " & fnds(TextBox1.Text)
                End If
            End If
            if not validate then
                if trim(pvGridDropParameters.SQLOrderFields) <> "" then
                    sql &= " ORDER BY " & pvGridDropParameters.SQLOrderFields
                else
                    sql &= " ORDER BY " & pvGridDropParameters.SourceCodeField
                End If
            end if
        else
            sql = ""
        end if
        return sql
    Catch ex As Exception
        msgbox(ex.Message)
    End Try
    End Function
    private Function fnds(ByVal ins As Object) As String
        Dim istr As string
        If ins is nothing Then
            fnds = "NULL"
        ElseIf IsDBNull(ins) Then
            fnds = "NULL"
        Else
            istr = Trim(CStr(ins))
            If istr = "" Then
                fnds = "NULL"
            Else
                fnds = "'" & Trim(rep_quote(istr)) & "'"
            End If
        End If
    End Function
    Function rep_quote(ByVal rs As String) As String
        Dim spos As Short
        Dim dpos As Short
        Dim Start As Object
        Start = InStr(rs, "'")
        Do While Start > 0
            dpos = InStr(Start + 1, rs, "'")
            If Not (dpos = Start + 1) Then
                rs = Mid(rs, 1, Start) & "'" & Mid(rs, Start + 1, Len(rs))
            End If
            spos = Start + 2
            Start = InStr(spos, rs, "'")
        Loop
        rep_quote = rs
    End Function
    public Property Hidden() as Boolean
    Get
        return pvHidden
    End Get
    set
        pvHidden = Value
    End Set
    end property
    public property UserAdded() as Boolean
    Get
        return pvUserAdded
    End Get
    Set
        pvUserAdded = Value
    End Set
    End Property
    'Private Sub TextBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles TextBox1.MouseDown
    'if e.Button = MouseButtons.Right then
    '    OnButtonClicked(e)
    'end if
    'End Sub
    'Public Shadows Function Focus() as Boolean
    '    TextBox1.Focus
    'End Function
    Protected Overrides Sub OnGotFocus(ByVal e As System.EventArgs)
        MyBase.OnGotFocus(e)
        TextBox1.Focus
    End Sub
End Class

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
United Kingdom United Kingdom
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.

Comments and Discussions