Исходный код программы «Электронный справочник по работе с программой



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$(r) + _

                  " из " + _

                  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


Заключение

В ходе дипломного проектирования была разработана программа «Справочник по работе с программой Visual Basic». Эта программа предназначена для самостоятельной работы студентов при обучении программированию в среде Visual Basic.

На основании поставленной цели решались следующие задачи:

- провести анализ теоретического материала предлагаемого к компьютерной реализации;

- предоставить студентам, изучающим Visual Basic эффективное и легкодоступное средство обучения, которое включало бы в себя теоретический материал, вопросы и практические задания, и выполняло бы не только обучающую, но и контролирующую и оценивающую функции;

- предоставить учебному заведению полноценное программное обеспечение, которое сможет применяться при обучении Visual Basic–у и которым смогут пользоваться сотни студентов.

Для решения данных задач была проделана следующая работа:

- проведен анализ теоретического материала предлагаемого к изучению студентам и выбран материал для первоочередной реализации в электронном справочнике;

- проведен сравнительный анализ электронных справочников («VBHELP» - справочник по Visual Basic 5.0, «Vbfunction», «Справочник по WIN 32 API», «Справочник по функциям Windows API») с целью выявления системы, наиболее отвечающей требованиям, предъявляемым при разработке справочника;

- подобрана система тестовых вопросов для выявления уровня усвоения нового материала;

- разработана система подсказок, призванная облегчить обучение студентов;

- разработан и реализован электронный справочник по работе с программой Visual Basic, который может применяться при обучении студентов.

Практическую ценность своей работы я вижу в том, что: во-первых, мною был получен богатый опыт разработки обучающих компьютерных систем, в том числе, освоены инструментальные средства разработки подобных систем; во-вторых, и это главное, учебное заведение получит в свое распоряжение и сможет использовать в образовательном процессе новое электронное средство обучения – электронный справочник по работе с программой Visual Basic.


Дата добавления: 2019-07-15; просмотров: 188; Мы поможем в написании вашей работы!

Поделиться с друзьями:






Мы поможем в написании ваших работ!