frmacntbookwizard.frm

金算盘软件代码

         If GetNoXString(.list(0), 1, Space(40)) = "年" Then
           cmdSerial(0).Enabled = False
         End If
      End If
      If .ListIndex = 2 Then
         If GetNoXString(.list(2), 1, Space(40)) = "日" Or GetNoXString(.list(2), 1, Space(40)) = "月" Then
           cmdSerial(1).Enabled = False
         End If
      End If
      If .ListIndex = 3 Then
         If GetNoXString(.list(2), 1, Space(40)) = "日" Or GetNoXString(.list(2), 1, Space(40)) = "月" Then
           cmdSerial(0).Enabled = False
         End If
      End If
   End With
End Sub

Private Sub RefreshButton()
   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
   If chkOnlyData.Value = 1 Then
      cmdLeftAll.Enabled = False
      cmdRightAll.Enabled = False
   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 10225
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 = 10225
    Utility.LoadFormResPicture Me
    Set tvwFilter.ImageList = frmMain.ImageListFilter
    
    Set mclsHook = New Hook
    mclsHook.SetHook MsgFilter.hwnd
    
    mintIndex = 0
    InitType
    mlngStepNum = 1
    CmdPrev.Enabled = False
    cmdOk.Enabled = False
    SSTab1.Tab = 0
    mintMaxStep = 4
    SSTab1.Tab = 0
    mblnChanged = False
End Sub

Private Sub AddPaperInfo()
  Dim strSql As String
  Dim rstPaper As rdoResultset
  
    strSql = "Select lngPaperID,strPaperCode,strPaperName From ReportPaper Where bytType=1"
    Set rstPaper = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    cmbOnlyData.ClearRefer
    Set cmbOnlyData.Recordset = rstPaper
    
    If mclsReportSet.ViewId <> 5 Then
      cmbOnlyData.Visible = False
      chkOnlyData.Visible = False
    Else
      cmbOnlyData.Visible = True
      chkOnlyData.Visible = True
    End If

    If mclsReportSet.OnlyData Then
       chkOnlyData.Value = 1
       cmbOnlyData.Visible = True
       cmbOnlyData.SeekId mclsReportSet.PaperID
    Else
       chkOnlyData.Value = 0
       cmbOnlyData.Visible = False
    End If

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

Public Function SetReport(clsReportSet As ReportSet, clsFormCond As FormCond, Optional HeadChange As Boolean = False) As Boolean
    mblnLoaded = False
    lstChoosed.Clear
    lstBeChoose.Clear
    mblnHeadChange = False
    
    Set mclsReportSet = clsReportSet
    If clsFormCond Is Nothing Then
      Set clsFormCond = New FormCond
      clsFormCond.InitCondArr clsReportSet.ReportID, clsReportSet.ViewId, 2, 255, "日期"
    End If
    Set mclsFilter = clsFormCond
    
    cmbType.ListIndex = mclsReportSet.ReportType - 1
    
    If mclsReportSet.Prep = 0 And mclsReportSet.ReportName = "三栏式帐册向导" Then
       txtName.Text = "未定义"
    Else
       txtName.Text = mclsReportSet.ReportName
    End If
    
    AddPaperInfo
    
    ReGetChoosed
    GetMayChoose
    ReGetHeadChoosed
    GetHeadMayChoose
    GetAccountInfo
    InitDirect
    mclsFilter.ShowFilter Me, mclsReportSet.ReportID, 2, 255, , "日期"
    Screen.MousePointer = vbDefault
    cmbShowCode.Enabled = False
    lblShowCode.Enabled = False
    mblnLoaded = True
    Me.Show vbModal
    SetReport = mblnOk
    HeadChange = mblnHeadChange
End Function

Private Function GetAccountInfo() As Boolean
  Dim intCount As Integer
     
     mblnVirtual = True
     For intCount = 1 To mclsReportSet.HeadFields
         If Trim(mclsReportSet.HeadFieldName(intCount)) = "科目" Then
            mblnVirtual = False
            Exit Function
         End If
     Next intCount
End Function

Private Sub InitDirect()
    Select Case mclsReportSet.Direct
       Case 1
          cmbDirect.ListIndex = 1
       Case -1
          cmbDirect.ListIndex = 2
       Case 0
          cmbDirect.ListIndex = 3
       Case 4
          cmbDirect.ListIndex = 0
    End Select
    If mclsReportSet.ViewId = 2 Or mclsReportSet.ViewId = 4 Or mclsReportSet.ViewId = 359 Or mclsReportSet.ViewId = 360 Then
        cmbDirect.Locked = True
    Else
        cmbDirect.Locked = False
    End If
    If mclsReportSet.ViewId = 5 Or mclsReportSet.ViewId = 2 Or mclsReportSet.ViewId = 4 Or mclsReportSet.ViewId = 359 Or mclsReportSet.ViewId = 360 Then
        cmbDirect.Visible = True
        lblDirect.Visible = True
    Else
        cmbDirect.Visible = False
        lblDirect.Visible = False
    End If
End Sub

'初始化帐册类型下拉列表
Private Sub InitType()
    With cmbType
        .AddItem "日记帐"
        .AddItem "明细帐"
        .AddItem "总帐"
        .ListIndex = 0
    End With
End Sub

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

Private Sub lstBeChoose_DblClick()
   cmdRightOne_Click
End Sub

Private Sub lstBeChoose_GotFocus()
   RefreshButton
   RefreshUpDown
End Sub

Private Sub lstChoosed_Click()
   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)
   mclsFilter.ReferText1_KeyPress Me, KeyAscii
End Sub

Private Sub ReferText2_KeyPress(KeyAscii As Integer)
   mclsFilter.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
        cmbType.Enabled = True
        txtName.Enabled = True
        
        Frame1.Enabled = False
        Frame6.Enabled = False
        Frame2.Enabled = False
        
        Frame4.Enabled = False
        
        Frame7.Enabled = False
     Case 1
        cmbType.Enabled = False
        txtName.Enabled = False
        
        Frame1.Enabled = True
        Frame6.Enabled = True
        Frame2.Enabled = True
        
        Frame4.Enabled = False
        
        Frame7.Enabled = False
     Case 2
        cmbType.Enabled = False
        txtName.Enabled = False
        
        Frame1.Enabled = False
        Frame6.Enabled = False
        Frame2.Enabled = False
        
        Frame4.Enabled = True
        
        Frame7.Enabled = False
     Case 3
        cmbType.Enabled = False
        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 lngWidth 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 & _
            " Order By intShowNO"
   Set rstMayChoose = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)

   With rstMayChoose
       Do While Not .EOF
            If !lngDisplayWidth = 0 Or IsNull(!lngDisplayWidth) Then
                lngWidth = Utility.GetDisplayWidth(!strViewFieldDesc, !bytFieldSize)
            Else
                lngWidth = !lngDisplayWidth
            End If
            lstBeChoose.AddItem !strReportFieldDesc & Space(40) & !strFieldName & "`" & _
                            lngWidth & "`" & 0 & "`" & !blnIsFixed & "`" & _
                            .rdoColumns("lngViewFieldID") & "`" & !strFieldType & "`" & !bytFieldSize & "`" & _
                            False & "`" & !strCombine & "`" & 0 & "`" & _
                            0 & "`" & !strTableName & "`" & !blnIsMust & "`" & !bytFormula & "`" & !bytFormat
            .MoveNext
       Loop
   End With
End Sub

'通过类的属性取已选栏目
Private Sub ReGetChoosed()
  Dim intCount As Integer
  Dim strAdd As String
   With mclsReportSet
      For intCount = 1 To .Columns
         strAdd = .ColumnDesc(intCount) & Space(40) & .ColumnFieldName(intCount) & "`" & .ColumnWidth(intCount) & _
                  "`" & .ColumnOrderType(intCount) & "`" & .ColumnIsFix(intCount) & "`" & .ColumnFieldID(intCount) & _
                  "`" & .ColumnFieldType(intCount) & "`" & .ColumnFieldSize(intCount) & "`" & False & "`" & _
                  .ColumnCombine(intCount) & "`" & 0 & "`" & 0 & "`" & " " & "`" & .ColumnIsMust(intCount) & "`" & _
                  .ColumnFomular(intCount) & "`" & .ColumnFormat(intCount)
         lstChoosed.AddItem strAdd
      Next intCount