📄 frmphclothserial.frm
字号:
VERSION 5.00
Begin VB.Form frmPHClothSerial
BorderStyle = 0 'None
Caption = "布料级别"
ClientHeight = 3750
ClientLeft = 0
ClientTop = 0
ClientWidth = 6435
LinkTopic = "Form1"
Picture = "frmPHClothSerial.frx":0000
ScaleHeight = 3750
ScaleWidth = 6435
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox Text1
Appearance = 0 'Flat
Height = 285
Left = 2970
TabIndex = 2
Top = 990
Width = 1965
End
Begin VB.TextBox Text3
Appearance = 0 'Flat
Height = 285
Left = 2970
TabIndex = 1
Top = 1860
Width = 1965
End
Begin VB.TextBox Text2
Appearance = 0 'Flat
Height = 285
Left = 2970
TabIndex = 0
Top = 1410
Width = 1965
End
Begin VB.PictureBox Picture1
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 345
Left = 1770
Picture = "frmPHClothSerial.frx":4EDFA
ScaleHeight = 23
ScaleMode = 3 'Pixel
ScaleWidth = 80
TabIndex = 5
Top = 2700
Width = 1200
End
Begin VB.PictureBox Picture2
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 345
Left = 4050
Picture = "frmPHClothSerial.frx":503CC
ScaleHeight = 23
ScaleMode = 3 'Pixel
ScaleWidth = 80
TabIndex = 4
Top = 2700
Width = 1200
End
Begin VB.Image Image1
Height = 330
Left = 5850
Picture = "frmPHClothSerial.frx":5199E
Top = 210
Width = 330
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 = 1920
TabIndex = 8
Top = 1890
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 = 1920
TabIndex = 7
Top = 1440
Width = 1065
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 = 1920
TabIndex = 6
Top = 1020
Width = 1125
End
Begin VB.Image Image2
Height = 585
Left = 900
Picture = "frmPHClothSerial.frx":51FB8
Top = 840
Width = 555
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "布料级别管理"
ForeColor = &H0000FFFF&
Height = 195
Index = 0
Left = 840
TabIndex = 3
Top = 300
Width = 1185
End
End
Attribute VB_Name = "frmPHClothSerial"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim env As rdoEnvironment
Dim cn As rdoConnection
Dim result As rdoResultset
Dim result1 As rdoResultset
Dim d_conn, sql As String
Dim hrowcount, hrowcount1 As Integer
Dim n As Integer
Dim jframe As New dframe
Private Function GetNextKey() As String
'Returns a new key value for each Node being added to the TreeView
'This algorithm is very simple and will limit you to adding a total of 999 nodes
'Each node needs a unique key. If you allow users to remove Nodes you can't use
'the Nodes count +1 as the key for a new node.
Dim sNewKey As String
Dim iHold As Integer
Dim i As Integer
On Error GoTo myerr
'The next line will return error #35600 if there are no Nodes in the TreeView
iHold = Val(frmPHCangKu.TreeView1.Nodes(1).Key)
For i = 1 To frmPHCangKu.TreeView1.Nodes.Count
If Val(frmPHCangKu.TreeView1.Nodes(i).Key) > iHold Then
iHold = Val(frmPHCangKu.TreeView1.Nodes(i).Key)
End If
Next
iHold = iHold + 1
sNewKey = CStr(iHold) & "_"
GetNextKey = sNewKey 'Return a unique key
Exit Function
myerr:
'Because the TreeView is empty return a 1 for the key of the first Node
GetNextKey = "1_"
Exit Function
End Function
Private Sub Form_Load()
rgn1 = 0
n = 0
Dim Ma As Dat
Show
Open App.Path & "\publish.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
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)
Text1.Text = GoodsTree
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
frmPHClothSerial.Move frmPHClothSerial.Left - mX + X, frmPHClothSerial.Top - mY + Y
End If
Picture1.Cls
Picture2.Cls
End Sub
Private Sub Image1_Click()
Unload Me
End Sub
Private Sub Picture1_Click()
Dim RecordCount As Integer
Dim oindex As Integer
Dim skey As String
sql = "select * from ClothSerial where 级别='" & Trim(Text1.Text) & "' and 布料号='" & Trim(Text2.Text) & "'"
Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
If result.RowCount <> 0 Then
MsgBox "本布料已经存在...."
Else
sql = "insert into ClothSerial(级别,布料号,序号) values ('" & Trim(Text1.Text) & "','" & Trim(Text2.Text) & "','" & Trim(Text3.Text) & "')"
Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
sql = "select * from ClothSerial where 级别='" & Trim(GoodsTree) & "'"
Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
If result.RowCount <> 0 Then
result.MoveLast
RecordCount = result.RowCount
result.MoveFirst
End If
skey = RecordCount & GetNextKey()
oindex = frmPHCangKu.TreeView1.SelectedItem.Index
If result.RowCount <> 0 Then
Set frmPHCangKu.TreeView1.ImageList = frmPHCangKu.ImageList1
Set Treesub = frmPHCangKu.TreeView1.Nodes.Add(oindex, tvwChild, skey, Trim(Text2.Text), 1)
Treesub.Image = 1
Treesub.EnsureVisible
End If
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 Text2_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 + -