📄 budgetfill.frm
字号:
VERSION 5.00
Object = "{9C4B12C2-D5CE-11D1-9ABC-444553540000}#1.0#0"; "GATLCTRL.DLL"
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form frmBudgetFill
BorderStyle = 1 'Fixed Single
Caption = "预算填充"
ClientHeight = 2520
ClientLeft = 45
ClientTop = 330
ClientWidth = 4530
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2520
ScaleWidth = 4530
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin GATLCTRLLibCtl.CalEdit txtBudget
Height = 270
Left = 1800
OleObjectBlob = "BudgetFill.frx":0000
TabIndex = 1
Top = 480
Width = 1110
End
Begin VB.CommandButton cmdBudget
Height = 350
Index = 1
Left = 3240
Style = 1 'Graphical
TabIndex = 7
Top = 660
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdBudget
Height = 350
Index = 0
Left = 3240
Style = 1 'Graphical
TabIndex = 6
Top = 240
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.Label lblAmount
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Height = 270
Index = 1
Left = 1800
TabIndex = 3
Top = 840
Width = 1110
End
Begin VB.Label lblAmount
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Height = 270
Index = 0
Left = 1800
TabIndex = 8
Top = 480
Width = 1110
End
Begin VB.Label Label1
Caption = "填充方向"
Height = 210
Index = 2
Left = 480
TabIndex = 11
Top = 1560
Width = 720
End
Begin VB.Label Label1
Caption = "填充数额"
Height = 210
Index = 0
Left = 480
TabIndex = 10
Top = 150
Width = 720
End
Begin MSForms.OptionButton optBudget
Height = 255
Index = 3
Left = 1810
TabIndex = 5
Top = 1890
Width = 975
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 5
Size = "1720;450"
Value = "0"
Caption = "向上"
GroupName = "2"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
Begin MSForms.OptionButton optBudget
Height = 255
Index = 2
Left = 360
TabIndex = 4
Top = 1890
Width = 975
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 5
Size = "1720;450"
Value = "1"
Caption = "向下"
GroupName = "2"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
Begin VB.Label Label1
Caption = "%"
Height = 255
Index = 1
Left = 2940
TabIndex = 9
Top = 900
Width = 120
End
Begin MSForms.OptionButton optBudget
Height = 255
Index = 1
Left = 360
TabIndex = 2
Top = 840
Width = 1410
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 5
Size = "2487;450"
Value = "0"
Caption = "按比例填充"
GroupName = "1"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
Begin MSForms.OptionButton optBudget
Height = 255
Index = 0
Left = 360
TabIndex = 0
Top = 480
Width = 1410
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 5
Size = "2487;450"
Value = "1"
Caption = "增加一定数额"
GroupName = "1"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
End
Attribute VB_Name = "frmBudgetFill"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mintDirection As Integer
Private mintStyle As Integer
Private mdblSum As Double
Private mblnIsOK As Boolean
Private mdblFactor As Double
'显示预算填充
Public Function ShowCard(Direction As Integer, Style As Integer, Sum As Double _
, Optional dblFactor As Double = 0) As Boolean
mblnIsOK = False
mdblFactor = dblFactor
Me.Show vbModal
If mblnIsOK Then
Direction = mintDirection
Style = mintStyle
Sum = mdblSum
ShowCard = True
Else
ShowCard = False
End If
End Function
Private Sub Form_Activate()
SetHelpID HelpContextID
frmMain.SetEditUnEnabled
End Sub
Private Sub Form_Load()
Me.HelpContextID = 10223
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, 150, 210, 3120, 1350
FrameBox Me.hwnd, 150, 1620, 3120, 2325
End Sub
Private Sub cmdBudget_Click(Index As Integer)
Dim dblValue As Double
Dim intValue As Integer
Dim strQuantity As String
Select Case Index
Case 0 '确定
If optBudget(1).Value Then
If txtBudget.Value < -100 Then
ShowMsg Me.hwnd, "比例值必须大于-100%！", vbInformation, Me.Caption
txtBudget.SetFocus
Exit Sub
End If
End If
If optBudget(0).Value Then
mintStyle = 1
If txtBudget.Text = "" Then
mdblSum = 0
Else
If mdblFactor > 0 Then
dblValue = CDbl(txtBudget.Value)
intValue = (dblValue - 0.5) \ 1
If dblValue = intValue Then
mdblSum = CDbl(NumberConvert(intValue, mdblFactor))
Else
strQuantity = BillPublic.DisplayData(Me.hwnd, CStr(dblValue), mdblFactor)
If intValue = CDbl(strQuantity) Then
txtBudget.SetFocus
Exit Sub
Else
mdblSum = CDbl(NumberConvert(strQuantity, mdblFactor))
End If
End If
Else
mdblSum = CDbl(NumberConvert(txtBudget.Value, mdblFactor))
End If
End If
Else
mintStyle = 2
If txtBudget.Text = "" Then
mdblSum = 0
Else
mdblSum = CDbl(txtBudget.Value)
End If
End If
If optBudget(2).Value Then
mintDirection = 1
Else
mintDirection = 2
End If
mblnIsOK = True
Unload Me
Case 1 '取消
Unload Me
End Select
End Sub
Private Sub Form_Unload(Cancel As Integer)
Utility.RemoveFormResPicture 139
Utility.RemoveFormResPicture 1001
Utility.RemoveFormResPicture 1002
End Sub
Private Sub optBudget_Click(Index As Integer)
Select Case Index
Case 0
txtBudget.Left = lblAmount(0).Left
txtBudget.top = lblAmount(0).top
txtBudget.Text = ""
Case 1
txtBudget.Left = lblAmount(1).Left
txtBudget.top = lblAmount(1).top
txtBudget.Text = ""
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -