frmstriprigout.frm

金算盘软件代码

    End If
    Form_Resize
    
    If Me.Left + Me.width < 0 Or Me.Left > Screen.width Then
        Me.Left = 300
    End If
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents Then Exit Sub
    blnNotRaiseEvents = True
    clsBill.GrdCol_Mouseup Button, Shift, x, y
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
'    If Button = vbRightButton Then
'        MakeListActivityMenu
'        PopupMenu frmMain.mnuListActivity
'    End If
End Sub

Private Sub grdCol1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents Then Exit Sub
    blnNotRaiseEvents = True
    clsBill.grdcol1_MouseUp Button, Shift, x, y
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
'    If Button = vbRightButton Then
'        MakeListActivityMenu
'        PopupMenu frmMain.mnuListActivity
'    End If
End Sub

Private Sub GrdCol_RowColChange()
    clsBill.GrdCol_RowColChange
End Sub


Private Sub grdCol_Scroll()
    clsBill.grdCol_Scroll
End Sub

Private Sub grdCol1_Scroll()
    clsBill.grdCol1_Scroll
End Sub

Private Sub LblBack_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents Then Exit Sub
    clsBill.LblBack_MouseUp
    If Button = vbRightButton Then
        MakeListEditMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        If clsBill Is Nothing Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
        clsBill.blnNotRespondKeyPress = False
        blnNotRaiseEvents = True
        DoEvents
        blnNotRaiseEvents = False
    End If
End Sub

Private Sub lblField_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents Then Exit Sub
    clsBill.Field_MouseUp Index, Button, x, y
    
    If Button = vbRightButton Then
        MakeListEditMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        If clsBill Is Nothing Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
        clsBill.blnNotRespondKeyPress = False
    End If
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub

Private Sub lblFieldCaption_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents Then Exit Sub
    clsBill.Field_MouseUp Index, Button, x, y
    If Button = vbRightButton Then
        MakeListEditMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        If clsBill Is Nothing Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
        clsBill.blnNotRespondKeyPress = False
    End If
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub

Private Sub lblHead_Change(Index As Integer)
    If Index = 5 Then
        refTmpID_Change
    End If
    If Index = 1 Then
        lblField(0).Caption = strDetailMsg(C2lng(lblHead(0).Tag))
'        lblCaption.Caption = lblField(0).Caption
    End If
End Sub

Private Sub lblHead_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents Then Exit Sub
    blnNotRaiseEvents = True
    Select Case Button
        Case vbRightButton
            clsBill.UpdateMainEditMenu
            MakeListEditMenu
            clsBill.blnNotRespondKeyPress = True
            PopupMenu frmMain.mnuListEdit
            If clsBill Is Nothing Then
                blnNotRaiseEvents = False
                Exit Sub
            End If
            clsBill.blnNotRespondKeyPress = False
            
            GoTo EndProc
        Case vbLeftButton
            If Index = 3 Then
                If clsBill.lngNowID = 0 Then
                Else
                    ShowMsg Me.hWnd, "已保存的单据，不能编辑单据类型！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "提示信息"
                    GoTo EndProc
                End If
            End If
            If (Index \ 2) * 2 = Index Then Exit Sub
            If x >= lblHead(Index).width - clsBill.DropButtonWidth And _
               x <= lblHead(Index).width And y >= 0 And _
               y <= lblHead(Index).Height Then
                clsBill.Head_Click Index, True
            Else
                clsBill.Head_Click Index, False
            End If
            clsBill.UpdateMainEditMenu
    End Select
EndProc:
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub

Private Sub LblMemo_Click(Index As Integer)
    If blnNotRaiseEvents Then Exit Sub
    clsBill.Memo_Click Index
End Sub

Private Sub mclsMainControl_ChildActive()
    SetHelpID C2lng(Me.HelpContextID)
    ResponseMessage
    gclsSys.CurrFormName = Me.hWnd
    clsBill.UpdateMainEditMenu
    If WanNeng Then
        tblReceipt.Refresh
    End If
End Sub

Private Sub mclsMainControl_EditDel()
   mclsMainControl_ListEditMenu (1)
End Sub

Private Sub mclsMainControl_EditDelLine()
    mclsMainControl_ListActivityMenu (1)
End Sub

Private Sub mclsMainControl_EditInActive()
    If chkPrint(1).Value <> 0 Then
        chkPrint(1).Value = 0
    Else
        chkPrint(1).Value = 1
    End If
End Sub

Private Sub mclsMainControl_EditInsLine()
    mclsMainControl_ListActivityMenu (0)
End Sub

Private Sub mclsMainControl_EditNew()
   mclsMainControl_ListEditMenu (0)
End Sub

Private Sub mclsMainControl_EditShowAll()
    If chkPrint(0).Value <> 0 Then
        chkPrint(0).Value = 0
    Else
        chkPrint(0).Value = 1
    End If
End Sub

Private Sub mclsMainControl_EditShowList()
   ShowRelationList
End Sub

Private Sub mclsMainControl_ListActivityMenu(ByVal intIndex As Integer)
    Dim strMsg(5) As String, strMsg1(5) As String
    Dim intYesNo As Integer
    Dim i%, j%
    
    strMsg1(0) = "确实要删除该条拆卸组装单记录吗？"
    strMsg1(1) = "确实要删除该条已经作废拆卸组装单记录吗？"
    
    Select Case intIndex
        Case 0  '插入记录
            clsBill.InsertARow
            MakeListActivityMenu
            clsBill.SetAFocus
        Case 1  '删除记录
            If chkPrint(1).Value = True Then
                intYesNo = ShowMsg(Me.hWnd, strMsg1(1), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息")
            Else
                intYesNo = ShowMsg(Me.hWnd, strMsg1(0), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息")
            End If
            If intYesNo = IDYES Then
                clsBill.blnCtrlBinding = False
                If Not clsBill.blnDeleteARow(GrdCol.Row) Then
                    ShowMsg Me.hWnd, "删除当前记录失败！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "提示信息"
                    Exit Sub
                End If
                If GrdCol.Row > 1 Then
                    GrdCol.RemoveItem GrdCol.Row
                End If
                clsBill.blnCtrlBinding = True
                clsBill.grdCol_EnterCell
                clsBill.BuildNoteMsg True
'                lblTotal(1).Caption = grdCol.TextMatrix(grdCol.Row, 8)
'                lblTotal(2).Caption = grdCol.TextMatrix(grdCol.Row, 7)
                MakeListActivityMenu
            Else
                clsBill.SetAFocus
            End If
        Case 2, 5 'bar
        Case 3  '复制记录
            clsBill.CopyARow
            MakeListActivityMenu
            clsBill.SetAFocus
        Case 4  '粘贴记录
            clsBill.PasteARow
            MakeListActivityMenu
            clsBill.SetAFocus
        Case 6  '搜索
        Case 7  '查询缺号
             frmBillNo.ShowTypeID ReceiptTypeID
            If clsBill.lngNowID > 0 Then
                lblField(1).Caption = GetReceiptNo(99, clsBill.lngNowID)
            End If
            clsBill.SetAFocus
    End Select
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Dim strMsg(5) As String
    Dim intYesNo As Integer
    Dim i%, j%
    strMsg(0) = "确实要删除该张商品期初单全部记录吗?"
    strMsg(1) = "确实要删除该张已经作废商品期初单全部记录吗?"
    Select Case intIndex
        Case 0  '插入单据
            clsBill.CHK_CLICK (0)
            If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then Exit Sub
            If ChangeSaveNote() = False Then Exit Sub
            ShowANewBill clsBill.lngNowID
        Case 1  '删除单据
            Dim clsLst As clsCompose
            Set clsLst = New clsCompose
            clsLst.hWnd = Me.hWnd
            If Not clsLst.DeleteCompose(clsBill.lngNowID, False) Then
                clsBill.SetAFocus
                Exit Sub
            Else
                gclsSys.SendMessage Me.hWnd, 30 + C2lng(lblHead(2).Tag)
                gclsSys.SendMessage Me.hWnd, msgItem
                clsBill.blnIsChanged = False
                cmdNext_Click
            End If
            Set clsLst = Nothing
'        Case 2, 5 'BAR
        Case 3  '复制单据
            clsBill.SaveBillToCollection
            MakeListEditMenu
            clsBill.SetAFocus
        Case 4  '粘贴单据
            clsBill.LoadBillFromCollection
            MakeListEditMenu
            clsBill.SetAFocus
        Case 6  '查询单据缺号
             frmBillNo.ShowTypeID C2lng(lblHead(2).Tag) 'ReceiptTypeID
            If clsBill.lngNowID > 0 Then
                lblField(1).Caption = GetReceiptNo(99, clsBill.lngNowID)
            End If
            clsBill.SetAFocus
        Case 7  '模板表体列宽恢复
            ModifyColWidthDefault Me
            clsBill.TemplateChange C2lng(lblHead(4).Tag)
            clsBill.SetAFocus
        Case 9 '筛选
            mclsMainControl_EditFilter
        Case 10 'LIST
            mclsMainControl_ReceiptList
        Case 11 'go
            mclsMainControl_ReceiptPosition
        Case 12
            mclsMainControl_FilePrintReceipt
    End Select
End Sub

Private Sub refTmpID_Change()
    clsBill.TemplateChange C2lng(lblHead(4).Tag)
End Sub



' 编辑菜单
Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    
    clsBill.UpdateMainEditMenu
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
                
        Load .mnuListEditMenu(1)
        Load .mnuListEditMenu(2)
        Load .mnuListEditMenu(3)
        Load .mnuListEditMenu(4)
        Load .mnuListEditMenu(5)
        Load .mnuListEditMenu(6)
        Load .mnuListEditMenu(7)
        Load .mnuListEditMenu(8)
        Load .mnuListEditMenu(9)
        Load .mnuListEditMenu(10)
        Load .mnuListEditMenu(11)
        Load .mnuListEditMenu(12)
        .mnuListEditMenu(12).Caption = "成批打印(&Y)"        '
        .mnuListEditMenu(12).Enabled = True
        
        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(0)
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(1)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(2)
'        .mnuListEditMenu(3).Caption = "复制拆卸组装单"
'        .mnuListEditMenu(4).Caption = "粘贴拆卸组装单"
'        .mnuListEditMenu(4).Enabled = True
        Utility.CloneMenu .mnuEditCopy, .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditPaste, .mnuListEditMenu(4)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(8)
        .mnuListEditMenu(8).Visible = True
        
        .mnuEditCut.Enabled = True
        .mnuListEditMenu(3).Caption = "复制单据(&C)"
        .mnuListEditMenu(4).Caption = "粘贴单据(&P)"
        .mnuListEditMenu(3).Visible = True
        .mnuListEditMenu(4).Visible = True
        If GrdCol.Rows >= 2 Then
            .mnuListEditMenu(3).Enabled = True
        Else
            .mnuListEditMenu(3).Enabled = False
        End If
        If clsBill.CollectionNotEmpty = False Then
            .mnuListEditMenu(4).Enabled = False
        ElseIf chkPrint(1).Value <> 1 And clsBill.blnMayDelete Then
            .mnuListEditMenu(4).Enabled = True
        Else
            .mnuListEditMenu(4).Enabled = False
        End If
        
        
        
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(5)
        .mnuListEditMenu(6).Caption = "编号查询及整理(&Q)"
        .mnuListEditMenu(6).Enabled = True
        .mnuListEditMenu(7).Caption = "单据模板表体列宽恢复(&W)"
        .mnuListEditMenu(7).Enabled = True
        
        .mnuListEditMenu(9).Caption = "筛选(&F)"        '
        .mnuListEditMenu(9).Enabled = True
        .mnuListEditMenu(10).Caption = "单据列表(&L)"        '
        .mnuListEditMenu(10).Enabled = True
        .mnuListEditMenu(11).Caption = "单据定位(&B)"        '