frmreporthead.frm

金算盘软件代码

          ReDim arrHeadField(UBound(marrHeadField))
          ReDim arrHeadFieldName(UBound(marrHeadField))
          ReDim arrHeadTop(UBound(marrHeadField))
          ReDim arrHeadLeft(UBound(marrHeadField))
          ReDim arrHeadHeight(UBound(marrHeadField))
          ReDim arrHeadWidth(UBound(marrHeadField))
          For intCount = 1 To UBound(arrHeadField)
                arrHeadField(intCount) = marrHeadField(intCount)
                arrHeadFieldName(intCount) = marrHeadFieldName(intCount)
                arrHeadTop(intCount) = marrHeadTop(intCount)
                arrHeadLeft(intCount) = marrHeadLeft(intCount)
                arrHeadHeight(intCount) = marrHeadHeight(intCount)
                arrHeadWidth(intCount) = marrHeadWidth(intCount)
          Next intCount
          SetHead = True
      End If
End Function

Private Function IdInArr(ID As Long, arr As Variant) As Boolean
  Dim intCount As Integer
    On Error GoTo ErrHandle
    If IsNull(ID) Then
         Exit Function
    End If
    For intCount = 1 To UBound(arr)
         If ID = CDbl(arr(intCount)) Then
            IdInArr = True
            Exit Function
         End If
    Next intCount
ErrHandle:
End Function

Private Sub cmdCancel_Click()
   Unload Me
End Sub

Private Sub cmdOK_Click()
   Dim intCount As Integer
   
'   If (lstChoosed2.ListCount = 1 And Trim(GetNoXString(lstChoosed2.list(0), 1, "/")) = "日期") _
'     Or (lstChoosed2.ListCount = 2 And (Trim(GetNoXString(lstChoosed2.list(0), 1, "/")) = "币种" Or Trim(GetNoXString(lstChoosed2.list(1), 1, "/")) = "币种")) Then
'      ShowMsg Me.hwnd, "请至少选择一个核算项目!", vbOKOnly + vbInformation, App.title
'      Exit Sub
'   End If
   
   mblnOk = True
   With lstChoosed2
       ReDim marrHeadField(.ListCount)
       ReDim marrHeadFieldName(.ListCount)
       ReDim marrHeadTop(.ListCount)
       ReDim marrHeadLeft(.ListCount)
       ReDim marrHeadHeight(.ListCount)
       ReDim marrHeadWidth(.ListCount)
       For intCount = 1 To .ListCount
           .ListIndex = intCount - 1
           marrHeadField(intCount) = GetNoXString(.Text, 2, "/")
           marrHeadFieldName(intCount) = Trim(GetNoXString(.Text, 1, "/"))
           marrHeadTop(intCount) = GetNoXString(.Text, 4, "/")
           marrHeadLeft(intCount) = GetNoXString(.Text, 5, "/")
           marrHeadHeight(intCount) = GetNoXString(.Text, 6, "/")
           marrHeadWidth(intCount) = GetNoXString(.Text, 7, "/")
       Next intCount
   End With
   Unload Me
End Sub

Private Sub cmdLeftAll2_Click()
    Dim i As Integer
    Dim intCount As Integer
    Dim intIndex As Integer

    With lstChoosed2
        intCount = .ListCount - 1
        intIndex = 0
        For i = 0 To intCount
            If Val(GetNoXString(.list(intIndex), 3, "/")) <> 1 Then
                lstBeChoose2.AddItem .list(intIndex)
                .RemoveItem intIndex
            Else
                intIndex = intIndex + 1
            End If
        Next
        On Error Resume Next
        .ListIndex = 0
        lstBeChoose2.ListIndex = 0
    End With
    RefreshButton2
    RefreshUpDown2
End Sub

Private Sub cmdLeftOne2_Click()
    Dim Index As Integer
    Dim blnValid As Boolean

    With lstChoosed2
        Index = .ListIndex
        If Val(GetNoXString(.Text, 3, "/")) <> 1 Then
            lstBeChoose2.AddItem .Text
            lstBeChoose2.Text = .Text
            .RemoveItem Index
        Else
            MsgBox "“" & Trim(GetNoXString(.Text, 1, "/")) & "”是必选表头栏目!", vbOKOnly, Me.Caption
        End If

        If .ListCount > 0 Then
            .ListIndex = IIf(Index < .ListCount, Index, .ListCount - 1)
        End If
    End With
    RefreshButton2
    RefreshUpDown2
