frmresmanage.frm

金算盘软件代码

       If Utility.ShowMsg(Me.hwnd, "帐表“" & strName & "”已存在,是否另存?", vbOKCancel, App.title) = vbCancel Then
           ReportPaste = False
           Exit Function
       End If
       If Not frmReportSameName.ShowInputBox("帐表名称", strName, "另存为", True) Then
            ReportPaste = False
            Exit Function
       End If
       blnIsFinded = Report.ReportExist(strName, lngParentId, lngID)
    Loop
    If mbytClipData = 2 Then
       '改变父节点ID(Cut-Paste)
       strSql = " Update Report Set lngOperatorID=" & gclsBase.OperatorID & ",lngParentID=" & lngParentId & ",bytGroup=" & intGroup & _
                ",intLevel=" & intLevel + 1 & _
                " Where lngReportID=" & lngID
       gclsBase.BaseDB.Execute strSql
    Else
       WriteToReport lngID, lngParentId, intLevel, strName, intGroup, bytPrep
    End If
    ReportPaste = True
End Function

'重命名时,更新 Report 表的strReportName
Private Sub WriteReportName(ByVal ReportID As Long, ByVal NewName As String)
  Dim strSql As String
     strSql = "UPDATE Report Set strReportName='" & NewName & "' WHERE lngReportId=" & ReportID
     gclsBase.ExecSQL strSql
End Sub

'粘贴时,更新 Report 表
Private Sub WriteToReport(ByVal CopyId As Long, ByVal ParentId As Long, ByVal ParentLevel As Integer, _
                          ByVal NewName As String, ByVal Group As Byte, Optional ByVal Prep As Byte = 2)
  Dim strSql As String
  Dim rstSource As rdoResultset, rstDesc As rdoResultset
  Dim fldReportField As rdoColumn
  Dim lngReportID As Long
  Dim rstTemp As rdoResultset
  Dim clsFormat As ClsFormatset
  
     strSql = "Select * from Report Where lngReportId=" & CopyId
     Set rstSource = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
     
     strSql = "Select * from Report Where lngReportId=-1"
     Set rstDesc = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, 4)
     
     With rstSource
            rstDesc.AddNew
                For Each fldReportField In .rdoColumns
                    Select Case UCase(fldReportField.Name)
                        Case UCase("strReportName")
                               rstDesc!strReportName = NewName
                        Case UCase("lngParentID")
                               rstDesc!lngParentId = ParentId
                        Case UCase("intLevel")
                               rstDesc!intLevel = ParentLevel + 1
                        Case UCase("lngOperatorID")
                               rstDesc!lngOperatorID = gclsBase.OperatorID
                        Case UCase("bytPrep")
                               rstDesc!bytPrep = Prep
                        Case UCase("bytGroup")
                               rstDesc!bytGroup = Group
                        Case UCase("lngReportID")
                               rstDesc!lngReportID = GetNewID("Report")
                        Case UCase("lngPrintSetupID")
                               Set clsFormat = New ClsFormatset
                               rstDesc!lngPrintSetupID = StandardReport.GetPrintSetupID(rstSource!bytWizard, rstSource!lngReportID)
                        Case Else
                             rstDesc.rdoColumns(fldReportField.Name).Value = fldReportField.Value
                    End Select
                Next
                lngReportID = rstDesc!lngReportID
            rstDesc.Update
     End With
        
     WriteToReportField lngReportID, CopyId
     
     rstSource.Close
     rstDesc.Close
     
     strSql = "Select * From Report Where lngParentId=" & CopyId
     Set rstTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
     With rstTemp
         Do While Not .EOF
             WriteToReport !lngReportID, lngReportID, ParentLevel + 1, !strReportName, Group
             .MoveNext
         Loop
         rstTemp.Close
     End With
End Sub

'粘贴时,更新 ReportField 表
Private Sub WriteToReportField(ByVal lngReportID As Long, ByVal ParentId As Long)
  Dim strSql As String
  Dim rstSource As rdoResultset, rstDesc As rdoResultset
  Dim fldReportField As rdoColumn
     
     strSql = "Select * from ReportField Where lngReportId=" & ParentId
     Set rstSource = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
     
     strSql = "Select * from ReportField Where lngReportId=" & lngReportID
     Set rstDesc = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, 4)
     
     With rstSource
         Do While Not .EOF
            rstDesc.AddNew
            For Each fldReportField In .rdoColumns
                If UCase(fldReportField.Name) = UCase("lngReportId") Then
                    rstDesc!lngReportID = lngReportID
                Else
                     If UCase(fldReportField.Name) <> UCase("lngReportFieldId") Then
                         rstDesc.rdoColumns(fldReportField.Name).Value = fldReportField.Value
                     Else
                         rstDesc.rdoColumns(fldReportField.Name).Value = GetNewID("ReportField")
                     End If
                End If
            Next
            rstDesc.Update
            .MoveNext
         Loop
     End With
     CopyFinanceReport ParentId, lngReportID
     Report.CopyAgeReport ParentId, lngReportID
     Report.CopyReportCond ParentId, lngReportID
     Report.CopyReportHeadTail ParentId, lngReportID
     CopyMultiColumn lngReportID, ParentId
End Sub

'粘贴时,更新 ReportMultiColumn 表
Private Sub CopyMultiColumn(ByVal lngReportID As Long, ByVal ParentId As Long)
  Dim strSql As String
  Dim rstSource As rdoResultset, rstDesc As rdoResultset
  Dim fldReportField As rdoColumn
     
     strSql = "Select * from ReportMultiColumn Where lngReportId=" & ParentId
     Set rstSource = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
     
     strSql = "Select * from ReportMultiColumn Where lngReportId=" & lngReportID
     Set rstDesc = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, 4)
     
     With rstSource
         Do While Not .EOF
            rstDesc.AddNew
            For Each fldReportField In .rdoColumns
                If UCase(fldReportField.Name) = UCase("lngReportId") Then
                    rstDesc!lngReportID = lngReportID
                Else
                    If UCase(fldReportField.Name) <> UCase("lngReportMultiID") Then
                         rstDesc.rdoColumns(fldReportField.Name).Value = fldReportField.Value
                    Else
                         rstDesc.rdoColumns(fldReportField.Name).Value = GetNewID("ReportMultiColumn")
                    End If
                End If
            Next
            rstDesc.Update
            .MoveNext
         Loop
     End With
End Sub

'新增帐表
Private Sub Newreport(ByVal strReportnewName As String)
    Dim lngParentId As Long, intLevel As Integer, lngViewId As Long
    Dim lngReportID As Long
    Dim recSource, recDesc As rdoResultset
    Dim strSql As String
    Dim fldparentfield As rdoColumn
    Dim ndNew As Node
    Dim blnIsFinded As Boolean
    
    lngParentId = GetNoXString(tvwReportType.SelectedItem.Key, 2, "-")
    intLevel = GetNoXString(tvwReportType.SelectedItem.Key, 1, "-")
    lngViewId = GetNoXString(tvwReportType.SelectedItem.Key, 3, "-")
    
    strSql = "select * from report where lngReportId=" & lngParentId
    Set recSource = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    blnIsFinded = Report.ReportExist(strReportnewName, lngParentId, -1)
    If blnIsFinded Then
        ShowMsg Me.hwnd, "报表目录“" & strReportnewName & "”已经存在！", vbOKOnly + vbExclamation, App.title
        Exit Sub
    End If
    
    strSql = "select * from report where lngReportId=-1"
    Set recDesc = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, 4)
    
    With recSource
        recDesc.AddNew
        For Each fldparentfield In .rdoColumns
             Select Case UCase(fldparentfield.Name)
                    Case UCase("intlevel")
                       recDesc!intLevel = intLevel + 1
                    Case UCase("lngparentId")
                       recDesc!lngParentId = lngParentId
                    Case UCase("strReportName")
                       recDesc!strReportName = strReportnewName
                    Case UCase("lngOperatorId")
                       recDesc!lngOperatorID = gclsBase.OperatorID
                    Case UCase("bytprep")
                       recDesc!bytPrep = 2
                    Case UCase("lngReportId")
                    '自动增加
                        recDesc!lngReportID = GetNewID("report")
                    Case Else
                       recDesc.rdoColumns(fldparentfield.Name).Value = fldparentfield.Value
            End Select
        Next
        lngReportID = recDesc!lngReportID
        recDesc.Update
    End With
    
    Set ndNew = tvwReportType.Nodes.Add(intLevel & "-" & lngParentId & "-" & lngViewId, tvwChild, _
       intLevel + 1 & "-" & lngReportID & "-" & lngViewId, strReportnewName, 4, 5)
    ndNew.Parent.Selected = True
    mintOldNode = tvwReportType.SelectedItem.Index
    mstrOldParent = ""
    InitList Val(lngParentId), CByte(lngViewId)
