30829-1 (Контроллер связываемых объектов), страница 8
Описание файла
Документ из архива "Контроллер связываемых объектов", который расположен в категории "". Всё это находится в предмете "информатика" из , которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "рефераты, доклады и презентации", в предмете "информатика, программирование" в общих файлах.
Онлайн просмотр документа "30829-1"
Текст 8 страницы из документа "30829-1"
В расчетной части проекта в качестве примера конструкторского расчета какой-либо конструкторской единицы представим конструкторский расчет платы усилителя импульсов (УИ).
Текст программы
‘*****************************
‘ Main Module Code
‘*****************************
Option Explicit
Option Base 0
Public MenuFrom As Integer
Public Canceled As Boolean
Public SelectOn As Boolean
Public SelectIs As Boolean
Public ImageCo As Integer
Public MouseX As Integer
Public MouseY As Integer
Public TotalDocCo As Integer
Public TotalFunCo As Integer
Public TotalRegCo As Integer
Public CurDocument As Integer
Public CurFunction As Integer
Public DocumentIsChanged As Boolean
Public Type RegistrationType
TotalNumber As Long
Discription As String
FileName As String
NameApp As String
FileMask As String
End Type
Public Registrations() As RegistrationType
Public RegistrationCo As Integer
Public Type DocumentType
TotalNumber As Long
FileName As String
CreateDateTime As String
UsedProgramm As Long
Discription As String
ImageIcon As String
ImageText As String
X As Integer
Y As Integer
OutputFunPoints() As Integer
OutputFunPointCo As Integer
OutputDocPoints() As Integer
OutputDocPointCo As Integer
End Type
Public Documents() As DocumentType
Public DocumentCo As Integer
Public Type FunctionType
TotalNumber As Long
FileName As String
CreateDateTime As String
Path As String
UsedProgramm As String
AutomatFunction As String
AutoExeFlag As Boolean
AskBeforeExe As Boolean
Discription As String
ImageIcon As String
ImageText As String
X As Integer
Y As Integer
DocumentsAndFunctionsLink As String
InputDocPoints() As Integer
InputDocPointCo As Integer
OutputDocPoints() As Integer
OutputDocPointCo As Integer
InputFunPoints() As Integer
InputFunPointCo As Integer
OutputFunPoints() As Integer
OutputFunPointCo As Integer
End Type
Public Functions() As FunctionType
Public FunctionCo As Integer
Public Sub ShowDocumentProperty(DocNumber As Integer)
On Error GoTo Err1
MakeDocForm.Label4(0).Caption = FileLen(Documents(DocNumber).FileName)
MakeDocForm.Label4(1).Caption = FileDateTime(Documents(DocNumber).FileName)
MakeDocForm.Label4(2).Caption = Documents(DocNumber).CreateDateTime
MakeDocForm.IconText.Text = Documents(DocNumber).ImageText
MakeDocForm.IconImage.Picture = LoadPicture(Documents(DocNumber).ImageIcon)
MakeDocForm.ImageIconText.Caption = Documents(DocNumber).ImageIcon
MakeDocForm.Discrip.Text = Documents(DocNumber).Discription
MakeDocForm.DocumentName = Documents(DocNumber).FileName
If Documents(DocNumber).UsedProgramm = -1 Then
MakeDocForm.Combo1.ListIndex = RegistrationCo + 1
Else
MakeDocForm.Combo1.ListIndex = GetREGIndex(Documents(DocNumber).UsedProgramm)
End If
Exit Sub
Err1:
Select Case MsgBox("Ïðîèçîøëà îøèáêà ïðè ïîïûòêå ñ÷èòàòü ôàéë.", vbAbortRetryIgnore + vbCritical)
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
.ImageIcon(ImageCo).Visible = True
.ImageIcon(ImageCo).Enabled = True
.ImageIcon(ImageCo).Picture = LoadPicture(Documents(a).ImageIcon)
.ImageIcon(ImageCo).Tag = Documents(a).TotalNumber
Load .ImageText(ImageCo)
.ImageText(ImageCo).Top = Documents(a).Y + 500
.ImageText(ImageCo).Left = Documents(a).X
.ImageText(ImageCo).Visible = True
.ImageText(ImageCo).Enabled = True
.ImageText(ImageCo).Caption = Documents(a).ImageText
.ImageText(ImageCo).Tag = 1
Next a
End With
End Sub
‘******************************
‘Main Form Code
‘******************************
Option Explicit
Option Base 0
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Dim a As Integer
Dim dX As Integer
Dim dY As Integer
If SelectIs = True Then
dX = X - Source.Left
dY = Y - Source.Top
For a = 0 To ImageCo
If ImageIcon(a).BorderStyle = 1 Then
If ImageText(a).Tag = 1 Then
Documents(GetDOCIndex(ImageIcon(a).Tag)).X = ImageIcon(a).Left + dX
Documents(GetDOCIndex(ImageIcon(a).Tag)).Y = ImageIcon(a).Top + dY
End If
ImageIcon(a).Left = ImageIcon(a).Left + dX
ImageIcon(a).Top = ImageIcon(a).Top + dY
ImageText(a).Left = ImageIcon(a).Left
ImageText(a).Top = ImageIcon(a).Top + 500
End If
Next a
