frmremindercard.frm

金算盘软件代码

      Top             =   1920
      Width           =   270
      _ExtentX        =   397
      _ExtentY        =   476
      _Version        =   327681
      BuddyControl    =   "txtReminder(3)"
      BuddyDispid     =   196609
      BuddyIndex      =   3
      OrigLeft        =   2835
      OrigTop         =   1920
      OrigRight       =   3105
      OrigBottom      =   2190
      Max             =   366
      Min             =   -366
      SyncBuddy       =   -1  'True
      BuddyProperty   =   65547
      Enabled         =   -1  'True
   End
   Begin ComCtl2.UpDown UpDown1 
      Height          =   270
      Index           =   5
      Left            =   2565
      TabIndex        =   20
      Top             =   2371
      Width           =   270
      _ExtentX        =   397
      _ExtentY        =   476
      _Version        =   327681
      BuddyControl    =   "txtReminder(5)"
      BuddyDispid     =   196609
      BuddyIndex      =   5
      OrigLeft        =   2835
      OrigTop         =   2760
      OrigRight       =   3105
      OrigBottom      =   3030
      Max             =   366
      Min             =   -366
      SyncBuddy       =   -1  'True
      BuddyProperty   =   65547
      Enabled         =   -1  'True
   End
   Begin ComCtl2.UpDown UpDown1 
      Height          =   270
      Index           =   6
      Left            =   2565
      TabIndex        =   24
      Top             =   2797
      Width           =   270
      _ExtentX        =   397
      _ExtentY        =   476
      _Version        =   327681
      BuddyControl    =   "txtReminder(6)"
      BuddyDispid     =   196609
      BuddyIndex      =   6
      OrigLeft        =   2835
      OrigTop         =   3180
      OrigRight       =   3105
      OrigBottom      =   3450
      Max             =   366
      Min             =   -366
      SyncBuddy       =   -1  'True
      BuddyProperty   =   65547
      Enabled         =   -1  'True
   End
   Begin VB.Label lblReminder 
      Caption         =   "报警"
      Height          =   255
      Left            =   360
      TabIndex        =   22
      Top             =   360
      Width           =   855
   End
   Begin VB.Label lblRate 
      Caption         =   "提前日"
      Height          =   255
      Left            =   2040
      TabIndex        =   21
      Top             =   360
      Width           =   855
   End
End
Attribute VB_Name = "frmReminderCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''
'   报警选择卡片
'
'   作者:郑权
'   日期：98.7.3
'
'
''''''''''''''
Option Explicit
Private mblnIsChanged As Boolean                     '判断控件是否改变
'Private WithEvents mclsMainControl As MainControl    '主控
'取操作员ID
Private Function OperatorID() As Long
        OperatorID = gclsBase.OperatorID
End Function
'调整操作员表
Private Function UpdateOperator(ByVal lngID As Long) As Boolean
    Dim Strsql As String
    
    If chkReminder(7).Value Then
        Strsql = "UPDATE Operator Set blnIsReminderSO= " & IIf(chkReminder(0).Value = 0, False, True) _
            & ", blnIsReminderPO =" & IIf(chkReminder(1).Value = 0, False, True) _
            & ", blnIsReminderAP =" & IIf(chkReminder(2).Value = 0, False, True) _
            & ", blnIsReminderAR =" & IIf(chkReminder(3).Value = 0, False, True) _
            & ", blnIsReminderStock =" & IIf(chkReminder(4).Value = 0, False, True) _
            & ", blnIsReminderVaild =" & IIf(chkReminder(5).Value = 0, False, True) _
            & ", blnIsReminderVoucher=" & IIf(chkReminder(6).Value = 0, False, True) _
            & ", blnIsReminder=" & IIf(chkReminder(7).Value = 0, False, True) & _
              ",intReminderSO = " & Val(txtReminder(0).Text) & _
              ",intReminderPO = " & Val(txtReminder(1).Text) & _
              ",intReminderAP = " & Val(txtReminder(2).Text) & _
              ",intReminderAR = " & Val(txtReminder(3).Text) & _
              ",intReminderValid =" & Val(txtReminder(5).Text) & _
              ",intReminderNote=" & Val(txtReminder(6).Text) & _
              " WHERE lngOperatorID = " & lngID
    Else
       Strsql = "Update Operator set intReminderNote=" & Val(txtReminder(6).Text) & _
       ",blnIsReminder=false"
    End If
    UpdateOperator = gclsBase.ExecSQL(Strsql)
End Function

Private Function SaveCard() As Boolean
        If UpdateOperator(OperatorID) Then
           gclsSys.SendMessage CStr(Me.hwnd), Message.msgReminder
           SaveCard = True
        Else
           SaveCard = False
        End If
        
End Function

Private Sub chkReminder_Click(Index As Integer)
    mblnIsChanged = True
End Sub
'Ok,Cancel
Private Sub cmdokcancel_Click(Index As Integer)
   Select Case Index
          Case 0
               If SaveCard() Then
                  mblnIsChanged = False
                  Unload Me
               Else
                  mblnIsChanged = True
                  txtReminder(0).SetFocus
               End If
          Case 1
               mblnIsChanged = False
               Unload Me
   End Select
   
End Sub

Private Sub Form_Load()
   Dim recRecordset As rdoResultset
   Dim Strsql As String
   
   SetHelpID Me.hwnd, 30009
   Set cmdOKCancel(0).Picture = LoadResPicture(1001, vbResBitmap)
   Set cmdOKCancel(1).Picture = LoadResPicture(1002, vbResBitmap)
   'Set mclsMainControl = gclsSys.MainControls.Add(Me)
'   frmReminderCard.IsShowCard = True
   Strsql = "select * from operator where lngOperatorID=" & OperatorID
   Set recRecordset = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
   recRecordset.MoveFirst
   With recRecordset
        chkReminder(0).Value = IIf(!blnIsReminderSO, 1, 0)
        chkReminder(1).Value = IIf(!blnIsReminderPO, 1, 0)
        chkReminder(2).Value = IIf(!blnIsReminderAP, 1, 0)
        chkReminder(3).Value = IIf(!blnIsReminderAR, 1, 0)
        chkReminder(4).Value = IIf(!blnIsReminderStock, 1, 0)
        chkReminder(5).Value = IIf(!blnIsReminderVaild, 1, 0)
        chkReminder(6).Value = IIf(!blnIsReminderVoucher, 1, 0)
        chkReminder(7).Value = IIf(!blnIsReminder, 1, 0)
        txtReminder(0).Text = !intReminderSO
        txtReminder(1).Text = !intReminderPO
        txtReminder(2).Text = !intReminderAP
        txtReminder(3).Text = !intReminderAR
        txtReminder(5).Text = !intReminderValid
        txtReminder(6).Text = !intReminderNote
   End With
   recRecordset.Close
   
End Sub

Private Sub Form_Paint()
   FrameBox Me.hwnd, 60, 160, 3500, 4080
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intResponse As Integer
    
    If mblnIsChanged Then
        intResponse = MsgBox("当前报警选择已被修改，是否保存？", vbYesNoCancel)
        If intResponse = vbYes Then
            Cancel = Not SaveCard()
        ElseIf intResponse = vbCancel Then
            Cancel = True
        End If
    End If
    If Not Cancel Then mblnIsChanged = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'frmTermList.IsShowCard = False
'    gclsSys.CurrFormName = ""
'    gclsSys.MainControls.Remove Me
End Sub

'检查正确性
Private Function CheckIsRight(strChecked As String) As Boolean
    Dim n As Integer
    CheckIsRight = False
    
    If Len(strChecked) = 0 Then
       Exit Function
    End If
    For n = 1 To Len(strChecked)
       If InStr(1, "1234567890", Mid(strChecked, n, 1)) = 0 Then
            SendKeys "{BS}"
            Exit Function
       End If
    Next
    If IsNumeric(strChecked) Then
       If Abs(Val(strChecked)) > 366 Then
          SendKeys "{bs}"
          Exit Function
       End If
    End If
          
    CheckIsRight = True
End Function

Private Sub txtReminer_Change(Index As Integer)
   mblnIsChanged = True
End Sub

Private Sub txtReminder_Change(Index As Integer)
    If CheckIsRight(txtReminder(Index).Text) Then mblnIsChanged = True
End Sub

Private Sub UpDown1_Change(Index As Integer)
   mblnIsChanged = True
End Sub