frmvoucher.frm

金算盘软件代码

   Begin VB.Label lblFu 
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      Caption         =   "张"
      Height          =   180
      Left            =   7410
      TabIndex        =   29
      Top             =   1200
      Width           =   150
   End
   Begin VB.Label lblFieldCaption 
      BackColor       =   &H80000005&
      Caption         =   "凭证字号"
      ForeColor       =   &H80000007&
      Height          =   270
      Index           =   0
      Left            =   240
      TabIndex        =   23
      Top             =   1260
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.Label lblField 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Index           =   0
      Left            =   1020
      TabIndex        =   22
      Top             =   1230
      Visible         =   0   'False
      Width           =   675
   End
   Begin VB.Label lblCaption 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "记帐凭证"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   18
         Charset         =   134
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00004000&
      Height          =   360
      Left            =   3570
      TabIndex        =   21
      Top             =   540
      Width           =   1440
   End
   Begin VB.Label lblHead 
      BackColor       =   &H80000004&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "手工录入"
      Height          =   225
      Index           =   1
      Left            =   960
      TabIndex        =   27
      Tag             =   "0"
      Top             =   120
      Width           =   780
   End
   Begin VB.Label lblHead 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "凭证来源"
      Height          =   180
      Index           =   0
      Left            =   180
      TabIndex        =   19
      Tag             =   "0"
      Top             =   135
      Width           =   720
   End
   Begin VB.Label lblHead 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "模板(&D)"
      ForeColor       =   &H80000008&
      Height          =   180
      Index           =   2
      Left            =   5520
      TabIndex        =   20
      Tag             =   "2"
      Top             =   120
      Width           =   630
   End
   Begin VB.Label lblHead 
      BackColor       =   &H80000009&
      BorderStyle     =   1  'Fixed Single
      Height          =   315
      Index           =   3
      Left            =   6210
      TabIndex        =   28
      Tag             =   "2"
      Top             =   60
      Width           =   1860
   End
   Begin VB.Label LblBack 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   5400
      Left            =   180
      TabIndex        =   0
      Top             =   450
      Width           =   7995
   End
End
Attribute VB_Name = "FrmVoucher"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-----------------------------------------
'记帐凭证
'作者：蔡奇科
'时间：1998年6月
'-----------------------------------------
'        intI = 0 '明细ID
'        intI = 1 '摘要
'        intI = 2 '科目名称
'        intI = 3 '原币币种名称（实际存于25列）
'        intI = 4 '本币借方金额（实际存于26列）
'        intI = 5 '本币贷方金额（实际存于27列）
'        intI = 6 '汇率
'        intI = 7 '数量
'        intI = 8 '原币单价,
'        intI = 9 '原币金额
'        intI = 10 '单位名称
'        intI = 11 '部门名称
'        intI = 12 '员工名称
'        intI = 13 '工程名称
'        intI = 14 '统计名称
'        intI = 15 '项目名称
'        intI = 16 '科目ID
'        intI = 17 '币种ID
'        intI = 18 '单位ID
'        intI = 19 '部门ID
'        intI = 20 '员工ID
'        intI = 21 '工程ID
'        intI = 22 '统计ID
'        intI = 23 '项目ID
'        intI = 24 '借贷方向
'        intI = 25 '币种名称
'        intI = 26 '借方金额
'        intI = 27 '贷方金额
'        intI = 28 '票据号
'        intI = 29 '付款方式
'        intI = 30 '付款方式ID
'        intI = 31 '现金流量项目
Option Explicit

Const ReceiptTypeID = 17 '记帐凭证单据ID
Const FixedCols = 1      'GRID固定列数
Const intCaptionHeight = 195 'FIELD按纽标题高度
Const intField0width = 2500 'FIELD按纽标题高度
Const intFieldHeight = 270 'FIELD按纽输入框高度
Const intButtonWidth = 255 '下拉按纽宽度
Const CaptionBackColor = &H800000    'FIELD控件标题背景色
Const BackGroundColor = &HC0FFFF     '底板背景色
Const SeparateLineColor = &H808080   'GRID列分隔线色
Const lngDefaultWidth = 8600  'Min 8600
#If conWan = 1 Then
    Const lngDefaultHeight = 5880 'Min 5600
#Else
    Const lngDefaultHeight = 5745 'Min 5600
#End If

Dim IntSpace As Long         '粘贴控件之间距
Dim SPACETWIPS As Long    '单据头控件之列距
Dim SpaceTwRow As Long    '单据头控件之行距
Dim ColBill As New Collection   '单据内容集合(不包括VoucherID和DetailID)
Dim WithEvents mclsSubClass As SubClass32.SubClass  'Grid回调函数对象
Attribute mclsSubClass.VB_VarHelpID = -1
Dim WithEvents mclsPicFooter As SubClass32.SubClass  'picFooter回调函数对象
Attribute mclsPicFooter.VB_VarHelpID = -1
Dim WithEvents mclsHook As SubClass32.SubClass      '窗体回调函数对象
Attribute mclsHook.VB_VarHelpID = -1
Dim WithEvents KeyPressHook As Hook
Attribute KeyPressHook.VB_VarHelpID = -1
Dim WithEvents mclsMainControl As MainControl       '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Dim ctrInput As Object            '通用输入控件
Dim ctrPicInput As Object         '列表输入为PIC方式时的输入控件
Dim clsLstVoucher As clsVoucherMethod
Dim clsRed As RecordClass

Dim My As clsBillMark           '自定义标志类对象
Dim Field() As ClassField        '表头输入控件的附加属性
Dim strColRow() As String       '单据体行复制/粘贴存储区
Dim PicLbl() As ClassPicInputField        'PIC输入时的附加属性
Dim ColProperty() As ClassGridProperty    'GRID附加属性
Dim blnMark As AccountblnOther
Dim frmColor As FormColor
Dim FormClipRect As RECT
Dim GridClipRect As RECT
Dim intGrdBorderWidth As Long
Dim intGrdBorderHeight As Long
Dim intTotalRowHeight As Integer
Dim ReceiptID As Long   '单据类型ID
Dim lngOldID As Long
Dim strOldText As String
Dim blnCanSave As Boolean
Dim blnBusy As Boolean
Dim intYesNoCancel As Integer
Dim blnReturn As Boolean
Dim blnDoAccVolid As Boolean
Dim blnFirstIn As Boolean    '通过新增修改进入标志
Dim blnOldCancel_Value  As Boolean      '刚进入时的冲销标志
Dim blnCanEvent_ChkCancel_Click As Boolean  '是否激活CLICK的过滤器
Dim blnIsAutoVoucher As Boolean     '是否为机制凭证
Dim lngOldHeight As Long        'GRID上次的行高
Dim lngBackColor As Long

Dim blnEdit As Boolean  '填制权限
Dim blnView As Boolean  '查询权限
Dim blnCheck As Boolean    '复核权限
Dim blnPost As Boolean     '记帐权限

Dim blnNotScroll As Boolean  ' 不触发msflexgrid SCROLL事件标志
Dim blnNotChkClick As Boolean  ' 不触发chechbox Click事件标志
Dim blnFirstToPic As Boolean  '从其它位置首次进入某列的PIC方式输入标志
Dim blnDrawBusy As Boolean
Dim blnKeyDown As Boolean
Dim blnInProcess As Boolean
Dim strError As String
Dim lngPrintSetupID  As Long
Public blnPreViewVoucher  As Boolean  '预演标志
Dim lngSourceVoucherID As Long '冲销凭证的来源凭证ID
Dim strCancelDate As String    '冲销凭证的来源凭证日期
Dim lngPostID As Long  '记帐ID
Dim lngCheckID As Long '复核ID
Dim blnCashLine As Boolean
Dim blnSound As Boolean
Dim blnAlert As Boolean
Dim lngOldFixVoucherID As Long '原凭证ID
Dim lngOldType As Long '原字号ID
Dim lngOldNo As Long   '原凭证号
Dim intOldYear As Integer   '原年度
Dim bytOldPeriod As Long   '原期间
Dim lngOldVoucherType As Long '原凭证类型的类型（受付转）
Dim blnUnLoadMark As Boolean   '可UNLOAD标志
Dim blnEntercellIsDoing As Boolean   'Entercell正在处理标志
Dim blnAccountIsChange As Boolean   '科目表已改变
Dim blnIsLoading As Boolean '正在引入数据标志,同时用于设置是否响应按键消息（TRUE时不响应）

Dim lngVoucherTypeType As Long '凭证类型的类型（受付转）
Dim blnReadOnly As Boolean '  单据只读标志
Dim lngRowPosition As Boolean '  GRDCOL 当前行状态，0---中间，1--首行，2----尾行，3---首尾
Dim blnAltPressDown As Boolean '  alt状态
Dim lngOneTextWidth As Long '一个字的显示宽度（TWIPS）
Dim blnPaint As Boolean '
Dim blnNoPaint As Boolean '
Dim blnScroll As Boolean '
Private blnPrinted As Boolean '已打印标志
Dim VP As VoucherProperty
Dim blnMouseDown As Boolean
Dim blnNoShowMsg As Boolean
Dim blnCanUseCash As Boolean '现金流量权限
Dim blnWhereIn As Boolean    '进入口，FALSE--新单  TRUE--旧单
Private Type RowProperty
   strCol(2) As String           'GRDCOL对应列
End Type
Dim Rows() As RowProperty    'GRID数据

Private Sub GrdAndLabelInitial()
'列表及LABEL控件初始化
    Dim intI As Integer
    '--------------------------
    '凭证只显示1--5列
    '--------------------------
    GrdCol.ColWidth(0) = 0
    If ColProperty(3).blnUsable = False Then
        GrdCol.ColWidth(1) = (GrdCol.width - 2 * Screen.TwipsPerPixelX) * (1 - 1 / 3) / 2
        GrdCol.ColWidth(2) = (GrdCol.width - 2 * Screen.TwipsPerPixelX) * (1 - 1 / 3) / 2
        GrdCol.ColWidth(3) = 0
        GrdCol.ColWidth(4) = (GrdCol.width - 2 * Screen.TwipsPerPixelX) / 6
        GrdCol.ColWidth(5) = (GrdCol.width - 2 * Screen.TwipsPerPixelX) / 6
    Else
        GrdCol.ColWidth(1) = (GrdCol.width - 2 * Screen.TwipsPerPixelX) / 4
        GrdCol.ColWidth(2) = (GrdCol.width - 2 * Screen.TwipsPerPixelX) / 4
        GrdCol.ColWidth(3) = (GrdCol.width - 2 * Screen.TwipsPerPixelX) / 6
        GrdCol.ColWidth(4) = (GrdCol.width - 2 * Screen.TwipsPerPixelX) / 6
        GrdCol.ColWidth(5) = (GrdCol.width - 2 * Screen.TwipsPerPixelX) / 6
    End If
    For intI = 1 To GrdCol.Cols - 1
        If intI <= 5 Then
            If ColProperty(intI).lngCtrType = tCurrency Then GrdCol.ColAlignment(intI) = 7
            GrdCol.FixedAlignment(intI) = 4
        Else
            GrdCol.ColWidth(intI) = 0
        End If
    Next intI
    
    
End Sub
Private Sub FieldButton()
 'fields控件位置调整
    Dim i As Integer
    Dim bln5RowIsVisible
    Dim lngSpaceUnderCaption As Long
    Dim lngSpaceUnderField As Long
    Dim lngUsabeHeight As Long
    Dim lngWidthOfGrdRight As Long
    If WanNeng Then
        lngWidthOfGrdRight = 7 * Screen.TwipsPerPixelY + Me.TextWidth("a") * 4
    Else
        lngWidthOfGrdRight = 0
    End If
    
'    If Not Me.Visible Then Exit Sub
    On Error Resume Next
    intTotalRowHeight = 23 * Screen.TwipsPerPixelY
    lngSpaceUnderCaption = 12 * Screen.TwipsPerPixelY
    lngSpaceUnderField = 2 * Screen.TwipsPerPixelY
    
    If Me.WindowState = 1 Then Exit Sub
    If Me.width < lngDefaultWidth Then