Option Strict Off Option Explicit On Imports Microsoft.Win32 Module mdlBaseClass Public intClassSelStart As Short Public strClassTempText As String Public Function ReadRegistryInfomation(ByVal strRegistryPath As String, ByVal strKeyName As String) As String Dim rgkTemp As RegistryKey Dim strValue As String Try rgkTemp = Registry.LocalMachine.OpenSubKey(strRegistryPath, False) strValue = rgkTemp.GetValue(strKeyName, "") Catch myException As System.Exception strValue = "" End Try Return strValue End Function Public Sub MapEnter(ByVal hWnd As Integer) Dim lRetVal As Integer Try lRetVal = PostMessage(hWnd, WM_KEYDOWN, VK_RETURN, 0) Catch myException As System.Exception End Try End Sub Public Sub MapEnterToTab(ByVal hWnd As Integer) Dim lRetVal As Integer Try lRetVal = PostMessage(hWnd, WM_KEYDOWN, VK_TAB, 0) Catch myException As System.Exception End Try End Sub Public Function MoveSubString(ByVal strCurString As String, ByVal strCurSubString As String) As String Dim strReturnValue As String Dim intTempPos As Integer Dim intTempLen As Integer Dim intSubStringLen As Integer intSubStringLen = Len(strCurSubString) strReturnValue = strCurString Do While InStr(strReturnValue, strCurSubString) > 0 intTempPos = InStr(strReturnValue, strCurSubString) intTempLen = Len(strReturnValue) strReturnValue = Left(strReturnValue, intTempPos - 1) & Right(strReturnValue, intTempLen - intTempPos) Loop Return strReturnValue End Function Public Overloads Function DisplayNumber(ByVal strCurText As String, ByVal strCurFormat As String, ByVal strCurDisplayFormat As String) As String Dim intStandIntPartLen As Short Dim intStandDecPartLen As Short Dim intDecPosition As Short Dim intDataLen As Short Dim strReturnValue As String If strCurText <> "" Then If IsNumeric(strCurFormat) Then intDataLen = Len(strCurFormat) intDecPosition = InStr(strCurFormat, ".") If intDecPosition > 0 Then If intDecPosition < intDataLen Then intStandDecPartLen = CShort(Mid(strCurFormat, intDecPosition + 1, intDataLen - intDecPosition)) Else intStandDecPartLen = 0 End If intStandIntPartLen = System.Math.Abs(CShort(Left(strCurFormat, intDecPosition - 1))) - intStandDecPartLen Else intStandIntPartLen = System.Math.Abs(CShort(strCurFormat)) intStandDecPartLen = 0 End If Else intStandIntPartLen = 0 intStandDecPartLen = 0 End If strReturnValue = Format(CDbl(strCurText)) If (InStr(strCurDisplayFormat, "9") > 0 Or InStr(strCurDisplayFormat, "0") > 0) Then strReturnValue = Right(StrDup(intStandIntPartLen, "0") & Trim(strCurText), intStandIntPartLen) ElseIf InStr(strCurDisplayFormat, ",") > 0 Then If intStandDecPartLen > 0 Then strReturnValue = Format(CDbl(strCurText), "#,##0." & StrDup(intStandDecPartLen, "0")) Else strReturnValue = Format(CDbl(strCurText), "#,##0") End If ElseIf InStr(strCurDisplayFormat, ".") > 0 Then If intStandDecPartLen > 0 Then strReturnValue = Format(CDbl(strCurText), "###0." & StrDup(intStandDecPartLen, "0")) Else strReturnValue = Format(CDbl(strCurText), "###0") End If End If End If Return strReturnValue End Function Public Overloads Function DisplayNumber(ByVal ctlCurControl As Control, ByVal strCurFormat As String, ByVal strCurDisplayFormat As String) As String Dim intStandIntPartLen As Short Dim intStandDecPartLen As Short Dim intDecPosition As Short Dim intDataLen As Short Dim strReturnValue As String If ctlCurControl.Text <> "" Then If IsNumeric(strCurFormat) Then intDataLen = Len(strCurFormat) intDecPosition = InStr(strCurFormat, ".") If intDecPosition > 0 Then If intDecPosition < intDataLen Then intStandDecPartLen = CShort(Mid(strCurFormat, intDecPosition + 1, intDataLen - intDecPosition)) Else intStandDecPartLen = 0 End If intStandIntPartLen = System.Math.Abs(CShort(Left(strCurFormat, intDecPosition - 1))) - intStandDecPartLen Else intStandIntPartLen = System.Math.Abs(CShort(strCurFormat)) intStandDecPartLen = 0 End If Else intStandIntPartLen = 0 intStandDecPartLen = 0 End If strReturnValue = Format(CDbl(ctlCurControl.Text)) If (InStr(strCurDisplayFormat, "9") > 0 Or InStr(strCurDisplayFormat, "0") > 0) Then strReturnValue = Right(StrDup(intStandIntPartLen, "0") & Trim(ctlCurControl.Text), intStandIntPartLen) ElseIf InStr(strCurDisplayFormat, ",") > 0 Then If intStandDecPartLen > 0 Then strReturnValue = Format(CDbl(ctlCurControl.Text), "#,##0." & StrDup(intStandDecPartLen, "0")) Else strReturnValue = Format(CDbl(ctlCurControl.Text), "#,##0") End If ElseIf InStr(strCurDisplayFormat, ".") > 0 Then If intStandDecPartLen > 0 Then strReturnValue = Format(CDbl(ctlCurControl.Text), "###0." & StrDup(intStandDecPartLen, "0")) Else strReturnValue = Format(CDbl(ctlCurControl.Text), "###0") End If End If ctlCurControl.Text = strReturnValue End If Return strReturnValue End Function Public Overloads Function DisplayDate(ByVal strCurText As String, ByVal strCurFormat As String) As String Dim strReturnValue As String Dim strStandardFormat As String strStandardFormat = "yyyy" & Mid(strCurFormat, 5, 1) & "MM" & Mid(strCurFormat, 5, 1) & "dd" strReturnValue = strCurText If Len(strCurFormat) = 7 Then If IsDate(strCurText & "/01") Then strReturnValue = Format(CDate(strCurText & "/01"), Left(strStandardFormat, Len(strCurFormat))) End If Else If IsDate(strCurText) Then strReturnValue = Format(CDate(strCurText), strStandardFormat) End If End If Return strReturnValue End Function Public Overloads Function DisplayDate(ByVal ctlCurControl As System.Windows.Forms.Control, ByVal strCurFormat As String) As String Dim strReturnValue As String Dim strStandardFormat As String strStandardFormat = "yyyy" & Mid(strCurFormat, 5, 1) & "MM" & Mid(strCurFormat, 5, 1) & "dd" strReturnValue = ctlCurControl.Text If Len(strCurFormat) = 7 Then If IsDate(ctlCurControl.Text & "/01") Then strReturnValue = Format(CDate(ctlCurControl.Text & "/01"), Left(strStandardFormat, Len(strCurFormat))) End If Else If IsDate(ctlCurControl.Text) Then strReturnValue = Format(CDate(ctlCurControl.Text), strStandardFormat) End If End If ctlCurControl.Text = strReturnValue Return strReturnValue End Function Public Sub FormatNumber(ByVal CurField As System.Windows.Forms.TextBox, ByVal strCurFormat As String, Optional ByVal strCurDisplayFormat As String = "") Dim intStandIntPartLen As Short Dim intStandDecPartLen As Short Dim intCurrIntPartLen As Short Dim intCurrDecPartLen As Short Dim intDecPosition As Short Dim intDataLen As Short Dim strTempText As String Dim booIncludeMinus As Boolean If CurField.Text <> "" Then If (strCurFormat = "" Or InStr(strCurFormat, "-") > 0) Then booIncludeMinus = True End If If IsNumeric(CurField.Text) Then If InStr(CurField.Text, " ") > 0 Then CurField.Text = strClassTempText CurField.SelectionStart = intClassSelStart 'Beep() ElseIf InStr(UCase(CurField.Text), "E") > 0 Then CurField.Text = strClassTempText CurField.SelectionStart = intClassSelStart 'Beep() ElseIf InStr(CurField.Text, "+") > 0 Then CurField.Text = strClassTempText CurField.SelectionStart = intClassSelStart 'Beep() ElseIf InStr(CurField.Text, "/") > 0 Then CurField.Text = strClassTempText CurField.SelectionStart = intClassSelStart 'Beep() ElseIf InStr(strCurFormat, ".") <= 0 And InStr(CurField.Text, ".") > 0 Then CurField.Text = strClassTempText CurField.SelectionStart = intClassSelStart 'Beep() ElseIf InStr(strCurDisplayFormat, ",") <= 0 And InStr(CurField.Text, ",") > 0 Then CurField.Text = strClassTempText CurField.SelectionStart = intClassSelStart 'Beep() ElseIf (Not booIncludeMinus) And InStr(CurField.Text, "-") > 0 Then CurField.Text = strClassTempText CurField.SelectionStart = intClassSelStart 'Beep() Else If InStr(CurField.Text, "-") > 0 Then If Left(CurField.Text, 1) = "-" Then strTempText = Mid(CurField.Text, 2, Len(CurField.Text) - 1) Else strTempText = Left(CurField.Text, Len(CurField.Text) - 1) End If Else strTempText = CurField.Text End If strTempText = MoveSubString(CurField.Text, ",") If IsNumeric(strCurFormat) Then intDataLen = Len(strCurFormat) intDecPosition = InStr(strCurFormat, ".") If intDecPosition > 0 Then If intDecPosition < intDataLen Then intStandDecPartLen = CShort(Mid(strCurFormat, intDecPosition + 1, intDataLen - intDecPosition)) Else intStandDecPartLen = 0 End If intStandIntPartLen = System.Math.Abs(CShort(Left(strCurFormat, intDecPosition - 1))) - intStandDecPartLen Else intStandIntPartLen = System.Math.Abs(CShort(strCurFormat)) intStandDecPartLen = 0 End If intDataLen = Len(strTempText) intDecPosition = InStr(strTempText, ".") If intDecPosition > 0 Then If intDecPosition < intDataLen Then intCurrDecPartLen = Len(Mid(strTempText, intDecPosition + 1, intDataLen - intDecPosition)) Else intCurrDecPartLen = 0 End If intCurrIntPartLen = Len(Left(strTempText, intDecPosition - 1)) Else intCurrIntPartLen = Len(strTempText) intCurrDecPartLen = 0 End If If (intCurrIntPartLen > intStandIntPartLen) Or (intCurrDecPartLen > intStandDecPartLen) Then CurField.Text = strClassTempText CurField.SelectionStart = intClassSelStart 'Beep() End If End If End If Else If Not (booIncludeMinus = True And CurField.Text = "-") Then CurField.Text = strClassTempText CurField.SelectionStart = intClassSelStart End If 'Beep() End If End If End Sub Public Sub FormatDate(ByVal txtCurField As TextBox, ByVal CurFormat As String) Dim intCount As Short Dim intStandDataLen As Short Dim intCurrDataLen As Short Dim strStandChar As String Dim strCurrChar As String Dim intSelDistance As Short If txtCurField.SelectionStart < 0 Then txtCurField.SelectionStart = 0 End If If txtCurField.SelectionStart > intClassSelStart Then If Not IsNumeric(Mid(CurFormat, txtCurField.SelectionStart, 1)) Then intSelDistance = txtCurField.SelectionStart + 1 Else intSelDistance = txtCurField.SelectionStart End If ElseIf txtCurField.SelectionStart < intClassSelStart Then If (Not IsNumeric(Mid(CurFormat, txtCurField.SelectionStart + 1, 1)) And txtCurField.SelectionStart < Len(txtCurField.Text)) Then intSelDistance = txtCurField.SelectionStart + 1 Else intSelDistance = txtCurField.SelectionStart End If Else intSelDistance = txtCurField.SelectionStart End If intStandDataLen = Len(CurFormat) intCurrDataLen = Len(txtCurField.Text) For intCount = 1 To intCurrDataLen Step 1 If intCount > intCurrDataLen Then Exit For End If If intCount > intStandDataLen Then txtCurField.Text = strClassTempText txtCurField.SelectionStart = intClassSelStart 'Beep() Exit For End If strStandChar = Mid(CurFormat, intCount, 1) strCurrChar = Mid(txtCurField.Text, intCount, 1) If strStandChar = "9" Then Do While Not IsNumeric(Mid(txtCurField.Text, intCount, 1)) txtCurField.Text = Left(txtCurField.Text, intCount - 1) & Mid(txtCurField.Text, intCount + 1, intCurrDataLen - intCount) intCurrDataLen = intCurrDataLen - 1 If intCount > intCurrDataLen Then Exit Do End If Loop Else If IsNumeric(strCurrChar) Then txtCurField.Text = Left(txtCurField.Text, intCount - 1) & strStandChar & Mid(txtCurField.Text, intCount, intCurrDataLen - intCount + 1) intCurrDataLen = intCurrDataLen + 1 Else If strStandChar <> strCurrChar Then txtCurField.Text = strClassTempText txtCurField.SelectionStart = intClassSelStart 'Beep() End If End If End If Next If (txtCurField.Text <> strClassTempText Or (txtCurField.Text = strClassTempText And txtCurField.SelectionStart = 0)) Then txtCurField.SelectionStart = intSelDistance End If End Sub Public Sub FormatString(ByVal txtCurControl As TextBox, ByVal intMaxLength As Short) If Length(txtCurControl.Text) > intMaxLength Then If Length(strClassTempText) >= intMaxLength Then txtCurControl.Text = strClassTempText txtCurControl.SelectionStart = intClassSelStart 'Beep() Else txtCurControl.Text = Left(txtCurControl.Text, intMaxLength) txtCurControl.SelectionStart = intMaxLength End If End If End Sub Public Function Length(ByVal strCurText As String) As Integer If IsNothing(strCurText) Or IsDBNull(strCurText) Then Return 0 Else Return System.Text.Encoding.Default.GetBytes(strCurText).Length() End If End Function Public Function Left(ByVal strCurText As String, ByVal intRetuLength As Short) As String If intRetuLength > 0 Then Return System.Text.Encoding.Default.GetString(System.Text.Encoding.Default.GetBytes(strCurText.ToCharArray()), 0, intRetuLength) Else Return "" End If End Function Public Function CutLeft(ByVal strCurText As String, ByVal intRetuLength As Short) As String Dim strReturnValue As String Dim intLoopCount As Integer Dim intLoopMaxCount As Integer Dim intTemp As Integer Dim strTemp As String strReturnValue = "" If intRetuLength > 0 Then intLoopMaxCount = Length(strCurText) If intLoopMaxCount > intRetuLength Then intLoopMaxCount = intRetuLength End If If intLoopMaxCount <= CInt(intRetuLength / 2) Then strReturnValue = strCurText Else For intLoopCount = CInt(intRetuLength / 2) To intLoopMaxCount Step 1 strTemp = Left(strCurText, intLoopCount) intTemp = Length(strTemp) If intTemp < intRetuLength Then strReturnValue = strTemp ElseIf intTemp = intRetuLength Then strReturnValue = strTemp Exit For Else Exit For End If Next End If End If Return strReturnValue End Function Public Overloads Function CutMid(ByVal strCurText As String, ByVal intRetuStart As Short, ByVal intRetuLength As Short) As String Dim strReturnValue As String Dim intTemp As Integer strReturnValue = "" If intRetuStart > 1 Then intTemp = Len(CutLeft(strCurText, intRetuStart - 1)) If intTemp < Len(strCurText) Then strReturnValue = CutLeft(Mid(strCurText, intTemp + 1), intRetuLength) End If Else strReturnValue = CutLeft(strCurText, intRetuLength) End If Return strReturnValue End Function Public Overloads Function CutMid(ByVal strCurText As String, ByVal intRetuStart As Short) As String Dim strReturnValue As String Dim intTemp As Integer strReturnValue = "" If intRetuStart > 1 Then intTemp = Len(CutLeft(strCurText, intRetuStart - 1)) If intTemp < Len(strCurText) Then strReturnValue = Mid(strCurText, intTemp + 1) End If Else strReturnValue = strCurText End If Return strReturnValue End Function Public Function Cut(ByVal strCurText As String, ByVal intRetuLength As Short) As String If intRetuLength > 0 Then Return System.Text.Encoding.Default.GetString(System.Text.Encoding.Default.GetBytes(strCurText.ToCharArray() & StrDup(intRetuLength, " ")), 0, intRetuLength) Else Return "" End If End Function Public Function GetStrArrayCount(ByVal strCurData As String, ByVal strSeperate As String) As Integer Dim intReturnValue As Integer Dim intCurPosition As Integer Dim strTempData As String intReturnValue = 0 strTempData = strCurData Do intReturnValue = intReturnValue + 1 intCurPosition = InStr(strTempData, strSeperate, CompareMethod.Text) If intCurPosition > 0 Then strTempData = Mid(strTempData, intCurPosition + 1) Else strTempData = "" Exit Do End If Loop Return intReturnValue End Function Public Function GetStrArrayDataX(ByVal strCurData As String, ByVal strSeperate As String, ByVal intPosition As Integer) As String Dim strReturnValue As String Dim intCurPosition As Integer Dim intCurCount As Integer Dim strTempData As String strTempData = strCurData intCurCount = 0 strReturnValue = "" If intPosition > 0 Then Do intCurCount = intCurCount + 1 intCurPosition = InStr(strTempData, strSeperate, CompareMethod.Text) If intCurPosition > 0 Then strReturnValue = Left(strTempData, intCurPosition - 1) strTempData = Mid(strTempData, intCurPosition + 1) Else strReturnValue = strTempData strTempData = "" If intPosition > intCurCount Then strReturnValue = "" End If Exit Do End If If intPosition <= intCurCount Then Exit Do End If Loop End If Return strReturnValue End Function Public Function ConnectArrayToStrArray(ByVal strArray() As String, ByVal strSeperate As String, ByVal intArrayCount As Integer) As String Dim strReturnValue As String Dim intTemp As Integer strReturnValue = "" For intTemp = 0 To intArrayCount - 1 Step 1 If intTemp = 0 Then strReturnValue = strArray(intTemp) Else strReturnValue = strReturnValue & strSeperate & strArray(intTemp) End If Next Return strReturnValue End Function Public Sub ErrorDeal(ByVal strModuleName As String, ByRef objErr As Object) MsgBox(objErr.Number & " " & vbCr & vbLf & objErr.Description & vbCr & vbLf & "儌僕儏乕儖柤 " & strModuleName) End Sub '---------------------------------------------------------------------- ' 俽俻俴暥幚峴 ' '堷悢 ' tblName IN Table Name ' strCurSqlText IN 俽俤俴俤俠俿暥 ' dsDateSet Out 僨乕僞張棟審悢 ' 栠傝抣 ' 惓忢廔椆 : False ' 堎忢廔椆 : True ' 'Ver 1.00 2002/12/31 Created by 揂帯 '---------------------------------------------------------------------- 'Public Function S_ExecuteSQLForADOSelect(ByVal tblName As String, ByVal strCurSqlText As String, ByRef dsDateSet As DataSet) As Boolean ' Dim booReturnValue As Boolean = True ' Try ' If cntForOleDb.State <> ConnectionState.Open Then ' cntForOleDb.ConnectionString = g_StrConnection ' cntForOleDb.Open() ' End If ' Dim adpDateA As New OleDb.OleDbDataAdapter() ' Dim cmdTbl As New OleDb.OleDbCommand(strCurSqlText, cntForOleDb) ' cmdTbl.CommandType = CommandType.Text ' adpDateA.SelectCommand = cmdTbl ' adpDateA.Fill(dsDateSet, "" & tblName & "") ' Catch myException As System.Exception ' booReturnValue = False ' Call S_Err("S_ExecuteSQLForSelect", Err) ' End Try ' Return booReturnValue 'End Function End Module