frmsysug.frm

制造业产供销与往来系统源码,包括进销存及全部控件！

   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "ADD", Flex(FlexSysUg)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "CHG", Flex(FlexSysUg)
   
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   LoadDataIntoGrid "SYSUG"

Exit Sub
Errorhandle:
    MsgBox Err.Description
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim mButton As Button
    Dim mButtonKey As String
On Error GoTo Errorhandle
   

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub LoadDataIntoGrid(RecordName As String)
    Dim ItemStr As String
    Dim mSysug As SysUg
    Dim mSysUgPriv As SysUgPriv
    Dim mSysUgPrivTb As SysUgPrivTb
    Dim m_SysUgRfd As SysUgRfd
    Dim mCol As Integer
On Error GoTo Errorhandle

   Me.MousePointer = vbHourglass

   Select Case UCase(RecordName)
      Case "SYSUG"
       
            Set OSysUgs = New SysUgs
            
            OSysUgs.FillbyDb
            Flex(FlexSysUg).Rows = 1
            
            For Each mSysug In OSysUgs
               ItemStr = vbTab & mSysug.SysUgCode & vbTab & mSysug.SysUgMc
               Flex(FlexSysUg).AddItem ItemStr
               Flex(FlexSysUg).RowData(Flex(FlexSysUg).Rows - 1) = mSysug.SysUg_Key
            Next
            
            If Flex(FlexSysUg).Rows > 1 Then
              Flex(FlexSysUg).Row = 1
              Set OSysUg = OSysUgs(CStr(Flex(FlexSysUg).RowData(1)))
              SetValueToControl "SysUg"
            Else
               Set OSysUg = Nothing
               Clearcontrol "SysUg"
               Flex(FlexSysUgPriv).Rows = 1
               Flex(FlexSysUgRfd).Rows = 1
            End If
            
           
      Case "SYSUGPRIV"
            
            Flex(FlexSysUgPriv).Rows = 1
            
            For Each mSysUgPriv In OSysUg.SysUgPrivs
               ItemStr = vbTab & IIf(mSysUgPriv.SelectFlg = 1 And mSysUgPriv.SmXtjg.SmXtJgLevel = 2, "√", "") & vbTab & mSysUgPriv.SmXtjg.SmXtJg_SysFormCode & vbTab & mSysUgPriv.SmXtjg.SmXtJg_SysFormMc
               If mSysUgPriv.SmXtjg.SmXtJgLevel = 2 Then
                  For Each mSysUgPrivTb In mSysUgPriv.SysUgPrivTbs
                     ItemStr = ItemStr & vbTab & IIf(mSysUgPrivTb.SelectFlg = 1, "√", "") & mSysUgPrivTb.SysUgPrivTb_SysTbMc
                  Next
               End If
               Flex(FlexSysUgPriv).AddItem ItemStr
               Flex(FlexSysUgPriv).RowData(Flex(FlexSysUgPriv).Rows - 1) = mSysUgPriv.SysUgPriv_Key
               If mSysUgPriv.SmXtjg.SmXtJgLevel = 1 Then
                  Flex(FlexSysUgPriv).Row = Flex(FlexSysUgPriv).Rows - 1
                  For mCol = 1 To Flex(FlexSysUgPriv).Cols - 1
                     Flex(FlexSysUgPriv).Col = mCol
                     Flex(FlexSysUgPriv).CellBackColor = RGB(0, 128, 255)
                  Next
               End If
            Next

            If Flex(FlexSysUgPriv).Rows > 1 Then
               Flex(FlexSysUgPriv).Row = 1
               Set oSysUgPriv = OSysUg.SysUgPrivs(CStr(Flex(FlexSysUgPriv).RowData(1)))
            Else
               Set oSysUgPriv = Nothing
            End If
            
      Case "SYSUGRFD"
      
            Flex(FlexSysUgRfd).Rows = 1
                     
            For Each m_SysUgRfd In OSysUg.SysUgRfds
               ItemStr = vbTab & IIf(m_SysUgRfd.SelectFlg = 1, "√", "") & vbTab & m_SysUgRfd.SysUgRfd_RfdCode & vbTab & m_SysUgRfd.SysUgRfd_RfdMc
               Flex(FlexSysUgRfd).AddItem ItemStr
               Flex(FlexSysUgRfd).RowData(Flex(FlexSysUgRfd).Rows - 1) = m_SysUgRfd.SysUgRfd_Key
            Next
            
            If Flex(FlexSysUgRfd).Rows > 1 Then
               Flex(FlexSysUgRfd).Row = 1
               Set oSysUgRfd = OSysUg.SysUgRfds(CStr(Flex(FlexSysUgRfd).RowData(1)))
            Else
               Set oSysUgRfd = Nothing
            End If
           
   End Select
   
   Me.MousePointer = vbDefault
    
Exit Sub
Errorhandle:
   Me.MousePointer = vbDefault
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Clearcontrol(ControlName)
On Error GoTo Errorhandle

   Text(TxtSysUgCode).Text = ""
   Text(TxtSysUgMc).Text = ""
   Flex(FlexSysUgPriv).Rows = 1
   Flex(FlexSysUgRfd).Rows = 1

Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub AddRecord(RecordName As String)
On Error GoTo Errorhandle

   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbSysUg), RecordName
   Set OSysUg = New SysUg
   Clearcontrol "SysUg"
   SSTab1.Tab = 0
   Text(TxtSysUgCode).SetFocus
   Flex(FlexSysUg).Enabled = False
   LoadDataIntoGrid "SYSUGPRIV"
   LoadDataIntoGrid "SYSUGRFD"

Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub ChgRecord(RecordName As String)
On Error GoTo Errorhandle
    
    If OSysUg Is Nothing Then
        Exit Sub
    End If
    
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbSysUg), RecordName
   Flex(FlexSysUg).Enabled = False
   Text(TxtSysUgCode).SetFocus
   SSTab1.Tab = 0
    
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub CancelRecord(RecordName As String)
On Error GoTo Errorhandle

   If Flex(FlexSysUg).Rows = 1 Then
      Set OSysUg = Nothing
      Clearcontrol "SysUg"
   Else
      Set OSysUg = OSysUgs(CStr(Flex(FlexSysUg).RowData(Flex(FlexSysUg).Row)))
      SetValueToControl "SysUg"
   End If
      
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbSysUg), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Delrecord(RecordName As String)
On Error GoTo Errorhandle
   
   If OSysUg Is Nothing Then
       Exit Sub
   End If
   
   If Flex(FlexSysUg).Rows = 1 Then
       Exit Sub
   End If
    
   If MsgBox("您真的要删除吗？", vbYesNo) = vbYes Then
      OSysUgs.Remove CStr(OSysUg.SysUg_Key)
      gPublicFunction.RemoveFlexItem Flex(FlexSysUg).Row, Flex(FlexSysUg)
      If Flex(FlexSysUg).Rows = 1 Then
         Set OSysUg = Nothing
         Clearcontrol "SysUg"
      Else
         Set OSysUg = OSysUgs(CStr(Flex(FlexSysUg).RowData(Flex(FlexSysUg).Row)))
         SetValueToControl "SysUg"
      End If
   End If

Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SaveRecord(RecordName As String)
On Error GoTo Errorhandle
   
   SetValueToObject RecordName
   
   Me.MousePointer = vbHourglass
            
   If OSysUg.SysUg_id = -1 Then
      OSysUg.DbSave
      OSysUgs.Add OSysUg
      ChgGrid "add_SysUg"
   Else
      OSysUg.DbSave
      ChgGrid "chg_SysUg"
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbSysUg), RecordName
   Flex(FlexSysUg).Enabled = True
    
   Me.MousePointer = vbDefault
    
Exit Sub
Errorhandle:
   Me.MousePointer = vbDefault
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub ChgGrid(RecordName As String)
    Dim ItemStr As String
On Error GoTo Errorhandle

   If UCase(Left(RecordName, 3)) = "ADD" Then
      ItemStr = vbTab & OSysUg.SysUgCode & vbTab & OSysUg.SysUgMc
      Flex(FlexSysUg).AddItem ItemStr
      Flex(FlexSysUg).RowData(Flex(FlexSysUg).Rows - 1) = OSysUg.SysUg_Key
      Flex(FlexSysUg).Row = Flex(FlexSysUg).Rows - 1
   Else
      Flex(FlexSysUg).TextMatrix(Flex(FlexSysUg).Row, 1) = Text(TxtSysUgCode).Text
      Flex(FlexSysUg).TextMatrix(Flex(FlexSysUg).Row, 2) = Text(TxtSysUgMc).Text
   End If

Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SetValueToObject(ObjectName As String)
   Dim I As Integer, J As Integer
   Dim mSysUgPriv As SysUgPriv
   Dim mSysUgPrivTb As SysUgPrivTb
   Dim mSysUgRfd As SysUgRfd
On Error GoTo Errorhandle

   OSysUg.SysUgCode = Trim(Text(TxtSysUgCode).Text)
   OSysUg.SysUgMc = Trim(Text(TxtSysUgMc).Text)
   
   For I = 1 To Flex(FlexSysUgPriv).Rows - 1
      Set mSysUgPriv = OSysUg.SysUgPrivs(CStr(Flex(FlexSysUgPriv).RowData(I)))
      If mSysUgPriv.SmXtjg.SmXtJgLevel = 2 Then
         If Trim(Flex(FlexSysUgPriv).TextMatrix(I, 1)) <> "" Then
            mSysUgPriv.SelectFlg = 1
            For J = 4 To Flex(FlexSysUgPriv).Cols - 1
               If Trim(Flex(FlexSysUgPriv).TextMatrix(I, J)) <> "" Then
                  Set mSysUgPrivTb = mSysUgPriv.SysUgPrivTbs(CStr(J - 3))
                  If Trim(Flex(FlexSysUgPriv).TextMatrix(I, Flex(FlexSysUgPriv).ColIndex("SYSUGPRIVTB_SELECT"))) <> "" Then
                     If InStr(1, Trim(Flex(FlexSysUgPriv).TextMatrix(I, J)), "√") > 0 Then
                        mSysUgPrivTb.SelectFlg = 1
                     Else
                        mSysUgPrivTb.SelectFlg = 0
                     End If
                  Else
                     mSysUgPrivTb.SelectFlg = 0
                  End If
               End If
            Next
         Else
            mSysUgPriv.SelectFlg = 0
         End If
      End If
   Next
   
   For I = 1 To Flex(FlexSysUgRfd).Rows - 1
      Set mSysUgRfd = OSysUg.SysUgRfds.Item(CStr(Flex(FlexSysUgRfd).RowData(I)))
      mSysUgRfd.SelectFlg = IIf(Trim(Flex(FlexSysUgRfd).TextMatrix(I, Flex(FlexSysUgRfd).ColIndex("SELECTFLG|SYSUGRFDNO"))) <> "", 1, 0)
   Next
    
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Form_Resize()
On Error GoTo Errorhandle
   
   gPublicFunction.ResizeForm Me
   
Exit Sub
Errorhandle:
    MsgBox Err.Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Errorhandle

   Set OSysUg = Nothing
   Set OSysUgs = Nothing
   
   gPublicFunction.SaveFormSet Me
    
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub muEdit_Click(Index As Integer)
On Error GoTo Errorhandle
         
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Text_GotFocus(Index As Integer)
On Error GoTo Errorhandle
    
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Text_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
On Error GoTo Errorhandle

   gPublicFunction.FormKeyDown Me, KeyCode, Shift, Text(Index)

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Text_KeyPress(Index As Integer, KeyAscii As Integer)
On Error GoTo Errorhandle

   gPublicFunction.InputCheck Me, Text(Index), KeyAscii

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub SetValueToControl(ObjectName As String)
On Error GoTo Errorhandle

   Text(TxtSysUgCode).Text = OSysUg.SysUgCode
   Text(TxtSysUgMc).Text = OSysUg.SysUgMc
   LoadDataIntoGrid "SYSUGPRIV"
   LoadDataIntoGrid "SYSUGRFD"

Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Text_LostFocus(Index As Integer)
On Error GoTo Errorhandle

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error GoTo Errorhandle
    
    Exit Sub
Errorhandle:
    MsgBox Err.Description
End Sub

Private Sub Tlbaction_ButtonClick(Index As Integer, ByVal Button As MSComctlLib.Button)
    Dim Action, RecordName As String
On Error GoTo Errorhandle

    Action = (Mid(Button.Key, 1, 3))
    RecordName = Button.Key
    
    Select Case Action
        Case "ADD"
             AddRecord RecordName
        Case "CHG"
             ChgRecord RecordName
        Case "CAN"
             CancelRecord RecordName
        Case "SAV"
             SaveRecord RecordName
        Case "DEL"
             Delrecord RecordName
        Case "EXI"
             Unload Me
        Case "FIN"
             
        Case Else
            
    End Select
    Exit Sub
Errorhandle:
    MsgBox Err.Description
End Sub