frmtransvoucher.frm

金算盘软件代码

    
    My.bytRegion = FcmdButton
    My.bytIndex = Index
    If cmdButton(Index).Visible And cmdButton(Index).Enabled Then
        cmdButton(Index).SetFocus
    End If
End Sub
Private Sub cmdButton_Click(Index As Integer)
    
    If blnButtonDisable Then Exit Sub
    If blnNotRaiseEvent Then Exit Sub
    Button_Click Index
    Select Case Index
        Case 0
            cmdNext_Click   '下一个
        Case 1
            CmdPrev_Click   '上一个
        Case 2
            cmdHome_Click   '最前
        Case 3
            CmdEnd_Click    '最后
        Case 4
            cmdOK_Click     '确定
        Case 5
            CmdCancel_Click '取消
        Case 6
            cmdVoucher_Click '预览凭证
    End Select
End Sub

Private Sub CmdCancel_Click()
    My.blnIsChanged = False
    Unload Me
End Sub

Private Sub CmdEnd_Click()
    Dim i As Integer
    If Not ChangeSaveNote Then Exit Sub
    Dim lngID As Long
    lngID = BillID(C2lng(My.lngNowID), 4)
    
    If lngID < 1 Then
        If blnEdit Then GetANewBill C2lng(lblHead(5 - 1).Tag)
    Else
        ShowAOldBill lngID
    End If
End Sub

Private Sub cmdHome_Click()
    Dim i As Integer
    If Not ChangeSaveNote Then Exit Sub
    Dim lngID As Long
    lngID = BillID(C2lng(My.lngNowID), 3)
    If lngID = 0 Then
    Else
        ShowAOldBill lngID
    End If
End Sub

Private Sub cmdNext_Click()
    Dim i As Integer
    Dim blnNewBill As Boolean
    
    If My.lngNowID <= 0 Then If My.blnIsChanged = False Then Exit Sub
    If My.lngNowID = 0 Then blnNewBill = True
    If Not SaveBill() Then Exit Sub
    If blnNewBill Then
        If blnEdit Then
            If ChangeSaveNote = False Then Exit Sub
            GetANewBill (C2lng(lblHead(5 - 1).Tag))
            Exit Sub
        End If
    End If
    '--------------------------------
    Dim lngID As Long
    lngID = BillID(C2lng(My.lngNowID), 2)
    If lngID = 0 Then
        If blnEdit Then
            If ChangeSaveNote = False Then Exit Sub
            GetANewBill C2lng(lblHead(5 - 1).Tag)
            Exit Sub
        End If
    Else
        ShowAOldBill lngID
    End If
End Sub

Private Sub cmdOK_Click()
    If SaveBill() Then Unload Me
End Sub

Private Sub CmdPrev_Click()
    Dim i As Integer
    If Not ChangeSaveNote Then Exit Sub
    Dim lngID As Long
    lngID = BillID(My.lngNowID, 1)
    If lngID = 0 Then
    Else
        ShowAOldBill lngID
    End If
End Sub

Private Sub cmdVoucher_Click()
    If Not PreViewVoucher() Then Exit Sub
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub
Private Sub Form_Activate()
    SetHelpID C2lng(Me.HelpContextID)
    If gclsSys Is Nothing Or mclsMainControl Is Nothing Then
        Unload Me
        Exit Sub
    End If
    ResponseMessage
    UpdateMainEditMenu My.bytRegion
    gclsSys.CurrFormName = Me.hwnd
    Debug.Print "ACTIVATE" & time
    If blnShowWizard = False Then
        Debug.Print "ACTIVATE1" & time
        Form_Resize
    End If
End Sub
Public Sub ResponseMessage()
    Dim vntMessage As Variant
    Dim lngOldID As Long
    Dim strOldText As String
    
    lngOldID = refInput(1).ID
    strOldText = refInput(1).Text
    
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgAccount Then '接收到科目改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除科目改变消息
            refInput(1).SQL = clsRed.RecordSQL(xAccount)
            Set refInput(1).Recordset = clsRed.RecordCon(xAccount)
            refInput(1).AddRefer "<新增>"
            refInput(1).AddRefer "<修改>"
            refInput(1).AddRefer "<删除>"
            
            If lngOldID > 0 Then
                refInput(1).SeekId lngOldID
            Else
                refInput(1).Text = strOldText
            End If
        End If
    Next
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Form_key_Down KeyCode
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim AltDown As Integer
    If KeyCode = 93 Then
        If My.bytRegion = FGrid Or My.bytRegion = FGrid1 Or My.bytRegion = FPicture Then
            blnMouseDown = True
            GrdCol_Mouseup vbRightButton, 0, 0, 0
        Else
            Form_MouseUp vbRightButton, 0, 0, 0
        End If
        Exit Sub
    End If
    
    If Shift = 2 And KeyCode = vbKeyPageDown Then
        cmdButton_Click 0
        Exit Sub
    ElseIf Shift = 2 And KeyCode = vbKeyPageUp Then
        cmdButton_Click 1
        Exit Sub
    ElseIf Shift = 2 And KeyCode = vbKeyReturn Then
        cmdButton_Click 4
        Exit Sub
    End If

    AltDown = Shift And vbAltMask
    If AltDown > 0 Then
        Select Case KeyCode
            Case 68     'ALT+D
                Head_Click 5, False
            Case 67     'ALT+C
                Head_Click 3, False
            Case 78     'ALT+N
                Head_Click 1, False
            Case 77     'ALT+M
                Memo_Click 1
            Case Else
        End Select
    Else
    End If

End Sub


Private Sub Form_Load()
    Dim i As Integer
    ReDim strColRow(grdCol.Cols - 1) As String  '单据体行复制/粘贴存储区
'--------------------------
'    Me.Hide
'    Me.Move -5000, -5000
    MsgForm.PleaseWait
'--------------------------
    If WanNeng Then
        Me.Caption = "万能转帐凭证"
        lblCaption.Caption = "万能转帐凭证"
    End If
    IntSpace = Screen.TwipsPerPixelX   '粘贴控件之间距
    SPACETWIPS = 2 * Screen.TwipsPerPixelX '单据头控件之列距
    SpaceTwRow = Screen.TwipsPerPixelY   '单据头控件之行距
    If gclsSys Is Nothing Or gclsBase Is Nothing Then
        Unload Me
        Exit Sub
    End If
    
    Set clsRed = New RecordClass
    Set clsBase = New BaseFunction
    clsBase.Init gclsBase.BaseDB, gclsBase.BaseDate, , gclsBase.OperatorID
    
    Me.HelpContextID = 60112
'给GRDCOL设HOOK
    Set mclsSubClass = New SubClass32.SubClass
    mclsSubClass.hwnd = grdCol.hwnd
    mclsSubClass.Messages(WM_PAINT) = True
    mclsSubClass.Messages(WM_LBUTTONDOWN) = True
    mclsSubClass.Messages(WM_LBUTTONUP) = True

    Set mclsHook = New SubClass32.SubClass
    mclsHook.hwnd = Me.hwnd
    mclsHook.Messages(WM_PAINT) = True
    mclsHook.Messages(WM_KEYUP) = True
    mclsHook.Messages(WM_GETMINMAXINFO) = True

    Set KeyPressHook = New Hook
    KeyPressHook.SetHookAll Me.hwnd
    
    My.blnIsChanged = False
    My.bytRegion = FHead
    My.bytIndex = 0
    
    intGrdBorderWidth = Screen.TwipsPerPixelX
    intGrdBorderHeight = Screen.TwipsPerPixelY
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Utility.LoadFormSetting Me
    My.intAccountYear = gclsBase.FYearOfDate(Date)   '会计年度
    My.bytAccountPeriod = gclsBase.PeriodOfDate(Date)   '会计期间
    gclsBase.GetBeginAndEndDate "本期", gclsBase.BaseDate, My.dtmStart, My.dtmEnd    '  当前会计期间之起始结束日期
    
    My.blnCtrlBinding = True
    My.blnPasteRec = False
'设置GRID附加属性
    SetColProperty
'   创建Field控件(表头输入)
    CreateField
'绑定科目记录集
    refInput(0).Comparts = 2
    refInput(1).Comparts = 2
    refInput(1).SeekCol = "1,2,3"
    refInput(1).SQL = clsRed.RecordSQL(xAccount, 0)
    Set refInput(1).Recordset = clsRed.RecordCon(xAccount, 0)
    refInput(1).BorderStyle = 0
    refInput(1).Appearance = 0
    refInput(1).AutoPop = True
    refInput(1).AddRefer "<新增>"
    refInput(1).AddRefer "<修改>"
    refInput(1).AddRefer "<删除>"
    refInput(1).Tag = MsgNO(enumTabType.xAccount)
    refInput(1).Move -50000
    
    My.blnCtrlBinding = True
'    设置客户可选项
    grdCol.ColWidth(0) = 0
    txtInput.Text = ""
    blnShowWizard = False
    ReceiptID = 80  'EditNO方法内权限内的转入的ID号
    If WanNeng Then
        tblReceipt.Visible = True
        SetImageList tblReceipt
        SetToolBarTextImage tblReceipt, 2, 21
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvent Then Exit Sub
    MakeListEditMenu
    If Button = vbRightButton Then
        PopupMenu frmMain.mnuListEdit
    End If

End Sub


'窗体尺寸变化处理程序
Private Sub Form_Resize()
    Dim lngLineLength As Long
    Dim lngGridwidth As Long
    Dim ctrOne As Control
    Dim i As Integer
    Dim lngL As Long
        
    If blnShowWizard = True Then Exit Sub
    If Me.WindowState = 1 Then Exit Sub
    If Not Me.Visible Then Exit Sub
'------------------------------------------------
    If (Me.Left + Me.width < Me.width / 2 Or Me.Left > Screen.width) And Me.WindowState <> 2 Then
        Me.Left = 300
    End If
    If (Me.top + Me.Height < Me.Height / 2 Or Me.top > Screen.Height) And Me.WindowState <> 2 Then
        Me.top = 300
    End If
'------------------------------------------------
    My.blnRefresh = False
    lngL = LblBack.Left
    If WanNeng Then
        lblHead(0).Move lngL, tblReceipt.Height + 8 * Screen.TwipsPerPixelY
        lblHead(1).Move lngL + lblHead(0).width + 50, tblReceipt.Height + 6 * Screen.TwipsPerPixelY
    Else
        lblHead(0).Left = lngL
        lblHead(1).Left = lngL + lblHead(0).width + 50
    End If
    lngL = ScaleWidth - cmdButton(0).width - 200 - lblHead(5).width
    If WanNeng Then
        lngL = ScaleWidth - lblHead(5).width - 3 * Screen.TwipsPerPixelX
    Else
        lngL = ScaleWidth - cmdButton(0).width - 200 - lblHead(5).width
    End If
    If WanNeng Then
        lblHead(5).Move lngL, tblReceipt.Height + 6 * Screen.TwipsPerPixelY
        lblHead(4).Move lngL - lblHead(4).width - 50, tblReceipt.Height + 8 * Screen.TwipsPerPixelY
    Else
        lblHead(5).Left = lngL
        lblHead(4).Left = lngL - lblHead(4).width - 50
    End If
    lngL = lblHead(4).Left - (lblHead(1).Left + lblHead(1).width) - lblHead(2).width - lblHead(3).width - 150
    If lngL < 0 Then
        lngL = 0
    End If
    If WanNeng Then
        lblHead(2).Move lblHead(1).Left + lblHead(1).width + 50 + lngL / 2, tblReceipt.Height + 8 * Screen.TwipsPerPixelY
        lblHead(3).Move lblHead(2).Left + lblHead(2).width + 50, tblReceipt.Height + 6 * Screen.TwipsPerPixelY
    Else
        lblHead(2).Left = lblHead(1).Left + lblHead(1).width + 50 + lngL / 2
        lblHead(3).Left = lblHead(2).Left + lblHead(2).width + 50
    End If
    FieldButton
    
    If Not grdCol.Visible Then
        grdCol.Visible = True
    End If
    LblBack.Visible = True
    lblCaption.Visible = True
    For i = 0 To cmdButton.Count - 1
        If i = 2 Or i = 3 Then
        Else
            cmdButton(i).Visible = True
        End If
    Next i
    For i = 0 To lblHead.Count - 1
        lblHead(i).Visible = True
    Next i
    For i = 0 To lblmemo.Count - 1