VB开发的ERP系统

      End
   End
   Begin VB.Label lbl_TitleMess 
      BackStyle       =   0  'Transparent
      Caption         =   "月份:"
      Height          =   225
      Index           =   0
      Left            =   180
      TabIndex        =   9
      Top             =   1080
      Width           =   465
   End
   Begin VB.Label lbl_TitleText 
      BackStyle       =   0  'Transparent
      Caption         =   "Label2"
      Height          =   225
      Index           =   0
      Left            =   690
      TabIndex        =   8
      Top             =   1080
      Width           =   1305
   End
   Begin VB.Label Lab_OperStatus 
      BackColor       =   &H000080FF&
      Caption         =   "1"
      Height          =   345
      Left            =   4080
      TabIndex        =   5
      Top             =   600
      Visible         =   0   'False
      Width           =   345
   End
   Begin VB.Label Lab_Djclzt 
      BackColor       =   &H0000FFFF&
      Caption         =   "1"
      ForeColor       =   &H00808080&
      Height          =   255
      Left            =   3810
      TabIndex        =   4
      Top             =   570
      Visible         =   0   'False
      Width           =   285
   End
   Begin VB.Label Lbl_TsLabel 
      AutoSize        =   -1  'True
      BackColor       =   &H80000018&
      BackStyle       =   0  'Transparent
      Caption         =   "全月平均单价"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   285
      Index           =   0
      Left            =   4560
      TabIndex        =   1
      Top             =   870
      Width           =   1800
   End
End
Attribute VB_Name = "CL_MonthAveragePrice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'********************************************************
'*     隐藏列值说明                                     *
'*           0-*号         1-主表ID     2-子表ID        *
'********************************************************
'*
'*****************************************************************************************
'*    模 块 名 称 :全月平均单价
'*
'*    功 能 描 述 :此功能模块主要完成全月平均单价修改、预览、打印等。
'*
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'*
'*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
'*
'*    2.Lab_OperStatus =1 (网格不可编辑)
'*
'*
'*    3.原则:只要单据能够存盘(无论修改或新增)则其必须接受完整性及有效性规则检查
'*
'****************************************************************************************
 
 '[以下为根据实际情况设置变量bfy
    Dim mQuery_cond As String
    Dim Save_Flag As Boolean                          '平均单价保存标记
    Dim Jsqte%                                        '临时计数器
  
 '**************************bfy]
 
 '以下为固定使用变量(网格)
    Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
    Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
    Dim GridCode As String                          '显示网格网格代码
    Dim GridInf() As Variant                        '整个网格设置信息
    Dim ReportTitle As String                       '报表主标题
    Dim Tsxx As String                              '系统提示信息
    Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
    Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
    Dim Sfxshjwg As Boolean                         '是否显示合计网格
    Dim Qslz As Long                                '网格隐藏(非操作显示)列数
    Dim Sjhgd As Double                             '网格数据行高度
    Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
    Dim GridStr()  As String                        '网格列信息(字符型)
    Dim GridInt() As Integer                        '网格列信息(整型)
    Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
    Dim Dqlrwgh As Long                             '当前录入数据网格行
    Dim Dqlrwgl As Long                             '当前录入数据网格列
    Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
    Dim Dqlkwgl As Long                             '刚刚离开网格列
    Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
    Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
    Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
    Dim Wbkbhlock As Boolean                        '文本框改变值锁
    Dim Changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
    Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
    Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
    Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
    Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
    Dim Shsfts As Boolean                           '删除记录行是否提示
    Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
    
 '以下为固定使用变量(文本框)
    Dim Textvar() As Variant                        '存储变体型文本框信息
    Dim Textboolean() As Boolean                    '存储布尔型文本框信息
    Dim Textint() As Integer                        '存储整型文本框信息
    Dim Textstr() As String                         '存储字符型文本框信息
    Dim Max_Text_Index As Integer                   '最大录入文本框索引值
    Dim TextGroupCode As String                     '文本框录入分组编码
    Dim TextValiLock As Boolean                     '文本框失去焦点是否进行有效性控制判断
    Dim TextValiJudgeLock() As Boolean              '文本框录入有效性判断控制锁
    Dim TextChangeLock As Boolean                   '文本框内容变换控制锁
    Dim Bln_Cancel As Boolean                       '取消按钮信息传递


Private Sub Form_Load()                              '窗 体 装 入
    
    Save_Flag = False
  
    '初始化各种锁值
    Changelock = False             '网格行列改变控制锁
    Gdtlock = False                '滚动条滚动控制
    Yxxpdlock = True               '字段有效性判断锁
    Hyxxpdlock = True              '行有效性判断锁
    Wbkbhlock = False              '文本框内容改变锁
    
    
    '报表主标题及报表编码
    ReportTitle = "全月平均单价"
    XtReportCode = "Chhs_MonthAveragePrice"
    Load Dyymctbl
    
    '调 入 网 格
    GridCode = "Chhs_MonthAveragePrice"          '网格属性编码
    Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Pmbcsjhs = GridInf(3)
    Fzxwghs = GridInf(4)
    Sfblbzkd = GridInf(5)
    Shsfts = GridInf(6)
    Sfxshjwg = GridInf(7)
    Szzls = WglrGrid.Cols - 1
    
    '当前会计月
    Lbl_TitleText(0) = CStr(Xtyear) + "." + CStr(PGNowmon)
 
