📄 frmprod.frm
字号:
Private Sub cmdPicture_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MacButton(" Change Picture", frmProduct.cmdPicture, 0, 0, 170, 30, frmLogin.Source, 147, 0, 2)
End Sub
Private Sub cmdPrev_Click()
Press_Buttons ("Prev")
End Sub
Private Sub cmdPrev_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MacButton("t", frmProduct.cmdPrev, 0, 0, 100, 50, frmLogin.Source, 112, 39, 3)
End Sub
Private Sub cmdPrev_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MacButton("t", frmProduct.cmdPrev, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
End Sub
Private Sub cmdSave_Click()
On Error Resume Next
If EditMode = True Then
Call MacButton(" Edit", frmProduct.cmdEdit, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
Press_Buttons ("Save")
Else
Call MacButton(" New", frmProduct.cmdNew, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
If Get_Product_Code Then
Call MessageBox("frmProduct", "Product Code already exists.", 0)
frmMessageBox.SetFocus
txtField(1) = ""
Press_Buttons ("Undo")
ElseIf txtField(1) = "" Then
Call MessageBox("frmProduct", "Product Code cannot be null", 0)
frmMessageBox.SetFocus
txtField(1) = ""
Press_Buttons ("Undo")
'ENABLE ONLY FOR SPECIFIC LENGTH OF 10 CHARACTERS NUMBERING
'ElseIf Len(txtField(1)) > 1 And Len(txtField(1)) < 10 Then
' Call MessageBox("frmProduct", "Product number must be 10 in length", 0)
' frmMessageBox.SetFocus
' txtField(1) = ""
' Press_Buttons ("Undo")
Else
Press_Buttons ("Save")
End If
End If
Call MacButton(" Save", frmProduct.cmdSave, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub
Private Sub cmdSave_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MacButton(" Save", frmProduct.cmdSave, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
End Sub
Private Sub cmdSave_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MacButton(" Save", frmProduct.cmdSave, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub
Private Sub cmdTop_Click()
Press_Buttons ("Top")
End Sub
Private Sub cmdTop_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MacButton("p", frmProduct.cmdTop, 0, 0, 100, 50, frmLogin.Source, 112, 39, 3)
End Sub
Private Sub cmdTop_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MacButton("p", frmProduct.cmdTop, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
End Sub
Private Sub cmdUndo_Click()
If EditMode = True Then
Call MacButton(" Edit", frmProduct.cmdEdit, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
Else
Call MacButton(" New", frmProduct.cmdNew, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End If
Press_Buttons ("Undo")
Call MacButton(" Undo", frmProduct.cmdUndo, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub
Private Sub cmdUndo_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MacButton(" Undo", frmProduct.cmdUndo, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
End Sub
Private Sub cmdUndo_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MacButton(" Undo", frmProduct.cmdUndo, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub
Private Sub Form_Activate()
On Error Resume Next
If EditMode = False Then
strs = "select * from PROD_STOCKS order by PRODCODE"
Set datprimary = New adodb.Recordset
datprimary.Open strs, myDB, 1, 3
If Not datprimary.BOF Then
Display_Fields
End If
Enable_Fields (True)
Object_Tab_Trigger (False)
Enable_Buttons
Enable_Buttons
rec_Isnew = False
If cmdNew.Enabled Then cmdNew.SetFocus
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
Call ColForm(BoxContainer, 217, 211, 213, 125)
Call ColForm(ButtonContainer, 217, 211, 213, 125)
Call ColForm(PictureContainer, 217, 211, 213, 125)
Call CreateMacOSTitleBar(titleBar, " 商品信息 ")
Call BitBlt(frmProduct.Closed.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 107, SRCCOPY)
frmProduct.Closed.Refresh
Call BitBlt(frmProduct.Maximized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 72, SRCCOPY)
frmProduct.Maximized.Refresh
Call BitBlt(frmProduct.Minimized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 124, SRCCOPY)
frmProduct.Minimized.Refresh
KeyPreview = True
Call MacButton(" New", frmProduct.cmdNew, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
Call MacButton(" Edit", frmProduct.cmdEdit, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
Call MacButton(" Save", frmProduct.cmdSave, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
Call MacButton(" Undo", frmProduct.cmdUndo, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
Call MacButton(" Delete", frmProduct.cmdDel, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
Call MacButton(" Find", frmProduct.cmdFind, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
Call MacButton(" Exit", frmProduct.cmdExit, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
Call MacButton(" 更换图片", frmProduct.cmdPicture, 0, 0, 170, 30, frmLogin.Source, 147, 0, 2)
Call MacButton("p", frmProduct.cmdTop, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
Call MacButton("u", frmProduct.cmdNext, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
Call MacButton("t", frmProduct.cmdPrev, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
Call MacButton("q", frmProduct.cmdLast, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
txtCombo(0).Clear
strs = "select CATCODE from CATEGORY order by CATCODE"
Set dummy = New adodb.Recordset
dummy.Open strs, myDB, 1, 3
If Not dummy.BOF Then
Do While Not dummy.EOF
If Not IsNull(dummy(0)) Then
txtCombo(0).AddItem (dummy(0))
End If
dummy.MoveNext
Loop
End If
txtCombo(1).Clear
strs = "select SUPCODE from SUPPLIER order by SUPCODE"
Set dummy = New adodb.Recordset
dummy.Open strs, myDB, 1, 3
If Not dummy.BOF Then
Do While Not dummy.EOF
If Not IsNull(dummy(0)) Then
txtCombo(1).AddItem (dummy(0))
End If
dummy.MoveNext
Loop
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
On Error Resume Next
Dim AltDown
AltDown = (Shift And vbAltMask) > 0
Select Case KeyCode
Case vbKeyEscape:
Me.Hide
Case vbKeyN:
If AltDown Then
Call MacButton(" New", frmProduct.cmdNew, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End If
Case vbKeyE:
If AltDown Then
Call MacButton(" Edit", frmProduct.cmdEdit, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End If
Case vbKeyS:
If AltDown Then
Call MacButton(" Save", frmProduct.cmdSave, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End If
Case vbKeyU:
If AltDown Then
Call MacButton(" Undo", frmProduct.cmdUndo, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End If
Case vbKeyD:
If AltDown Then
Call MacButton(" Delete", frmProduct.cmdDel, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End If
Case vbKeyF:
If AltDown Then
Call MacButton(" Find", frmProduct.cmdFind, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End If
Case vbKeyX:
If AltDown Then
Call MacButton(" Exit", frmProduct.cmdExit, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End If
Case vbKeyP:
If AltDown Then
Call MacButton(" Change Picture", frmProduct.cmdPicture, 0, 0, 170, 30, frmLogin.Source, 147, 0, 2)
End If
Case vbKeyLeft:
If AltDown Then
Call MacButton("t", frmProduct.cmdPrev, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
End If
Case vbKeyRight:
If AltDown Then
Call MacButton("u", frmProduct.cmdNext, 0, 0, 100, 49, frmLogin.Source, 138, 39, 3)
End If
Case vbKeyUp:
If AltDown Then
Call MacButton("p", frmProduct.cmdTop, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
End If
Case vbKeyDown:
If AltDown Then
Call MacButton("q", frmProduct.cmdLast, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
End If
End Select
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
Dim AltDown
AltDown = (Shift And vbAltMask) > 0
Select Case KeyCode
Case vbKeyEscape:
Me.Hide
Case vbKeyF1:
frmHelp.Show
frmHelp.Help_Values = Space(1) & vbCrLf & _
"注意: 商品信息模块的快捷键." & vbCrLf & _
Space(1) & vbCrLf & _
"ALT-N=New, ALT-E=Edit, ALT-S=Save, ALT-U=Undo, ALT-D=Delete" & vbCrLf & _
"ALT-F=Find, ALT-X=Exit, ALT-P=Change Picture" & vbCrLf & _
Space(1) & vbCrLf & _
"Left Arrow=Previous Records, Right Arrow=Next Records" & vbCrLf & _
"Top Arrow=Top Record, Down Arrow=Last Record"
Case vbKeyN:
If AltDown Then
Call MacButton(" New", frmProduct.cmdNew, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
cmdNew_Click
End If
Case vbKeyE:
If AltDown Then
Call MacButton(" Edit", frmProduct.cmdEdit, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
cmdEdit_Click
End If
Case vbKeyS:
If AltDown Then
Call MacButton(" Save", frmProduct.cmdSave, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
cmdSave_Click
End If
Case vbKeyU:
If AltDown Then
Call MacButton(" Undo", frmProduct.cmdUndo, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
cmdUndo_Click
End If
Case vbKeyD:
If AltDown Then
Call MacButton(" Delete", frmProduct.cmdDel, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
cmdDel_Click
End If
Case vbKeyF:
If AltDown Then
Call MacButton(" Find", frmProduct.cmdFind, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
cmdFind_Click
End If
Case vbKeyX:
If AltDown Then
Call MacButton(" Exit", frmProduct.cmdExit, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
cmdExit_Click
End If
Case vbKeyP:
If AltDown Then
Call MacButton(" Change Picture", frmProduct.cmdPicture, 0, 0, 170, 30, frmLogin.Source, 182, 30, 2)
cmdPicture_Click
End If
Case vbKeyLeft:
If AltDown Then
Call MacButton("t", frmProduct.cmdPrev, 0, 0, 100, 50, frmLogin.Source, 112, 39, 3)
cmdPrev_Click
End If
Case vbKeyRight:
If AltDown Then
Call MacButton("u", frmProduct.cmdNext, 0, 0, 100, 49, frmLogin.Source, 112, 39, 3)
cmdNext_Click
End If
Case vbKeyUp:
If AltDown Then
Call MacButton("p", frmProduct.cmdTop, 0, 0, 100, 50, frmLogin.Source, 112, 39, 3)
cmdTop_Click
End If
Case vbKeyDown:
If AltDown Then
Call MacButton("q", frmProduct.cmdLast, 0, 0, 100, 50, frmLogin.Source, 112, 39, 3)
cmdLast_Click
End If
End Select
End Sub
Private Sub titleBar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call DragForm(Me)
End Sub
Private Sub Closed_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call BitBlt(frmProduct.Closed.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 18, 107, SRCCOPY)
frmProduct.Closed.Refresh
End Sub
Private Sub Closed_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call BitBlt(frmProduct.Closed.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 107, SRCCOPY)
frmProduct.Closed.Refresh
End Sub
Private Sub Maximized_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call BitBlt(frmProduct.Maximized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 18, 72, SRCCOPY)
frmProduct.Maximized.Refresh
End Sub
Private Sub Maximized_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call BitBlt(frmProduct.Maximized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 72, SRCCOPY)
frmProduct.Maximized.Refresh
End Sub
Private Sub Minimized_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call BitBlt(frmProduct.Minimized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 18, 124, SRCCOPY)
frmProduct.Minimized.Refresh
End Sub
Private Sub Minimized_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call BitBlt(frmProduct.Minimized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 124, SRCCOPY)
frmProduct.Minimized.Refresh
End Sub
Private Sub Display_Fields()
On Error Resume Next
If datprimary.AbsolutePosition <> -1 Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -