frmnavigate2.frm

金算盘软件代码

Const m_MovingY     As Integer = -5            ''所有图标在Y轴上的偏移量
Const m_TableX      As Integer = 80           ''所有帐表在X轴上的偏移量
Const m_TableY      As Integer = 8            ''所有帐表在Y轴上的偏移量
Const m_BigTableY      As Integer = 86            ''所有大帐表在Y轴上的偏移量
Const m_BigTableX      As Integer = 134           ''所有大帐表在X轴上的偏移量
Const m_BigIntervalX   As Integer = 220          ''所有大帐表在X轴上的间隔量
Const m_BigIntervalY   As Integer = 23           ''所有大帐表在Y轴上的间隔量

Const m_BigTableX1      As Integer = 250           ''所有大帐表在X轴上的偏移量
Const m_BigTableY1      As Integer = 86            ''所有大帐表在Y轴上的偏移量
Const m_BigIntervalX1   As Integer = 170          ''所有大帐表在X轴上的间隔量
Const m_BigIntervalY1   As Integer = 23           ''所有大帐表在Y轴上的间隔量

Private temp            As Integer                ''临时变量
Private intMaxPage      As Integer                ''最大页号

''****************************************************************
Private m_ItemCount(Dimensions)          As Integer
Private m_page_0                         As Integer     ''保存第0页代号
Private m_page_1                         As Integer     ''保存第1页代号
Private m_page_2                         As Integer     ''保存第2页代号
Private m_page_3                         As Integer     ''保存第3页代号
Private m_page_4                         As Integer     ''保存第4页代号
Private m_page_5                         As Integer     ''保存第5页代号
Private m_page_6                         As Integer     ''保存第6页代号
Private m_page_7                         As Integer     ''保存第7页代号
Private m_page_8                         As Integer     ''保存第8页代号
Private m_page_9                         As Integer     ''保存第9页代号
Private m_page_10                         As Integer     ''保存第10页代号
Private m_page_11                         As Integer     ''保存第11页代号
Private m_page_12                         As Integer     ''保存第12页代号
Private m_page_13                         As Integer     ''保存第13页代号
Private m_page_14                         As Integer     ''保存第14页代号
Private m_page_15                         As Integer     ''保存第15页代号

Private Sub Form_Activate()
    mclsMainControl_ChildActive
End Sub

Private Sub Form_Load()
    Set x1 = New BaseFunction
    Set clsRes = New Res
    clsRes.ResourceFile = "acntres.dll"
    #If conPE = 1 Then
        frmMain.mnuWindowDiagram.Checked = True
    #Else
        frmMain.mnuWindowDiagram.Checked = True
    #End If
    m_lngBitMapHeight = 45
    m_lngBitMapWidth = 50

    ''******************************************************************
    Call InitArrange("")
    Call ClearPageInfo
    m_lngOldButton = 0
    
    m_no = -1
    Dim i As Integer
    For i = 0 To Dimensions
       m_ItemCount(i) = -2
    Next i
    m_page_0 = -2
    m_page_1 = -2
    m_page_2 = -2
    m_page_3 = -2
    m_page_4 = -2
    m_page_5 = -2
    m_page_6 = -2
    m_page_7 = -2
    m_page_8 = -2
    m_page_9 = -2
    m_page_10 = -2
    m_page_11 = -2
    m_page_12 = -2
    m_page_13 = -2
    m_page_14 = -2
    m_page_15 = -2
    
    intMaxPage = -1
    
    ''*******************************************************************
    
    InitPageInfo
    InitPageInfo0
    Initpageinfo1
    Me.BackColor = RGB(244, 235, 221)
    Me.picBackGround.Picture = Loadres1(1100, vbResBitmap)
    m_lngPageNo = 0
    m_lngSelectedItem = -1
    m_varSaveTime = time
    Set mHook = New Hook
    mHook.SetHook (0)
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
''******************************************************
End Sub


Private Sub Form_Resize()
  '  If Me.Height < 6000 Then
'        Me.ScaleHeight = 6120
'        Me.ScaleWidth = 9130
   ' End If
    Dim x As Single, y As Single
    On Error Resume Next
    x = Me.width - Me.ScaleWidth
    y = Me.Height - Me.ScaleHeight
    '386--高度象数点，600--宽度象数点。
    Me.Height = 386 * Screen.TwipsPerPixelY + y
    Me.width = 600 * Screen.TwipsPerPixelX + x
End Sub

Private Sub Form_Unload(Cancel As Integer)
   On Error Resume Next
   Set x1 = Nothing
   Set clsRes = Nothing
   gclsSys.MainControls.Remove Me
   
    #If conPE = 1 Then
        frmMain.mnuWindowDiagram.Checked = False
    #Else
        frmMain.mnuWindowDiagram.Checked = False
    #End If
   If gclsSys.MainControls.Count = 0 And Not gclsBase.BaseDB Is Nothing Then
      frmMain.tlbMain.Visible = True
   End If
   Set mHook = Nothing
End Sub

Private Sub mHook_OnMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, bCancel As Long)
    If Msg <> WM_TIMER Then
      m_lngTimeCount = 0
    End If
End Sub

