📄 frmphcangkuin.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmPHCangKuIn
BorderStyle = 0 'None
Caption = "仓库数据输入"
ClientHeight = 6120
ClientLeft = 0
ClientTop = 0
ClientWidth = 6435
LinkTopic = "Form1"
Picture = "frmPHCangKuIn.frx":0000
ScaleHeight = 6120
ScaleWidth = 6435
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox Picture1
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 345
Left = 1590
Picture = "frmPHCangKuIn.frx":847F2
ScaleHeight = 23
ScaleMode = 3 'Pixel
ScaleWidth = 80
TabIndex = 18
Top = 4890
Width = 1200
End
Begin VB.PictureBox Picture2
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 345
Left = 3870
Picture = "frmPHCangKuIn.frx":85DC4
ScaleHeight = 23
ScaleMode = 3 'Pixel
ScaleWidth = 80
TabIndex = 17
Top = 4890
Width = 1200
End
Begin VB.TextBox Text3
Appearance = 0 'Flat
Height = 285
Left = 2730
TabIndex = 2
Top = 1980
Width = 1425
End
Begin VB.TextBox Text2
Appearance = 0 'Flat
Height = 285
Left = 2730
TabIndex = 7
Top = 1140
Width = 1425
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
Height = 285
Left = 2730
TabIndex = 3
Top = 2400
Width = 2475
End
Begin VB.TextBox Text4
Appearance = 0 'Flat
Height = 285
Left = 2730
TabIndex = 4
Top = 2820
Width = 2475
End
Begin VB.TextBox Text5
Appearance = 0 'Flat
Height = 285
Left = 2730
TabIndex = 5
Top = 3240
Width = 2475
End
Begin VB.TextBox Text6
Appearance = 0 'Flat
Height = 285
Left = 2730
TabIndex = 1
Top = 1560
Width = 1425
End
Begin MSComCtl2.DTPicker date1
Height = 285
Left = 2730
TabIndex = 6
Top = 3660
Width = 1695
_ExtentX = 2990
_ExtentY = 503
_Version = 393216
Format = 24576000
CurrentDate = 36529
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "布料原长度"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Index = 9
Left = 1500
TabIndex = 16
Top = 2010
Width = 1095
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "布料编号"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Index = 2
Left = 1710
TabIndex = 15
Top = 1170
Width = 1005
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "(米)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Index = 1
Left = 4200
TabIndex = 14
Top = 2040
Width = 465
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "布料名称"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Index = 3
Left = 1710
TabIndex = 13
Top = 2430
Width = 1005
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "供 应 商"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Index = 4
Left = 1710
TabIndex = 12
Top = 2850
Width = 1005
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "布料产地"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Index = 5
Left = 1710
TabIndex = 11
Top = 3270
Width = 1005
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "日 期"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Index = 6
Left = 1710
TabIndex = 10
Top = 3690
Width = 1005
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "幅 宽"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Index = 7
Left = 1710
TabIndex = 9
Top = 1590
Width = 1005
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "(米)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Index = 8
Left = 4200
TabIndex = 8
Top = 1620
Width = 465
End
Begin VB.Image Image1
Height = 330
Left = 5880
Picture = "frmPHCangKuIn.frx":87396
Top = 210
Width = 330
End
Begin VB.Image Image2
Height = 375
Left = 5460
Picture = "frmPHCangKuIn.frx":879B0
Top = 210
Width = 390
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "仓库数据输入"
ForeColor = &H0000FFFF&
Height = 285
Index = 0
Left = 840
TabIndex = 0
Top = 330
Width = 1845
End
End
Attribute VB_Name = "frmPHCangKuIn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim n As Integer
Dim jframe As New dframe
Dim env As rdoEnvironment
Dim cn As rdoConnection
Dim result As rdoResultset
Dim sql As String
Dim d_conn As String
Dim i As Integer
Dim hrecord As Integer
Private Sub date1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub Form_Load()
rgn1 = 0
n = 0
Dim Ma As Dat
Show
Open App.Path & "\CangKuIn.dat" For Random As #1 Len = Len(Ma)
Do While Not EOF(1)
n = n + 1
Get #1, n, Ma
If rgn1 = 0 Then rgn1 = CreateRectRgn(Ma.sx, Ma.sy, Ma.ex, Ma.ey)
If rgn1 <> 0 Then
rgn2 = CreateRectRgn(Ma.sx, Ma.sy, Ma.ex, Ma.ey)
CombineRgn rgn1, rgn1, rgn2, 2
'释放系统资源
DeleteObject rgn2
End If
Loop
'关闭文件
Close #1
SetWindowRgn hwnd, rgn1, True
DeleteObject rgn1
''''''''''连接远程数据库SQL SERVER''''
On Error GoTo errmsg
' Set env = rdoEnvironments(0)
' env.CursorDriver = rdUseOdbc
' d_conn = "uid=sa;pwd=;driver={SQL SERVER};SERVER=ntserver;database=phdatabase;"
' Set cn = env.OpenConnection(dsname:="odbc_api_demo", Prompt:="rdodriverprompt", ReadOnly:=False, Connect:=d_conn)
Text2.Text = GoodsTree
If ClothFlagh = 2 Then
date1.Value = CLOTHtableText(0)
Text2.Text = CLOTHtableText(1)
Text6.Text = CLOTHtableText(2)
Text3.Text = CLOTHtableText(3)
Text1.Text = CLOTHtableText(4)
Text4.Text = CLOTHtableText(5)
Text5.Text = CLOTHtableText(6)
End If
errmsg:
If Err.Number <> 0 Then
Text2.Text = GoodsTree
End If
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
mX = X
mY = Y
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
frmPHCangKuIn.Move frmPHCangKuIn.Left - mX + X, frmPHCangKuIn.Top - mY + Y
End If
Picture1.Cls
Picture2.Cls
End Sub
Private Sub Image1_Click()
Unload Me
End Sub
Private Sub Image2_Click()
frmPHCangKuIn.WindowState = 1
End Sub
Private Sub Picture1_Click()
On Error GoTo errmsg
If ClothFlagh = 1 Then
If MsgBox("确定是否存盘？", 36, "存盘！！") = 6 Then
sql = "insert into ClothTable(日期,布料编号,幅宽,布料原长度,布料名称,供应商,布料产地) values('" & Trim(date1.Value) & "','" & Trim(Text2.Text) & "'," & Val(Trim(Text6.Text)) & "," & Val(Trim(Text3.Text)) & ",'" & Trim(Text1.Text) & "','" & Trim(Text4.Text) & "','" & Trim(Text5.Text) & "')"
Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
MsgBox "存盘结束！！"
'''''''
sql = "select * from ClothTable where 布料编号='" & Trim(Text2.Text) & "'"
Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
frmPHCangKu.ListView1.ListItems.Clear
If result.RowCount <> 0 Then
Do While Not result.EOF()
Set itm = frmPHCangKu.ListView1.ListItems.Add(, , result("日期"))
itm.SubItems(1) = Trim(result("布料编号"))
itm.SubItems(2) = Trim(result("布料原长度"))
itm.SubItems(3) = Trim(result("布料名称"))
itm.SubItems(4) = Trim(result("供应商"))
result.MoveNext
Loop
End If
End If
End If
errmsg:
If Err.Number <> 0 Then
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture2.Cls
jframe.danum = 5
jframe.rtop = 1
jframe.rleft = 1
jframe.rright = 80
jframe.rbottom = 23
jframe.ddrawc Picture1
End Sub
Private Sub Picture2_Click()
Unload Me
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.Cls
jframe.danum = 5
jframe.rtop = 1
jframe.rleft = 1
jframe.rright = 80
jframe.rbottom = 23
jframe.ddrawc Picture2
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -