📄 frmsuppler.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{29743316-0803-11D5-AD8E-0050BAA9AC14}#2.0#0"; "FocusText.ocx"
Begin VB.Form frmSuppler
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Dialog
Caption = "供应商浏览：请选择供应商后，双击或按回车键。"
ClientHeight = 6975
ClientLeft = 45
ClientTop = 330
ClientWidth = 10290
ClipControls = 0 'False
ControlBox = 0 'False
Icon = "frmSuppler.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6975
ScaleWidth = 10290
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
WindowState = 2 'Maximized
Begin MSFlexGridLib.MSFlexGrid Grid2
Height = 3825
Left = 450
TabIndex = 6
Top = 675
Width = 5130
_ExtentX = 9049
_ExtentY = 6747
_Version = 393216
AllowBigSelection= 0 'False
FocusRect = 0
ScrollBars = 2
SelectionMode = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.PictureBox picTool
BackColor = &H80000000&
BorderStyle = 0 'None
Height = 540
Left = 45
ScaleHeight = 540
ScaleWidth = 10200
TabIndex = 4
Top = 5355
Width = 10200
Begin VB.CommandButton Command2
Caption = "浏览(&B)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 6390
TabIndex = 2
Top = 30
Width = 1260
End
Begin 给出焦点文本框.FocusText txtSearch
Height = 315
Left = 1500
TabIndex = 0
Top = 60
Width = 3435
_ExtentX = 6059
_ExtentY = 556
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BorderStyle = 0
GotBackColor = 16777215
GotForeColor = 12582912
LostBackColor = 14737632
LostForeColor = 12582912
PreControl = "Grid1"
End
Begin VB.CommandButton Command1
Caption = "查找(&S)"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 5055
TabIndex = 1
Top = 30
Width = 1260
End
Begin VB.CommandButton cmdExit
BackColor = &H00FFFFFF&
Cancel = -1 'True
Caption = "返回(&R)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 8775
MaskColor = &H00FFFFFF&
TabIndex = 3
Top = 30
Width = 1230
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "供应商姓名:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 5
Top = 90
Width = 1320
End
End
End
Attribute VB_Name = "frmSuppler"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim New_AniCur As New AniCursor '动画光标
Private Sub cmdExit_Click()
Me.Hide
End Sub
Private Sub Command1_Click()
Me.MousePointer = 11
If Trim(txtSearch.Text) <> "" Then
If InStr(1, txtSearch.Text, "'", vbTextCompare) Then
MsgBox "对不起，查询的供应商名称中不能有《'》号？ ", vbInformation
Exit Sub
Else
ConfigData "Select * From Suppler Where UnitID Like '%" & Trim(txtSearch.Text) & "%' Or UnitName Like '%" & Trim(txtSearch.Text) & "%'"
End If
End If
Me.MousePointer = 0
End Sub
Private Sub Command2_Click()
ConfigData "Select * From Suppler"
End Sub
Private Sub Form_Load()
' Me.Left = frmSuppler.Left + 160
' Me.Top = frmSuppler.Top + 500
'表单安装为真
SupplerForm = True
'Grid Config
ConfigData "Select * From Suppler"
Screen.MousePointer = 0
Me.MousePointer = 0
'装载动画光标
New_AniCur.AniFileName = App.Path + "\sys\9.ani"
New_AniCur.SetAniCursor Grid1.hwnd
End Sub
Private Sub Form_Resize()
If Me.WindowState = 1 Then Exit Sub
On Error Resume Next
Grid1.Left = 0
Grid1.Top = 0
Grid1.Width = Me.ScaleWidth
Grid1.Height = Me.ScaleHeight - picTool.Height - 100
picTool.Left = 0
picTool.Top = Grid1.Height + 50
picTool.Width = Grid1.Width
End Sub
Private Sub ConfigData(sSQL As String)
On Error GoTo Err_S
'配置网格
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 6
Grid1.FormatString = "..|^ 编号 |^ 供应商名称 |^ 联系人 |^ 电话 |^ 传真 |^地址"
Grid1.ColWidth(0) = 200
Grid1.ColWidth(1) = 1000
Grid1.ColWidth(2) = 3500
Grid1.ColWidth(3) = 1200
Grid1.ColWidth(4) = 2000
Grid1.ColWidth(5) = 4000
Dim Con As Connection
Dim rRecord As Recordset
Set Con = New Connection
Con.Open adDsn '打开ODBC数据源
Set rRecord = New Recordset
rRecord.Open sSQL, Con, adOpenStatic, adLockPessimistic, adCmdText
If rRecord.BOF Or rRecord.EOF Then
rRecord.Close
Con.Close
Set rRecord = Nothing
Set Con = Nothing
Else
Dim GridNO As Long
Do While Not rRecord.EOF
GridNO = GridNO + 1
rRecord.MoveNext
Loop
Grid1.Rows = GridNO + 5
If Grid1.Rows < 30 Then '缺省的30行
Grid1.Rows = 30
End If
If rRecord.BOF And rRecord.EOF Then
Else
rRecord.MoveFirst
HH = 1
Do While Not rRecord.EOF
Grid1.Row = HH
Grid1.Col = 1
Grid1.CellAlignment = 1
If Not IsNull(rRecord.Fields("UnitID")) Then
Grid1.Text = rRecord.Fields("UnitID")
End If
Grid1.Col = 2
Grid1.CellAlignment = 1
If Not IsNull(rRecord.Fields("UnitName")) Then
Grid1.Text = rRecord.Fields("UnitName")
End If
Grid1.Col = 3
Grid1.CellAlignment = 1
If Not IsNull(rRecord.Fields("UnitContact")) Then
Grid1.Text = rRecord.Fields("UnitContact")
End If
Grid1.Col = 4
Grid1.CellAlignment = 1
If Not IsNull(rRecord.Fields("UnitTel")) Then
Grid1.Text = rRecord.Fields("UnitTel")
End If
Grid1.Col = 5
Grid1.CellAlignment = 1
If Not IsNull(rRecord.Fields("Unitaddress")) Then
Grid1.Text = rRecord.Fields("Unitaddress")
End If
rRecord.MoveNext
HH = HH + 1
Loop
End If
rRecord.Close
Con.Close
Set rRecord = Nothing
Set Con = Nothing
Grid1.Row = 1
Grid1.Col = 1
End If
Grid1.ColSel = 5
Grid1.Visible = True
Exit Sub
Err_S:
MsgBox "很抱歉，不能正常配置网格（或查询供应商） " & vbCrLf & vbCrLf & "：请 WWW.VB-CODE.NET,网咨询 " & vbCrLf & vbCrLf & Err.Description, vbInformation, "Error for form load."
Exit Sub
End Sub
Private Sub Form_Unload(Cancel As Integer)
New_AniCur.RelaseAniCursor Grid1.hwnd
Set New_AniCur = Nothing
End Sub
Private Sub Grid1_DblClick()
If Grid1.Text = "" Then
'MsgBox "请选择《供应商》后,再双击！ ", vbInformation
Exit Sub
End If
frmOrder.txtUnitID.Text = Grid1.TextMatrix(Grid1.Row, 1)
frmOrder.lbUnit = Grid1.TextMatrix(Grid1.Row, 2)
Me.Hide
End Sub
Private Sub Grid1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Grid1.Text = "" Then
MsgBox "请选择《供应商》后,再双击！ ", vbInformation
Exit Sub
End If
frmOrder.txtUnitID.Text = Grid1.TextMatrix(Grid1.Row, 1)
frmOrder.lbUnit = Grid1.TextMatrix(Grid1.Row, 2)
Me.Hide
End If
End Sub
Private Sub picTool_Resize()
On Error Resume Next
cmdExit.Left = picTool.Width - cmdExit.Width - 200
End Sub
Private Sub txtSearch_Change()
If Trim(txtSearch.Text) <> "" Then
Command1.Enabled = True
Else
Command1.Enabled = False
End If
End Sub
Private Sub txtSearch_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 And Trim(txtSearch) <> "" Then
If Command1.Enabled = True Then Call Command1_Click
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -