www.pudn.com > chap07.rar > frmTmEdit1.frm
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmTmAdd
BorderStyle = 3 'Fixed Dialog
Caption = "添加题目"
ClientHeight = 5775
ClientLeft = 2760
ClientTop = 3750
ClientWidth = 8250
ControlBox = 0 'False
Icon = "frmTmAdd.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5775
ScaleWidth = 8250
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BackColor = &H80000011&
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 2205
Left = 135
ScaleHeight = 2145
ScaleWidth = 2205
TabIndex = 28
Top = 3510
Width = 2265
Begin VB.Image Image1
Height = 2145
Left = 0
Stretch = -1 'True
Top = 0
Width = 2205
End
End
Begin VB.CommandButton cmdClear
Caption = "×"
Height = 375
Left = 7710
TabIndex = 27
Top = 3840
Width = 465
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 4980
Top = 4905
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.TextBox txtTmda
DataField = "tmda"
DataSource = "Adodc1"
Height = 420
Left = 5820
TabIndex = 26
Text = "tmda"
Top = 4260
Visible = 0 'False
Width = 1065
End
Begin VB.TextBox txtTmlx_id
DataField = "tmlx_id"
DataSource = "Adodc1"
Height = 405
Left = 4800
TabIndex = 25
Text = "tmlx_id"
Top = 4260
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtTmlb_id
DataField = "tmlb_id"
DataSource = "Adodc1"
Height = 375
Left = 3900
TabIndex = 24
Text = "tmlb_id"
Top = 4275
Visible = 0 'False
Width = 870
End
Begin MSAdodcLib.Adodc Adodc1
Height = 375
Left = 2475
Top = 4275
Visible = 0 'False
Width = 1395
_ExtentX = 2461
_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 = "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.CommandButton cmdBrowse
Caption = "..."
Height = 375
Left = 7230
TabIndex = 10
Tag = "4365"
Top = 3840
Width = 465
End
Begin VB.CommandButton cmdOK
Caption = "保存(&S)"
Enabled = 0 'False
Height = 375
Left = 3360
TabIndex = 9
Top = 4830
Width = 1215
End
Begin VB.CommandButton cmdCancel
Caption = "取消(&C)"
Height = 375
Left = 6270
TabIndex = 11
Top = 4830
Width = 1215
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "frmTmAdd.frx":000C
Left = 3330
List = "frmTmAdd.frx":000E
Style = 2 'Dropdown List
TabIndex = 8
Top = 3525
Width = 4845
End
Begin VB.TextBox Text1
BackColor = &H8000000F&
DataField = "tp"
DataSource = "Adodc1"
Height = 315
Index = 9
Left = 3330
Locked = -1 'True
TabIndex = 12
Tag = "3330"
Top = 3870
Width = 3885
End
Begin VB.TextBox Text1
DataField = "tmmc"
DataSource = "Adodc1"
Height = 315
Index = 2
Left = 1020
TabIndex = 1
Top = 465
Width = 7155
End
Begin VB.TextBox Text1
DataField = "tmbh"
DataSource = "Adodc1"
Height = 315
Index = 1
Left = 1020
TabIndex = 0
Top = 105
Width = 7155
End
Begin VB.Frame Frame1
Caption = "题目选项"
Height = 2565
Left = 135
TabIndex = 17
Top = 885
Width = 8040
Begin VB.TextBox Text1
DataField = "F"
DataSource = "Adodc1"
Height = 300
Index = 8
Left = 450
TabIndex = 7
Top = 2040
Width = 7485
End
Begin VB.TextBox Text1
DataField = "E"
DataSource = "Adodc1"
Height = 300
Index = 7
Left = 450
TabIndex = 6
Top = 1695
Width = 7485
End
Begin VB.TextBox Text1
DataField = "D"
DataSource = "Adodc1"
Height = 300
Index = 6
Left = 450
TabIndex = 5
Top = 1350
Width = 7485
End
Begin VB.TextBox Text1
DataField = "C"
DataSource = "Adodc1"
Height = 300
Index = 5
Left = 450
TabIndex = 4
Top = 1005
Width = 7485
End
Begin VB.TextBox Text1
DataField = "B"
DataSource = "Adodc1"
Height = 300
Index = 4
Left = 450
TabIndex = 3
Top = 660
Width = 7485
End
Begin VB.TextBox Text1
DataField = "A"
DataSource = "Adodc1"
Height = 300
Index = 3
Left = 450
TabIndex = 2
Top = 315
Width = 7485
End
Begin VB.Label lblF
AutoSize = -1 'True
Caption = "F、"
Height = 180
Left = 225
TabIndex = 23
Top = 2070
Width = 270
End
Begin VB.Label lblE
AutoSize = -1 'True
Caption = "E、"
Height = 180
Left = 225
TabIndex = 22
Top = 1755
Width = 270
End
Begin VB.Label lblD
AutoSize = -1 'True
Caption = "D、"
Height = 180
Left = 225
TabIndex = 21
Top = 1395
Width = 270
End
Begin VB.Label lblC
AutoSize = -1 'True
Caption = "C、"
Height = 180
Left = 225
TabIndex = 20
Top = 1050
Width = 270
End
Begin VB.Label lblB
AutoSize = -1 'True
Caption = "B、"
Height = 180
Left = 225
TabIndex = 19
Top = 720
Width = 270
End
Begin VB.Label lblA
AutoSize = -1 'True
Caption = "A、"
Height = 180
Left = 225
TabIndex = 18
Top = 330
Width = 270
End
End
Begin VB.Label lblTp
AutoSize = -1 'True
Caption = "题目图片："
Height = 180
Left = 2460
TabIndex = 16
Tag = "3330"
Top = 3945
Width = 900
End
Begin VB.Label lblTmda
AutoSize = -1 'True
Caption = "题目答案："
Height = 180
Left = 2460
TabIndex = 15
Tag = "2460"
Top = 3570
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "题目名称："
Height = 180
Left = 135
TabIndex = 14
Top = 495
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "题目编号："
Height = 180
Left = 135
TabIndex = 13
Top = 165
Width = 900
End
End
Attribute VB_Name = "frmTmAdd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private miTmlx_id As Integer '题目类型编号
Private miTmlb_id As Integer '题目类别编号
Private rs As ADODB.Recordset '数据源
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
'设置
Public Property Let TmADORecordset(ByRef vNewValue As ADODB.Recordset)
Set rs = vNewValue
End Property
'设置
Public Property Let Tmlx_id(ByVal vNewValue As Integer)
miTmlx_id = vNewValue
End Property
'设置
Public Property Let Tmlb_id(ByVal vNewValue As Integer)
miTmlb_id = vNewValue
End Property
'添加一行
Private Sub InsertRow()
'加一条新记录
rs.AddNew
txtTmlb_id.Text = CStr(miTmlb_id)
txtTmlx_id.Text = CStr(miTmlx_id)
'----------------------------
cmdOK.Enabled = False
Combo1.ListIndex = 0
txtTmda.Text = Combo1.Text
End Sub
Private Sub cmdBrowse_Click()
Dim pfn As String '路径及文件名
Dim fn As String '纯文件名
'
On Error GoTo ErrHandler
CommonDialog1.CancelError = True
CommonDialog1.DialogTitle = "选择图片文件"
CommonDialog1.Filter = "位图文件(*.bmp)|*.bmp|JPG文件(*.jpg)|*.jpg"
CommonDialog1.FilterIndex = 1
'Display the Open dialog box
CommonDialog1.ShowOpen
pfn = CommonDialog1.FileName
fn = CommonDialog1.FileTitle
If pfn <> (GetAppPath() & "pic\" & fn) Then '在给定图片路径下不存在
CopyFile pfn, GetAppPath() & "pic\" & fn, 0
End If
'--------------------------------------------------------------
Text1(9).Text = "pic\" & fn
Image1.Picture = LoadPicture(GetAppPath() & "pic\" & fn)
Exit Sub
ErrHandler:
'按了"取消"按钮
End Sub
Private Sub cmdCancel_Click()
rs.CancelUpdate
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim bh As Integer
Dim ct As Integer
Dim rs As ADODB.Recordset
Dim szSQL As String
On Error GoTo ErrHandler
bh = CInt(Text1(1).Text)
'10:编号是否重复
szSQL = "SELECT Count(*) as ct FROM tbTK WHERE tmlb_id=" & CStr(miTmlb_id) & " AND tmlx_id=" & CStr(miTmlx_id) & " AND tmbh=" & CStr(bh)
Set rs = gadoCONN.Execute(szSQL)
If Not rs.EOF Then rs.MoveLast
If Not rs.BOF Then rs.MoveFirst
If ToLong(rs("ct")) >= 1 Then
MsgBox "该题目编号已经使用，请用其他编号！", vbOKOnly + vbInformation, Me.Caption
Text1(1).SetFocus
Exit Sub
End If
'保存记录
Adodc1.Recordset.Move 0
'添加新记录
Call InsertRow
Text1(1).SetFocus
Exit Sub
ErrHandler:
Set rs = Nothing
ErrMessageBox "保存记录cmdOK_Click()", Me.Caption
End Sub
Private Sub Combo1_Click()
txtTmda.Text = Combo1.Text
End Sub
Private Sub cmdClear_Click()
Text1(9).Text = ""
Image1.Picture = LoadPicture()
End Sub
Private Sub Form_Load()
On Error Resume Next
'是选择题还是判断题
Select Case miTmlx_id
Case 0 '选择题
Me.Caption = "添加选择题"
Combo1.AddItem "A"
Combo1.AddItem "B"
Combo1.AddItem "C"
Combo1.AddItem "D"
Combo1.AddItem "E"
Combo1.AddItem "F"
Case 1 '判断题
Me.Caption = "添加判断题"
Combo1.AddItem "对"
Combo1.AddItem "错"
Call ChangePosition
Frame1.Visible = False
End Select
'
' Picture1.CurrentX = 600
' Picture1.CurrentY = 800
' Picture1.Print "图片预览"
'
Set Adodc1.Recordset = rs
'添加一行
Call InsertRow
End Sub
Private Sub Text1_Change(Index As Integer)
If miTmlb_id = 0 Then
Select Case Index
Case 1, 2, 3, 4, 5
If (Text1(1).Text = "") Or (Text1(2).Text = "") Or (Text1(3).Text = "") Or (Text1(4).Text = "") Or (Text1(5).Text = "") Then
cmdOK.Enabled = False
Else
cmdOK.Enabled = True
End If
Case Else
End Select
Else
Select Case Index
Case 1, 2
If (Text1(1).Text = "") Or (Text1(2).Text = "") Then
cmdOK.Enabled = False
Else
cmdOK.Enabled = True
End If
Case Else
End Select
End If
End Sub
Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then '回车键
If miTmlx_id = 0 Then '选择题
Select Case Index
Case 8
Combo1.SetFocus
Case Else
Text1(Index + 1).SetFocus
End Select
Else '判断题
SendKeys "{tab}"
End If
End If
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then '回车键
SendKeys "{Tab}"
End If
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If Index = 1 Then '编号
If KeyAscii < 48 Or KeyAscii > 57 Then '只允许输入数字
KeyAscii = 0
End If
End If
End Sub
'如果是判断题，则调整各控件的位置
Private Sub ChangePosition()
Dim offset As Integer
offset = Frame1.Height
Picture1.Top = Picture1.Top - offset
lblTmda.Top = lblTmda.Top - offset
Combo1.Top = Combo1.Top - offset
lblTp.Top = lblTp.Top - offset
Text1(9).Top = Text1(9).Top - offset
cmdBrowse.Top = cmdBrowse.Top - offset
cmdClear.Top = cmdClear.Top - offset
cmdOK.Top = cmdOK.Top - offset
cmdCancel.Top = cmdCancel.Top - offset
Me.Height = Me.Height - offset
End Sub