frmin_kmyetz.frm

一个用VB写的财务软件源码

      _StockProps     =   0
   End
   Begin VB.Label lblBeginDate 
      AutoSize        =   -1  'True
      Caption         =   "12/05/00"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   180
      Left            =   1170
      TabIndex        =   5
      Top             =   660
      Width           =   855
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "期初："
      ForeColor       =   &H00FF0000&
      Height          =   180
      Left            =   450
      TabIndex        =   4
      Top             =   660
      Width           =   540
   End
   Begin VB.Shape Shape1 
      BackStyle       =   1  'Opaque
      Height          =   150
      Left            =   3870
      Top             =   705
      Width           =   195
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "明细科目"
      Height          =   180
      Left            =   4170
      TabIndex        =   3
      Top             =   690
      Width           =   720
   End
   Begin VB.Shape Shape2 
      BackColor       =   &H00F3F5FA&
      BackStyle       =   1  'Opaque
      Height          =   150
      Left            =   5610
      Top             =   705
      Width           =   195
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "汇总科目"
      Height          =   180
      Left            =   5955
      TabIndex        =   2
      Top             =   690
      Width           =   720
   End
   Begin VB.Shape Shape3 
      BackColor       =   &H00FFFFFF&
      BackStyle       =   1  'Opaque
      Height          =   150
      Left            =   7110
      Top             =   705
      Width           =   195
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "辅助核算科目"
      Height          =   180
      Left            =   7410
      TabIndex        =   1
      Top             =   690
      Width           =   1080
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuPrint 
         Caption         =   "打印(&P)"
         Shortcut        =   ^P
      End
      Begin VB.Menu mnuPreview 
         Caption         =   "打印预览(&P)"
      End
      Begin VB.Menu mnuDiv1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出(&X)"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu mnuFind 
         Caption         =   "查找(&F)"
         Shortcut        =   ^F
      End
      Begin VB.Menu mnuSave 
         Caption         =   "保存(&S)"
         Shortcut        =   ^S
      End
      Begin VB.Menu mnuDiv3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuDirect 
         Caption         =   "更改科目方向(&D)"
      End
      Begin VB.Menu mnuCalc 
         Caption         =   "平衡试算(&C)"
      End
   End
   Begin VB.Menu mnuLookup 
      Caption         =   "查看(&L)"
      Begin VB.Menu mnuTotal 
         Caption         =   "总账(&T)"
         Shortcut        =   ^T
      End
      Begin VB.Menu mnuDetail 
         Caption         =   "明细(&A)"
         Shortcut        =   ^A
      End
      Begin VB.Menu mnuDiv2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuaMount 
         Caption         =   "数量(&M)"
         Shortcut        =   ^M
      End
      Begin VB.Menu mnuForing 
         Caption         =   "外币(&F)"
      End
      Begin VB.Menu mnuMoney 
         Caption         =   "金额(&O)"
         Shortcut        =   ^O
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpTheme 
         Caption         =   "帮助主题(&H)"
      End
   End
End
Attribute VB_Name = "frmIN_Kmyetz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=============================changjh edit 2003.2======================
Option Explicit
Private Type colUDT '所在的列数、宽度
        iCol As Integer
        iWidth As Integer
End Type

Private Const lMxKmColor As Long = vbWhite  '明细科目颜色
Private Const lHzKmColor As Long = &HE4FEFC                '汇总科目颜色
Private Const lFzKmColor As Long = &HF4ECEA            '辅助核算科目颜色

Private Const iDataBgxColor As Long = &HE7CBCC    '数据边框颜色
Private Const lFxColColor As Long = vbWhite     '方向列颜色
Private Const lQcColColor As Long = &HE4FEFC      '期初列颜色
Private Const lFixRowColor As Long = &HC0C0C0    '固定行颜色
Private Const lFixColColor As Long = vbWhite '     '固定列颜色
Private Const lReadonlyColor As Long = vbWhite '只读颜色
Private Const lDefaultColor As Long = vbWhite

Private Const lRowHeight As Long = 18 '行高

Private Const iDataCols As Integer = 14 '数据列数
Private iDataRows As Integer  '数据行数
Private Const iFixRows As Integer = 1 '固定行数
Private Const iFixCols As Integer = 3 '固定列数

Private uSlWbLxCol As colUDT '数量、外币类型列
Private uKmdmCol As colUDT '科目代码列
Private uKmmcCol As colUDT '科目代名称
Private uFxCol As colUDT '方向
Private uNcSlCol As colUDT  '年初列
Private uNcWbCol As colUDT
Private uNcJeCol As colUDT
Private uLjJslCol As colUDT  '累计借列
Private uLjJwbCol As colUDT
Private uLjJjeCol As colUDT
Private uLjDslCol As colUDT  '累计量列
Private uLjDwbCol As colUDT
Private uLjDjeCol As colUDT
Private uQcSlCol As colUDT  '期初列
Private uQcWbCol As colUDT
Private uQcJeCol As colUDT
'Private uFzhshCol As ColUDT '辅助核算号
'Private uIsEndKMCol As ColUDT '是否末级科目

Private arrSlWb() As String
Private arrKmdm() As String '科目代码
Private arrKmmc() As String '科目名称
Private arrFx() As String '科目方向
Private arrIsEndKM() As Boolean '是否末级科目

Private sXgFlagMuster As String '被修改行的集合
Private sBeginMonth As String               '当前使用年份的期初月份
Private Loading As Boolean                  '是否在窗体引导状态
Private QcYue As String                     '当年年度的期初月
Private bReadOnly As Boolean                ' 是否允许修改标志，为True则不允许修改，为False则可修改状态
Private bSlFlag As Boolean '是否有数量
Private bWbFlag As Boolean '是否有外币
Private iSlWbJeOperate As Integer '1=数量 2=外币 3=金额
Private iZzMxOperate As Integer '1=总账 2=明细


Private Sub cllBalance_AllowEditCell(ByVal col As Long, ByVal row As Long, approve As Long)
'Dim d As Double
'    If (col = uNcWbCol.iCol Or col = uLjJwbCol.iCol Or col = uLjDwbCol.iCol) And row >= iFixRows + 1 Then
'            d = pWbRowValid(sBeginMonth, arrKmdm(row))
'            If d = 0 Then
'               cllBalance.SetCellNote col, row, 0, 0
'               approve = 0
'               Exit Sub '检查有没有录入外币汇率
'            Else
'                cllBalance.SetCellNote col, row, 0, d
'            End If
'    End If
End Sub

'========================================== 窗体装载模块 ====================
'==============装载窗体========================
Private Sub form_load()
    Loading = True '表示在加载窗体
    MousePointer = vbHourglass
    InitVariable '初始化变量
    InitCllControl '初始化控件
    If InitLoadDataToCll Then MsgBox "服务器不可连接或数据加载错误！", vbCritical '装载数据到cll
    InitGIUControl '控制按钮显示
    Call pReCll '控制cll显示
    MousePointer = vbDefault
    Loading = False '表示加载窗体完毕
    cllBalance.SetModified 0 '当前修改标志清空
End Sub

'==============================='初始化变量============
Private Sub InitVariable()
Dim rSt As New ADODB.Recordset
sBeginMonth = 0
GetAllowMonth sBeginMonth, 0 '取得当前操作年份开始使用月
If sBeginMonth = -1 Then
   MsgBox "注册年份不能小于账套启用年份！", vbExclamation, "提示！": Unload Me: Exit Sub
End If
QcYue = IIf(sBeginMonth = "1", "00", Format(CStr(Val(sBeginMonth) - 1), "00")) '期初月
' 判断期初月是否有结账的凭证，如有，则不允许修改期初数据！
bReadOnly = False
With rSt
    .Open "SELECT count(*) FROM tZW_pzsj" & glo.sOperateYear & _
            " WHERE xgbz='2' AND kjqj = " & Val(sBeginMonth), _
            glo.cnnMain, adOpenStatic, adLockOptimistic
    If .Fields(0).value > 0 Then
        bReadOnly = True
    End If
    .Close
    Set rSt = Nothing
End With
sXgFlagMuster = "," '致方向没有被修改

iSlWbJeOperate = 3 '金额
iZzMxOperate = 2 '明细
bSlFlag = False '默认没有数量
bWbFlag = False '默认没有金额

uSlWbLxCol.iCol = 1: uSlWbLxCol.iWidth = 50 '初始化列所在的位置
uKmdmCol.iCol = 2: uKmdmCol.iWidth = 100
uKmmcCol.iCol = 3: uKmmcCol.iWidth = 120
uFxCol.iCol = 4: uFxCol.iWidth = 50
uNcSlCol.iCol = 5: uNcSlCol.iWidth = 120
uNcWbCol.iCol = 6: uNcWbCol.iWidth = 120
uNcJeCol.iCol = 7: uNcJeCol.iWidth = 120
uLjJslCol.iCol = 8: uLjJslCol.iWidth = 120
uLjJwbCol.iCol = 9: uLjJwbCol.iWidth = 120
uLjJjeCol.iCol = 10: uLjJjeCol.iWidth = 120
uLjDslCol.iCol = 11: uLjDslCol.iWidth = 120
uLjDwbCol.iCol = 12: uLjDwbCol.iWidth = 120
uLjDjeCol.iCol = 13: uLjDjeCol.iWidth = 120
uQcSlCol.iCol = 14: uQcSlCol.iWidth = 120
uQcWbCol.iCol = 15: uQcWbCol.iWidth = 120
uQcJeCol.iCol = 16: uQcJeCol.iWidth = 120
'uFzhshCol.iCol = 17: uFzhshCol.iWidth = 50
'uIsEndKMCol.iCol = 18: uIsEndKMCol.iWidth = 50
End Sub