frmcopywork.frm

金算盘软件代码

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmCopyWork 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "复制工作量"
   ClientHeight    =   1755
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4185
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1755
   ScaleWidth      =   4185
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin ComctlLib.ProgressBar prgCopy 
      Height          =   240
      Left            =   75
      TabIndex        =   7
      Top             =   1470
      Visible         =   0   'False
      Width           =   4035
      _ExtentX        =   7117
      _ExtentY        =   423
      _Version        =   327682
      Appearance      =   1
   End
   Begin VB.CommandButton cmdOk 
      Height          =   350
      Index           =   1
      Left            =   2880
      Style           =   1  'Graphical
      TabIndex        =   2
      Tag             =   "1002"
      Top             =   570
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOk 
      Height          =   350
      Index           =   0
      Left            =   2880
      Style           =   1  'Graphical
      TabIndex        =   1
      Tag             =   "1001"
      Top             =   180
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Caption         =   "复制以前期间的工作量"
      Height          =   1275
      Left            =   120
      TabIndex        =   0
      Top             =   150
      Width           =   2655
      Begin VB.ComboBox cboPeriod 
         Height          =   300
         Left            =   1170
         Style           =   2  'Dropdown List
         TabIndex        =   6
         Top             =   780
         Width           =   1305
      End
      Begin VB.ComboBox cboYear 
         Height          =   300
         Left            =   1170
         Style           =   2  'Dropdown List
         TabIndex        =   4
         Top             =   360
         Width           =   1305
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "会计期间(&P)"
         Height          =   180
         Index           =   1
         Left            =   150
         TabIndex        =   5
         Top             =   840
         Width           =   990
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "会计年度(&Y)"
         Height          =   180
         Index           =   0
         Left            =   150
         TabIndex        =   3
         Top             =   420
         Width           =   990
      End
   End
End
Attribute VB_Name = "frmCopyWork"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''
'   复制工作量窗体
'   作者:肖宇
'   日期:98-07-03
'
'   功能:
'       将当前固资在所选会计年度和
'       会计期间的工作量复制到列表中
'
'''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private mblnLoading As Boolean
Private mblnOk As Boolean

Private Sub cmdOK_Click(index As Integer)
    Select Case index
        Case 0
            '确定
            mblnOk = True
            Hide
        Case 1
            '取消
            mblnOk = False
            Hide
    End Select
End Sub

Private Sub Form_Activate()
    SetHelpID HelpContextID
    frmMain.SetEditUnEnabled
End Sub

Private Sub Form_Load()
    Me.HelpContextID = 10228
    mblnLoading = True
    cboYear.ListIndex = cboYear.ListCount - 1
    Utility.LoadFormResPicture Me
    InitYear
    mblnLoading = False
    cboYear_click
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Utility.UnLoadFormResPicture Me
End Sub

Private Sub InitYear()
    Dim strSQL As String
    Dim recFixedBalance As rdoResultset
    
    strSQL = "SELECT DISTINCT intYear FROM FixedBalance WHERE dblwork>0"
    Set recFixedBalance = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If Not recFixedBalance.EOF Then
        Do While Not recFixedBalance.EOF
            cboYear.AddItem Format(recFixedBalance!intYear, "0000") & "年"
            recFixedBalance.MoveNext
        Loop
    End If
    recFixedBalance.Close
    Set recFixedBalance = Nothing
End Sub

Private Sub cboYear_click()
    Dim strSQL As String
    Dim recFixedBalance As rdoResultset
    
    If (Not mblnLoading) And IsNumeric(Left(cboYear.Text, 4)) Then
        cboPeriod.Clear
        strSQL = "SELECT DISTINCT bytPeriod FROM FixedBalance WHERE dblwork>0 AND intYear=" & Left(cboYear.Text, 4)
        Set recFixedBalance = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
        Do While Not recFixedBalance.EOF
            If C2lng(Left(cboYear.Text, 4)) = gclsBase.AccountYear And recFixedBalance!bytPeriod = gclsBase.Period Then
            Else
                cboPeriod.AddItem Format(recFixedBalance!bytPeriod, "00期间")
            End If
            recFixedBalance.MoveNext
        Loop
        recFixedBalance.Close
        Set recFixedBalance = Nothing
    End If
End Sub

Public Sub CopyWork(msgWork As MSFlexGrid, lngColID As Long, lngColWork As Long)
    Dim lngRow As Long
    Dim strSQL As String
    Dim recFixedBalance As rdoResultset
    Dim intCol1 As Integer
    Dim intCol2 As Integer
    Dim dblTotal As Double
    Dim dblAccWork As Double
    
    intCol1 = GetGridCol("预计总工作量", msgWork)
    intCol2 = GetGridCol("月初累计工作量", msgWork)
    
    Show vbModal
    
    If mblnOk And cboYear.Text <> "" And cboPeriod.Text <> "" Then
        With msgWork
            prgCopy.Max = .Rows - 1
            prgCopy.Visible = True
            For lngRow = 1 To .Rows - 1
                strSQL = "SELECT dblWork FROM FixedBalance WHERE lngFixedCardID=" & .TextMatrix(lngRow, lngColID) _
                    & " AND dblWork>0 AND intYear=" & Left(cboYear.Text, 4) & " AND bytPeriod=" & Left(cboPeriod.Text, 2)
                Set recFixedBalance = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
                If Not recFixedBalance.EOF Then
                    If intCol1 > 0 And intCol2 > 0 Then
                        dblTotal = GetGridValue(lngRow, intCol1, "Double", msgWork)
                        dblAccWork = GetGridValue(lngRow, intCol2, "Double", msgWork)
                    Else
                        dblTotal = 0
                        dblAccWork = 0
                    End If
                    If recFixedBalance!dblWork + dblAccWork <= dblTotal Then
                        .TextMatrix(lngRow, lngColWork) = recFixedBalance!dblWork
                    ElseIf dblAccWork < dblTotal Then
                        .TextMatrix(lngRow, lngColWork) = dblTotal - dblAccWork
                    End If
                Else
                    .TextMatrix(lngRow, lngColWork) = ""
                End If
                prgCopy.Value = lngRow
            Next lngRow
        End With
        
        If Not recFixedBalance Is Nothing Then
            recFixedBalance.Close
            Set recFixedBalance = Nothing
        End If
    End If
    Unload Me
End Sub