budgetfixedsum.frm

金算盘软件代码

VERSION 5.00
Object = "{9C4B12C2-D5CE-11D1-9ABC-444553540000}#1.0#0"; "GACEDIT.DLL"
Begin VB.Form frmBudgetFixedSum 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "固定数额"
   ClientHeight    =   1695
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4185
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1695
   ScaleWidth      =   4185
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin GATLCTRLLibCtl.CalEdit txtBudget 
      Height          =   300
      Left            =   480
      OleObjectBlob   =   "BudgetFixedSum.frx":0000
      TabIndex        =   1
      Top             =   840
      Width           =   1935
   End
   Begin VB.CommandButton cmdBudget 
      Height          =   350
      Index           =   1
      Left            =   2880
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   600
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdBudget 
      Height          =   350
      Index           =   0
      Left            =   2880
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   180
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "固定数额(&M)"
      Height          =   255
      Left            =   480
      TabIndex        =   0
      Top             =   480
      Width           =   1995
   End
End
Attribute VB_Name = "frmBudgetFixedSum"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mblnIsOK As Boolean
Private mdblSum As Double
Private mdblFactor As Double

'显示固定金额
Public Function ShowCard(dblSum As Double, Optional strCaption As String = "", Optional dblFactor As Double = 0) As Boolean
    mblnIsOK = False
    mdblFactor = dblFactor
    If strCaption <> "" Then Label1.Caption = strCaption & "(&M)"
    If dblSum > 0 And dblSum < 1 Then
        txtBudget.Text = Format(dblSum, "####0.00")
    ElseIf dblSum = 0 Then
        txtBudget.Text = ""
    Else
        txtBudget.Text = dblSum
    End If
    Me.Show vbModal
    If mblnIsOK Then
        dblSum = mdblSum
        ShowCard = True
    Else
        ShowCard = False
    End If
End Function

Private Sub cmdBudget_Click(Index As Integer)
    Dim dblValue As Double
    Dim intValue As Double
    Dim strQuantity As String
    
    Select Case Index
        Case 0
            If txtBudget.Text = "" Then
                If ShowMsg(Me.hwnd, "由于没有金额输入，系统将清除指定预算数据！", vbQuestion + vbOKCancel, Me.Caption) = vbCancel Then
                    txtBudget.SetFocus
                    Exit Sub
                End If
            End If
            If txtBudget.Text = "" Then
                txtBudget.Text = "0"
            End If
            If mdblFactor > 0 Then
                dblValue = CDbl(txtBudget.Value)
                intValue = (dblValue - 0.5) \ 1
                If dblValue = intValue Then
                    mdblSum = NumberConvert(intValue, mdblFactor)
                    mblnIsOK = True
                    Unload Me
                Else
                    strQuantity = BillPublic.DisplayData(Me.hwnd, CStr(dblValue), mdblFactor)
                    If intValue = CDbl(strQuantity) Then
                        txtBudget.SetFocus
                    Else
                        mdblSum = CDbl(NumberConvert(strQuantity, mdblFactor))
                        mblnIsOK = True
                        Unload Me
                    End If
                End If
            Else
                mdblSum = CDbl(txtBudget.Value)
                mblnIsOK = True
                Unload Me
            End If
        Case 1
            mdblSum = 0
            Unload Me
    End Select
End Sub

Private Sub Form_Activate()
    SetHelpID HelpContextID
    frmMain.SetEditUnEnabled
End Sub

Private Sub Form_Load()
    Me.HelpContextID = 10222
    Set Me.Icon = GetFormResPicture(139, vbResIcon)
    Set cmdBudget(0).Picture = GetFormResPicture(1001, vbResBitmap)
    Set cmdBudget(1).Picture = GetFormResPicture(1002, vbResBitmap)
End Sub

Private Sub Form_Paint()
    FrameBox Me.hwnd, 180, 180, 2700, 1420
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture 139
    Utility.RemoveFormResPicture 1001
    Utility.RemoveFormResPicture 1002
End Sub

Private Sub txtBudget_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
    If KeyCode = 13 Then
        cmdBudget_Click 0
    End If
End Sub