⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form3.frm

📁 nice proggy nnnnnnnnnnnnnn
💻 FRM
📖 第 1 页 / 共 2 页
字号:
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   1440
      TabIndex        =   35
      Top             =   120
      Width           =   1455
   End
   Begin VB.Label Label7 
      BackStyle       =   0  'Transparent
      Caption         =   "Location"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   1440
      TabIndex        =   34
      Top             =   3000
      Width           =   1455
   End
   Begin VB.Label Label6 
      BackStyle       =   0  'Transparent
      Caption         =   "Op. Balance"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   1440
      TabIndex        =   33
      Top             =   2520
      Width           =   1455
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "Price"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   1440
      TabIndex        =   32
      Top             =   2040
      Width           =   1455
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "Group Head"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   1455
      TabIndex        =   31
      Top             =   600
      Width           =   1455
   End
   Begin VB.Label Label8 
      BackStyle       =   0  'Transparent
      Caption         =   "Manufecturer"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   1440
      TabIndex        =   30
      Top             =   3480
      Width           =   1455
   End
   Begin VB.Label Label14 
      BackStyle       =   0  'Transparent
      Caption         =   "Item Name"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   1440
      TabIndex        =   29
      Top             =   1080
      Width           =   1455
   End
   Begin VB.Label Label15 
      BackStyle       =   0  'Transparent
      Caption         =   "Make && Model"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   1440
      TabIndex        =   28
      Top             =   1560
      Width           =   1455
   End
End
Attribute VB_Name = "Stock"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim e As Integer

Private Sub Check1_Click()
If Check1.Value = 1 Then
Text9.Enabled = True
Text10.Enabled = True
Else
Text9.Enabled = False
Text10.Enabled = False
End If
End Sub

Private Sub Combo1_Click()
Text2 = Combo1.Text
End Sub

Private Sub Combo2_Click()
Text3 = Combo2.Text
Combo3.Clear
data3.RecordSource = "select distinct item from stock where g_head like '" + Trim(Combo2.Text) + "%'"
data3.Refresh
While data3.Recordset.EOF = False
    Combo3.AddItem data3.Recordset.Fields(0)
    data3.Recordset.MoveNext
Wend
End Sub
Private Sub Combo3_Click()
Combo4.Clear
Text4 = Combo3.Text
data3.RecordSource = "select distinct model from stock where g_head = '" + Text3 + "' and item = '" + Text4 + "'"
data3.Refresh
While data3.Recordset.EOF = False
    Combo4.AddItem data3.Recordset.Fields(0)
    data3.Recordset.MoveNext
Wend
End Sub
Private Sub Combo4_Click()
Text5 = Combo4.Text
End Sub

Private Sub Command1_Click()
data1.Recordset.MoveFirst
End Sub

Private Sub Command10_Click()
r = MsgBox("Wish to Insert Another Item?", vbYesNo, "Insert New...")
data1.Recordset.CancelUpdate
If r = vbYes Then
    Call Form_Activate
Else
    MAIN.Enabled = True
    MAIN.Show
     Unload Me
End If
End Sub

Private Sub Command11_Click()
End Sub

Private Sub Command2_Click()
data1.Recordset.MovePrevious
If data1.Recordset.BOF = True Then
    data1.Recordset.MoveFirst
End If
End Sub

Private Sub Command3_Click()
data1.Recordset.MoveNext
If data1.Recordset.EOF = True And data1.Recordset.BOF = False Then
    data1.Recordset.MoveLast
End If

End Sub

Private Sub Command4_Click()
data1.Recordset.MoveLast
End Sub

Private Sub Command5_Click()
On Error Resume Next
data1.Recordset.AddNew
Frame3.Enabled = True
Frame1.Visible = False
Frame2.Visible = True
Combo2.Visible = True
Combo3.Visible = True
Combo4.Visible = True
Text8 = "1"
Text12 = "STORE ROOM"
'
If data3.Recordset.RecordCount <> 0 Then
data3.Recordset.MoveFirst
data3.RecordSource = "select distinct g_head from stock"
data3.Refresh
Combo2.Clear
While data3.Recordset.EOF = False
    Combo2.AddItem data3.Recordset.Fields(0)
    data3.Recordset.MoveNext
Wend
End If






'
End Sub
Private Sub Command6_Click()
e = 1
Frame3.Enabled = True
Frame1.Visible = False
Frame2.Visible = True
End Sub


Private Sub Command7_Click()
Dim a As Integer
a = MsgBox("Wish to Delete This Rec. Parmanently ", vbYesNo)
If a = vbYes Then
    data1.Recordset.Delete
    Call Command3_Click
End If
End Sub

Private Sub Command8_Click()
Dim a As String
a = InputBox("Enter Item Code")
s = "Item_code = '" + a + "'"
data1.Recordset.MoveFirst
data1.Recordset.Find s
If data1.Recordset.EOF = True Then
    MsgBox "Record Does not exists"
    data1.Recordset.MoveFirst
End If
End Sub

Private Sub Command9_Click()
Dim q As String
Dim r As Integer
If e = 0 Then
    'change the code for dup. as form1
    q = "select * from stock where g_head = '" + Text3 + "' and item = '" + Text4 + "' and model = '" + Text5 + "'"
    data3.RecordSource = q
    data3.Refresh
    If data3.Recordset.RecordCount = 0 Then
        ' validations
        If Trim(Text6) = "0" Or Trim(Text6) = "" Then
            MsgBox "You cant Leave Price Field empty."
            Text6.SetFocus
            Exit Sub
        End If
        
        If Val(Text6) > Val(Text7) Then
            MsgBox "MRP cant be less than the cost price."
            Text6.SetFocus
            Exit Sub
        End If
        
        If Trim(Text1) = "" Then
            MsgBox "Item-Code can not be Blank."
            Text1.SetFocus
            Exit Sub
        End If
        
        If Trim(Text3) = "" Or Trim(Text4) = "" Or Trim(Text5) = "" Then
            MsgBox "Values can not be blank"
            Exit Sub
        End If
        'end validations
        
            'auto insertion
            'data2.Recordset.MoveFirst
            'data2.Recordset.Fields(1).Value = data2.Recordset.Fields(1).Value + 1
            'Text1 = "CON-" + Str(data2.Recordset.Fields(1).Value)
            'end insertion
        
        data1.Recordset.Fields("iss_qty") = "0"
        data1.Recordset.Fields("QOH") = Val(Text8)
        data1.Recordset.Update
        data1.Recordset.MoveLast
      
    
    
    Else
        MsgBox "This Product already exists in the database. Select Different..."
        Text3.SetFocus
        Exit Sub
    End If
Else
   data1.Recordset.Update
   e = 0
End If
Frame2.Visible = False
Frame1.Visible = True
Frame3.Enabled = False
'Combo1.Visible = False
Combo2.Visible = False
Combo3.Visible = False
Combo3.Visible = False

r = MsgBox("Wish to Insert Another Item?", vbYesNo, "Insert New...")
If r = vbYes Then
    Call Command5_Click
Else
    MAIN.Enabled = True
    MAIN.Show
    Unload Me
End If
End Sub


Private Sub Form_Activate()
Dim res As Integer

If data1.Recordset.RecordCount = 0 Then
    res = MsgBox("No Record Exists. Whether to insert New Record First?", vbQuestion + vbYesNo, "Please Confirm...")
    If res = vbYes Then
        Call Command5_Click
        Exit Sub
    Else
        Call Command11_Click
        Exit Sub
    End If
End If
Call Command5_Click
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii >= 97 And KeyAscii <= 122 Then
    KeyAscii = KeyAscii - 32
End If
End Sub

Private Sub Text1_Validate(Cancel As Boolean)
data2.RecordSource = "select * from stock where item_code = '" + Text1 + "'"
data2.Refresh
If data2.Recordset.RecordCount >= 1 Then
    MsgBox "This Item Code already Exists. Retype"
    Cancel = True
End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii >= 97 And KeyAscii <= 122 Then
    KeyAscii = KeyAscii - 32
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii >= 97 And KeyAscii <= 122 Then
    KeyAscii = KeyAscii - 32
End If
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii >= 97 And KeyAscii <= 122 Then
    KeyAscii = KeyAscii - 32
End If
End Sub
Private Sub Text12_KeyPress(KeyAscii As Integer)
If KeyAscii >= 97 And KeyAscii <= 122 Then
    KeyAscii = KeyAscii - 32
End If
End Sub
Private Sub Text13_KeyPress(KeyAscii As Integer)
If KeyAscii >= 97 And KeyAscii <= 122 Then
    KeyAscii = KeyAscii - 32
End If
End Sub

Private Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 46 Then
    KeyAscii = KeyAscii
Else
    KeyAscii = 0
    Beep
End If
End Sub
Private Sub Text7_KeyPress(KeyAscii As Integer)
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 46 Then
    KeyAscii = KeyAscii
Else
    KeyAscii = 0
    Beep
End If
End Sub

Private Sub Text8_KeyPress(KeyAscii As Integer)
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 46 Then
    KeyAscii = KeyAscii
Else
    KeyAscii = 0
    Beep
End If
End Sub

Private Sub Text9_KeyPress(KeyAscii As Integer)
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 46 Then
    KeyAscii = KeyAscii
Else
    KeyAscii = 0
    Beep
End If
End Sub
Private Sub Text10_KeyPress(KeyAscii As Integer)
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 46 Then
    KeyAscii = KeyAscii
Else
    KeyAscii = 0
    Beep
End If
End Sub
Private Sub Text11_KeyPress(KeyAscii As Integer)
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 46 Then
    KeyAscii = KeyAscii
Else
    KeyAscii = 0
    Beep
End If
End Sub


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -