frmbanreportset.frm

金算盘软件代码

   With lstChoosed
      If .ListIndex + 1 = mclsReportSet.FixColumns Then
          If .ListIndex > 0 Then
              cmdSerial(0).Enabled = True
          Else
              cmdSerial(0).Enabled = False
          End If
          cmdSerial(1).Enabled = False
      End If
      If .ListIndex + 1 < mclsReportSet.FixColumns Then
          If .ListIndex > 0 Then
              cmdSerial(0).Enabled = True
          Else
              cmdSerial(0).Enabled = False
          End If
          cmdSerial(1).Enabled = True
      End If
      If .ListIndex + 1 > mclsReportSet.FixColumns Then
          If .ListIndex > mclsReportSet.FixColumns Then
             cmdSerial(0).Enabled = True
          Else
             cmdSerial(0).Enabled = False
          End If
          If .ListIndex < .ListCount - 1 Then
              cmdSerial(1).Enabled = True
          Else
              cmdSerial(1).Enabled = False
          End If
      End If
      If .ListIndex = -1 Then
          cmdSerial(0).Enabled = False
          cmdSerial(1).Enabled = False
      End If
   End With
End Sub

Private Sub RefreshButton()
   If mclsReportSet.PaperID <> 0 Then
      Exit Sub
   End If
   If lstBeChoose.ListCount = 0 Then
      cmdRightAll.Enabled = False
   Else
      cmdRightAll.Enabled = True
   End If
   If lstBeChoose.ListIndex = -1 Then
      cmdRightOne.Enabled = False
   Else
      cmdRightOne.Enabled = True
   End If

   If lstChoosed.ListCount = 0 Then
      cmdLeftAll.Enabled = False
   Else
      cmdLeftAll.Enabled = True
   End If
   If lstChoosed.ListIndex = -1 Then
      cmdLeftOne.Enabled = False
   Else
      cmdLeftOne.Enabled = True
   End If
End Sub

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

    With lstChoosed
        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
End Sub

Private Sub Form_Activate()
    SetUnEnabled SSTab1.Tab
    Utility.SetHelpID 70002
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
       Unload Me
    End If
End Sub

Private Sub Form_Load()
    Me.HelpContextID = 70002
    Utility.LoadFormResPicture Me
    Set tvwFilter.ImageList = frmMain.ImageListFilter
    
    Set mclsHook = New Hook
    mclsHook.SetHook MsgFilter.hwnd
    
    mintIndex = 0
    mlngStepNum = 1
    CmdPrev.Enabled = False
    cmdOk.Enabled = False
    SSTab1.Tab = 0
    mintMaxStep = 4
    SSTab1.Tab = 0
    mblnChanged = False
    With cmbCond
       .Clear
       .AddItem "不显示"
       .AddItem "表头显示"
       .AddItem "表尾显示"
    End With
End Sub

Public Function SetReport(clsReportSet As banreport, clsFormCond As FormCond, Optional HeadChange As Boolean = False) As Boolean
    mblnLoaded = False
    mblnOk = False
    mblnHeadChange = False
    lstChoosed.Clear
    lstBeChoose.Clear
    
    Set mclsReportSet = clsReportSet
    If clsFormCond Is Nothing Then
      Set clsFormCond = New FormCond
    End If
    Set mclsFilterCond = clsFormCond
    
    If mclsReportSet.Prep = 0 And mclsReportSet.ReportName = "" Then
       txtName = "未定义"
       Me.Caption = "报表设置"
    Else
       txtName = mclsReportSet.ReportName
       Me.Caption = Trim(txtName) & "设置"
    End If
    If mclsReportSet.ViewId = 636 Or mclsReportSet.ViewId = 632 Or mclsReportSet.ViewId = 680 Then
        chkQuantity.Visible = True
        If (mclsReportSet.ColType And 1) <> 0 Then
           chkQuantity.Value = 1
        Else
           chkQuantity.Value = 0
        End If
    Else
        chkQuantity.Visible = False
    End If
    
    If mclsReportSet.ViewId = 636 Or mclsReportSet.ViewId = 662 Then
       chkOnlyData.Visible = True
       cmbOnlyData.Visible = True
    Else
       chkOnlyData.Visible = False
       cmbOnlyData.Visible = False
    End If
    
    AddPaperInfo
    
    ReGetChoosed
    GetMayChoose
    ReGetHeadChoosed
    GetHeadMayChoose
    cmbCond.ListIndex = mclsReportSet.CondShow
    mclsFilterCond.ShowFilter Me, mclsReportSet.ReportID, 2, 255, , "日期"
    Screen.MousePointer = vbDefault
    mblnLoaded = True
    cmbShowCode.Enabled = False
    lblShowCode.Enabled = False
    Me.Show vbModal
    SetReport = mblnOk
    HeadChange = mblnHeadChange
End Function

Private Sub Form_Unload(Cancel As Integer)
    Set mclsHook = Nothing
    Utility.UnLoadFormResPicture Me
    Set Me.Icon = Nothing
End Sub

Private Sub mclsHook_OnMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, bCancel As Long)
  If Msg = WM_KEYUP Then
      If wParam = vbKeyUp Or wParam = vbKeyDown Then
          MsgFilter_click
      End If
  End If
End Sub

Private Sub lstBeChoose_DblClick()
   cmdRightOne_Click
End Sub

Private Sub lstBeChoose_GotFocus()
   RefreshButton
   RefreshUpDown
End Sub

Private Sub lstChoosed_Click()
   RefreshButton
   RefreshUpDown
End Sub

Private Sub LstChoosed_DblClick()
   cmdLeftOne_Click
End Sub

Private Sub lstChoosed_GotFocus()
   RefreshButton
   RefreshUpDown
End Sub

