Click here to Skip to main content
15,896,606 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.5K   2K   59  
A utility for generating user editable reports, charts, documents, enquiries
imports System.Windows.Forms
imports nbfSqlReporter
imports system.Drawing
imports system.Drawing.Printing
Imports System.Diagnostics
Imports Microsoft.Win32
Imports VB6 = Microsoft.VisualBasic.Compatibility
Public Class nbfBrowseHost
Inherits ApplicationContext
Implements IDisposable
private pvSI as New nbfStyleInfo.AppStyle
    Private AppConnectDB As Boolean = False
    Private pvDisposeDB As Boolean = False
    'private pvHostUI as nbfUIMonitor.nbfUIMonitor
private pvDbc as nbfDB.HDBC
private pvMdiParentForm as Form
    Private pvAppPath As String
    Private pvSkinName As String = ""
    Private pvCurrentDefaultPrefix As String
    Private pvCompanyName As String = ""
    Private pvScopeDes As String = ""
Private pvCurrentDate as Date
private pvPrinterName as String
private pvTemplateName as string
private pvDataBaseName as String
private pvDSN as String
private pvUserName as String
    Private pvPassWord As String
    Private pvDisAllowEnableLayoutEdit As Boolean = False
    Private pvAllowSaveAsShared As Boolean = False
    Private pvLoadAsShared As Boolean = False
    Private app_name As String
private pvParamCollection as new Collection
Private gdisposed As Boolean = False
Public app_title As String
public pvCurrentTemplate as string
Private mmr As nbfReportForm
    Public Sub New(Dsn as string,UserName as string,PassWord as String,AppPath as String)
        mybase.new()
        Try
            pvCurrentDate = now
            SetDefaultStyle
            AppConnectDB = true
            pvDSN = DSN
            pvUserName = UserName
            pvPassWord = PassWord
            pvAppPath = AppPath
        Catch ex As Exception
            MsgBox(ex.Message)
            exitthread()
        End Try
    End Sub
    Public Sub New (inDB as nbfDB.HDBC,AppPath as String)
        pvCurrentDate = now
        SetDefaultStyle
        pvDBC = inDB
        AppConnectDB = false
        pvAppPath = AppPath
    End Sub
    Public Sub New(ByVal inDB As nbfDB.HDBC, ByVal AppPath As String, ByVal DisposeDB As Boolean)
        pvCurrentDate = Now
        SetDefaultStyle()
        pvDbc = inDB
        AppConnectDB = False
        pvDisposeDB = DisposeDB
        pvAppPath = AppPath
    End Sub
public Sub SetParameter(byval ParamNumber as Integer, byval ParamValue as String)
dim pi as New ParamInfo
pi.ParamNo = ParamNumber
pi.ParamVal = ParamValue
pvParamCollection.Add(PI)
End Sub
Public Sub SetPrinter(ByVal DeviceName as String)
    pvPrinterName = DeviceName
End Sub
    Public Sub SetCompanyName(ByVal CompanyName As String)
        pvCompanyName = CompanyName
    End Sub
    Public Sub SetScopeDes(ByVal ScopeDes As String)
        pvScopeDes = ScopeDes
    End Sub
    Public Function PrintTemplate(ByVal Template As String, Optional ByVal View As Boolean = False, Optional ByVal PrintOnly As Boolean = False) As nbfBrowseRep
        Dim tDBC As nbfDB.HDBC = Nothing
        Try
            Dim ssz As New System.Drawing.Size
            If AppConnectDB Then
                tDBC = New nbfDB.HDBC
                tDBC.logon(pvDSN, pvUserName, pvPassWord, False)
                If pvDataBaseName <> "" Then
                    tDBC.execsql("USE " & pvDataBaseName)
                End If
            Else
                tDBC = pvDbc
            End If
            Dim pvBR As New nbfBrowseRep(tDBC, pvAppPath, Template, pvSkinName)
            Dim pi As ParamInfo
            pvBR.CurrentDate = pvCurrentDate
            For Each pi In pvParamCollection
                pvBR.SetParamValue(pi.ParamNo, pi.ParamVal)
            Next
            If pvCurrentDefaultPrefix <> "" Then
                pvBR.SetDefaultPrefix(pvCurrentDefaultPrefix)
            End If
            If pvCompanyName <> "" Then
                pvBR.SetCompanyName(pvCompanyName)
            End If
            If pvScopeDes <> "" Then
                pvBR.SetScopeDes(pvScopeDes)
            End If
            If pvPrinterName <> "" Then
                pvBR.BFInfo.PrinterName = pvPrinterName
            End If
            If View Then
                Dim scr As Screen = Screen.PrimaryScreen
                Dim spt As New Point
                spt.X = 1
                spt.Y = 1
                Dim r As Rectangle = scr.GetWorkingArea(spt)
                ssz.Width = CInt(r.Width * 0.95)
                ssz.Height = CInt(r.Height * 0.95)
            End If
            AddHandler pvBR.PrintComplete, AddressOf OnPrintComplete
            pvBR.PrintForm(ssz, View, PrintOnly)
        Catch ex As Exception
            MsgBox(ex.Message)
        Finally
            If Not tDBC Is Nothing Then
                tDBC.Dispose()
                tDBC = Nothing
            End If
        End Try
    End Function
    Public Sub SetDefaultPrefix(DefaultPrefix as String)
        pvCurrentDefaultPrefix = DefaultPrefix
    End Sub
    Public Sub SetCurrentDate(CurrentDate as Date)
        pvCurrentDate = CurrentDate
    End Sub
    Public Sub EditReportTemplate(ByVal Template As String, Optional Byval DisallowLayoutEdit as Boolean = false)
        Try
            mmr = New nbfReportForm(Me, pvSI) '(Me)
            If AllowSaveAsShared And Not LoadAsShared Then
                mmr.SaveAsSharedReportToolStripMenuItem.Visible = True
            ElseIf LoadAsShared Then
                mmr.LoadFromDB = True
            End If
            if not pvMdiParentForm is nothing then
                mmr.MdiParent =  pvMdiParentForm
                mmr.ExitToolStripMenuItem.Text = "Close"
                mmr.MenuStrip1.Visible = False
            End If
            If DisallowLayoutEdit Then
                mmr.AllowControlEdit = False
            End If
            If AppConnectDB Then
                mmr.SetConnectInfo(pvDSN, pvUserName, pvPassWord, pvDataBaseName, pvAppPath, Template, pvParamCollection, pvCurrentDefaultPrefix, pvPrinterName, pvCurrentDate, pvCompanyName, pvScopeDes, pvSkinName)
            Else
                mmr.SetConnectInfo(pvDbc, pvAppPath, Template, pvParamCollection, pvCurrentDefaultPrefix, pvPrinterName, pvCurrentDate, pvCompanyName, pvScopeDes, pvSkinName, pvDisposeDB)
            End If
            mmr.DisAllowEnableLayoutEdit = DisAllowEnableLayoutEdit
            AddHandler mmr.Closed, AddressOf OnFormClosed
            mmr.Show()
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    Public Property MdiParentForm as Form
    Get
            Return pvMdiParentForm
    End Get
    Set
            pvMdiParentForm = Value
    End Set
    End Property
    Public Property DisAllowEnableLayoutEdit() As Boolean
        Get
            Return pvDisAllowEnableLayoutEdit
        End Get
        Set(ByVal value As Boolean)
            pvDisAllowEnableLayoutEdit = value
        End Set
    End Property
    Public Property AllowSaveAsShared() As Boolean
        Get
            Return pvAllowSaveAsShared
        End Get
        Set(ByVal value As Boolean)
            pvAllowSaveAsShared = value
        End Set
    End Property
    Public Property LoadAsShared() As Boolean
        Get
            Return pvLoadAsShared
        End Get
        Set(ByVal value As Boolean)
            pvLoadAsShared = value
        End Set
    End Property
    'public Sub ShowBrowser()
    '    if pvDBC is nothing then
    '        msgbox("Cannot Show Browser Until Database Connection has been Set")
    '        exit sub
    '    End If
    '    dim bf as New nbfBrowseForm(pvDBC,pvSI,pvAppPath,pvTemplateName)
    '    bf.Show
    'End Sub
    Private Sub OnFormClosed(ByVal sender As Object, ByVal e As EventArgs)
        ExitThread()
    End Sub
    Private Sub OnPrintComplete()
        ExitThread()
    End Sub
    Public Property SI() As nbfStyleInfo.AppStyle
        Get
            Return pvSI
        End Get
        Set(ByVal Value As nbfStyleInfo.AppStyle)
            pvSI = Value
            If Not pvSI Is Nothing Then
                pvSkinName = pvSI.SkinName
            End If
        End Set
    End Property
    Public WriteOnly Property SiWithoutSkin() As nbfStyleInfo.AppStyle
        Set(ByVal value As nbfStyleInfo.AppStyle)
            pvSI = value
            pvSkinName = ""
        End Set
    End Property
    'Public Property HostUI as nbfUIMonitor.nbfUIMonitor
    'Get
    '    Return pvHostUI
    'End Get
    'Set
    '    pvHostUI = Value
    'End Set
    'End Property
    Shared Sub SetStyles(ByVal prControl As Control, ByVal si As nbfStyleInfo.AppStyle)
        Dim c As Control
        Dim tp As TabPage
        If si Is Nothing Then
            Exit Sub
        End If
        If TypeOf prControl Is Form Then
            prControl.BackColor = si.FormBackColour
            prControl.ForeColor = si.CtrlForeColour
            'prControl.Font = si.FormFont
            'prControl.FontHeight = si.FormFont.Height
        End If
        For Each c In prControl.Controls
            SetCtrlStyle(c, si)
            SetStyles(c, si)
        Next
    End Sub
    Friend Sub DrillCLicked(ByVal bc As nbfBrowseCtrl, ByVal Plist As ArrayList)
        'If Not pvHostUI Is Nothing Then
        '    Dim e As New nbfUIMonitor.nbfUIActionParams
        '    If bc.SourceType = "DirectNBF" Then
        '        e.Action = nbfUIMonitor.nbfUIActionParams.ActionType.NBFRequest
        '        e.Ref = CDec(bc.NBFFunction)
        '        e.IDCode = bc.NBFDrillRequestCode
        '    Else
        '        e.Action = nbfUIMonitor.nbfUIActionParams.ActionType.OpenDoorRequest
        '        e.IDCode = bc.DrillTemplate
        '    End If
        '    e.BrowseSelectType = nbfUIMonitor.nbfUIActionParams.BrowseType.Standard
        '    e.ReturnObject = Plist
        '    Dim a As New nbfUIMonitor.nbfUIActionEventArgs(e)
        '    pvHostUI.ReportEvent(Me, a)
        'End If
    End Sub
    Shared Sub SetCtrlStyle(ByRef c As Control, ByVal si As nbfStyleInfo.AppStyle)
        'debug.WriteLine(c.GetType.Name)
        Dim fht As Single
        Select Case c.GetType.Name
            Case "nbfGrid"
                'Ctype(c,odGridControls.nbfGrid).SI = si
            Case "SQLBrowseField"
                CType(c, nbfSQLReportBrowserCtrls.SQLBrowseField).ForeColor = si.CtrlForeColour
                CType(c, nbfSQLReportBrowserCtrls.SQLBrowseField).BackColor = si.CtrlBackColour
                CType(c, nbfSQLReportBrowserCtrls.SQLBrowseField).BorderStyle = si.CtrlBorderStyle
                fht = CType(c, nbfSQLReportBrowserCtrls.SQLBrowseField).Font.GetHeight
                If CType(c, nbfSQLReportBrowserCtrls.SQLBrowseField).Height < fht Then
                    CType(c, nbfSQLReportBrowserCtrls.SQLBrowseField).Height = CInt(fht)
                End If
            Case "SQLBrowseTotal"
                CType(c, nbfSQLReportBrowserCtrls.SQLBrowseTotal).ForeColor = si.CtrlForeColour
                CType(c, nbfSQLReportBrowserCtrls.SQLBrowseTotal).BackColor = si.CtrlBackColour
                CType(c, nbfSQLReportBrowserCtrls.SQLBrowseTotal).BorderStyle = si.CtrlBorderStyle
                fht = CType(c, nbfSQLReportBrowserCtrls.SQLBrowseTotal).Font.GetHeight
                If CType(c, nbfSQLReportBrowserCtrls.SQLBrowseTotal).Height < fht Then
                    CType(c, nbfSQLReportBrowserCtrls.SQLBrowseTotal).Height = CInt(fht)
                End If
            Case "SQLBrowseAmalgum"
                CType(c, nbfSQLReportBrowserCtrls.SQLBrowseAmalgum).ForeColor = si.CtrlForeColour
                CType(c, nbfSQLReportBrowserCtrls.SQLBrowseAmalgum).BackColor = si.CtrlBackColour
                CType(c, nbfSQLReportBrowserCtrls.SQLBrowseAmalgum).BorderStyle = si.CtrlBorderStyle
                fht = CType(c, nbfSQLReportBrowserCtrls.SQLBrowseAmalgum).Font.GetHeight
                If CType(c, nbfSQLReportBrowserCtrls.SQLBrowseAmalgum).Height < fht Then
                    CType(c, nbfSQLReportBrowserCtrls.SQLBrowseAmalgum).Height = CInt(fht)
                End If
                'ctype(c,nbfSQLReportBrowserCtrls.SQLBrowseField).font = si.Labelfont
            Case "SQLBrowseLabel"
                CType(c, nbfSQLReportBrowserCtrls.SQLBrowseLabel).ForeColor = si.LabelForeColor
                CType(c, nbfSQLReportBrowserCtrls.SQLBrowseLabel).BackColor = si.LabelBackColor
                CType(c, nbfSQLReportBrowserCtrls.SQLBrowseLabel).BorderStyle = si.LabelBorderStyle
                CType(c, nbfSQLReportBrowserCtrls.SQLBrowseLabel).Height = CType(c, nbfSQLReportBrowserCtrls.SQLBrowseLabel).Font.GetHeight
                'ctype(c,nbfSQLReportBrowserCtrls.SQLBrowseLabel).font = si.Labelfont
            Case "SQLBrowseGrid"
                'CType(c, nbfSQLReportBrowserCtrls.SQLBrowseGrid).SI = si
            Case "Button", "SQLDrillDown"
                'allow styles from system
                'c.ForeColor = si.ButtonForeColor
                c.Font = si.CtrlFont
                'c.BackColor = si.ButtonBackColor
            Case "TextBox"
                c.ForeColor = si.CtrlForeColour
                'c.Font = si.CtrlFont
                If c.Height < c.Font.GetHeight Then
                    c.Height = c.Font.GetHeight
                End If
                c.BackColor = si.CtrlBackColour
            Case Else
                c.ForeColor = si.LabelForeColor
                'c.Font = si.LabelFont 
                c.BackColor = si.LabelBackColor
        End Select
    End Sub
    Public Property DataBaseName() As String
        Get
            Return pvDataBaseName
        End Get
        Set(ByVal Value As String)
            pvDataBaseName = Value
        End Set
    End Property
    Private Sub SetDefaultStyle()
        Dim DefFontFamily As System.Drawing.FontFamily
        pvSI.FormBackColour = System.Drawing.Color.WhiteSmoke
        pvSI.FormForeColour = System.Drawing.Color.Black
        Try
            pvSI.FormFont = New System.Drawing.Font("Tahoma", 8)
            pvSI.GridCaptionFont = New System.Drawing.Font("Tahoma", 8, Drawing.FontStyle.Bold)
        Catch
            pvSI.FormFont = New System.Drawing.Font(DefFontFamily.GenericSansSerif, 8)
            pvSI.GridCaptionFont = New System.Drawing.Font(DefFontFamily.GenericSansSerif, 8)
        End Try
        'if DisStyle = "D" then
        '    pvSi.LabelBackColor = system.Drawing.Color.Gainsboro
        'else
        pvSI.LabelBackColor = System.Drawing.Color.WhiteSmoke
        'end if
        pvSI.LabelForeColor = pvSI.FormForeColour
        pvSI.LabelFont = pvSI.FormFont
        pvSI.LabelBorderStyle = BorderStyle.None

        pvSI.InfoLabelBackColor = pvSI.FormBackColour
        pvSI.InfoLabelForeColor = System.Drawing.Color.Black
        pvSI.InfoLabelFont = pvSI.FormFont
        pvSI.InfoLabelBorderStyle = BorderStyle.None

        pvSI.CtrlBackColour = System.Drawing.SystemColors.Control
        pvSI.CtrlForeColour = System.Drawing.SystemColors.ControlText
        pvSI.CtrlFont = pvSI.FormFont
        pvSI.CtrlBorderStyle = BorderStyle.FixedSingle

        pvSI.ButtonBackColor = pvSI.CtrlBackColour
        pvSI.ButtonForeColor = pvSI.CtrlForeColour
        pvSI.HeadButtonBackColor = pvSI.CtrlBackColour

        pvSI.GridAlternatingBackColor = System.Drawing.Color.WhiteSmoke
        pvSI.GridBackColor = System.Drawing.Color.WhiteSmoke
        pvSI.GridBackgroundColor = System.Drawing.Color.WhiteSmoke

        pvSI.GridCaptionBackColor = System.Drawing.Color.WhiteSmoke
        pvSI.GridCaptionForecolor = System.Drawing.Color.Black

        pvSI.GridFont = pvSI.FormFont
        pvSI.GridForecolor = System.Drawing.Color.Black
        pvSI.GridLinecolor = System.Drawing.Color.Black
        pvSI.GridLineStyle = DataGridLineStyle.None

        pvSI.GridHeaderBackColor = System.Drawing.Color.WhiteSmoke
        pvSI.GridHeaderFont = pvSI.FormFont
        pvSI.GridHeaderForecolor = System.Drawing.Color.Black

        pvSI.GridSelectionBackColor = System.Drawing.Color.CadetBlue
        pvSI.GridSelectionForecolor = System.Drawing.Color.WhiteSmoke

        pvSI.GridLinkcolor = System.Drawing.Color.Teal

        pvSI.GridParentRowsBackColor = System.Drawing.Color.WhiteSmoke
        pvSI.GridParentRowsForecolor = System.Drawing.Color.Black

        pvSI.GridPreferredColumnWidth = 75
        pvSI.GridPreferredRowHeight = 16

        pvSI.StdTextBoxHeight = 18

        pvSI.GridFlatMode = True

        pvSI.GridBorderStyle = BorderStyle.FixedSingle
    End Sub
    Sub WriteRegistry(ByVal ParentKey As RegistryKey, ByVal SubKey As String, _
    ByVal ValueName As String, ByVal Value As Object)

        Dim Key As RegistryKey

        Try
            'Open the registry key.
            Key = ParentKey.OpenSubKey(SubKey, True)
            If Key Is Nothing Then 'if the key doesn't exist.
                Key = ParentKey.CreateSubKey(SubKey)
            End If

            'Set the value.
            Key.SetValue(ValueName, Value)

            Console.WriteLine("Value:{0} for {1} is successfully written.", Value, ValueName)
        Catch e As Exception
            Console.WriteLine("Error occurs in WriteRegistry" & e.Message)
        End Try
    End Sub
Function ReadRegistry(ByVal ParentKey As RegistryKey, ByVal SubKey As String, _
    ByVal ValueName As String, ByRef Value As Object) as boolean

    Dim Key As RegistryKey

    Try
        'Open the registry key.
        Key = ParentKey.OpenSubKey(SubKey, True)
        If Key Is Nothing Then 'if the key doesn't exist
            Throw New Exception("The registry key doesn't exist")
        End If

        'Get the value.
        Value = Key.GetValue(ValueName)
        Return True
        'Console.WriteLine("Value:{0} for {1} is successfully retrieved.", Value, ValueName)
    Catch e As Exception
        'Console.WriteLine("Error occurs in ReadRegistry" & e.Message)
        Return False
    End Try
End Function
Public Overloads Sub Dispose() Implements IDisposable.Dispose
      Dispose(true)
      GC.SuppressFinalize(Me) 
   End Sub
Protected Overloads Overridable Sub Dispose(disposing As Boolean)
   ' Check to see if Dispose has already been called.
   If Not (Me.gdisposed) Then
      ' If disposing equals true, dispose all managed 
      ' and unmanaged resources.
      If (disposing) Then
        pvSI = nothing
        do while pvParamCollection.Count > 0
            pvParamCollection.Remove(1)
        Loop
      End If
      ' Release unmanaged resources. If disposing is false,
      ' only the following code is executed.      
   End If
   Me.gdisposed = true
End Sub
    Protected Overrides Sub Finalize()
        dispose(false)
    End Sub		
    Protected Overrides Sub OnMainFormClosed(ByVal sender As Object, ByVal e As System.EventArgs)
        mybase.OnMainFormClosed(sender,e)
    End Sub
    Private Sub nbfBrowseHost_ThreadExit(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.ThreadExit
        debug.WriteLine("Exiting")
    End Sub
End Class
Public Class ParamInfo
    Public ParamNo As Integer
    Public ParamVal As String
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