📄 frmstockup.frm
字号:
Left = 7440
TabIndex = 31
Top = 285
Width = 540
End
End
Begin VB.CommandButton cmdPrint
Caption = "打印(&P)"
Height = 315
Left = 6240
TabIndex = 19
Top = 720
Width = 975
End
Begin VB.CommandButton cmdEdit
Caption = "修改(&E)"
Height = 315
Left = 2400
TabIndex = 16
Top = 720
Width = 975
End
Begin VB.CommandButton cmdAdd
Caption = "添加(&A)"
Height = 315
Left = 480
TabIndex = 15
Top = 720
Width = 975
End
End
Begin MSDataGridLib.DataGrid grdDataGrid
Height = 2715
Left = 45
TabIndex = 7
Top = 1800
Width = 9480
_ExtentX = 16722
_ExtentY = 4789
_Version = 393216
AllowUpdate = -1 'True
HeadLines = 1.5
RowHeight = 15
TabAction = 2
WrapCellPointer = -1 'True
AllowAddNew = -1 'True
AllowDelete = -1 'True
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ColumnCount = 2
BeginProperty Column00
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
EndProperty
BeginProperty Column01
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList imlToolbarIcons
Left = 4170
Top = 2700
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 2
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmStockUp.frx":0D08
Key = "Save"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmStockUp.frx":0E1A
Key = "Undo"
EndProperty
EndProperty
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "注:日期、单据号及地址电话不绑定"
ForeColor = &H000000FF&
Height = 180
Left = 240
TabIndex = 40
Top = 120
Visible = 0 'False
Width = 2790
End
Begin VB.Label lblTitle
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "采 购 单"
BeginProperty Font
Name = "隶书"
Size = 26.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 525
Index = 0
Left = 3600
TabIndex = 22
Top = 0
Width = 2685
End
Begin VB.Label lblTitle
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "采 购 单"
BeginProperty Font
Name = "隶书"
Size = 26.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 525
Index = 1
Left = 3630
TabIndex = 23
Top = 30
Width = 2685
End
End
Attribute VB_Name = "frmStockUp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim WithEvents adoPrimaryRs As ADODB.Recordset
Attribute adoPrimaryRs.VB_VarHelpID = -1
Dim WithEvents adoSecondaryRs As ADODB.Recordset
Attribute adoSecondaryRs.VB_VarHelpID = -1
Dim m_DepartRs As ADODB.Recordset
Dim m_SupplierRs As ADODB.Recordset
Dim m_EntryTypeRs As ADODB.Recordset
Dim m_byType As Byte
Dim m_sWaresCode As String, m_bIsSelectWares As Boolean
Dim m_bEdit As Boolean, m_bAuditer As Boolean, m_bKeeper As Boolean
Dim YearCol As Integer, MonthCol As Integer, TypeCol As Integer, NoCol As Integer
Dim CodeCol As Integer, NameCol As Integer, SpecCol As Integer, MeasCol As Integer
Dim QuantityCol As Integer, PriceCol As Integer, MoneyCol As Integer
Dim RateCol As Integer, TaxCol As Integer
Property Let InvoiceType(bEdit As Boolean, bAuditer As Boolean, bKeeper As Boolean, byType As Byte)
m_bEdit = bEdit
m_bAuditer = bAuditer
m_bKeeper = bKeeper
m_byType = byType
End Property
Private Sub InitScreenObject()
If m_byType = STOCKUP_INVOICE Then
Me.Caption = "商品购进(预验)单"
ElseIf m_byType = INFORMAL_INVOICE Then
Me.Caption = "商品估进单"
ElseIf m_byType = RETURN_INVOICE Then
Me.Caption = "进货退还单"
lblTitle(0).ForeColor = QBColor(3)
End If
lblTitle(0).Caption = Me.Caption
lblTitle(1).Caption = lblTitle(0).Caption
Set m_DepartRs = New ADODB.Recordset
m_DepartRs.Open "Select FDepartCode, FDepartName From Depart Where FDepartAttrib = " & COMPANY_DEPART & " Or FDepartAttrib = " & STOCKUP_SELL_DEPART & " Or FDepartAttrib = " & STOCKUP_DEPART & " Order by FDepartCode", m_gDBCnn
' m_DepartRs.Open "Select FDepartCode, FDepartName From Depart Order by FDepartCode", m_gDBCnn
With DACDepart
Set .RowSource = m_DepartRs
.ListField = "FDepartName"
.BoundColumn = "FDepartCode"
End With
' Set m_SupplierRs = New ADODB.Recordset
' m_SupplierRs.Open "Select FSupplierCode, FSupplierName From Supplier Order by FSupplierCode", m_gDBCnn
' With DACSupplier
' Set .RowSource = m_SupplierRs
' .ListField = "FSupplierName"
' .BoundColumn = "FSupplierCode"
' End With
Set m_EntryTypeRs = New ADODB.Recordset
m_EntryTypeRs.Open "Select FEntryTypeCode,FentryTypeName From EntryType order by FentryTypeCode", m_gDBCnn
With DacEntryType
Set .RowSource = m_EntryTypeRs
.ListField = "FEntryTypeName"
.BoundColumn = "FentryTypeCode"
End With
End Sub
'////////////////////////////////////////////////
'//日期、单据号及地址电话不绑定
Private Sub BoundingScreenObject()
Dim ctl As Control
For Each ctl In Me.Controls
If TypeOf ctl Is TextBox Then
If UCase(ctl.Name) <> "TXTNO" Or UCase(ctl.Name) <> "TXTFINDNO" Then
Set ctl.DataSource = adoPrimaryRs
End If
End If
Next
Set DACDepart.DataSource = adoPrimaryRs
' Set dacSupplier.DataSource = adoPrimaryRs
Set DacEntryType.DataSource = adoPrimaryRs
End Sub
Private Sub RefreshDataGrid(nYear As Integer, byMonth As Byte, byType As Byte, sNo As String)
Dim sSqlStr As String
Dim sGrdWidth As String, i As Integer, j As Integer
Set adoSecondaryRs = Nothing
Set adoSecondaryRs = New ADODB.Recordset
With adoSecondaryRs
sSqlStr = "Select StockUpDetail.FWaresCode, WaresList.FName, WaresList.FSpecName, WaresList.FMeasurement, FQuantity, FPrice, FMoney, FTaxRate, FTaxMoney, FYear, FMonth, FType, FNo " & _
" From StockUpDetail Inner Join WaresList On StockUpDetail.FWaresCode = WaresList.FWaresCode " & _
" Where FYear = " & nYear & " And FMonth = " & byMonth & " And FType = " & byType & " And FNo = '" & sNo & "' Order by StockUpDetail.FWaresCode"
.Open sSqlStr, m_gDBCnn, adOpenDynamic, adLockOptimistic, adCmdUnknown
.Properties("Unique Table") = "StockUpDetail"
.Properties("Resync Command") = "Select * FROM (" & sSqlStr & ") WHERE FWaresCode = ? And FYear = ? And FMonth = ? And FType = ? And FNo = ?"
.Properties("Update Resync") = adResyncAll Or adResyncUpdates Or adResyncInserts Or adResyncConflicts
End With
With grdDataGrid
Set .DataSource = adoSecondaryRs
sGrdWidth = GetPrivateSetting(Me.Caption, "GrdWidth", "")
.RowHeight = GetPrivateSetting(Me.Caption, "GrdHeight", "275")
i = 0
.Columns(i).Caption = "商品编码"
SetColumnWidth sGrdWidth, .Columns(i), 1200
.Columns(i).Button = True
CodeCol = i
i = i + 1
.Columns(i).Caption = "名称"
SetColumnWidth sGrdWidth, .Columns(i), 1500
.Columns(i).Locked = True
NameCol = i
i = i + 1
.Columns(i).Caption = "规格"
SetColumnWidth sGrdWidth, .Columns(i), 1200
.Columns(i).Locked = True
SpecCol = i
i = i + 1
.Columns(i).Caption = "计量单位"
SetColumnWidth sGrdWidth, .Columns(i), 1000
.Columns(i).Locked = True
MeasCol = i
i = i + 1
.Columns(i).Caption = "采购数量"
SetColumnWidth sGrdWidth, .Columns(i), 1000
QuantityCol = i
i = i + 1
.Columns(i).Caption = "无税单价"
SetColumnWidth sGrdWidth, .Columns(i), 1000
.Columns(i).NumberFormat = "########0.00"
PriceCol = i
i = i + 1
.Columns(i).Caption = "金额"
SetColumnWidth sGrdWidth, .Columns(i), 1000
.Columns(i).NumberFormat = "########0.00"
MoneyCol = i
i = i + 1
.Columns(i).Caption = "税率%"
SetColumnWidth sGrdWidth, .Columns(i), 750
.Columns(i).NumberFormat = "##0.00%"
RateCol = i
i = i + 1
.Columns(i).Caption = "税额"
SetColumnWidth sGrdWidth, .Columns(i), 1000
.Columns(i).NumberFormat = "#######0.00"
TaxCol = i
For j = i + 1 To i + 4 'FYear, FMonth, FType, FNo
.Columns(j).Visible = False
.Columns(j).AllowSizing = False
.Columns(j).Locked = True
SetColumnWidth sGrdWidth, .Columns(j), 0
Next
YearCol = i + 1
MonthCol = i + 2
TypeCol = i + 3
NoCol = i + 4
End With
End Sub
Private Sub adoPrimaryRs_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
Dim nYear As Integer, byMonth As Byte, byType As Byte
With adoPrimaryRs
If .EOF Or .BOF Or IsNull(![FNo]) Then
txtNo.Text = ""
maskDate.Text = "____年__月__日"
' lblAddressTel.Caption = ""
lblStatus.Caption = ""
Else
nYear = ![FYear]
byMonth = ![FMonth]
byType = ![FType]
txtNo.Text = ![FNo]
maskDate.Text = Format(![FDate], "YYYY年MM月DD日")
' lblAddressTel.Caption = IIf(IsNull(![FAddress]), "", ![FAddress]) & "," & IIf(IsNull(![FTel]), "", ![FTel])
lblStatus.Caption = "序号: " & CStr(adoPrimaryRs.AbsolutePosition)
End If
End With
RefreshDataGrid nYear, byMonth, byType, txtNo.Text
End Sub
Private Sub adoPrimaryRs_Error(ByVal ErrorNumber As Long, Description As String, ByVal sCode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
' MsgBox "Data error event hit err:" & Description
fCancelDisplay = True
End Sub
Private Sub adoPrimaryRs_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'验证代码置于此处
'下列动作发生时该事件被调用
Dim bCancel As Boolean
Select Case adReason
Case adRsnAddNew
Case adRsnClose
Case adRsnDelete
Case adRsnFirstChange
Case adRsnMove
Case adRsnRequery
Case adRsnResynch
Case adRsnUndoAddNew
Case adRsnUndoDelete
Case adRsnUndoUpdate
Case adRsnUpdate
End Select
If bCancel Then adStatus = adStatusCancel
End Sub
Private Sub DataCombo1_Click(Area As Integer)
End Sub
Private Sub DacEntryType_Validate(Cancel As Boolean)
If Not DacEntryType.MatchedWithList Then
DacEntryType.BoundText = m_EntryTypeRs!FEntrytypeCode
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{Tab}"
End If
End Sub
Private Sub Form_Load()
SetForm Me, 9
InitScreenObject
Dim sSqlStr As String
Set adoPrimaryRs = New ADODB.Recordset
With adoPrimaryRs
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -