⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmultiaccountbook.frm

📁 金算盘软件代码
💻 FRM
📖 第 1 页 / 共 5 页
字号:
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin GACALENDARLibCtl.Calendar detEnd 
      Height          =   300
      Left            =   7350
      OleObjectBlob   =   "frmMultiAccountBook.frx":04D5
      TabIndex        =   10
      Top             =   465
      Width           =   1335
   End
   Begin ListRefer.ListText cmbType 
      Height          =   315
      Left            =   1140
      TabIndex        =   6
      Top             =   465
      Width           =   1695
      _ExtentX        =   2990
      _ExtentY        =   556
      Locked          =   -1  'True
      BackColor       =   -2147483643
      RMenu           =   "1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin ListRefer.ListText cmbDate 
      Height          =   315
      Left            =   3660
      TabIndex        =   8
      Top             =   450
      Width           =   1905
      _ExtentX        =   3360
      _ExtentY        =   556
      Locked          =   -1  'True
      BackColor       =   -2147483643
      RMenu           =   "1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin GACALENDARLibCtl.Calendar detBegin 
      Height          =   300
      Left            =   5790
      OleObjectBlob   =   "frmMultiAccountBook.frx":055E
      TabIndex        =   9
      Top             =   465
      Width           =   1335
   End
   Begin VB.Label lblFrom 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "从"
      Height          =   180
      Left            =   5595
      TabIndex        =   33
      Top             =   510
      Width           =   180
   End
   Begin VB.Label lblTo 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "到"
      Height          =   180
      Left            =   7155
      TabIndex        =   32
      Top             =   510
      Width           =   180
   End
   Begin VB.Label lblD 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "日期(&D)"
      Height          =   180
      Left            =   2925
      TabIndex        =   7
      Top             =   510
      Width           =   630
   End
   Begin VB.Label lblType 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "帐册类型(&Y)"
      Height          =   180
      Left            =   150
      TabIndex        =   5
      Top             =   510
      Width           =   990
   End
   Begin MSForms.CommandButton CmdPaper 
      Height          =   345
      Left            =   3900
      TabIndex        =   17
      Top             =   6540
      Width           =   1215
      Caption         =   "纸张"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin MSForms.CommandButton CmdZoom 
      Height          =   345
      Left            =   2670
      TabIndex        =   16
      Top             =   6540
      Width           =   1215
      Caption         =   "缩放"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin VB.Label lblHead 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "科目(&A)"
      Height          =   180
      Index           =   0
      Left            =   180
      TabIndex        =   11
      Top             =   900
      Visible         =   0   'False
      Width           =   630
   End
End
Attribute VB_Name = "frmMultiAccountBook"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

''''''''''''''''''''''''''''''''''''''''''''''''
'真实帐册窗体(多栏帐)
'
'Author    Hebing、魏 然    1998.7
'
' 子过程
'
'SetTitle           设置标题
'
'SetBookField       设置栏目
'
'SetCell            设置单元数据
'
'SetFreeCell        设置自由单元数据'
'
'''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private mblnChanged As Boolean
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private mclsMultiReportSet As MultiReportSet                    '帐表设置对象
Private mclsFormCond As FormCond                                '筛选条件类
Private mblnLoad As Boolean                                     '是否在初始数据
Private FixedCond As String
Private mlngCondType As Long

Private mintAmountBanCol As Integer                             '金额余额列
Private mintQuantityBanCol As Integer                           '数量余额列
Private mintCurrencyBanCol As Integer                           '外币余额列
Private mintRemarkCol As Integer                                '摘要列
Private mintDirectCol As Integer                                '方向列

Private mlngAmountBalance As Double
Private mlngQuantityBalance As Double
Private mlngCurrencyBalance As Double
Private mdblSubBan() As Double                                  '子栏目余额

Private mstrQuantityCol As String * 4                           '数量列
Private mstrAmountCol As String * 4                             '金额列
Private mstrCurrencyCol As String * 4                           '外币列
Private mstrPriceCol As String * 4                              '余额单价列

Private mintMonthCol As Integer                                 '月对应的列号
Private mintDayCol As Integer                                   '日对应的列号
Private mintYear As Integer                                     '年
Private mstrMonth As String                                     '上一行的月
Private mstrDay As String                                       '上一行的日
Private mintFCIndex As Integer       '当前表头索引

Private mstrWhere As String
Private mintMastDealRow As Integer                              '已进行数据处理的最大行
Private mintMastDealCol() As Integer                            '本页已显示的最大列
Private mblnIsOver As Boolean                                   '是否处理帐册的最后一行
Private mintSub As Integer                                      '页折行的第X分页
Private mlngMultiWid() As Long                                  '子栏目宽度

Private mbResizeing As Boolean                  '移动标志
Private mintCurContents As Integer              '当前目录
Private mintNowPage As Integer                  '当前页
Private mintPages As Integer                    '总页数
Private mintPageRows As Integer      '每页行数
Private mintZeroRow As Integer       '隐藏行数

Private mlngDayTotal() As Variant       '日合计
Private mlngDayAll() As Variant         '日累计
Private mlngNowTotal() As Variant       '当前合计
Private mlngNowAll() As Variant         '当前累计
Private mintBanDirect As Integer        '余额方向

Private ZoomIndex As Integer
Private PaperWidth As Long
Private PaperHeight As Long
Private mblnOrientation As Boolean

Private WithEvents ABook As AountBook
Attribute ABook.VB_VarHelpID = -1

Private mDebitDesc() As String
Private mCreditDesc() As String
Private mBanlanceDesc() As String
Private mTotalDesc() As String              '借方合计栏
Private mTotalDesc2() As String             '贷方合计栏
Private mOtherDesc() As String
Private mOtherDesc2() As String
Private mSubColDesc() As String
Private mSubColCombine() As String

Private mintDebit As Integer
Private mintCredit As Integer
Private mintBanlance As Integer
Private mintTotal As Integer                '借方合计栏数
Private mintTotal2 As Integer               '贷方合计栏数
Private mintOther As Integer
Private mintOther2 As Integer
Private mclsFset As ClsFormatset
Private mblnDateChange As Boolean    '日期是否改变
Private mintDirect As Integer                                   '当前分录的方向
Private mintDefDirect As Integer                               '当前科目的方向
Private mblnErr As Boolean
Private mstrCurName As String        '币种Name
Private mintData As Integer          '栏目数据类型
Private marrPeriod() As Variant
Private mblnAlign As Boolean
Private mstrCond As String           '表头栏目对应的条件
Private mblnHeadChange As Boolean    '表头设置是否改变
Private mlngPageAlign As Long        '页号显示对齐方式
Private mblnFirstLoad As Boolean
Private mblnSetData As Boolean
Private mblnLockHead As Boolean
Private mstrOldDate As String
Private mintDateIndex As Integer
Private mblnPrint As Boolean
Private mblnRefresh As Boolean


'''''''''''''''''''''''''''''
'
'         数据组织
'
'''''''''''''''''''''''''''''

Private Function GetPeriod(ByVal tYear As Integer, ByVal tMonth As Integer, ByVal tDay As Integer) As Integer
   Dim dNow As Date
   Dim intCount As Integer
     
     On Error GoTo ErrHandle
     dNow = Format(CStr(tYear) & "-" & CStr(tMonth) & "-" & CStr(tDay), "YYYY-MM-DD")
     For intCount = 1 To UBound(marrPeriod)
         If dNow >= marrPeriod(intCount, 3) And dNow <= marrPeriod(intCount, 4) Then
            GetPeriod = marrPeriod(intCount, 2)
            Exit Function
         End If
     Next intCount
     Exit Function
ErrHandle:
End Function

'初始化合计栏目数组
Private Sub InitTotalColumn()
   With mclsMultiReportSet
       If Not Utility.ArrIsEmpty(mSubColDesc) Then
            ReDim mlngDayTotal(.Columns + UBound(mSubColDesc))
            ReDim mlngDayAll(.Columns + UBound(mSubColDesc))
            ReDim mlngNowTotal(.Columns + UBound(mSubColDesc))
            ReDim mlngNowAll(.Columns + UBound(mSubColDesc))
       Else
            ReDim mlngDayTotal(.Columns)
            ReDim mlngDayAll(.Columns)
            ReDim mlngNowTotal(.Columns)
            ReDim mlngNowAll(.Columns)
       End If
   End With
End Sub

'初始化多栏帐子栏目
Private Sub InitSubCol()
  Dim intCount As Integer
  Dim intExpandStyle As Integer
  
    intExpandStyle = mclsMultiReportSet.ExpandStyle
    If intExpandStyle = 1 Or intExpandStyle = 2 Or _
       intExpandStyle = 8 Or intExpandStyle = 32 Then
        ReDim mSubColDesc(mintDebit + mintCredit + 1 + mintBanlance + mintOther)
        ReDim mSubColCombine(mintDebit + mintCredit + 1 + mintBanlance + mintOther)
        For intCount = 1 To mintDebit + mintCredit + 1 + mintBanlance + mintOther
              
              If intCount <= mintDebit Then
                  mSubColDesc(intCount) = mDebitDesc(intCount)
                  mSubColCombine(intCount) = "借方"
              End If
              If intCount > mintDebit And intCount <= mintDebit + mintCredit Then
                  mSubColDesc(intCount) = mCreditDesc(intCount - mintDebit)
                  mSubColCombine(intCount) = "贷方"
              End If
              If intCount = mintDebit + mintCredit + 1 Then
                  mSubColDesc(intCount) = "借/货"
                  mSubColCombine(intCount) = ""
                  mintDirectCol = mintDebit + mintCredit + 1

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -