Attribute VB_Name = "Utility"
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  公用代碼
'  作者：黃濤
'  日期：1998.02.21
'
'  LoadMRU              從系統注冊表中加載最近打開文件到mnuFileMenu數組
'  SaveMRU              把mnuFileMenu數組中最近打開文件存儲到系統注冊表
'  UpdateMRU            根據打開文件strFileName，調整MRU
'
'  LoadFormSetting      從系統注冊表中加載窗體位置、大小
'  SaveFormSetting      把窗體位置、大小存儲到系統注冊表中。
'
'  LoadFormResPicture   加載窗體內控件的圖片資源
'  UnLoadFormResPicture 卸載窗體內控件的圖片資源
'
'  GetFormResPicture    得到窗體內控件的圖片資源
'  RemoveFormResPicture 刪除窗體內控件的圖片資源
'
'  GetListRecordSet     得到列表的記錄集資源
'  RemoveListRecordSet  刪除列表的記錄集資源
'  ClearListRecordSet   清除列表的記錄集資源
'  ListRecordSetType    列表的記錄集資源類型(枚舉)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit
Public Const OPAQUE = 2
Public Enum ListRecordSetType                             '帶'*'表示局部記錄集資源
     lrtCustomer = 1             '單位
     lrtDepartment               '部門
     lrtEmployee                 '職員
     lrtClass1                   '統計
     lrtCurrencys                '全幣種                  *
     lrtTerm                     '付款條件
     lrtAccount                  '科目
     lrtItem                     '商品
     lrtJob                      '工程表
     lrtPosition                 '貨位
     
     lrtRemark                   '摘要
     lrtCustom1                  '自定義項目1
     lrtCustom2                  '自定義項目2
     lrtCustom3                  '自定義項目3
     lrtCustom4                  '自定義項目4
     lrtCustom5                  '自定義項目5
     lrtClass2                   '項目
     lrtRate                     '匯率                    *
     lrtVoucherType              '憑證類型
     lrtCustom0                  '自定義項目0
     
     lrtTemplate                 '單據模板                *
     lrtAccountType              '科目類型                *
     lrtInvRecAccount            '應收/應付科目           *
     lrtCustomerAddress          '單位發貨地址            *
     lrtCustomerBank             '單位開戶銀行            *
     lrtBusinessAddress          '企業地址
     lrtBusinessBank             '企業開戶銀行
     lrtItemUnit                 '商品單位                *
     lrtTax                      '稅率                    *
     lrtTransVoucher             '轉帳憑證                *
     
     lrtPaymentMethod            '付款方式                *

End Enum
Declare Function SetWindowContextHelpId Lib "user32" (ByVal hwnd As Long, ByVal dw As Long) As Long
Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function ValidateRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function ValidateRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long) As Long
Public Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Public Declare Function InvalidateRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bErase As Long) As Long
Public Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'Declare Function UpdateColors Lib "gdi32" (ByVal hdc As Long) As Long
Private arrResPicture() As Object                '圖片資源數組
Private arrResPictureID() As Long                '圖片資源ID數組
Private arrResPictureCount() As Integer          '圖片資源加載個數數組
Private arrResPictureType() As Integer           '圖片資源類型

Private arrListRecSet() As rdoResultset             '列表的記錄集資源數組
Private arrListRecSetType() As ListRecordSetType '列表的記錄集資源類型數組
Private arrListRecSetCount() As Integer          '列表的記錄集資源使用個數數組

