frmquota.frm

金算盘软件代码

         Caption         =   "已选表头(&Y)"
         Height          =   255
         Left            =   5310
         TabIndex        =   46
         Top             =   600
         Width           =   1455
      End
      Begin VB.Label LblHead 
         Caption         =   "可选表头(&K)"
         Height          =   255
         Left            =   2820
         TabIndex        =   44
         Top             =   600
         Width           =   1695
      End
      Begin VB.Label LblName 
         Alignment       =   2  'Center
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         Caption         =   "报表名称(&R)"
         ForeColor       =   &H00000000&
         Height          =   180
         Left            =   -72360
         TabIndex        =   2
         Top             =   600
         Width           =   1245
      End
      Begin VB.Label LblData 
         Caption         =   "数据项目(&K)"
         Height          =   225
         Left            =   -72180
         TabIndex        =   13
         Top             =   600
         Width           =   1035
      End
      Begin VB.Label LblReport 
         Caption         =   "报表项目(&Y)"
         Height          =   225
         Index           =   0
         Left            =   -69690
         TabIndex        =   15
         Top             =   600
         Width           =   1575
      End
      Begin VB.Label LblList 
         Caption         =   "列名(&L)"
         Height          =   255
         Left            =   -70335
         TabIndex        =   17
         Top             =   3660
         Width           =   675
      End
   End
   Begin VB.Line linSep 
      BorderColor     =   &H00FFFFFF&
      Index           =   1
      X1              =   0
      X2              =   9032.129
      Y1              =   4572.785
      Y2              =   4572.785
   End
   Begin VB.Line linSep 
      BorderColor     =   &H00808080&
      Index           =   0
      X1              =   0
      X2              =   9032.129
      Y1              =   4572.785
      Y2              =   4572.785
   End
End
Attribute VB_Name = "frmQuota"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  配款表向导窗体
'  作者：邓强
'  日期：1998.12.26
'
'  引导用户选择列表项目
'  SetQuota          初始化向导(设置钩子), 返回是否选中"完成"按钮(QuotaSet类模块调用)
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                      查询条件变量
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private WithEvents mclsHook As Hook
Attribute mclsHook.VB_VarHelpID = -1
Private mclsFilter As FormCond           '查询条件类
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                      向导变量
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private mclsQuota As QuotaSet                 '列表类
Private mblnMeOK As Boolean                   '是否选中"完成"按钮
Private mblnIsInited(3) As Boolean            'Tab是否已初始化
Private marrFields() As Variant               '字段数组
Private mblnChanged As Boolean                '工资表变化
Private mblnHeadChanged As Boolean            '是否重选表头项目
Private mintDeductList As Integer             '表扣零标准
Private mintDeductField As Integer            '扣零项目扣零标准
Private mlngDeductFieldID As Long             '扣零项目ID
Private mstrSalaryList As String              '工资表
Private mstrQuotaField As String              '配款字段
Private mstrQuotaStandard As String           '配款标准
Private mblnDeductItem As Boolean             '是否为扣零项目配款
Private mblnInited As Boolean                 '是否已初始化窗体
Private mblnFirstOpen As Boolean              '是否第一次打开向导
Private mblnFormShow As Boolean               '窗体是否已显示
Private mbytOldCondShow As Byte               '条件最先显示方式

Private Sub cboCode_Click()
Dim intLoc As Integer
    If mblnFormShow Then
        MeFind LstHeaded.list(LstHeaded.ListIndex), intLoc
        marrFields(intLoc, 12) = cboCode.ListIndex + 1
    End If
End Sub

Private Sub cboQuota_Click()
Dim strTemp As String
    If Not mblnInited Then Exit Sub
    strTemp = cboQuota.Text
    If CLng(GetNoXString(strTemp, 2, Space(100))) = mlngDeductFieldID Then
        mblnDeductItem = True
    Else
        mblnDeductItem = False
    End If
    mblnChanged = True
End Sub

Private Sub cboSalary_Click()
Dim strSql As String
Dim rstData As rdoResultset
    If Not mblnInited Then Exit Sub
    mstrSalaryList = cboSalary.Text
    strSql = "Select ViewField.strViewFieldDesc,ViewField.lngViewFieldID,ViewField.strFieldName  FROM SalaryField,ViewField" _
             & " Where SalaryField.lngViewFieldID = ViewField.lngViewFieldID  " _
             & " And ViewField.lngViewid=63 And SalaryField.lngSalaryListID=" & Val(GetNoXString(mstrSalaryList, 2, Space(100))) _
             & " And Upper(ViewField.strFieldType)='DOUBLE' And ViewField.lngViewFieldID NOT IN (13219,13221,18660)"
    Set rstData = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    cboQuota.Clear
    Do Until rstData.EOF
        cboQuota.AddItem rstData!strViewFieldDesc & Space(100) & rstData!lngViewFieldID & Space(100) & rstData!strFieldName
        rstData.MoveNext
    Loop
    GetDeduct
    mstrQuotaField = cboQuota.list(0)
    cboQuota.Text = mstrQuotaField
    Set rstData = Nothing
    mblnChanged = True
End Sub

Private Sub cboStandard_Click()
    If Not mblnInited Then Exit Sub
'    mstrQuotaStandard = cboStandard.Text
    mblnChanged = True
End Sub

Private Sub cmdArrow_Click(Index As Integer)  '查询项目
    Dim intCount As Integer
    Dim intLoc As Integer
    Dim strSel As String
    Select Case Index
    Case 0
        SendField LstDataField, lstReport, False
        CmdEnabled LstDataField, cmdArrow(0), cmdArrow(1)
        CmdEnabled lstReport, cmdArrow(2), cmdArrow(3)
    Case 1
        SendField LstDataField, lstReport, True
        CmdEnabled LstDataField, cmdArrow(0), cmdArrow(1)
        CmdEnabled lstReport, cmdArrow(2), cmdArrow(3)
    Case 2
        For intCount = 0 To lstReport.ListCount - 1
            If lstReport.Selected(intCount) = True Then
                strSel = lstReport.list(intCount)
                MeFind strSel, intLoc
                If mblnDeductItem Then
                    If marrFields(intLoc, 8) = mintDeductField Or marrFields(intLoc, 10) Then
                        lstReport.Selected(intCount) = False
                    End If
                Else
                    If marrFields(intLoc, 8) = mintDeductList Or marrFields(intLoc, 10) Then
                        lstReport.Selected(intCount) = False
                    End If
                End If
            End If
        Next intCount
        SendField lstReport, LstDataField, False
        CmdEnabled LstDataField, cmdArrow(0), cmdArrow(1)
        CmdEnabled lstReport, cmdArrow(2), cmdArrow(3)
        If lstReport.ListCount = 0 Then
            txtList.Text = ""
            txtList.Enabled = False
            LblList.Enabled = False
        End If
    Case 3
        For intCount = 0 To lstReport.ListCount - 1
            strSel = lstReport.list(intCount)
            MeFind strSel, intLoc
            If mblnDeductItem Then
                If marrFields(intLoc, 8) = mintDeductField Or marrFields(intLoc, 10) Then
                    lstReport.Selected(intCount) = False
                Else
                    lstReport.Selected(intCount) = True
                End If
            Else
                If marrFields(intLoc, 8) = mintDeductList Or marrFields(intLoc, 10) Then
                    lstReport.Selected(intCount) = False
                Else
                    lstReport.Selected(intCount) = True
                End If
            End If
        Next intCount
        SendField lstReport, LstDataField, False
        CmdEnabled LstDataField, cmdArrow(0), cmdArrow(1)
        CmdEnabled lstReport, cmdArrow(2), cmdArrow(3)
        txtList.Text = ""
        txtList.Enabled = False
        LblList.Enabled = False
    End Select
    LstClick lstReport, cmdUpDown(0), cmdUpDown(1)
    IsComplete
End Sub


Private Sub CmdCancel_Click()
    mblnMeOK = False
    Unload Me
End Sub

Private Sub cmdComplete_Click()
Dim blnIsSave As Boolean
    mblnMeOK = True
'    If Not mblnIsInited(2) Then InitQuota 2
    GetQuotaWizard
    Unload Me
End Sub

