frmliststocktaking.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 frmListStockTaking 
   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            =   5208
      Top             =   3216
      Visible         =   0   'False
      Width           =   1308
      _ExtentX        =   2307
      _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        =   2
      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        =   3
      Tag             =   "1017"
      ToolTipText     =   "再找"
      Top             =   90
      UseMaskColor    =   -1  'True
      Width           =   300
   End
   Begin VB.ComboBox cboFindKind 
      Height          =   300
      Left            =   720
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   90
      Width           =   1515
   End
   Begin MSFlexGridLib.MSFlexGrid grdList 
      Bindings        =   "frmListStockTaking.frx":0000
      Height          =   2655
      Left            =   0
      TabIndex        =   4
      Tag             =   "ctPayMethod////101"
      Top             =   480
      Width           =   6495
      _ExtentX        =   11451
      _ExtentY        =   4678
      _Version        =   393216
      Rows            =   20
      Cols            =   3
      FixedCols       =   0
      BackColor       =   -2147483634
      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        =   6
      Tag             =   "1018"
      Top             =   3240
      Visible         =   0   'False
      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        =   5
      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        =   7
      Top             =   150
      Width           =   630
   End
   Begin VB.Label lblFindKind 
      AutoSize        =   -1  'True
      Caption         =   "查找(&B)"
      Height          =   180
      Left            =   50
      TabIndex        =   0
      Top             =   150
      Width           =   630
   End
End
Attribute VB_Name = "frmListStockTaking"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'王成

'商品盘点仅针对“自制入库”

Option Explicit

Private strSql  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 mclsStockTaking As clsStockTaking
'////////////////////////////////////////////////
'/////                赋值
'////////////////////////////////////////////////
Private Const intViewID = 141                                  '商品盘点表：不同的列表窗口，其值不同

Private blnMenuBuilded As Boolean
Private strOldMenuCaption As String

Private theEditForm As Form
Private mIsShowEdit As Boolean                                 '编辑窗口是否已调出标志
Private theEditRow As Long                                     '弹出编辑窗口时本列表的当前行，编辑窗口的记录移动操作影响此值

Private bDblClick As Boolean
Private strReceiptType As String '单据类型名称

Private blnIsVoid As Boolean
Private blnEdit As Boolean '编辑权限
Private blnChange As Boolean '只能编辑和删除自己制作的单据
Public blnShowWizard As Boolean 'for SM
Private mblnIsSaveListset As Boolean                            'Whether or not save lngViewID in list


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

'获得当前行的lngStockTakingID
Private Function GetlngStockTakingID()
    With grdList
        If .Row > 0 Then
           GetlngStockTakingID = CLng(.TextMatrix(.Row, 0))
        Else
           GetlngStockTakingID = -1
        End If
    End With
End Function

'返回本张单的各种状态
Private Function GetItemStatus(lngStockTakingID As Long) As Boolean
    Dim strSql As String
    Dim recTemp As rdoResultset
    
    strSql = "SELECT StockTaking.lngOperatorID, StockTaking.blnIsVoid From StockTaking WHERE (((StockTaking.lngStockTakingID)=" & lngStockTakingID & "))"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.BOF And recTemp.EOF Then
        cMsgBox "列表的数据已被修改，请重新刷新后再进行操作！"
        Exit Function
    End If
    
    If gclsBase.OperatorID = recTemp(0) Then
        blnChange = True
    Else
        blnChange = False
    End If
    blnIsVoid = recTemp(1)
    
    Set recTemp = Nothing
    GetItemStatus = True
End Function

Public Function GetList() As rdoResultset
    Dim BeginDate As Date
    Dim EndDate As Date
    Dim recTemp As rdoResultset
    Dim strSelect As String
    Dim strFrom   As String
    Dim strWhere  As String

On Error Resume Next
    strSelect = mclsList.ListSet.SelectOfSql
    strFrom = mclsList.ListSet.FromOfSql
    strWhere = mclsList.ListSet.WhereOfSql
   
    If Trim(strSelect) = "" Or Trim(strFrom) = "" Then
        Set GetList = Nothing
        Exit Function
    End If
    If mclsList.ListSet.ListID < 1 Then
       BeginDate = gclsBase.PeriodBegin
       EndDate = gclsBase.PeriodEnd
       
       If Trim(strWhere) <> "" Then
          strWhere = " WHERE " & strWhere & " AND (To_Date(StockTaking.strDate,'rrrr-mm-dd')>=To_Date('" & _
                     BeginDate & "','rrrr-mm-dd') And To_Date(StockTaking.strDate,'rrrr-mm-dd')<=To_Date('" & _
                     EndDate & "','rrrr-mm-dd')) "
       Else
          strWhere = " WHERE " & " (To_Date(StockTaking.strDate,'rrrr-mm-dd')>=To_Date('" & _
                     BeginDate & "','rrrr-mm-dd') And To_Date(StockTaking.strDate,'rrrr-mm-dd')<=To_Date('" & _
                     EndDate & "','rrrr-mm-dd'))"
       End If
    Else
       If Trim(strWhere) <> "" Then
          strWhere = " where " & strWhere
       End If
    End If
    
    strSelect = "SELECT StockTaking.lngStockTakingID, Decode(StockTaking.blnIsVoid,1,'√','') AS ""作废""," & strSelect
    strSql = strSelect & strFrom & strWhere
    
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    '列表是否为空
    If recTemp.RowCount = 0 Then
        grdList.HighLight = flexHighlightNever      '光标亮条消失
        cmdAgain.Enabled = False
    Else
        grdList.HighLight = flexHighlightAlways     '光标亮条显示
        cmdAgain.Enabled = True
    End If
      
    mclsList.ShowAll = True
    Set GetList = recTemp
        
End Function

'根据列表中记录数，设置菜单可用属性
Private Sub UpdateMenuStatus()
    Dim blnIsnotEmpty As Boolean
    Dim blnFindNoChange As Boolean
    
    If chkShowAll.Enabled = False Then
       chkShowAll.Value = 0
       frmMain.mnuEditShowAll = False
       If grdList.ColWidth(1) <> 0 Then
          grdList.ColWidth(1) = 0
       End If
    End If
    If grdList.Rows > 1 And grdList.ColSel <> 0 Then
        blnIsnotEmpty = True
    Else
        blnIsnotEmpty = False
    End If
    
    If Not blnMenuBuilded Then
        MakeListEditMenu
    End If
    
    With frmMain
         
        .mnuEditCopy.Enabled = blnIsnotEmpty
        .mnuEditEdit.Enabled = blnIsnotEmpty And blnEdit
        .mnuEditNew.Enabled = blnEdit
        .mnuEditDel.Enabled = blnIsnotEmpty And blnEdit
        
        .mnuEditInActive.Checked = False
        .mnuEditInActive.Enabled = blnIsnotEmpty And blnEdit
        If chkShowAll.Value = 1 Then
            .mnuEditShowAll.Checked = True
        Else
            .mnuEditShowAll.Checked = False
        End If
        If chkShowAll.Enabled = True Then
            .mnuEditShowAll.Enabled = True
        Else
            .mnuEditShowAll.Enabled = False
        End If
        .mnuEditColumn.Enabled = True