📄 frmypadm.frm
字号:
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form frmYpadm
BorderStyle = 1 'Fixed Single
Caption = "添加药品"
ClientHeight = 6615
ClientLeft = 150
ClientTop = 435
ClientWidth = 8670
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6615
ScaleWidth = 8670
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox Text6
DataField = "SearchCD"
DataSource = "Adodc1"
Height = 375
Left = 1320
TabIndex = 17
Text = "Text6"
Top = 2160
Width = 1695
End
Begin VB.ComboBox Combo1
DataField = "Unit"
DataSource = "Adodc1"
Height = 300
ItemData = "frmYpadm.frx":0000
Left = 1320
List = "frmYpadm.frx":000D
TabIndex = 15
Text = "Combo1"
Top = 1680
Width = 1095
End
Begin VB.TextBox Text5
DataField = "EghName"
DataSource = "Adodc1"
Height = 375
Left = 1320
TabIndex = 12
Text = "Text5"
Top = 1080
Width = 2175
End
Begin VB.TextBox Text4
DataField = "Name"
DataSource = "Adodc1"
Height = 375
Left = 1320
TabIndex = 11
Text = "Text4"
Top = 600
Width = 2175
End
Begin VB.TextBox Text1
DataField = "StorePrice"
DataSource = "Adodc1"
Height = 375
Left = 1320
TabIndex = 6
Top = 3120
Width = 1695
End
Begin VB.TextBox Text2
DataField = "StoreNum"
DataSource = "Adodc1"
Height = 375
Left = 1320
TabIndex = 5
Top = 3600
Width = 1695
End
Begin VB.CommandButton Command1
Caption = "确定"
Height = 375
Left = 3480
TabIndex = 4
Top = 6120
Width = 1455
End
Begin VB.CommandButton Command2
Caption = "取消"
Height = 375
Left = 5520
TabIndex = 3
Top = 6120
Width = 1335
End
Begin VB.TextBox txtPicFile
Height = 270
Left = 4800
TabIndex = 1
Top = 2160
Visible = 0 'False
Width = 180
End
Begin VB.CommandButton Command3
Caption = "选择"
Height = 300
Left = 7200
TabIndex = 0
Top = 1680
Width = 855
End
Begin MSAdodcLib.Adodc Adodc2
Height = 375
Left = 1800
Top = 5040
Visible = 0 'False
Width = 1200
_ExtentX = 2117
_ExtentY = 661
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 2
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=data;Data Source=."
OLEDBString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=data;Data Source=."
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = "DrugsType"
Caption = "Adodc2"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MSDataListLib.DataCombo DataCombo1
Bindings = "frmYpadm.frx":001D
DataField = "sType"
DataSource = "Adodc1"
Height = 330
Left = 1320
TabIndex = 2
Top = 4080
Width = 1215
_ExtentX = 2143
_ExtentY = 582
_Version = 393216
ListField = "type_name"
BoundColumn = "type_name"
Text = "DataCombo1"
Object.DataMember = ""
End
Begin MSAdodcLib.Adodc Adodc1
Height = 330
Left = 120
Top = 5040
Visible = 0 'False
Width = 1200
_ExtentX = 2117
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 2
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=data;Data Source=."
OLEDBString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=data;Data Source=."
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = "DrugsDB"
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin RichTextLib.RichTextBox RichTextBox1
DataField = "Specification"
DataSource = "Adodc1"
Height = 3495
Left = 3480
TabIndex = 7
Top = 2520
Width = 4935
_ExtentX = 8705
_ExtentY = 6165
_Version = 393217
BorderStyle = 0
Enabled = -1 'True
ScrollBars = 1
Appearance = 0
TextRTF = $"frmYpadm.frx":0032
End
Begin VB.Label Lypb
Caption = "Label9"
DataField = "DrugID"
DataSource = "Adodc1"
Height = 375
Left = 480
TabIndex = 19
Top = 120
Width = 2415
End
Begin VB.Label Label8
Caption = "拼音码"
Height = 255
Left = 240
TabIndex = 18
Top = 2160
Width = 975
End
Begin VB.Label Label7
Caption = "单位"
Height = 255
Left = 240
TabIndex = 16
Top = 1680
Width = 735
End
Begin VB.Label Label6
Caption = "英文名称"
Height = 375
Left = 240
TabIndex = 14
Top = 1080
Width = 735
End
Begin VB.Label Label5
Caption = "名称"
Height = 255
Left = 240
TabIndex = 13
Top = 600
Width = 735
End
Begin VB.Label Label1
Caption = "价格："
Height = 255
Left = 360
TabIndex = 10
Top = 3240
Width = 615
End
Begin VB.Label Label2
Caption = "数量："
Height = 255
Left = 360
TabIndex = 9
Top = 3720
Width = 615
End
Begin VB.Label Label4
Caption = "分类："
Height = 255
Left = 240
TabIndex = 8
Top = 4200
Width = 735
End
Begin VB.Image Image1
DataField = "sPicture"
DataSource = "Adodc1"
Height = 1575
Left = 4320
Stretch = -1 'True
Top = 360
Width = 2535
End
End
Attribute VB_Name = "frmYpadm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const vbDBName As Byte = 1
Private Const vbPicture As Byte = 2
Private bDirty(1 To 2) As Boolean
Public ypstr As String
Const BLOCKSIZE = 4096
Public ID As String
Private Sub Command1_Click()
If txtPicFile <> "" Then
Call SaveToDB(Me.Adodc1.Recordset.Fields(40), txtPicFile)
End If
Me.Adodc1.Recordset.Update
Unload Me
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
Dim sFilter As String
OpenFileDlg.hWndOwner = Me.hWnd
' txtPicFile.SetFocus
OpenFileDlg.Title = "Select Picture"
sFilter = "Picture Files" & vbNullChar & "*.BMP;*.ICO;*.RLE;*.jpg;*.gif" & vbNullChar
sFilter = sFilter & "All Files" & vbNullChar & "*.*" & String$(2, 0)
OpenFileDlg.Filter = sFilter
OpenFileDlg.FileName = ""
OpenFileDlg.Show
If Len(OpenFileDlg.FileName) Then
txtPicFile = OpenFileDlg.FileName
Image1.Picture = LoadPicture(OpenFileDlg.FileName)
bDirty(vbPicture) = False
'Me.Adodc1.Recordset.Update
End If
End Sub
Private Sub Form_Load()
Dim i As Long
Dim List_item As ListItem
Dim strSQL As String
Dim strtype As String
Dim j As Integer
j = 1
Me.Adodc1.ConnectionString = Constr
Me.Adodc2.ConnectionString = Constr
Adodc1.CommandType = adCmdText
Adodc2.CommandType = adCmdText
strSQL = "select * from DrugsDB where DrugID='" & ypstr & "'"
Adodc1.RecordSource = strSQL
Me.Adodc1.Refresh
strtype = " select * from drugstype"
Me.Adodc2.RecordSource = strtype
Me.Adodc2.Refresh
If ID = "0" Then
Me.Adodc1.Recordset.AddNew
Dim rs As New ADODB.Recordset
Dim m As Integer
Dim ypb As String
rs.Source = "select max(DrugID) as mID from DrugsDB"
rs.ActiveConnection = Constr
rs.Open
ypb = rs!Mid + 1
If Len(ypb) < 8 Then
For m = Len(ypb) + 1 To 8 Step 1
ypb = "0" & ypb
Next
End If
Lypb.Caption = ypb
rs.Close
End If
End Sub
Private Sub SaveToDB(ByRef Fld As ADODB.Field, DiskFile As String)
Dim byteData() As Byte
Dim NumBlocks As Long
Dim FileLength As Long
Dim LeftOver As Long
Dim SourceFile As Long
Dim i As Long
SourceFile = FreeFile
Open DiskFile For Binary Access Read As SourceFile
FileLength = LOF(SourceFile)
If FileLength = 0 Then
Close SourceFile
MsgBox DiskFile & " 无 内 容 或 不 存 在 !"
Else
NumBlocks = FileLength \ BLOCKSIZE
LeftOver = FileLength Mod BLOCKSIZE
Fld.Value = Null
ReDim byteData(BLOCKSIZE)
For i = 1 To NumBlocks
Get SourceFile, , byteData()
Fld.AppendChunk byteData()
Next i
ReDim byteData(LeftOver)
Get SourceFile, , byteData()
Fld.AppendChunk byteData()
Close SourceFile
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -