Пожалуйста помогите создать электронный справочник на Visual Basic. скачала готовую дипломную работу но там вид формы и объекты не показаны есть только код. а по нему нечего не понимаю вот код: I. m_Tbook.frm Основная форма учебника | Код |
Const SuperRootName = "NULL?+1234r55tegwegdsfasfgsdg"
Const SubjectFile = "Subject.htm"
Const ExampleFile = "Example.rtf"
Const TestFile = "Test\index.htm"
Const iThemeListWidth = 3000
Dim NavPath As String
Dim NavBKPath As String
Dim bFullMode As Boolean
Function CreateTheme(pName As String, rName As String)
Dim tmpNode As Node
Set tmpNode = m_ThemeList.Nodes.Add(, tvwFirst, rName, pName, 1, 3)
End Function
Function CreateSection(pName As String, rName As String)
Dim tmpNode As Node
Set tmpNode = m_ThemeList.Nodes.Add(rName, tvwChild, , pName, 2)
End Function
Private Sub Themes_Loading()
Dim sFile As String
Dim i As Integer
sFile = Dir(App.Path & "\Themes\", vbDirectory)
Do Until sFile = ""
If sFile <> "." And sFile <> ".." Then
CreateTheme sFile, "r" & CStr(i)
CreateSection SuperRootName, "r" & CStr(i)
End If
sFile = Dir
i = i + 1
Loop
End Sub
Private Sub Form_Load()
Load m_Password
m_Password.Show 1
Themes_Loading
bFullMode = False
m_CmdSwitch.Caption = "Пример"
m_CmdSwitch.Enabled = False
m_ThemeView.Navigate2 App.Path & "\StartPage.htm", navNoHistory
End Sub
Function CtrlResize(iTheme As Integer)
On Error Resume Next
If m_TBook.Width <= iThemeListWidth + 110 Or m_TBook.Height <= 800 Then Exit Function
If m_TBook.WindowState = vbMinimized Then Exit Function
m_CmdSwitch.Left = iTheme + 10
m_CmdSwitch.Top = m_TBook.Height - 1000
m_CmdSwitch.Height = 400
m_CmdSwitch.Width = 1500
m_CmdTest.Left = m_CmdSwitch.Left + m_CmdSwitch.Width
m_CmdTest.Top = m_TBook.Height - 1000
m_CmdTest.Height = 400
m_CmdTest.Width = 1500
m_CmdCopyClip.Left = m_CmdTest.Left + m_CmdTest.Width
m_CmdCopyClip.Top = m_TBook.Height - 1000
m_CmdCopyClip.Height = 400
m_CmdCopyClip.Width = 1500
m_Back.Left = m_CmdCopyClip.Left + m_CmdCopyClip.Width
m_Back.Top = m_TBook.Height - 1000
m_Back.Height = 400
m_Back.Width = 1000
m_Home.Left = m_Back.Left + m_Back.Width
m_Home.Top = m_TBook.Height - 1000
m_Home.Height = 400
m_Home.Width = 1000
m_Forward.Left = m_Home.Left + m_Home.Width
m_Forward.Top = m_TBook.Height - 1000
m_Forward.Height = 400
m_Forward.Width = 1000
m_ThemeView.Left = iTheme + 100
m_ThemeView.Top = 0
m_ThemeView.Width = m_TBook.Width - (iTheme + 200)
m_ThemeView.Height = m_TBook.Height - 1000
m_BtnFullMode.Width = 100
m_BtnFullMode.Height = 1000
m_BtnFullMode.Left = iTheme
m_BtnFullMode.Top = m_TBook.Height / 2 - m_BtnFullMode.Height / 2
m_ExampleView.Left = iTheme + 100
m_ExampleView.Top = 0
m_ExampleView.Width = m_TBook.Width - (iTheme + 200)
m_ExampleView.Height = m_TBook.Height - 1000
m_ThemeList.Left = 0
m_ThemeList.Top = 0
m_ThemeList.Width = iTheme
m_ThemeList.Height = m_TBook.Height - 400
End Function
Private Sub Form_Resize()
If bFullMode Then
m_ThemeList.Visible = False
CtrlResize 0
Else
m_ThemeList.Visible = True
CtrlResize iThemeListWidth
End If
End Sub
Private Sub m_About_Click()
Load frmAbout
frmAbout.Show
End Sub
Private Sub m_NewBK_Click()
m_gBKPath = NavBKPath
Load m_FrmBookMark
m_FrmBookMark.Show 1
End Sub
Private Sub m_openBK_Click()
m_gBKPath = ""
Load m_FrmBookMark
m_FrmBookMark.Show 1
End Sub
Private Sub m_BtnFullMode_Click()
If bFullMode = True Then
bFullMode = False
Else
bFullMode = True
End If
Form_Resize
End Sub
Private Sub m_cmdCopyClip_Click()
Clipboard.SetText m_ExampleView.TextRTF
End Sub
Private Sub m_CmdSwitch_Click()
If m_CmdSwitch.Caption = "Тема" Then
m_CmdSwitch.Caption = "Пример"
m_ThemeView.Visible = True
m_ExampleView.Visible = False
m_CmdCopyClip.Visible = False
ElseIf m_CmdSwitch.Caption = "Пример" Then
m_CmdSwitch.Caption = "Тема"
m_ExampleView.Visible = True
m_ThemeView.Visible = False
m_CmdCopyClip.Visible = True
End If
End Sub
Private Sub m_CmdTest_Click()
If NavPath = "" Then Exit Sub
m_gTestPath = NavPath & "test.txt"
If Dir(m_gTestPath, vbNormal) <> "" Then
Load m_FrmTest
m_FrmTest.Show 1
End If
End Sub
Private Sub m_Back_Click()
On Error Resume Next
m_ThemeView.GoBack
End Sub
Private Sub m_Forward_Click()
On Error Resume Next
m_ThemeView.GoForward
End Sub
Private Sub m_Home_Click()
m_ThemeView.Navigate2 App.Path & "\StartPage.htm", navNoHistory
End Sub
Private Sub m_MenuPrint_Click()
On Error Resume Next
m_ThemeView.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub m_MenuSave_Click()
m_ThemeView.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub m_MenuFind_Click()
On Error Resume Next
' m_ThemeView.ExecWB OLECMDID_F, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub m_Quit_Click()
End
End Sub
Private Sub m_ThemeList_Expand(ByVal Node As MSComctlLib.Node)
Dim pNode As Node
Set pNode = Node.Child
If pNode.Text = SuperRootName Then
m_ThemeList.Nodes.Remove pNode.Index
Dim sFile As String
Dim i As Integer
sFile = Dir(App.Path & "\Themes\" & Node.Text & "\", vbDirectory)
Do Until sFile = ""
If sFile <> "." And sFile <> ".." Then
CreateSection sFile, Node.Key
End If
sFile = Dir
i = i + 1
Loop
End If
End Sub
Private Sub m_ThemeList_NodeClick(ByVal Node As MSComctlLib.Node)
If Node.Children Then Exit Sub
m_CmdSwitch.Enabled = True
NavPath = App.Path & "\Themes\" & Node.FullPath & "\"
NavBKPath = Node.FullPath
m_ThemeView.Navigate2 NavPath & SubjectFile, navNoHistory
If (Len(Dir(NavPath & ExampleFile))) <= 0 Then
m_ExampleView.Text = ""
Else
m_ExampleView.LoadFile NavPath & ExampleFile
End If
End Sub
|
II. mdl_Question.bas Модуль для хранения глобальных переменных | Код |
Type Question
Question As String
Answer(2) As String
True As Integer
End Type
Public m_gTestPath As String
Public m_gBKPath As String
Public m_gBKNewName As String
|
III. m_FrmBookMark.frm Форма управления закладками | Код |
Private Sub Form_Load()
On Error GoTo EndLoadForm
Dim pLine As String
m_bFindName = False
Open App.Path & "\bookmark.txt" For Input As #1
Do Until EOF(1)
Line Input #1, pLine
m_BKList.AddItem pLine
If m_bFindName = False Then
If pLine = m_gBKPath Then m_bFindName = True
End If
Loop
If m_bFindName = False And m_gBKPath <> "" Then
m_BKList.AddItem m_gBKPath
End If
Close #1
EndLoadForm:
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo EndUnLoadForm
If m_gBKPath = "" Then
GoTo EndUnLoadForm
End If
Open App.Path & "\bookmark.txt" For Output As #1
For i = 0 To m_BKList.ListCount - 1
m_BKList.ListIndex = 0
Print #1, m_BKList.Text
m_BKList.RemoveItem m_BKList.ListIndex
Next
Close #1
EndUnLoadForm:
End Sub
Private Sub m_DeleteBK_Click()
If m_BKList.ListIndex <> -1 Then m_BKList.RemoveItem m_BKList.ListIndex
End Sub
|
IV. m_FrmTest.frm Форма управления тестом | Код |
Dim qcount As Integer ' общее количество вопросов
Dim r As Integer ' количество правильный
' ответов
Dim curq As Integer
Dim rate(1 To 4) As Integer ' критерии оценок
Dim comment(1 To 4) As String ' комментарии
Dim f As String ' буфер чтения
Dim qcycle() As Integer
Dim quest() As Question
Sub LoadQuestions()
Dim fquest As String
Dim ftrue As Integer
Dim fanswer() As String
Do While NextQuestion(fquest, ftrue, fanswer)
If qcount = 1 Then
ReDim quest(0)
Else
ReDim Preserve quest(qcount - 1)
End If
quest(qcount - 1).Question = fquest
quest(qcount - 1).True = ftrue
For i = 0 To 2
quest(qcount - 1).Answer(i) = fanswer(i)
Next
Loop
End Sub
Function NextQuestion(ByRef fquest As String, ByRef ftrue As Integer, ByRef fanswer() As String) As Boolean
If Not EOF(1) Then ' файл не закончился
' считывание и ввод вопроса
Line Input #1, fquest
' считывание вариантов ответа
ReDim fanswer(2)
For i = 0 To 2
Line Input #1, f
fanswer(i) = f
Line Input #1, f
If f = "1" Then ftrue = i
Next
' верный ли ответ: 1 – верный 0 - нет
' 0 или 1 записывается в свойство Tag соответствующего компонента
' Option
' увеличение счетчика вопросов
qcount = qcount + 1
NextQuestion = True
Else
NextQuestion = False
End If
End Function
Private Sub ShowQuestion(ByVal num As Integer)
If num >= qcount - 1 Then m_CmdNext.Caption = "Завершить"
num = qcycle(num)
m_CmdNext.Enabled = False
m_Question.Caption = quest(num).Question
m_Var1.Caption = quest(num).Answer(0)
m_Var1.Tag = 0
If quest(num).True = 0 Then m_Var1.Tag = 1
m_Var2.Caption = quest(num).Answer(1)
m_Var2.Tag = 0
If quest(num).True = 1 Then m_Var2.Tag = 1
m_Var3.Caption = quest(num).Answer(2)
m_Var3.Tag = 0
If quest(num).True = 2 Then m_Var3.Tag = 1
m_Var1.Value = False
m_Var2.Value = False
m_Var3.Value = False
End Sub
Private Sub Form_Load()
m_Question.Font.Size = 10
FileName = m_gTestPath
On Error GoTo EndTest
Open FileName For Input As #1 ' открытие файла
' для чтения
Line Input #1, f ' чтение названия теста
m_FrmTest.Caption = f
' комментарии и критерии оценок
For i = 1 To 4 Step 1
Line Input #1, f
comment(i) = f
Line Input #1, f
rate(i) = f
Next
' обнуление счетчиков
q = 0
r = 0
LoadQuestions
Close #1
ReDim qcycle(qcount - 1)
Dim qvars() As Boolean
ReDim qvars(qcount - 1)
For i = 0 To qcount - 1
qvars(i) = True
Next
For i = 0 To qcount - 1
Dim rn As Integer
Dim num As Integer
Randomize
rn = Rnd(qcount - 1) * (qcount - 1) + 1
Do While rn > 0
num = num + 1
If num > qcount - 1 Then num = 0
Do Until qvars(num)
num = num + 1
If num > qcount - 1 Then num = 0
Loop
rn = rn - 1
Loop
qcycle(i) = num
qvars(num) = False
Next
If qcount = 0 Then GoTo EndTest
ShowQuestion (0)
EndTest:
End Sub
Private Sub m_CmdEndTest_Click()
Erase quest
curq = 0
qcount = 0
r = 0
Unload m_FrmTest
End Sub
Private Sub m_CmdNext_Click()
If m_Var1.Value = True Then r = r + m_Var1.Tag
If m_Var2.Value = True Then r = r + m_Var2.Tag
If m_Var3.Value = True Then r = r + m_Var3.Tag
If m_CmdNext.Caption = "Завршить" Then
m_Var1.Visible = False
m_Var2.Visible = False
m_Var3.Visible = False
m_Question.Height = m_Question.Height * 2
m_Question.Caption = "Тестирование завершено." + Chr(13) + _
"Правильных ответов: " + Format$® + _
" из " + _
Format$(qcount) + "."
i = 1
While (r < rate(i)) And (i < 4)
i = i + 1
Wend
' ввод коментария
m_Question.Caption = m_Question.Caption + Chr(13) + comment(i)
m_CmdNext.Enabled = False
Else
curq = curq + 1
ShowQuestion curq
End If
End Sub
Private Sub m_Question_Click()
End Sub
Private Sub m_Var1_Click()
m_CmdNext.Enabled = True
End Sub
Private Sub m_Var2_Click()
m_CmdNext.Enabled = True
End Sub
Private Sub m_Var3_Click()
m_CmdNext.Enabled = True
End Sub
|
V. m_Password.frm Форма для ввода пароля | Код |
Dim Entered As Boolean
Private Sub Command1_Click()
End
End Sub
Private Sub Command2_Click()
Dim sName As String
Dim sPass As String
Dim deName As String
Dim dePass As String
Dim Equal As Boolean
Open App.Path & "\Passwords" For Input As 1
Do Until EOF(1)
deName = ""
dePass = ""
Input #1, sName
Input #1, sPass
Dim sim As String
Dim sima As String
Dim simb As String
For i = 0 To Len(sName) - 1 Step 2
sima = Mid(sName, i + 1, 1)
simb = Mid(sName, i + 2, 1)
sim = Chr((Asc(sima) - 210) * 16 + (Asc(simb) - 210))
deName = deName & sim
Next
For i = 0 To Len(sPass) - 1 Step 2
sima = Mid(sPass, i + 1, 1)
simb = Mid(sPass, i + 2, 1)
sim = Chr((Asc(sima) - 210) * 16 + (Asc(simb) - 210))
dePass = dePass & sim
Next
If deName = txt_Name And dePass = txt_Password Then
Equal = True
End If
Loop
Close #1
If Not Equal Then
MsgBox "Неправильно введены" & vbCrLf & _
"имя пользователя" & vbCrLf & _
"и пароль", vbOKOnly
Else
Entered = True
Unload m_Password
End If
End Sub
Private Sub Form_Load()
Entered = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Not Entered Then End
End Sub
|
заранее спасибо!!  Это сообщение отредактировал(а) Akina - 30.11.2009, 09:43 |
[VB6] программирования в Visual Basic, Создать электронный справочник на Visual 
Загрузка ...