Private Sub cmdHeadArrow_Click(Index As Integer)
Dim intLoc As Integer
Dim strSel As String
    If Index = 0 Then        '右移表头项目
      If LstHeaded.ListCount >= 9 Then
         Utility.ShowMsg Me.hwnd, "不能再加表头项目了!", vbOKOnly + vbInformation, App.title
         Exit Sub
      End If
      SendField lstHead, LstHeaded, False
      CmdEnabled LstHeaded, cmdHeadArrow(1)
      CmdEnabled lstHead, cmdHeadArrow(0)
    ElseIf Index = 1 Then     '左移表头项目
      If LstHeaded.SelCount = 1 Then
         MeFind LstHeaded.list(LstHeaded.ListIndex), intLoc
         marrFields(intLoc, 12) = 2
      End If
      SendField LstHeaded, lstHead, False
      CmdEnabled LstHeaded, cmdHeadArrow(1)
      CmdEnabled lstHead, cmdHeadArrow(0)
      If LstHeaded.SelCount = 1 Then
            cboCode.Enabled = True
            LblCode.Enabled = True
      Else
            cboCode.Enabled = False
            LblCode.Enabled = False
      End If
    End If
    mblnHeadChanged = True
End Sub

Private Sub cmdHeadUpDown_Click(Index As Integer)
    '上下移动表头项目
    StandardReport.FieldUpdown LstHeaded, Index
End Sub



Private Sub cmdNext_Click()
    sstQuota.Tab = sstQuota.Tab + 1
End Sub

Private Sub cmdPrevious_Click()
    sstQuota.Tab = sstQuota.Tab - 1
End Sub

Private Sub cmdUpDown_Click(Index As Integer)
    StandardReport.FieldUpdown lstReport, Index
    picWizard.SetFocus
End Sub

Private Sub Form_Activate()
    Utility.SetHelpID Me.HelpContextID
End Sub

Private Sub Form_Load()
    Me.HelpContextID = 70017
    tvwFilter.ImageList = frmMain.ImageListFilter
    Set mclsHook = New Hook
    mclsHook.SetHook MsgFilter.hwnd
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set mclsQuota = Nothing
    Set mclsFilter = Nothing
    Set mclsHook = Nothing
    Set Me.Icon = Nothing
    UnloadResPic
End Sub


Private Sub LstDataField_Click()
   CmdEnabled LstDataField, cmdArrow(0), cmdArrow(1)
   If LstDataField.ListIndex <> -1 Then LstDataField.ToolTipText = GetNoXString(LstDataField.list(LstDataField.ListIndex), 1, Space(100))
End Sub

Private Sub LstDataField_DblClick()
    If LstDataField.SelCount <> 1 Then Exit Sub
    cmdArrow_Click 0
End Sub


Private Sub LstDataField_KeyPress(KeyAscii As Integer)
    If KeyAscii <> vbKeySpace Then Exit Sub
    If LstDataField.SelCount <> 1 Then Exit Sub
    cmdArrow_Click 0
End Sub

Private Sub LstHead_Click()
    CmdEnabled lstHead, cmdHeadArrow(0)
End Sub

Private Sub LstHead_DblClick()
    If lstHead.SelCount <> 1 Then Exit Sub
    cmdHeadArrow_Click 0
End Sub

Private Sub LstHead_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeySpace Then Exit Sub
    If lstHead.SelCount <> 1 Then Exit Sub
    cmdHeadArrow_Click 0
End Sub

Private Sub LstHeaded_Click()
Dim intLoc As Integer
    If LstHeaded.SelCount = 1 Then
        MeFind LstHeaded.list(LstHeaded.ListIndex), intLoc
        cboCode.Text = cboCode.list(marrFields(intLoc, 12) - 1)
        cboCode.Enabled = True
        LblCode.Enabled = True
    Else
        cboCode.Enabled = False
        LblCode.Enabled = False
    End If
    CmdEnabled LstHeaded, cmdHeadArrow(1)
    LstClick LstHeaded, cmdHeadUpDown(0), cmdHeadUpDown(1)
End Sub

Private Sub LstHeaded_DblClick()
    If LstHeaded.SelCount <> 1 Then Exit Sub
    cmdHeadArrow_Click 1
End Sub