frmoperatorgrp.frm

金算盘软件代码

VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#4.0#0"; "ATLEDIT.OCX"
Begin VB.Form frmOperatorGrp 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "增加操作员组"
   ClientHeight    =   1515
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4545
   HelpContextID   =   80003
   Icon            =   "frmOperatorGrp.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1515
   ScaleWidth      =   4545
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   2
      Left            =   3240
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1009"
      Top             =   840
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   3240
      Style           =   1  'Graphical
      TabIndex        =   3
      Tag             =   "1002"
      Top             =   480
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   0
      Left            =   3240
      Style           =   1  'Graphical
      TabIndex        =   2
      Tag             =   "1001"
      Top             =   120
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin AtlEdit.TEdit txtGroup 
      Height          =   285
      Left            =   330
      TabIndex        =   1
      Top             =   600
      Width           =   2535
      _ExtentX        =   4471
      _ExtentY        =   503
      maxchar         =   30
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Text            =   ""
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "操作员组(&G)"
      Height          =   195
      Left            =   360
      TabIndex        =   0
      Top             =   360
      Width           =   1035
   End
End
Attribute VB_Name = "frmOperatorGrp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'操作员组卡片模块
'      作者：欧中建
'      日期：1998.6.10
'用于修改，新增，某一操作员组

Option Explicit
Option Compare Text

Private mblnIsChanged As Boolean
Private mblnIsList As Boolean
Private mblnIsInit As Boolean
Private mblnIsNew As Boolean
Private mlngGroupID As Long
Private mlngDGroupID As Long
Private mstrGroupName As String

Public Function AddCard(Optional strGroupName As String = "", _
    Optional ByVal IsList As Boolean = False) As Long
    
    cmdOk(2).Default = True
    mstrGroupName = strGroupName
    mlngGroupID = 0
    mblnIsNew = True
    mblnIsList = IsList
    InitCard strGroupName
    Show vbModal
    AddCard = mlngGroupID
End Function

Public Sub EditCard(lngID As Long, strGroupName As String)
    
    mstrGroupName = strGroupName
    If Trim(strGroupName) = "" Then
        ShowMsg 0, "请先选择一个操作员组,再进行修改！", _
            vbExclamation + MB_TASKMODAL, "修改操作员组"
        Unload Me
    Else
        If Not CheckIDUsed("OperatorGroup", "lngOperatorGroupID", lngID) Then
            ShowMsg 0, "“" & strGroupName & "”操作员组不存在,不能进行修改！", _
                vbExclamation + MB_TASKMODAL, "修改操作员组"
            Unload Me
        Else
            mlngGroupID = lngID
            mblnIsNew = False
            Caption = "修改操作员组"
            cmdOk(2).Visible = False
            InitCard
            Show vbModal
        End If
    End If
End Sub

Private Sub cmdOK_Click(Index As Integer)
    If Index = 0 Then
        If Not SaveCard Then
            txtGroup.SetFocus
            Exit Sub
        End If
    ElseIf Index = 2 Then
        If SaveCard Then
'            mlngGroupID = 0
'            mblnIsChanged = True
            InitCard
            txtGroup.SetFocus
        End If
        Exit Sub
    End If
    Unload Me
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If mblnIsList Then
        mblnIsList = False
        Exit Sub
    End If
    If KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdOk(0).Value = True
    End If
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
'    SetHelpID hwnd, 80003
    Utility.LoadFormResPicture Me
'    SendKeys "%{G}"
    Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_Paint()
    FrameBox Me.hwnd, 120, 120, 3070, 1320
End Sub

Private Function SaveCard() As Boolean
    Dim recGroup As rdoResultset, strSql As String
    
    On Error GoTo ErrHandle
    gclsBase.BaseWorkSpace.BeginTrans
    SaveCard = False
    If Not mblnIsChanged Then
        SaveCard = True
        GoTo ErrHandle
    End If
    If txtGroup.Text = "" Then
        ShowMsg hwnd, "操作员组名不能为空！", vbExclamation, Me.Caption
        txtGroup.SetFocus
        GoTo ErrHandle
    End If
    If Not CodeCheck Then
        If mblnIsNew Then
            ShowMsg hwnd, "操作员组名不能为重复,请重新录入！", vbExclamation, Caption
            txtGroup.SetFocus
            txtGroup.SelStart = 0
            txtGroup.SelLength = Len(txtGroup.Text)
            GoTo ErrHandle
        Else
            If ShowMsg(hwnd, "是否将操作员组“" & mstrGroupName & "”与“" & txtGroup.Text _
                & "”进行合并？", vbQuestion + vbYesNo, Caption) = vbNo Then
                txtGroup.SetFocus
                GoTo ErrHandle
            Else   '合并编码
                If Not DisplaceActivity("Operator", "lngOperatorGroupID", mlngDGroupID, mlngGroupID) Then
                    GoTo ErrHandle
                End If
                strSql = "DELETE FROM OperatorGroup WHERE lngOperatorGroupID=" & mlngGroupID
                If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
            End If
        End If
    Else
        If mblnIsNew Then
            mlngGroupID = GetNewID("OperatorGroup")
            strSql = "INSERT INTO OperatorGroup(lngOperatorGroupID,strOperatorGroupName) VALUES(" _
                & mlngGroupID & ",'" & Trim(txtGroup.Text) & "')"
            If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
'            strSql = "SELECT * FROM OperatorGroup WHERE strOperatorGroupName='" & Trim(txtGroup.Text) & "'"
'            Set recGroup = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'            mlngGroupID = recGroup!lngOperatorGroupID
'            recGroup.Close
        Else
            strSql = "UPDATE OperatorGroup SET strOperatorGroupName='" _
                & Trim(txtGroup.Text) & "' WHERE strOperatorGroupName='" _
                & mstrGroupName & "'"
            If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
        End If
    End If
    gclsBase.BaseWorkSpace.CommitTrans
    mblnIsChanged = False
    SaveCard = True
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollBacktrans
End Function

Private Function CodeCheck() As Boolean
    Dim recGroup As rdoResultset, strSql As String
    
    strSql = "SELECT * FROM OperatorGroup WHERE strOperatorGroupName='" _
        & txtGroup.Text & "' AND lngOperatorGroupID<>" & mlngGroupID
    Set recGroup = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recGroup.EOF Then
        CodeCheck = False
        mlngDGroupID = recGroup!lngOperatorGroupID
    Else
        CodeCheck = True
    End If
    recGroup.Close
End Function

Private Sub InitCard(Optional strGroupName As String = "")
    Dim strSql As String
    Dim recOperatorGp As rdoResultset
    
    mblnIsInit = True
    If Not mblnIsNew Then
        strSql = "SELECT strOperatorGroupName FROM OperatorGroup WHERE lngOperatorGroupID=" & mlngGroupID
        Set recOperatorGp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        txtGroup.Text = recOperatorGp!strOperatorGroupName
        recOperatorGp.Close
        mblnIsChanged = False
    Else
        txtGroup.Text = strGroupName
        mblnIsChanged = True
    End If
    mblnIsInit = False
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode <> vbFormControlMenu Then Exit Sub
    If mblnIsChanged Then
        If mblnIsNew Then
            If ShowMsg(hwnd, "要保存新增的操作员组吗？", vbQuestion + vbYesNo, Caption) = vbYes Then
                Cancel = Not SaveCard
            End If
        Else
            If ShowMsg(hwnd, "要保存对操作员组的修改吗？", vbQuestion + vbYesNo, Caption) = vbYes Then
                Cancel = Not SaveCard
            End If
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Utility.UnLoadFormResPicture Me
End Sub

Private Sub txtGroup_Change()
    
    If ContainErrorChar(txtGroup.Text) Then BKKEY txtGroup.hwnd
    If Not mblnIsInit Then mblnIsChanged = True
End Sub