frmac_randommulticolresult.frm

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

VERSION 5.00
Object = "{7802D41A-28B0-43C4-95EA-17B7E32337D1}#1.0#0"; "CellCtrl5.ocx"
Begin VB.Form frmAC_RandomMultiColResult 
   Caption         =   "多栏账"
   ClientHeight    =   4305
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8430
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   4305
   ScaleWidth      =   8430
   WindowState     =   2  'Maximized
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   345
      Left            =   480
      ScaleHeight     =   345
      ScaleWidth      =   1050
      TabIndex        =   1
      Top             =   720
      Width           =   1050
      Begin VB.Label Label1 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         Caption         =   "查询多栏账："
         ForeColor       =   &H80000008&
         Height          =   180
         Left            =   0
         TabIndex        =   2
         Top             =   120
         Width           =   1215
      End
   End
   Begin VB.ComboBox cboAccountbook 
      Height          =   300
      Left            =   1560
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   720
      Width           =   1245
   End
   Begin CELL50Lib.Cell Cllr 
      Height          =   4215
      Left            =   240
      TabIndex        =   3
      Top             =   120
      Width           =   8055
      _Version        =   65536
      _ExtentX        =   14208
      _ExtentY        =   7435
      _StockProps     =   0
   End
End
Attribute VB_Name = "frmAC_RandomMultiColResult"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'辅助核算任意多栏式明细账
'Cell单元格对齐方式: 33 = 左对齐, 34 = 右对齐, 36 = 居中对齐;
'Const lColTxtNegativeColor = vbRed '单元格为负数时的颜色

Const ROWS_PAGE = 30               '每页行数

Const COL_START = 1                 '开始列数
Const COL_SERIAL = 1                '序号
Const COL_MONTH = 2                 '月
Const COL_DAY = 3                   '日
Const COL_TYPE = 4                  '凭证种类
Const COL_NUMBER = 5                '凭证号码
Const COL_SUMMARY = 6              '摘要

Const COL_DEBIT_AMOUNT = 7           '借方数量
Const COL_DEBIT_FOREIGN = 8         '借方外币
Const COL_DEBIT_MONEY = 9           '借方金额
Const COL_CREDIT_AMOUNT = 10           '贷方数量
Const COL_CREDIT_FOREIGN = 11         '贷方外币
Const COL_CREDIT_MONEY = 12           '贷方金额

Const COL_DIRECTION = 13            '方向
Const COL_BALANCE_AMOUNT = 14          '金额余额
Const COL_BALANCE_FOREIGN = 15          '金额余额
Const COL_BALANCE_MONEY = 16         '金额余额
Const COL_ACTION_BEGIN = 17           '辅助核算 栏目开始列

Dim CurRow As Long                  '存放当前行的行数(从表格开始行计数)

Const ROW_HEAD1 = 6                '页标头行1

Const ROW_TITLE = 1                 '标题
Const ROW_PAGEHEAD1 = 2          '页眉行1
Const ROW_PAGEHEAD2 = 3             '页眉行2
Const ROW_PAGEHEAD3 = 4            '页眉行3
Const ROW_PAGEHEAD4 = 5            '页眉行4
Const ROW_PAGEHEAD5 = 6           '页眉行5
Const ROW_GRIDHEAD1 = 7            '表格头行1
Const ROW_GRIDHEAD2 = 8            '表格头行2
Const ROW_GRIDHEAD3 = 9             '表格头行3
Const ROW_GRID_START = 10          '表格开始行

Const CRB_LINE = vbBlack            '表格线颜色

'多栏式账页缺省列宽去除子科目列
Const COLWIDTH_MONEY = "30,30,30,50,50,220,120,120,120,120,120,120,25,120,120,120"

'Private m_iTotalSheets As Integer '页面的总数

Private iCol_DebitEnd As Integer        '借方结束列
Private iCol_End As Integer             '结束列
'Private dUnit_Price As Double           '单价
'Private dExchange_Rate As Double        '汇率
'Private m_sYear As String               '查账年份
Private m_sMonthFrom As String          '查账起始月
Private m_sMonthTo As String            '查账截止月
Private m_sSubjectCode As String        '科目代码
Private m_sDeptCode As String           '部门代码
Private m_sItemCodeCollect As String    '项目代码集
Private m_iLevel As String    '分析级次
Private m_bShowNotMoneyCol           '是否显示没有发生额的栏目
Private m_bIncludeNotRecordVoucher As Boolean       '是否包含未记账凭证
Private m_sAccountName As String        '账页名称
Private m_sAccountField               '对应的字段名称
Private m_sAccountType As String      '账页类型
Private m_sMode As String               '多栏账分析方式
Private m_sCellTitle As String          'CELL表格标题
Private m_sHeaderOneCode As String      'CELL表格页眉行1第一列的名称
Private m_sHeaderTwoCode As String      'CELL表格页眉行2第一列的名称
Private m_sHeaderThreeCode As String     'CELL表格页眉行3第一列的名称
'Private m_sCaudaThreeCode As String     'CELL表格页眉行3尾的名称
Private m_sEnterName As String          '单位名称
Private m_bAmount As Boolean            '是否数量账
Private m_bForeign As Boolean           '是否外币账
Private m_bDebitSum As Boolean            '是否借方合计
Private m_bCreditSum As Boolean           '是否贷方合计

