frmresmanage.frm

来自「金算盘软件代码」· FRM 代码 · 共 1,578 行 · 第 1/5 页

                  Report.ShowStandardReport GetNoXString(lvwDetail.SelectedItem.Key, 2, "-"), GetNoXString(lvwDetail.SelectedItem.Key, 4, "-")
               Case "4"
                  Report.ShowCrossReport GetNoXString(lvwDetail.SelectedItem.Key, 2, "-"), GetNoXString(lvwDetail.SelectedItem.Key, 4, "-")
               Case "5"
                  Report.ShowListReport GetNoXString(lvwDetail.SelectedItem.Key, 2, "-"), GetNoXString(lvwDetail.SelectedItem.Key, 4, "-")
               Case "6"
                  Report.ShowAgeReport GetNoXString(lvwDetail.SelectedItem.Key, 2, "-"), GetNoXString(lvwDetail.SelectedItem.Key, 4, "-")
               Case "7"
                  Report.ShowFinanceReport GetNoXString(lvwDetail.SelectedItem.Key, 2, "-"), GetNoXString(lvwDetail.SelectedItem.Key, 4, "-")
               Case "8"
                  Report.ShowSumReport GetNoXString(lvwDetail.SelectedItem.Key, 2, "-"), GetNoXString(lvwDetail.SelectedItem.Key, 4, "-")
               Case "9"
                  Report.ShowBalance GetNoXString(lvwDetail.SelectedItem.Key, 2, "-"), GetNoXString(lvwDetail.SelectedItem.Key, 4, "-")
               Case "10"
                  Report.ShowQuota GetNoXString(lvwDetail.SelectedItem.Key, 2, "-"), GetNoXString(lvwDetail.SelectedItem.Key, 4, "-")
           End Select
       End If
   End If
   mblnRun = False
ErrHandle:
   mblnRun = False
End Sub

Private Sub lvwDetail_ItemClick(ByVal Item As ComctlLib.ListItem)
   If Not mblnIsLoadPopMenu Then CallPopMenu
   With frmMain
        If Item.SmallIcon = 2 Or Item.Icon = 2 _
           Or Item.SmallIcon = 5 Or Item.Icon = 5 Then
            mbytNowOperate = 2
        Else
            mbytNowOperate = 3
        End If
   End With
   mintOldItem = lvwDetail.SelectedItem.Index
End Sub

Private Sub lvwDetail_KeyDown(KeyCode As Integer, Shift As Integer)
   Select Case KeyCode
      Case vbKeyReturn
         lvwDetail_DblClick
      Case vbKeyDelete
         mclsMainControl_ListEditMenu 6
   End Select
End Sub

Private Sub lvwDetail_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
         If lvwDetail.SelectedItem Is Nothing Then
            If lvwDetail.ListItems.Count > 0 Then
               lvwDetail_ItemClick lvwDetail.ListItems(0)
            Else
               tvwReportType_NodeClick tvwReportType.SelectedItem
            End If
         Else
            If lvwDetail.SelectedItem.Selected = False Then
               lvwDetail_ItemClick lvwDetail.SelectedItem
            End If
         End If
         CallPopMenu
         DealMenuEnabled
         PopupMenu frmMain.mnuListEdit, , lvwDetail.Left + x, lvwDetail.top + y
      End If
   End If
End Sub

Private Sub lvwDetail_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 mclsMainControl_ChildActive()
    Dim msgResponse As Variant
    For Each msgResponse In mclsMainControl.Messages
        If msgResponse = Message.msgReport Then
            mclsMainControl_ToolRefresh
            mclsMainControl.Messages.Remove CStr(msgResponse)  '清除报表改变消息
        End If
    Next
    gclsSys.CurrFormName = Me.hwnd
    mclsMainControl.Messages.Clear
    Report.SetReportTlb
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
  Dim lngReportID As Long
  Dim strInputname As String, strNowParent As String, strUser As String
  Dim blnIsPasted As Boolean
  Dim nodTemp As Node
  Dim strSql As String
'   On Error GoTo ErrHandle
   Select Case intIndex
     'Cut
     Case 0
         mbytClipData = 2
         If mbytNowOperate = 3 Or mbytNowOperate = 2 Then
            If EstimateIsprep(Val(GetNoXString(lvwDetail.SelectedItem.Key, 2, "-"))) Then
                Utility.ShowMsg Me.hwnd, lvwDetail.SelectedItem.Text & "是预置帐表，不能剪切！", vbInformation + vbOKOnly, App.title
                Exit Sub
            End If
            mstrClipCode = lvwDetail.SelectedItem.Key
            mstrClipName = lvwDetail.SelectedItem.Text
            mstrClipParentKey = tvwReportType.SelectedItem.Key
         Else
            '判断是否复制预置报表分组
            lngReportID = GetNoXString(tvwReportType.SelectedItem.Key, 2, "-")
            If PrePrport(lngReportID) Then
               Utility.ShowMsg Me.hwnd, "不能剪切预置报表目录!", vbInformation + vbOKOnly, App.title
               Exit Sub
            End If
            mstrClipCode = tvwReportType.SelectedItem.Key
            mstrClipName = tvwReportType.SelectedItem.Text
            mstrClipParentKey = tvwReportType.SelectedItem.Parent.Key
         End If
         mbytCopyed = mbytNowOperate
        
     'Copy
     Case 1
         mbytClipData = 1
         If mbytNowOperate = 3 Or mbytNowOperate = 2 Then
            mstrClipCode = lvwDetail.SelectedItem.Key
            mstrClipName = lvwDetail.SelectedItem.Text
            mstrClipParentKey = tvwReportType.SelectedItem.Key
         Else
            mstrClipCode = tvwReportType.SelectedItem.Key
            mstrClipName = tvwReportType.SelectedItem.Text
            mstrClipParentKey = tvwReportType.SelectedItem.Parent.Key
         End If
         mbytCopyed = mbytNowOperate
     'Paste
     Case 2
         'ClipBoard Is Null
         If mbytClipData = 0 Then
            Exit Sub
         End If
        
         strNowParent = tvwReportType.SelectedItem.Key
         If strNowParent = mstrClipParentKey Or strNowParent = mstrClipCode Then
           ShowMsg Me.hwnd, "帐表(或帐表分类)不能复制到它自身!", vbQuestion, App.title
           Exit Sub
         End If
         Set nodTemp = tvwReportType.SelectedItem
         Do While mstrClipCode <> nodTemp.Key And (Not nodTemp Is Nothing)
             Set nodTemp = nodTemp.Parent
             If nodTemp Is Nothing Then
                Exit Do
             End If
             If mstrClipCode = nodTemp.Key Then
                ShowMsg Me.hwnd, "帐表分类不能复制到它的下级目录!", vbQuestion, App.title
                Exit Sub
             End If
         Loop
         '判断是否复制向导
         If mbytCopyed = 3 And Val(GetNoXString(mstrClipCode, 5, "-")) = 0 Then
            Utility.ShowMsg Me.hwnd, "不能粘贴向导!", vbQuestion, App.title
            Exit Sub
         End If
         lngReportID = GetNoXString(mstrClipCode, 2, "-")
         '判断是否复制预置报表分组
         If mbytCopyed <> 3 And PrePrport(lngReportID) Then
            Utility.ShowMsg Me.hwnd, "不能粘贴预置报表目录!", vbQuestion, App.title
            Exit Sub
         End If
         blnIsPasted = ReportPaste
         If Not blnIsPasted Then
              mblnAlreadyPop = False
              Exit Sub
         End If
         If mbytClipData = 2 Then
              mbytClipData = 0
         End If
         mstrOldParent = ""
         InitType
         tvwReportType.Nodes(mintOldNode).Selected = True
         tvwReportType_NodeClick tvwReportType.Nodes(tvwReportType.SelectedItem.Key)
     'Rename ReportName
     Case 4
         If mbytNowOperate = 1 Then
            tvwReportType.LabelEdit = lvwManual
            tvwReportType.StartLabelEdit
         Else
            lvwDetail.LabelEdit = lvwManual
            lvwDetail.StartLabelEdit
         End If
     'Group:New Detail:Show
     Case 5
         If mbytNowOperate = 3 Then
                lvwDetail_DblClick
         Else
            If frmReportSameName.ShowInputBox("请输入新增帐表分组名称：", strInputname, "新增帐表分组", True, 40) Then
                If StrLen(strInputname) <> 0 Then
                   If mbytNowOperate = 2 Then
                      Set tvwReportType.SelectedItem = tvwReportType.Nodes(lvwDetail.SelectedItem.Key)
                      tvwReportType.SetFocus
                   End If
                   Newreport strInputname
                End If
            End If
         End If
         
     'Del
     Case 6
         If mblnRun Then
            Exit Sub
         End If

         If mbytNowOperate = 3 Or mbytNowOperate = 2 Then
            strUser = Trim(lvwDetail.SelectedItem.SubItems(1))
            If strUser <> gclsBase.OperatorName Then
                ShowMsg Me.hwnd, "不能删除他人制作的报表!", vbInformation + vbOKOnly, App.title
                Exit Sub
            End If
            If EstimateIsprep(Val(GetNoXString(lvwDetail.SelectedItem.Key, 2, "-"))) Then
                Utility.ShowMsg Me.hwnd, "“" & lvwDetail.SelectedItem.Text & "”" & "是预置帐表，不能删除！", vbInformation + vbOKOnly, App.title
            Else
                If Utility.ShowMsg(Me.hwnd, "你确认要删除帐表“" & lvwDetail.SelectedItem.Text & "”吗?", vbQuestion + vbOKCancel, App.title) = vbCancel Then
                   Exit Sub
                End If
                DelReport GetNoXString(lvwDetail.SelectedItem.Key, 2, "-")
                If mbytNowOperate = 3 Then
                   lvwDetail.ListItems.Remove (lvwDetail.SelectedItem.Key)
                Else
                   tvwReportType.Nodes.Remove (lvwDetail.SelectedItem.Key)
                   lvwDetail.ListItems.Remove (lvwDetail.SelectedItem.Key)
                End If
            End If
             
         Else
            If EstimateIsprep(Val(GetNoXString(tvwReportType.SelectedItem.Key, 2, "-"))) Then
               Utility.ShowMsg Me.hwnd, "“" & tvwReportType.SelectedItem.Text & "”" & "是预置帐表，不能删除！", vbInformation + vbOKOnly, App.title
            Else
                If Utility.ShowMsg(Me.hwnd, "你确认要删除帐表分类“" & tvwReportType.SelectedItem.Text & "”吗?", vbOKCancel, App.title) = vbCancel Then
                   Exit Sub
                End If
                DelReport GetNoXString(tvwReportType.SelectedItem.Key, 2, "-")
                lngReportID = GetNoXString(tvwReportType.SelectedItem.Parent.Key, 2, "-")
                tvwReportType.Nodes.Remove (tvwReportType.SelectedItem.Key)
                            
                InitList (lngReportID), GetNoXString(tvwReportType.SelectedItem.Key, 3, "-")
            End If
            
         End If
         mstrOldParent = ""
     'Print
     Case 8
         '帐册
         Report.ShowAcntBook GetNoXString(lvwDetail.SelectedItem.Key, 2, "-"), GetNoXString(lvwDetail.SelectedItem.Key, 4, "-"), , , , , , True
    '恢复缺省设置
    Case 10
        lngReportID = GetNoXString(tvwReportType.SelectedItem.Key, 2, "-")
        strSql = "Update Report set lngPrintSetupID = 0 Where lngReportID = " & lngReportID
        gclsBase.BaseDB.Execute strSql
     'ShowType
     Case 12, 13, 14, 15
        frmMain.mnuListEditMenu(12).Checked = False
        frmMain.mnuListEditMenu(13).Checked = False
        frmMain.mnuListEditMenu(14).Checked = False
        frmMain.mnuListEditMenu(15).Checked = False
        frmMain.mnuListEditMenu(intIndex).Checked = True
        lvwDetail.View = intIndex - 12
   End Select
   
   mblnAlreadyPop = False
   Exit Sub