Private Sub lstChoosed2_LostFocus()
   If Not Me.ActiveControl Is cmbShowCode Then
      cmbShowCode.Enabled = False
      lblShowCode.Enabled = False
   End If
End Sub

Private Sub ReferText1_KeyPress(KeyAscii As Integer)
   mclsFilterCond.ReferText1_KeyPress Me, KeyAscii
End Sub

Private Sub ReferText2_KeyPress(KeyAscii As Integer)
   mclsFilterCond.ReferText2_KeyPress Me, KeyAscii
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
   If Not mblnLoaded Then
       Exit Sub
   End If
   SetUnEnabled SSTab1.Tab
   mlngStepNum = SSTab1.Tab + 1
   ComEnabled
   If SSTab1.Tab = SSTab1.Tabs - 1 Then
      lstBeChoose2.SetFocus
      If lstBeChoose2.ListCount > 0 Then
         lstBeChoose2.ListIndex = 0
      End If
   End If
   RefreshButton
   RefreshUpDown
End Sub

Private Sub SetUnEnabled(ByVal intTab As Integer)
   Select Case intTab
     Case 0
        txtName.Enabled = True
        
        Frame1.Enabled = False
        Frame6.Enabled = False
        Frame2.Enabled = False
        
        Frame4.Enabled = False
        
        Frame7.Enabled = False
     Case 1
        txtName.Enabled = False
        
        Frame1.Enabled = True
        Frame6.Enabled = True
        Frame2.Enabled = True
        
        Frame4.Enabled = False
        
        Frame7.Enabled = False
     Case 2
        txtName.Enabled = False
        
        Frame1.Enabled = False
        Frame6.Enabled = False
        Frame2.Enabled = False
        
        Frame4.Enabled = True
        
        Frame7.Enabled = False
     Case 3
        txtName.Enabled = False
        
        Frame1.Enabled = False
        Frame6.Enabled = False
        Frame2.Enabled = False
        
        Frame4.Enabled = False
        
        Frame7.Enabled = True
   End Select
End Sub

'取可选栏目
Private Sub GetMayChoose()
   Dim rstMayChoose As rdoResultset
   Dim strSql As String
   Dim strChoosed As String, strCondVersion As String
   Dim intCount As Integer
   Dim lngColType As Long
   
   strCondVersion = " And Mod(ViewField.bytVersion," & gVersionType * 2 & ")>=" & gVersionType
   
   For intCount = 1 To mclsReportSet.Columns
       If strChoosed = "" Then
            strChoosed = "'" & mclsReportSet.ColumnDesc(intCount) & "'"
       Else
            strChoosed = strChoosed & ",'" & mclsReportSet.ColumnDesc(intCount) & "'"
       End If
   Next intCount
   lstBeChoose.Clear
   
   strSql = "Select * from ViewField,ReportField " & _
            "Where ViewField.lngViewFieldID=ReportField.lngViewFieldID" & _
            " And blnIsChoose=1 And bytHead<>1 And lngReportID=" & mclsReportSet.ReportID & _
            " And (Not ReportField.strReportFieldDesc IN (" & strChoosed & "))" & strCondVersion
   Set rstMayChoose = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)

   With rstMayChoose
       Do While Not .EOF
            lstBeChoose.AddItem !strReportFieldDesc & Space(100) & !strFieldName & "`" & _
                            Utility.GetDisplayWidth(!strReportFieldDesc, !bytFieldSize) & "`" & 0 & "`" & !blnIsFixed & "`" & _
                            .rdoColumns("lngViewFieldID") & "`" & !strFieldType & "`" & !bytFieldSize & "`" & _
                            False & "`" & !strCombine & "`" & 0 & "`" & _
                            0 & "`" & !strTableName & "`" & !blnIsMust & "`" & !strGroup
            .MoveNext
       Loop
   End With
   Select Case mclsReportSet.ViewId
   Case 636, 662
      lngColType = mclsReportSet.ColType
      If (lngColType And 8) = 0 Then
          lstBeChoose.AddItem "期初余额"
      End If
      If (lngColType And 16) = 0 Then
          lstBeChoose.AddItem "本期借方发生"
      End If
      If (lngColType And 128) = 0 Then
          lstBeChoose.AddItem "本期贷方发生"
      End If
      If (lngColType And 32) = 0 Then
          lstBeChoose.AddItem "借方累计发生"
      End If
      If (lngColType And 256) = 0 Then
          lstBeChoose.AddItem "贷方累计发生"
      End If
      If (lngColType And 64) = 0 Then
          lstBeChoose.AddItem "期末余额"
      End If
   Case 632, 680
      lngColType = mclsReportSet.ColType
      If (lngColType And 16) = 0 Then
          lstBeChoose.AddItem "本期借方发生"
      End If
      If (lngColType And 128) = 0 Then
          lstBeChoose.AddItem "本期贷方发生"
      End If
      If (lngColType And 32) = 0 Then
          lstBeChoose.AddItem "借方累计发生"
      End If
      If (lngColType And 256) = 0 Then
          lstBeChoose.AddItem "贷方累计发生"
      End If
   Case 638
      lngColType = mclsReportSet.ColType
      If (lngColType And 8) = 0 Then
          lstBeChoose.AddItem "期初应收余额"
      End If
      If (lngColType And 16) = 0 Then
          lstBeChoose.AddItem "本期应收"
      End If
      If (lngColType And 128) = 0 Then
          lstBeChoose.AddItem "本期已收"
      End If
      If (lngColType And 64) = 0 Then
          lstBeChoose.AddItem "期末应收余额"
      End If
   Case 639
      lngColType = mclsReportSet.ColType
      If (lngColType And 8) = 0 Then
          lstBeChoose.AddItem "期初应付余额"
      End If