Методика расчета собственных колебаний блока

Расчет частоты собственных колебаний блока можно привести, заменив конструкцию его эквивалентной расчетной схемой в виде блочной схемы /5/.

Частоту собственных колебаний прямоугольной пластины для всех случаев закрепления ее краев можно определить следующим образом :

 

, (4.14)

 

где

а - длина пластины, м;

D - цилиндрическая жесткость пластины

 , (4.15)

Е - модуль упругости;

 - коэффициент Пуассона;

q - ускорение свободного падения;

- плотность материала

- коэффициент, значение которого зависит от способа закрепления сторон пластины

 

Для удобства пользования выражение (4.14) приведем к виду :

 

, (4.16)

где

В - частотная постоянная, зависящая от способа закрепления пластины

 

Если пластина не стальная, а выполнена из какого-либо другого материала, то в (4.16) вводится поправочный коэффициент k_M на материал

 

где

Е и  - модуль упругости и плотность применяемого материала;

Е_С и _С - модуль упругости и плотность стали.

Для учета нагрузки при распределенной нагрузке вводят поправочный коэффициент массы элементов

 ,

где

Q_Э и Q_Э - масса пластины и масса элементов, равномерно распределенных по пластине ;

Таким образом выражение (4.14) для определения частоты собственных колебаний приобретает вид

 (4.17)

Важно, чтобы резонансная частота ПП отличалась от частоты вынужденных колебаний на входе, по крайней мере в два раза. При этом исключается вхождение в резонанс, опасный в вибросистеме.

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

 

 , (4.18)

где

j_max - вибрационные перегрузки

b - размер короткой стороны платы

 - безразмерная постоянная, числовое значение которой зависит от значений частоты собственных колебаний и воздействующих ускорений.

Расчетная часть

В расчетной части проекта в качестве примера конструкторского расчета какой-либо конструкторской единицы представим конструкторский расчет платы усилителя импульсов (УИ).

 

 

Текст программы

 

‘*****************************

‘ 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

 Else

 If ImageText(Source.Index).Tag = 1 Then

 Documents(GetDOCIndex(Source.Tag)).X = X

 Documents(GetDOCIndex(Source.Tag)).Y = Y

 End If

 Source.Left = X

 Source.Top = Y

 ImageText(Source.Index).Left = X

 ImageText(Source.Index).Top = Y + 500

 End If

End Sub

 

Private Sub Form_Load()

 Dim a As Integer

 

 LoadRegCards

 

 MakeDocForm.Combo1.Clear

 For a = 0 To RegistrationCo

 MakeDocForm.Combo1.AddItem Registrations(a).NameApp, a

 Next a

 MakeDocForm.Combo1.AddItem "Использовать стандартный обработчик", RegistrationCo + 1

 MakeDocForm.Combo1.ListIndex = RegistrationCo + 1

 

 LoadRegCards

 ImageCo = -1

 LoadProject App.Path & "\pro1.prj"

 ShowProject

 SaveProject App.Path & "\pro1.prj"

 

End Sub

 

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

 

 If Button = 1 Then

 MouseX = X

 MouseY = Y

 SelectOn = True

 With selectrec

 .Visible = True

 .Height = 0

 .Width = 0

 .Left = X

 .Top = Y

 End With

 End If

End Sub

 

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

 If SelectOn = True Then

 With selectrec

 If Y < MouseY Then

 .Top = Y

 .Height = MouseY - Y

 Else

 .Top = MouseY

 .Height = Y - MouseY

 End If

 If X < MouseX Then

 .Left = X

 .Width = MouseX - X

 Else

 .Left = MouseX

 .Width = X - MouseX

 End If

 End With

 End If

End Sub

 

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

 Dim a As Integer

 If SelectOn = False Then

 MouseX = X

 MouseY = Y

 If Button = 2 Then

 MenuMake.Visible = True

 MenuRegistration.Visible = True

 MenuPropertyes.Visible = False

 MenuSeparator.Visible = False

 If SelectIs = True Then

 MenuDelete.Visible = True

 MenuCut.Visible = True

 MenuCopy.Visible = True

 Else

 MenuDelete.Visible = False

 MenuCut.Visible = False

 MenuCopy.Visible = False

 End If

