📄 traderecord.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmTradeRecord
BorderStyle = 3 'Fixed Dialog
Caption = "历史交易记录"
ClientHeight = 5100
ClientLeft = 45
ClientTop = 330
ClientWidth = 4455
Icon = "TradeRecord.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5100
ScaleWidth = 4455
ShowInTaskbar = 0 'False
Begin VB.Frame Frame1
Height = 4485
Left = 60
TabIndex = 14
Top = 0
Width = 4335
Begin VB.TextBox txtMemo
Height = 315
Left = 1200
TabIndex = 10
Text = "Text9"
Top = 4050
Width = 2925
End
Begin VB.TextBox txtNextPrice
Height = 315
Left = 1200
TabIndex = 9
Text = "Text8"
Top = 3630
Width = 2925
End
Begin VB.TextBox txtPrePrice
Height = 315
Left = 1200
TabIndex = 8
Text = "Text7"
Top = 3195
Width = 2925
End
Begin VB.TextBox txtCount
Height = 315
Left = 1200
TabIndex = 7
Text = "Text6"
Top = 2775
Width = 2925
End
Begin VB.TextBox txtPrice
Height = 315
Left = 1200
TabIndex = 6
Text = "Text5"
Top = 2355
Width = 2925
End
Begin VB.TextBox txtGuiGe
Height = 315
Left = 1200
TabIndex = 4
Text = "Text3"
Top = 1515
Width = 2925
End
Begin VB.TextBox txtNo
Height = 315
Left = 1200
TabIndex = 3
Text = "Text2"
Top = 1080
Width = 2925
End
Begin VB.TextBox txtName
Enabled = 0 'False
Height = 315
Left = 1200
TabIndex = 0
Text = "Text1"
Top = 240
Width = 2505
End
Begin VB.CommandButton cmdChose
Caption = "..."
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 3780
TabIndex = 1
Top = 240
Width = 345
End
Begin MSComCtl2.DTPicker dtpDate
Height = 315
Left = 1200
TabIndex = 2
Top = 660
Width = 1695
_ExtentX = 2990
_ExtentY = 556
_Version = 393216
Format = 30146560
CurrentDate = 37642
End
Begin VB.TextBox txtType
Height = 315
Left = 1200
TabIndex = 5
Text = "Text4"
Top = 1935
Width = 2925
End
Begin VB.Label Label10
Caption = "备注："
Height = 315
Left = 240
TabIndex = 24
Top = 4020
Width = 975
End
Begin VB.Label Label9
Caption = "成交价格："
Height = 315
Left = 240
TabIndex = 23
Top = 3615
Width = 975
End
Begin VB.Label Label8
Caption = "接洽价格："
Height = 315
Left = 240
TabIndex = 22
Top = 3225
Width = 975
End
Begin VB.Label Label7
Caption = "数量："
Height = 315
Left = 240
TabIndex = 21
Top = 2820
Width = 975
End
Begin VB.Label Label6
Caption = "单价："
Height = 315
Left = 240
TabIndex = 20
Top = 2415
Width = 975
End
Begin VB.Label Label5
Caption = "型号："
Height = 315
Left = 240
TabIndex = 19
Top = 2025
Width = 975
End
Begin VB.Label Label4
Caption = "规格："
Height = 315
Left = 240
TabIndex = 18
Top = 1620
Width = 975
End
Begin VB.Label Label3
Caption = "单号："
Height = 315
Left = 240
TabIndex = 17
Top = 1215
Width = 975
End
Begin VB.Label Label2
Caption = "日期："
Height = 435
Left = 240
TabIndex = 16
Top = 705
Width = 975
End
Begin VB.Label Label1
Caption = "客户名称："
Height = 315
Left = 240
TabIndex = 15
Top = 300
Width = 975
End
End
Begin VB.CommandButton cmdClose
Caption = "关闭"
Height = 345
Left = 3000
TabIndex = 13
Top = 4650
Width = 1245
End
Begin VB.CommandButton cmdSaveClose
Caption = "保存并关闭"
Height = 345
Left = 1680
TabIndex = 12
Top = 4650
Width = 1245
End
Begin VB.CommandButton cmdSaveNew
Caption = "保存并新建"
Height = 345
Left = 270
TabIndex = 11
Top = 4650
Width = 1245
End
End
Attribute VB_Name = "frmTradeRecord"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public mbAdd As Boolean
Public mTRID As Long
Private Function mbSaveTradeRecord() As Boolean
'**********************************************
'
'保存当前的单据
'
'**********************************************
Dim sSql As String
Dim Rs As New ADODB.Recordset
Dim lID As Long
On Error GoTo ErrSave
'检验数据正确性
If mbCheckOk() = False Then mbSaveTradeRecord = False: Exit Function
Screen.MousePointer = vbHourglass
Rs.Open "Select max(TR_ID) from TradeRecord", CN
If IsNull(Rs.Fields(0)) Then
lID = 1
Else
lID = CLng(Rs.Fields(0)) + 1
End If
Rs.Close
If mbAdd = False Then
sSql = "Delete from TradeRecord where TR_ID=" & mTRID
sSql = sSql & vbCrLf & "Insert TradeRecord (TR_ID,TR_AID,TR_Date,TR_InvoiceNo,TR_Specs,TR_Type,TR_Price,TR_Count,TR_PrePrice,TR_AftPrice,TR_Memo) values("
sSql = sSql & mTRID & ","
sSql = sSql & txtName.Tag & ",'"
sSql = sSql & Format(dtpDate.Value, "yyyy-mm-dd") & "','"
sSql = sSql & DoubleQuote(txtNo.Text) & "','"
sSql = sSql & DoubleQuote(txtGuiGe.Text) & "','"
sSql = sSql & DoubleQuote(txtType.Text) & "',"
sSql = sSql & Val(txtPrice.Text) & ","
sSql = sSql & Val(txtCount.Text) & ","
sSql = sSql & Val(txtPrePrice.Text) & ","
sSql = sSql & Val(txtNextPrice.Text) & ",'"
sSql = sSql & DoubleQuote(txtMemo.Text) & "')"
Else
sSql = "Insert TradeRecord (TR_ID,TR_AID,TR_Date,TR_InvoiceNo,TR_Specs,TR_Type,TR_Price,TR_Count,TR_PrePrice,TR_AftPrice,TR_Memo) values("
sSql = sSql & lID & ","
sSql = sSql & txtName.Tag & ",'"
sSql = sSql & Format(dtpDate.Value, "yyyy-mm-dd") & "','"
sSql = sSql & DoubleQuote(txtNo.Text) & "','"
sSql = sSql & DoubleQuote(txtGuiGe.Text) & "','"
sSql = sSql & DoubleQuote(txtType.Text) & "',"
sSql = sSql & Val(txtPrice.Text) & ","
sSql = sSql & Val(txtCount.Text) & ","
sSql = sSql & Val(txtPrePrice.Text) & ","
sSql = sSql & Val(txtNextPrice.Text) & ",'"
sSql = sSql & DoubleQuote(txtMemo.Text) & "')"
End If
If sSql <> "" Then
CN.Execute sSql
mbSaveTradeRecord = True
Else
mbSaveTradeRecord = False
End If
Screen.MousePointer = vbDefault
Exit Function
ErrSave:
Screen.MousePointer = vbDefault
mbSaveTradeRecord = False
gShowMsg "保存交易记录时出错 frmTradeRecord.mbSaveTradeRecord"
End Function
Private Function mbCheckOk() As Boolean
'**********************************************
'
'校验输入内容的合法性
'
'**********************************************
Dim sSql As String
Dim Rs As New ADODB.Recordset
On Error GoTo ErrCheckOk
If txtName.Tag = "" Then
MsgBox "请选择客户名称！！！", vbInformation, ""
mbCheckOk = False
Exit Function
Else
mbCheckOk = True
End If
Exit Function
ErrCheckOk:
Screen.MousePointer = vbDefault
mbCheckOk = False
gShowMsg "校验交易记录出错 frmTradeRecord.mbCheckOK"
End Function
Private Function mbShowOldTradeRecord() As Boolean
'***********************************************
'
'显示要修改交易记录
'
'***********************************************
Dim sSql As String
Dim Rs As New ADODB.Recordset
Dim iRow As Integer
On Error GoTo ErrShowOldTradeRecord
sSql = "Select TR_ID,CT.CT_Name,TR_AID,TR_Date,TR_InvoiceNo,TR_Specs,TR_Type,TR_Price,TR_Count,TR_PrePrice,TR_AftPrice,TR_Memo"
sSql = sSql & vbCrLf & " from TradeRecord TR inner join Customers CT on CT.CT_AID=TR.TR_AID"
sSql = sSql & vbCrLf & " where TR_ID = " & mTRID
Screen.MousePointer = vbHourglass
Rs.Open sSql, CN
Screen.MousePointer = vbDefault
'客户名称
txtName.Text = IIf(IsNull(Rs.Fields!CT_Name), "", Rs.Fields!CT_Name)
txtName.Tag = IIf(IsNull(Rs.Fields!TR_AID), 0, Rs.Fields!TR_AID)
'日期
dtpDate.Value = Format(IIf(IsNull(Rs.Fields!TR_Date), Now, Rs.Fields!TR_Date), "yyyy-mm-dd")
'单据号
txtNo = IIf(IsNull(Rs.Fields!TR_InvoiceNo), "", Rs.Fields!TR_InvoiceNo)
'规格
txtGuiGe.Text = IIf(IsNull(Rs.Fields!TR_Specs), "", Rs.Fields!TR_Specs)
'型号
txtType = IIf(IsNull(Rs.Fields!TR_Type), "", Rs.Fields!TR_Type)
'单价
txtPrice = IIf(IsNull(Rs.Fields!TR_Price), "0.00", Format(Rs.Fields!TR_Price, "0.00"))
'数据量
txtCount = IIf(IsNull(Rs.Fields!TR_Count), "0", Format(Rs.Fields!TR_Count, "0.00"))
'接洽价
txtPrePrice = IIf(IsNull(Rs.Fields!TR_PrePrice), "0", Format(Rs.Fields!TR_PrePrice, "0.00"))
'成交价
txtNextPrice = IIf(IsNull(Rs.Fields!TR_AftPrice), "0.00", Format(Rs.Fields!TR_AftPrice, "0.00"))
'备注
txtMemo.Text = IIf(IsNull(Rs.Fields!TR_Memo), "", Rs.Fields!TR_Memo)
mbShowOldTradeRecord = True
Exit Function
ErrShowOldTradeRecord:
Screen.MousePointer = vbDefault
mbShowOldTradeRecord = False
gShowMsg "显示要修改的交易记录时出错 frmTradeRecord.mbShowOldTradeRecord"
End Function
Private Sub mClear()
'清空控件的值
txtName.Text = ""
txtName.Tag = ""
dtpDate.Value = Now
txtNo.Text = ""
txtGuiGe.Text = ""
txtType.Text = ""
txtPrice.Text = ""
txtCount.Text = ""
txtPrePrice.Text = ""
txtNextPrice.Text = ""
txtMemo.Text = ""
End Sub
Private Sub cmdChose_Click()
frmSearchArch.Show vbModal
If frmSearchArch.mArchiveID <> 0 Then
txtName.Text = frmSearchArch.mCustomerName
txtName.Tag = frmSearchArch.mArchiveID
End If
Unload frmSearchArch
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdSaveClose_Click()
If mbSaveTradeRecord Then
Call SendMessageToCtl(frmMain.vsf, WM_KEYDOWN, VK_F5, 0)
Call mClear
Unload Me
End If
End Sub
Private Sub cmdSaveNew_Click()
If mbSaveTradeRecord Then
Call SendMessageToCtl(frmMain.vsf, WM_KEYDOWN, VK_F5, 0)
Call mClear
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
KeyAscii = 0
SendKeys "{tab}"
ElseIf KeyAscii = vbKeyEscape Then
KeyAscii = 0
Unload Me
End If
End Sub
Private Sub Form_Load()
Center Me
Me.KeyPreview = True
Call mClear
If mbAdd = False Then
cmdSaveNew.Enabled = False
Call mbShowOldTradeRecord
End If
End Sub
Private Sub txtCount_KeyPress(KeyAscii As Integer)
KeyAscii = gNumericKey(KeyAscii, True)
End Sub
Private Sub txtNextPrice_KeyPress(KeyAscii As Integer)
KeyAscii = gNumericKey(KeyAscii, True)
End Sub
Private Sub txtPrePrice_KeyPress(KeyAscii As Integer)
KeyAscii = gNumericKey(KeyAscii, True)
End Sub
Private Sub txtPrice_KeyPress(KeyAscii As Integer)
KeyAscii = gNumericKey(KeyAscii, True)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -