frmcross.frm

金算盘软件代码

Private Sub cmdHeadTail_Click()
Dim frmHeadTail As New frmCustomerField
    '调用表头表尾窗体，设置项目
    frmHeadTail.SetHeadTail mclsCross
    Set frmHeadTail = Nothing
End Sub

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

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

Private Sub cmdRow_Click(Index As Integer)
    '移动行项目
    StandardReport.FieldUpdown LstRow, Index
End Sub

Private Sub Form_Load()
    '调用帮助
    SetHelpID Me.hwnd, 70013
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    '释放资源
    Set mclsCross = Nothing
    Set mclsFilter = Nothing
    Set mclsHook = Nothing
    Set Me.Icon = Nothing
    UnloadResPic
End Sub

Private Sub LstCol_Click()
    If mblnIsDrag Then Exit Sub
    If LstCol.ListIndex <> -1 Then LstCol.ToolTipText = GetNoXString(LstCol.list(LstCol.ListIndex), 1, Space(100))
    '设置拖动源
    mOldLstNO = 2
    '删除按钮是否可用
    If LstCol.SelCount = 0 Then
       cmdDelete.Enabled = False
    Else
       cmdDelete.Enabled = True
    End If
    '上下移动按钮是否可用
    LstClick LstCol, cmdCol(0), cmdCol(1)
End Sub

Private Sub LstCol_DblClick()
    '删除列项目
    If LstCol.SelCount = 1 Then cmdDelete_Click
End Sub

Private Sub LstCol_DragDrop(Source As Control, x As Single, y As Single)
Dim intInsert As Integer, intDelLoc As Integer
    mblnIsDrag = False               '拖动完成
    If LstCol.ListCount > 3 Then Exit Sub
    intInsert = LstCol.ListIndex     '插入列索引
    
    Select Case mDragSource          '拖动源
    Case 4                           '已选项目列表
         If intInsert = -1 Then
           intInsert = LstCol.ListCount
         Else
           LstCol.Selected(intInsert) = False
         End If
         intDelLoc = LstField.ListIndex
         LstCol.AddItem LstField.list(LstField.ListIndex), intInsert
         LstCol.Selected(LstCol.NewIndex) = True
         LstField.RemoveItem LstField.ListIndex
         '判断按钮可用性
         If intDelLoc < LstField.ListCount Then
           LstField.Selected(intDelLoc) = True
         ElseIf LstField.ListCount > 0 Then
           LstField.Selected(LstField.ListCount - 1) = True
         End If
         LstField_Click
    End Select
    '是否可完成
    IsComplete
End Sub

Private Sub LstCol_DragOver(Source As Control, x As Single, y As Single, State As Integer)
Dim intLoc As Integer, intCount As Integer
    If mDragSource <> 4 Then Source.MousePointer = 12: Exit Sub
    If State = 1 Then Source.MousePointer = 12      '进入
    If State = 0 Then Source.MousePointer = 0       '离去
    intLoc = (y + 150) \ 200
    For intCount = 0 To LstCol.ListCount - 1
          LstCol.Selected(intCount) = False
    Next intCount
    If intLoc < LstCol.ListCount Then
       LstCol.Selected(intLoc) = True
    End If
End Sub

Private Sub LstCol_KeyPress(KeyAscii As Integer)
    '空格键：删除选中列
    If KeyAscii <> vbKeySpace Then Exit Sub
    If LstCol.SelCount = 1 Then cmdDelete_Click
End Sub

Private Sub LstCol_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    mDragSource = 2           '设置拖动源
    LblDrag.Move LstCol.Left, LstCol.top + y - mlngDragHeight \ 2, mlngDragWidth, mlngDragHeight
    LblDrag.Drag
    mblnIsDrag = True         '开始拖动
End Sub

Private Sub LstData_Click()
    If mblnIsDrag Then Exit Sub
    If LstData.ListIndex <> -1 Then LstData.ToolTipText = GetNoXString(LstData.list(LstData.ListIndex), 1, Space(100))
    mOldLstNO = 3             '选中列表标志
    '删除按钮是否可删除
    If LstData.SelCount = 0 Then
       cmdDelete.Enabled = False
    Else
       cmdDelete.Enabled = True
    End If
End Sub

Private Sub LstData_DblClick()
    '双击删除数据项目
    If LstData.SelCount = 1 Then cmdDelete_Click
End Sub

Private Sub LstData_DragDrop(Source As Control, x As Single, y As Single)
    mblnIsDrag = False
    Select Case mDragSource
    Case 4           '拖动源为已选项目列表，加入数据项目
         cmdAddData_Click
    End Select
    '是否可完成
    IsComplete
End Sub

Private Sub LstData_DragOver(Source As Control, x As Single, y As Single, State As Integer)
Dim intLoc As Integer, intCount As Integer
    If mDragSource <> 4 Then Source.MousePointer = 12: Exit Sub
    If State = 1 Then Source.MousePointer = 12      '进入
    If State = 0 Then Source.MousePointer = 0       '离去
    '判断选中列
    intLoc = (y + 150) \ 200
    For intCount = 0 To LstData.ListCount - 1
          LstData.Selected(intCount) = False
    Next intCount
    If intLoc < LstData.ListCount Then
       LstData.Selected(intLoc) = True
    End If
End Sub

Private Sub LstData_KeyPress(KeyAscii As Integer)
    '空格键：删除选中列
    If KeyAscii <> vbKeySpace Then Exit Sub
    If LstData.SelCount = 1 Then cmdDelete_Click
End Sub

Private Sub LstData_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    mDragSource = 3                '拖动源
    LblDrag.Move LstData.Left, LstData.top + y - mlngDragHeight \ 2, mlngDragWidth, mlngDragHeight
    LblDrag.Drag
    mblnIsDrag = True              '开始拖动
End Sub

Private Sub LstDataField_Click()
    If LstDataField.ListIndex <> -1 Then LstDataField.ToolTipText = GetNoXString(LstDataField.list(LstDataField.ListIndex), 1, Space(100))
    '数据浏览是否可用
    If LstDataField.SelCount = 1 Then
       cmdBrowse(0).Enabled = True
   Else
       cmdBrowse(0).Enabled = False
   End If
   '移动按钮是否可用
   CmdEnabled LstDataField, cmdArrow(0), cmdArrow(1)
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 LstField_Click()
    
    If mblnIsDrag Then Exit Sub
    If LstField.ListIndex <> -1 Then LstField.ToolTipText = GetNoXString(LstField.list(LstField.ListIndex), 1, Space(100))
    '按钮是否可用
    If LstField.SelCount = 0 Then
       cmdAddRow.Enabled = False
       cmdAddCol.Enabled = False
       cmdAddData.Enabled = False
       cmdBrowse(1).Enabled = False
    Else
       cmdAddRow.Enabled = True
       cmdAddCol.Enabled = True
       cmdAddData.Enabled = True
       cmdBrowse(1).Enabled = True
    End If
End Sub
'拖动项目到已选项目列表
Private Sub LstField_DragDrop(Source As Control, x As Single, y As Single)
Dim intInsert As Integer, intDelLoc As Integer
    mblnIsDrag = False           '拖动完成
    intInsert = LstField.ListIndex
    If intInsert = -1 Then
       intInsert = LstField.ListCount
    Else
       LstField.Selected(intInsert) = False
    End If
    Select Case mDragSource         '拖动源
    Case 1                          '行项目列表
       intDelLoc = LstRow.ListIndex
       LstField.AddItem LstRow.list(LstRow.ListIndex), intInsert
       LstRow.RemoveItem LstRow.ListIndex
       If intDelLoc < LstRow.ListCount Then
          LstRow.Selected(intDelLoc) = True
       ElseIf LstRow.ListCount > 0 Then
          LstRow.Selected(LstRow.ListCount - 1) = True
       Else
          cmdDelete.Enabled = False
       End If
    Case 2                          '列项目列表
       intDelLoc = LstCol.ListIndex
       LstField.AddItem LstCol.list(LstCol.ListIndex), intInsert
       LstCol.RemoveItem LstCol.ListIndex
       If intDelLoc < LstCol.ListCount Then
          LstCol.Selected(intDelLoc) = True
       ElseIf LstCol.ListCount > 0 Then
          LstCol.Selected(LstCol.ListCount - 1) = True
       Else
          cmdDelete.Enabled = False
       End If
    Case 3                          '数据项目列表
       intDelLoc = LstRow.ListIndex
       LstField.AddItem LstData.list(LstData.ListIndex), intInsert
       LstData.Clear
       cmdDelete.Enabled = False
    Case 4                          '已选项目列表，改变选中项目
       If intInsert < LstField.ListCount Then LstField.Selected(intInsert) = True
       Exit Sub
    End Select
    LstField.Selected(LstField.NewIndex) = True
    '是否可完成
    IsComplete
End Sub

Private Sub LstField_DragOver(Source As Control, x As Single, y As Single, State As Integer)
Dim intLoc As Integer, intCount As Integer
    If mDragSource = 4 Then Source.MousePointer = 12: Exit Sub
    If State = 1 Then Source.MousePointer = 12      '进入
    If State = 0 Then Source.MousePointer = 0       '离去
    intLoc = (y + 150) \ 200
    '判断插入列位置,设置选中项目
    For intCount = 0 To LstField.ListCount - 1
          LstField.Selected(intCount) = False
    Next intCount
    If intLoc < LstField.ListCount Then
       LstField.Selected(intLoc) = True
    End If
End Sub

Private Sub LstField_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    mDragSource = 4               '拖动源
    LblDrag.Move LstField.Left, LstField.top + y - mlngDragHeight \ 2, mlngDragWidth, mlngDragHeight
    LblDrag.Drag
    mblnIsDrag = True             '开始拖动
End Sub

Private Sub LstReport_Click()
    Dim intLoc As Integer
    Dim strSel As String
    If LstReport.ListIndex <> -1 Then LstReport.ToolTipText = GetNoXString(LstReport.list(LstReport.ListIndex), 1, Space(100))
    '判断按钮可用性
    If LstReport.SelCount <> 1 Then
     txtList.Text = ""
     txtList.Enabled = False
     LblList.Enabled = False
    Else
     txtList.Enabled = True
     LblList.Enabled = True
     strSel = LstReport.list(LstReport.ListIndex)
     txtList.Text = StringOut(strSel, Space(100))
    End If
    CmdEnabled LstReport, cmdArrow(2), cmdArrow(3)
End Sub

Private Sub LstReport_DblClick()
    '双击左移选中项目
    cmdArrow_Click 2
End Sub

Private Sub LstReport_KeyPress(KeyAscii As Integer)
    '回车键：左移选中项目
    If KeyAscii <> vbKeySpace Then Exit Sub
    cmdArrow_Click 2
End Sub

Private Sub LstRow_Click()
    If mblnIsDrag Then Exit Sub
    If LstRow.ListIndex <> -1 Then LstRow.ToolTipText = GetNoXString(LstRow.list(LstRow.ListIndex), 1, Space(100))
    mOldLstNO = 1                  '列表选中标志
    '判断按钮可用性
    If LstRow.SelCount = 0 Then
       cmdDelete.Enabled = False
    Else
       cmdDelete.Enabled = True
    End If
    LstClick LstRow, cmdRow(0), cmdRow(1)
End Sub

Private Sub LstRow_DblClick()
    '双击删除选中行项目
    If LstRow.SelCount = 1 Then cmdDelete_Click
End Sub
'拖动项目到行列表
Private Sub LstRow_DragDrop(Source As Control, x As Single, y As Single)
Dim intInsert As Integer, intDelLoc As Integer
    mblnIsDrag = False
    If LstRow.ListCount > 3 Then Exit Sub
    intInsert = LstRow.ListIndex
    
    Select Case mDragSource
    Case 4                     '源列表为已选项目列表
         If intInsert = -1 Then
           intInsert = LstRow.ListCount
         Else
           LstRow.Selected(intInsert) = False
         End If
         intDelLoc = LstField.ListIndex
         LstRow.AddItem LstField.list(LstField.ListIndex), intInsert
         LstRow.Selected(LstRow.NewIndex) = True
         LstField.RemoveItem LstField.ListIndex
         '设置选中项目
         If intDelLoc < LstField.ListCount Then
           LstField.Selected(intDelLoc) = True
         ElseIf LstField.ListCount > 0 Then
           LstField.Selected(LstField.ListCount - 1) = True
         End If
         LstField_Click
    End Select
    '是否可完成
    IsComplete
End Sub

Private Sub LstRow_DragOver(Source As Control, x As Single, y As Single, State As Integer)
Dim intLoc As Integer, intCount As Integer
    If mDragSource <> 4 Then Source.MousePointer = 12: Exit Sub
    If State = 1 Then Source.MousePointer = 12      '进入
    If State = 0 Then Source.MousePointer = 0       '离去
    intLoc = (y + 150) \ 200
    '判断插入列位置
    For intCount = 0 To LstRow.ListCount - 1
          LstRow.Selected(intCount) = False
    Next intCount
    If intLoc < LstRow.ListCount Then