' MenuPaste.Visible = False

 MenuFrom = -1

 MainForm.PopupMenu RightButtonMenuOnForm

 End If

 Else

 SelectOn = False

 selectrec.Visible = False

 SelectIs = False

 For a = 0 To ImageCo

 If (ImageIcon(a).Top > selectrec.Top) And _

 (ImageIcon(a).Left > selectrec.Left) And _

 (ImageIcon(a).Top < (selectrec.Top + selectrec.Height)) And _

 (ImageIcon(a).Left < (selectrec.Left + selectrec.Width)) Then

 

 SelectIs = True

 ImageIcon(a).BorderStyle = 1

 Else

 ImageIcon(a).BorderStyle = 0

 End If

 

 Next a

 End If

End Sub

 

Private Sub Form_Unload(Cancel As Integer)

 SaveProject App.Path & "\pro1.prj"

 End

End Sub

 

Private Sub ImageIcon_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

 If Button = 1 Then

 ImageIcon(Index).Drag

 End If

End Sub

 

Private Sub ImageIcon_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

 If Button = 2 Then

 MenuMake.Visible = False

 MenuRegistration.Visible = False

 MenuPaste.Visible = False

 MenuPropertyes.Visible = True

 MenuSeparator.Visible = True

 MenuFrom = Index

 PopupMenu RightButtonMenuOnForm

 End If

 

End Sub

 

Private Sub Menu_Edit_Click()

 MainForm.PopupMenu RightButtonMenuOnForm

End Sub

 

Private Sub MenuDelete_Click()

Dim a As Integer

If SelectIs = True Then

 For a = 0 To ImageCo

 If ImageIcon(a).BorderStyle = 1 Then

 Delete a

 End If

 Next a

 SelectIs = False

Else

 Delete MenuFrom

End If

End Sub

 

Private Sub MenuMakeDocument_Click()

 DocumentCo = DocumentCo + 1

 TotalDocCo = TotalDocCo + 1

 ReDim Preserve Documents(DocumentCo)

 Documents(DocumentCo).X = MouseX

 Documents(DocumentCo).Y = MouseY

 

 CurDocument = DocumentCo

 DocumentIsChanged = True

 

 MakeDocForm.Label4(0).Caption = "0"

 MakeDocForm.Label4(1).Caption = str(Now)

 MakeDocForm.Label4(2).Caption = str(Now)

 MakeDocForm.IconText.Text = "Документ"

 MakeDocForm.IconImage.Picture = LoadPicture(App.Path & "\DefDoc.ico")

 MakeDocForm.ImageIconText = App.Path & "\DefDoc.ico"

 MakeDocForm.Discrip.Text = ""

 MakeDocForm.DocumentName = ""

 

 Canceled = False

 

 MakeDocForm.Show vbModal

 

 If Canceled = True Then

 DocumentCo = DocumentCo - 1

 TotalDocCo = TotalDocCo - 1

 ReDim Preserve Documents(DocumentCo)

 Exit Sub

 End If

 MemberDocumentProperty DocumentCo

 Documents(DocumentCo).TotalNumber = TotalDocCo

 Documents(DocumentCo).OutputFunPointCo = -1

 Documents(DocumentCo).OutputDocPointCo = -1

 

 ImageCo = ImageCo + 1

 Load ImageIcon(ImageCo)

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

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

 ImageIcon(ImageCo).Visible = True

 ImageIcon(ImageCo).Enabled = True

 ImageIcon(ImageCo).Picture = LoadPicture(Documents(DocumentCo).ImageIcon)

 ImageIcon(ImageCo).Tag = Documents(DocumentCo).TotalNumber

 

 Load ImageText(ImageCo)

 ImageText(ImageCo).Top = Documents(DocumentCo).Y + 300

 ImageText(ImageCo).Left = Documents(DocumentCo).X

 ImageText(ImageCo).Visible = True

 ImageText(ImageCo).Enabled = True

 ImageText(ImageCo).Caption = Documents(DocumentCo).ImageText

 ImageText(ImageCo).Tag = 1 '**************** 1 = Это документ

End Sub

 

 

Private Sub MenuPropertyes_Click()

 Dim temp As Integer

 If MenuFrom >= 0 Then

 If ImageText(MenuFrom).Tag = 1 Then

 temp = GetDOCIndex(ImageIcon(MenuFrom).Tag)

 ShowDocumentProperty temp

 MakeDocForm.Show vbModal

 MemberDocumentProperty temp

 ImageText(MenuFrom).Caption = Documents(temp).ImageText

 ImageIcon(MenuFrom).Picture = LoadPicture(Documents(temp).ImageIcon)

 End If

 Else

 

 End If

End Sub

 

Private Sub MenuRegistration_Click()

 RegistrForm.Show vbModal

End Sub

 

Public Sub Delete(Index As Integer)

 Dim a As Integer

 Dim b As Integer

 

 If ImageText(Index).Tag = 1 Then

 b = GetDOCIndex(ImageIcon(Index).Tag)

 For a = b To DocumentCo - 1

 LSet Documents(a) = Documents(a + 1)

 Next a

 DocumentCo = DocumentCo - 1

 End If

 For a = 0 To ImageCo

 Unload ImageText(a)

 Unload ImageIcon(a)

 Next a

 

 ImageCo = -1

 SaveProject App.Path & "\temp~.prj"

 LoadProject App.Path & "\temp~.prj"

 ShowProject

End Sub

 

‘********************

‘Make doc form code

‘********************

Option Explicit

Private Sub Cancel_Click()

 Canceled = True

 Hide

End Sub

 

Private Sub Command1_Click()

On Error GoTo Err1

 RegDialog2.Flags = cdlOFNHideReadOnly

 If Combo1.ListIndex <> (RegistrationCo + 1) Then

 RegDialog2.Filter = "Âñå ôàéëû|*.*|" & _

 Registrations(Combo1.ListIndex).NameApp & "|" & _

 Registrations(Combo1.ListIndex).FileMask

 Else

 RegDialog2.Filter = "Âñå ôàéëû|*.*"

 End If

 RegDialog2.ShowOpen

 DocumentName.Text = RegDialog2.FileName

Err1:

End Sub

 

Private Sub Command2_Click()

On Error GoTo Err1

 RegDialog.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly

 RegDialog.ShowOpen

 IconImage.Picture = LoadPicture(RegDialog.FileName)

 ImageIconText = RegDialog.FileName

Err1:

End Sub

 

Private Sub DocumentName_Change()

 DocumentIsChanged = True

End Sub

 

Private Sub Form_Activate()

 DocumentIsChanged = False

End Sub

 

Private Sub OkButton_Click()

 Dim ErrorFlag As Boolean

 Dim tmp As Integer

 Dim CurObject As Object

 Dim retShell As Long

 

 On Error GoTo Err1

 If DocumentName.Text = "" Then

 MsgBox ("Íåîáõîäèìî çàïîëíèòü ïîëå ""Äîêóìåíò :""")

 DocumentName.SetFocus

 Exit Sub

 End If

 If DocumentIsChanged Then

 ErrorFlag = False

 tmp = FileLen(DocumentName.Text)

 If ErrorFlag = True Then

 tmp = FreeFile

 Open DocumentName.Text For Output As tmp

 Close tmp

 End If

 End If

Hide

Exit Sub

Err1:

 If Err.Number = 53 Then

 ErrorFlag = True

 Else

 Select Case MsgBox("Ïðîèçîøëà îøèáêà íîìåð :" & Err.Number & _

 Chr(13) & Chr(10) _

 & Err.Description, vbAbortRetryIgnore + vbCritical)

 Case vbAbort

 End

 Case vbRetry

 Resume 0

 End Select

 End If

 Resume Next

End Sub

 

‘***********************

‘ registration form code

‘***********************

Option Explicit

Dim CurIndex As Integer

Private Sub Browser_Click()

 On Error GoTo Err1

 RegDialog.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly

 RegDialog.ShowOpen

 Path = RegDialog.FileName

Err1:

End Sub

 

Private Sub Cancel_Click()

 LoadRegCards

 Hide

End Sub

 

Private Sub Combo1_Click()

 ShowRegCard Combo1.ListIndex

End Sub

 

 

Private Sub DestroyReg_Click()

Dim a As Integer

 

For a = CurIndex To RegistrationCo - 1

 LSet Registrations(a) = Registrations(a + 1)

Next a

RegistrationCo = RegistrationCo - 1

If RegistrationCo > -1 Then

 ReDim Preserve Registrations(RegistrationCo)

 If CurIndex > RegistrationCo Then CurIndex = CurIndex - 1

 ComboRemake

 CardShow CurIndex

 Combo1.ListIndex = CurIndex

 'ShowRegCard CurIndex

Else

 EnabledAll RegistrationCo

End If

EnabledAll RegistrationCo

End Sub

 

Private Sub Form_Activate()

 EnabledAll RegistrationCo

 If RegistrationCo = -1 Then Exit Sub

 ComboRemake

 CurIndex = 0

 CardShow CurIndex

 Combo1.ListIndex = CurIndex

End Sub

 

Private Sub NewReg_Click()

 TotalRegCo = TotalRegCo + 1

 RegistrationCo = RegistrationCo + 1

 ReDim Preserve Registrations(RegistrationCo)

 

 Registrations(RegistrationCo).NameApp = InputBox("Ââåäèòå èìÿ ïðèëîæåíèÿ", , "Ïðèëîæåíèå" + str(RegistrationCo + 1))

 If Registrations(RegistrationCo).NameApp = "" Then

 ReDim Preserve Registrations(RegistrationCo)

 TotalRegCo = TotalRegCo - 1

 RegistrationCo = RegistrationCo - 1

 Exit Sub

 End If

 Registrations(RegistrationCo).TotalNumber = TotalRegCo

 EnabledAll RegistrationCo

 ComboRemake

 Combo1.ListIndex = RegistrationCo

 'ShowRegCard RegistrationCo

 

 'Debug.Print

 

End Sub

 

Private Sub OkButton_Click()

 MemberCard

 SaveRegCards

 Hide

End Sub

 

 

Private Sub Rename_Click()

 Dim a As Integer

 Dim str As String

 a = Combo1.ListIndex

 

 str = InputBox("Ââåäèòå èìÿ ïðèëîæåíèÿ", , Registrations(a).NameApp)

 If str <> "" Then Registrations(a).NameApp = str

 ComboRemake

 Combo1.ListIndex = a

 'ShowRegCard a

 

End Sub

 

Private Sub ShowRegCard(NumRegCard As Integer)

 MemberCard

 CardShow NumRegCard

End Sub

 

Public Sub ComboRemake()

 Dim a As Integer

 Combo1.Clear

 For a = 0 To RegistrationCo

 Combo1.AddItem Registrations(a).NameApp, a

 Next a

 

End Sub

 

Public Sub EnabledAll(Yes As Integer)

 If Yes = -1 Then

 ComboRemake

 Browser.Enabled = False

 DestroyReg.Enabled = False

 Combo1.Enabled = False

 Rename.Enabled = False

 Path.Enabled = False

 Discrip.Enabled = False

 ListExt.Enabled = False

 Path.Text = ""

 Discrip.Text = ""

 ListExt.Text = ""

 Label1.Enabled = False

 Label2.Enabled = False

 Label3.Enabled = False

 Label4.Enabled = False

 Else

 DestroyReg.Enabled = True

 Combo1.Enabled = True

 Browser.Enabled = True

 Rename.Enabled = True

 Path.Enabled = True

 Discrip.Enabled = True

 ListExt.Enabled = True

 Label1.Enabled = True

 Label2.Enabled = True

 Label3.Enabled = True

 Label4.Enabled = True

 End If

End Sub

Public Sub CardShow(NumRegCard As Integer)

 Path.Text = Registrations(NumRegCard).FileName

 ListExt.Text = Registrations(NumRegCard).FileMask

 Discrip.Text = Registrations(NumRegCard).Discription

 CurIndex = NumRegCard

End Sub

 

Public Sub MemberCard()

 Registrations(CurIndex).FileName = Path.Text

 Registrations(CurIndex).FileMask = ListExt.Text

 Registrations(CurIndex).Discription = Discrip.Text

End Sub

 

Приложения

 

рис 1.1

 

 

Рис. 2.2

 

 

 

 

 

Рис. 3.1. Основное окно программы

 

Рис. 3.2. Меню "Правка"

 

Рис. 3.3. Окно свойств документа