'改變控件Tag屬性
'參數：strTag 需要改變的Tag，strRep 替換的字符串，intSect 要替換的段號
Public Function ChangeTag(ByVal strTag As String, strRep As String, intSect As Integer, Optional strSep As String = "/", Optional SecondSep As String = "") As String
   Dim strTemp As String
   Dim intSepNum As Integer
   Dim strLeft As String
   Dim strRight As String
   Dim intCount As Integer
   
   If SecondSep = "" Then
        intSepNum = strCount(strTag, strSep) + 1
   Else
        intSepNum = strCount(strTag, SecondSep) + 2
   End If
   
   For intCount = 1 To intSect - 1
        If SecondSep = "" Then
            If strLeft = "" Then
               strLeft = GetNoXString(strTag, intCount, strSep)
            Else
               strLeft = strLeft & strSep & GetNoXString(strTag, intCount, strSep)
            End If
        Else
            If intCount = 1 Then
               strLeft = GetNoXString(strTag, intCount, strSep)
            Else
               If strLeft = "" Then
                   strLeft = GetNoXString(GetNoXString(strTag, 2, strSep), intCount - 1, SecondSep)
               Else
                   strLeft = strLeft & IIf(intCount < 3, strSep, SecondSep) & GetNoXString(GetNoXString(strTag, 2, strSep), intCount - 1, SecondSep)
               End If
            End If
        End If
   Next intCount
   
   For intCount = intSect + 1 To intSepNum
        If SecondSep = "" Then
            If strRight = "" Then
               strRight = GetNoXString(strTag, intCount, strSep)
            Else
               strRight = strRight & strSep & GetNoXString(strTag, intCount, strSep)
            End If
        Else
            If intCount = 1 Then
               strRight = GetNoXString(strTag, intCount, strSep)
            Else
               If strRight = "" Then
                   strRight = GetNoXString(GetNoXString(strTag, 2, strSep), intCount - 1, SecondSep)
               Else
                   strRight = strRight & IIf(intCount < 3, strSep, SecondSep) & GetNoXString(GetNoXString(strTag, 2, strSep), intCount - 1, SecondSep)
               End If
            End If
        End If
   Next intCount
   
   If SecondSep = "" Then
        If strLeft = "" Then
            ChangeTag = strRep & strSep & strRight
        Else
            ChangeTag = strLeft & strSep & strRep & strSep & strRight
        End If
   Else
        If intSect <= 2 Then
            If strLeft = "" Then
                ChangeTag = strRep & strSep & strRight
            Else
                ChangeTag = strLeft & strSep & strRep & strSep & strRight
            End If
        Else
            If strLeft = "" Then
                ChangeTag = strRep & SecondSep & strRight
            Else
                ChangeTag = strLeft & SecondSep & strRep & SecondSep & strRight
            End If
        End If
   End If
End Function

'取欄目寬度
Public Function GetDisplayWidth(ByVal strCaption As String, intLenth As Integer) As Long
   On Error GoTo ErrHandle
   GetDisplayWidth = frmMain.ActiveForm.TextWidth("A") * ((IIf(StrLen(strCaption) > intLenth, StrLen(strCaption), intLenth)) + 1)
   Exit Function
ErrHandle:
   GetDisplayWidth = 90 * (IIf(StrLen(strCaption) > intLenth, StrLen(strCaption), intLenth))
End Function

'取小數位數對應的格式化字符串
Public Function GetFormatString(ByVal intDec As Integer, Optional IsShowSep As Boolean = True) As String
    Dim intI As Integer
    If intDec = 0 Then
        If IsShowSep Then
           GetFormatString = "###,###,###,###,##0"
        Else
           GetFormatString = "#0"
        End If
        Exit Function
    End If
    If IsShowSep Then
       GetFormatString = "###,###,###,###,##0."
    Else
       GetFormatString = "#0."
    End If
    For intI = 1 To intDec
        GetFormatString = GetFormatString + "0"
    Next intI
End Function

'取出用分隔符分隔的字符串中第X個子串（第intSect段）
Public Function GetNoXString(Optional ByVal strSource As String = "", Optional ByVal intSect As Integer = 1, Optional strSeprater As String = " ") As String
 Dim strTemp As String
 Dim intCount As Integer
   GetNoXString = ""
   For intCount = 1 To intSect
       If Trim(strSource) = "" Then
          GetNoXString = ""
          Exit For
       End If
       GetNoXString = Trim(StringOut(strSource, strSeprater))
   Next intCount
End Function

'從系統注冊表中加載最近打開文件到mnuFileMenu數組。
Public Sub LoadMRU()
    Dim intCnt As Integer
    Dim strProduceName As String
    
    strProduceName = App.title
    For intCnt = 0 To 3
        With frmMain.mnuFileMRU(intCnt)
            .Caption = GetSetting(strProduceName, "ORAMRU", "File" & intCnt, "")
            If .Caption <> "" Then
                .Visible = True
                .Caption = "&" & (intCnt + 1) & " " & .Caption
            Else
                .Visible = False
            End If
        End With
    Next
        
    frmMain.mnuFileMRUBar.Visible = frmMain.mnuFileMRU(0).Visible
End Sub

'把mnuFileMenu數組中最近打開文件存儲到系統注冊表。
Public Sub SaveMRU()
    Dim intCnt As Integer
    Dim strProduceName As String
    
    strProduceName = App.title
    For intCnt = 0 To 3
        With frmMain.mnuFileMRU(intCnt)
            SaveSetting strProduceName, "ORAMRU", "File" & intCnt, IIf(.Visible, Mid(.Caption, 4), "")
        End With
    Next
End Sub

'根據打開文件strFileName，調整MRU
Public Sub UpdateMRU(StrFileName As String, Optional strErrFile As String = "")
    Dim intCnt As Integer, intFound As Integer
    Dim strProduceName As String
    Dim strTempName As String
    
    ' 從mnuFileMRU中查找strFileName
    intFound = 3
    For intCnt = 0 To 2
        With frmMain.mnuFileMRU(intCnt)
            If .Visible Then
                If UCase(Mid(.Caption, 4)) = UCase(StrFileName) Then
                    intFound = intCnt
                    Exit For
                End If
            End If
        End With
    Next
    
    strProduceName = App.title
    With frmMain
        For intCnt = intFound To 1 Step -1
            .mnuFileMRU(intCnt).Caption = "&" & intCnt + 1 & " " & Mid(.mnuFileMRU(intCnt - 1).Caption, 4)
            .mnuFileMRU(intCnt).Visible = .mnuFileMRU(intCnt - 1).Visible
        Next
        
        With .mnuFileMRU(0)
            If StrFileName <> "" Then
                .Caption = "&1 " & StrFileName
                .Visible = True
            Else
                If strErrFile <> "" Then
                    intFound = 0
                    For intCnt = 1 To 3
                        If Mid(frmMain.mnuFileMRU(intCnt).Caption, 4) <> strErrFile Then
                            frmMain.mnuFileMRU(intFound).Caption = "&" & intFound + 1 & " " & Mid(frmMain.mnuFileMRU(intCnt).Caption, 4)
                            frmMain.mnuFileMRU(intFound).Visible = frmMain.mnuFileMRU(intCnt).Visible
                            intFound = intFound + 1
                        End If
                    Next
                    For intCnt = intFound To 3
                        frmMain.mnuFileMRU(intCnt).Visible = False
                    Next intCnt
                End If
            End If
        End With
        .mnuFileMRUBar.Visible = frmMain.mnuFileMRU(0).Visible
    End With
    
    SaveMRU
End Sub


'從系統注冊表中加載窗體位置、大小。
Public Sub LoadFormSetting(frmForm As Form)
    Dim strTitle As String, strFormName As String
    Dim intState As Integer
    
    On Error Resume Next
    strTitle = App.title
    strFormName = frmForm.Name
    With frmForm
      intState = GetSetting(strTitle, strFormName, "State", vbNormal)
      If intState <> vbNormal Then
         If intState = vbMinimized Then
           .WindowState = vbMaximized
         Else
           .WindowState = intState
         End If
      Else
        .Move GetSetting(strTitle, strFormName, "Left", .Left), GetSetting(strTitle, strFormName, "Top", .top) _
              , GetSetting(strTitle, strFormName, "Width", .width), GetSetting(strTitle, strFormName, "Height", .Height)
      End If
      If ((.Left + .width) < 0 Or .Left > Screen.width) Then
           .Left = 300
      End If
    End With
End Sub

'把窗體位置、大小存儲到系統注冊表中。
Public Sub SaveFormSetting(frmForm As Form)
    Dim strTitle As String, strFormName As String
    
    strTitle = App.title
    strFormName = frmForm.Name
    With frmForm
      SaveSetting strTitle, strFormName, "State", .WindowState
      'If Not .WindowState = vbMaximized Then
      If .WindowState = vbNormal Then
        SaveSetting strTitle, strFormName, "Left", .Left
        SaveSetting strTitle, strFormName, "Top", .top
        SaveSetting strTitle, strFormName, "Width", .width
        SaveSetting strTitle, strFormName, "Height", .Height
      End If
    End With
End Sub


'
'資源管理
'

'加載窗體內控件的圖片資源
Public Sub LoadFormResPicture(ByVal frmForm As Form)
    Dim ctlControl As Control
    Dim strControlType As String
    Dim strResID As String
    
    On Error GoTo Error_Handle
    
    Set frmForm.Icon = GetFormResPicture(139, vbResIcon)
    For Each ctlControl In frmForm.Controls
        strControlType = TypeName(ctlControl)
        strResID = ctlControl.Tag
        
        If strResID > "0" And strResID < "32767" And UCase(strControlType) <> UCase("ListText") Then
            If strResID > "1000" And strResID < "2000" Then
                Set ctlControl.Picture = GetFormResPicture(CLng(strResID), vbResBitmap)
            ElseIf strResID > "2000" And strResID < "3000" Then
                Select Case strControlType
                Case ""
                Case Else
                     Set ctlControl.MouseIcon = GetFormResPicture(CLng(strResID), vbResCursor)
                End Select
            Else
                Select Case strControlType
                Case "CommandButton"
                    Set ctlControl.Picture = GetFormResPicture(CInt(strResID), vbResBitmap)
                Case "MSFlexGrid"