| Вопрос: Помогите пожалуйста с защитой курсовой | Добавлено: 20.06.08 18:22 |
Автор вопроса:  Марат
|
| У меня код программы на 17 страниц А4, нужно чтобы кто-нибудь помог мне разобраться с этим кодом |
| Ответы | Всего ответов: 14 |
|
Номер ответа: 1 Автор ответа:  Марат Вопросов: 1 Ответов: 2 |
Профиль | | #1 | Добавлено: 20.06.08 18:24 |
|
Высылаю код:
Модуль главной формы MFormYKB Dim n As Long Dim m() As Double Dim a() As Double Dim b() As Double Dim xx() As Double Dim fgTBL As MSFlexGrid Rem "форма" Private Sub Form_Load() Set fgTBL = Me.MSFGrid fgTBL.Width = Me.ScaleWidth * 0.98 fgTBL.Left = Me.ScaleWidth / 100 LabInfo.Left = fgTBL.Left LabInfo.Width = Me.ScaleWidth * 0.98 Clear n = 3 ReadMnu.Enabled = True End Sub Private Sub Form_Resize() fgTBL.Left = Me.ScaleWidth / 100 fgTBL.Width = Me.ScaleWidth * 0.98 LabInfo.Left = fgTBL.Left LabInfo.Width = Me.ScaleWidth * 0.98 ReadMnu.Enabled = False End Sub Rem "обработка событий таблицы FlexGrid" Private Sub MSFGrid_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 46 Then MSFGrid.Text = "" End Sub Private Sub MSFGrid_KeyPress(KeyAscii As Integer) Dim s As String If MSFGrid.Row > n Then Exit Sub If MSFGrid.Col > n + 1 Then Exit Sub s = MSFGrid.Text If KeyAscii = 8 And s <> "" Then s = Left$(s, Len(s) - 1) ElseIf KeyAscii > 31 Then If KeyAscii = 46 Then s = "" Else s = s & Chr$(KeyAscii) End If End If MSFGrid.Text = s End Sub Rem "Обработчики меню" Rem "Чтение данных" Private Sub ReadMnu_Click() On Error GoTo cErr RSysMnu.Enabled = False If n < 2 Or n > 10 Then Exit Sub If Not ReadData Then Exit Sub RSysMnu.Enabled = True cErr: If Err <> 0 Then Err.Clear End If End Sub Rem "Решение системы" Private Sub RSysMnu_Click() RSysMnu.Enabled = False If Not ReadData Then Exit Sub If (Not Yakobi.RYakobuSys(m, a, b, xx, fgTBL, LabInfo)) Then Rem "Здесь может быть код для случая неудачного решения системы" End If ShowToki RSysMnu.Enabled = True End Sub Rem "Очистка" Private Sub ClearMnu_Click() Clear End Sub Rem "Выход" Private Sub CloseMnu_Click() Unload Me End Sub Rem "О программе" Private Sub AboutMnu_Click() About.Show vbModal End Sub Rem "Электрическая схема" Private Sub ShemaMnu_Click() ShemaF.Show vbModal End Sub Rem "конец обработчиков меню" Rem "чтение исходных данных из файла" Private Sub ReadIREFCmd_Click() Dim s As String On Error GoTo cErr Clear CmDlg.InitDir = App.Path CmDlg.FileName = "" CmDlg.Filter = "Текстовые файлы(*.txt)|*.txt|Все файлы(*.*)|*.*" CmDlg.Flags = CmDlg.Flags Or 4 CmDlg.ShowOpen If CmDlg.FileName = "" Then Exit Sub If Dir$(PathName:=CmDlg.FileName, Attributes:=vbArchive + vbHidden _ + vbReadOnly + vbSystem + vbNormal) = "" Then MsgBox Prompt:="Нет файла данных", Title:="Чтение данных" Exit Sub End If Open CmDlg.FileName For Input As #1 Line Input #1, s: R1 = CDbl(s) Line Input #1, s: R2 = CDbl(s) Line Input #1, s: R3T = CDbl(s) Line Input #1, s: R4 = CDbl(s) Line Input #1, s: R5T = CDbl(s) If R1 <= 0 Or R2 <= 0 Or R3T <= 0 Or R4 <= 0 Or R5T <= 0 Then Err.Raise Number:=6 End If Line Input #1, s: RM1 = CDbl(s) Line Input #1, s: RM2 = CDbl(s) Line Input #1, s: RM3 = CDbl(s) If RM1 <= 0 Or RM2 <= 0 Or RM3 <= 0 Then Err.Raise Number:=6 End If Line Input #1, s: E1 = CDbl(s) Line Input #1, s: E2 = CDbl(s) Line Input #1, s: E3 = CDbl(s) If E1 <= 0 Or E2 <= 0 Or E3 <= 0 Then Err.Raise Number:=6 End If txtR1 = R1: txtR2 = R2: txtR3 = R3T: txtR4 = R4: txtR5 = R5T txtRM1 = RM1: txtRM2 = RM2: txtRM3 = RM3 txtE1 = E1: txtE2 = E2: txtE3 = E3 Close #1 cErr: If Err <> 0 Then Err.Clear MsgBox Prompt:="Данные в файле не корректны", _ Title:="Чтение данных из файла" End If End Sub Rem "кнопка Расчет системы" Private Sub CalcKSysCmd_Click() ReadMnu.Enabled = False If Not ReadIRE Then Exit Sub ReadMnu.Enabled = True End Sub Rem "пользовательские поцедуры и функции" Private Sub fgTBL_Clear() Dim i As Integer LabInfo.Caption = "" fgTBL.Redraw = False: fgTBL.Clear: fgTBL.FixedRows = 1 For i = 0 To (fgTBL.Rows - 1) fgTBL.TextMatrix(i, 0) = i Next i fgTBL.ColWidth(0) = 480 For i = 1 To (fgTBL.Cols - 1) fgTBL.TextMatrix(0, i) = i Next i For i = 0 To fgTBL.Rows - 1 fgTBL.RowHeight(i) = 240 Next i For i = 1 To fgTBL.Cols - 1 fgTBL.ColWidth(i) = 1600 Next i fgTBL.Redraw = True End Sub Private Sub Clear() RSysMnu.Enabled = False fgTBL_Clear Erase m Erase a Erase b Erase xx LabInfo.Caption = "" txtR1 = "": txtR2 = "": txtR3 = "": txtR4 = "": txtR5 = "" txtRM1 = "": txtRM2 = "": txtRM3 = "" txtE1 = "": txtE2 = "": txtE3 = "" txtI1 = "": txtI2 = "": txtI3 = "": txtI4 = "": txtI5 = "" txtIE1 = "": txtIE2 = "" End Sub Private Function ReadData() As Boolean Dim i As Long, j As Long On Error GoTo cErr ReDim m(1 To n, 1 To n + 1) For i = LBound(m, 1) To UBound(m, 1) For j = LBound(m, 2) To UBound(m, 2) fgTBL.TextMatrix(i, j) = Trim$(fgTBL.TextMatrix(i, j)) If Not IsNumeric(fgTBL.TextMatrix(i, j)) Then Err.Raise Number:=13 m(i, j) = CDbl(fgTBL.TextMatrix(i, j)) Next j Next i For i = LBound(m, 1) To UBound(m, 1) For j = LBound(m, 2) To UBound(m, 2) fgTBL.TextMatrix(i, j) = Format(m(i, j), "0.00" 
Next j Next i fgTBL.TextMatrix(UBound(m, 1) + 1, 1) = "Матрица" fgTBL.TextMatrix(UBound(m, 1) + 1, 2) = "A" fgTBL.TextMatrix(UBound(m, 1) + 1, UBound(m, 2)) = "Вектор B" ReadData = True cErr: If Err.Number <> 0 Then Err.Clear Erase m End If End Function Private Function ReadIRE() As Boolean On Error GoTo cErr fgTBL_Clear txtI1 = "": txtI2 = "": txtI3 = "": txtI4 = "": txtI5 = "" txtIE1 = "": txtIE2 = "" R1 = CDbl(txtR1) R2 = CDbl(txtR2) R3T = CDbl(txtR3) R4 = CDbl(txtR4) R5T = CDbl(txtR5) RM1 = CDbl(txtRM1) RM2 = CDbl(txtRM2) RM3 = CDbl(txtRM3) E1 = CDbl(txtE1) E2 = CDbl(txtE2) E3 = CDbl(txtE3) If R1 <= 0 Or R2 <= 0 Or R3T <= 0 Or R4 <= 0 Or R5T <= 0 Then Err.Raise Number:=6 End If If RM1 <= 0 Or RM2 <= 0 Or RM3 <= 0 Then Err.Raise Number:=6 End If If E1 <= 0 Or E2 <= 0 Or E3 <= 0 Then Err.Raise Number:=6 End If If Not Common.CalcKSys(fgTBL) Then Clear Exit Function End If ReadIRE = True cErr: If Err <> 0 Then Err.Clear MsgBox Prompt:="Некорректны исходные данные", _ Title:="Расчет системы" End If End Function Private Sub ShowToki() Dim i As Long On Error GoTo cErr i = LBound(xx) I1 = xx(i) i = i + 1 I2 = xx(i) I3 = I1 / (R3T / R5T + 1) i = i + 1 I4 = xx(i) I5 = I1 - I3 IE1 = I2 + I4 - I1 IE2 = I2 - I1 txtI1 = Format(I1, "0.000 000"
txtI2 = Format(I2, "0.000 000"
txtI3 = Format(I3, "0.000 000"
txtI4 = Format(I4, "0.000 000"
txtI5 = Format(I5, "0.000 000"
txtIE1 = Format(IE1, "0.000 000"
txtIE2 = Format(IE2, "0.000 000"
cErr: If Err <> 0 Then Err.Clear MsgBox Prompt:="Некорректны исходные данные", _ Title:="Расчет системы" End If End Sub Форма About (О программе) Private Sub Form_Load() Dim s As String s = "УФИМСКИЙ ГОСУДАРСТВЕННЫЙ АВИАЦИОННЫЙ ТЕХНИЧЕСКИЙ УНИВЕРСИТЕТ" s = s & vbCrLf & vbCrLf & "курсовая работа на тему:" & vbCrLf s = s & "РАСЧЕТ ЭДС ИСТОЧНИКОВ ТОКА В РАЗВЕТВЛЕННОЙ ЦЕПИ" & vbCrLf s = s & "ПРИ ПОМОЩИ ЗАКОНОВ КИРХГОФА И МЕТОДА ЯКОБИ" & vbCrLf & vbCrLf s = s & "Автор программы студент группы ЭМ - 126" & vbCrLf s = s & "Валеев Э.А." & vbCrLf & vbCrLf s = s & "Проверил: доцент кафедры Информатики" & vbCrLf s = s & "Бикмеев А.Т." & vbCrLf & vbCrLf s = s & "УФА 2008 год" LabInfo.Caption = s: s = "" End Sub Private Sub OKCmd_Click() Unload Me End Sub Форма ShemaF (вывод на экран электрической схемы) Private Sub CmdOK_Click() Unload Me End Sub Модуль StartMD Public Sub Main() About.Show 1 MFormYKB.Show End Sub Модуль Common Public R3T As Double Public R5T As Double Public R1 As Double Public R2 As Double Public R4 As Double Public R5 As Double Public RM1 As Double Public RM2 As Double Public RM3 As Double Public E1 As Double Public E2 As Double Public E3 As Double Public I1 As Double Public I2 As Double Public I3 As Double Public I4 As Double Public I5 As Double Public IE1 As Double Public IE2 As Double Public a11 As Double Public a12 As Double Public a13 As Double Public a21 As Double Public a22 As Double Public a23 As Double Public a31 As Double Public a32 As Double Public a33 As Double Public b1 As Double Public b2 As Double Public b3 As Double Dim ms(1 To 3, 1 To 4) As Double Dim mr(1 To 3, 1 To 4) As Double Public Function CalcKSys(fg As MSFlexGrid) As Boolean Dim x As Double Dim i As Long, j As Long On Error GoTo cErr x = 1 / R3T + 1 / R5T R5 = 1 / x ms(1, 1) = R1 + R5 + RM3 ms(1, 2) = R2 ms(1, 3) = 0 ms(1, 4) = E3 ms(2, 1) = -(RM1 + RM2) ms(2, 2) = R2 + RM1 + RM2 ms(2, 3) = RM1 ms(2, 4) = E1 + E2 ms(3, 1) = -RM1: ms(3, 2) = RM1 ms(3, 3) = R4 + RM1 ms(3, 4) = E1 For i = 1 To 3 For j = 1 To 4 mr(i, j) = ms(i, j): Next j Next i For i = 1 To 3 For j = 1 To 4 fg.TextMatrix(i, j) = mr(i, j) Next j Next i CalcKSys = True cErr: If Err <> 0 Then Err.Clear End If End Function Модуль Yakobi Private Const minE = 0.00001 Private Const maxE = 0.1 Private Const maxIter = 5000 Dim x() As Double Dim y() As Double Dim s() As Double Dim smax As Double Dim e As Double Dim ax() As Double Dim vp() As Double Private Sub YakobiStep(ByRef a() As Double, ByRef b() As Double, _ ByRef x() As Double, ByRef y() As Double) Dim i As Long Dim j As Long On Error GoTo cErr For i = LBound(x) To UBound(x) y(i) = 0 For j = LBound(x) To UBound(x) If i <> j Then y(i) = y(i) - x(j) * a(i, j) End If Next j y(i) = y(i) + b(i) Next i cErr: If Err <> 0 Then Err.Clear End If End Sub Rem "Процедура вычисления нулевого приближения вектора x()" Private Sub VektorX0(ByRef a() As Double, ByRef b() As Double, _ ByRef x() As Double) Dim i As Long On Error GoTo cErr For i = LBound(b) To UBound(b) b(i) = b(i) / a(i, i) x(i) = b(i) Next i cErr: If Err <> 0 Then Err.Clear End If End Sub Rem "процедура приведения матрицы к удобному для решения виду" Private Sub DivMatrix(ByRef a() As Double, ByRef s() As Double, _ ByRef smax As Double) Dim i As Long, j As Long On Error GoTo cErr smax = 0 For i = LBound(a, 1) To UBound(a, 1) s(i) = 0 For j = LBound(a, 2) To UBound(a, 2) If i <> j Then a(i, j) = a(i, j) / a(i, i) s(i) = s(i) + Abs(a(i, j)) End If Next j If smax < s(i) Then smax = s(i) Next i cErr: If Err <> 0 Then Err.Clear End If End Sub Rem "поцедура начального формирования матрицы a() и вектора b()" Public Sub MakeAB(ByRef m() As Double, ByRef a() As Double, _ ByRef b() As Double) Dim i As Long, j As Long On Error GoTo cErr Erase a ReDim a(LBound(m, 1) To UBound(m, 1), LBound(m, 1) To UBound(m, 1)) For i = LBound(m, 1) To UBound(m, 1) For j = LBound(m, 1) To UBound(m, 1) a(i, j) = m(i, j) Next j Next i Erase b ReDim b(LBound(m, 1) To UBound(m, 1)) For i = LBound(m, 1) To UBound(m, 1) b(i) = m(i, UBound(m, 2)) Next i cErr: If Err <> 0 Then Err.Clear End If End Sub Private Sub MakeXYS(ByRef x() As Double, ByRef y() As Double, _ ByRef s() As Double, ByVal LB As Long, ByVal UB As Long) On Error GoTo cErr Erase x: Erase y: Erase s ReDim x(LB To UB) ReDim y(LB To UB) ReDim s(LB To UB) cErr: If Err <> 0 Then Err.Clear End If End Sub Rem "функция вычисляет точность решения, при которой" Rem "должны заканчиваться итерации" Private Function CalcE(ByVal s As Double, ByVal e As Double) As Double On Error GoTo cErr If s < 0.5 Then CalcE = e ElseIf s >= 0.5 And s < 1 Then CalcE = e * (1 - s) / s Else CalcE = 0 End If cErr: If Err <> 0 Then Err.Clear End If End Function Rem "функция сравнивает векторы корней на предыдущей и текущей" Rem "итерациях и возвращает максимальное Abs отклонение" Private Function CompareXY(ByRef x() As Double, _ ByRef y() As Double) As Double Dim i As Long Dim pa As Double Dim pxy As Double On Error GoTo cErr pxy = 0 For i = LBound(x) To UBound(x) pa = Abs(x(i) - y(i)) If pxy < pa Then pxy = pa End If Next i CompareXY = pxy cErr: If Err <> 0 Then Err.Clear End If End Function Rem "копирование вектора последующей итерации y() в вектор" Rem "предыдущей итерации x()" Private Sub YCopyX(ByRef x() As Double, ByRef y() As Double) Dim i As Long On Error GoTo cErr For i = LBound(x) To UBound(x) x(i) = y(i) Next i cErr: If Err <> 0 Then Err.Clear End If End Sub Rem "проверка найденного решения" Private Sub CheckReshenie(ByRef a() As Double, ByRef b() As Double, _ ByRef x() As Double, ByRef ax() As Double, ByRef vp() As Double) Dim i As Integer, j As Integer Dim s As Double On Error GoTo cErr Erase ax Erase vp ReDim ax(LBound(b) To UBound(b)) ReDim vp(LBound(b) To UBound(b)) For i = LBound(a, 1) To UBound(a, 1) s = 0 For j = LBound(b) To UBound(b) s = s + a(i, j) * x(j) Next j ax(i) = s vp(i) = Abs(b(i) - ax(i)) Next i cErr: If Err <> 0 Then Err.Clear End If End Sub Public Function RYakobuSys(ByRef m() As Double, ByRef a() As Double, _ ByRef b() As Double, ByRef xx() As Double, _ msfg As MSFlexGrid, lblf As Label) As Boolean Dim i As Long, j As Long Dim p As Double On Error GoTo cErr MakeAB m, a, b MakeXYS x, y, s, LBound(b), UBound(b) DivMatrix a, s, smax If smax >= 1 Then Exit Function VektorX0 a, b, x '"нулевое приближение" e = CalcE(smax, 0.0001) If e < minE Or e > maxE Then Exit Function YakobiStep a, b, x, y '"первое приближение" YCopyX x, y YakobiStep a, b, x, y '"второе приближение" p = CompareXY(x, y) i = 2 Do While ((p > e) And (i <= maxIter)) i = i + 1 YakobiStep a, b, x, y p = CompareXY(x, y) YCopyX x, y Loop MakeAB m, a, b CheckReshenie a, b, x, ax, vp ReDim xx(LBound(x) To UBound(x)) For i = LBound(x) To UBound(x) xx(i) = x(i) Next i msfg.TextMatrix(UBound(x) + 3, 1) = "X" PrintVektor x, UBound(x) + 4, 1, msfg msfg.TextMatrix(UBound(x) + 3, 3) = "AX" PrintVektor ax, UBound(ax) + 4, 3, msfg msfg.TextMatrix(UBound(x) + 3, 5) = "|AX-B|" PrintVektor vp, UBound(vp) + 4, 5, msfg lblf.Caption = "Точность вычисления = " & Format(e, "0.000 000 000" _
& vbCrLf & "Число итераций = " & i RYakobuSys = True cErr: If Err <> 0 Then Err.Clear End If End Function Rem "отладочные процедуры" Private Sub PrintMatrix(ByRef a() As Double, ByVal r As Long, _ ByVal c As Long, msfg As MSFlexGrid) Dim i As Long, j As Long On Error GoTo cErr For i = LBound(a, 1) To UBound(a, 1) For j = LBound(a, 2) To UBound(a, 2) msfg.TextMatrix(r + i - LBound(a, 1), c + j - LBound(a, 2)) _ = Format(a(i, j), "0.000"
Next j Next i cErr: If Err <> 0 Then Err.Clear End If End Sub Private Sub PrintVektor(ByRef b() As Double, ByVal r As Long, _ ByVal c As Long, msfg As MSFlexGrid) Dim i As Long, j As Long On Error GoTo cErr For i = LBound(b) To UBound(b) msfg.TextMatrix(r + i - LBound(b), c) = Format(b(i), "0.000 000"
Next i cErr: If Err <> 0 Then Err.Clear End If End Sub |
||
|
Номер ответа: 2 Автор ответа: Artyom Разработчик Вопросов: 130 Ответов: 6602 |
Профиль | | #2 | Добавлено: 21.06.08 15:53 |
| Мне он нравится! | ||
|
Номер ответа: 3 Автор ответа: bi-lya Вопросов: 1 Ответов: 125 |
Профиль | | #3 | Добавлено: 21.06.08 16:00 |
|
||
|
Номер ответа: 4 Автор ответа: ArsenyICQ: 298826769 Вопросов: 53 Ответов: 1732 |
Профиль | | #4 | Добавлено: 22.06.08 01:35 |
|
Мне он нравится!
Код или Марат? |
||
|
Номер ответа: 5 Автор ответа: ArsenyICQ: 298826769 Вопросов: 53 Ответов: 1732 |
Профиль | | #5 | Добавлено: 22.06.08 01:37 |
| так-то оно конечно нормально: курсовую написал, а понять, что написал - не могу, помогите.... | ||
|
Номер ответа: 6 Автор ответа: ArtyomРазработчик Вопросов: 130 Ответов: 6602 |
Профиль | | #6 | Добавлено: 22.06.08 01:37 |
| Код конечно! | ||
|
Номер ответа: 7 Автор ответа: ArsenyICQ: 298826769 Вопросов: 53 Ответов: 1732 |
Профиль | | #7 | Добавлено: 22.06.08 01:41 |
| :D А Марата ты чего - уже ненавидишь? :D | ||
|
Номер ответа: 8 Автор ответа: ArsenyICQ: 298826769 Вопросов: 53 Ответов: 1732 |
Профиль | | #8 | Добавлено: 22.06.08 01:42 |
| ремарки просто умиляют.... | ||
|
Номер ответа: 9 Автор ответа: ArtyomРазработчик Вопросов: 130 Ответов: 6602 |
Профиль | | #9 | Добавлено: 22.06.08 02:06 |
| чел просто горько плакал над клавиатурой... | ||
|
Номер ответа: 10 Автор ответа: МаратВопросов: 1 Ответов: 2 |
Профиль | | #10 | Добавлено: 22.06.08 10:49 |
| Ну что? Никто не поможет с кодом? | ||
|
Номер ответа: 11 Автор ответа: ArtyomРазработчик Вопросов: 130 Ответов: 6602 |
Профиль | | #11 | Добавлено: 22.06.08 19:00 |
| Один мой знакомый заентиресовался этим кодом. | ||
|
Номер ответа: 12 Автор ответа: ArsenyICQ: 298826769 Вопросов: 53 Ответов: 1732 |
Профиль | | #12 | Добавлено: 22.06.08 23:57 |
|
Один мой знакомый заентиресовался этим кодом.
Гейтс? |
||
|
Номер ответа: 13 Автор ответа: ArsenyICQ: 298826769 Вопросов: 53 Ответов: 1732 |
Профиль | | #13 | Добавлено: 23.06.08 00:00 |
|
Ну что? Никто не поможет с кодом?
Сколько вас учить: при такой постановке вопроса сразу называется сумма вознаграждения! |
||
|
Номер ответа: 14 Автор ответа: ArtyomРазработчик Вопросов: 130 Ответов: 6602 |
Профиль | | #14 | Добавлено: 23.06.08 00:23 |
|
Кстати, автор вопроса ввел в заблуждение участников форума!
На самом деле кода не 17 страниц а 24 страницы! Проверил на шрифте Times New Roman 14 полуторным интервалом при стандартных настройках полей. |
||
Страница: 1 |