ʰ

VB开发的ERP系统

      FrozenRows      =   0
      FrozenCols      =   0
      AllowUserFreezing=   0
      BackColorFrozen =   0
      ForeColorFrozen =   0
      WallPaperAlignment=   9
      AccessibleName  =   ""
      AccessibleDescription=   ""
      AccessibleValue =   ""
      AccessibleRole  =   24
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Height          =   180
      Index           =   2
      Left            =   6150
      TabIndex        =   25
      Top             =   750
      Width           =   90
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Height          =   180
      Index           =   1
      Left            =   1380
      TabIndex        =   24
      Top             =   735
      Width           =   90
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "启用日期:"
      Height          =   180
      Left            =   5250
      TabIndex        =   2
      Top             =   750
      Width           =   810
   End
   Begin VB.Label Label3 
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Label3"
      Height          =   15
      Index           =   5
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   7545
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "银行科目:"
      Height          =   180
      Index           =   0
      Left            =   510
      TabIndex        =   0
      Top             =   735
      Width           =   810
   End
End
Attribute VB_Name = "YH_FrmQcsj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************************************************
'*    模 块 名 称 :期初数据录入
'*    功 能 描 述 :此功能模块主要完成银行对帐功能的期初数据录入
'*    程序员姓名  :xjl
'*    最后修改人  :xjl
'*    最后修改时间:2001/07/13
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'*
'*********************************************************************************************************
'自定义部分
Dim RecTemp As New ADODB.Recordset              '临时记录集
Public Str_RightEdit As String                  '编辑权限索引
 
'以下为固定使用变量(网格)
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 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 TextValiJudgeLock() As Boolean              '文本框录入有效性判断控制锁
Dim TextChangeLock As Boolean                   '文本框内容变换控制锁
'对帐单未达帐项
Private Sub Command1_Click()
    YH_FrmYhqc.HelpContextID = "0115001"
    YH_FrmYhqc.Show 1
    Call bcsj
    Call XSSJ
    Call Sub_ShowBill
End Sub

'日记帐未达帐项
Private Sub Command2_Click()
    YH_FrmDwqc.HelpContextID = "0115001"
    YH_FrmDwqc.Show 1
    Call bcsj
    Call XSSJ
    Call Sub_ShowBill
End Sub

'设置启用日期
Private Sub Command3_Click()
    XT_calendar.Show 1
    '求帐套日期
    Sqlstr = " Select qsrq From Gy_kjrlb where beginflag='1'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Not RecTemp.EOF Then
        If Xtfhcs < Format(RecTemp(0), "yyyy-mm-dd") Then
            MsgBox "启用日期不能小于帐套日期", 16, "提示："
            Call Command3_Click
        Else
            Label2(2).Caption = Format(Xtfhcs, "yyyy年mm月dd日")
            Label2(2).Tag = Xtfhcsfz
        End If
    Else
        Label2(2).Caption = Format(Xtfhcs, "yyyy年mm月dd日")
        Label2(2).Tag = Xtfhcsfz
    End If
End Sub

'调入窗体
Sub Form_Load()
    '显示银行科目
    Label2(1).Caption = YH_FrmXzkm.Combo1.Text
    '隐藏选择对话框
    YH_FrmXzkm.Hide
    
    '定义可变部分变量
    ReportTitle = "银行期初余额调节表"
    '调入打印页面设置窗体
    XtReportCode = "cwzz_yhqcdy"
    Load Dyymctbl
    
    '以下为文本框处理程序
    TextGroupCode = "cwzz_yhdzqc"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
    Call Wbkcsh
    
    '调 入 网 格
    GridCode = "cwzz_yhqcdy"          '网格属性编码
    Call BzWgcsh(CxbbGrid, 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 = CxbbGrid.Cols - 1
    If RecTemp.State = 1 Then RecTemp.Close
    Sqlstr = " Select qsrq From Gy_kjrlb where beginflag='1'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Not RecTemp.EOF Then
        Label2(2).Caption = Format(Xtfhcs, "yyyy年mm月dd日")
    Else
        Label2(2).Caption = Format(Now, "yyyy年mm月dd日")
    End If
    '显示文本框所有数据和启用日期
    Call XSSJ
    '显示网格数据
    Call Sub_ShowBill
    
    Str_RightEdit = "Cwzz_yhdzqc_Edit"
            
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
        LrText(0).Enabled = False
        LrText(4).Enabled = False
    End If
    
End Sub

'退出
Private Sub Form_Unload(Cancel As Integer)
    Unload YH_FrmXzkm
    Call bcsj
    Glo_Variable.Unload_TF = True
End Sub

'单击功能工具栏
Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
    Case "ymsz"                              '页面设置
        Dyymctbl.Show 1
    Case "yl"                                '预 览
        Call bbyl(True)
    Case "dy"                                '打 印
        Call bbyl(False)
    Case "fh"                                '退出
        Call bcsj
        Unload Me
    Case "bz"
        Call F1bz
    Case "Select"                            '选择
        Call bcsj
        Glo_Variable.Unload_TF = False
        YH_FrmXzkm.HelpContextID = "0115001"
        YH_FrmXzkm.Show 1
    End Select
End Sub

'************以下为文本框录入处理程序(固定不变部分)*************'
Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
    '以下为依据实际情况自定义部分[
    '在此填写文本框录入事后处理程序
    TextChangeLock = True
    LrText(3) = Val(Format(LrText(0), "0.00")) + Val(Format(LrText(1), "0.00")) - Val(Format(LrText(2), "0.00"))
    LrText(7) = Val(Format(LrText(4), "0.00")) + Val(Format(LrText(5), "0.00")) - Val(Format(LrText(6), "0.00"))
    LrText(Index) = Format(LrText(Index), "#,###.00")
    LrText(3) = Format(LrText(3), "#,###.00")
    LrText(7) = Format(LrText(7), "#,###.00")
    TextChangeLock = False
    ']以上为依据实际情况自定义部分
End Sub

'文本框发生改变
Private Sub LrText_Change(Index As Integer)
    '屏蔽程序改变控制
    If TextChangeLock Then
        Exit Sub
    End If
    TextValiJudgeLock(Index) = False    '打开有效性判断锁
    '限制字段录入长度
    TextChangeLock = True  '加锁(防止执行Lrtext_Change)
    Select Case Textint(Index, 1)
    Case 8           '金额型
        Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
    Case 9           '数量型
        Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
    Case 10          '单价型
        Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
    Case Else        '其他小数类型控制
        If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
            Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
        End If
    End Select
    TextChangeLock = False '解锁
End Sub

'文本框得到焦点,显示相应信息
Private Sub LrText_GotFocus(Index As Integer)
    Call TextShow(Index)
    CurTextIndex = Index
    LrText(Index).SelStart = Len(LrText(Index))
End Sub

'字段按F2键提供帮助
Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case vbKeyF2
        Call Text_Help(Index)
    End Select
End Sub

'文本框录入事中控制(限制录入某些数据)
Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)
    Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
End Sub

'文本框失去焦点进行有效性判断及相应处理
Private Sub LrText_LostFocus(Index As Integer)
    If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
        Call TextYxxpd(Index)
    End If
    Call Wbklrwbcl(Index)
    Call Sub_ShowBill
End Sub

'录入字段帮助
Private Sub Text_Help(Index As Integer)