摘要:My Library - Class
LIBClass.vb
Option Explicit On Option Explicit On Imports ...System.Data.OleDb Imports CrystalDecisions.CrystalReports.Engine Imports CrystalDecisions.Shared Imports C1.Win.C1FlexGrid 
Imports System.Collections.Generic 'f mean function without return value
'o mean return value is object
'b mean return value is boolean
'i mean return value is integer
's mean return value is string
"ClassSQLExecuteHelper"#Region "ClassSQLExecuteHelper" ' Used in : Many
' Property :
' History :
' 2009-06-05 : change to use bCheckDBConnection()
Public Class ClassSQLExecuteHelper Public msSQLArraylist As New ArrayList 
Public Sub AddSQL() Sub AddSQL(ByVal psSQLString As String) If psSQLString <> BLANK Then msSQLArraylist.Add(psSQLString) Else ' Call MsgBoxOkOnly("It is Blank SQL.") Debug.Print("ClassSQLExecuteHelper - AddSQL() It is Blank SQL") End If 
End Sub Public Function bExecute() Function bExecute() As Boolean bExecute = False Dim cmdSql As New OleDbCommand Try If nsSQL.bCheckDBConnection() = False Then Exit Function ' Begin Transaction cmdSql.Connection = gcnOLEDBHIS cmdSql.Transaction = gcnOLEDBHIS.BeginTransaction For liSQL As Integer = 0 To msSQLArraylist.Count - 1 cmdSql.CommandText = msSQLArraylist.Item(liSQL) Call cmdSql.ExecuteNonQuery() Next ' Commit Transaction cmdSql.Transaction.Commit() cmdSql.Dispose() bExecute = True Catch Err As Exception 'Rollback Transaction cmdSql.Transaction.Rollback() cmdSql.Dispose() Call ErrHandler(Err.Message, APP_NAME) End Try End Function End Class #End Region "ClassSQLSaveHelper"#Region "ClassSQLSaveHelper" ' Used in : Many
' Desc : Easy Code for Insert/Update/Save
' History :
' 2009-03-06 : Create this Class
Public Class ClassSQLSaveHelper Public TableName As String = BLANK Public SQLExtraSelect As String = BLANK Public SQLExtraCriteria As String = BLANK Private SearchKeyNames As New ArrayList Private SearchKeyValues As New ArrayList Private FieldNames As New ArrayList Private Fields As New ArrayList Private FieldUniCodes As New ArrayList Public Sub AddSearchKey() Sub AddSearchKey(ByVal psSearchKeyName As String, ByVal psSearchKeyValue As String) ' AddSearchKey -) add criteria fields (eg : where XXX = YYY) Try Me.SearchKeyNames.Add(psSearchKeyName) Me.SearchKeyValues.Add(psSearchKeyValue) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Public Sub AddField() Sub AddField(ByVal psSQLFieldName As String, ByVal psSaveValue As Object, Optional ByVal pbChineseField As Boolean = False) ' AddField -) Field that we want to make change in Database (insert / update) Try Me.FieldNames.Add(psSQLFieldName) Me.Fields.Add(psSaveValue) Me.FieldUniCodes.Add(pbChineseField) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub 'Select Case psSaveValue.GetType.Name ' Case "String" ' psSaveValue = vntFixNull(psSaveValue) ' Case Else 'End Select "3 SQL type"#Region "3 SQL type" Public Function sGenerateSQLInsert() Function sGenerateSQLInsert() As String ' will change to sAddFullRecordClass sGenerateSQLInsert = BLANK Try ' Initialize the return flag to false. Dim lsSql As String ' Final SQL statement for record insertion Dim lsSQLselect As String ' SQL statement for Selection part Dim lsSQLUpdate As String ' Fields of table for SQL record insertion Dim liNumOfFields As Short ' Counter for looping the insertion field name ' Prepare SQL statement. lsSQLselect = "Insert into " & Me.TableName & " " lsSQLUpdate = "(" 'Construct the fields required for record insertion For liNumOfFields = 0 To Me.FieldNames.Count - 1 If Me.FieldNames(liNumOfFields) <> BLANK Then If lsSQLUpdate <> "(" Then lsSQLUpdate = lsSQLUpdate & ", " lsSQLUpdate = lsSQLUpdate & Me.FieldNames(liNumOfFields) End If Next liNumOfFields lsSQLUpdate = lsSQLUpdate & ") " lsSQLUpdate = lsSQLUpdate & "values (" 'Construct the fields values for record insertion For liNumOfFields = 0 To Me.FieldNames.Count - 1 If Me.FieldNames(liNumOfFields) <> BLANK Then If liNumOfFields > 0 Then lsSQLUpdate = lsSQLUpdate & ", " If Me.FieldUniCodes(liNumOfFields) = True And vntFixNull(Me.Fields(liNumOfFields)) <> BLANK Then lsSQLUpdate = lsSQLUpdate & "N" & VarSQLString(Me.Fields(liNumOfFields)) Else lsSQLUpdate = lsSQLUpdate & VarSQLString(Me.Fields(liNumOfFields)) End If End If Next liNumOfFields lsSQLUpdate = lsSQLUpdate & ") " ' Display error messsage when no condition was specified. If Trim(lsSQLUpdate) = "() values ()" Then MsgBox("No condition specified in SQL", MsgBoxStyle.OkOnly, "Record Creation Error") Exit Function End If ' Construct the full SQL statement. lsSql = lsSQLselect & lsSQLUpdate sGenerateSQLInsert = lsSql Catch ERR As Exception Call ErrHandler(ERR.Message, "General Error") End Try End Function Public Function sGenerateSQLDelete() Function sGenerateSQLDelete() As String ' will change to sDeleteFullRecordClass sGenerateSQLDelete = BLANK Try Dim lsSql As String ' Final SQL statement for record deletion Dim lsSQLselect As String ' SQL statement for Selection part Dim lsSQLCriteria As String ' Deletion criteria Dim liNumOfKeys As Short ' Number of fields required for deletion ' Constructing the SQL statement for record deletion. lsSQLselect = "Delete from " & Me.TableName & " " lsSQLCriteria = "Where " 'If Not IsDBNull(me.SearchKeyValues(0)) And Not IsNothing(me.SearchKeyValues(0)) Then For liNumOfKeys = 0 To Me.SearchKeyNames.Count - 1 If liNumOfKeys > 0 Then lsSQLCriteria = lsSQLCriteria & "and " lsSQLCriteria = lsSQLCriteria & Me.SearchKeyNames(liNumOfKeys) & " = " & VarSQLString(Me.SearchKeyValues(liNumOfKeys)) & " " Next 'End If ' Construct for the extra SQL statment of Where clause. If Me.SQLExtraCriteria <> BLANK Then lsSQLCriteria = lsSQLCriteria & "and " & Me.SQLExtraCriteria & " " End If ' Display error message when no condition for record deletion. If Trim(lsSQLCriteria) = "Where " Then MsgBox("No condition specified in SQL", MsgBoxStyle.OkOnly, "Record Deletion Error") Exit Function End If ' Construct the completed SQL statement lsSql = lsSQLselect & lsSQLCriteria sGenerateSQLDelete = lsSql Catch ERR As Exception Call ErrHandler(ERR.Message, "General Error") End Try End Function Public Function sGenerateSQLUpdate() Function sGenerateSQLUpdate() As String ' will change to sUpdateFullRecordClass sGenerateSQLUpdate = BLANK Try Dim lsSql As String ' Final SQL statement for update Dim lsSQLselect As String = BLANK ' SQL statement for selection part Dim lsSQLUpdate As String ' SQL statement for "Set" update fields. Dim lsSQLCriteria As String Dim liNumOfFields As Short Dim liNumOfKeys As Short 'Construct SQL statement for update lsSQLselect = lsSQLselect & "Update " & Me.TableName & " " lsSQLUpdate = "Set " ' Construct the number of fields required to update on lsSQLUpdate string For liNumOfFields = 0 To Me.FieldNames.Count - 1 If Me.FieldNames(liNumOfFields) <> BLANK Then If lsSQLUpdate <> "Set " Then lsSQLUpdate = lsSQLUpdate & ", " If Me.FieldUniCodes(liNumOfFields) = True And vntFixNull(Me.Fields(liNumOfFields)) <> BLANK Then lsSQLUpdate = lsSQLUpdate & Me.FieldNames(liNumOfFields) & " = N" & VarSQLString(Me.Fields(liNumOfFields)) & " " Else lsSQLUpdate = lsSQLUpdate & Me.FieldNames(liNumOfFields) & " = " & VarSQLString(Me.Fields(liNumOfFields)) & " " End If End If Next ' Display the error message when no condition was selected for update If Trim(lsSQLUpdate) = "Set" Then MsgBox("No criteria specified in SQL", MsgBoxStyle.OkOnly, "Update Full Record") Exit Function End If 'Construct where clause for the SQL data manipulation lsSQLCriteria = "Where " 'If Not IsDBNull(me.SearchKeyValues(0)) And Not IsNothing(me.SearchKeyValues(0)) Then For liNumOfKeys = 0 To Me.SearchKeyNames.Count - 1 If liNumOfKeys > 0 Then lsSQLCriteria = lsSQLCriteria & "and " lsSQLCriteria = lsSQLCriteria & Me.SearchKeyNames(liNumOfKeys) & " = " & VarSQLString(Me.SearchKeyValues(liNumOfKeys)) & " " Next liNumOfKeys 'End If ' Construct for the SQL extra criteria condition If Me.SQLExtraCriteria <> BLANK Then lsSQLCriteria = lsSQLCriteria & "and " & Me.SQLExtraCriteria & " " End If If Trim(lsSQLCriteria) = "Where" Then MsgBox("No criteria specified in SQL", MsgBoxStyle.OkOnly, "Update Error") Exit Function End If ' Construct the final SQL statement. lsSql = lsSQLselect & lsSQLUpdate & lsSQLCriteria sGenerateSQLUpdate = lsSql Catch Err As Exception Call ErrHandler(Err.Message, "General Error") End Try End Function #End Region End Class #End Region "ClassSQLLoadHelper"#Region "ClassSQLLoadHelper" ' Used in : Many
' Desc : Easy Code for Load
' History :
' 2009-03-06 : Create this Class
Public Class ClassSQLLoadHelper ' class record loading Public SQLString As String = BLANK Public TableName As String = BLANK Public SQLExtraSelect As String = BLANK Public SQLExtraCriteria As String = BLANK Public SQLOrder As String = BLANK Public SQLGroupBy As String = BLANK Private RequiredFields As New ArrayList ''' <summary> ''' Field name that we want to select ''' </summary> ''' <param name="psSQLFieldName">Name of the SQLField.</param> Public Sub AddRequiredField() Sub AddRequiredField(ByVal psSQLFieldName As String) ' AddRequiredField -) Try Me.RequiredFields.Add(psSQLFieldName) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub ''' <summary> ''' Generate select SQL ''' </summary> ''' <returns></returns> Public Function sGenerateSqlSelect() Function sGenerateSqlSelect() As String sGenerateSqlSelect = BLANK Try Dim lsSQLSelect As String ' SQL statement for Selection part Dim lsSQLCriteria As String ' SQL criteria Dim lsSQLOrder As String ' SQL ordering sequence Dim liNumReqFields As Short ' Counter for the number of fields Dim lsFieldsRequired As String = BLANK ' Fields of table for SQL statement ' Constructing the SQL statement for record retrieval fields. For liNumReqFields = 0 To Me.RequiredFields.Count - 1 If liNumReqFields > 0 Then lsFieldsRequired = lsFieldsRequired & ", " lsFieldsRequired = lsFieldsRequired & Me.RequiredFields(liNumReqFields) Next liNumReqFields ' Construct SQL statement with using retrieval fields variable lsFieldsRequired. lsSQLSelect = "Select " & lsFieldsRequired & " From " & Me.TableName & " " ' Construct SQL statement with extra SQL select statement. If Me.SQLExtraSelect <> BLANK Then lsSQLSelect = lsSQLSelect & Me.SQLExtraSelect & " " End If ' Initialize the SQL Criteria to [Where]. lsSQLCriteria = "Where " 'Construct SQL extra criteria statement. If Me.SQLExtraCriteria <> BLANK Then If Trim(lsSQLCriteria) <> "Where" Then lsSQLCriteria = lsSQLCriteria & "and " lsSQLCriteria = lsSQLCriteria & Me.SQLExtraCriteria & " " End If 'Remove the [Where] in lsSQLCriteria when there is no filtering condition. If Trim(lsSQLCriteria) = "Where" Then lsSQLCriteria = "" lsSQLOrder = BLANK ' Construct Group by SQL statement. (Avoid of using this) If Trim(Me.SQLGroupBy) <> BLANK Then lsSQLOrder = " Group by " & Me.SQLGroupBy ' Construct Order by SQL statement. If Trim(Me.SQLOrder) <> BLANK Then lsSQLOrder = lsSQLOrder & " Order by " & Me.SQLOrder 'Final SQL statement construction. Me.SQLString = lsSQLSelect & lsSQLCriteria & lsSQLOrder sGenerateSqlSelect = Me.SQLString Catch ERR As Exception Call ErrHandler(ERR.Message, "General Error") End Try End Function ''' <summary> ''' Fill combo data set. ''' </summary> ''' <param name="pcboAny">Combo Box</param> ''' <param name="pbAll">contain All option or not<c>true</c> [pb all].</param> Public Sub fFillComboDataSet() Sub fFillComboDataSet(ByRef pcboAny As C1.Win.C1List.C1Combo, Optional ByVal pbAll As Boolean = False) Try Dim lsSQLString As String = BLANK lsSQLString = Me.sGenerateSqlSelect() Call nsComboBox.FillComboDataSet(pcboAny, lsSQLString, pbAll) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub ''' <summary> ''' Fill combo single coulmn. ''' </summary> ''' <param name="pCombo">Combo Box</param> Public Sub fFillComboSingleCoulmn() Sub fFillComboSingleCoulmn(ByRef pCombo As C1.Win.C1List.C1Combo) ' use SQLString ' only take the first column Try Dim lsSQLString As String = Me.sGenerateSqlSelect() Call nsComboBox.FillComboSingleCoulmn(pCombo, lsSQLString) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub ''' <summary> ''' Load one 1 value from SQLString ''' </summary> ''' <param name="psFieldName">Name of the field.</param> ''' <returns></returns> Public Function oSQLLoadOneField() Function oSQLLoadOneField(ByVal psFieldName As String) As Object oSQLLoadOneField = BLANK Try Dim lsSQLString As String = Me.sGenerateSqlSelect() oSQLLoadOneField = nsSQL.oSQLLoadOneField(lsSQLString, psFieldName) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Function End Class #End Region "ClassRecordLoadHelper"#Region "ClassRecordLoadHelper" ' Used in : Many
' Property : If The SQL do not contain that field, will return value Blank
' : eg : select Reqest_No from Patient, if get other field
' History :
' 2009-05-27 : add boolean for connect or not, if not then exit sub
Public Class ClassRecordLoadHelper ' ClassRecordLoadHelper : use for loading DB's data to window control(Textbox, CheckBox, DataTimePicker...). Private drSQL As OleDbDataReader Private cmSQL As OleDbCommand Private ClsSQLHelper As New ClassSQLHelper Public mbConnect As Boolean = False "bReadStart, bReadEnd, SetConnection"#Region "bReadStart, bReadEnd, SetConnection" Public Function bReadStart() Function bReadStart() As Boolean bReadStart = False Try If mbConnect = False Then MsgBoxOkOnly(" Please restart the program,as it is disconnected.") Exit Function End If bReadStart = drSQL.Read() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Function Public Sub bReadEnd() Sub bReadEnd() Try drSQL.Close() cmSQL.Dispose() Catch Err As Exception End Try End Sub Public Sub SetConnection() Sub SetConnection(ByRef psSQLString As String) Try mbConnect = nsSQL.bCheckDBConnection If mbConnect = False Then Exit Sub cmSQL = New OleDbCommand(psSQLString, gcnOLEDBHIS) drSQL = cmSQL.ExecuteReader() ClsSQLHelper.SetOleDbDataReader(drSQL) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "fLoadSQLField"#Region "fLoadSQLField" Public Sub fLoadSQLField() Sub fLoadSQLField(ByVal psSQLFieldName As String, ByRef psLoadValue As Object) Try psLoadValue = ClsSQLHelper.oLoadSQLField(psSQLFieldName) Catch Err As Exception Call drSQL.Close() Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "oLoadSQLField"#Region "oLoadSQLField" Public Function oLoadSQLField() Function oLoadSQLField(ByVal psSQLFieldName As String) As Object oLoadSQLField = BLANK Try oLoadSQLField = ClsSQLHelper.oLoadSQLField(psSQLFieldName) Catch Err As Exception Call drSQL.Close() Call ErrHandler(Err.Message, APP_NAME) End Try End Function #End Region End Class #End Region "ClassGridHelper"#Region "ClassGridHelper" ' Class : ClassGridHelper
' Used in : ROE, LOEPrinting, WardLOE
' History :
' 2009-05-27 : add boolean for connect or not, if not then exit sub
Public Class ClassGridHelper Private drSQL As OleDbDataReader Private cmSQL As OleDbCommand Private mGrid As C1.Win.C1FlexGrid.C1FlexGrid Private miRow As Integer Private mFieldArraylist As New ArrayList Private ClsSQLHelper As New ClassSQLHelper Public mbConnect As Boolean = False "fHighlightGridRow"#Region "fHighlightGridRow" Public Sub fHighlightGridRow() Sub fHighlightGridRow(ByVal psGridColName As String, ByVal psSearchKey As String) ' Hightlight the Row of mGrid where it's psColumn containing psSearchKey ' used in event of TextChanged in TextBox Try Dim liRow As Integer = iSearchGrid(psGridColName, psSearchKey) If liRow > 0 Then mGrid.Select(liRow, 0) Else mGrid.Select(0, 0) End If Catch Err As Exception End Try End Sub #End Region "fAddGridRow, iGetGridRow"#Region "fAddGridRow, iGetGridRow" Public Sub fAddGridRow() Sub fAddGridRow() Try mGrid.Rows.Add() miRow = mGrid.Rows.Count - mGrid.Rows.Fixed() Catch Err As Exception End Try End Sub Public Function iGetGridRow() Function iGetGridRow() As Integer ' iGetGridRow -) get no. of row of mGrid Try miRow = mGrid.Rows.Count - mGrid.Rows.Fixed() iGetGridRow = miRow Catch Err As Exception End Try End Function #End Region Public Sub fAutoSize() Sub fAutoSize() Try nsC1Grid.AutoSize(mGrid) Catch Err As Exception End Try End Sub "bContain"#Region "bContain" Public Function bContain() Function bContain(ByVal psGridColName As String, ByVal poSearchKey As Object) As Boolean ' Grid contain that record or not bContain = False Try Dim liRow As Integer = iSearchGrid(psGridColName, poSearchKey) If liRow > 0 Then bContain = True End If Catch Err As Exception End Try End Function Private Function iSearchGrid() Function iSearchGrid(ByVal psGridColName As String, ByVal poSearchKey As Object) As Integer Try iSearchGrid = 0 If mGrid Is Nothing Then Call MsgBoxOkOnly("No Record") Exit Function End If Dim liRow As Integer = mGrid.Rows.Count - mGrid.Rows.Fixed() For liCount As Integer = 1 To liRow If TypeOf poSearchKey Is String Then If mGrid.Item(liCount, psGridColName).indexof(poSearchKey) > -1 Then mGrid.Select(liCount, 1) iSearchGrid = liCount Exit Function End If End If If TypeOf poSearchKey Is Boolean Then If mGrid.Item(liCount, psGridColName) = poSearchKey Then mGrid.Select(liCount, 1) iSearchGrid = liCount Exit Function End If End If Next Catch Err As Exception End Try End Function #End Region "SetC1FlexGrid, SetOleDbDataReader"#Region "SetC1FlexGrid, SetOleDbDataReader" Public Sub SetC1FlexGrid() Sub SetC1FlexGrid(ByRef mGrid As C1.Win.C1FlexGrid.C1FlexGrid, Optional ByVal pbClearGrid As Boolean = False) Try If pbClearGrid = True Then Call nsC1Grid.ClearGrid(mGrid) End If Me.mGrid = mGrid Call FillFieldList() Catch Err As Exception End Try End Sub Public Function bExistGridField() Function bExistGridField(ByVal psSQLFieldName As String) As Boolean Try bExistGridField = False If mFieldArraylist.Contains(psSQLFieldName.ToLower) Then bExistGridField = True Else Console.WriteLine(Me.mGrid.Name & " - No this Grid Field : " & psSQLFieldName) End If Catch Err As Exception End Try End Function Private Sub FillFieldList() Sub FillFieldList() Try ' FillFieldList -) Fill the Grid Column into Arraylist list for bExistGridField Use For liField As Integer = 0 To mGrid.Cols.Count - 1 mFieldArraylist.Add(mGrid.Cols(liField).Name.ToLower) Next Catch Err As Exception End Try End Sub #End Region "bReadStart, bReadEnd, SetConnection"#Region "bReadStart, bReadEnd, SetConnection" Public Function bReadStart() Function bReadStart() As Boolean bReadStart = False Try If mbConnect = False Then MsgBoxOkOnly(" Please restart the program,as it is disconnected.") Exit Function End If bReadStart = drSQL.Read() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Function Public Sub bReadEnd() Sub bReadEnd() Try drSQL.Close() cmSQL.Dispose() Catch Err As Exception End Try End Sub Public Sub SetConnection() Sub SetConnection(ByRef psSQLString As String) Try mbConnect = nsSQL.bCheckDBConnection If mbConnect = False Then Exit Sub cmSQL = New OleDbCommand(psSQLString, gcnOLEDBHIS) drSQL = cmSQL.ExecuteReader() ClsSQLHelper.SetOleDbDataReader(drSQL) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "fFillGridFieldFromSQL"#Region "fFillGridFieldFromSQL" Public Sub fFillGridFieldFromSQL() Sub fFillGridFieldFromSQL(ByVal psSQLFieldName As String, Optional ByVal psGridColName As String = BLANK) ' If GridColName = SQLFieldName, no need to input GridColName. Try If psGridColName = BLANK Then If bExistGridField(psSQLFieldName) = True Then mGrid.Item(miRow, psSQLFieldName) = ClsSQLHelper.oLoadSQLField(psSQLFieldName) End If Else If bExistGridField(psGridColName) = True Then mGrid.Item(miRow, psGridColName) = ClsSQLHelper.oLoadSQLField(psSQLFieldName) End If End If Catch Err As Exception End Try End Sub Public Sub fFillGridFieldFromSQL() Sub fFillGridFieldFromSQL(ByVal psSQLBooleanFieldName As String, ByVal psGridColName As String, ByVal psGridDisplayText As String) ' If psSQLBooleanFieldName = true, then fill psGridDisplayText into psGridColName Try If bExistGridField(psGridColName) = True Then If ClsSQLHelper.oLoadSQLField(psSQLBooleanFieldName) = True Then mGrid.Item(miRow, psGridColName) = psGridDisplayText End If End If Catch Err As Exception End Try End Sub #End Region "oLoadSQLField"#Region "oLoadSQLField" Public Function oLoadSQLField() Function oLoadSQLField(ByVal psSQLFieldName As String) As Object oLoadSQLField = BLANK Try oLoadSQLField = ClsSQLHelper.oLoadSQLField(psSQLFieldName) Catch Err As Exception End Try End Function #End Region End Class #End Region "ClassSQLHelper"#Region "ClassSQLHelper" ' Class : ClassSQLHelper
' Used in : LOEPrinting,ROE
' History :
' 2009-05-27 : change bCheckDBConnection to check network connection.
Friend Class ClassSQLHelper Public mdrSQL As OleDbDataReader Private FieldArraylist As New ArrayList "oLoadSQLField"#Region "oLoadSQLField" Public Function oLoadSQLField() Function oLoadSQLField(ByVal psSQLFieldName As String) As Object oLoadSQLField = BLANK Try Select Case psSQLFieldName ' special case : user define case Case "PatientName" oLoadSQLField = sPatientName(vntFixNull(mdrSQL("PV_Surname")), vntFixNull(mdrSQL("PV_Given_Name")), vntFixNull(mdrSQL("ChiName"))) Case "DoctorName" oLoadSQLField = sDoctorName(vntFixNull(mdrSQL("Doctor_Surname")), vntFixNull(mdrSQL("Doctor_GivenName")), BLANK) Case Else If bExistSQLField(psSQLFieldName) = True Then oLoadSQLField = oLoadSQLData_NormalCase(psSQLFieldName) Else ' may forgot to insert the field ' Debug.Print("No this SQL field : " & psSQLFieldName) End If End Select Catch Err As Exception End Try End Function Private Function oLoadSQLData_NormalCase() Function oLoadSQLData_NormalCase(ByVal psSQLFieldName As String) As Object oLoadSQLData_NormalCase = BLANK Try Select Case mdrSQL.GetFieldType((mdrSQL.GetOrdinal(psSQLFieldName))).ToString Case "System.String" oLoadSQLData_NormalCase = vntFixNull(mdrSQL(psSQLFieldName)) Case "System.DateTime" oLoadSQLData_NormalCase = FormatDateSec(vntFixNull(mdrSQL(psSQLFieldName))).ToString.Replace("00:00:00", BLANK) Case "System.Boolean" oLoadSQLData_NormalCase = bGetBoolean(vntFixNull(mdrSQL(psSQLFieldName))) Case Else oLoadSQLData_NormalCase = vntFixNull(mdrSQL(psSQLFieldName)) End Select Catch Err As Exception End Try End Function #End Region "SetOleDbDataReader"#Region "SetOleDbDataReader" Public Sub SetOleDbDataReader() Sub SetOleDbDataReader(ByRef drSQL As OleDbDataReader) Try Me.mdrSQL = drSQL ' Call bCheckDBConnection() Call Me.FillFieldList() Catch Err As Exception End Try End Sub #End Region "bExistSQLField"#Region "bExistSQLField" Public Function bExistSQLField() Function bExistSQLField(ByVal psSQLFieldName As String) As Boolean Try bExistSQLField = False If FieldArraylist.Contains(psSQLFieldName.ToLower) Then bExistSQLField = True End If Catch Err As Exception End Try End Function #End Region "FillFieldList"#Region "FillFieldList" Private Sub FillFieldList() Sub FillFieldList() Try For liField As Integer = 0 To mdrSQL.FieldCount - 1 FieldArraylist.Add(mdrSQL.GetName(liField).ToLower) Next Catch Err As Exception End Try End Sub #End Region 'Public Function bCheckDBConnection() Function bCheckDBConnection() As Boolean ' bCheckDBConnection = False ' Try ' If My.Computer.Network.IsAvailable Then ' If gcnOLEDBHIS.State = ConnectionState.Open Then ' bCheckDBConnection = True ' Else ' gcnOLEDBHIS.Open() ' End If ' End If ' Catch Err As Exception ' Call ErrHandler(Err.Message, APP_NAME) ' End Try 'End Function End Class #End Region "ClassGridButton"#Region "ClassGridButton" ' Used in : ROE , LIS, LOE...
' History :
' 2009-05-13 - remove button label "New"
' 2009-05-21 - 2 path, when <300, then refresh all, when > 300 refresh selected row +-40
' 2009-05-29 - grid button after sorting the grid ,then sort the button too.
' 2009-06-20 - when >300 rows, auto Add AfterScoll Handler.
' 2009-07-17 - add mbuttonVisibleWidth.
' 2009-07-23 - C1.Grid can add image. mGrid.SetCellImage, so this function is not the only choice.
"ClassGridButton"#Region "ClassGridButton" Public Class ClassGridButton Private mArrayList As New ArrayList Private mGrid As C1.Win.C1FlexGrid.C1FlexGrid Public cmdGridButton As Button Public miButtonVisibleWidth As Integer = 0 Public Sub SetButtonVisibleWidth() Sub SetButtonVisibleWidth(ByVal piButtonVisibleWidth As Integer) Me.miButtonVisibleWidth = piButtonVisibleWidth End Sub Public Sub SetGridButtonName() Sub SetGridButtonName(Optional ByVal psGridButtonColName As String = BLANK) If psGridButtonColName <> BLANK Then Me.cmdGridButton.Text = psGridButtonColName End If End Sub Public Sub SetGridButtonToolTip() Sub SetGridButtonToolTip(ByVal pToolTip As ToolTip, ByVal psTip As String) pToolTip.SetToolTip(Me.cmdGridButton, psTip) End Sub Public Sub SetGridButtonImage() Sub SetGridButtonImage(ByVal psGridButtonImage As Image) Me.cmdGridButton.Image = psGridButtonImage End Sub "SetGridButton"#Region "SetGridButton" Public Sub SetGridButton() Sub SetGridButton(ByVal piRow As Integer, ByVal piCol As Integer, ByVal pbVisible As Boolean) 'reviewed Try Dim psGrid As C1.Win.C1FlexGrid.C1FlexGrid = mGrid Dim cmdGrid As New Button With cmdGrid .BackColor = System.Drawing.Color.DarkSlateGray .ForeColor = System.Drawing.Color.White .Tag = piRow If pbVisible = True Then .Text = " " End If .Enabled = pbVisible .Visible = False End With Me.cmdGridButton = cmdGrid ' AddHandler cmdGrid.Click, AddressOf grdButton_Click Me.mArrayList.Add(New ClassGridButtonHostedControl(psGrid, cmdGrid, piRow, piCol, miButtonVisibleWidth)) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Public Sub SetGridButton() Sub SetGridButton(ByVal piRow As Integer, ByVal psColName As String, ByVal pbVisible As Boolean) 'reviewed Try Dim liCol As Integer Dim lsGrid As C1.Win.C1FlexGrid.C1FlexGrid = mGrid liCol = lsGrid.Cols(psColName).Index Call SetGridButton(piRow, liCol, pbVisible) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "SetGrid, Grid_Paint, Grid_AfterScroll"#Region "SetGrid, Grid_Paint, Grid_AfterScroll" Private mbHasAfterScrollHandler As Boolean = False Public Sub SetGrid() Sub SetGrid(ByRef pGrid As C1.Win.C1FlexGrid.C1FlexGrid) 'reviewed Try Me.mGrid = pGrid AddHandler Me.mGrid.Paint, AddressOf Me.Grid_Paint Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub Grid_Paint() Sub Grid_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) 'reviewed ' Grid_Paint -) update all hosted controls when the grid changes in any way Try If Me.mGrid.Rows.Count < 300 Then Call DrawButtonAll() Else If mbHasAfterScrollHandler = False Then AddHandler Me.mGrid.AfterScroll, AddressOf Me.Grid_AfterScroll mbHasAfterScrollHandler = True End If Call DrawButton(True, Me.mGrid.RowSel) End If Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub Grid_AfterScroll() Sub Grid_AfterScroll(ByVal sender As Object, ByVal e As C1.Win.C1FlexGrid.RangeEventArgs) Try Me.HideButton(e.OldRange.TopRow) Me.mGrid.Select(e.NewRange.TopRow, False) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub DrawButton() Sub DrawButton(ByVal pbVisible As Boolean, ByVal psRowSel As Integer) Try Dim liRowSel As Integer = psRowSel Dim liRowCount As Integer = Me.mGrid.Rows.Count - 2 Dim liRowStart As Integer Dim liRowEnd As Integer Dim lcControl As ClassGridButtonHostedControl liRowStart = liRowSel - 40 liRowEnd = liRowSel + 40 If liRowStart < 0 Then liRowStart = 0 End If If liRowEnd >= liRowCount Then liRowEnd = liRowCount End If ' Set hide the previous button If pbVisible = True Then For liRow As Integer = liRowStart To liRowEnd lcControl = Me.mArrayList(liRow) lcControl.UpdatePosition() Next Else For liRow As Integer = liRowStart To liRowEnd lcControl = Me.mArrayList(liRow) lcControl.mControl.Visible = False Next End If Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub DrawButtonAll() Sub DrawButtonAll() Try Dim lcControl As ClassGridButtonHostedControl For Each lcControl In Me.mArrayList lcControl.UpdatePosition() Next Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "HideButton"#Region "HideButton" Public Sub HideButton() Sub HideButton(ByVal psRowSel As Integer) Try Call DrawButton(False, psRowSel) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "ClearGrid"#Region "ClearGrid" Public Sub ClearGrid() Sub ClearGrid(Optional ByVal pbClearGrid As Boolean = False) 'reviewed Try Me.mGrid.Controls.Clear() Me.mArrayList.Clear() If pbClearGrid = True Then Call nsC1Grid.ClearGrid(mGrid) End If Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region Public Sub SetButton() Sub SetButton(ByVal piRow As Integer, ByVal psCol As String, _ ByVal pbVisible As Boolean, _ Optional ByVal psName As String = BLANK, _ Optional ByVal pImage As Image = Nothing) Try Me.SetGridButton(piRow, psCol, pbVisible) Me.SetGridButtonName(psName) If pbVisible Then If pImage Is Nothing Then Else Me.SetGridButtonImage(pImage) End If End If Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Public Sub AutoSize() Sub AutoSize() Try nsC1Grid.AutoSize(mGrid) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub End Class #End Region "HostedControl - Class"#Region "HostedControl - Class" ' This class is used for Grid Button
Friend Class ClassGridButtonHostedControl ' Fields Friend mColumn As Column Friend mControl As Control Friend mC1FlexGrid As C1FlexGrid Friend mRow As Row Friend mButtonVisibleWidth As Integer = 0 Friend Sub New() New(ByVal pGrid As C1FlexGrid, ByVal pControl As Control, ByVal piRow As Integer, ByVal piCol As Integer, Optional ByVal pButtonVisibleWidth As Integer = 0) Try ' save info Me.mC1FlexGrid = pGrid Me.mControl = pControl Me.mRow = pGrid.Rows.Item(piRow) Me.mColumn = pGrid.Cols.Item(piCol) Me.mButtonVisibleWidth = pButtonVisibleWidth ' insert hosted control into grid Me.mC1FlexGrid.Controls.Add(Me.mControl) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Friend Sub UpdatePosition() UpdatePosition() 'reviewed Try ' get row/col indices Dim liRow As Integer = Me.mRow.Index Dim liCol As Integer = Me.mColumn.Index If ((liRow < 0) OrElse (liCol < 0)) Then Exit Sub End If ' get cell rect Dim lrRectangle As Rectangle = Me.mC1FlexGrid.GetCellRect(liRow, liCol) Me.mControl.Visible = False If liCol > 0 Then If lrRectangle.IntersectsWith(Me.mC1FlexGrid.GetCellRect(liRow, liCol - 1)) Then Exit Sub End If End If If liRow > 0 Then If lrRectangle.IntersectsWith(Me.mC1FlexGrid.GetCellRect(liRow - 1, liCol)) Then Exit Sub End If End If ' hide control if out of range If (((lrRectangle.Width <= 0) OrElse (lrRectangle.Height <= 0)) OrElse Not lrRectangle.IntersectsWith(Me.mC1FlexGrid.ClientRectangle)) Then Exit Sub End If ' Debug.Print(lrRectangle.Width & " " & lrRectangle.Height) ' move the control and show it If mButtonVisibleWidth <> 0 Then If lrRectangle.Width > mButtonVisibleWidth Then Exit Sub End If End If ' update for sorting case Me.mControl.Tag = liRow Me.mControl.Bounds = lrRectangle Me.mControl.Visible = True Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub End Class #End Region #End Region "ClassReportHelper"#Region "ClassReportHelper" ' Last update : 2009-04-02 - ClassReportHelper
' Used in : LOEPrinting
' modify : add dispose
Public Class ClassReportHelper Private msRepID As String = BLANK Private msStoredProcedureName As String = BLANK Private mbHasReoprtDocument As Boolean = False Private mdsSQL As New DataSet Private mReportDocument As New ReportDocument Public scrClassReportViewer As New frmClassReportViewer "SetReportID"#Region "SetReportID" Public Sub SetReportID() Sub SetReportID(ByVal psReportID As String) Try Me.msRepID = psReportID Me.msStoredProcedureName = "usp_" & psReportID Call ConstructReportDocument() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Public Sub SetReportID() Sub SetReportID(ByVal psReportID As String, ByVal psStoredProcedureName As String) Try Me.msRepID = psReportID Me.msStoredProcedureName = "usp_" & psStoredProcedureName Call ConstructReportDocument() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "Parameter, Formula, Sort"#Region "Parameter, Formula, Sort" Private ParameterFieldsNames As New ArrayList Private ParameterFieldsValues As New ArrayList Private FormulaFieldsNames As New ArrayList Private FormulaFieldsValues As New ArrayList Private SortFieldsNames As New ArrayList Private SortDirections As New ArrayList Public Sub AddParameter() Sub AddParameter(ByVal psFieldName As String, ByVal psValue As String) Try Me.ParameterFieldsNames.Add(psFieldName) Me.ParameterFieldsValues.Add(psValue) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Public Sub AddFormula() Sub AddFormula(ByVal psFieldName As String, ByVal psValue As String) Try Me.FormulaFieldsNames.Add(psFieldName) Me.FormulaFieldsValues.Add(psValue) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Public Sub AddSort() Sub AddSort(ByVal psFieldName As String, ByVal psValue As String) Try Me.SortFieldsNames.Add(psFieldName) Me.SortDirections.Add(psValue) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "ConstructReportDocument"#Region "ConstructReportDocument" Private Sub ConstructReportDocument() Sub ConstructReportDocument() If mbHasReoprtDocument = True Then Exit Sub Dim cmSQL As New OleDbCommand Dim liCount As Integer Try Dim lsRptID As String = Me.msRepID Dim lsStoredProcedureName As String = Me.msStoredProcedureName cmSQL.Connection = gcnOLEDBHIS cmSQL.CommandText = lsStoredProcedureName cmSQL.CommandType = CommandType.StoredProcedure For liCount = 0 To Me.ParameterFieldsNames.Count - 1 cmSQL.Parameters.Add(Me.ParameterFieldsNames(liCount), Me.ParameterFieldsValues(liCount)) Next Dim daSQL As New OleDbDataAdapter(cmSQL) daSQL.Fill(mdsSQL, lsStoredProcedureName) mReportDocument.Load(gsRepDir & "\" & lsRptID & ".rpt") mReportDocument.SetDataSource(mdsSQL) For liCount = 0 To Me.FormulaFieldsNames.Count - 1 mReportDocument.DataDefinition.FormulaFields(Me.FormulaFieldsNames(liCount)).Text = Me.FormulaFieldsValues(liCount) Next Dim lTable As Table For Each lTable In mReportDocument.Database.Tables For liCount = 0 To Me.SortFieldsNames.Count - 1 Dim lFieldDefinition As FieldDefinition lFieldDefinition = lTable.Fields.Item(Me.SortFieldsNames(liCount)) mReportDocument.DataDefinition.SortFields.Item(liCount).Field = lFieldDefinition Select Case Me.SortDirections(liCount) Case SORT_ASC mReportDocument.DataDefinition.SortFields.Item(liCount).SortDirection = SortDirection.AscendingOrder Case SORT_DESC mReportDocument.DataDefinition.SortFields.Item(liCount).SortDirection = SortDirection.DescendingOrder End Select Next Next daSQL.Dispose() cmSQL.Dispose() mbHasReoprtDocument = True Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "PreviewReport, PrintReport, ExportPDF"#Region "PreviewReport, PrintReport, ExportPDF" "PrintReport"#Region "PrintReport" Public Sub PrintReport() Sub PrintReport(Optional ByVal piNoOfCopies As Integer = REPORT_PRINTING_DEFAULT_COPY, Optional ByVal psPrinterName As String = BLANK) Call ConstructReportDocument() Dim liCount As Integer Dim lbInstalledPrinter As Boolean Dim lsRptID As String = Me.msRepID Dim lsStoredProcedureName As String = Me.msStoredProcedureName Try Dim lsPrinterName As String ' Setting the Printer Name If psPrinterName <> BLANK Then mReportDocument.PrintOptions.PrinterName = psPrinterName Else lsPrinterName = BLANK If Not bGetPrinterName(lsRptID, gsWSName, lsPrinterName) Then lsPrinterName = BLANK Else ' Code change by Edmond Tam 30-09-2005 requested by Tommy lbInstalledPrinter = False For liCount = 0 To System.Drawing.Printing.PrinterSettings.InstalledPrinters.Count - 1 If System.Drawing.Printing.PrinterSettings.InstalledPrinters.Item(liCount) = lsPrinterName Then lbInstalledPrinter = True Exit For End If Next If lbInstalledPrinter = True Then mReportDocument.PrintOptions.PrinterName = lsPrinterName End If End If End If mReportDocument.PrintToPrinter(piNoOfCopies, True, REPORT_PRINTING_DEFAULT_START_PAGE, REPORT_PRINTING_DEFAULT_END_PAGE) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "Preview report"#Region "Preview report" Public Sub PreviewReport() Sub PreviewReport(Optional ByVal psViewerTitle As String = "Preview", Optional ByVal pbShowPrint As Boolean = True) 'reviewed Try Call ConstructReportDocument() Me.scrClassReportViewer.msRptID = Me.msRepID Me.scrClassReportViewer.msStoredProcedureName = Me.msStoredProcedureName Me.scrClassReportViewer.mReportDocument = Me.mReportDocument Me.scrClassReportViewer.Text = psViewerTitle Me.scrClassReportViewer.mbShowPrint = pbShowPrint Call scrClassReportViewer.ShowDialog() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Public Sub PreviewReport() Sub PreviewReport(ByRef psViewer As CrystalDecisions.Windows.Forms.CrystalReportViewer, Optional ByVal psViewerTitle As String = "Preview", Optional ByVal pbShowPrint As Boolean = True) 'reviewed Try Call ConstructReportDocument() Dim CRMainControl As System.Windows.Forms.Control Dim CRSubControl As System.Windows.Forms.Control Dim lTabControl As TabControl psViewer.ReportSource = mReportDocument ' Code for invisible the Tab "MainReport" For Each CRMainControl In psViewer.Controls If TypeOf CRMainControl Is CrystalDecisions.Windows.Forms.PageView Then For Each CRSubControl In CRMainControl.Controls If TypeOf CRSubControl Is System.Windows.Forms.TabControl Then lTabControl = CRSubControl With lTabControl .Appearance = TabAppearance.Buttons .ItemSize = New Size(0, 1) .Padding = New Point(0, 0) .SizeMode = TabSizeMode.Fixed End With End If Next End If Next ' Zoom viewer to fit to the whole page so the user can see the report ' 1 - fit page width ' 2 - fit whole page psViewer.Zoom(100) psViewer.ShowZoomButton = True psViewer.ShowPageNavigateButtons = True psViewer.ShowPrintButton = True psViewer.DisplayToolbar = True Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "ExportPDF"#Region "ExportPDF" Public Sub ExportPDF() Sub ExportPDF() Try Call ConstructReportDocument() Me.mReportDocument.ExportOptions.ExportDestinationType = ExportDestinationType.DiskFile Me.mReportDocument.ExportOptions.ExportFormatType = ExportFormatType.CrystalReport Me.mReportDocument.ExportToDisk(ExportFormatType.PortableDocFormat, "C://" & msRepID & ".pdf") 'mReportDocument.ExportToDisk(ExportFormatType.PortableDocFormat, "\\sthmb1\dev\System\His\VB.NET Small Font\AAA.pdf") Catch Err As Exception MsgBox(Err.Message, MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, APP_NAME) End Try End Sub #End Region #End Region Public Function GetDataSet() Function GetDataSet() As DataSet GetDataSet = Me.mdsSQL End Function Public Sub Dispose() Sub Dispose() Try Me.mdsSQL.Clear() If scrClassReportViewer Is Nothing Then Else Me.scrClassReportViewer.Dispose() End If If mReportDocument Is Nothing Then Else Me.mReportDocument.Dispose() mReportDocument.Close() End If Me.mdsSQL.Dispose() GC.Collect() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub End Class #End Region "ClassAutoLogOut"#Region "ClassAutoLogOut" Public Class ClassAutoLogOut " Code for Auto Logout "#Region " Code for Auto Logout " Public mTimer As New System.Windows.Forms.Timer Private miTimeOut As Integer Public Delegate Sub DelLogoutClass() Delegate Sub DelLogoutClass() Private gLogoutProcess As DelLogoutClass Private mForm As Form Public Sub addAutoLogout() Sub addAutoLogout(ByVal pform As Form, ByVal LougoutProcess As DelLogoutClass, Optional ByVal piTimeOut As Integer = 10) Try miTimeOut = piTimeOut * 1000 gLogoutProcess = LougoutProcess mForm = pform AddHandler mTimer.Tick, AddressOf TimerTick AddHandler pform.KeyDown, AddressOf FormKeyDown AddHandler pform.MouseMove, AddressOf FormMouseMove AddHandler pform.Activated, AddressOf FormActivated AddHandler pform.Deactivate, AddressOf FormDeactivated Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub TimerTick() Sub TimerTick(ByVal sender As Object, ByVal e As System.EventArgs) Try Call gLogoutProcess.Invoke() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub FormActivated() Sub FormActivated(ByVal sender As Object, ByVal e As System.EventArgs) Try mTimer.Enabled = False mTimer.Interval = miTimeOut mTimer.Enabled = True Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub FormDeactivated() Sub FormDeactivated(ByVal sender As Object, ByVal e As System.EventArgs) Try mTimer.Enabled = False Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub FormKeyDown() Sub FormKeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Try mTimer.Enabled = False mTimer.Interval = miTimeOut mTimer.Enabled = True Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub FormMouseMove() Sub FormMouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Try mTimer.Enabled = False mTimer.Interval = miTimeOut mTimer.Enabled = True Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region End Class #End Region "ClassAutoClose"#Region "ClassAutoClose" ''' <summary>
''' When there is no action in the form in XX seconds. Then AutoClose.
''' Desc : give privilege based on user login,
''' History :
''' 2009-08-09 - Create this function
''' </summary>
Public Class ClassAutoClose Private mTimer As New System.Windows.Forms.Timer Private miTimeOut As Integer Private mForm As Form ''' <summary> ''' Set AutoClose to the form. ''' Use in Form load. ''' <example> ClassAutoClose.SetAutoClose(Me,60)</example> ''' <code>ClassAutoClose.SetAutoClose(Me,60)</code> ''' <c>CC</c> ''' <list>List</list> ''' <see>AAA</see> ''' </summary> ''' <param name="pform">The Form you want to auto close. Usually use "Me"</param> ''' <param name="piTimeOut">piTimeOut</param> Public Sub SetAutoClose() Sub SetAutoClose(ByVal pform As Form, Optional ByVal piTimeOut As Integer = 60) Try miTimeOut = piTimeOut * 1000 mForm = pform AddHandler mTimer.Tick, AddressOf TimerTick AddHandler pform.KeyDown, AddressOf FormKeyDown AddHandler pform.MouseMove, AddressOf FormMouseMove AddHandler pform.Activated, AddressOf FormActivated AddHandler pform.Deactivate, AddressOf FormDeactivated mTimer.Start() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub TimerTick() Sub TimerTick(ByVal sender As Object, ByVal e As System.EventArgs) Try mForm.Close() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub FormActivated() Sub FormActivated(ByVal sender As Object, ByVal e As System.EventArgs) Try Call ResetTimer() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub FormDeactivated() Sub FormDeactivated(ByVal sender As Object, ByVal e As System.EventArgs) Try mTimer.Enabled = False Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub FormKeyDown() Sub FormKeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Try Call ResetTimer() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub FormMouseMove() Sub FormMouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Try Call ResetTimer() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub ResetTimer() Sub ResetTimer() Try mTimer.Enabled = False mTimer.Interval = miTimeOut mTimer.Enabled = True Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub End Class #End Region "ClassAdvancedSearch"#Region "ClassAdvancedSearch" ' Used in : ROE , LOE...and so on
' History :
' 2009-07-23 - tidy up the code.
Public Class ClassAdvancedSearch Private mGrid As C1.Win.C1FlexGrid.C1FlexGrid Private mTxtBox As Windows.Forms.TextBox Private mdsSearchDataSet As DataSet Private msSearchTablename As String = "Search" Private msDataSetSQLString As String = BLANK Private mDSubSetGridCol As DSub1Grid Private mDSubAddResult As DSub1Grid "Set"#Region "Set" Public Sub SetDataSetSQLString() Sub SetDataSetSQLString(ByVal psSQLString As String) Try msDataSetSQLString = psSQLString Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Public Sub SetDataSet() Sub SetDataSet(ByVal psSQLString As String) Try Dim daSQL As New OleDbDataAdapter mdsSearchDataSet = Nothing mdsSearchDataSet = New DataSet daSQL.SelectCommand = New OleDbCommand(psSQLString, gcnOLEDBHIS) daSQL.Fill(mdsSearchDataSet, msSearchTablename) daSQL.SelectCommand.Dispose() daSQL.Dispose() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Public Sub SetSub() Sub SetSub(ByVal pSetGridCol As DSub1Grid, ByVal pAddResult As DSub1Grid) Try mDSubAddResult = pAddResult mDSubSetGridCol = pSetGridCol Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Public Sub SetControl() Sub SetControl(ByVal pGrid As C1.Win.C1FlexGrid.C1FlexGrid, ByVal pTxtBox As Windows.Forms.TextBox) Try Me.mGrid = pGrid Me.mTxtBox = pTxtBox Me.mGrid.Tag = "AdvancedSearch" AddHandler mTxtBox.TextChanged, AddressOf txtSearchExam_TextChanged AddHandler mTxtBox.KeyDown, AddressOf txtSearchExam_KeyDown AddHandler mGrid.Click, AddressOf grdSearch_Click AddHandler mGrid.KeyDown, AddressOf grdSearch_KeyDown Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "Search"#Region "Search" Private Sub txtSearchExam_TextChanged() Sub txtSearchExam_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Try If sender.TextLength > 0 Then Search() Else mGrid.Visible = False End If Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub txtSearchExam_KeyDown() Sub txtSearchExam_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Try Select Case e.KeyCode Case Keys.Enter Call Search() mGrid.Focus() Case Keys.Down If mGrid.Enabled = True And mGrid.Visible = True Then mGrid.Focus() End If Case Keys.Up If mGrid.Enabled = True And mGrid.Visible = True Then mGrid.Focus() End If End Select Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub Search() Sub Search() Try Dim lsSearchName As String = mTxtBox.Text If lsSearchName = BLANK Then Exit Sub lsSearchName = lsSearchName.Replace("'", "`") Dim lTable As System.Data.DataTable lTable = mdsSearchDataSet.Tables(msSearchTablename) lTable.DefaultView.RowFilter = msDataSetSQLString & "'%" & lsSearchName & "%'" mGrid.DataSource = lTable.DefaultView mGrid.ScrollBars = ScrollBars.Vertical mGrid.DrawMode = C1.Win.C1FlexGrid.DrawModeEnum.OwnerDraw lTable.Dispose() Call mDSubSetGridCol(mGrid) mGrid.BringToFront() mGrid.Visible = True mGrid.Show() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "AddResult"#Region "AddResult" Private Sub grdSearch_Click() Sub grdSearch_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) ' reviewed Try Call AddResult() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub grdSearch_KeyDown() Sub grdSearch_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) ' reviewed Try Select Case e.KeyCode Case Keys.Enter Call AddResult() Case Keys.Up Case Keys.Down Case Keys.Space mTxtBox.Focus() Case Keys.Back mTxtBox.Focus() Case Else mTxtBox.Focus() End Select Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub AddResult() Sub AddResult() Try If mGrid.RowSel < mGrid.Rows.Fixed Then Exit Sub Call mDSubAddResult(mGrid) mGrid.Visible = False mTxtBox.Text = BLANK Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region End Class #End Region "ClassComboTxtBoxSwitch"#Region "ClassComboTxtBoxSwitch" ' Used in : Cath Lab Reporting System
' History :
' 2009-08-09 - Create this function
Public Class ClassComboTxtBoxSwitch Private mCombo As C1.Win.C1List.C1Combo Private mTxtBox As TextBox Private mButton As Button Public Sub SetControl() Sub SetControl(ByVal pCombo As C1.Win.C1List.C1Combo, ByVal pTxtBox As TextBox, ByVal pButton As Button) Try Me.mCombo = pCombo Me.mTxtBox = pTxtBox Me.mButton = pButton Me.mCombo.Visible = True Me.mTxtBox.Visible = False AddHandler mTxtBox.TextChanged, AddressOf mTxtBox_TextChanged AddHandler mCombo.VisibleChanged, AddressOf mCombo_VisibleChanged AddHandler pButton.Click, AddressOf pButton_KeyDown Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub mTxtBox_TextChanged() Sub mTxtBox_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Try If Me.mTxtBox.Text <> BLANK Then Me.mCombo.Visible = False End If Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub pButton_KeyDown() Sub pButton_KeyDown(ByVal sender As System.Object, ByVal e As System.EventArgs) Try If mCombo.Visible Then mCombo.Visible = False Else mCombo.Visible = True End If Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub mCombo_VisibleChanged() Sub mCombo_VisibleChanged(ByVal sender As Object, ByVal e As System.EventArgs) Try If mCombo.Visible Then mTxtBox.Text = BLANK mTxtBox.Visible = False Else mCombo.ClearSelected() mTxtBox.Visible = True End If Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub End Class #End Region "ClassFunctionPrivilege"#Region "ClassFunctionPrivilege" ' Used in : Cath Lab Reporting System
' Desc : give privilege based on user login,
' History :
' 2009-08-09 - Create this function
''' <summary>
''' Grant privilege based on Workgroup
''' </summary>
Public Class ClassFunctionPrivilege Private mDSub1 As DSub1 ''' <summary> ''' localizatize the enable function ''' </summary> ''' <param name="pSubEnableFunction">you should pass the local function in here. use addressof functionname</param> Public Sub SetSub() Sub SetSub(ByVal pSubEnableFunction As DSub1) Try Me.mDSub1 = pSubEnableFunction Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub ''' <summary> ''' Enables the function. ''' </summary> Public Sub EnableFunction() Sub EnableFunction() Try Dim lsSQLString As String = BLANK Dim ClsSQLLoadHelper As New ClassSQLLoadHelper With ClsSQLLoadHelper .TableName = "Workgroup_Function_Privilege WFP" .SQLExtraSelect = ", Workgroup_User_Privilege WUP" .SQLExtraCriteria = "WFP.Workgroup_Code = WUP.Workgroup_Code" .SQLExtraCriteria += " And WUP.User_Code = " & VarSQLString(gsUserCode) .AddRequiredField("Distinct WFP.Func_Code") .SQLOrder = "WFP.Func_Code" lsSQLString = .sGenerateSqlSelect End With Dim ClsGridHelper As New ClassGridHelper With ClsGridHelper .SetConnection(lsSQLString) Try While .bReadStart Call mDSub1(.oLoadSQLField("Func_Code")) End While Finally .bReadEnd() End Try End With Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub End Class #End Region "ClassControlSetting"#Region "ClassControlSetting" Public Class ClassControlSetting Private mDictionary As New Dictionary() mDictionary As New Dictionary(Of String, Object) Private mDictionaryEnable As New Dictionary() mDictionaryEnable As New Dictionary(Of String, Object) "SaveControlSetting"#Region "SaveControlSetting" Public Sub SaveControlSetting() Sub SaveControlSetting(ByVal pform As System.Windows.Forms.Form) Try mDictionary.Clear() mDictionaryEnable.Clear() Call ControlSetting_Save(pform) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub ControlSetting_Save() Sub ControlSetting_Save(ByVal pform As System.Windows.Forms.Form) Try Call ControlSetting_Save_Search(pform.Controls) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub ControlSetting_Save_Search() Sub ControlSetting_Save_Search(ByVal pControls As System.Windows.Forms.Control.ControlCollection) Try For Each lcControl As Control In pControls If lcControl.Controls.Count > 0 Then If TypeOf lcControl Is C1.Win.C1List.C1Combo Then mDictionaryEnable.Add(lcControl.Name, lcControl.Enabled) mDictionary.Add(lcControl.Name, lcControl.Text) Else Call ControlSetting_Save_Search(lcControl.Controls) End If Else If TypeOf lcControl Is DateTimePicker Then mDictionaryEnable.Add(lcControl.Name, lcControl.Enabled) mDictionary.Add(lcControl.Name, lcControl.Text) ElseIf TypeOf lcControl Is TextBox Then mDictionaryEnable.Add(lcControl.Name, lcControl.Enabled) mDictionary.Add(lcControl.Name, lcControl.Text) ElseIf TypeOf lcControl Is CheckBox Then mDictionaryEnable.Add(lcControl.Name, lcControl.Enabled) Dim lchkBox As CheckBox = lcControl mDictionary.Add(lcControl.Name, lchkBox.Checked) ElseIf TypeOf lcControl Is RadioButton Then mDictionaryEnable.Add(lcControl.Name, lcControl.Enabled) Dim loptBox As RadioButton = lcControl mDictionary.Add(lcControl.Name, loptBox.Checked) ElseIf TypeOf lcControl Is Label Then mDictionaryEnable.Add(lcControl.Name, lcControl.Enabled) mDictionary.Add(lcControl.Name, lcControl.Text) End If End If Next Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "LoadControlSetting"#Region "LoadControlSetting" Public Sub LoadControlSetting() Sub LoadControlSetting(ByVal pform As System.Windows.Forms.Form) Try Call ControlSetting_Load(pform) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub ControlSetting_Load() Sub ControlSetting_Load(ByRef pform As System.Windows.Forms.Form) Try Call ControlSetting_Load_Search(pform.Controls) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub ControlSetting_Load_Search() Sub ControlSetting_Load_Search(ByRef pControls As System.Windows.Forms.Control.ControlCollection) Try For Each lcControl As Control In pControls If lcControl.Controls.Count > 0 Then If TypeOf lcControl Is C1.Win.C1List.C1Combo Then lcControl.Enabled = mDictionaryEnable.Item(lcControl.Name) lcControl.Text = mDictionary.Item(lcControl.Name) Else Call ControlSetting_Load_Search(lcControl.Controls) End If Else If TypeOf lcControl Is DateTimePicker Then lcControl.Enabled = mDictionaryEnable.Item(lcControl.Name) Dim ldtPicker As DateTimePicker = lcControl ldtPicker.Text = mDictionary.Item(lcControl.Name) ldtPicker.Checked = False ElseIf TypeOf lcControl Is TextBox Then lcControl.Enabled = mDictionaryEnable.Item(lcControl.Name) lcControl.Text = mDictionary.Item(lcControl.Name) ElseIf TypeOf lcControl Is CheckBox Then lcControl.Enabled = mDictionaryEnable.Item(lcControl.Name) Dim lchkBox As CheckBox = lcControl lchkBox.Checked = mDictionary.Item(lchkBox.Name) ElseIf TypeOf lcControl Is RadioButton Then lcControl.Enabled = mDictionaryEnable.Item(lcControl.Name) Dim loptBox As RadioButton = lcControl loptBox.Checked = mDictionary.Item(loptBox.Name) ElseIf TypeOf lcControl Is Label Then lcControl.Enabled = mDictionaryEnable.Item(lcControl.Name) lcControl.Text = mDictionary.Item(lcControl.Name) End If End If Next Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region "bControlChanged"#Region "bControlChanged" Public Function bControlChanged() Function bControlChanged(ByVal pform As System.Windows.Forms.Form) As Boolean bControlChanged = False Try bControlChanged = bControlSetting_Compare(pform) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Function Private Function bControlSetting_Compare() Function bControlSetting_Compare(ByRef pform As System.Windows.Forms.Form) As Boolean Try bControlSetting_Compare = bControlSetting_Compare_Search(pform.Controls) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Function Private Function bControlSetting_Compare_Search() Function bControlSetting_Compare_Search(ByRef pControls As System.Windows.Forms.Control.ControlCollection) As Boolean bControlSetting_Compare_Search = False Try For Each lcControl As Control In pControls If lcControl.Controls.Count > 0 Then If TypeOf lcControl Is C1.Win.C1List.C1Combo Then If lcControl.Enabled <> mDictionaryEnable.Item(lcControl.Name) Then bControlSetting_Compare_Search = True Exit Function End If If lcControl.Text <> mDictionary.Item(lcControl.Name) Then bControlSetting_Compare_Search = True Exit Function End If Else bControlSetting_Compare_Search = bControlSetting_Compare_Search(lcControl.Controls) If bControlSetting_Compare_Search = True Then Exit Function End If Else If TypeOf lcControl Is DateTimePicker Then If lcControl.Text <> mDictionary.Item(lcControl.Name) Then bControlSetting_Compare_Search = True Exit Function End If ElseIf TypeOf lcControl Is TextBox Then If lcControl.Enabled <> mDictionaryEnable.Item(lcControl.Name) Then bControlSetting_Compare_Search = True Exit Function End If If lcControl.Text <> mDictionary.Item(lcControl.Name) Then bControlSetting_Compare_Search = True Exit Function End If ElseIf TypeOf lcControl Is CheckBox Then If lcControl.Enabled <> mDictionaryEnable.Item(lcControl.Name) Then bControlSetting_Compare_Search = True Exit Function End If Dim lchkBox As CheckBox = lcControl If lchkBox.Checked <> mDictionary.Item(lchkBox.Name) Then bControlSetting_Compare_Search = True Exit Function End If ElseIf TypeOf lcControl Is RadioButton Then If lcControl.Enabled <> mDictionaryEnable.Item(lcControl.Name) Then bControlSetting_Compare_Search = True Exit Function End If Dim loptBox As RadioButton = lcControl If loptBox.Checked <> mDictionary.Item(loptBox.Name) Then bControlSetting_Compare_Search = True Exit Function End If End If End If Next Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Function #End Region End Class #End Region "ClassStandardizeControl"#Region "ClassStandardizeControl" ' Used in : ROE , LOE...and so on
' History :
' 2009-05-12 - add chinese hotfix pform.ImeMode = ImeMode.OnHalf
' 2009-05-13 - handle advanced search style info setting.
' using Grid.Tag 1-) "AdvancedSearch" (special styleInfo)
' 2-) "False" = no Warp (do not change to 2 line when word too long)
' 2009-05-20 - add Overridable Highlighton off
' 2009-07-23 - all pform.FormBorderStyle = FormBorderStyle.Fixed3D, user cannot change the form size
Public Class ClassStandardizeControl Private msStyleInfoSearch As String = _ "Normal{Font:Microsoft Sans Serif, 10pt;BackColor:White;ForeColor:Green;}" & _ "Fixed{BackColor:Window;ForeColor:Black;Border:Flat,1,ActiveCaptionText,Both;}" & _ "Highlight{BackColor:ActiveCaption;ForeColor:Window;}" & _ "Focus{BackColor:ActiveCaption;ForeColor:Window;}" Private msStyleInfoDefault As String = _ "Normal{Font:Microsoft Sans Serif, 11pt;BackColor:White;} " & _ "Fixed{BackColor:DarkSlateGray;ForeColor:White;Border:Flat,1,ControlDark,Both;BackgroundImageLayout:Hide;WordWrap:true; }" & _ "Highlight{BackColor:yellow;}" & _ "Focus{BackColor:yellow;}" Sub New() New() Try Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Sub New() New(ByVal psStyle As String) Try msStyleInfoDefault = psStyle Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Property sGridStyleInfoDefault() Get Return msStyleInfoDefault End Get Set(ByVal value) msStyleInfoDefault = value End Set End Property Public Sub SetC1GridStyle() Sub SetC1GridStyle(ByVal psStyle As String) Try msStyleInfoDefault = psStyle Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub "StandardizeControl_Master "#Region "StandardizeControl_Master " ' Standardize text box handler Public Sub StandardizeControl_Master() Sub StandardizeControl_Master(ByVal pform As System.Windows.Forms.Form) ' Function to add common handler to all Text Box in the form () to add common handler to all Text Box in the form (Key up, Enter, Leave) Private Sub StandardizeControl_Search() Sub StandardizeControl_Search(ByVal pControls As System.Windows.Forms.Control.ControlCollection) 'reviewed Try For Each lcControl As Control In pControls If lcControl.Controls.Count > 0 Then If TypeOf lcControl Is C1.Win.C1List.C1Combo Then Dim lcCombo As C1.Win.C1List.C1Combo = lcControl lcCombo.AutoCompletion = True lcCombo.AutoDropDown = True lcCombo.Cursor = System.Windows.Forms.Cursors.Default lcCombo.DropdownPosition = C1.Win.C1List.DropdownPositionEnum.LeftDown lcCombo.EditorFont = lcCombo.Font AddHandler lcControl.Enter, AddressOf Standardize_TxtHandler_Enter AddHandler lcControl.Leave, AddressOf Standardize_ComboHandler_Leave Else Call StandardizeControl_Search(lcControl.Controls) End If Else Select Case lcControl.GetType.Name Case "TextBox", "C1TextBox", "UpDownEdit" AddHandler lcControl.KeyUp, AddressOf Standardize_TxtHandler_KeyUp AddHandler lcControl.Enter, AddressOf Standardize_TxtHandler_Enter AddHandler lcControl.Leave, AddressOf Standardize_TxtHandler_Leave Case "C1FlexGrid" Dim lcFlexGrid As C1.Win.C1FlexGrid.C1FlexGrid = lcControl Select Case lcFlexGrid.Tag Case "False" lcFlexGrid.StyleInfo = msStyleInfoDefault.Replace("WordWrap:true;", "WordWrap:false;") Case "AdvancedSearch" lcFlexGrid.StyleInfo = msStyleInfoSearch Case "Localize" Case Else lcFlexGrid.StyleInfo = msStyleInfoDefault End Select End Select End If Next Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub Standardize_TxtHandler_Enter() Sub Standardize_TxtHandler_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs) Try Call HighlightOn(sender) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub Standardize_TxtHandler_Leave() Sub Standardize_TxtHandler_Leave(ByVal sender As System.Object, ByVal e As System.EventArgs) Try Call HighlightOff(sender) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub Standardize_TxtHandler_KeyUp() Sub Standardize_TxtHandler_KeyUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Try Call ReplaceSingleQuote(sender, e.KeyCode) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub Standardize_ComboHandler_Leave() Sub Standardize_ComboHandler_Leave(ByVal sender As System.Object, ByVal e As System.EventArgs) Try Call HighlightOff(sender) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Overridable Sub HighlightOn() HighlightOn(ByVal objTarget As Object) Try If TypeOf (objTarget) Is C1.Win.C1List.C1Combo Then objTarget.EditForeColor = System.Drawing.Color.Blue objTarget.EditBackColor = System.Drawing.Color.Yellow Else objTarget.ForeColor = System.Drawing.Color.Blue objTarget.BackColor = System.Drawing.Color.Yellow End If Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Overridable Sub HighlightOff() HighlightOff(ByVal objTarget As Object) Try If TypeOf (objTarget) Is C1.Win.C1List.C1Combo Then objTarget.EditForeColor = System.Drawing.Color.Black objTarget.EditBackColor = System.Drawing.Color.White Else objTarget.ForeColor = System.Drawing.Color.Black objTarget.BackColor = System.Drawing.Color.White End If Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region 'reviewed Try pform.ImeMode = ImeMode.OnHalf If pform.FormBorderStyle <> FormBorderStyle.FixedSingle Then pform.FormBorderStyle = FormBorderStyle.FixedSingle End If Call StandardizeControl_Search(pform.Controls) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Public Sub Standardize_ClearAll() Sub Standardize_ClearAll(ByVal pform As System.Windows.Forms.Form) ' Function to Clear Try Call Standardize_ClearAll_Search(pform.Controls) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Private Sub Standardize_ClearAll_Search() Sub Standardize_ClearAll_Search(ByVal pControls As System.Windows.Forms.Control.ControlCollection) 'reviewed Try For Each lcControl As Control In pControls If lcControl.Controls.Count > 0 Then If TypeOf lcControl Is C1.Win.C1List.C1Combo Then Dim lcCombo As C1.Win.C1List.C1Combo = lcControl lcCombo.Text = BLANK lcCombo.ClearSelected() Else Call Standardize_ClearAll_Search(lcControl.Controls) End If Else If TypeOf lcControl Is DateTimePicker Then Dim ldtPicker As DateTimePicker = lcControl ldtPicker.Text = Now ldtPicker.Checked = False ElseIf TypeOf lcControl Is TextBox Then lcControl.Text = BLANK ElseIf TypeOf lcControl Is CheckBox Then Dim lchkBox As CheckBox = lcControl lchkBox.Checked = True lchkBox.Checked = False ElseIf TypeOf lcControl Is RadioButton Then Dim loptBox As RadioButton = lcControl loptBox.Checked = False End If End If Next Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub End Class #End Region "Not in used"#Region "Not in used" ' Last update : 2009-02-13 - ClassDataSetHelper
' status : developing
' modify : add bHasRecord
"ClassDataSetHelper"#Region "ClassDataSetHelper" Public Class ClassDataSetHelper Private mSQLString As String Private mDataSet As DataSet Private mDataTableName As String = "Test" Public Sub FillDataSet() Sub FillDataSet(ByVal mSQLString As String) Try Dim daSQL As New OleDbDataAdapter mDataSet = Nothing mDataSet = New DataSet daSQL.SelectCommand = New OleDbCommand(mSQLString, gcnOLEDBHIS) daSQL.Fill(mDataSet, mDataTableName) daSQL.SelectCommand.Dispose() daSQL.Dispose() Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Public Function bContain() Function bContain(ByVal psFieldName As String, ByVal psValue As String) As Boolean bContain = False Try If mDataSet.Tables(mDataTableName) Is Nothing Then Exit Function Dim liRowCount As Integer = mDataSet.Tables(mDataTableName).Rows.Count For liRow As Integer = 0 To liRowCount - 1 If (mDataSet.Tables(mDataTableName).Rows(liRow).Item(psFieldName).ToString().IndexOf(psValue) > -1) Then bContain = True Exit For End If Next liRow Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Function Public Function bEqual() Function bEqual(ByVal psFieldName As String, ByVal psValue As String) As Boolean bEqual = False Try If mDataSet.Tables(mDataTableName) Is Nothing Then Exit Function Dim liRowCount As Integer = mDataSet.Tables(mDataTableName).Rows.Count For liRow As Integer = 0 To liRowCount - 1 If mDataSet.Tables(mDataTableName).Rows(liRow).Item(psFieldName).ToString() = psValue Then bEqual = True Exit For End If Next liRow Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Function Public Function bHasRecord() Function bHasRecord(ByVal psFirstColValue As String, ByVal psSecondColValue As String) As Boolean bHasRecord = False Try If mDataSet.Tables(mDataTableName) Is Nothing Then Exit Function Dim liRowCount As Integer = mDataSet.Tables(mDataTableName).Rows.Count For liRow As Integer = 0 To liRowCount - 1 If mDataSet.Tables(mDataTableName).Rows(liRow).Item(0).ToString() = psFirstColValue Then If Trim(mDataSet.Tables(mDataTableName).Rows(liRow).Item(1).ToString()) = psSecondColValue Then bHasRecord = True Exit For End If End If Next liRow Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Function End Class #End Region ' Last update : 2009-04-14 - ClassStandardizeGrid
' status : developing
' modify :
"ClassStandardizeGrid"#Region "ClassStandardizeGrid" Public Class ClassStandardizeGrid Private mC1FlexGridStyleInfo As String = _ "Normal{Font:Microsoft Sans Serif, 11pt;BackColor:White;} " & _ "Alternate{}" & _ "Fixed{BackColor:64, 64, 64;ForeColor:White;Border:Flat,1,ControlDark,Both;BackgroundImageLayout:Hide;WordWrap:true; }" & _ "Highlight{BackColor:255, 255, 128;ForeColor:Black;}" & _ "Focus{BackColor:255, 255, 128;ForeColor:Black;} Editor{}" & _ "Search{BackColor:Highlight;ForeColor:HighlightText;} " & _ "Frozen{BackColor:Beige;} NewRow{} " & _ "EmptyArea{BackColor:AppWorkspace;Border:Flat,1,ControlDarkDark,Both;} SelectedColumnHeader{} SelectedRowHeader{} " & _ "GrandTotal{BackColor:Black;ForeColor:White;} " & _ "Subtotal0{BackColor:ControlDarkDark;ForeColor:White;} " & _ "Subtotal1{BackColor:ControlDarkDark;ForeColor:White;} " & _ "Subtotal2{BackColor:ControlDarkDark;ForeColor:White;} " & _ "Subtotal3{BackColor:ControlDarkDark;ForeColor:White;} " & _ "Subtotal4{BackColor:ControlDarkDark;ForeColor:White;} " & _ "Subtotal5{BackColor:ControlDarkDark;ForeColor:White;} " Sub New() New() End Sub Sub New() New(ByVal psStyle As String) Try mC1FlexGridStyleInfo = psStyle Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub "StandardizeControl_Master "#Region "StandardizeControl_Master " ' Standardize text box handler Public Sub StandardizeControl_Master() Sub StandardizeControl_Master(ByRef pform As System.Windows.Forms.Form) ' Function to add common handler to all Text Box in the form () to add common handler to all Text Box in the form (Key up, Enter, Leave) Private Sub Standardize_SearchControl() Sub Standardize_SearchControl(ByRef pControls As System.Windows.Forms.Control.ControlCollection) 'reviewed Try For Each lcControl As Control In pControls If lcControl.Controls.Count > 0 Then Call Standardize_SearchControl(lcControl.Controls) Else Call SetControlWithoutChild(lcControl) End If Next Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Overridable Sub SetControlWithoutChild() SetControlWithoutChild(ByRef lcControl As Windows.Forms.Control) Try Select Case lcControl.GetType.Name Case "C1FlexGrid" Dim lcFlexGrid As C1.Win.C1FlexGrid.C1FlexGrid = lcControl lcFlexGrid.StyleInfo = mC1FlexGridStyleInfo End Select Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub #End Region 'reviewed Try Call Standardize_SearchControl(pform.Controls) Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub Public Sub SetC1GridStyle() Sub SetC1GridStyle(ByVal psStyle As String) Try Me.mC1FlexGridStyleInfo = psStyle Catch Err As Exception Call ErrHandler(Err.Message, APP_NAME) End Try End Sub End Class #End Region #End Region
------------------
熱愛生命 喜愛新奇 有趣的事物
過去 是無法改變
將來 卻能夠創造
希望使大家生活更便利
世界更美好
a guy who loves IT and life