frmlistsales.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 = "{F6125AB1-8AB1-11CE-A77F-08002B2F4E98}#2.0#0"; "MSRDC20.OCX"
Begin VB.Form frmListSales 
   BackColor       =   &H80000004&
   Caption         =   "销售单列表"
   ClientHeight    =   3756
   ClientLeft      =   2580
   ClientTop       =   2592
   ClientWidth     =   6888
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MDIChild        =   -1  'True
   ScaleHeight     =   3756
   ScaleWidth      =   6888
   Tag             =   "ctPayMethod////101"
   Begin MSRDC.MSRDC datGrid 
      Height          =   312
      Left            =   5376
      Top             =   3264
      Visible         =   0   'False
      Width           =   972
      _ExtentX        =   1715
      _ExtentY        =   550
      _Version        =   393216
      Options         =   0
      CursorDriver    =   0
      BOFAction       =   0
      EOFAction       =   0
      RecordsetType   =   1
      LockType        =   3
      QueryType       =   0
      Prompt          =   3
      Appearance      =   1
      QueryTimeout    =   30
      RowsetSize      =   100
      LoginTimeout    =   15
      KeysetSize      =   0
      MaxRows         =   0
      ErrorThreshold  =   -1
      BatchSize       =   15
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Enabled         =   -1  'True
      ReadOnly        =   0   'False
      Appearance      =   -1  'True
      DataSourceName  =   ""
      RecordSource    =   ""
      UserName        =   ""
      Password        =   ""
      Connect         =   ""
      LogMessages     =   ""
      Caption         =   "MSRDC1"
      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 VB.CheckBox chkShowAll 
      Caption         =   "全部显示"
      Height          =   350
      Left            =   4080
      TabIndex        =   8
      Top             =   3180
      Width           =   1095
   End
   Begin VB.TextBox txtFind 
      Height          =   300
      Left            =   3195
      TabIndex        =   4
      Top             =   75
      Width           =   3015
   End
   Begin VB.CommandButton cmdAgain 
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   6240
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1017"
      ToolTipText     =   "再找"
      Top             =   90
      UseMaskColor    =   -1  'True
      Width           =   300
   End
   Begin VB.ComboBox cboFindKind 
      Height          =   300
      Left            =   720
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   90
      Width           =   1515
   End
   Begin MSFlexGridLib.MSFlexGrid grdList 
      Bindings        =   "frmListSales.frx":0000
      Height          =   2655
      Left            =   0
      TabIndex        =   0
      Tag             =   "ctPayMethod////101"
      Top             =   480
      Width           =   6495
      _ExtentX        =   11451
      _ExtentY        =   4678
      _Version        =   393216
      Rows            =   20
      Cols            =   3
      FixedCols       =   0
      BackColor       =   16777215
      BackColorFixed  =   -2147483644
      BackColorSel    =   -2147483646
      BackColorBkg    =   16777215
      Redraw          =   -1  'True
      AllowBigSelection=   0   'False
      FocusRect       =   0
      SelectionMode   =   1
      AllowUserResizing=   1
   End
   Begin MSForms.CommandButton cmdReport 
      Height          =   345
      Left            =   1260
      TabIndex        =   7
      Tag             =   "1018"
      Top             =   3240
      WhatsThisHelpID =   5010
      Width           =   1215
      Caption         =   "报表"
      PicturePosition =   196613
      Size            =   "2143;609"
      TakeFocusOnClick=   0   'False
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin MSForms.CommandButton cmdEdit 
      Height          =   350
      Left            =   50
      TabIndex        =   6
      Tag             =   "1018"
      Top             =   3240
      WhatsThisHelpID =   5010
      Width           =   1215
      Caption         =   "编辑"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin VB.Label lblFind 
      AutoSize        =   -1  'True
      Caption         =   "内容(&C)"
      Height          =   180
      Left            =   2460
      TabIndex        =   3
      Top             =   150
      Width           =   630
   End
   Begin VB.Label lblFindKind 
      AutoSize        =   -1  'True
      Caption         =   "查找(&B)"
      Height          =   180
      Left            =   50
      TabIndex        =   1
      Top             =   150
      Width           =   630
   End
End
Attribute VB_Name = "frmListSales"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'王成
Option Explicit

Private intFormType As Integer
Private strTypeName As String
Private lngOldOperatorID As Long
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private WithEvents mclsSubClass As SubClass32.SubClass          '钩子对象
Attribute mclsSubClass.VB_VarHelpID = -1
Private WithEvents mclsSubClassform As SubClass32.SubClass
Attribute mclsSubClassform.VB_VarHelpID = -1
Private mclsList As list                                        '列表对象
Attribute mclsList.VB_VarHelpID = -1
Private mclsSales As clsSales
'////////////////////////////////////////////////
'/////                赋值
'////////////////////////////////////////////////
Private intViewID As Integer                                    '商品出货列表：不同的列表窗口，其值不同
Private blnMenuBuilded As Boolean
Private strOldMenuCaption As String
Private frmEdit As FrmSalesBill
Private BeginDate As Date
Private EndDate As Date
Private bDblClick As Boolean
Private blnIsVoid    As Boolean   '是否已作废
Private blnIsInvoice As Boolean   '开票标志
Private blnIsVouchered As Boolean '是否已生成凭证
Private blnEdit As Boolean        '编辑权限
Private blnChange As Boolean      '只能编辑和删除自己制作的单据
Private mblnIsSaveListset As Boolean                            'Whether or not save lngViewID in list
Private mblnFinish As Boolean
'设置单据类型
Public Sub SetFormType(intType As Integer)
    Select Case intType
    Case 11 '商品销售
        #If conVersionType = 16 Then
            strTypeName = "销售发票"
        #Else
            strTypeName = "商品销售"
        #End If
        intViewID = 78
        
    Case 12 '直运销售
        strTypeName = "直运销售单"
        intViewID = 343
        
    Case 13 '代销出库
        strTypeName = "委托代销出库单"
        intViewID = 344
        
    Case 14 '代销结算
        strTypeName = "委托代销结算单"
        intViewID = 345
        
    Case 15 '加工出库
        strTypeName = "加工出库单"
        intViewID = 346
        
    Case 16 '分期出库
        strTypeName = "分期出库单"
        intViewID = 347
        
    Case 17 '分期结算
        strTypeName = "分期结算单"
        intViewID = 348
        
    Case 18 '销售发票
        strTypeName = "销售发票"
        intViewID = 349
        
    Case 19 '领用出库
        strTypeName = "领用出库单"
        intViewID = 350
        
    Case 20 '成本调整
        strTypeName = "成本调整单"
        intViewID = 351
        
    Case 21 '盘亏出库
        strTypeName = "盘亏出库单"
        intViewID = 352
        
    Case 22 '其它出库
        strTypeName = "其它出库单"
        intViewID = 353
    End Select
    intFormType = intType
End Sub

Private Sub cMsgBox(strMsg As String, Optional strTitle As String)
    If Trim(strTitle) = "" Then
        strTitle = "提示信息"
    End If

    ShowMsg Me.hwnd, strMsg, MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strTitle
End Sub

Private Sub GotoRow(lngRow As Long)
    With grdList
        .Row = lngRow
        .ColSel = .Cols - 1
    End With
End Sub

'返回行为row，列为col的cell在TextArray中的位置
Private Function pos(Row As Long, col As Long) As Long
    pos = col + grdList.Cols * Row
End Function

'获得当前行的lngActivityID
Private Function GetlngActivityID()
    With grdList
        If .Row > 0 And .ColSel <> 0 And .RowHeight(.Row) > 0 Then
            GetlngActivityID = CLng(.TextMatrix(.Row, 0))
        Else
            GetlngActivityID = 0
        End If
    End With
End Function
Private Function GetlngActivityTypeID(lngActivityID As Long) As Long
    Dim strSql As String
    Dim recTemplete As rdoResultset
    strSql = "SELECT lngActivityTypeID From ItemActivity where lngActivityID=" & lngActivityID
    Set recTemplete = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemplete.RowCount > 0 Then GetlngActivityTypeID = recTemplete!lngActivityTypeID
End Function
'返回本张单的各种状态
Private Function GetItemStatus(lngActivityID As Long) As Boolean
    Dim strSql As String
    Dim recTemp As rdoResultset
    
    strSql = "SELECT ItemActivity.lngVoucherID, ItemActivity.lngOperatorID, ItemActivity.blnIsInvoice From ItemActivity" _
            & " WHERE (ItemActivity.lngActivityID)=" & lngActivityID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.BOF And recTemp.EOF Then
        cMsgBox "请刷新列表后再执行！"
        Exit Function
    End If
        
    '1
    If recTemp(0) > 0 Then
        blnIsVouchered = True
    Else
        blnIsVouchered = False
    End If
    '2