End Sub

Private Sub mclsMainControl_ToolRefresh()
   If Not tvwReportType.SelectedItem Is Nothing Then
      mstrOldParent = ""
      tvwReportType_NodeClick tvwReportType.SelectedItem
   End If
End Sub
Private Sub picSep_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
   Me.MousePointer = vbSizeWE
   If Button = 1 Then
        picMove.Visible = True
        picMove.Move picSep.Left + x, lvwDetail.top, picSep.width, lvwDetail.Height
        picMove.ZOrder
   End If
End Sub

Private Sub picSep_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   If Button = 1 Then
        picMove.Visible = False
        If tvwReportType.width + x > 0 And lvwDetail.width - x > 0 And picGroup.width + x > 0 Then
            picSep.Move picSep.Left + x, lvwDetail.top, picSep.width, lvwDetail.Height
            tvwReportType.width = tvwReportType.width + x
            picGroup.width = picGroup.width + x
            lvwDetail.width = lvwDetail.width - x
            picReport.width = picReport.width - x
            picReport.Left = picReport.Left + x
            lvwDetail.Left = lvwDetail.Left + x
        End If
   End If
End Sub

Private Sub tvwReportType_AfterLabelEdit(Cancel As Integer, NewString As String)
Dim lngReportID As Long, lngParentId As Long
Dim intLevel As Integer
Dim blnIsFinded As Boolean
Dim strErr As String
     
     If IsNull(NewString) Then Exit Sub
     
     If Report.NameIsErr(NewString, strErr) Then
        Utility.ShowMsg Me.hwnd, "报表目录名称包含非法字符“" & strErr & "”!", vbOKOnly + vbExclamation, App.title
        Cancel = True
        Exit Sub
     End If
     intLevel = Val(GetNoXString(tvwReportType.SelectedItem.Key, 1, "-"))
     lngReportID = GetNoXString(tvwReportType.SelectedItem.Key, 2, "-")
     lngParentId = GetNoXString(tvwReportType.SelectedItem.Parent.Key, 2, "-")
     
     If NewString = "" Then
        Utility.ShowMsg Me.hwnd, "报表目录名称不能为空!", vbOKOnly + vbExclamation, App.title
        Cancel = True
     ElseIf StrLen(NewString) > 40 Then
        Utility.ShowMsg Me.hwnd, "报表目录名称太长!", vbOKOnly + vbExclamation, App.title
        Cancel = True
     Else
        blnIsFinded = Report.ReportExist(NewString, lngParentId, lngReportID)
        If blnIsFinded Then
            Utility.ShowMsg Me.hwnd, "报表目录“" & NewString & "”已经存在!", vbOKOnly + vbExclamation, App.title
            Cancel = True
        Else
            WriteReportName lngReportID, NewString
        End If
     End If
     tvwReportType.LabelEdit = lvwManual
End Sub

Private Sub tvwReportType_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyDelete Then
       mclsMainControl_ListEditMenu 6
   End If
End Sub

Private Sub tvwReportType_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
   If Not frmMain.ActiveForm Is Me Then
     Exit Sub
   End If
   If Not mblnIsLoadPopMenu Then
        CallPopMenu
        Exit Sub
   End If
   If mbytNowOperate = 1 Then
      If Button = vbRightButton Then
         DealMenuEnabled
         PopupMenu frmMain.mnuListEdit, , tvwReportType.Left + x, tvwReportType.top + y
      End If
   End If
End Sub

Private Sub tvwReportType_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 0 Then
        Me.MousePointer = vbDefault
    End If
End Sub

Private Sub tvwReportType_NodeClick(ByVal Node As ComctlLib.Node)
  Dim strID As String
   If Not mblnIsLoadPopMenu Then CallPopMenu
   mintOldNode = tvwReportType.SelectedItem.Index
   strID = GetNoXString(Node.Key, 2, "-")
   InitList Val(strID), GetNoXString(Node.Key, 3, "-")