frmsysur.frm

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

   Flex(FlexSysUrUg).ColKey(3) = "SYSUGMC"
   
   LoadDataIntoGrid "SysUr"
   
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbSysUr), Img(ImgSysUr), SBar(SBarSysUr)
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "SYSUR", "TXTSYSURCODE", "TXTSYSURRPASS"
  
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexSysUr)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexSysUrUg)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "ADD", Flex(FlexSysUr)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "CHG", Flex(FlexSysUr)
   
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   
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 mSysUr As SysUr
    Dim mSysUrUg As SysUrUg
    Dim mCol As Integer
On Error GoTo Errorhandle

   Select Case UCase(RecordName)
      Case "SYSUR"
       
            Set OSysUrs = New SysUrs
            
            OSysUrs.FillbyDb
            Flex(FlexSysUr).Rows = 1
            
            For Each mSysUr In OSysUrs
               ItemStr = vbTab & mSysUr.SysUrCode & vbTab & mSysUr.SysUrMc
               Flex(FlexSysUr).AddItem ItemStr
               Flex(FlexSysUr).RowData(Flex(FlexSysUr).Rows - 1) = mSysUr.SysUr_Key
            Next
            
            If Flex(FlexSysUr).Rows > 1 Then
              Flex(FlexSysUr).Row = 1
              Set OSysUr = OSysUrs(CStr(Flex(FlexSysUr).RowData(1)))
              SetValueToControl "SysUr"
            Else
               Set OSysUr = Nothing
               Clearcontrol "SysUr"
            End If
            
           
      Case "SYSURUG"
            
            Flex(FlexSysUrUg).Rows = 1
            
            For Each mSysUrUg In OSysUr.SysUrUgs
               ItemStr = vbTab & IIf(mSysUrUg.SelectFlg = 1, "√", "") & vbTab & mSysUrUg.SysUrUg_SysUgCode & vbTab & mSysUrUg.SysUrUg_SysUgMc
               Flex(FlexSysUrUg).AddItem ItemStr
               Flex(FlexSysUrUg).RowData(Flex(FlexSysUrUg).Rows - 1) = mSysUrUg.SysUrUg_Key
            Next

            If Flex(FlexSysUrUg).Rows > 1 Then
               Flex(FlexSysUrUg).Row = 1
               Set oSysUrUg = OSysUr.SysUrUgs(CStr(Flex(FlexSysUrUg).RowData(1)))
            Else
               Set oSysUrUg = Nothing
            End If
           
   End Select
    
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Clearcontrol(ControlName)
On Error GoTo Errorhandle

   Text(TxtSysUrCode).Text = ""
   Text(TxtSysUrMc).Text = ""
   Text(TxtSysUrPass).Text = ""
   Text(TxtSysUrRPass).Text = ""
   Flex(FlexSysUrUg).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(TlbSysUr), RecordName
   Set OSysUr = New SysUr
   Clearcontrol "SysUr"
   Text(TxtSysUrCode).SetFocus
   Flex(FlexSysUr).Enabled = False
   LoadDataIntoGrid "SYSURUG"
   SSTab1.Tab = 0

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

Private Sub ChgRecord(RecordName As String)
On Error GoTo Errorhandle
    
   If OSysUr Is Nothing Then
      Exit Sub
   End If
    
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbSysUr), RecordName
   Flex(FlexSysUr).Enabled = False
   Text(TxtSysUrCode).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(FlexSysUr).Rows = 1 Then
      Set OSysUr = Nothing
      Clearcontrol "SysUr"
   Else
      Set OSysUr = OSysUrs(CStr(Flex(FlexSysUr).RowData(Flex(FlexSysUr).Row)))
      SetValueToControl "SysUr"
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbSysUr), RecordName

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

Private Sub Delrecord(RecordName As String)
On Error GoTo Errorhandle
   
   If OSysUr Is Nothing Then
       Exit Sub
   End If
   
   If Flex(FlexSysUr).Rows = 1 Then
       Exit Sub
   End If
   
   If MsgBox("您真的要删除吗？", vbYesNo) = vbYes Then
      OSysUrs.Remove CStr(OSysUr.SysUr_Key)
      gPublicFunction.RemoveFlexItem Flex(FlexSysUr).Row, Flex(FlexSysUr)
      If Flex(FlexSysUr).Rows = 1 Then
         Set OSysUr = Nothing
         Clearcontrol "SysUr"
      Else
         Set OSysUr = OSysUrs(CStr(Flex(FlexSysUr).RowData(Flex(FlexSysUr).Row)))
         SetValueToControl "SysUr"
      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
           
   If OSysUr.SysUr_id = -1 Then
      OSysUr.DbSave
      OSysUrs.Add OSysUr
      ChgGrid "add_SysUr"
   Else
      OSysUr.DbSave
      ChgGrid "chg_SysUr"
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbSysUr), RecordName
    
Exit Sub
Errorhandle:
    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 & OSysUr.SysUrCode & vbTab & OSysUr.SysUrMc
      Flex(FlexSysUr).AddItem ItemStr
      Flex(FlexSysUr).RowData(Flex(FlexSysUr).Rows - 1) = OSysUr.SysUr_Key
      Flex(FlexSysUr).Row = Flex(FlexSysUr).Rows - 1
   Else
      Flex(FlexSysUr).TextMatrix(Flex(FlexSysUr).Row, Flex(FlexSysUr).ColIndex("SYSURCODE")) = Text(TxtSysUrCode).Text
      Flex(FlexSysUr).TextMatrix(Flex(FlexSysUr).Row, Flex(FlexSysUr).ColIndex("SYSURMC")) = Text(TxtSysUrMc).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 mSysUrUg As SysUrUg
On Error GoTo Errorhandle

   If Text(TxtSysUrPass).Text <> Text(TxtSysUrRPass).Text Then
      Err.Raise vbObjectError + 1, , "密码与确认密码不一致，请重新输入！"
      Exit Sub
   End If

   OSysUr.SysUrCode = Trim(Text(TxtSysUrCode).Text)
   OSysUr.SysUrMc = Trim(Text(TxtSysUrMc).Text)
   OSysUr.SysUrPass = Trim(Text(TxtSysUrPass).Text)
      
   For I = 1 To Flex(FlexSysUrUg).Rows - 1
      Set mSysUrUg = OSysUr.SysUrUgs(CStr(Flex(FlexSysUrUg).RowData(I)))
      If Trim(Flex(FlexSysUrUg).TextMatrix(I, 1)) <> "" Then
         mSysUrUg.SelectFlg = 1
      Else
         mSysUrUg.SelectFlg = 0
      End If
   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 OSysUr = Nothing
   Set OSysUrs = 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(TxtSysUrCode).Text = OSysUr.SysUrCode
   Text(TxtSysUrMc).Text = OSysUr.SysUrMc
   Text(TxtSysUrPass).Text = OSysUr.SysUrPass
   Text(TxtSysUrRPass).Text = OSysUr.SysUrPass
   
   LoadDataIntoGrid "SysUrUg"

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