End Sub

Private Sub Form_Unload(Cancel As Integer)           '窗体卸载

    Dim Msg As Integer

    If Not Save_Flag Then
        Call Delete_AvgPrice
    End If

   '卸载打印页面窗体
   Unload Dyymctbl
   
End Sub


Private Sub Opt_Price_Click(Index As Integer)
    
    Timer1.Enabled = True
    
End Sub

Private Sub Timer1_Timer()                           '根据不同凭证或单据状态处理不同的数据初始化

    '关闭定时器
    Timer1.Enabled = False
     
    Lab_OperStatus = "2"
    
    WglrGrid.Redraw = False
    
    '调入单据信息
    Call Sub_Query
    
    WglrGrid.Redraw = True
   
End Sub

Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
           
    '屏蔽文本框有效性判断
    Valilock = True
     
    '屏蔽网格失去焦点产生的有效性判断
    Changelock = True
     
    Select Case Button.Key
        Case "ymsz"                                          '页面设置
            Dyymctbl.Show 1
        Case "yl"                                            '预 览
            If Fun_Drfrmyxxpd Then Call bbyl(True)
        Case "dy"                                            '打 印
            If Fun_Drfrmyxxpd Then Call bbyl(False)
        Case "bc"                                            '保 存
            If Fun_Drfrmyxxpd Then Call Sub_SaveBill
        Case "bz"                                            '帮 助
          
        Case "fh"                                            '退 出
            Unload Me
    End Select
       
    '解 锁
    Valilock = False
    Changelock = False
        
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)     '支持热键操作

    Select Case KeyCode
        Case vbKeyF6          '保存
            If Tlb_Action.Buttons("bc").Enabled And Tlb_Action.Buttons("bc").Visible Then
                If Fun_Drfrmyxxpd Then Call Sub_SaveBill
            End If
        Case vbKeyEscape      '退出
            Unload Me
    End Select
    
End Sub

Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
 
    Dim xswbrr As String
 
    With WglrGrid
        Zdlrqnr = Trim(.Text)
        xswbrr = Trim(.Text)
    
        If GridBoolean(.Col, 3) Then   '列表框录入
    
            '填充列表框程序
        Else
            Wbkbhlock = True
       
            '====以下为用户自定义
            Ydtext.Text = xswbrr
            '====以上为用户自定义
         
            Wbkbhlock = False
            Ydtext.SelStart = Len(Ydtext.Text)
        End If
    End With
    
End Sub

Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long)        '录入数据字段有效性判断,同时进行字段录入事后处理
 
    Dim Str_JudgeText As String  '临时有效性判断字段内容
    Dim Coljsq As Long           '临时列计数器
  
    With WglrGrid
    
        '非录入状态有效性为合法
        If Yxxpdlock Or .Row < .FixedRows Then
            sjzdyxxpd = True
            Exit Function
        End If
 
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
        
        Select Case GridStr(Dqpdwgl, 1)
         
            '以下为自定义部分[
         
            Case "007"
                
                If Val(.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls))) <= 0 Then
                    Tsxx = "单价必须大于零!"
                    GoTo Lrcwcl
                End If
                    
                If Not .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = "" Then
                    If Not Val(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))) = 0 And Val(Str_JudgeText) <> 0 Then
                        .TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls)) = Format(Val(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))) * Val(Str_JudgeText), "####." + String(Xtjexsws, "0"))
                    Else
                        .TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls)) = ""
                    End If
                End If
                 
            '以上为自定义部分]
            
        End Select
                    
        '字段录入正确后为零字段清空
        Call Qkwlzd(Dqpdwgh, Dqpdwgl)
     
        '字段录入正确后进行数据合计
        sjzdyxxpd = True
        Yxxpdlock = True
        Exit Function
     
    End With
  
Lrcwcl:    '录入错误处理

    With WglrGrid
        Call Xtxxts(Tsxx, 0, 1)
        Changelock = True
        .Select Dqpdwgh, Dqpdwgl
        Changelock = False
        Call xswbk
        sjzdyxxpd = False
        Exit Function
    End With
    
End Function

Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
 
    Dim Lrywlz As Long
    Dim Rectemp As Recordset
    Dim Yxrow As Long
    
    With WglrGrid
        If Yxxpdh > (.Rows - .FixedRows) Then Exit Function
        If .TextMatrix(Yxxpdh, 0) <> "*" Then
            Sjhzyxxpd = True
            Exit Function
        Else
            If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
                If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
                    Changelock = True
                    .RemoveItem Yxxpdh
                    Changelock = False
                    Sjhzyxxpd = True
                    Exit Function