frmsyscp.frm

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

         BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSysCp.frx":3444
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.StatusBar SBar 
      Align           =   2  'Align Bottom
      Height          =   375
      Index           =   0
      Left            =   0
      TabIndex        =   29
      Top             =   6045
      Width           =   10380
      _ExtentX        =   18309
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
   Begin VB.Menu mFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu muFile 
         Caption         =   ""
         Index           =   0
      End
   End
   Begin VB.Menu mEdit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu muEdit 
         Caption         =   ""
         Index           =   0
      End
   End
   Begin VB.Menu mView 
      Caption         =   "查看(&V)"
      Begin VB.Menu muView 
         Caption         =   ""
         Index           =   0
      End
   End
   Begin VB.Menu mHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu muHelp 
         Caption         =   ""
         Index           =   0
      End
   End
End
Attribute VB_Name = "frmSysCp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const TlbSysCp = 0
Const ImgSysCp = 0
Const SBarSysCp = 0

Const FlexSysCp = 0

Const TxtSysCpCode = 0
Const TxtSysCpMc = 1
Const TxtSysCpEMc = 5

Const TxtSysCpTel = 2
Const TxtSysCpFax = 3
Const TxtSysCpAdd = 4
Const TxtSysCpPCode = 11
Const TxtSysCpEmail = 10
Const TxtSysCpWww = 9

Const TxtSysCp_SCwqjCode = 12
Const LblSysCp_CCwqjCode = 6
Const TxtSysCp_CwBzCode = 14

Const CbxSysCp_SysTableNo = 1
Const CbxSysCpType = 0
Const CbxSysCpLinkSysTable = 2
Const CbxSysCpLinkSysCp = 3

Const CmdStart = 0

Dim mPreSysTableCode As String

Dim OSysCp As SysCp
Dim oSysCps As SysCps

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

Select Case Index

End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

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


Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

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

   Select Case Index
   Case CmdStart
         
         SaveRecord
         
         If MsgBox("是否启用系统？", vbYesNo + vbQuestion) = vbYes Then
            OSysCp.SysCpCw.Start Trim(Text(TxtSysCp_SCwqjCode).Text), Trim(Text(TxtSysCp_CwBzCode).Text)
            MsgBox "系统启用成功，请退出系统后重新登陆！", vbInformation
         End If
         
   End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description, vbInformation
End Sub

Private Sub Form_Load()
On Error GoTo Errorhandle

   gPublicFunction.LoadFormSet Me, , , SBar(SBarSysCp)
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "SysCp1", "TXTSYSCPCODE", "TXTSYSCPEMC"
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "SysCp2", "TXTSYSCPTEL", "TXTSYSCPWWW"
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "SysCp3", "TXTSYSCPCW_SCWQJNO", "TXTSYSCPCW_CWBZNO"
   
   Set oSysCps = New SysCps
   oSysCps.FillbyDb
   
   If oSysCps.Count = 0 Then
      Set OSysCp = New SysCp
      oSysCps.Add OSysCp
   Else
      Set OSysCp = oSysCps(1)
      SetValueToControl
   End If

Exit Sub
Errorhandle:
    MsgBox Err.Description
End Sub

Private Sub Clearcontrol()
On Error GoTo Errorhandle
          
   Text(TxtSysCpCode).Text = ""
   Text(TxtSysCpMc).Text = ""
   Text(TxtSysCpEMc).Text = ""
   
   Text(TxtSysCpTel).Text = ""
   Text(TxtSysCpFax).Text = ""
   Text(TxtSysCpAdd).Text = ""
   Text(TxtSysCpPCode).Text = ""
   Text(TxtSysCpEmail).Text = ""
   Text(TxtSysCpWww).Text = ""
   
   Text(TxtSysCp_SCwqjCode).Text = ""
   Label(LblSysCp_CCwqjCode).Caption = ""
   Text(TxtSysCp_CwBzCode).Text = ""

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

Private Sub SaveRecord()
On Error GoTo Errorhandle
   
   SetValueToObject
   OSysCp.DbSave
    
Exit Sub
Errorhandle:
    Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SetValueToObject()
On Error GoTo Errorhandle

   OSysCp.SysCpCode = Trim(Text(TxtSysCpCode).Text)
   OSysCp.SysCpMc = Trim(Text(TxtSysCpMc).Text)
   OSysCp.SysCpEmc = Trim(Text(TxtSysCpEMc).Text)
   
   OSysCp.SysCpTel = Trim(Text(TxtSysCpTel).Text)
   OSysCp.SysCpFax = Trim(Text(TxtSysCpFax).Text)
   OSysCp.SysCpAdd = Trim(Text(TxtSysCpAdd).Text)
   OSysCp.SysCpPCode = Trim(Text(TxtSysCpPCode).Text)
   OSysCp.SysCpEmail = Trim(Text(TxtSysCpEmail).Text)
   OSysCp.SysCpWww = Trim(Text(TxtSysCpWww).Text)
    
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 OSysCp = Nothing
   Set oSysCps = Nothing
   
   gPublicFunction.SaveFormSet Me
    
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()
On Error GoTo Errorhandle

   Text(TxtSysCpCode).Text = OSysCp.SysCpCode
   Text(TxtSysCpMc).Text = OSysCp.SysCpMc
   Text(TxtSysCpEMc).Text = OSysCp.SysCpEmc
   
   Text(TxtSysCpTel).Text = OSysCp.SysCpTel
   Text(TxtSysCpFax).Text = OSysCp.SysCpFax
   Text(TxtSysCpAdd).Text = OSysCp.SysCpAdd
   Text(TxtSysCpPCode).Text = OSysCp.SysCpPCode
   Text(TxtSysCpEmail).Text = OSysCp.SysCpEmail
   Text(TxtSysCpWww).Text = OSysCp.SysCpWww
   
   Text(TxtSysCp_SCwqjCode).Text = OSysCp.SysCpCw.SysCpCw_SCwqjCode
               
   Label(LblSysCp_CCwqjCode).Caption = OSysCp.SysCpCw.SysCpCw_CCwqjCode
   Text(TxtSysCp_CwBzCode).Text = OSysCp.SysCpCw.SysCpCw_CwBzCode
               
   If CStr(gPublicCommon.PublicSysDatas("SYSCPCW_SCWQJCODE").SysDataValue <> "") Then
      gPublicFunction.LockControl Me, Text(TxtSysCp_SCwqjCode), False
      gPublicFunction.LockControl Me, Text(TxtSysCp_CwBzCode), False
      gPublicFunction.LockControl Me, Command(CmdStart), False
   End If
   

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 "SAV"
             SaveRecord
        Case "EXI"
             Unload Me
        Case "FIN"
             ShowBmQuery
        Case Else
            
    End Select
    Exit Sub
Errorhandle:
    MsgBox Err.Description
End Sub

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

Select Case KeyCode
Case vbKeyF2
      ShowBmQuery
End Select
  
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub ShowBmQuery()
   Dim mCodeType As String
   Dim mQueryValue As String
On Error GoTo Errorhandle
  
   If Me.ActiveControl Is Nothing Then
      Exit Sub
   End If
      
   Select Case UCase(Me.ActiveControl.Tag)
   Case "TXTSYSCPCW_SCWQJNO|CWQJCODE"
         mCodeType = "CWQJCODE"
   Case "TXTSYSCPCW_CWBZNO|CWBZCODE"
         mCodeType = "CWBZCODE"
   End Select
   
   If mCodeType <> "" Then
      mQueryValue = gPublicFunction.GetBmQueryValue(Me, mCodeType)
      If mQueryValue <> "" Then
         Me.ActiveControl.Text = mQueryValue
      End If
   End If
  
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub