📄 frmview.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 frmView
BorderStyle = 1 'Fixed Single
Caption = "药品信息"
ClientHeight = 6165
ClientLeft = 45
ClientTop = 330
ClientWidth = 7410
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6165
ScaleWidth = 7410
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command4
Caption = "浏览"
Height = 375
Left = 4920
TabIndex = 14
Top = 1800
Width = 735
End
Begin VB.TextBox txtPath
DataField = "AdPath"
DataSource = "Adodc1"
Height = 390
Left = 1080
TabIndex = 13
Top = 1800
Width = 3735
End
Begin VB.CommandButton Command3
Caption = "选择"
Height = 300
Left = 2760
TabIndex = 12
Top = 1440
Width = 855
End
Begin VB.TextBox txtPicFile
Height = 270
Left = 2880
TabIndex = 11
Top = 0
Visible = 0 'False
Width = 180
End
Begin MSAdodcLib.Adodc Adodc2
Height = 375
Left = 2040
Top = 5640
Visible = 0 'False
Width = 1200
_ExtentX = 2117
_ExtentY = 661
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
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 = "frmView.frx":0000
DataField = "sType"
DataSource = "Adodc1"
Height = 330
Left = 5760
TabIndex = 6
Top = 600
Width = 1215
_ExtentX = 2143
_ExtentY = 582
_Version = 393216
ListField = "type_name"
BoundColumn = "type_name"
Text = "DataCombo1"
Object.DataMember = ""
End
Begin VB.TextBox Text3
DataField = "sGd"
DataSource = "Adodc1"
Height = 375
Left = 3720
Locked = -1 'True
TabIndex = 5
Text = "Text3"
Top = 1080
Width = 1695
End
Begin VB.CommandButton Command2
Caption = "取消"
Height = 375
Left = 5400
TabIndex = 4
Top = 5640
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "确定"
Height = 375
Left = 3600
TabIndex = 3
Top = 5640
Width = 1455
End
Begin VB.TextBox Text2
DataField = "StoreNum"
DataSource = "Adodc1"
Height = 375
Left = 3720
TabIndex = 2
Text = "Text2"
Top = 600
Width = 1695
End
Begin MSAdodcLib.Adodc Adodc1
Height = 330
Left = 720
Top = 5640
Visible = 0 'False
Width = 1200
_ExtentX = 2117
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
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 VB.TextBox Text1
DataField = "StorePrice"
DataSource = "Adodc1"
Height = 375
Left = 3720
TabIndex = 0
Text = "Text1"
Top = 120
Width = 1695
End
Begin RichTextLib.RichTextBox RichTextBox1
DataField = "Specification"
DataSource = "Adodc1"
Height = 3255
Left = 120
TabIndex = 1
Top = 2280
Width = 7095
_ExtentX = 12515
_ExtentY = 5741
_Version = 393217
BorderStyle = 0
Enabled = -1 'True
ScrollBars = 1
Appearance = 0
TextRTF = $"frmView.frx":0015
End
Begin VB.Label Label5
Caption = "广告位置"
Height = 255
Left = 120
TabIndex = 15
Top = 1800
Width = 855
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
DataField = "sPicture"
DataSource = "Adodc1"
Height = 1575
Left = 120
OLEDragMode = 1 'Automatic
OLEDropMode = 2 'Automatic
Stretch = -1 'True
Top = 120
Width = 2535
End
Begin VB.Label Label4
Caption = "分类："
Height = 255
Left = 5760
TabIndex = 10
Top = 240
Width = 855
End
Begin VB.Label Label3
Caption = "轨道："
Height = 255
Left = 3120
TabIndex = 9
Top = 1200
Width = 615
End
Begin VB.Label Label2
Caption = "数量："
Height = 255
Left = 3120
TabIndex = 8
Top = 720
Width = 615
End
Begin VB.Label Label1
Caption = "价格："
Height = 255
Left = 3120
TabIndex = 7
Top = 240
Width = 615
End
End
Attribute VB_Name = "frmView"
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
Const BLOCKSIZE = 4096
Public ypstr As String
Private Sub Command1_Click()
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
'Me.Adodc1.Recordset.Update
Call SaveToDB(Me.Adodc1.Recordset.Fields(40), OpenFileDlg.FileName)
Image1.Picture = LoadPicture(OpenFileDlg.FileName)
bDirty(vbPicture) = False
End If
End Sub
Private Sub Command4_Click()
Dim sFilter As String
OpenFileDlg.hWndOwner = Me.hWnd
OpenFileDlg.Title = "选择广告电影"
sFilter = "Moive Files" & vbNullChar & "*.avi;*.wmv;*.mpg" & vbNullChar
sFilter = sFilter & "All Files" & vbNullChar & "*.*" & String$(2, 0)
OpenFileDlg.Filter = sFilter
OpenFileDlg.FileName = ""
OpenFileDlg.Show
If Len(OpenFileDlg.FileName) Then
txtPath.Text = OpenFileDlg.FileName
End If
Me.Adodc1.Recordset.Update
txtPath.SetFocus
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
' Me.Adodc1.Recordset.Open
strtype = " select * from drugstype"
Me.Adodc2.RecordSource = strtype
Me.Adodc2.Refresh
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 + -