frmcustomerfield.frm

金算盘软件代码

    Select Case mbytChoose
    Case 1          '加入可选项目
         LstTail.AddItem LstDefine.list(LstDefine.ListIndex)
    Case 2           '加入自定义项目
         LstTail.AddItem txtAdd.Text & Space(100) & "0"
    End Select
End Sub

Private Sub cmdAffirm_Click()
Dim intCount As Integer, intLoc As Integer, intHead As Integer
Dim strIndex As String, strTemp As String
Dim strColumn As String
    mblnOk = True
    
    '把已选表尾项目传给报表类
    mclsHeadTail.TailColumns = LstTail.ListCount
    intCount = 0
    Do While intCount < LstTail.ListCount
        strIndex = LstTail.list(intCount)
        strColumn = StringOut(strIndex, Space(100))
        mclsHeadTail.TailFuncIndex(intCount) = CInt(strIndex)
        mclsHeadTail.TailDesc(intCount) = strColumn
        mclsHeadTail.TailHeight(intCount) = 15 * Screen.TwipsPerPixelY
        mclsHeadTail.TailWidth(intCount) = 200 * Screen.TwipsPerPixelY
        mclsHeadTail.TailLeft(intCount) = 100
        mclsHeadTail.TailTop(intCount) = 100
        mclsHeadTail.TailAlign(intCount) = intCount
        intCount = intCount + 1
    Loop
'    '把已选列表框项目传给报表类
    intCount = 0
    If mblnChoose Then
        mclsHeadTail.ListColumns = lstChoosed.ListCount
        For intCount = 0 To lstChoosed.ListCount - 1
            strTemp = lstChoosed.list(intCount)
            MeFind strTemp, intLoc
            mclsHeadTail.ColumnListLoc(intCount) = intLoc
            If intCount < 3 Then
                mclsHeadTail.ColumnAlign(intLoc) = intCount
            Else
                mclsHeadTail.ColumnAlign(intLoc) = intCount + 2
            End If
            mclsHeadTail.ColumnHeight(intLoc) = 15 * Screen.TwipsPerPixelY
            mclsHeadTail.ColumnWidth(intLoc) = 200 * Screen.TwipsPerPixelY
            mclsHeadTail.ColumnTop(intLoc) = 100
            mclsHeadTail.ColumnLeft(intLoc) = 100
        Next intCount
    End If
    '把已选表头项目传给报表类
    mclsHeadTail.HeadColumns = LstHead.ListCount
    Do While intHead < LstHead.ListCount
        strIndex = LstHead.list(intHead)
        strColumn = StringOut(strIndex, Space(100))
        mclsHeadTail.HeadFuncIndex(intHead) = CInt(strIndex)
        mclsHeadTail.HeadDesc(intHead) = strColumn
        mclsHeadTail.HeadHeight(intHead) = 15 * Screen.TwipsPerPixelY
        mclsHeadTail.HeadWidth(intHead) = 200 * Screen.TwipsPerPixelY
        mclsHeadTail.HeadLeft(intHead) = 100
        mclsHeadTail.HeadTop(intHead) = 100
        If intCount + lstChoosed.ListCount < 3 Then
            mclsHeadTail.HeadAlign(intHead) = intCount
        Else
            mclsHeadTail.HeadAlign(intHead) = intCount + 2
        End If
        intHead = intHead + 1
        intCount = intCount + 1
    Loop
    Unload Me
End Sub

Private Sub cmdArrow_Click(Index As Integer)
Dim intCount As Integer, intLoc As Integer
Dim strTemp As String, strSel As String
    If Index = 0 Then       '右移项目
      
      If lstChoosed.ListCount = 9 Then
        Utility.ShowMsg Me.hwnd, "请原谅,不能再加表头项目了!", vbOKOnly, App.title
        Exit Sub
      End If
      strTemp = LstChoose.list(LstChoose.ListIndex)
      MeFind strTemp, intLoc
      marr(intLoc) = 6
      SendField LstChoose, lstChoosed, False
      CmdEnabled lstChoosed, cmdArrow(1)
      CmdEnabled LstChoose, cmdArrow(0)
    ElseIf Index = 1 Then    '左移项目
      strTemp = lstChoosed.list(lstChoosed.ListIndex)
      MeFind strTemp, intLoc
      If mclsHeadTail.ColumnFieldHead(intLoc) = 1 Then
            Utility.ShowMsg Me.hwnd, "请原谅,固定项目不能删除!", vbOKOnly, App.title
            Exit Sub
      End If
      marr(intLoc) = 0
      SendField lstChoosed, LstChoose, False
      CmdEnabled lstChoosed, cmdArrow(1)
      CmdEnabled LstChoose, cmdArrow(0)
    End If
End Sub

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

Private Sub cmdDelHead_Click()
Dim strFlag As String
Dim strText As String
    If LstHead.ListIndex <> -1 Then
    '删除表头项目
       strFlag = LstHead.list(LstHead.ListIndex)
       strText = StringOut(strFlag, Space(100))
       If strFlag = "0" Then
            txtAdd.Text = strText
            LstHead.RemoveItem LstHead.ListIndex
       Else
            LstHead.RemoveItem LstHead.ListIndex
       End If
    End If
    '判断按钮可用性
    If LstHead.ListCount > 0 Then
        LstHead.Selected(0) = True
    Else
        cmdDelHead.Enabled = False
    End If
End Sub

Private Sub cmdDelTail_Click()
Dim strFlag As String
Dim strText As String
    If LstTail.ListIndex <> -1 Then
    '删除表尾项目
       strFlag = LstTail.list(LstTail.ListIndex)
       strText = StringOut(strFlag, Space(100))
       If strFlag = "0" Then
            txtAdd.Text = strText
            LstTail.RemoveItem LstTail.ListIndex
       Else
            LstTail.RemoveItem LstTail.ListIndex
       End If
    End If
    '判断按钮可用性
    If LstTail.ListCount > 0 Then
        LstTail.Selected(0) = True
    Else
        cmdDelTail.Enabled = False
    End If
End Sub


Private Sub Form_Load()
    SetHelpID Me.hwnd, 10018
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    '释放资源
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Set Me.Icon = Nothing
End Sub

Private Sub LstChoose_Click()
    CmdEnabled LstChoose, cmdArrow(0)
End Sub

Private Sub LstChoose_DblClick()
    '左移项目
    cmdArrow_Click 0
End Sub

Private Sub LstChoose_KeyPress(KeyAscii As Integer)
    '左移项目
    If KeyAscii = vbKeySpace Then
        cmdArrow_Click 0
    End If
End Sub

Private Sub lstChoosed_Click()
    CmdEnabled lstChoosed, cmdArrow(1)
End Sub

Private Sub LstChoosed_DblClick()
    '右移项目
    cmdArrow_Click 1
End Sub

Private Sub LstChoosed_KeyPress(KeyAscii As Integer)
    '右移项目
    If KeyAscii = vbKeySpace Then
        cmdArrow_Click 1
    End If
End Sub

Private Sub lstDefine_Click()
    mbytChoose = 1          '添加项目源
    '判断按钮可用性
    If LstDefine.SelCount <> 1 Then
        cmdAddHead.Enabled = False
        cmdAddTail.Enabled = False
    Else
        If LstHead.ListCount < 10 Then cmdAddHead.Enabled = True
        If LstTail.ListCount < 10 Then cmdAddTail.Enabled = True
    End If
End Sub


Private Sub LstDefine_GotFocus()
    If LstDefine.ListIndex = -1 And LstDefine.ListCount > 0 Then LstDefine.Selected(0) = True
    lstDefine_Click
End Sub

Private Sub lstHead_Click()
    '判断按钮可用性
    If LstHead.SelCount <> 1 Then
        cmdDelHead.Enabled = False
    Else
        cmdDelHead.Enabled = True
    End If
    If LstHead.ListCount = 10 Then
        cmdAddHead.Enabled = False
    End If
End Sub

Private Sub LstHead_GotFocus()
    If LstHead.ListIndex = -1 And LstHead.ListCount > 0 Then LstHead.Selected(0) = True
End Sub

Private Sub lstTail_Click()
    '判断按钮可用性
    If LstTail.SelCount <> 1 Then
        cmdDelTail.Enabled = False
    Else
        cmdDelTail.Enabled = True
    End If
    If LstTail.ListCount = 3 Then
        cmdAddTail.Enabled = False
    End If
End Sub

Private Sub LstTail_GotFocus()
    If LstTail.ListIndex = -1 And LstTail.ListCount > 0 Then LstTail.Selected(0) = True
End Sub

Private Sub txtAdd_Change()
    mbytChoose = 2              '添加项目源
    '判断按钮可用性
    If strLen(txtAdd.Text) > 40 Or Trim(txtAdd.Text) = "" Then
        cmdAddHead.Enabled = False
        cmdAddTail.Enabled = False
    Else
        If LstHead.ListCount < 10 Then cmdAddHead.Enabled = True
        If LstTail.ListCount < 10 Then cmdAddTail.Enabled = True
    End If
End Sub

Private Sub txtAdd_GotFocus()
Dim intCount As Integer
    mbytChoose = 2
    '清除可选项目列表框的已选项
    intCount = 0
    Do While intCount < LstDefine.ListCount
        LstDefine.Selected(intCount) = False
        intCount = intCount + 1
    Loop
    '判断增加按钮的有效性
    txtAdd_Change
End Sub

''''''''''''''''''''''''''''''''''
'       私有过程
''''''''''''''''''''''''''''''''''
'初始化已选项目
Private Sub InitHeadTail()
Dim intCount As Integer
Dim intChoose As Integer
Dim blnIsFinded As Boolean
Dim strList As String
    LstDefine.Clear
    LstHead.Clear
    LstTail.Clear
    '初始化可选项目列表框
    LstDefine.AddItem "查询日期" & Space(100) & "1"
    LstDefine.AddItem "打印日期" & Space(100) & "2"
    LstDefine.AddItem "单位名称" & Space(100) & "3"
    LstDefine.AddItem "制表" & Space(100) & "4"
    LstDefine.AddItem "页码" & Space(100) & "5"
    '加表头已选项目
    intCount = 0
    Do While intCount < mclsHeadTail.HeadColumns
        blnIsFinded = False
        For intChoose = 0 To LstDefine.ListCount - 1
            strList = LstDefine.list(intChoose)
            If StringOut(strList, Space(100)) = mclsHeadTail.HeadDesc(intCount) Then
                blnIsFinded = True
                Exit For
            End If
        Next
        If blnIsFinded Then
            LstHead.AddItem mclsHeadTail.HeadDesc(intCount) & Space(100) & mclsHeadTail.HeadFuncIndex(intCount)
        Else
            LstHead.AddItem mclsHeadTail.HeadDesc(intCount) & Space(100) & "0"
        End If
        intCount = intCount + 1
    Loop
    '加表尾已选项目
    intCount = 0
    Do While intCount < mclsHeadTail.TailColumns
        blnIsFinded = False
        For intChoose = 0 To LstDefine.ListCount - 1
            strList = LstDefine.list(intChoose)
            If StringOut(strList, Space(100)) = mclsHeadTail.TailDesc(intCount) Then
                blnIsFinded = True
                Exit For
            End If
        Next
        If blnIsFinded Then
            LstTail.AddItem mclsHeadTail.TailDesc(intCount) & Space(100) & mclsHeadTail.TailFuncIndex(intCount)
        Else
            LstTail.AddItem mclsHeadTail.TailDesc(intCount) & Space(100) & "0"
        End If
        intCount = intCount + 1
    Loop
End Sub
'在指定字符串里寻找数字
Private Sub MeFind(strSel As String, intLoc As Integer)
    Dim str As String
    str = StringOut(strSel, Space(100))
    str = StringOut(strSel, Space(100))
    str = IIf(Trim(str) = "", "0", Trim(str))
    intLoc = CInt(str)            '为"0"一般表示没找到
End Sub