frmexplorer.frm

通用样品管理系统是一个商业程序,功能界面都还不错!

                   End If
                Case Pro(6)
                  FindX = "批发价"
                  FindStr = FindX + Combo2.Text + Text1.Text
                Case Pro(7)
                  FindX = "零售价"
                  FindStr = FindX + Combo2.Text + Text1.Text
                Case Pro(8)
                  FindX = "其它价"
                  FindStr = FindX + Combo2.Text + Text1.Text
                Case Pro(9)
                  FindX = "样品图片"
                  If Combo2.Text = "等于" Then
                   FindStr = FindX + "='" + Text1.Text + "'"
                    Else
                   FindStr = FindX + " LIKE '*" + Text1.Text + "*'"
                   End If
            End Select
    Set EF = DB.OpenRecordset("Select 样品名称,颜色,尺码,风格,批发价,零售价,样品图片 From S_Main Where " & FindStr, dbOpenDynaset)
        HH = 1
        Do While Not EF.EOF()
           Grid1.Row = HH
           Grid1.Col = 1
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(0).Value) Then
           Grid1.Text = EF.Fields(0).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 2
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(1).Value) Then
           Grid1.Text = EF.Fields(1).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 3
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(2).Value) Then
           Grid1.Text = EF.Fields(2).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 4
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(3).Value) Then
           Grid1.Text = EF.Fields(3).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 5
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(4).Value) Then
           Grid1.Text = EF.Fields(4).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 6
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(5).Value) Then
           Grid1.Text = EF.Fields(5).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 7
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(6).Value) Then
           Grid1.Text = EF.Fields(6).Value
        End If
        
          EF.MoveNext
          HH = HH + 1
        Loop
        DB.Close
 For HH = 1 To Grid1.Rows - 1
    Grid1.Row = HH
    Grid1.Col = 0
    Grid1.Text = HH
    If Len(Grid1.Text) = 1 Then
       Grid1.Text = "0" + Grid1.Text
    End If
 Next
 Grid1.Col = 1
 Grid1.Row = 1
 Grid1.ColSel = 7
 Grid1.Visible = True
 Me.MousePointer = 0
End Sub

Private Sub Form_Activate()
 NS = True
 MS = True
 DS = True
 If Grid1.Text = "" Then
    D_Button.Enabled = False
    M_Button.Enabled = False
      Else
    D_Button.Enabled = True
    M_Button.Enabled = True
 End If
End Sub

Private Sub Form_Load()
 frmExplorer.HelpContextID = 6
 NS = True
 MS = True
 DS = True
Me.Left = (MDIForm1.Width - Me.Width) / 2
Me.Top = (MDIForm1.Height - Me.Height) / 2 - 1500
Dim X As Integer
    X = 0
    For X = 0 To 9
        Combo1.AddItem Pro(X)
    Next
If Combo1.ListCount > 0 Then
   Combo1.ListIndex = 0
End If
'配置网格
Grid1.Visible = False
Grid1.Cols = 7
Grid1.FormatString = "^序号 |^ " & Pro(0) & " |^ " & Pro(2) & " |^ " & Pro(3) & " |^ " & Pro(4) & " |^ " & Pro(6) & " | " & Pro(7) & " | " & Pro(9)
Grid1.ColWidth(0) = 500
Grid1.ColWidth(1) = 900
Grid1.ColWidth(2) = 900
Grid1.ColWidth(3) = 900
Grid1.ColWidth(4) = 1220
Grid1.ColWidth(5) = 800
Grid1.ColWidth(6) = 800
Grid1.ColWidth(7) = 1600
Dim DB As Database, EF As Recordset
    Set DB = OpenDatabase(SampleData)
    Set EF = DB.OpenRecordset("S_Main", dbOpenTable)
        Grid1.Rows = EF.RecordCount + 4
    Set EF = DB.OpenRecordset("Select 样品名称,颜色,尺码,风格,批发价,零售价,样品图片 From S_Main", dbOpenDynaset)
        HH = 1
        Do While Not EF.EOF()
           Grid1.Row = HH
           Grid1.Col = 1
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(0).Value) Then
           Grid1.Text = EF.Fields(0).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 2
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(1).Value) Then
           Grid1.Text = EF.Fields(1).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 3
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(2).Value) Then
           Grid1.Text = EF.Fields(2).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 4
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(3).Value) Then
           Grid1.Text = EF.Fields(3).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 5
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(4).Value) Then
           Grid1.Text = EF.Fields(4).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 6
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(5).Value) Then
           Grid1.Text = EF.Fields(5).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 7
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(6).Value) Then
           Grid1.Text = EF.Fields(6).Value
        End If
        
          EF.MoveNext
          HH = HH + 1
        Loop
        DB.Close
 For HH = 1 To Grid1.Rows - 1
    Grid1.Row = HH
    Grid1.Col = 0
    Grid1.Text = HH
    If Len(Grid1.Text) = 1 Then
       Grid1.Text = "0" + Grid1.Text
    End If
 Next
 Grid1.Col = 1
 Grid1.Row = 1
 Grid1.ColSel = 7
 Grid1.Visible = True

End Sub

Private Sub Form_Unload(Cancel As Integer)
  NS = False
  MS = False
  DS = False
End Sub

Private Sub Grid1_DblClick()
 If Grid1.MouseCol = 0 Or Grid1.MouseRow = 0 Then
    Exit Sub
 End If
 If Grid1.Text = "" Then
    MnuDeleteSample.Enabled = False
    MnuModifySample.Enabled = False
    MnuDisplayPhoto.Enabled = False
    M_Button.Enabled = False
    D_Button.Enabled = False
     Else
    MnuDeleteSample.Enabled = True
    MnuModifySample.Enabled = True
    MnuDisplayPhoto.Enabled = True
    M_Button.Enabled = True
    D_Button.Enabled = True
 End If
    PopupMenu MnuOperating
End Sub

Private Sub Grid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 RowN = Grid1.Row
 If Grid1.Text = "" Then
    M_Button.Enabled = False
    D_Button.Enabled = False
  Else
    M_Button.Enabled = True
    D_Button.Enabled = True
 End If
 If Button = 2 Then
  If Grid1.MouseCol = 0 Or Grid1.MouseRow = 0 Then
    Exit Sub
  End If
  If Grid1.Text = "" Then
    MnuDeleteSample.Enabled = False
    MnuModifySample.Enabled = False
    MnuDisplayPhoto.Enabled = False
      Else
    MnuDeleteSample.Enabled = True
    MnuModifySample.Enabled = True
    MnuDisplayPhoto.Enabled = True
  End If
    PopupMenu MnuOperating

 End If
End Sub

Private Sub M_Button_Click()
 If Grid1.Text = "" Then Exit Sub
 MS = True
 frmExplorer.MousePointer = 11
    ModifyText = Grid1.Text
    frmExplorer.Hide
    frmPModify.Show
 frmExplorer.MousePointer = 0
End Sub

Private Sub MnuDeleteSample_Click()
 Call D_Button_Click
End Sub

Private Sub MnuDisplayPhoto_Click()
 frmExplorer.MousePointer = 11
    Dim FS As Field, X As Integer
    Dim DB As Database
    Dim EF As Recordset
Set DB = OpenDatabase(SampleData)
Set EF = DB.OpenRecordset("Select * From S_Main Where 样品名称='" & Grid1.Text & "'", dbOpenDynaset)
    X = 0
    For Each FS In EF.Fields
        Des(X) = FS
        X = X + 1
    Next
    DB.Close
    Load frmDisplayImage
    On Error GoTo NoFile
    frmDisplayImage.DisplayImage.Picture = LoadPicture(Grid1.TextMatrix(RowN, 7))
    GoTo HFile
NoFile:
    MsgBox "图片文没有找到或格式错误，将以缺省图片安装。", vbOKOnly + vbCritical, "图片错误"
    On Error Resume Next
    frmDisplayImage.DisplayImage.Picture = LoadPicture(Browser + "photo\default.bmp")
HFile:
    frmExplorer.Hide
    frmDisplayImage.Show
 frmExplorer.MousePointer = 0
End Sub

Private Sub MnuExit_Click()
 Unload Me
End Sub

Private Sub MnuModifySample_Click()
 Call M_Button_Click
End Sub

Private Sub MnuNewSample_Click()
 Call N_Button_Click
End Sub

Private Sub MnuOperating_Click()
 
  If Grid1.Text = "" Then
    MnuDeleteSample.Enabled = False
    MnuModifySample.Enabled = False
    MnuDisplayPhoto.Enabled = False
     Else
    MnuDeleteSample.Enabled = True
    MnuModifySample.Enabled = True
    MnuDisplayPhoto.Enabled = True
 End If

End Sub

Private Sub N_Button_Click()
NS = True
frmExplorer.MousePointer = 11
    frmExplorer.Hide
    frmRegister.Show
frmExplorer.MousePointer = 0
End Sub

Private Sub Text1_Change()
 If Trim(Text1.Text) = "" Then
    F_Button.Enabled = False
     Else
    F_Button.Enabled = True
 End If
End Sub

Private Sub Text1_GotFocus()
 Text1.SelStart = 0
 Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 And Trim(Text1.Text) <> "" Then
    SendKeys "{tab}"
    Exit Sub
 End If
 If Combo1.Text = Pro(6) Or Combo1.Text = Pro(7) Or Combo1.Text = Pro(8) Then
    If NumberTrue(KeyAscii, Text1) = False Then
       KeyAscii = 0
    End If
 End If
End Sub
Function NumberTrue(keyNumber As Integer, NumberStr As TextBox) As Boolean
   '转入退格键时
   If keyNumber = 8 Then
        NumberTrue = True
        Exit Function
      End If
   If keyNumber >= 46 And keyNumber <= 57 And keyNumber <> 47 Then
       NumberTrue = True
        Else
       NumberTrue = False
   End If
End Function

Private Sub Text1_LostFocus()
   If (Combo1.Text = Pro(6) Or Combo1.Text = Pro(7) Or Combo1.Text = Pro(8)) And Trim(Text1.Text) <> "" Then
      If IsNumeric(Text1.Text) = False Then
         MsgBox "数 字 格 式 不 对 ， 请 重 写", vbOKOnly + vbQuestion, "非数字格式"
         Text1.Text = ""
         Text1.SetFocus
      End If
   End If
End Sub