budgetcopy.frm

金算盘软件代码

VERSION 5.00
Object = "{9C4B12C2-D5CE-11D1-9ABC-444553540000}#1.0#0"; "GACEDIT.DLL"
Begin VB.Form frmBudgetCopy 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "复制历史预算"
   ClientHeight    =   2205
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4785
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2205
   ScaleWidth      =   4785
   StartUpPosition =   1  '所有者中心
   Begin GATLCTRLLibCtl.CalEdit calBudget 
      Height          =   300
      Left            =   1680
      OleObjectBlob   =   "BudgetCopy.frx":0000
      TabIndex        =   5
      Top             =   1500
      Width           =   1500
   End
   Begin VB.ComboBox cboBudget 
      Height          =   300
      Index           =   1
      Left            =   1680
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   960
      Width           =   1500
   End
   Begin VB.ComboBox cboBudget 
      Height          =   300
      Index           =   0
      Left            =   1680
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   420
      Width           =   1500
   End
   Begin VB.CommandButton cmdBudget 
      Height          =   345
      Index           =   0
      Left            =   3480
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   180
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdBudget 
      Height          =   345
      Index           =   1
      Left            =   3480
      Style           =   1  'Graphical
      TabIndex        =   7
      Top             =   600
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.Label lblBudget 
      Caption         =   "复制选项"
      Height          =   225
      Index           =   4
      Left            =   240
      TabIndex        =   9
      Top             =   120
      Width           =   720
   End
   Begin VB.Label lblBudget 
      Caption         =   "%"
      Height          =   225
      Index           =   3
      Left            =   3210
      TabIndex        =   8
      Top             =   1560
      Width           =   90
   End
   Begin VB.Label lblBudget 
      Caption         =   "按比例复制(&S)"
      Height          =   225
      Index           =   2
      Left            =   240
      TabIndex        =   4
      Top             =   1560
      Width           =   1335
   End
   Begin VB.Label lblBudget 
      Caption         =   "复制预算年度(&Y)"
      Height          =   225
      Index           =   1
      Left            =   240
      TabIndex        =   2
      Top             =   1020
      Width           =   1455
   End
   Begin VB.Label lblBudget 
      Caption         =   "复制历史预算(&B)"
      Height          =   225
      Index           =   0
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   1455
   End
End
Attribute VB_Name = "frmBudgetCopy"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mintYear As Integer
Private mlngBudgetID As Long
Private mblnBudget(11) As Boolean
Private mintFlag As Integer

'显示
Public Sub ShowCard(ByVal lngBudgetID As Long, ByVal intYear As Integer, ByVal intFlag As Integer)
    Dim intCount As Integer
    
    mintFlag = intFlag
    mlngBudgetID = lngBudgetID
    mintYear = intYear
    For intCount = 0 To 11
        mblnBudget(intCount) = False
    Next
    Me.Show vbModal
End Sub

'初始化参照列表
Private Sub SetListText()
    Dim intCount As Integer
    Dim strID As String
    Dim strSql As String
    Dim recTemp As rdoResultset
    
    strSql = "SELECT lngBudgetID,strBudgetName FROM Budget WHERE bytType=" & mintFlag
    With cboBudget(0)
        Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recTemp.RowCount > 0 Then
            Do While Not recTemp.EOF
                .AddItem recTemp("strBudgetName")
                .ItemData(intCount) = recTemp("lngBudgetID")
                intCount = intCount + 1
                recTemp.MoveNext
            Loop
            .ListIndex = 0
            strSql = "SELECT DISTINCT intYear FROM BudgetBalance WHERE lngBudgetID=" & .ItemData(0)
            With cboBudget(1)
                .Clear
                Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If Not recTemp.EOF Then
                    Do While Not recTemp.EOF
                        .AddItem recTemp("intYear")
                        recTemp.MoveNext
                    Loop
                    .ListIndex = 0
                End If
            End With
        End If
    End With
    recTemp.Close
End Sub

'复制历史预算
Private Function CopyBudget() As Boolean
    Dim intCount As Integer
    Dim strSql As String
    Dim strSql1 As String
    Dim recTemp As rdoResultset
    Dim blnBudget(10) As Boolean
    Dim bytPeriodNO As Byte
    Dim dblScale As Double
    Dim lngBudgetID As Long
    Dim intYear As Integer
    Dim strObject1 As String
    Dim strObject2 As String
    
    If cboBudget(0).Text = "" Then
        ShowMsg Me.hWnd, "预算方案必须选择！", vbInformation, Me.Caption
        cboBudget(0).SetFocus
        CopyBudget = False
        Exit Function
    End If
    If cboBudget(1).Text = "" Then
        ShowMsg Me.hWnd, "预算年度必须选择！", vbInformation, Me.Caption
        CopyBudget = False
        cboBudget(1).SetFocus
        Exit Function
    End If
    If calBudget.Text <> "" And IsNumeric(calBudget.Text) Then
        If CDbl(calBudget.Text) <= 0 Then
            ShowMsg Me.hWnd, "复制比例必须大于零！", vbInformation, Me.Caption
            CopyBudget = False
            calBudget.SetFocus
            Exit Function
        End If
    Else
        ShowMsg Me.hWnd, "复制比例错误，请重新输入！", vbInformation, Me.Caption
        CopyBudget = False
        calBudget.SetFocus
        Exit Function
    End If
    lngBudgetID = cboBudget(0).ItemData(cboBudget(0).ListIndex)
    intYear = cboBudget(1).Text
    If lngBudgetID = mlngBudgetID And intYear = mintYear Then
        ShowMsg Me.hWnd, "复制与被复制的预算方案和预算年度完全相同，不能复制！", vbInformation, Me.Caption
        cboBudget(0).SetFocus
        CopyBudget = False
        Exit Function
    End If
    For intCount = 0 To 10
        If mblnBudget(intCount) Then Exit For