frmfillprice.frm

金算盘软件代码

VERSION 5.00
Begin VB.Form frmFillPrice 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "填充单价"
   ClientHeight    =   2295
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4620
   HelpContextID   =   18007
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2295
   ScaleWidth      =   4620
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame fraFillPrice 
      Caption         =   "填充方向"
      Height          =   615
      Index           =   1
      Left            =   150
      TabIndex        =   9
      Top             =   1440
      Width           =   2865
      Begin VB.OptionButton optDirection 
         Caption         =   "向下"
         Height          =   180
         Index           =   1
         Left            =   1620
         TabIndex        =   5
         Top             =   300
         Value           =   -1  'True
         Width           =   1035
      End
      Begin VB.OptionButton optDirection 
         Caption         =   "向上"
         Height          =   180
         Index           =   0
         Left            =   210
         TabIndex        =   4
         Top             =   300
         Width           =   915
      End
   End
   Begin VB.CommandButton cmdFillPrice 
      Height          =   350
      Index           =   0
      Left            =   3210
      Style           =   1  'Graphical
      TabIndex        =   6
      Tag             =   "1001"
      Top             =   150
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdFillPrice 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   3210
      Style           =   1  'Graphical
      TabIndex        =   7
      Tag             =   "1002"
      Top             =   540
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.Frame fraFillPrice 
      Caption         =   "填充数据"
      Height          =   1215
      Index           =   0
      Left            =   150
      TabIndex        =   8
      Top             =   120
      Width           =   2865
      Begin VB.TextBox txtFillPrice 
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   285
         Index           =   1
         Left            =   1590
         MaxLength       =   10
         TabIndex        =   3
         Top             =   720
         Width           =   915
      End
      Begin VB.TextBox txtFillPrice 
         Height          =   270
         Index           =   0
         Left            =   1590
         TabIndex        =   1
         Top             =   360
         Width           =   915
      End
      Begin VB.OptionButton optData 
         Caption         =   "按比例填充"
         Height          =   195
         Index           =   1
         Left            =   210
         TabIndex        =   2
         Top             =   780
         Width           =   1455
      End
      Begin VB.OptionButton optData 
         Caption         =   "增加一定金额"
         Height          =   225
         Index           =   0
         Left            =   210
         TabIndex        =   0
         Top             =   360
         Value           =   -1  'True
         Width           =   1695
      End
      Begin VB.Label lblFillPrice 
         Caption         =   "%"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Left            =   2550
         TabIndex        =   10
         Top             =   780
         Width           =   135
      End
   End
End
Attribute VB_Name = "frmFillPrice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''
'    填充单价卡片
'
'    作者：郑权
'
'    日期：98.7.14
'
'    入口：msgUpdatePrice属性接收MSFlexGrid
'
'''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private mblnIsChanged As Boolean '数据是否改变
Private mbytDec As Byte
Private mbytCol As Byte
Private mbytSCol As Byte
Private mintRow As Integer
Private msgFillPrice As MSFlexGrid

Public Property Let RowNo(ByVal vNewValue As Integer)
    mintRow = vNewValue
End Property

Public Property Let colNo(ByVal vNewValue As Byte)
    mbytCol = vNewValue
End Property

Public Property Let ScolNo(ByVal vNewValue As Byte)
    mbytSCol = vNewValue
End Property

Public Property Set msgUpdatePrice(ByVal vNewValue As MSFlexGrid)
     Set msgFillPrice = vNewValue
End Property

Public Property Let Dec(ByVal vNewValue As Byte)
    mbytDec = vNewValue
End Property

Private Function CalcPrice(ByVal iRow As Integer, ByVal iCol As Integer) As Double
    Dim dblPrice As Double
    
    With msgFillPrice
    dblPrice = TxtToDouble(.TextMatrix(iRow, iCol))
    If optData(0).Value Then
        If Trim(txtFillPrice(0).Text) <> "" Then
            CalcPrice = dblPrice + TxtToDouble(txtFillPrice(0).Text)
        End If
    Else
        CalcPrice = dblPrice * TxtToDouble(txtFillPrice(1).Text) / 100
    End If
    End With
    If CalcPrice < 0 Then CalcPrice = 0
End Function

'Private Function GetColNO(ByRef mbytscol As Integer) As Integer
'    Dim iCol As Integer, strTitle As String
'
'    With msgFillPrice
'    For iCol = 1 To .Cols - 1
'        If InStr(1, .TextMatrix(0, iCol), "新") <> 0 Then Exit For
'    Next iCol
'    strTitle = Mid(.TextMatrix(0, iCol), 2)
'    For mbytscol = 1 To .Cols - 1
'        If .TextMatrix(0, mbytscol) = strTitle Then Exit For
'    Next mbytscol
'    End With
'    GetColNO = iCol
'End Function
'
'向调整价格卡片保存数据
Private Sub SaveData()
    Dim iRow As Integer
    Dim dblPrice As Double '当前行，新销售价列值
    
    With msgFillPrice
    If optDirection(0).Value Then
        For iRow = mintRow To 1 Step -1
            If .TextMatrix(iRow, 1) = "√" Then
                .TextMatrix(iRow, mbytCol) = FormatShow(CalcPrice(iRow, mbytSCol), mbytDec)
                .RowData(iRow) = -1
            End If
        Next iRow
    Else
        For iRow = mintRow To .Rows - 1
            If .TextMatrix(iRow, 1) = "√" Then
                .TextMatrix(iRow, mbytCol) = FormatShow(CalcPrice(iRow, mbytSCol), mbytDec)
                .RowData(iRow) = -1
            End If
        Next iRow
    End If
    End With
    mblnIsChanged = False
End Sub

Private Sub cmdFillPrice_Click(Index As Integer)
    If Index = 0 Then
        SaveData
        frmAdaptCard.IsChanged = True
    End If
    mblnIsChanged = False
    Unload Me
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        If Shift = 2 Then
            cmdFillPrice(0).Value = True
        Else
            BKKEY Me.ActiveControl.hwnd, vbKeyTab
        End If
    End If
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
'    SetHelpID hwnd, 18007
    Utility.LoadFormResPicture Me
    Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Dim intResponse As Integer
    
    If mblnIsChanged Then
        intResponse = MsgBox("当前填充单价已被修改，是否保存？", _
            vbYesNoCancel + vbQuestion, Caption)
        If intResponse = vbYes Then
            SaveData
        ElseIf intResponse = vbCancel Then
            Cancel = True
        End If
    End If
    If Not Cancel Then mblnIsChanged = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    mblnIsChanged = False
    Utility.UnLoadFormResPicture Me
End Sub

'选项框事件
Private Sub optData_Click(Index As Integer)
    Select Case Index
    Case 0
        txtFillPrice(0).Enabled = True
        txtFillPrice(0).BackColor = &H80000005
        txtFillPrice(0).SetFocus
        txtFillPrice(1).Text = ""
        txtFillPrice(1).Enabled = False
        txtFillPrice(1).BackColor = &H80000004
    Case 1
        txtFillPrice(0).Text = ""
        txtFillPrice(0).Enabled = False
        txtFillPrice(0).BackColor = &H80000004
        txtFillPrice(1).Enabled = True
        txtFillPrice(1).BackColor = &H80000005
        txtFillPrice(1).SetFocus
   End Select
   mblnIsChanged = True
End Sub

Private Sub optDirection_Click(Index As Integer)
      mblnIsChanged = True
End Sub

'文本框改变事件
Private Sub txtFillPrice_Change(Index As Integer)
    If Index = 0 Then
        If Not IsNum(txtFillPrice(Index).Text, mbytDec) Then
            BKKEY txtFillPrice(Index).hwnd
        End If
    Else
        If Not ContainSpecifyChar(txtFillPrice(1).Text, ".0123456789") Then
            BKKEY txtFillPrice(1).hwnd
        ElseIf Not IsNum(txtFillPrice(1).Text, mbytDec) Then
            BKKEY txtFillPrice(1).hwnd
'        ElseIf TxtToDouble(txtFillPrice(1).Text) > 100 Then
'            BKKEY txtFillPrice(1).hwnd
        End If
    End If
    mblnIsChanged = True
End Sub

Private Sub txtFillPrice_KeyPress(Index As Integer, KeyAscii As Integer)
    If Chr(KeyAscii) < "." Or Chr(KeyAscii) > "9" Or Chr(KeyAscii) = "/" Then KeyAscii = 0
End Sub