End Sub

Private Sub cmdRightAll2_Click()
    Dim i As Integer
    Dim Count As Integer

    With lstBeChoose2
        Count = .ListCount
        For i = 0 To Count - 1
            lstChoosed2.AddItem .list(0)
            .RemoveItem 0
        Next
        lstChoosed2.ListIndex = 0
    End With
    RefreshButton2
    RefreshUpDown2
End Sub

Private Sub cmdRightOne2_Click()
    Dim Index As Integer

    With lstBeChoose2
        Index = .ListIndex
        lstChoosed2.AddItem .Text
        lstChoosed2.Text = .Text
        .RemoveItem Index
        If .ListCount > 0 Then
            .ListIndex = IIf(Index < .ListCount, Index, .ListCount - 1)
        End If
    End With
    RefreshButton2
    RefreshUpDown2
End Sub

Private Sub cmdRightOne_Click()

End Sub

Private Sub cmdSerial2_Click(Index As Integer)
    Dim strTemp As String

    With lstChoosed2
        Select Case Index
            Case 0
                strTemp = .list(.ListIndex)
                .list(.ListIndex) = .list(.ListIndex - 1)
                .list(.ListIndex - 1) = strTemp
                .ListIndex = .ListIndex - 1
            Case 1
                strTemp = .list(.ListIndex)
                .list(.ListIndex) = .list(.ListIndex + 1)
                .list(.ListIndex + 1) = strTemp
                .ListIndex = .ListIndex + 1
        End Select
    End With
    RefreshUpDown2
End Sub

Private Sub RefreshButton2()
   If lstBeChoose2.ListCount = 0 Then
      cmdRightAll2.Enabled = False
   Else
      cmdRightAll2.Enabled = True
   End If
   If lstBeChoose2.ListIndex = -1 Then
      cmdRightOne2.Enabled = False
   Else
      cmdRightOne2.Enabled = True
   End If

   If lstChoosed2.ListCount = 0 Then
      cmdLeftAll2.Enabled = False
   Else
      cmdLeftAll2.Enabled = True
   End If
   If lstChoosed2.ListIndex = -1 Then
      cmdLeftOne2.Enabled = False
   Else
      cmdLeftOne2.Enabled = True
   End If
End Sub

Private Sub RefreshUpDown2()
   With lstChoosed2
       If .ListIndex > 0 Then
          cmdSerial2(0).Enabled = True
       Else
          cmdSerial2(0).Enabled = False
       End If
       If .ListIndex < .ListCount - 1 And .ListIndex <> -1 Then
          cmdSerial2(1).Enabled = True
       Else
          cmdSerial2(1).Enabled = False
       End If
   End With
End Sub

Private Sub cmdSerial_Click(Index As Integer)

End Sub

Private Sub Form_Activate()
   lstBeChoose2.SetFocus
End Sub

Private Sub Form_Load()
   SetHelpID Me.hwnd, 10002
   Set cmdOk.Picture = GetFormResPicture(1001, 0)
   Set cmdCancel.Picture = GetFormResPicture(1002, 0)
   Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
End Sub

Private Sub Form_Unload(Cancel As Integer)
   RemoveFormResPicture 1001
   RemoveFormResPicture 1002
   Set Me.Icon = Nothing
End Sub

Private Sub lstBeChoose2_Click()
   RefreshButton2
   RefreshUpDown2
End Sub

Private Sub lstBeChoose2_DblClick()
   cmdRightOne2_Click
End Sub

Private Sub lstBeChoose2_GotFocus()
   RefreshButton2
   RefreshUpDown2
End Sub

Private Sub lstChoosed2_Click()
   RefreshButton2
   RefreshUpDown2
End Sub

Private Sub lstChoosed2_DblClick()
   cmdLeftOne2_Click
End Sub

Private Sub lstChoosed2_GotFocus()
   RefreshButton2
   RefreshUpDown2
End Sub