frmtransferloss.frm

金算盘软件代码

      End
      Begin VB.Frame fraWizard 
         Height          =   3285
         Index           =   3
         Left            =   -74910
         TabIndex        =   6
         Top             =   360
         Width           =   6255
         Begin VB.TextBox txtResult 
            Height          =   2640
            Left            =   1485
            Locked          =   -1  'True
            MultiLine       =   -1  'True
            ScrollBars      =   2  'Vertical
            TabIndex        =   7
            Top             =   540
            Width           =   4680
         End
         Begin ListRefer.ListText lstxtRemark 
            Height          =   300
            Left            =   2550
            TabIndex        =   8
            Top             =   180
            Width           =   3615
            _ExtentX        =   6376
            _ExtentY        =   556
            BackColor       =   -2147483643
            BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
               Name            =   "宋体"
               Size            =   9
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
         End
         Begin VB.Image imgWizard 
            BorderStyle     =   1  'Fixed Single
            Height          =   3000
            Index           =   3
            Left            =   90
            Stretch         =   -1  'True
            Tag             =   "140"
            Top             =   180
            Width           =   1335
         End
         Begin VB.Label lblArr 
            Caption         =   "凭证摘要(&R)"
            Height          =   195
            Index           =   3
            Left            =   1530
            TabIndex        =   9
            Top             =   210
            Width           =   1005
         End
      End
   End
End
Attribute VB_Name = "FrmTransferLoss"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 期末调汇
' 1998.7.13
' 作者：唐维勇
'
' 过程：
'     InitStep                                                     向导每步初始化
'     ValidStep                                                    向导每步合法检查
'     Execute                                                      向导完成后需执行的操作
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private mintStepNum As Integer                                    '向导总步骤
Private mintStep As Integer                                       '向导当前步骤
Private mblnEnd As Boolean                                        '完成按扭是否有效
Private mblnValid() As Boolean                                    '向导每步是否合法

Private WithEvents mclsRateGrid As Grid                           'Grid对象
Attribute mclsRateGrid.VB_VarHelpID = -1
Private WithEvents mclsMainControl As MainControl                 '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1

Private mAccountID As Long
Private mVoucherTypeID As Long
Private mTemplateID As Long
Private mRemarkID As Long
Private VoucherData() As VoucherRecord                            '凭证结果
Private mlngFormatID As Long

Private Sub Form_Activate()
    SetHelpID HelpContextID
    gclsSys.CurrFormName = hWnd
    mclsMainControl_ChildActive
    
    '进入向导第一步
    If Not mblnValid(0) Then
        stabWizard.Tab = 0
        stabWizard_Click -1
    End If
End Sub

Private Sub Form_Load()
    
    Me.HelpContextID = 60016
    mlngFormatID = 41
    '主控对象
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    
    '向导初始化(包括每步仅需初始一次的部分)
    mintStepNum = stabWizard.Tabs - 1
    mintStep = -1
    mblnEnd = False
    ReDim mblnValid(mintStepNum)
End Sub


Private Sub Form_Resize()
    If Left < 0 Or Left > Screen.Width Then Left = (Screen.Width - Width) / 2
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    If (TypeOf Screen.ActiveControl Is ListText) Then
        If Not Screen.ActiveControl.ReferVisible Then
            If KeyCode = vbKeyReturn Then
               KeyCode = 0
               SendKeys "{Tab}", True
            End If
        End If
    ElseIf Not (TypeOf Screen.ActiveControl Is MSFlexGrid) And Not (UCase(Screen.ActiveControl.Name) = "TXTRATE") Then
        If KeyCode = vbKeyReturn Then
           KeyCode = 0
           SendKeys "{Tab}", True
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Set mclsRateGrid = Nothing
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    
    '删除科目参照
    If Not lstxtAccount.Recordset Is Nothing Then
        Utility.RemoveListRecordSet lrtAccount
    End If

    '删除凭证类型参照
    If Not lstxtType.Recordset Is Nothing Then
        Utility.RemoveListRecordSet lrtVoucherType
    End If

End Sub

'更新与子窗体相关的菜单项的可用性
Private Sub UpdateMenuStatus()
    With frmMain
        ' 设置MDI主窗口菜单可用标志
        .mnuEditUndo.Enabled = False
        .mnuEditCut.Enabled = False
        .mnuEditCopy.Enabled = False
        .mnuEditPaste.Enabled = False
        .mnuEditInsLine.Enabled = False
        .mnuEditDelLine.Enabled = False
        .mnuEditEdit.Enabled = False
        .mnuEditNew.Enabled = False
        .mnuEditDel.Enabled = False
        .mnuEditInActive.Enabled = False
        .mnuEditShowAll.Enabled = False
        .mnuEditShowList.Enabled = False
        .mnuEditUse.Enabled = False
        .mnuEditNotepad.Enabled = False
        .mnuEditFilter.Enabled = False
        .mnuEditColumn.Enabled = False
        .mnuFilePrintSetup.Enabled = False
        .mnuFilePrint.Enabled = False
        .mnuReportQuick.Enabled = False
        .mnuToolRefresh.Enabled = False
        .SetToolBar
    End With
End Sub