Private Sub picBackGround_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

    Dim xPoint As Long
    Dim yPoint As Long
    Dim lngButton As Long
    Dim lngItem   As Long
    xPoint = x \ Screen.TwipsPerPixelX
    yPoint = y \ Screen.TwipsPerPixelY
    lngButton = GetButton(xPoint, yPoint)
    
    If m_lngPageNo >= 0 And m_lngSelectedItem >= 0 Then
       ''DoProc 执行过程调用
       Select Case m_lngPageNo
         ''*****************************************************************************************************************
         ''( 销售管理 )
         Case m_page_0
           Select Case m_lngSelectedItem
             Case 0  ''销售订单
               If frmMain.mnuTaskSaleOrder.Enabled Then
                  Me.Enabled = False
                  frmMain.mnuTaskSaleOrder_Click
                  Me.Enabled = True
               Else
                  MsgBox "没有使用" & m_udtPageInfo(m_lngPageNo).udtItem(m_lngSelectedItem).strDescript & "的权限！"
               End If
             Case 1  ''商品销售
               If frmMain.mnuTaskSale.Enabled Then
                  Me.Enabled = False
                  frmMain.mnuTaskSale_Click
                  Me.Enabled = True
               Else
                  MsgBox "没有使用" & m_udtPageInfo(m_lngPageNo).udtItem(m_lngSelectedItem).strDescript & "的权限！"
               End If
             Case 2  ''直运销售
               If frmMain.mnuTaskDirectSale.Enabled Then
                  Me.Enabled = False
                  frmMain.mnuTaskDirectSale_Click
                  Me.Enabled = True
               Else
                  MsgBox "没有使用" & m_udtPageInfo(m_lngPageNo).udtItem(m_lngSelectedItem).strDescript & "的权限！"
               End If
             Case 3  '分期出库
                If frmMain.mnuTaskStageOut.Enabled Then
                   Me.Enabled = False
                   frmMain.mnuTaskStageOut_Click
                   Me.Enabled = True
                Else
                  MsgBox "没有使用" & m_udtPageInfo(m_lngPageNo).udtItem(m_lngSelectedItem).strDescript & "的权限！"
                End If
             Case 4  ''委托出库
                If frmMain.mnuTaskLendOut.Enabled Then
                   Me.Enabled = False
                   frmMain.mnuTaskLendOut_Click
                   Me.Enabled = True
                Else
                   MsgBox "没有使用" & m_udtPageInfo(m_lngPageNo).udtItem(m_lngSelectedItem).strDescript & "的权限！"
                End If
             Case 5  ''委托调拨
                If frmMain.mnuTaskLendPosition.Enabled Then
                    Me.Enabled = False
                    frmMain.mnuTaskLendPosition_Click
                    Me.Enabled = True
                Else
                    MsgBox "没有使用" & m_udtPageInfo(m_lngPageNo).udtItem(m_lngSelectedItem).strDescript & "的权限！"
                End If
             Case 6  ''分期结算
                If frmMain.mnuTaskStageSale.Enabled Then
                   Me.Enabled = False
                   frmMain.mnuTaskStageSale_Click
                   Me.Enabled = True
                Else
                    MsgBox "没有使用" & m_udtPageInfo(m_lngPageNo).udtItem(m_lngSelectedItem).strDescript & "的权限！"
                End If
             Case 7  ''委托结算
                If frmMain.mnuTaskLendSale.Enabled Then
                   Me.Enabled = False
                   frmMain.mnuTaskLendSale_Click
                   Me.Enabled = True
                Else
                    MsgBox "没有使用" & m_udtPageInfo(m_lngPageNo).udtItem(m_lngSelectedItem).strDescript & "的权限！"
                End If
             Case 8  ''销售发票
                If IsCanDo(124, gclsBase.OperatorID) Then
                    Me.Enabled = False
                    frmMain.mnuTaskSaleInvoice_Click
                    Me.Enabled = True
                Else
                    MsgBox "没有使用" & m_udtPageInfo(m_lngPageNo).udtItem(m_lngSelectedItem).strDescript & "的权限！"
                End If
             Case 9  '销售凭证
                If IsCanDo(86, gclsBase.OperatorID) Then
                   
                    If Not gclsBase.PeriodClosed(gclsBase.BaseDate) Then
                        Me.Enabled = False
                        frmPurchaseSaleVoucher.SetManner ("销售业务")
                        frmPurchaseSaleVoucher.Show vbModal
                        Set frmPurchaseSaleVoucher = Nothing
                        Me.Enabled = True
                    Else
                        ShowMsg frmMain.hwnd, "本期已结帐，不能再制作凭证！", vbCritical + vbOKOnly, m_udtPageInfo(m_lngPageNo).udtItem(m_lngSelectedItem).strDescript
                    End If
                   
                Else
                    MsgBox "没有使用" & m_udtPageInfo(m_lngPageNo).udtItem(m_lngSelectedItem).strDescript & "的权限！"
                End If
                
             Case 10  '商品销售汇总表
                 Report.ShowSumReport 1595, 719
             Case 11  '直运销售汇总表
                Report.ShowSumReport 1601, 725
             Case 12  '委托代销结算汇总表
                Report.ShowSumReport 1613, 737
             Case 13 '分期收款发出商品结算汇总表
                Report.ShowSumReport 1605, 729
             Case 14  '销售订单执行情况表
                Report.ShowSumReport 1594, 718
             Case 15 '我的报表
                frmMain.ShowMyReport
             Case 16 ''单位编码
                If frmMain.mnuListCustomer.Enabled Then
                   Me.Enabled = False
                   frmMain.mnuListCustomer_Click
                   frmCustomerList.sstCustomer.Tab = 1
                   Me.Enabled = True
                Else
                    MsgBox "没有使用" & m_udtPageInfo(m_lngPageNo).udtItem(m_lngSelectedItem).strDescript & "的权限！"
                End If
             Case 17 ''部门编码
                If frmMain.mnuListDepartment.Enabled Then
                   Me.Enabled = False
                   Me.MousePointer = vbHourglass
'                   With frmEmployeeList
'                       .Show
'                       .sstDepEmp.Tab = 0
'                       .ZOrder 0
'                   End With
                   UserRight.CallShowList 0, msgDepartment