www.pudn.com > chap07.rar > frmManager.frm
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form frmManager
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 5325
ClientLeft = 45
ClientTop = 615
ClientWidth = 7200
Icon = "frmManager.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
Moveable = 0 'False
ScaleHeight = 5325
ScaleWidth = 7200
Begin VB.FileListBox File1
Height = 1710
Left = 3525
TabIndex = 12
Top = 1350
Visible = 0 'False
Width = 2235
End
Begin VB.CommandButton Command2
Caption = "倒入图片"
Height = 435
Left = 3600
TabIndex = 11
Top = 3810
Visible = 0 'False
Width = 1995
End
Begin VB.CommandButton Command1
Caption = "生成题库"
Height = 450
Left = 3600
TabIndex = 10
Top = 3210
Visible = 0 'False
Width = 1980
End
Begin VB.PictureBox Picture1
AutoSize = -1 'True
Height = 810
Left = 3855
ScaleHeight = 750
ScaleWidth = 1320
TabIndex = 9
Top = 2160
Visible = 0 'False
Width = 1380
End
Begin VB.PictureBox picSplitter
BackColor = &H80000007&
BorderStyle = 0 'None
Height = 3975
Left = 2835
ScaleHeight = 3975
ScaleWidth = 45
TabIndex = 2
Top = 960
Visible = 0 'False
Width = 45
End
Begin MSComctlLib.ImageList ImageList5
Left = 6495
Top = 3900
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":030A
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":0BE4
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":1A36
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":2310
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":262A
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList ImageList4
Left = 6465
Top = 3120
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":4334
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":4C0E
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":5A60
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":633A
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":6654
Key = ""
EndProperty
EndProperty
End
Begin MSDataGridLib.DataGrid DataGrid1
Bindings = "frmManager.frx":67AE
Height = 3555
Left = 3270
TabIndex = 3
Top = 1020
Width = 2625
_ExtentX = 4630
_ExtentY = 6271
_Version = 393216
AllowUpdate = 0 'False
AllowArrows = -1 'True
HeadLines = 2
RowHeight = 15
FormatLocked = -1 'True
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ColumnCount = 10
BeginProperty Column00
DataField = "tmbh"
Caption = "编号"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = "tmmc"
Caption = "题目名称"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column02
DataField = "tp"
Caption = "题目图片"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column03
DataField = "tmda"
Caption = "题目答案"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column04
DataField = "A"
Caption = "题目选项A"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column05
DataField = "B"
Caption = "题目选项B"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column06
DataField = "C"
Caption = "题目选项C"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column07
DataField = "D"
Caption = "题目选项D"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column08
DataField = "E"
Caption = "题目选项E"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column09
DataField = "F"
Caption = "题目选项F"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
MarqueeStyle = 3
AllowRowSizing = 0 'False
Locked = -1 'True
BeginProperty Column00
Alignment = 2
ColumnWidth = 494.929
EndProperty
BeginProperty Column01
ColumnWidth = 4605.166
EndProperty
BeginProperty Column02
ColumnWidth = 1574.929
EndProperty
BeginProperty Column03
ColumnWidth = 854.929
EndProperty
BeginProperty Column04
ColumnWidth = 3014.929
EndProperty
BeginProperty Column05
ColumnWidth = 3614.74
EndProperty
BeginProperty Column06
ColumnWidth = 2085.166
EndProperty
BeginProperty Column07
ColumnWidth = 3165.166
EndProperty
BeginProperty Column08
ColumnWidth = 2984.882
EndProperty
BeginProperty Column09
ColumnWidth = 2085.166
EndProperty
EndProperty
End
Begin VB.CommandButton cmdClose
Caption = "×"
BeginProperty Font
Name = "宋体"
Size = 8.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 2130
TabIndex = 5
TabStop = 0 'False
Top = 960
Width = 195
End
Begin VB.CommandButton cmdUp
Caption = "▲"
BeginProperty Font
Name = "宋体"
Size = 8.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 1875
MaskColor = &H00808080&
TabIndex = 4
TabStop = 0 'False
Top = 960
Width = 195
End
Begin MSAdodcLib.Adodc Adodc1
Height = 330
Left = 6000
Top = 5010
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 MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 285
Left = 0
TabIndex = 1
Top = 5040
Width = 7200
_ExtentX = 12700
_ExtentY = 503
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 4
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
Alignment = 1
TextSave = "2002-5-9"
EndProperty
BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
Alignment = 1
TextSave = "12:31"
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList ImageList3
Left = 6420
Top = 2325
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 3
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":67C3
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":6ADD
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":6FE1
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList ImageList2
Left = 6420
Top = 1695
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":75C5
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":7E9F
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":8CF1
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":95CB
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":98E5
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList ImageList1
Left = 6390
Top = 1035
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":B5EF
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":BEC9
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":CD1B
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":D5F5
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmManager.frx":D90F
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 360
Left = 0
TabIndex = 0
Top = 0
Width = 7200
_ExtentX = 12700
_ExtentY = 635
ButtonWidth = 609
ButtonHeight = 582
Appearance = 1
Style = 1
ImageList = "ImageList1"
HotImageList = "ImageList2"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 7
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "mnuTmlbAdd"
Object.ToolTipText = "添加题类"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Key = "mnuTmAdd"
Object.ToolTipText = "添加题目"
ImageIndex = 2
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Key = "mnuTmEdit"
Object.ToolTipText = "修改题目"
ImageIndex = 3
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Key = "mnuTmDel"
Object.ToolTipText = "删除题目"
ImageIndex = 4
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "mnuHelpContext"
Object.ToolTipText = "帮助"
ImageIndex = 5
EndProperty
EndProperty
End
Begin TabDlg.SSTab SSTabWks
Height = 3750
Left = 60
TabIndex = 6
Top = 1200
Width = 2550
_ExtentX = 4498
_ExtentY = 6615
_Version = 393216
TabOrientation = 1
Style = 1
Tabs = 1
TabHeight = 529
ShowFocusRect = 0 'False
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
TabCaption(0) = "题库管理(&T)"
TabPicture(0) = "frmManager.frx":DA69
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "TreeView1"
Tab(0).Control(0).Enabled= 0 'False
Tab(0).ControlCount= 1
Begin MSComctlLib.TreeView TreeView1
Height = 3345
Left = 45
TabIndex = 7
Top = 45
Width = 2220
_ExtentX = 3916
_ExtentY = 5900
_Version = 393217
HideSelection = 0 'False
Indentation = 529
LabelEdit = 1
Style = 7
ImageList = "ImageList3"
Appearance = 1
End
End
Begin VB.PictureBox imgBackground
AutoRedraw = -1 'True
BackColor = &H80000001&
Height = 4215
Left = 3000
ScaleHeight = 4155
ScaleWidth = 3285
TabIndex = 8
Top = 750
Width = 3345
End
Begin VB.Line Line2
BorderColor = &H80000009&
X1 = 60
X2 = 2730
Y1 = 765
Y2 = 765
End
Begin VB.Line Line1
BorderColor = &H8000000C&
X1 = 45
X2 = 2715
Y1 = 750
Y2 = 750
End
Begin VB.Line lnLeft
BorderColor = &H00FFFFFF&
X1 = 2925
X2 = 2925
Y1 = 960
Y2 = 4935
End
Begin VB.Line lnSecBlack
BorderColor = &H00808080&
X1 = 0
X2 = 1815
Y1 = 1035
Y2 = 1035
End
Begin VB.Line lnSecWhite
BorderColor = &H00FFFFFF&
X1 = 0
X2 = 1815
Y1 = 1095
Y2 = 1095
End
Begin VB.Line lnFirBlack
BorderColor = &H00808080&
X1 = 0
X2 = 1815
Y1 = 1125
Y2 = 1125
End
Begin VB.Line lnFirWhite
BorderColor = &H00FFFFFF&
X1 = 0
X2 = 1815
Y1 = 1005
Y2 = 1005
End
Begin VB.Image imgSplitter
Height = 4035
Left = 2715
MouseIcon = "frmManager.frx":F773
MousePointer = 99 'Custom
Top = 960
Width = 60
End
Begin VB.Menu mnuSystem
Caption = "系统(&S)"
Begin VB.Menu mnuUser
Caption = "用户管理(&U)..."
End
Begin VB.Menu mnuGenTestPaper
Caption = "生成试卷(&G)"
Visible = 0 'False
End
Begin VB.Menu mnu3
Caption = "-"
End
Begin VB.Menu mnuSysParam
Caption = "系统参数(&C)..."
End
Begin VB.Menu mnuOptions
Caption = "选项(&B)..."
End
Begin VB.Menu mnu2
Caption = "-"
End
Begin VB.Menu mnuExit
Caption = "退出(&X)"
Shortcut = ^X
End
End
Begin VB.Menu mnuView
Caption = "视图(&V)"
Begin VB.Menu mnuShowToolbar
Caption = "显示工具条(&S)"
Checked = -1 'True
End
Begin VB.Menu mnuShowToolbarText
Caption = "显示标签文字(&T)"
End
Begin VB.Menu mnuShowLargeIcon
Caption = "显示大图标(&B)"
End
End
Begin VB.Menu mnuSubject
Caption = "题库(&T)"
Begin VB.Menu mnuTmlb
Caption = "添加题目类别(&L)..."
End
Begin VB.Menu mnuTmlbEdit
Caption = "修改题目类别(&E)..."
End
Begin VB.Menu mnuTmlbDel
Caption = "删除题目类别(&D)..."
End
Begin VB.Menu mnu1
Caption = "-"
End
Begin VB.Menu mnuTmAdd
Caption = "添加题目(&I)..."
Shortcut = ^{INSERT}
End
Begin VB.Menu mnuTmEdit
Caption = "修改题目(&M)..."
End
Begin VB.Menu mnuTmDel
Caption = "删除题目(&R)..."
End
End
Begin VB.Menu mnuHelp
Caption = "帮助(&H)"
Begin VB.Menu mnuHelpContext
Caption = "帮助主题(&C)"
Shortcut = {F1}
End
Begin VB.Menu mnuHelpAbout
Caption = "关于(&A)"
End
End
End
Attribute VB_Name = "frmManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const minSplitLimit = 1000 '最小
Private Const minTreeTableWidth = 2000 '
Private sglSplitLimit As Double
Private mrsTK As ADODB.Recordset '题库
Private msTitle As String
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As Long, ByVal lpDirectory As Long, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL = 1
'重新生成原始题库
Private Sub Command1_Click()
Dim i As Long
Dim szSQL As String
On Error GoTo ErrHandler
Screen.MousePointer = 11
'从tb?_?中生成题库
gadoCONN.Execute "DELETE FROM tbTk"
For i = 1 To 11
'倒入选择题(0)
szSQL = "INSERT INTO tbTk(tmlb_id,tmlx_id,tmbh,tmmc,tmda,A,B,C,D,E,F) " & _
"SELECT " & CStr(i) & ",0,tmbh,tmmc,tmda,A,B,C,D,E,F FROM tb" & CStr(i) & "_0"
gadoCONN.Execute szSQL
'倒入判断题(1)
szSQL = "INSERT INTO tbTk(tmlb_id,tmlx_id,tmbh,tmmc,tmda) " & _
"SELECT " & CStr(i) & ",1,tmbh,tmmc,tmda FROM tb" & CStr(i) & "_1"
gadoCONN.Execute szSQL
Next i
Screen.MousePointer = 0
MsgBox "重新生成题库操作成功！", vbOKOnly + vbInformation, Me.Caption
Exit Sub
ErrHandler:
Screen.MousePointer = 0
ErrMessageBox Me.Name & "_重新生成题库Command1_Click()", Me.Caption
End Sub
'倒入图片
Private Sub Command2_Click()
Dim idx As Long
Dim ct As Long
Dim tmlb As Long
Dim tmlx As Long
Dim tmbh As Long
Dim szSQL As String
Screen.MousePointer = 11
On Error GoTo ErrHandler
'------------------------------------------
File1.Pattern = "*.bmp;*.jpg"
File1.Path = GetAppPath() & "pic"
ct = File1.ListCount
For idx = 0 To ct - 1
'获取题目类别、题目类型、题目编号
GetTmParameters File1.List(idx), tmlb, tmlx, tmbh
'
szSQL = "UPDATE tbTk SET tp='" & "pic\" & File1.List(idx) & "' WHERE tmlb_id=" & CStr(tmlb) & " AND tmlx_id=" & CStr(tmlx) & " AND tmbh=" & CStr(tmbh)
gadoCONN.Execute szSQL
Next idx
Screen.MousePointer = 0
MsgBox "图片例入成功！", vbOKOnly + vbInformation, Me.Caption
Exit Sub
ErrHandler:
Screen.MousePointer = 0
ErrMessageBox Me.Name & "_倒入图片Command2_Click()", Me.Caption
End Sub
Private Sub DataGrid1_DblClick()
Call mnuTmEdit_Click
End Sub
Private Sub Form_Load()
Dim theArea As RECT
On Error GoTo ErrHandler
'
imgBackground.Visible = True
DataGrid1.Visible = False
'get the workarea
theArea = GetWorkArea()
'设置应用程序的主窗口的大小
Me.Left = theArea.Left * Screen.TwipsPerPixelX
Me.Top = theArea.Top * Screen.TwipsPerPixelX
Me.Width = (theArea.Right - theArea.Left) * Screen.TwipsPerPixelX
Me.Height = (theArea.Bottom - theArea.Top) * Screen.TwipsPerPixelY
sglSplitLimit = SSTabWks.Left + SSTabWks.Width
'强制重画一下各个控件
SizeControls imgSplitter.Left
'初始化题库树
Call InitTreeView
'---------------------------------------------------------------
Me.Caption = msTitle
StatusBar1.Panels(1).Text = "欢迎使用" & Me.Caption
'获取上次的系统设置
Call SetViewSettings
'----------------------------------------------------------------
Set mrsTK = Nothing
Exit Sub
ErrHandler:
Set mrsTK = Nothing
ErrMessageBox Me.Name & ":Form_Load()", Me.Caption
End Sub
Private Sub SizeControls(ByVal x As Single)
On Error Resume Next
'------------------------------------------
Call SeperateStatusBar(Me.ScaleWidth)
'set the width
imgSplitter.Left = x
SSTabWks.Width = imgSplitter.Left - 2 * SSTabWks.Left
imgBackground.Left = imgSplitter.Left + imgSplitter.Width
imgBackground.Width = Me.ScaleWidth - imgBackground.Left - Me.ScaleLeft '(SSTabWks.Width + SSTabWks.Left + )
'set the top and height
If Toolbar1.Visible Then
cmdClose.Top = Toolbar1.Height + 60
SSTabWks.Top = cmdClose.Top + cmdClose.Height + 40
imgBackground.Top = Toolbar1.Height
imgBackground.Height = Me.ScaleHeight - Toolbar1.Height - StatusBar1.Height
Else
cmdClose.Top = 140
SSTabWks.Top = cmdClose.Top + cmdClose.Height + 40
imgBackground.Top = 0
imgBackground.Height = Me.ScaleHeight - StatusBar1.Height
End If
cmdUp.Top = cmdClose.Top
imgSplitter.Top = imgBackground.Top
'set the height
SSTabWks.Height = Me.ScaleHeight + Me.ScaleLeft - SSTabWks.Top - StatusBar1.Height
imgSplitter.Height = imgBackground.Height
'set the lines
lnLeft.x1 = imgSplitter.Left
lnLeft.X2 = imgSplitter.Left
lnLeft.y1 = imgSplitter.Top
lnLeft.Y2 = lnLeft.y1 + imgSplitter.Height
'set command buttons
cmdClose.Left = SSTabWks.Left + SSTabWks.Width - cmdClose.Width
cmdUp.Left = cmdClose.Left - cmdUp.Width - 60
'set the treeview1
TreeView1.Height = SSTabWks.Height - TreeView1.Top - SSTabWks.TabHeight - 50
TreeView1.Width = SSTabWks.Width - 90 '2 * lstPoints.Left
'set the lines
lnFirWhite.x1 = SSTabWks.Left
lnFirWhite.X2 = cmdUp.Left - 80
lnFirWhite.y1 = cmdUp.Top + 50
lnFirWhite.Y2 = lnFirWhite.y1
lnFirBlack.x1 = lnFirWhite.x1
lnFirBlack.X2 = lnFirWhite.X2
lnFirBlack.y1 = lnFirWhite.y1 + 20
lnFirBlack.Y2 = lnFirBlack.y1
lnSecWhite.x1 = lnFirWhite.x1
lnSecWhite.X2 = lnFirWhite.X2
lnSecWhite.y1 = lnFirBlack.y1 + 40
lnSecWhite.Y2 = lnSecWhite.y1
lnSecBlack.x1 = lnSecWhite.x1
lnSecBlack.X2 = lnFirWhite.X2
lnSecBlack.y1 = lnSecWhite.y1 + 20
lnSecBlack.Y2 = lnSecBlack.y1
Line1.x1 = 0
Line1.X2 = imgBackground.Left
Line1.y1 = imgBackground.Top '+ 15
Line1.Y2 = Line1.y1
Line2.x1 = Line1.x1
Line2.X2 = Line1.X2
Line2.y1 = Line1.y1 + 15
Line2.Y2 = Line2.y1
'-------------------------------------------------------------
DataGrid1.Left = imgBackground.Left
DataGrid1.Top = imgBackground.Top
DataGrid1.Width = imgBackground.Width
DataGrid1.Height = imgBackground.Height
'画背景
Call GetBackgroundSettings
End Sub
Private Sub Form_Resize()
'resize the controls
SizeControls imgSplitter.Left
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
If MsgBox("真的要退出" & Me.Caption & "吗？", vbYesNo + vbInformation, "提示") = vbNo Then
Cancel = True
Exit Sub
End If
'保存本次的系统设置
Call SaveViewSettings
'关闭题库记录集
If Not mrsTK Is Nothing Then
If mrsTK.State = adStateOpen Then
mrsTK.Close
End If
Set mrsTK = Nothing
End If
'断开数据库连接
If Not gadoCONN Is Nothing Then
If gadoCONN.State = adStateOpen Then
gadoCONN.Close
End If
Set gadoCONN = Nothing
End If
'close all sub forms
For i = Forms.Count - 1 To 1 Step -1
Unload Forms(i)
Next
'----------------------------------------
End
End Sub
Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
With imgSplitter
picSplitter.Move .Left, .Top, .Width, .Height
End With
picSplitter.Visible = True
End Sub
Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
Dim sglPos As Single
If (Button And vbLeftButton) > 0 Then
sglPos = x + imgSplitter.Left
If sglPos >= 0 Then
picSplitter.Left = sglPos
Else
picSplitter.Left = 0
End If
End If
End Sub
Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
If picSplitter.Left < sglSplitLimit Then
picSplitter.Left = sglSplitLimit
Else
If picSplitter.Left > (Me.ScaleWidth - sglSplitLimit) Then
picSplitter.Left = Me.ScaleWidth - sglSplitLimit
End If
End If
SizeControls picSplitter.Left
picSplitter.Visible = False
End Sub
'设置状态栏
Private Sub SeperateStatusBar(ByVal totalwd As Double)
Dim wd As Double
wd = totalwd / 12
StatusBar1.Panels(1).Width = 4 * wd
StatusBar1.Panels(2).Width = 4 * wd
StatusBar1.Panels(3).Width = 2 * wd
StatusBar1.Panels(4).Width = 2 * wd
End Sub
'将题目类别添加到树形控件上去
Private Sub InitTreeView()
Dim rs As ADODB.Recordset
Dim szSQL As String
Dim i As Long
Dim ct As Long
Dim nodeX As Node
On Error GoTo ErrHandler
szSQL = "SELECT id,name,ctbl FROM tbTmlb ORDER BY id ASC"
Set rs = gadoCONN.Execute(szSQL)
If Not rs.EOF Then rs.MoveLast
If Not rs.BOF Then rs.MoveFirst
'添加树根
Set nodeX = TreeView1.Nodes.Add(, , "r", "题库", 1, 1)
nodeX.Expanded = True
ct = rs.RecordCount
For i = 1 To ct
Call AddTmlbNode(ToInteger(rs("id")), "" & rs("name"))
rs.MoveNext
Next i
Set rs = Nothing
Exit Sub
ErrHandler:
Set rs = Nothing
ErrMessageBox "题库树初始化InitTreeView()", "提示"
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuGenTestPaper_Click()
Call GenTestPaper
End Sub
Private Sub mnuHelp_Click()
mnuHelpAbout.Caption = "关于 " & Me.Caption & "(&A)..."
End Sub
Private Sub mnuHelpAbout_Click()
Dim frm As New frmAbout
Load frm
frm.Show vbModal
End Sub
Private Sub mnuHelpContext_Click()
ShellExecute Me.hwnd, "Open", GetAppPath() & "jttest.chm", 0, 0, SW_SHOWNORMAL
End Sub
Private Sub mnuOptions_Click()
Dim frm As frmOptions
Set frm = New frmOptions
frm.SourcePicture = imgBackground
Load frm
frm.Show vbModal
End Sub
Private Sub mnuShowLargeIcon_Click()
mnuShowLargeIcon.Checked = Not mnuShowLargeIcon.Checked
ShowLargeIcon mnuShowLargeIcon.Checked
End Sub
Private Sub mnuShowToolbar_Click()
mnuShowToolbar.Checked = (Not mnuShowToolbar.Checked)
Toolbar1.Visible = mnuShowToolbar.Checked
'redraw the form
Call Form_Resize
End Sub
Private Sub mnuShowToolbarText_Click()
mnuShowToolbarText.Checked = (Not mnuShowToolbarText.Checked)
SetToolbarTextLabel mnuShowToolbarText.Checked
'
DoEvents
'
Call Form_Resize
End Sub
'点击题库菜单
Private Sub mnuSubject_Click()
Dim nodeCur As Node
'获取当前节点
Set nodeCur = TreeView1.SelectedItem
Call SetMenuToolbarStatus(nodeCur)
End Sub
Private Sub mnuSysParam_Click()
Dim frm As New frmSystemParam
Load frm
frm.Show vbModal
End Sub
Private Sub mnuTmAdd_Click()
On Error Resume Next
'添加题目
Dim frm As New frmTmAdd
Dim nodeCur As Node
On Error Resume Next
Set nodeCur = TreeView1.SelectedItem '当前节点
'传入参数
frm.TmADORecordset = Adodc1.Recordset
frm.Tmlb_id = CInt(nodeCur.Parent.Tag)
frm.Tmlx_id = CInt(nodeCur.Tag)
Load frm
frm.Show vbModal
End Sub
Private Sub mnuTmDel_Click()
If mrsTK.RecordCount > 0 Then
'---------------------------
If MsgBox("真的要删除当前记录吗？", vbQuestion + vbYesNo, "提示") = vbYes Then
mrsTK.Delete adAffectCurrent
'save the data
mrsTK.Update
End If
End If
End Sub
Private Sub mnuTmEdit_Click()
On Error Resume Next
'修改题目
Dim frm As New frmTmEdit
Dim nodeCur As Node
On Error Resume Next
If Adodc1.Recordset.RecordCount <= 0 Then
Exit Sub
End If
'-----------------------------------------------
Set nodeCur = TreeView1.SelectedItem '当前节点
'传入参数
frm.TmADORecordset = Adodc1.Recordset
frm.Tmlb_id = CInt(nodeCur.Parent.Tag)
frm.Tmlx_id = CInt(nodeCur.Tag)
Load frm
frm.Show vbModal
End Sub
Private Sub mnuTmlb_Click()
Dim frm As New frmTmlb
Dim rs As ADODB.Recordset
Dim MaxID As Integer
Dim szSQL As String
On Error GoTo ErrHandler
frm.Show vbModal
If frm.IsCancelled = True Then
Exit Sub
End If
'--------------------------------------
Set rs = gadoCONN.Execute("SELECT Max(id) as MaxID FROM tbTmlb")
If Not rs.EOF Then rs.MoveLast
If Not rs.BOF Then rs.MoveFirst
If rs.RecordCount >= 1 Then
MaxID = ToInteger(rs("MaxID")) + 1
Else
MaxID = 1
End If
Set rs = Nothing
szSQL = "INSERT INTO tbTmlb(id,name) VALUES(" & CStr(MaxID) & ",'" & frm.TmlbMC & "')"
'添加到数据中
gadoCONN.Execute szSQL
'添加到树形控件中
Call AddTmlbNode(MaxID, frm.TmlbMC)
Exit Sub
ErrHandler:
Set rs = Nothing
ErrMessageBox "添加题目类别mnuTmlb_Click()", "提示"
End Sub
'添加题目类别到题库树上
Private Sub AddTmlbNode(ByVal Tmlb_id As Integer, ByVal tmmc As String)
Dim nodeX As Node
'添加到树形控件中
Set nodeX = TreeView1.Nodes(1) '树根
Set nodeX = TreeView1.Nodes.Add(CStr(nodeX.Key), tvwChild, "TMLB_" & CStr(Tmlb_id), tmmc, 2, 2)
nodeX.Tag = CStr(Tmlb_id)
Set nodeX = TreeView1.Nodes.Add("TMLB_" & CStr(Tmlb_id), tvwChild, "TMLB_" & CStr(Tmlb_id) & "_0", "选择题", 3, 3)
nodeX.Tag = "0"
Set nodeX = TreeView1.Nodes.Add("TMLB_" & CStr(Tmlb_id), tvwChild, "TMLB_" & CStr(Tmlb_id) & "_1", "判断题", 3, 3)
nodeX.Tag = "1"
End Sub
Private Sub mnuUser_Click()
Dim frm As New frmUser
Load frm
frm.Show vbModal
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "mnuHelpContext"
ShellExecute Me.hwnd, "Open", GetAppPath() & "jttest.chm", 0, 0, SW_SHOWNORMAL
Case "mnuTmAdd"
Call mnuTmAdd_Click
Case "mnuTmEdit"
Call mnuTmEdit_Click
Case "mnuTmDel"
Call mnuTmDel_Click
Case "mnuTmlbAdd"
Call mnuTmlb_Click
Case Else
End Select
End Sub
Private Sub TreeView1_Collapse(ByVal Node As MSComctlLib.Node)
Dim nodeCur As Node
'on error resume next
Set nodeCur = TreeView1.SelectedItem
If Node.Image < 3 Then
Call TreeView1_NodeClick(Node)
Node.Selected = True
End If
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
Dim szSQL As String
'点击结点
If Node.Image = 3 Then '表示题目类型
DataGrid1.Visible = True
imgBackground.Visible = False
DataGrid1.Caption = "当前题目类别：" & Node.Parent.Text & "——" & Node.Text
'打开记录
szSQL = "SELECT * FROM tbTK WHERE tmlb_id=" & Node.Parent.Tag & " AND tmlx_id=" & Node.Tag
If Not mrsTK Is Nothing Then
If mrsTK.State = adStateOpen Then
mrsTK.Close
End If
Set mrsTK = Nothing
End If
If mrsTK Is Nothing Then
Set mrsTK = New ADODB.Recordset
End If
'打开记录
mrsTK.Open szSQL, gadoCONN, adOpenKeyset, adLockPessimistic, adCmdText
'
Set Adodc1.Recordset = mrsTK
Else
DataGrid1.Visible = False
imgBackground.Visible = True
End If
'设置菜单及工具条状态
Call SetMenuToolbarStatus(Node)
End Sub
'设置工具条的标签
Private Sub SetToolbarTextLabel(ByVal bSetLabel As Boolean)
Dim ct As Long
Dim i As Long
ct = Toolbar1.Buttons.Count
Select Case bSetLabel
Case False '不显示文本
For i = 1 To ct
Toolbar1.Buttons(i).Caption = ""
Next i
Case True '显示文本
For i = 1 To ct
Toolbar1.Buttons(i).Caption = Toolbar1.Buttons(i).ToolTipText
Next i
End Select
End Sub
'设置标题
Public Property Let Title(ByVal vNewValue As String)
msTitle = vNewValue
End Property
'保存工具条设置
Public Sub SaveViewSettings()
SaveSetting GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_TOOLBAR, "IsVisible", CStr(mnuShowToolbar.Checked)
SaveSetting GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_TOOLBAR, "HasLabel", CStr(mnuShowToolbarText.Checked)
SaveSetting GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_TOOLBAR, "IsLargeIcon", CStr(mnuShowLargeIcon.Checked)
End Sub
'获取工具条设置
Public Sub SetViewSettings()
'show toolbar or not
mnuShowToolbar.Checked = CBool(GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_TOOLBAR, "IsVisible", "1"))
Toolbar1.Visible = mnuShowToolbar.Checked
'show toolbar text or not
mnuShowToolbarText.Checked = CBool(GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_TOOLBAR, "HasLabel", "0"))
SetToolbarTextLabel mnuShowToolbarText.Checked
'show large icon or not
mnuShowLargeIcon.Checked = CBool(GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_TOOLBAR, "IsLargeIcon", "0"))
ShowLargeIcon mnuShowLargeIcon.Checked
End Sub
'是否显示大图标
Private Sub ShowLargeIcon(ByVal bShowLargeIcon As Boolean)
Dim idx() As Long
Dim ct As Long
Dim i As Long
'先将原来的图片index记录下来
ct = Toolbar1.Buttons.Count
ReDim idx(1 To ct)
For i = 1 To ct
idx(i) = Toolbar1.Buttons(i).Image
Next i
'-------------------
Select Case bShowLargeIcon
Case True '当前为大图标
'设置新的图像
Set Toolbar1.HotImageList = Nothing
Set Toolbar1.ImageList = ImageList4
Set Toolbar1.HotImageList = ImageList5
Case False '当前为小图标
Set Toolbar1.HotImageList = Nothing
Set Toolbar1.ImageList = ImageList1
Set Toolbar1.HotImageList = ImageList2
End Select
'设置图像index
For i = 1 To ct
Toolbar1.Buttons(i).Image = idx(i)
Next i
'resize the controls
DoEvents
Call Form_Resize
End Sub
'获取背景选项设置
Private Sub GetBackgroundSettings()
On Error Resume Next
Dim idx As Long
Dim fn As String '图片文件名
Dim lstIdx As Long '图片索引
'获取设置
Picture1.BackColor = GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "BackColor", &H80000001)
'获取用户自定义的图片
fn = GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "BackgroundFileName", "")
idx = GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "DisplayStyle", 1)
lstIdx = GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "ListIndex", 0)
If lstIdx > 0 Then
'如果没有设置背景图片
If fn = "" Then
imgBackground.Picture = LoadPicture()
Picture1.Picture = LoadPicture()
Exit Sub
End If
'如果设置了背景图片
Picture1.Picture = LoadPicture(fn)
Picture1.AutoSize = True
'画背景图片
Call PaintImage(imgBackground.ScaleWidth, imgBackground.ScaleHeight, Picture1, imgBackground, idx)
End If
End Sub
'根据文件名获取题目类别，题目类型，题目编号
Private Sub GetTmParameters(ByVal sFilename As String, lpTmlb As Long, lpTmlx As Long, lpTmbh As Long)
Dim L1 As Long
Dim L2 As Long
Dim sFile As String
'去除"."号
L1 = InStrRev(sFilename, ".", , vbTextCompare)
sFile = Left(sFilename, L1 - 1)
'分离各编号
L1 = InStr(1, sFile, "-", vbTextCompare)
L2 = InStrRev(sFile, "-", , vbTextCompare)
lpTmlb = CLng(Left(sFile, L1 - 1))
lpTmlx = CLng(Mid(sFile, L1 + 1, L2 - L1 - 1))
lpTmbh = CLng(Mid(sFile, L2 + 1, Len(sFile) - L2))
End Sub
Private Sub SetMenuToolbarStatus(ByVal CurNode As Node)
If CurNode Is Nothing Then
mnuTmlbEdit.Enabled = False
mnuTmlbDel.Enabled = False
mnuTmAdd.Enabled = False
mnuTmEdit.Enabled = False
mnuTmDel.Enabled = False
Toolbar1.Buttons("mnuTmAdd").Enabled = False
Toolbar1.Buttons("mnuTmEdit").Enabled = False
Toolbar1.Buttons("mnuTmDel").Enabled = False
Else
Select Case CurNode.Image
Case 3 '题目类型
mnuTmlbEdit.Enabled = False
mnuTmlbDel.Enabled = False
mnuTmAdd.Enabled = True
mnuTmEdit.Enabled = True
mnuTmDel.Enabled = True
Toolbar1.Buttons("mnuTmAdd").Enabled = True
Toolbar1.Buttons("mnuTmEdit").Enabled = True
Toolbar1.Buttons("mnuTmDel").Enabled = True
Case 2 '题目类别
mnuTmlbEdit.Enabled = True
mnuTmlbDel.Enabled = True
mnuTmAdd.Enabled = False
mnuTmEdit.Enabled = False
mnuTmDel.Enabled = False
Toolbar1.Buttons("mnuTmAdd").Enabled = False
Toolbar1.Buttons("mnuTmEdit").Enabled = False
Toolbar1.Buttons("mnuTmDel").Enabled = False
Case 1 'root node
mnuTmlbEdit.Enabled = False
mnuTmlbDel.Enabled = False
mnuTmAdd.Enabled = False
mnuTmEdit.Enabled = False
mnuTmDel.Enabled = False
Toolbar1.Buttons("mnuTmAdd").Enabled = False
Toolbar1.Buttons("mnuTmEdit").Enabled = False
Toolbar1.Buttons("mnuTmDel").Enabled = False
End Select
End If
End Sub