Реферат: Контроллер связываемых объектов

 Case vbAbort

 End

 Case vbRetry

 Resume 0

 Case vbIgnore

 End Select

End Sub

Public Sub SaveRegCards()

 Dim FileNumber As Integer

 Dim a As Integer

On Error GoTo Err1

 FileNumber = FreeFile

 Open App.Path & "\RegisterCards" For Output As FileNumber

 Write #FileNumber, TotalRegCo, RegistrationCo

 For a = 0 To RegistrationCo

 With Registrations(a)

 Write #FileNumber, .TotalNumber, .Discription, .FileName, .NameApp, .FileMask

 End With

 Next a

 Close FileNumber

 Exit Sub

Err1:

 Select Case MsgBox("Ïðîèçîøëà îøèáêà ïðè ïîïûòêå çàïèñàòü ôàéë ðåãèñòðàöèè." _

 & Chr(13) & Chr(10) & Err.Number & Chr(13) & Chr(10) & _

 Err.Description, vbAbortRetryIgnore + vbCritical)

 Case vbAbort

 End

 Case vbRetry

 Resume 0

 End Select

End Sub

Public Sub MemberDocumentProperty(DocNumber As Integer)

 Documents(DocNumber).ImageText = MakeDocForm.IconText.Text

 Documents(DocNumber).ImageIcon = MakeDocForm.ImageIconText.Caption

 Documents(DocNumber).Discription = MakeDocForm.Discrip.Text

 Documents(DocNumber).FileName = MakeDocForm.DocumentName.Text

 Documents(DocNumber).CreateDateTime = MakeDocForm.Label4(0).Caption

 If MakeDocForm.Combo1.ListIndex = RegistrationCo + 1 Then

 Documents(DocNumber).UsedProgramm = -1

 Else

 Documents(DocNumber).UsedProgramm = Registrations(MakeDocForm.Combo1.ListIndex).TotalNumber

 End If

 

End Sub

Public Sub SaveProject(ProjectName As String)

 Dim FileNumber As Integer

 Dim a As Integer

 Dim b As Integer

 On Error GoTo Err1

 FileNumber = FreeFile

 Open ProjectName For Output As FileNumber

 Write #FileNumber, TotalDocCo, TotalFunCo, DocumentCo, FunctionCo

 For a = 0 To DocumentCo

 With Documents(a)

 Write #FileNumber, .TotalNumber, .FileName, .CreateDateTime, .UsedProgramm, _

 .Discription, .ImageIcon, .ImageText, .X, .Y, .OutputFunPointCo, _

 .OutputDocPointCo

 For b = 0 To .OutputFunPointCo

 Write #FileNumber, .OutputFunPoints(b)

 Next b

 For b = 0 To .OutputDocPointCo

 Write #FileNumber, .OutputDocPoints(b)

 Next b

 End With

 Next a

 For a = 0 To FunctionCo

 With Functions(a)

 Write #FileNumber, .TotalNumber, .FileName, .CreateDateTime, .UsedProgramm, _

 .AutomatFunction, .AutoExeFlag, .AskBeforeExe, .Discription, _

 .ImageIcon, .ImageText, .X, .Y, .DocumentsAndFunctionsLink, _

 .OutputFunPointCo, .OutputDocPointCo, .InputFunPointCo, _

 .InputDocPointCo

 For b = 0 To .OutputFunPointCo

 Write #FileNumber, .OutputFunPoints(b)

 Next b

 For b = 0 To .OutputDocPointCo

 Write #FileNumber, .OutputDocPoints(b)

 Next b

 For b = 0 To .InputFunPointCo

 Write #FileNumber, .InputFunPoints(b)

 Next b

 For b = 0 To .InputDocPointCo

 Write #FileNumber, .InputDocPoints(b)

 Next b

 End With

 Next a

 Close FileNumber

 Exit Sub

Err1:

 Select Case MsgBox("Ïðîèçîøëà îøèáêà ïðè ïîïûòêå çàïèñàòü ôàéë ïðîåêòà." _

 & Chr(13) & Chr(10) & Err.Number & Chr(13) & Chr(10) & _

 Err.Description, vbAbortRetryIgnore + vbCritical)

 Case vbAbort

 End

 Case vbRetry

 Resume 0

 End Select

End Sub

Public Sub LoadRegCards()

On Error GoTo Err1

 Dim FileNumber As Integer

 Dim a As Integer

 FileNumber = FreeFile

 Open App.Path & "\RegisterCards" For Input As FileNumber

 Input #FileNumber, TotalRegCo, RegistrationCo

 If RegistrationCo = -1 Then

 Close FileNumber

 Exit Sub

 End If

 ReDim Registrations(RegistrationCo)

 For a = 0 To RegistrationCo

 With Registrations(a)

 Input #FileNumber, .TotalNumber, .Discription, .FileName, .NameApp, .FileMask

 End With

 Next a

 Close FileNumber

 Exit Sub

Err1:

 Select Case MsgBox("Ïðîèçîøëà îøèáêà ïðè ïîïûòêå ñ÷èòàòü ôàéë ðåãèñòðàöèè." _

 & Chr(13) & Chr(10) & Err.Number & Chr(13) & Chr(10) & _

 Err.Description, vbAbortRetryIgnore + vbCritical)

 Case vbAbort

 End

 Case vbRetry

 Resume 0

 Case vbIgnore

 RegistrationCo = -1

 End Select

End Sub

Public Sub LoadProject(ProjectName As String)

 On Error GoTo Err1

 Dim FileNumber As Integer

 Dim a As Integer

 Dim b As Integer

 FileNumber = FreeFile

 Open ProjectName For Input As FileNumber

 Input #FileNumber, TotalDocCo, TotalFunCo, DocumentCo, FunctionCo

 If DocumentCo <> -1 Then

 ReDim Documents(DocumentCo)

 For a = 0 To DocumentCo

 With Documents(a)

 Input #FileNumber, .TotalNumber, .FileName, .CreateDateTime, .UsedProgramm, _

 .Discription, .ImageIcon, .ImageText, .X, .Y, .OutputFunPointCo, _

 .OutputDocPointCo

 If .OutputFunPointCo <> -1 Then

 ReDim .OutputFunPoints(.OutputFunPointCo)

 For b = 0 To .OutputFunPointCo

 Input #FileNumber, .OutputFunPoints(b)

 Next b

 End If

 If .OutputFunPointCo <> -1 Then

 ReDim .OutputDocPoints(.OutputDocPointCo)

 For b = 0 To .OutputDocPointCo

 Input #FileNumber, .OutputDocPoints(b)

 Next b

 End If

 End With

 Next a

 End If

 If FunctionCo <> -1 Then

 ReDim Functions(FunctionCo)

 For a = 0 To FunctionCo

 With Functions(a)

 Input #FileNumber, .TotalNumber, .FileName, .CreateDateTime, .UsedProgramm, _

 .AutomatFunction, .AutoExeFlag, .AskBeforeExe, .Discription, _

 .ImageIcon, .ImageText, .X, .Y, .DocumentsAndFunctionsLink, _

 .OutputFunPointCo, .OutputDocPointCo, .InputFunPointCo, _

 .InputDocPointCo

 If .OutputFunPointCo <> -1 Then

 ReDim .OutputFunPoints(.OutputFunPointCo)

 For b = 0 To .OutputFunPointCo

 Input #FileNumber, .OutputFunPoints(b)

 Next b

 End If

 If .OutputDocPointCo <> -1 Then

 ReDim .OutputDocPoints(.OutputDocPointCo)

 For b = 0 To .OutputDocPointCo

 Input #FileNumber, .OutputDocPoints(b)

 Next b

 End If

 If .InputFunPointCo <> -1 Then

 ReDim .InputFunPoints(.InputFunPointCo)

 For b = 0 To .InputFunPointCo

 Input #FileNumber, .InputFunPoints(b)

 Next b

 End If

 If .InputDocPointCo <> -1 Then

 ReDim .InputDocPoints(.InputDocPointCo)

 For b = 0 To .InputDocPointCo

 Input #FileNumber, .InputDocPoints(b)

 Next b

 End If

 End With

 Next a

 End If

 Close FileNumber

Exit Sub

Err1:

 Select Case MsgBox("Ïðîèçîøëà îøèáêà ïðè ïîïûòêå ñ÷èòàòü ôàéë ïðîåêòà." _

 & Chr(13) & Chr(10) & Err.Number & Chr(13) & Chr(10) _

 & Err.Description, vbAbortRetryIgnore + vbCritical)

 Case vbAbort

 End

 Case vbRetry

 Resume 0

 Case vbIgnore

 FunctionCo = -1

 DocumentCo = -1

 End Select

End Sub

Public Function GetREGIndex(TotalNumber As Long) As Integer

 Dim a As Integer

 For a = 0 To RegistrationCo

 If Registrations(a).TotalNumber = TotalNumber Then

 GetREGIndex = a

 Exit For

 End If

 Next a

End Function

Public Function GetDOCIndex(TotalNumber As Long) As Integer

 Dim a As Integer

 For a = 0 To DocumentCo

 If Documents(a).TotalNumber = TotalNumber Then

 GetDOCIndex = a

 Exit For

 End If

 Next a

End Function

Public Function GetFUNIndex(TotalNumber As Long) As Integer

 Dim a As Integer

 For a = 0 To FunctionCo

 If Functions(a).TotalNumber = TotalNumber Then

 GetFUNIndex = a

 Exit For

 End If

 Next a

End Function

Public Sub ShowProject()

 Dim a As Integer

 With MainForm

 For a = 0 To DocumentCo

 ImageCo = ImageCo + 1

 Load .ImageIcon(ImageCo)

 .ImageIcon(ImageCo).Top = Documents(a).Y

 .ImageIcon(ImageCo).Left = Documents(a).X

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12