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