frmcustomcodelist.frm

金算盘软件代码

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Object = "{9C4B12C2-D5CE-11D1-9ABC-444553540000}#1.0#0"; "GATLCTRL.DLL"
Object = "{D252F124-F62C-11D1-9ABD-444553540000}#1.0#0"; "GACALENDAR.DLL"
Begin VB.Form frmCustomer 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "往来单位列表"
   ClientHeight    =   4440
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7725
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4440
   ScaleWidth      =   7725
   ShowInTaskbar   =   0   'False
   Begin VB.Data datCustomer 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  'DefaultCursor
      DefaultType     =   2  'UseODBC
      Exclusive       =   0   'False
      Height          =   375
      Index           =   0
      Left            =   5235
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   3030
      Visible         =   0   'False
      Width           =   1260
   End
   Begin VB.ComboBox cboFindKind 
      Height          =   300
      ItemData        =   "frmCustomer.frx":0000
      Left            =   795
      List            =   "frmCustomer.frx":0002
      Style           =   2  'Dropdown List
      TabIndex        =   7
      Top             =   0
      Width           =   1515
   End
   Begin VB.CommandButton cmdAgain 
      Caption         =   "..."
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   6315
      TabIndex        =   6
      ToolTipText     =   "再找"
      Top             =   0
      Width           =   300
   End
   Begin VB.CheckBox chkShowAll 
      Caption         =   "全部显示"
      Height          =   350
      Left            =   3870
      TabIndex        =   5
      Top             =   3120
      Width           =   1095
   End
   Begin VB.Data datCustomer 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  'DefaultCursor
      DefaultType     =   2  'UseODBC
      Exclusive       =   0   'False
      Height          =   375
      Index           =   1
      Left            =   5235
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   3390
      Visible         =   0   'False
      Width           =   1260
   End
   Begin VB.TextBox txtFind 
      Height          =   300
      Left            =   3195
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   0
      Visible         =   0   'False
      Width           =   3015
   End
   Begin TabDlg.SSTab sstCustomer 
      Height          =   2460
      Left            =   195
      TabIndex        =   1
      Top             =   510
      Width           =   6375
      _ExtentX        =   11245
      _ExtentY        =   4339
      _Version        =   327681
      Style           =   1
      Tabs            =   2
      TabsPerRow      =   2
      TabHeight       =   529
      TabCaption(0)   =   "单位类型(&T)"
      TabPicture(0)   =   "frmCustomer.frx":0004
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).Control(0)=   "msgCustomerType"
      Tab(0).Control(0).Enabled=   0   'False
      Tab(0).ControlCount=   1
      TabCaption(1)   =   "往来单位(&C)"
      TabPicture(1)   =   "frmCustomer.frx":0020
      Tab(1).ControlEnabled=   0   'False
      Tab(1).Control(0)=   "msgCustomer"
      Tab(1).ControlCount=   1
      Begin MSFlexGridLib.MSFlexGrid msgCustomerType 
         Bindings        =   "frmCustomer.frx":003C
         DragIcon        =   "frmCustomer.frx":0055
         Height          =   1815
         Left            =   90
         TabIndex        =   2
         Tag             =   "ctPayMethod////101"
         Top             =   450
         Width           =   5775
         _ExtentX        =   10186
         _ExtentY        =   3201
         _Version        =   65541
         Rows            =   20
         Cols            =   3
         FixedCols       =   0
         BackColorFixed  =   -2147483644
         BackColorSel    =   -2147483646
         BackColorBkg    =   16777215
         Redraw          =   -1  'True
         AllowBigSelection=   0   'False
         FocusRect       =   0
         SelectionMode   =   1
         AllowUserResizing=   1
      End
      Begin MSFlexGridLib.MSFlexGrid msgCustomer 
         Bindings        =   "frmCustomer.frx":0497
         DragIcon        =   "frmCustomer.frx":04B0
         Height          =   1815
         Left            =   -74880
         TabIndex        =   3
         Tag             =   "ctPayMethod////101"
         Top             =   480
         Width           =   5775
         _ExtentX        =   10186
         _ExtentY        =   3201
         _Version        =   65541
         Rows            =   20
         Cols            =   3
         FixedCols       =   0
         BackColorFixed  =   -2147483644
         BackColorSel    =   -2147483646
         BackColorBkg    =   16777215
         Redraw          =   -1  'True
         AllowBigSelection=   0   'False
         FocusRect       =   0
         SelectionMode   =   1
         AllowUserResizing=   1
      End
   End
   Begin GATLCTRLLibCtl.CalEdit cleFind 
      Height          =   300
      Left            =   3255
      OleObjectBlob   =   "frmCustomer.frx":08F2
      TabIndex        =   4
      Top             =   0
      Visible         =   0   'False
      Width           =   3015
   End
   Begin GACALENDARLibCtl.Calendar cldFind 
      Height          =   300
      Left            =   3315
      OleObjectBlob   =   "frmCustomer.frx":0975
      TabIndex        =   8
      Top             =   0
      Visible         =   0   'False
      Width           =   2895
   End
   Begin MSForms.CommandButton cmdPopupMenu 
      Height          =   345
      Index           =   2
      Left            =   2520
      TabIndex        =   13
      Tag             =   "////110"
      Top             =   3120
      WhatsThisHelpID =   5010
      Width           =   1215
      Caption         =   "报表"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin MSForms.CommandButton cmdPopupMenu 
      Height          =   345
      Index           =   1
      Left            =   1320
      TabIndex        =   12
      Tag             =   "////110"
      Top             =   3120
      WhatsThisHelpID =   5010
      Width           =   1215
      Caption         =   "业务"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin MSForms.CommandButton cmdPopupMenu 
      Height          =   345
      Index           =   0
      Left            =   120
      TabIndex        =   11
      Tag             =   "////110"
      Top             =   3120
      WhatsThisHelpID =   5010
      Width           =   1215
      Caption         =   "编辑"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin VB.Label lblFindKind 
      AutoSize        =   -1  'True
      Caption         =   "查找(&F)"
      Height          =   180
      Left            =   120
      TabIndex        =   10
      Top             =   60
      Width           =   630
   End
   Begin VB.Label lblFind 
      AutoSize        =   -1  'True
      Caption         =   "内容(&C)"
      Height          =   180
      Left            =   2535
      TabIndex        =   9
      Top             =   60
      Width           =   630
   End
End
Attribute VB_Name = "frmCustomer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private mIsShowCard As Boolean                                  '卡片窗口显示标志
Private mblnCheckNoChange As Boolean                            '不需要响应chkshowAll控件Change事件
Private mblnFormNoRezise As Boolean                             '不需要响应form_Rezise事件
Private mblnComboxNoClick As Boolean

Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private WithEvents mclsSubClass As SubClass32.SubClass          '钩子对象
Attribute mclsSubClass.VB_VarHelpID = -1
Private mclsList(1) As List                                    '列表对象
Private blnIsLoad(1) As Boolean
Private intViewID(1) As Integer
Private strfieldName, strfieldType As String
 
Private Const fieldName = "单位名称"
Private Const fieldType = "单位类型"
Private Const intFormWidth = 5100
Private Const intFormHeight = 3000

'
'方法及函数
'
'产生往来单位列表记录集
Public Function GetList(ByVal intTab As Integer) As Recordset
    Dim recRecordset As Recordset
    Dim strSelectOfSql As String
    Dim strFromOfSql As String
    Dim strWhereOfSql As String
    Dim strSQL As String
    
    strSelectOfSql = mclsList(intTab).ListSet.SelectOfSql
    strFromOfSql = mclsList(intTab).ListSet.FromOfSql
    strWhereOfSql = mclsList(intTab).ListSet.WhereOfSql
    Select Case intTab
        Case 0
            If mclsList(intTab).ShowAll Then
                strSelectOfSql = "Select CustomerType.lngCustomerTypeID As id,IIF(CustomerType.blnIsInActive,'√','') As 停用," & strSelectOfSql
                If strWhereOfSql <> "" Then
                   strWhereOfSql = "where" & strWhereOfSql
                End If
            Else
                strSelectOfSql = "Select CustomerType.lngCustomerTypeID As id ," & strSelectOfSql
                If strWhereOfSql = "" Then
                   strWhereOfSql = " Where Not CustomerType.blnIsInactive"
                Else
                   strWhereOfSql = " Where Not CustomerType.blnIsInactive" & strWhereOfSql
                End If
            End If
        Case 1
            If mclsList(intTab).ShowAll Then
                strSelectOfSql = "Select Customer.lngCustomerID As id,IIF(Customer.blnIsInActive,'√','') As 停用," & strSelectOfSql
                If strWhereOfSql <> "" Then
                   strWhereOfSql = "where" & strWhereOfSql
                End If
 
            Else
                strSelectOfSql = "Select Customer.lngCustomerID As id ," & strSelectOfSql
                If strWhereOfSql = "" Then
                   strWhereOfSql = " Where Not Customer.blnIsInactive"
                Else
                   strWhereOfSql = " Where Not Customer.blnIsInactive" & strWhereOfSql
                End If
            End If
    End Select
    strSQL = strSelectOfSql & strFromOfSql & strWhereOfSql

    Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSQL, dbOpenSnapshot)
    
    '列表是否为空
    If recRecordset.RecordCount = 0 Then
        mclsList(intTab).FlexGrid.HighLight = flexHighlightNever
        cmdAgain.Enabled = False
    Else
        mclsList(intTab).FlexGrid.HighLight = flexHighlightAlways
        cmdAgain.Enabled = True
    End If
    Set GetList = recRecordset
End Function

Public Property Let IsShowCard(ByVal vNewValue As Boolean)
   mIsShowCard = vNewValue
End Property

'按照往来单位ID提取记录
Public Function GetByListID(ByVal intTab As Integer, ByVal lngID As Long) As Recordset
    Dim recRecordset As Recordset
    Dim strSQL As String
    
    Select Case intTab
        Case 0
            strSQL = "Select * From CustomerType Where lngCustomerTypeID = " & lngID
        Case 1
            strSQL = "Select * From Customer Where lngCustomerID = " & lngID
    End Select
    Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSQL, dbOpenSnapshot)
    Set GetByListID = recRecordset
End Function

'按照往来单位ID更新停用标志
Private Function UpdateListInActive(ByVal intTab As Integer, ByVal lngID As Long, ByVal blnIsInActive As Boolean) As Boolean
    Dim strSQL As String
    
    Select Case intTab
        Case 0
            strSQL = "UPDATE CustomerType SET blnIsInActive = " & blnIsInActive & " WHERE lngCustomerTypeID = " & lngID
        Case 1
            strSQL = "UPDATE Customer SET blnIsInActive = " & blnIsInActive & " WHERE lngCustomerID = " & lngID
    End Select
    UpdateListInActive = gclsBase.ExecSQL(strSQL)
End Function

'删除往来单位ID指定记录
Private Function DelByCustomerID(ByVal lngID As Long, ByVal intTab As Integer) As Boolean
    Dim strSQL As String
    
    Select Case intTab
        Case 0
            strSQL = "Delete * From CustomerType WHERE lngCustomerTypeID = " & lngID
        Case 1
            strSQL = "Delete * From Customer WHERE lngCustomerID = " & lngID
    End Select
    DelByCustomerID = gclsBase.ExecSQL(strSQL)
End Function

'判断往来单位ID是否使用
Private Function IsUseCustomerID(ByVal lngID As Long, ByVal intTab As Integer) As Boolean
    Dim recRecordset As Recordset
    Dim strSQL As String
    
    If intTab = 0 Then
       strSQL = "Select lngCustomerTypeID From Customer Where lngCustomerTypeID = " & lngID
    Else
       strSQL = "Select lngCustomerID From CustomerAccount Where lngCustomerID = " & lngID
    End If
    
    Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSQL, dbOpenSnapshot)
    IsUseCustomerID = (recRecordset.RecordCount >= 1)
    recRecordset.Close
End Function

' 往来单位ID
Public Property Get ListID(ByVal intTab As Integer) As Long
    With mclsList(intTab).FlexGrid
        ListID = CLng(.TextArray(.Row * .cols))
    End With
End Property

' 往来单位停用标志
Public Property Get ListIsInActive(ByVal intTab As Integer) As Boolean
    If chkShowAll.Value Then
        With mclsList(intTab).FlexGrid
            ListIsInActive = Not (.TextArray(.Row * .cols + 1) = "")
        End With
    Else
        ListIsInActive = False
    End If
End Property

'根据列表中记录数，设置菜单可用属性
Private Sub UpdateMenuStatus()
    Dim blnIsNotEmpty As Boolean
    Dim blnFindNoChange As Boolean
    With mclsList(sstCustomer.Tab).FlexGrid
        If .Row > 0 And .ColSel <> 0 Then
            blnIsNotEmpty = True
        Else
            blnIsNotEmpty = False
        End If
    End With
    With frmMain
        .mnuEditCopy.Enabled = blnIsNotEmpty
        .mnuEditEdit.Enabled = blnIsNotEmpty
        .mnuEditNew.Enabled = True
        .mnuEditDel.Enabled = blnIsNotEmpty
        .mnuEditInActive.Enabled = blnIsNotEmpty
        .mnuEditShowAll.Enabled = True
        .mnuEditUse.Enabled = blnIsNotEmpty
        .mnuEditColumn.Enabled = True
        .mnuEditFilter.Enabled = True
        .mnuFilePrint.Enabled = True
      '  .mnuReportQuick.Enabled = blnIsNotEmpty
        .mnuToolRefresh.Enabled = True
    End With
    If sstCustomer.Tab = 0 Or (blnIsNotEmpty = False) Then
       strfieldName = ""
    Else
       pop
    End If
    
    If mclsList(sstCustomer.Tab).FlexGrid.ColSel = 0 Then  '无当前选定行
        blnFindNoChange = mclsList(sstCustomer.Tab).FindNoChange
        mclsList(sstCustomer.Tab).FindNoChange = True
        mclsList(sstCustomer.Tab).Find.Text = ""
        mclsList(sstCustomer.Tab).FindNoChange = blnFindNoChange
        cmdAgain.Enabled = False