30829-1 (Контроллер связываемых объектов), страница 9

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. Окно свойств документа