Private Sub mclsMainControl_ChildActive()
    Dim vntMessage As Variant
    
    On Error Resume Next
    '响应消息
    If fraWizard(1).Tag = "已设置" Then
        For Each vntMessage In mclsMainControl.Messages
            Select Case vntMessage
            Case Message.msgVoucherType
                RefreshVoucherType mVoucherTypeID
            Case Message.msgTemplate
                RefreshTemplate mTemplateID
            End Select
        Next
    End If
    
    gclsSys.CurrFormName = hWnd
    UpdateMenuStatus
End Sub

Private Sub mclsRateGrid_BeforeSave(blnCancel As Boolean)
    If msgRate.TextMatrix(msgRate.Row, 3) > 0 Then
        msgRate = Format(txtRate.Text, "0." & String(msgRate.TextMatrix(msgRate.Row, 3), "0"))
    Else
        msgRate = Format(txtRate.Text, "0")
    End If
    blnCancel = True
End Sub

Private Sub stabWizard_Click(PreviousTab As Integer)
    Dim intCnt As Integer
    
    For intCnt = 0 To stabWizard.Tabs - 1
        fraWizard(intCnt).Visible = (intCnt = stabWizard.Tab)
    Next intCnt
    
    ' 若向导进入其他步骤，进行该步骤合法检查
    If stabWizard.Tab > mintStep And mintStep < mintStepNum Then
        If ValidStep(mintStep) Then
            mintStep = stabWizard.Tab
            
            '初始向导步骤
            InitStep mintStep
            
        End If
    Else
        mintStep = stabWizard.Tab
        InitStep mintStep
        RefreshCmd
    End If
    
    If stabWizard.Tab = stabWizard.Tabs - 1 Then
        On Error Resume Next
        cmdStep(3).SetFocus
    Else
        On Error Resume Next
        cmdStep(2).SetFocus
    End If
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'向导公用过程
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 向导每步合法检查
Private Function ValidStep(ByVal TabIndex As Integer) As Boolean
    Dim strMsg As String, lngBottom As Integer
    
    Select Case TabIndex
    Case 0: ValidStep = ValidRate(strMsg)          '期末汇率
    Case 1: ValidStep = ValidAccount(strMsg)       '损益科目
    Case 2: ValidStep = ValidOption(strMsg)        '凭证选项
    Case 3: ValidStep = ValidResult(strMsg)        '执行调汇
    Case Else
        ValidStep = True
    End Select
    
    '返回上一步
    If Not ValidStep Then
        If mintStep < stabWizard.Tab Then
            stabWizard.Tab = mintStep
        Else
            mintStep = stabWizard.Tab
            RefreshCmd
        End If
        ShowMsg hWnd, strMsg, vbExclamation + vbOKOnly, Caption
    End If
    
    '设置每步合法性
    If TabIndex <> -1 Then
        mblnValid(TabIndex) = ValidStep
    End If
    
End Function

' 向导每步初始设置
Private Sub InitStep(TabIndex As Integer)
    Dim lngCnt As Long
    
    Me.MousePointer = vbHourglass
    Select Case TabIndex
    Case 0: InitRate          '期末汇率
    Case 1: InitAccount       '损益科目
    Case 2: InitOption        '凭证选项
    Case 3:
        For lngCnt = 0 To TabIndex - 1
            If Not mblnValid(lngCnt) Then
                stabWizard.Tab = lngCnt
            End If
        Next lngCnt
        InitResult        '执行调汇
    End Select
    RefreshCmd
    Me.MousePointer = vbDefault
End Sub

' 向导完成后需执行的操作
Private Sub Execute()
    Dim lngCnt As Long, lngCntDetail As Long
    Dim errNo As Long
    Dim blnSave As Boolean
    
    On Error GoTo ErrHandle
    
    For lngCnt = 0 To UBound(VoucherData)
        If VoucherData(lngCnt).Used Then
            VoucherData(lngCnt).TemplateID = lstxtTemplate.TextMatrix(lstxtTemplate.ReferRow, 1)
            VoucherData(lngCnt).VoucherTypeID = lstxtType.TextMatrix(lstxtType.ReferRow, 1)
            For lngCntDetail = 0 To UBound(VoucherData(lngCnt).Detail)
                VoucherData(lngCnt).Detail(lngCntDetail).Remark = lstxtRemark.Text
            Next lngCntDetail
        End If
    Next lngCnt
    
    gclsBase.BaseWorkSpace.BeginTrans
    blnSave = SaveVoucher(VoucherData)
    If gclsBase.ControlAccount And blnSave Then
        blnSave = MakeTOReceipt
    End If
    If blnSave Then
        gclsBase.BaseWorkSpace.CommitTrans
    Else
        'gclsBase.BaseWorkSpace.RollBack
        gclsBase.BaseWorkSpace.RollbackTrans
    End If
    
    If Not blnSave Then
        If VoucherData(0).ErrorString <> "" Then
            ShowMsg hWnd, "凭证生成失败：" & VoucherData(0).ErrorString, vbOKOnly + vbCritical, Caption
        Else
            ShowMsg hWnd, "没有凭证生成！", vbOKOnly + vbCritical, Caption
        End If
    Else
'        ShowMsg hWnd, "凭证生成完毕！", vbOKOnly + vbInformation, Caption
        Me.Hide
        gclsSys.SendMessage Me.hWnd, msgReceipt41
        If gclsBase.ControlAccount Then
            gclsSys.SendMessage Me.hWnd, msgReceipt36
        End If
        BillPublic.ShowBill 50, VoucherData(0).VoucherID
    End If
    Exit Sub