ErrHandle:
    ShowMsg Me.hwnd, Err.Description, vbOKOnly, App.title
   mclsMainControl_ToolRefresh
End Sub

'判断当前所选是否为预置帐表
Private Function EstimateIsprep(ByVal lngReportID As Long) As Boolean
  Dim strSql As String
  Dim recEstimate As rdoResultset
  
  strSql = "select * from report where lngReportId=" & lngReportID
  Set recEstimate = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
  If recEstimate!bytPrep = 1 Or recEstimate!bytPrep = 0 Then
     EstimateIsprep = True
  Else
     EstimateIsprep = False
  End If
End Function

'粘贴帐表或帐表分组
Private Function ReportPaste() As Boolean
  Dim lngParentId As Long, lngID As Long, lngViewId As Long
  Dim intLevel As Integer, intCancel As Integer, intGroup As Integer
  Dim strName As String, strSql As String
  Dim blnIsFinded As Boolean
  Dim bytPrep As Byte
  
    If mbytNowOperate = 2 Then
         lngParentId = GetNoXString(lvwDetail.SelectedItem.Key, 2, "-")
         intLevel = Val(GetNoXString(lvwDetail.SelectedItem.Key, 1, "-"))
         intGroup = Val(GetNoXString(lvwDetail.SelectedItem.Key, 3, "-"))
         bytPrep = Val(GetNoXString(lvwDetail.SelectedItem.Key, 4, "-"))
    Else
         lngParentId = GetNoXString(tvwReportType.SelectedItem.Key, 2, "-")
         intLevel = Val(GetNoXString(tvwReportType.SelectedItem.Key, 1, "-"))
         intGroup = Val(GetNoXString(tvwReportType.SelectedItem.Key, 3, "-"))
         bytPrep = Val(GetNoXString(tvwReportType.SelectedItem.Key, 4, "-"))
    End If
    bytPrep = 2
    lngID = GetNoXString(mstrClipCode, 2, "-")
    strName = mstrClipName
    '处理同一目录下报表同名的情况
    blnIsFinded = Report.ReportExist(strName, lngParentId, lngID)
    Do While blnIsFinded