Private m_arrColInformation() As clsSubSys  '栏目信息

Private m_bFormLoad As Boolean          '是否在窗体引导状态

Private m_iCol As Integer               '鼠标右击单元格所在行
Private m_iRow As Integer               '鼠标右击单元格所在列
Private m_iColWidth() As Integer        '存放表格各列的宽度
Private m_iColWidthTemp() As Integer    '存放表格列宽被修改后的宽度
Private m_sDefaultColWidth As String    '当前账页的缺省列宽

Private m_sPzKey() As String

Private lMutexID As Integer

Public Property Let uMutexID(ByVal i As Integer)
lMutexID = i
End Property
Public Sub RestoreDefault()
Dim sArray() As String
Dim i As Integer
Dim j As Integer
Dim k As Integer

    m_sDefaultColWidth = COLWIDTH_MONEY
    m_iColWidth = GetColWidth1(m_sAccountName, m_sMode, m_sDefaultColWidth)

k = 1
 For j = 0 To Cllr.GetTotalSheets - 1
  For i = LBound(m_iColWidth) To UBound(m_iColWidth)
           Cllr.SetColWidth 1, m_iColWidth(i), i, j
        Next i
        For i = LBound(m_arrColInformation) To UBound(m_arrColInformation)
            Cllr.SetColWidth 1, 120, COL_ACTION_BEGIN + i * 3, j
            Cllr.SetColWidth 1, 120, COL_ACTION_BEGIN + i * 3 + 1, j
            Cllr.SetColWidth 1, 120, COL_ACTION_BEGIN + i * 3 + 2, j
        Next i
        Cllr.SetColWidth 1, 3, iCol_End + 1, j
'  For i = LBound(sArray) To UBound(sArray)
'      m_iColWidth(i + 1) = CInt(sArray(i))
'            CllR.SetColWidth 1, sArray(i), i, j
'        Next i
'        For i = LBound(m_arrColInformation) To UBound(m_arrColInformation)
'            CllR.SetColWidth 1, 120, COL_ACTION_BEGIN + i * 3, j
'            CllR.SetColWidth 1, 120, COL_ACTION_BEGIN + i * 3 + 1, j
'            CllR.SetColWidth 1, 120, COL_ACTION_BEGIN + i * 3 + 2, j
'        Next i
'        CllR.SetColWidth 1, 3, iCol_End + 1, k
  Next
  k = 1
m_iColWidthTemp = m_iColWidth
Cllr.Redraw
End Sub

Public Property Let usAccountType(ByVal NewValue As String) '账页类型
    m_sAccountType = NewValue
    If m_sAccountType = "科目" Then
       m_sAccountField = "kmdm"
    ElseIf m_sAccountType = "部门" Then
       m_sAccountField = "bmdm"
    Else
       m_sAccountField = "xmdm"
    End If
End Property
Public Property Let ubFormLoad(ByVal NewValue As Boolean) '是否在引导状态
m_bFormLoad = NewValue
End Property
Public Property Let usAccountName(ByVal NewValue As String) '账页类型
m_sAccountName = NewValue
End Property
Public Property Let usMode(ByVal NewValue As String) '分析方式
    m_sMode = NewValue
End Property
Public Property Let usMonthFrom(ByVal NewValue As String) '开始月份
    m_sMonthFrom = NewValue
End Property
Public Property Let usMonthTo(ByVal NewValue As String) '结束月份
    m_sMonthTo = NewValue
End Property
Public Property Let usSubjectCode(ByVal NewValue As String) '科目代码
    m_sSubjectCode = NewValue
End Property
Public Property Let usDeptCode(ByVal NewValue As String) '查询部门代码
    m_sDeptCode = NewValue
End Property
Public Property Let uaItemCodeCollect(ByRef NewValue As String) '查询项目代码集
    m_sItemCodeCollect = NewValue
End Property
Public Property Let ubIncludeNotRecordVoucher(ByVal NewValue As Boolean) '是否包括未记账凭证
    m_bIncludeNotRecordVoucher = NewValue
End Property
Public Property Let ubShowNotMoneyCol(ByVal NewValue As Boolean) '是否显示没有数据的栏目
    m_bShowNotMoneyCol = NewValue
End Property
Public Property Let ubAmount(ByVal NewValue As Boolean) '是否数量账
    m_bAmount = NewValue
End Property
Public Property Let ubForeign(ByVal NewValue As Boolean) '是否外币账
    m_bForeign = NewValue
End Property
Public Property Let uiLevel(ByVal NewValue As Integer) '分析级次
    m_iLevel = NewValue
End Property
Public Property Let uarrColInformation(ByRef NewValue() As clsSubSys) '栏目信息