frmcalcamount.frm

金算盘软件代码

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{F6125AB1-8AB1-11CE-A77F-08002B2F4E98}#2.0#0"; "MSRDC20.OCX"
Begin VB.Form FrmCalcAmount 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "只有金额的入库资料"
   ClientHeight    =   4350
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7965
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4350
   ScaleWidth      =   7965
   StartUpPosition =   2  '屏幕中心
   Begin MSRDC.MSRDC datItem 
      Height          =   330
      Left            =   6720
      Top             =   3000
      Visible         =   0   'False
      Width           =   1200
      _ExtentX        =   2117
      _ExtentY        =   582
      _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.CommandButton cmdList 
      Caption         =   "全部取消"
      Height          =   350
      Index           =   3
      Left            =   6630
      TabIndex        =   5
      Top             =   1590
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdList 
      Caption         =   "全部选择"
      Height          =   350
      Index           =   2
      Left            =   6630
      TabIndex        =   4
      Top             =   1230
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdList 
      Height          =   350
      Index           =   0
      Left            =   6630
      Style           =   1  'Graphical
      TabIndex        =   3
      Tag             =   "1001"
      Top             =   345
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdList 
      Height          =   350
      Index           =   1
      Left            =   6630
      Style           =   1  'Graphical
      TabIndex        =   2
      Tag             =   "1002"
      Top             =   705
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin MSFlexGridLib.MSFlexGrid msgTable 
      Bindings        =   "FrmCalcAmount.frx":0000
      Height          =   3945
      Left            =   45
      TabIndex        =   0
      Top             =   345
      Width           =   6435
      _ExtentX        =   11351
      _ExtentY        =   6959
      _Version        =   393216
   End
   Begin VB.Label lblNote 
      AutoSize        =   -1  'True
      Caption         =   "期间"
      Height          =   180
      Index           =   1
      Left            =   5370
      TabIndex        =   6
      Top             =   120
      Width           =   360
   End
   Begin VB.Label lblNote 
      AutoSize        =   -1  'True
      Caption         =   "选择进入本期成本的明细资料："
      Height          =   180
      Index           =   0
      Left            =   90
      TabIndex        =   1
      Top             =   105
      Width           =   2520
   End
End
Attribute VB_Name = "FrmCalcAmount"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'Private WithEvents mclsMainControl As MainControl               '主控对象
Private WithEvents mclsGrid As Grid                             'Grid对象
Attribute mclsGrid.VB_VarHelpID = -1
Private WithEvents mclsSubClassform As SubClass32.SubClass      '钩子对象
Attribute mclsSubClassform.VB_VarHelpID = -1

Private Const HelpID = 13007
Private Const mViewID = 545                                     '视图号

Private Const mlngFormMinWidth = 450                            '窗体最小尺寸
Private Const mlngFormMinHeight = 200

Private Const mintLeft = 50                                     '窗体位置尺寸
Private Const mintTop = 420
Private Const mintBottomHeight = 75

Private Const mintColDetailID = 0                               '入库ID列号
Private Const mintColItemID = 1                                 '商品ID列号
Private Const mintColUnitID = 2                                  '选择列号
Private Const mintColCheck = 11                                  '选择列号
Private Const mintColAmt = 16                                    '选择列号

Private mintPeriod As Integer
Private mintYear As Integer
Private mlngID As Long
Private mdtmStart As Date
Private mdtmEnd As Date
Private mblnOk As Boolean

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'        外部方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function SetParameters(strPeriod As String) As Boolean
    mintPeriod = GetbytPeriod(strPeriod)
    mintYear = GetintYear(strPeriod)
    mlngID = CLng(GetintYear(strPeriod)) * 100 + GetbytPeriod(strPeriod)
    gclsBase.DateOfPeriod mintYear, mintPeriod, mdtmStart, mdtmEnd
    lblNote(1) = strPeriod
    Show vbModal
    SetParameters = mblnOk
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'        私有方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'生成列表结果集
Private Function GetList() As rdoResultset
    Dim strSelect As String
    Dim strFrom As String
    Dim strWhere As String
    Dim strSql As String
    Dim errNo As Long
    
    On Error GoTo ErrHandle
    
    strSelect = mclsGrid.ListSet.SelectOfSql
    strFrom = mclsGrid.ListSet.FromOfSql
    strWhere = mclsGrid.ListSet.WhereOfSql
    
    strSelect = "SELECT lngActivityDetailID,ItemActivityDetail.lngItemID,ItemActivityDetail.lngUnitID," _
        & "ItemActivityDetail.lngPositionID,ItemActivityDetail.strProduceNum,ItemActivityDetail.lngCustomID0," _
        & "ItemActivityDetail.lngCustomID1,ItemActivityDetail.lngCustomID2,ItemActivityDetail.lngCustomID3," _
        & "ItemActivityDetail.lngCustomID4,ItemActivityDetail.lngCustomID5," _
        & "DECODE(lngCostOrder," & mlngID & ",'√','') As 选择," & strSelect
    strWhere = " WHERE " & strWhere & " AND dblQuantity=0 AND dblAmount<>0 AND lngActivityTypeID IN (1,2,3,5,8,9,10) AND strItemCategory='1' " _
        & "AND (lngCostOrder>=" & mlngID & " OR lngCostOrder=0) AND (strCostMethod='3' OR strCostMethod='4') AND blnIsVoid=0"
    strSql = strSelect & " " & strFrom & " " & strWhere
    Set GetList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Exit Function
    
ErrHandle:
    errNo = Errors.ErrorsDeal(True, Me)
    Select Case errNo
    Case edtResume: Resume
    Case edtResumeNext: Resume Next
    Case edtCanNotKnown
        ShowMsg hwnd, "程序出错：" & Err.Description, vbOKOnly + vbCritical, Caption
    End Select
End Function


Private Sub cmdList_Click(Index As Integer)
    Select Case Index
    Case 0 '确定
        mblnOk = True
        GenCostAdjust
        Unload Me
    Case 1 '取消
        mblnOk = False
        Unload Me
    Case 2 '全部选择
        ChoiceAll
    Case 3 '全部取消
        ClearAll
    End Select
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'        Form 事件、方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
    Me.MousePointer = vbHourglass
    
    Me.HelpContextID = HelpID
    
    mblnOk = False
    'Grid对象
    Set mclsGrid = New Grid
    
    '主控对象
'    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Utility.LoadFormResPicture Me