frmyh_djwh.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmYH_Djwh 
   Caption         =   "银行单据号维护"
   ClientHeight    =   5145
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   8730
   Icon            =   "frmYH_Djwh.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   5145
   ScaleWidth      =   8730
   StartUpPosition =   3  '窗口缺省
   Begin VB.ComboBox cboJsfs 
      Height          =   300
      Left            =   3555
      Style           =   2  'Dropdown List
      TabIndex        =   9
      Top             =   2475
      Visible         =   0   'False
      Width           =   1230
   End
   Begin VB.TextBox txtEdit 
      Height          =   270
      Left            =   2610
      MaxLength       =   12
      TabIndex        =   8
      Top             =   1530
      Visible         =   0   'False
      Width           =   240
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   7020
      Top             =   45
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmYH_Djwh.frx":014A
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmYH_Djwh.frx":026A
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmYH_Djwh.frx":037E
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmYH_Djwh.frx":08C0
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.ComboBox cboStyle 
      Height          =   300
      ItemData        =   "frmYH_Djwh.frx":0D1C
      Left            =   3465
      List            =   "frmYH_Djwh.frx":0D26
      Style           =   2  'Dropdown List
      TabIndex        =   5
      Top             =   675
      Width           =   1860
   End
   Begin VB.ComboBox cboKm 
      Height          =   300
      Left            =   675
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   675
      Width           =   1860
   End
   Begin MSComctlLib.Toolbar tbr 
      Align           =   1  'Align Top
      Height          =   555
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   8730
      _ExtentX        =   15399
      _ExtentY        =   979
      ButtonWidth     =   820
      ButtonHeight    =   926
      Appearance      =   1
      Style           =   1
      ImageList       =   "ImageList1"
      DisabledImageList=   "ImageList1"
      HotImageList    =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   5
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "定位"
            Key             =   "Find"
            ImageIndex      =   1
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "保存"
            Key             =   "Save"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "帮助"
            Key             =   "Help"
            ImageIndex      =   2
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退出"
            Key             =   "Exit"
            ImageIndex      =   4
         EndProperty
      EndProperty
   End
   Begin MSFlexGridLib.MSFlexGrid mfg 
      Height          =   4020
      Left            =   90
      TabIndex        =   0
      Top             =   990
      Width           =   8610
      _ExtentX        =   15187
      _ExtentY        =   7091
      _Version        =   393216
      Rows            =   3
      Cols            =   13
      FixedRows       =   2
      FixedCols       =   2
      FocusRect       =   2
      FillStyle       =   1
      MergeCells      =   4
      AllowUserResizing=   1
   End
   Begin VB.Label lblRq 
      AutoSize        =   -1  'True
      Height          =   180
      Left            =   6570
      TabIndex        =   7
      Top             =   765
      Width           =   90
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "查询日期："
      Height          =   180
      Left            =   5580
      TabIndex        =   6
      Top             =   765
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "格式："
      Height          =   180
      Left            =   2745
      TabIndex        =   4
      Top             =   720
      Width           =   540
   End
   Begin VB.Label lblKm 
      AutoSize        =   -1  'True
      Caption         =   "科目："
      Height          =   180
      Left            =   90
      TabIndex        =   2
      Top             =   720
      Width           =   540
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件"
      Begin VB.Menu mnuFileFind 
         Caption         =   "定位"
      End
      Begin VB.Menu mnuFileSave 
         Caption         =   "保存"
      End
      Begin VB.Menu mnuFileBar 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "退出"
      End
   End
End
Attribute VB_Name = "frmYH_Djwh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const Head1_WBJE = "|#|日期|凭证|凭证|凭证|凭证|凭证|摘要|汇率|借方|借方|贷方|贷方"
Private Const Head2_WBJE = "|#|日期|类别|号|结算方式|单据号|票据日期|摘要|汇率|外币|金额|外币|金额"
Private Const Colwidth_WBJE = "0,250,900,500,500,1600,1600,1600,5000,1500,1500,1500,1500,1500"
Private Const Head1_JE = "|#|日期|凭证|凭证|凭证|凭证|凭证|摘要|借方|贷方"
Private Const Head2_JE = "|#|日期|类别|号|结算方式|单据号|票据日期|摘要|借方|贷方"
Private Const Colwidth_JE = "0,250,900,500,500,1600,1600,1600,5000,1500,1500"

Dim m_sYear  As String
Dim m_sFromMonth As String
Dim m_sToMonth As String
Dim m_sFromDate As String
Dim m_sToDate As String
Dim m_sSubjectCode As String
Dim m_sSubjectName  As String

Dim bEnableEnterCell As Boolean

'''''''''''
'年
Public Property Get usYear() As String
usYear = m_sYear
End Property

Public Property Let usYear(ByVal vNewValue As String)
m_sYear = vNewValue
End Property
''''''''''
'起始月
Public Property Get usFromMonth() As String
usFromMonth = m_sFromMonth
End Property

Public Property Let usFromMonth(ByVal vNewValue As String)
m_sFromMonth = vNewValue
End Property
''''''''''''''
'结束月
Public Property Get usToMonth() As String
usToMonth = m_sToMonth
End Property

Public Property Let usToMonth(ByVal vNewValue As String)
m_sToMonth = vNewValue
End Property
'''''''''
'起始日
Public Property Get usFromDate() As String
usFromDate = m_sFromDate
End Property

Public Property Let usFromDate(ByVal vNewValue As String)
m_sFromDate = vNewValue
End Property
'''''''''
'结束月
Public Property Get usToDate() As String
usToDate = m_sToDate
End Property

Public Property Let usToDate(ByVal vNewValue As String)
m_sToDate = vNewValue
End Property
'''''''''
'科目代码
Public Property Get usSubjectCode() As String
usSubjectCode = m_sSubjectCode
End Property

Public Property Let usSubjectCode(ByVal vNewValue As String)
m_sSubjectCode = vNewValue
End Property

'''''''''
'科目名称
Public Property Get usSubjectName() As String
usSubjectName = m_sSubjectName
End Property

Public Property Let usSubjectName(ByVal vNewValue As String)
m_sSubjectName = vNewValue
End Property
'''''''''
'科目序号
Public Property Get usSubjectIndex() As Integer
usSubjectIndex = cboKm.ListIndex
End Property

Public Property Let usSubjectIndex(ByVal vNewValue As Integer)
cboKm.ListIndex = vNewValue
End Property

'回车键焦点向后
Private Sub cboJsfs_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
'    SetTextVisible False
    mFg.Col = mFg.Col + 1
End If
End Sub

'切换科目
Private Sub cboKm_Click()
Dim i As Integer
i = InStr(1, cboKm.text, "=")
If i > 0 Then
    m_sSubjectCode = Left$(cboKm.text, i - 1)
    m_sSubjectName = Mid$(cboKm.text, i + 1)
    '刷新内容
    ShowResult
Else
    cboKm.ListIndex = -1
End If
End Sub

'切换格式
Private Sub cboStyle_Click()
'防止焦点切换
bEnableEnterCell = False
Select Case cboStyle.text
Case "金额式"
    '格式化网格
    FormatMfg "Je"
    '重设列宽
    SetColWidth Colwidth_JE
Case "外币金额式"
    FormatMfg "Wb"
    SetColWidth Colwidth_WBJE
End Select
ShowResult
bEnableEnterCell = True
End Sub

Private Sub form_load()
bEnableEnterCell = False
InitCboKm
InitCboJsfs
cboStyle.ListIndex = 0
lblRq.Caption = Replace$(m_sFromDate, "-", ".") + "-" + Replace$(m_sToDate, "-", ".")
bEnableEnterCell = False
FormatMfg "Je"
SetColWidth Colwidth_JE
txtEdit.text = ""
bEnableEnterCell = True
End Sub

Public Sub FormatMfg(ByVal sformat As String)
Dim i As Integer
Dim j As Integer
mFg.MergeCells = flexMergeFree
Select Case sformat
Case "Je"
    FillRow Head1_JE, 0
    FillRow Head2_JE, 1
    mFg.MergeCol(1) = True
    mFg.MergeCol(2) = True
    mFg.MergeCol(8) = True
    mFg.MergeCol(9) = True
    mFg.MergeCol(10) = True
Case "Wb"
    FillRow Head1_WBJE, 0
    FillRow Head2_WBJE, 1
    mFg.MergeCol(1) = True
    mFg.MergeCol(2) = True
    mFg.MergeCol(8) = True
    mFg.MergeCol(9) = True
    mFg.MergeCol(10) = False
End Select
For i = 2 To 8
    mFg.ColAlignment(i) = flexAlignLeftCenter
Next
For i = 0 To mFg.FixedRows - 1
    mFg.MergeRow(i) = True
    mFg.Row = i
    For j = 1 To mFg.Cols - 1
        mFg.Col = j
        mFg.CellAlignment = flexAlignCenterCenter
    Next
Next
mFg.Row = mFg.FixedRows - 1 - CInt(mFg.Rows > mFg.FixedRows)
mFg.Col = mFg.FixedCols - 1 - CInt(mFg.Cols > mFg.FixedCols)
End Sub

'设定列宽
Public Sub SetColWidth(ByVal s As String)
Dim arryS() As String
Dim i As Integer
arryS = Split(s, ",")
For i = LBound(arryS) To UBound(arryS)
    mFg.ColWidth(i) = CLng(arryS(i))
Next
End Sub

'填充行
Public Sub FillRow(ByVal s As String, ByVal iRow As Integer)
Dim arryS() As String
Dim i As Integer
arryS = Split(s, "|")
mFg.Cols = UBound(arryS) + 1
For i = LBound(arryS) To UBound(arryS)
    mFg.TextMatrix(iRow, i) = arryS(i)
Next
End Sub

Private Sub Form_Resize()
If Me.Height - 1730 > 0 Then mFg.Height = Me.Height - 1730
mFg.Left = Me.ScaleLeft
mFg.Width = Me.ScaleWidth
End Sub

'初始化结算方式
Private Sub InitCboJsfs()
Dim rSt As New Recordset
cboJsfs.Clear
cboJsfs.AddItem ""
rSt.Open "select cCode,cName from tZW_Jsfs" + m_sYear + " where bEnd=-1 order by cCode", glo.cnnMain, adOpenKeyset, adLockOptimistic
While rSt.EOF = False
    cboJsfs.AddItem Trim$(rSt.Fields("cCode").value) + "=" + Trim$(rSt.Fields("cName").value)
    rSt.MoveNext
Wend
rSt.Close
End Sub

'初始化科目
Private Sub InitCboKm()
Dim rSt As New Recordset
cboKm.Clear
rSt.Open "select kmdm,kmmc from tZW_Km" + m_sYear + " where IsYhz=-1 order by kmdm", glo.cnnMain, adOpenKeyset, adLockOptimistic
While rSt.EOF = False
    cboKm.AddItem rSt.Fields("Kmdm").value + "=" + rSt.Fields("Kmmc").value
    rSt.MoveNext
Wend
rSt.Close
End Sub