1224 lines
51 KiB
VB.net
Executable File
1224 lines
51 KiB
VB.net
Executable File
|
|
'HauptClasse von PictureTagger ##### IMG ##### Taggs ##### Marks ############################
|
|
Public Class TaggedIMG
|
|
Inherits System.Windows.Forms.PictureBox
|
|
|
|
'########################################################################################
|
|
'############################## Settings ##############################################
|
|
'########################################################################################
|
|
|
|
Private Const SupportedMarks As Integer = 200
|
|
Private Const MinMarkLateralDistanceOnProgramm As Integer = 0
|
|
Private Const MinMarkLateralDistanceOnPicture As Integer = 0
|
|
Private Const MinMarkOnPictureSize As Integer = 16 'This are Pixel
|
|
Private Const MinMarkOnProgrammSize As Integer = 15 'Mindestgröse um Auf TaggedIMG Angezeigt zu werden ... <- Reverenzwert bei Neuen
|
|
Private Const Debugging As Boolean = True 'Bei Fehler werden diese ausgegeben
|
|
|
|
|
|
'########################################################################################
|
|
'############################## MAIN ##################################################
|
|
'########################################################################################
|
|
#Region "Main"
|
|
|
|
'######################
|
|
'### Declarations ###
|
|
'######################
|
|
'Variables
|
|
Private components As System.ComponentModel.IContainer
|
|
Private IMG_Position As New Rectangle
|
|
Private IMG_ScaleFactor As Double
|
|
Private IMG_AspectSiteWidth As Boolean
|
|
|
|
'Events
|
|
' -------------------------------- Taggs ------------------------------
|
|
Public Event TaggChanged()
|
|
Public Event PropertyIDChanged()
|
|
Public Event PropertyTitleChanged()
|
|
Public Event PropertyDescriptionChanged()
|
|
Public Event PropertyTimeChanged()
|
|
Public Event PropertyPlaceChanged()
|
|
|
|
|
|
'###################
|
|
'### Propertys ###
|
|
'###################
|
|
|
|
Private sID As String
|
|
Public Property ID() As String
|
|
Get
|
|
Return Me.sID
|
|
End Get
|
|
Set(ByVal value As String)
|
|
If Not value = Me.sID Then
|
|
Me.sID = value
|
|
RaiseEvent PropertyIDChanged()
|
|
End If
|
|
End Set
|
|
End Property
|
|
|
|
Private sTitle As String
|
|
Public Property Title() As String
|
|
Get
|
|
Return Me.sTitle
|
|
End Get
|
|
Set(ByVal value As String)
|
|
If Not value = Me.sTitle Then
|
|
Me.sTitle = value
|
|
RaiseEvent PropertyTitleChanged()
|
|
RaiseEvent TaggChanged()
|
|
End If
|
|
End Set
|
|
End Property
|
|
|
|
Private sDescription As String
|
|
Public Property Description() As String
|
|
Get
|
|
Return Me.sDescription
|
|
End Get
|
|
Set(ByVal value As String)
|
|
If Not value = Me.sDescription Then
|
|
Me.sDescription = value
|
|
RaiseEvent PropertyDescriptionChanged()
|
|
RaiseEvent TaggChanged()
|
|
End If
|
|
End Set
|
|
End Property
|
|
|
|
Private sTime As String
|
|
Public Property Time() As String
|
|
Get
|
|
Return Me.sTime
|
|
End Get
|
|
Set(ByVal value As String)
|
|
If Not value = Me.sTime Then
|
|
Me.sTime = value
|
|
RaiseEvent PropertyTimeChanged()
|
|
RaiseEvent TaggChanged()
|
|
End If
|
|
End Set
|
|
End Property
|
|
|
|
Private oPlace As New Place
|
|
Public Property Place() As Place 'AufnahmeOrt
|
|
Get
|
|
Return oPlace
|
|
End Get
|
|
Set(ByVal value As Place)
|
|
If Not value.GetHashCode = Me.oPlace.GetHashCode Then
|
|
Me.oPlace = value
|
|
RaiseEvent PropertyPlaceChanged()
|
|
RaiseEvent TaggChanged()
|
|
End If
|
|
End Set
|
|
End Property
|
|
' -------------------------------- Taggs END ---------------------------
|
|
|
|
|
|
Private Property MenuEnabled As Boolean
|
|
Get
|
|
Return ContextMenuStrip.Enabled
|
|
End Get
|
|
Set(ByVal value As Boolean)
|
|
ContextMenuStrip.Enabled = value
|
|
For i = 0 To (SupportedMarks - 1)
|
|
aMarkButtons(i).ContextMenuStrip.Enabled = value
|
|
Next
|
|
End Set
|
|
End Property
|
|
|
|
Private bRO As Boolean
|
|
Public Property RO As Boolean
|
|
Get
|
|
Return bRO
|
|
End Get
|
|
Set(ByVal value As Boolean)
|
|
bRO = value
|
|
Me.MenuEnabled = Not value
|
|
End Set
|
|
End Property 'RO = ReadOnly
|
|
|
|
'###################
|
|
'### Public Sub ###
|
|
'###################
|
|
|
|
Public Sub Clear()
|
|
With Me
|
|
'Main
|
|
.sID = Nothing
|
|
.Image = Nothing
|
|
.sTitle = Nothing
|
|
.sDescription = Nothing
|
|
.sTime = Nothing
|
|
.oPlace.Clear()
|
|
|
|
'Mousemode
|
|
.MouseMode_Clear()
|
|
|
|
'Marks & MarkButtons
|
|
.Marks_Clear()
|
|
|
|
'ActivMark
|
|
.ActivMark_Clear()
|
|
|
|
'Menu
|
|
.MenuEnabled = True
|
|
|
|
End With
|
|
End Sub 'Main Clear
|
|
|
|
Public Sub New()
|
|
'Initial Special PictureBox setings
|
|
With Me
|
|
.BorderStyle = Windows.Forms.BorderStyle.None
|
|
.SizeMode = System.Windows.Forms.PictureBoxSizeMode.Zoom
|
|
.TabIndex = 0
|
|
.TabStop = False
|
|
|
|
.MouseMode_Initial()
|
|
.MarkButtons_Initial()
|
|
.Marks_Initial()
|
|
.Menu_Initial() 'ContextMenuStrip_Initial
|
|
.Clear()
|
|
End With
|
|
End Sub ' New() will execute wenn declare a new instance
|
|
|
|
|
|
'######################
|
|
'### Private Subs ###
|
|
'######################
|
|
|
|
Private Sub IMG_Update_PositionsParam()
|
|
Dim ImageAspect As Double = Image.Width / Image.Height
|
|
Dim ControlAspect As Double = Me.Width / Me.Height
|
|
Dim DisplayHeight As Double = Me.Height
|
|
Dim DisplayWidth As Double = Me.Width
|
|
Dim freeAreaSize As Double
|
|
If (ImageAspect >= ControlAspect) Then
|
|
'This means that we are limited by width,
|
|
'meaning the image fills up the entire control from left to right
|
|
Me.IMG_AspectSiteWidth = True
|
|
Me.IMG_ScaleFactor = Me.Width / Image.Width
|
|
DisplayHeight = Me.IMG_ScaleFactor * Image.Height
|
|
freeAreaSize = (Height - DisplayHeight) / 2
|
|
Me.IMG_Position = New Rectangle(0, freeAreaSize, DisplayWidth, DisplayHeight)
|
|
Else
|
|
'This means that we are limited by height,
|
|
'meaning the image fills up the entire control from top to bottom
|
|
Me.IMG_AspectSiteWidth = False
|
|
Me.IMG_ScaleFactor = Me.Height / Image.Height
|
|
DisplayWidth = Me.IMG_ScaleFactor * Image.Width
|
|
freeAreaSize = (Width - DisplayWidth) / 2
|
|
Me.IMG_Position = New Rectangle(freeAreaSize, 0, DisplayWidth, DisplayHeight)
|
|
End If
|
|
End Sub 'IMG_Update_PositionsParam
|
|
|
|
|
|
'##########################
|
|
'#### Handles Events ####
|
|
'##########################
|
|
|
|
Private Sub ReSice() Handles Me.SizeChanged
|
|
Me.MarkButtons_Update() 'ReLoad MarkButons
|
|
|
|
End Sub 'ReSice ### will execute wenn Me.Size has been changed
|
|
|
|
|
|
#End Region 'Main
|
|
|
|
|
|
'########################################################################################
|
|
'############################## MousMode ##############################################
|
|
'########################################################################################
|
|
#Region "MousMode"
|
|
|
|
Private Sub MouseMode_Initial()
|
|
Me.oMouseModeMarkButton.Deleted = True
|
|
Me.oMouseModeMarkButton.Parent = Me
|
|
Me.Controls.Add(Me.oMouseModeMarkButton)
|
|
Me.oMouseModeArgs = New Mark
|
|
End Sub 'MouseMode_Initial
|
|
|
|
'######################
|
|
'### Declarations ###
|
|
'######################
|
|
|
|
'Objects
|
|
Private oMouseModeMarkButton As New MarkButton
|
|
Private bMouseMode As Boolean
|
|
Private oMouseModeArgs As New Mark
|
|
Private nMouseModeAim As Int16 '0 = Nothing | 1 = Change Sice | 2 = Creat New Intern | 3 = Creat New Extern
|
|
Private pMouseDown As System.Drawing.Point
|
|
Private pMouseUp As System.Drawing.Point
|
|
Private bMouseModeSuccessDown As Boolean
|
|
|
|
'Events
|
|
Public Event LikeToCreatMark(ByVal Left As Integer, ByVal Top As Integer, ByVal Width As Integer, ByVal Height As Integer) 'Wird Für ID Generierung Benötigt! <- Übergebe Position(Conv)
|
|
Public Event MouseModeChanged()
|
|
|
|
|
|
'###################
|
|
'### Propertys ###
|
|
'###################
|
|
|
|
Public ReadOnly Property MouseMode As Boolean
|
|
Get
|
|
Return Me.bMouseMode
|
|
End Get
|
|
End Property 'MouseMode
|
|
|
|
|
|
'###########################
|
|
'### Private Functions ###
|
|
'###########################
|
|
|
|
Private Function MouseMode_CalcRectangle(ByVal PointA As System.Drawing.Point, ByVal PointB As System.Drawing.Point) As Rectangle
|
|
Dim Result As New Rectangle
|
|
Result = Rectangle.Points_to_Rectangle(PointA, PointB)
|
|
|
|
If Result.Left < MinMarkLateralDistanceOnProgramm + Me.IMG_Position.Left Then Result.Left = MinMarkLateralDistanceOnProgramm + Me.IMG_Position.Left
|
|
If Result.Top < MinMarkLateralDistanceOnProgramm + Me.IMG_Position.Top Then Result.Top = MinMarkLateralDistanceOnProgramm + Me.IMG_Position.Top
|
|
If Result.PointB.X > Me.IMG_Position.PointB.X - MinMarkLateralDistanceOnProgramm Then Result.Width = Me.IMG_Position.PointB.X - MinMarkLateralDistanceOnProgramm - Result.Left
|
|
If Result.PointB.Y > Me.IMG_Position.PointB.Y - MinMarkLateralDistanceOnProgramm Then Result.Height = Me.IMG_Position.PointB.Y - MinMarkLateralDistanceOnProgramm - Result.Top
|
|
|
|
Return Result
|
|
End Function 'MouseMode_CalcRectangle
|
|
|
|
' "Change_Sice" | "Creat_New_Intern" | "Creat_New_Extern" | {"Move_Mark"}
|
|
Private Function MouseMode_Set(ByRef Aim As String, ByVal Args As Mark) As Boolean
|
|
Me.MouseMode_Clear()
|
|
MouseMode_Set = False
|
|
Me.IMG_Update_PositionsParam()
|
|
If (Aim = "Change_Sice") Or (Aim = "Creat_New_Intern") Or (Aim = "Creat_New_Extern") Or (Aim = "Move_Mark") Then
|
|
Me.bMouseMode = True
|
|
RaiseEvent MouseModeChanged()
|
|
Me.oMouseModeArgs = Args 'Übergebe MarkID
|
|
MouseMode_Set = True
|
|
Select Case Aim
|
|
Case "Change_Sice", "Move_Mark" '<-- Größe zu Ändern | "Move_Mark" wird eigerer Case!
|
|
Me.nMouseModeAim = 1
|
|
|
|
Case "Creat_New_Intern" '<-- Setze Position, ID Fehlt!!
|
|
Me.nMouseModeAim = 2
|
|
|
|
Case "Creat_New_Extern" '<-- Setzt Pisition
|
|
Me.nMouseModeAim = 3
|
|
|
|
End Select 'Aim
|
|
End If
|
|
End Function 'MouseMode_Set
|
|
|
|
Private Function MouseMode_RightPlace(ByVal pPoint As Point) As Boolean
|
|
MouseMode_RightPlace = True
|
|
If pPoint.Y < Me.IMG_Position.Top + MinMarkLateralDistanceOnProgramm Then MouseMode_RightPlace = False
|
|
If pPoint.Y > Me.IMG_Position.PointB.Y - MinMarkLateralDistanceOnProgramm Then MouseMode_RightPlace = False
|
|
If pPoint.X < Me.IMG_Position.Left + MinMarkLateralDistanceOnProgramm Then MouseMode_RightPlace = False
|
|
If pPoint.X > Me.IMG_Position.PointB.X - MinMarkLateralDistanceOnProgramm Then MouseMode_RightPlace = False
|
|
End Function 'MouseMode_ClickRightPlace
|
|
|
|
'######################
|
|
'### Private Subs ###
|
|
'######################
|
|
|
|
Private Sub MouseMode_Clear()
|
|
|
|
Me.bMouseMode = False
|
|
Me.nMouseModeAim = 0
|
|
Me.oMouseModeArgs.Clear()
|
|
Me.pMouseDown = New System.Drawing.Point(0, 0)
|
|
Me.pMouseUp = New System.Drawing.Point(0, 0)
|
|
Me.bMouseModeSuccessDown = False
|
|
Me.Cursor = Cursors.Default
|
|
Me.oMouseModeMarkButton.Deleted = True
|
|
|
|
End Sub
|
|
|
|
|
|
'##########################
|
|
'#### Handles Events ####
|
|
'##########################
|
|
|
|
Private Sub MyEvents_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
|
|
If bMouseMode Then
|
|
Dim pPoint As Drawing.Point
|
|
pPoint.X = e.X
|
|
pPoint.Y = e.Y
|
|
If MouseMode_RightPlace(pPoint) Then
|
|
Me.bMouseModeSuccessDown = True
|
|
Me.pMouseDown = pPoint
|
|
Me.oMouseModeMarkButton.Deleted = False
|
|
Me.oMouseModeMarkButton.Visible = True
|
|
Me.Cursor = Cursors.Cross
|
|
If Me.nMouseModeAim = 1 Then
|
|
Me.aMarkButtons(Me.Marks_IndexOf(Me.oMouseModeArgs.ID)).Visible = False
|
|
End If
|
|
End If
|
|
End If
|
|
End Sub 'MyEvents_MouseDown <-- Will act when bMouseMode = True
|
|
|
|
Private Sub MyEvents_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
|
|
If bMouseMode Then
|
|
Dim pMouseMove As System.Drawing.Point
|
|
pMouseMove.X = e.X
|
|
pMouseMove.Y = e.Y
|
|
oMouseModeMarkButton.Position = MouseMode_CalcRectangle(Me.pMouseDown, pMouseMove) 'Zeige positions änderungen an
|
|
If Me.MouseMode_RightPlace(pMouseMove) Then
|
|
Me.Cursor = Cursors.Cross
|
|
Else
|
|
Me.Cursor = Cursors.No
|
|
End If
|
|
End If
|
|
End Sub 'MyEvents_MouseMove <-- Will act when bMouseMode = True
|
|
|
|
Private Sub MyEvents_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
|
|
If bMouseMode And bMouseModeSuccessDown Then
|
|
Dim Answer As String
|
|
Dim oPositonOnPic As New Rectangle
|
|
oPositonOnPic = Me.ConvertToPicturePosition(Me.oMouseModeMarkButton.Position)
|
|
If Me.MarkButtons_CheckPositionArguments(Me.oMouseModeMarkButton.Position) Then
|
|
Select Case nMouseModeAim
|
|
Case 1
|
|
Me.aMarkButtons(Me.Marks_IndexOf(Me.oMouseModeArgs.ID)).Visible = True
|
|
Answer = Me.Marks_Update(Me.oMouseModeArgs.ID, "Change", oPositonOnPic.Left, oPositonOnPic.Top, oPositonOnPic.Width, oPositonOnPic.Height, Me.oMouseModeArgs.Name, Me.oMouseModeArgs.Description)
|
|
If Not (Answer = "Success") And Debugging Then MsgBox(Answer)
|
|
|
|
Case 2
|
|
RaiseEvent LikeToCreatMark(oPositonOnPic.Left, oPositonOnPic.Top, oPositonOnPic.Width, oPositonOnPic.Height)
|
|
|
|
Case 3
|
|
Answer = Me.Marks_Update(Me.oMouseModeArgs.ID, "Create", oPositonOnPic.Left, oPositonOnPic.Top, oPositonOnPic.Width, oPositonOnPic.Height, Me.oMouseModeArgs.Name, Me.oMouseModeArgs.Description)
|
|
If Not (Answer = "Success") And Debugging Then MsgBox(Answer)
|
|
|
|
End Select
|
|
Else 'On Error
|
|
If (nMouseModeAim >= 1) And Not (nMouseModeAim > 4) Then MsgBox("Das ist Eine Falsche Größe!")
|
|
End If
|
|
Me.MouseMode_Clear()
|
|
RaiseEvent MouseModeChanged()
|
|
End If
|
|
End Sub 'MyEvents_MouseUp <-- Will act when bMouseMode = True
|
|
|
|
|
|
#End Region 'MousMode
|
|
|
|
|
|
'########################################################################################
|
|
'############################## MarkButtons ###########################################
|
|
'########################################################################################
|
|
#Region "MarkButtons"
|
|
|
|
Private Sub MarkButtons_Initial()
|
|
'Initial SupportedMarks MarkButtons <- Maximal sichtbar SupportedMarks/2
|
|
For i = 0 To (SupportedMarks - 1)
|
|
Me.aMarkButtons(i) = New MarkButton(i, bRO)
|
|
Me.aMarkButtons(i).Parent = Me
|
|
Me.Controls.Add(Me.aMarkButtons(i))
|
|
AddHandler Me.aMarkButtons(i).Click, AddressOf MarkButton_Click
|
|
AddHandler Me.aMarkButtons(i).LikeMove, AddressOf MarkButton_LikeMove
|
|
AddHandler Me.aMarkButtons(i).LikeSiceChange, AddressOf MarkButton_LikeSiceChange
|
|
AddHandler Me.aMarkButtons(i).LikeDelete, AddressOf MarkButton_LikeDelete
|
|
Next
|
|
End Sub 'MarkButtons_Initial
|
|
|
|
|
|
'######################
|
|
'### Declarations ###
|
|
'######################
|
|
|
|
Private aMarkButtons(SupportedMarks - 1) As MarkButton
|
|
|
|
|
|
'####################
|
|
'### Private Sub ###
|
|
'####################
|
|
|
|
Private Sub MarkButtons_Visible(ByRef value As Boolean)
|
|
For i = 0 To (SupportedMarks - 1)
|
|
If Not Me.aMarkButtons(i).Deleted Then
|
|
Me.aMarkButtons(i).Visible = value
|
|
End If
|
|
bMarks_Visible = value
|
|
If value = False Then ActivMark_Clear()
|
|
Next
|
|
End Sub 'MarkButtons_Visible
|
|
|
|
Private Sub MarkButtons_Update(Optional ByVal Index As Integer = -1)
|
|
If Index < 0 Then 'Update Alle (Rekursiv)
|
|
For i = 0 To (SupportedMarks - 1)
|
|
Me.MarkButtons_Update(i)
|
|
Next
|
|
ElseIf Index <= (SupportedMarks - 1) Then 'Update %Index%
|
|
If Me.aMarks(Index).ID = "" Or Nothing Then Me.aMarks(Index).Command = "" ' If something gets rong with Information it will Delete
|
|
Select Case Me.aMarks(Index).Command
|
|
Case "Nothing", "Create", "Change"
|
|
Me.MarkButtons_ReSize(Index)
|
|
|
|
Case "Delete"
|
|
Me.aMarkButtons(Index).Deleted = True
|
|
|
|
Case Else
|
|
Me.aMarkButtons(Index).Deleted = True
|
|
Me.Marks_LineDelete(Me.aMarks(Index).ID)
|
|
|
|
End Select
|
|
End If
|
|
End Sub 'MarkButtons_Update -1 Means All
|
|
|
|
Private Sub MarkButtons_ReSize(ByRef Index As Integer)
|
|
' Position des MB | ist | Convertiette Position von | Position auf Bild
|
|
Dim rTemp As Rectangle = Me.ConvertToProgrammPosition(New Rectangle(Me.aMarks(Index).Left, Me.aMarks(Index).Top, Me.aMarks(Index).Width, Me.aMarks(Index).Height))
|
|
If (Me.MarkButtons_CheckPositionArguments(rTemp)) Then
|
|
If Not (aMarkButtons(Index).Position.GetHashCode = rTemp.GetHashCode) Then 'Bei Positionsänderung
|
|
Me.aMarkButtons(Index).Position = rTemp
|
|
Me.aMarkButtons(Index).Deleted = False
|
|
Me.aMarkButtons(Index).Visible = Me.bMarks_Visible
|
|
Me.ActivMark_EventSiceChanged()
|
|
End If
|
|
Else 'Zu Kleine Marks Werden nicht angezeigt
|
|
Me.aMarkButtons(Index).Deleted = True
|
|
End If
|
|
|
|
End Sub 'MarkButtons_ReSize
|
|
|
|
|
|
'###########################
|
|
'### Private Functions ###
|
|
'###########################
|
|
|
|
'Es werden Die Orginal Pixel des Pict hergenommen
|
|
Private Function ConvertToPicturePosition(ByVal ProgrammPosition As Rectangle) As Rectangle
|
|
Me.IMG_Update_PositionsParam()
|
|
Dim Result As New Rectangle
|
|
Result = Me.PositionOnIMG(ProgrammPosition) 'Schneide Lehren Raum Ab
|
|
Result.Left /= IMG_ScaleFactor 'Scaliere auf OrginalGröße
|
|
Result.Top /= IMG_ScaleFactor 'Scaliere auf OrginalGröße
|
|
Result.Width /= IMG_ScaleFactor 'Scaliere auf OrginalGröße
|
|
Result.Height /= IMG_ScaleFactor 'Scaliere auf OrginalGröße
|
|
Return Result
|
|
End Function 'ConvertToPicturePosition
|
|
|
|
Private Function ConvertToProgrammPosition(ByVal PicturePosition As Rectangle) As Rectangle
|
|
Me.IMG_Update_PositionsParam()
|
|
Dim Result As New Rectangle
|
|
Result = PicturePosition
|
|
Result.Left *= IMG_ScaleFactor 'Scaliere
|
|
Result.Top *= IMG_ScaleFactor 'Scaliere
|
|
Result.Width *= IMG_ScaleFactor 'Scaliere
|
|
Result.Height *= IMG_ScaleFactor 'Scaliere
|
|
Result.Left += Me.IMG_Position.Left 'Addire Lheren Raum Hinzu
|
|
Result.Top += Me.IMG_Position.Top 'Addire Lheren Raum Hinzu
|
|
Return Result
|
|
End Function 'ConvertToProgrammPosition
|
|
|
|
Private Function MarkButtons_CheckPositionArguments(ByVal Position As Rectangle) As Boolean
|
|
MarkButtons_CheckPositionArguments = False
|
|
If (Position.Width >= MinMarkOnProgrammSize) And (Position.Height >= MinMarkOnProgrammSize) Then MarkButtons_CheckPositionArguments = True
|
|
End Function 'MarkButtons_CheckPositionArguments
|
|
|
|
Private Function PositionOnIMG(ByVal Position As Rectangle) As Rectangle
|
|
|
|
Position.Left -= IMG_Position.Left
|
|
Position.Top -= IMG_Position.Top
|
|
If Position.Left > IMG_Position.Width Then Position.Left = IMG_Position.Width
|
|
If Position.Top > IMG_Position.Height Then Position.Top = IMG_Position.Height
|
|
If Position.PointB.X > IMG_Position.Width Then Position.Width = IMG_Position.Width - Position.Left
|
|
If Position.PointB.Y > IMG_Position.Height Then Position.Height = IMG_Position.Height - Position.Top
|
|
Return Position
|
|
|
|
End Function 'PositionOnBitmap
|
|
|
|
'##########################
|
|
'#### Handles Events ####
|
|
'##########################
|
|
|
|
Private Sub MarkButton_Click(ByVal sender As MarkButton, ByVal e As System.EventArgs)
|
|
Me.ActivMark_Update(sender.Index)
|
|
End Sub 'MarkButton_Click Handles aMarkButtons(i).Click
|
|
|
|
Private Sub MarkButton_LikeMove(ByVal sender As MarkButton)
|
|
Me.aMarkButtons(sender.Index).Visible = False
|
|
Dim Answer As Boolean = Me.MouseMode_Set("Move_Mark", New Mark(Me.aMarks(sender.Index).ID, Me.aMarks(sender.Index).Command, Me.aMarks(sender.Index).Left, Me.aMarks(sender.Index).Top, Me.aMarks(sender.Index).Width, Me.aMarks(sender.Index).Height, Me.aMarks(sender.Index).Name, Me.aMarks(sender.Index).Description))
|
|
If Debugging And Not Answer Then MsgBox(Convert.ToString(Answer))
|
|
End Sub 'MarkButton_LikeMove Handles aMarkButtons(i).LikeMove
|
|
|
|
Private Sub MarkButton_LikeSiceChange(ByVal sender As MarkButton)
|
|
Me.aMarkButtons(sender.Index).Visible = False
|
|
Dim Answer As Boolean = Me.MouseMode_Set("Change_Sice", New Mark(Me.aMarks(sender.Index).ID, Me.aMarks(sender.Index).Command, Me.aMarks(sender.Index).Left, Me.aMarks(sender.Index).Top, Me.aMarks(sender.Index).Width, Me.aMarks(sender.Index).Height, Me.aMarks(sender.Index).Name, Me.aMarks(sender.Index).Description))
|
|
If Debugging And Not Answer Then MsgBox(Convert.ToString(Answer))
|
|
End Sub 'MarkButton_LikeSiceChange Handles aMarkButtons(i).LikeSiceChange
|
|
|
|
Private Sub MarkButton_LikeDelete(ByVal sender As MarkButton)
|
|
Dim Answer As String = Me.Marks_Update(Me.aMarks(sender.Index).ID, "Delete", 0, 0, 0, 0, Nothing, Nothing)
|
|
If Debugging And Not Answer = "Success" Then MsgBox(Answer)
|
|
End Sub 'MarkButton_LikeDelete Handles aMarkButtons(i).LikeDelete
|
|
|
|
|
|
#End Region 'MarkButtons
|
|
|
|
|
|
'########################################################################################
|
|
'############################## Marks #################################################
|
|
'########################################################################################
|
|
#Region "Marks"
|
|
|
|
'######################
|
|
'### Declarations ###
|
|
'######################
|
|
'Variables
|
|
Private aMarks(SupportedMarks - 1) As Mark
|
|
|
|
'Events
|
|
Public Event PropertyMarks_VisibleChanged()
|
|
Public Event Marks_Changed()
|
|
|
|
|
|
'###################
|
|
'### Propertys ###
|
|
'###################
|
|
|
|
Private bMarks_Visible As Boolean
|
|
Public Property Marks_Visible() As Boolean
|
|
Get
|
|
Return bMarks_Visible
|
|
End Get
|
|
Set(ByVal value As Boolean)
|
|
If Not value = bMarks_Visible Then
|
|
Me.MarkButtons_Visible(value)
|
|
Me.Menu_Update()
|
|
RaiseEvent PropertyMarks_VisibleChanged()
|
|
End If
|
|
End Set
|
|
End Property
|
|
|
|
|
|
'######################
|
|
'### Private Subs ###
|
|
'######################
|
|
|
|
Private Sub Marks_Clear()
|
|
For i = 0 To (SupportedMarks - 1)
|
|
Me.aMarks(i).Clear()
|
|
Next
|
|
Me.bMarks_Visible = True
|
|
Me.MarkButtons_Update()
|
|
End Sub 'Marks_Clear
|
|
|
|
Private Sub Marks_Initial()
|
|
'Initial SupportedMarks
|
|
For i = 0 To (SupportedMarks - 1)
|
|
Me.aMarks(i) = New Mark
|
|
Next
|
|
Me.bMarks_Visible = True 'Benötigt wegen menü
|
|
End Sub 'Marks_Initial
|
|
|
|
|
|
'########################## <==<==<==<== ####################################
|
|
'### PUBLIC Functions ### <-<Beginn>-> ####################################
|
|
'########################## ==>==>==>==> ####################################
|
|
|
|
' #################
|
|
' ### InPut ==> ###
|
|
' #################
|
|
' {LineNR}, 0 ID | 1 Left | 2 Top | 3 Wight | 4 Heigth | 5 Name | 6 Description
|
|
|
|
'Single
|
|
Public Function Marks_Set(ByVal ID As String, ByVal Command As String, ByVal Left As Integer, ByVal Top As Integer, ByVal Width As Integer, ByVal Height As Integer, ByVal Name As String, ByVal Description As String) As Boolean
|
|
Marks_Set = False
|
|
Dim Answer As String = Marks_Update(ID, Command, Left, Top, Width, Height, Name, Description)
|
|
If (Answer = "Success") Or (Answer = "") Or (Answer = Nothing) Then Marks_Set = True Else If Debugging Then MsgBox(Answer)
|
|
End Function 'Marks_Set
|
|
|
|
Public Function Marks_Create(ByVal MarkID As String, Optional ByVal Left As Integer = -1, Optional ByVal Top As Integer = -1, Optional ByVal Width As Integer = -1, Optional ByVal Height As Integer = -1, Optional ByVal Name As String = "", Optional ByVal Description As String = "") As Boolean
|
|
Marks_Create = False
|
|
Dim Answer As String = ""
|
|
If (Left >= 0) Or (Top >= 0) Or (Width >= 0) Or (Height >= 0) Then
|
|
If Marks_CheckPositionArguments(New Rectangle(Left, Top, Width, Height)) Then
|
|
Answer = Marks_Update(MarkID, "Create", Left, Top, Width, Height, Name, Description)
|
|
If Answer = "Success" Then
|
|
Marks_Create = True
|
|
Else
|
|
If Debugging Then MsgBox(Answer)
|
|
End If
|
|
End If
|
|
Else
|
|
If Me.MouseMode_Set("Creat_New_Extern", New Mark(MarkID, "Create", Left, Top, Width, Height, Name, Description)) Then
|
|
Marks_Create = True
|
|
Else
|
|
If Debugging Then MsgBox("Can't set MouseMode")
|
|
End If
|
|
End If
|
|
End Function 'Marks_Create
|
|
|
|
'All
|
|
Public Function Marks_SetAll(ByVal value As Mark()) As Boolean
|
|
Marks_SetAll = False
|
|
Dim AnswerOfAll As String = ""
|
|
For Each M As Mark In value
|
|
Dim Answer As String = Marks_Update(M.ID, M.Command, M.Left, M.Top, M.Width, M.Height, M.Name, M.Description)
|
|
If Not Answer = "Success" Then AnswerOfAll &= "MarkID """ & M.ID & """: " & Answer & "; "
|
|
Next
|
|
If AnswerOfAll = "" Then Marks_SetAll = True Else If Debugging Then MsgBox(AnswerOfAll)
|
|
End Function 'Marks_SetAll
|
|
|
|
' ##################
|
|
' ### <== OutPut ###
|
|
' ##################
|
|
|
|
'Single
|
|
Public Function Marks_Get(ByVal MarkID As String) As Mark
|
|
Dim Index = Me.Marks_IndexOf(MarkID)
|
|
Dim Result As New Mark
|
|
If Index >= 0 Then Result = Me.aMarks(Index)
|
|
Return Result
|
|
End Function 'Marks_Get
|
|
|
|
'All
|
|
Public Function Marks_GetAll() As Mark()
|
|
Dim nEntrys As Integer = Marks_IndexOf_LastLine()
|
|
Dim Result(nEntrys) As Mark
|
|
|
|
If nEntrys >= 0 Then
|
|
For i = 0 To nEntrys
|
|
Result(i) = aMarks(i)
|
|
Next
|
|
End If
|
|
|
|
Return Result
|
|
End Function 'Marks_GetAll
|
|
|
|
'########################## <==<==<== ####################################
|
|
'########################## <-<End>-> ####################################
|
|
'########################## ==>==>==> ####################################
|
|
|
|
|
|
'###########################
|
|
'### Private Functions ###
|
|
'###########################
|
|
|
|
Private Function Marks_Update(ByVal MarkID As String, ByVal Command As String, ByVal Left As Integer, ByVal Top As Integer, ByVal Width As Integer, ByVal Height As Integer, Optional ByVal Name As String = "", Optional ByVal Description As String = "") As String
|
|
'Initial
|
|
Marks_Update = "Success"
|
|
|
|
Dim Index As Integer = Me.Marks_IndexOf(MarkID)
|
|
If Index < 0 Then 'ID Existiert nicht
|
|
Select Case Command
|
|
Case "Nothing"
|
|
Marks_Update = Me.Marks_LineAdd(MarkID, "Nothing", Left, Top, Width, Height, Name, Description)
|
|
|
|
Case "Change"
|
|
Marks_Update = "Error: ID_Not_Exist"
|
|
|
|
Case "Create"
|
|
Marks_Update = Me.Marks_LineAdd(MarkID, "Create", Left, Top, Width, Height, Name, Description)
|
|
RaiseEvent Marks_Changed()
|
|
|
|
Case "Delete"
|
|
Marks_Update = "Error: ID_Not_Exist"
|
|
|
|
Case Else
|
|
Marks_Update = "Error: Unknown_Command"
|
|
|
|
End Select
|
|
Else
|
|
'If Name = Nothing Then Name = aMarks(Index).Name
|
|
'If Description = Nothing Then Description = aMarks(Index).Description
|
|
Select Case Command
|
|
Case "Nothing"
|
|
Marks_Update = "Error: ID_Already_Exist"
|
|
|
|
Case "Change", "Create"
|
|
Select Case Me.aMarks(Index).Command
|
|
Case "Create"
|
|
Marks_Update = Me.Marks_LineUpdate(MarkID, "Create", Left, Top, Width, Height, Name, Description)
|
|
RaiseEvent Marks_Changed()
|
|
|
|
Case Else 'Case "Nothing", "Change", "Delete"
|
|
Marks_Update = Me.Marks_LineUpdate(MarkID, "Change", Left, Top, Width, Height, Name, Description)
|
|
RaiseEvent Marks_Changed()
|
|
|
|
End Select
|
|
|
|
Case "Delete"
|
|
Select Case Me.aMarks(Index).Command
|
|
Case "Create"
|
|
Marks_Update = Me.Marks_LineDelete(MarkID)
|
|
RaiseEvent Marks_Changed()
|
|
|
|
Case Else 'Case "Nothing", "Change", "Delete"
|
|
Marks_Update = Me.Marks_LineUpdate(MarkID, "Delete", 0, 0, 0, 0, Nothing, Nothing)
|
|
RaiseEvent Marks_Changed()
|
|
|
|
End Select
|
|
|
|
Case Else
|
|
Marks_Update = "Error: Unknown_Command"
|
|
|
|
End Select
|
|
End If
|
|
|
|
'If Marks_Update = "Error: No_Free_Line_In_Array" Then MsgBox("Only " & Convert.ToString(SupportedMarks / 2) & " Marks and " & Convert.ToString(SupportedMarks) & " Changes are Supported!")
|
|
End Function 'Marks_LineUpdate ### Add or Update a Line ###
|
|
'-> "Success" | "Error: ID_Not_Exist" | "Error: ID_Already_Exist" | "Error: No_Free_Line_In_Array" | "Error: Unknown_Command"
|
|
|
|
Private Function Marks_LineAdd(ByVal MarkID As String, ByVal Command As String, ByVal Left As Integer, ByVal Top As Integer, ByVal Width As Integer, ByVal Height As Integer, ByVal Name As String, ByVal Description As String) As String
|
|
Marks_LineAdd = "Success"
|
|
Dim Index As Integer = Marks_IndexOf_LastLine() + 1
|
|
If (Index < 0) Or (Index > (SupportedMarks - 1)) Then Return "Error: No_Free_Line_In_Array"
|
|
If Me.Marks_CheckFreeCommandLines(Command) Then
|
|
|
|
Me.aMarks(Index).ID = MarkID
|
|
Me.aMarks(Index).Command = Command
|
|
Me.aMarks(Index).Left = Left
|
|
Me.aMarks(Index).Top = Top
|
|
Me.aMarks(Index).Width = Width
|
|
Me.aMarks(Index).Height = Height
|
|
Me.aMarks(Index).Name = Name
|
|
Me.aMarks(Index).Description = Description
|
|
Me.MarkButtons_Update(Index)
|
|
|
|
Else
|
|
Return "Error: No_Free_Line_In_Array"
|
|
End If
|
|
End Function 'Marks_LineAdd
|
|
|
|
Private Function Marks_LineDelete(ByVal MarkID As String) As String
|
|
Marks_LineDelete = "Success"
|
|
Dim Index As Integer = Me.Marks_IndexOf(MarkID)
|
|
Dim IndexLastLine As Integer = Me.Marks_IndexOf_LastLine()
|
|
If (Index < 0) Or (Index > IndexLastLine) Then Return "Error: ID_Not_Exist"
|
|
|
|
Me.aMarks(Index).ID = Me.aMarks(IndexLastLine).ID
|
|
Me.aMarks(Index).Command = Me.aMarks(IndexLastLine).Command
|
|
Me.aMarks(Index).Left = Me.aMarks(IndexLastLine).Left
|
|
Me.aMarks(Index).Top = Me.aMarks(IndexLastLine).Top
|
|
Me.aMarks(Index).Width = Me.aMarks(IndexLastLine).Width
|
|
Me.aMarks(Index).Height = Me.aMarks(IndexLastLine).Height
|
|
Me.aMarks(Index).Name = Me.aMarks(IndexLastLine).Name
|
|
Me.aMarks(Index).Description = Me.aMarks(IndexLastLine).Description
|
|
|
|
Me.aMarks(IndexLastLine).Clear()
|
|
Me.MarkButtons_Update(Index)
|
|
Me.MarkButtons_Update(IndexLastLine)
|
|
If Me.nActivMarkIndex = Index Then Me.ActivMark_Update(-1)
|
|
End Function 'Marks_LineDelete
|
|
|
|
Private Function Marks_LineUpdate(ByVal MarkID As String, ByVal Command As String, ByVal Left As Integer, ByVal Top As Integer, ByVal Width As Integer, ByVal Height As Integer, ByVal Name As String, ByVal Description As String) As String
|
|
Marks_LineUpdate = "Success"
|
|
Dim Index As Integer = Marks_IndexOf(MarkID)
|
|
If (Index < 0) Or (Index > (SupportedMarks - 1)) Then Return "Error: ID_Not_Exist"
|
|
If Not Me.Marks_IsCommandActiv(Me.aMarks(Index).Command) = Me.Marks_IsCommandActiv(Command) Then
|
|
If Not Me.Marks_CheckFreeCommandLines(Command) Then
|
|
Return "Error: No_Free_Line_In_Array"
|
|
End If
|
|
End If
|
|
Me.aMarks(Index).ID = MarkID
|
|
Me.aMarks(Index).Command = Command
|
|
Me.aMarks(Index).Left = Left
|
|
Me.aMarks(Index).Top = Top
|
|
Me.aMarks(Index).Width = Width
|
|
Me.aMarks(Index).Height = Height
|
|
Me.aMarks(Index).Name = Name
|
|
Me.aMarks(Index).Description = Description
|
|
Me.MarkButtons_Update(Index)
|
|
End Function 'Marks_LineUpdate
|
|
|
|
|
|
Private Function Marks_CheckFreeCommandLines(ByVal Command As String) As Boolean
|
|
Marks_CheckFreeCommandLines = False
|
|
Dim nType As Integer = Me.Marks_IsCommandActiv(Command)
|
|
Dim nCounter As Integer = 0
|
|
For i = 0 To (SupportedMarks - 1)
|
|
If nType = Me.Marks_IsCommandActiv(Me.aMarks(i).Command) Then nCounter += 1
|
|
Next
|
|
If nCounter <= ((SupportedMarks / 2) - 1) Then Marks_CheckFreeCommandLines = True
|
|
End Function
|
|
|
|
Private Function Marks_IndexOf(ByRef MarkID As String) As Integer
|
|
Marks_IndexOf = -1 'Nicht Vorhanden
|
|
For i = 0 To (SupportedMarks - 1)
|
|
If aMarks(i).ID = MarkID Then
|
|
Marks_IndexOf = i
|
|
Exit For
|
|
End If
|
|
Next
|
|
End Function 'Marks_IndexOf ### Serch ID in MarkArray, If it exists return Index ELSE return "-1" ###
|
|
|
|
Private Function Marks_IndexOf_LastLine() As Integer
|
|
Marks_IndexOf_LastLine = (SupportedMarks - 1)
|
|
For i = 0 To (SupportedMarks - 1)
|
|
If aMarks(i).ID = "" Or Nothing Then
|
|
Marks_IndexOf_LastLine = i - 1
|
|
Exit For
|
|
End If
|
|
Next
|
|
End Function 'Marks_IndexOf_LastActivLine ### Serch The Array vor the Last-> -1 = Alles Frei; 0 to 198 = Belegt Und Min 1 Frei; 199 = Alles Foll ###
|
|
|
|
Private Function Marks_IsCommandActiv(ByVal Command As String) As Integer
|
|
Marks_IsCommandActiv = -1
|
|
Select Case Command
|
|
Case "Delete"
|
|
Marks_IsCommandActiv = 0
|
|
|
|
Case "Nothing", "Change", "Create"
|
|
Marks_IsCommandActiv = 1
|
|
|
|
End Select
|
|
End Function 'Marks_IsCommandActiv ### 0 = Delete | 1 = ActivComand | -1 = Error
|
|
|
|
Private Function Marks_CheckPositionArguments(ByVal Position As Rectangle) As Boolean
|
|
Marks_CheckPositionArguments = False
|
|
If (Position.Left >= MinMarkLateralDistanceOnPicture) And (Position.Top >= MinMarkLateralDistanceOnPicture) And (Position.Width >= MinMarkOnPictureSize) And (Position.Height >= MinMarkOnPictureSize) Then Marks_CheckPositionArguments = True
|
|
End Function 'Marks_CheckPositionArguments
|
|
|
|
Private Function Marks_DeleteAll()
|
|
Marks_DeleteAll = ""
|
|
Dim counter As Integer
|
|
If Me.Marks_IndexOf_LastLine >= 0 Then
|
|
If Microsoft.VisualBasic.MsgBoxResult.Yes = MsgBox("Alle Markierungen LÖSCHEN?", MsgBoxStyle.YesNo, Me.Text) Then
|
|
For i = 0 To Me.Marks_IndexOf_LastLine
|
|
counter = SupportedMarks
|
|
Do While Not (Me.aMarks(i).ID = "") Or Not (Me.aMarks(i).ID = Nothing) And (Me.Marks_IsCommandActiv(Me.aMarks(i).Command) = 1) And (counter > 0)
|
|
Dim Answer As String = Me.Marks_Update(Me.aMarks(i).ID, "Delete", 0, 0, 0, 0, Nothing, Nothing)
|
|
If Not Answer = "Success" Then Marks_DeleteAll &= "MarkID """ & Me.aMarks(i).ID & """: " & Answer & "; "
|
|
counter -= 1
|
|
Loop
|
|
Next
|
|
End If
|
|
End If
|
|
If Marks_DeleteAll = "" Then Marks_DeleteAll = "Success"
|
|
End Function 'Marks_DeleteAll
|
|
|
|
#End Region 'Marks
|
|
|
|
|
|
'########################################################################################
|
|
'############################## ContextMenuStrip ######################################
|
|
'########################################################################################
|
|
#Region "ContextMenuStrip"
|
|
|
|
'######################
|
|
'### Declarations ###
|
|
'######################
|
|
'Variables
|
|
|
|
'Objects
|
|
|
|
Friend WithEvents oMenu_Main As System.Windows.Forms.ContextMenuStrip 'Beinhaltet die Einträge
|
|
Friend WithEvents oMenu_NewMarks As System.Windows.Forms.ToolStripMenuItem 'Neue Markierung
|
|
Friend WithEvents oMenu_HideMarks As System.Windows.Forms.ToolStripMenuItem 'Verstecke/Zeige Markierungen
|
|
Friend WithEvents oMenu_DelAllMarks As System.Windows.Forms.ToolStripMenuItem 'Lösche Markierungen
|
|
|
|
|
|
'###################
|
|
'### Public Sub ###
|
|
'###################
|
|
|
|
Private Sub Menu_Initial()
|
|
|
|
Me.oMenu_Main = New System.Windows.Forms.ContextMenuStrip
|
|
Me.oMenu_NewMarks = New System.Windows.Forms.ToolStripMenuItem
|
|
Me.oMenu_HideMarks = New System.Windows.Forms.ToolStripMenuItem
|
|
Me.oMenu_DelAllMarks = New System.Windows.Forms.ToolStripMenuItem
|
|
|
|
'
|
|
'Main
|
|
'
|
|
Me.oMenu_Main.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.oMenu_NewMarks, Me.oMenu_HideMarks, Me.oMenu_DelAllMarks})
|
|
Me.oMenu_Main.Name = "oMenu_Main"
|
|
Me.oMenu_Main.Size = New System.Drawing.Size(202, 70)
|
|
|
|
'
|
|
'oMenu_NewMarks
|
|
'
|
|
Me.oMenu_NewMarks.Name = "oMenu_NewMarks"
|
|
Me.oMenu_NewMarks.Size = New System.Drawing.Size(201, 22)
|
|
Me.oMenu_NewMarks.Text = "Neue Markierung"
|
|
AddHandler Me.oMenu_NewMarks.Click, AddressOf oMenu_NewMarks_Click
|
|
|
|
'
|
|
'oMenu_HideMarks
|
|
'
|
|
Me.oMenu_HideMarks.Name = "oMenu_HideMarks"
|
|
Me.oMenu_HideMarks.Size = New System.Drawing.Size(201, 22)
|
|
Me.oMenu_HideMarks.Text = "Verstecke Markierungen"
|
|
Me.Menu_Update()
|
|
AddHandler Me.oMenu_HideMarks.Click, AddressOf oMenu_HideMarks_Click
|
|
|
|
'
|
|
'oMenu_DelAllMarks
|
|
'
|
|
Me.oMenu_DelAllMarks.Name = "oMenu_DelAllMarks"
|
|
Me.oMenu_DelAllMarks.Size = New System.Drawing.Size(201, 22)
|
|
Me.oMenu_DelAllMarks.Text = "Lösche Markierungen"
|
|
AddHandler Me.oMenu_DelAllMarks.Click, AddressOf oMenu_DelAllMarks_Click
|
|
|
|
|
|
Me.ContextMenuStrip = Me.oMenu_Main
|
|
|
|
End Sub 'Menu_Initial
|
|
|
|
Private Sub Menu_Update()
|
|
If bMarks_Visible Then
|
|
Me.oMenu_HideMarks.Text = "Verstecke Markierungen"
|
|
Else
|
|
Me.oMenu_HideMarks.Text = "Zeige Markierungen"
|
|
End If
|
|
End Sub 'Menu_Update
|
|
|
|
'##########################
|
|
'#### Handles Events ####
|
|
'##########################
|
|
|
|
|
|
Private Sub oMenu_NewMarks_Click()
|
|
Me.MouseMode_Set("Creat_New_Intern", New Mark)
|
|
End Sub 'oMenu_NewMarks_Click
|
|
|
|
Private Sub oMenu_HideMarks_Click()
|
|
Me.Marks_Visible = Not Me.Marks_Visible
|
|
End Sub 'oHideMarks_Click
|
|
|
|
Private Sub oMenu_DelAllMarks_Click()
|
|
Dim Answer As String = Me.Marks_DeleteAll
|
|
If Debugging And Not Answer = "Success" Then MsgBox(Answer)
|
|
End Sub 'oMenu_DelAllMarks_Click
|
|
|
|
|
|
#End Region 'ContextMenuStrip
|
|
|
|
|
|
'########################################################################################
|
|
'############################## ActivMark #############################################
|
|
'########################################################################################
|
|
#Region "ActivMark"
|
|
'Propertys ---, Events, Update (Click on Buton Activate - Click on IMG Deactivate)
|
|
|
|
'#################
|
|
'### Declare ###
|
|
'#################
|
|
|
|
'Events
|
|
Public Event ActivMarkChanged(ByVal arg As Boolean) 'When new is Activ or it is Deactivated
|
|
Public Event ActivMarkTaggChanged() 'Name & Description
|
|
Public Event ActivMarkPositionChanged() 'Position = Left or Top or Width or Height
|
|
Public Event ActivMarkNameChanged() 'Name
|
|
Public Event ActivMarkDescriptionChanged() 'Description
|
|
Public Event ActivMarkLeftChanged() 'Left
|
|
Public Event ActivMarkTopChanged() 'Top
|
|
Public Event ActivMarkWidthChanged() 'Width
|
|
Public Event ActivMarkHeightChanged() 'Height
|
|
|
|
|
|
'Variablen
|
|
Private nActivMarkIndex As Integer
|
|
|
|
|
|
'##################
|
|
'### Property ###
|
|
'##################
|
|
'Me.Marks_Update(Me.aMarks(nActivMarkIndex).ID, Me.aMarks(nActivMarkIndex).Command, Me.aMarks(nActivMarkIndex).Left, Me.aMarks(nActivMarkIndex).Top, Me.aMarks(nActivMarkIndex).Width, Me.aMarks(nActivMarkIndex).Height, Me.aMarks(nActivMarkIndex).Name, Me.aMarks(nActivMarkIndex).Description)
|
|
|
|
Public Property ActivMark As Boolean
|
|
Get
|
|
Return Me.ActivMark_Enabled()
|
|
End Get
|
|
Set(ByVal value As Boolean)
|
|
If Me.ActivMark_Enabled() Then Me.ActivMark_LuseFokus()
|
|
End Set
|
|
End Property 'ActivMark: Get-> Return Mode | Set-> Only Act when value = False -> Clear()
|
|
|
|
Public ReadOnly Property ActivMarkID As String
|
|
Get
|
|
If ActivMark_Enabled() Then
|
|
Return Me.aMarks(nActivMarkIndex).ID
|
|
Else
|
|
Return ""
|
|
End If
|
|
End Get
|
|
''Set(ByVal value As String)
|
|
'' If bActivMark And (Me.nActivMarkIndex >= 0) Then
|
|
'' If Not (Me.aMarks(nActivMarkIndex).ID = value) Then
|
|
|
|
'' 'Creat new witch new ID and Old Position & Tagg
|
|
'' 'Del onld wich old ID
|
|
|
|
'' Me.aMarks(nActivMarkIndex).ID = value
|
|
'' RaiseEvent ActivMarkChanged(ActivMark_Enabled())
|
|
'' End If
|
|
'' End If
|
|
''End Set
|
|
End Property 'RO ActivMarkID <--- Jet RO, In the future RW
|
|
|
|
Public ReadOnly Property ActivMarkCommand As String
|
|
Get
|
|
If ActivMark_Enabled() Then
|
|
Return Me.aMarks(nActivMarkIndex).Command
|
|
Else
|
|
Return ""
|
|
End If
|
|
End Get
|
|
End Property 'RO ActivMarkCommand
|
|
|
|
Public Property ActivMarkLeft() As Integer
|
|
Get
|
|
If ActivMark_Enabled() Then
|
|
Return Me.aMarks(nActivMarkIndex).Left
|
|
Else
|
|
Return -1
|
|
End If
|
|
End Get
|
|
Set(ByVal value As Integer)
|
|
If ActivMark_Enabled() Then
|
|
If (value >= 0) And Not (Me.aMarks(nActivMarkIndex).Left = value) Then
|
|
Dim Answer As String = Me.Marks_Update(Me.aMarks(nActivMarkIndex).ID, "Change", value, Me.aMarks(nActivMarkIndex).Top, Me.aMarks(nActivMarkIndex).Width, Me.aMarks(nActivMarkIndex).Height, Me.aMarks(nActivMarkIndex).Name, Me.aMarks(nActivMarkIndex).Description)
|
|
If Debugging And Not Answer = "Success" Then MsgBox(Answer)
|
|
RaiseEvent ActivMarkLeftChanged()
|
|
RaiseEvent ActivMarkPositionChanged()
|
|
End If
|
|
End If
|
|
End Set
|
|
End Property 'ActivMarkLeft
|
|
|
|
Public Property ActivMarkTop() As Integer
|
|
Get
|
|
If ActivMark_Enabled() Then
|
|
Return Me.aMarks(nActivMarkIndex).Top
|
|
Else
|
|
Return -1
|
|
End If
|
|
End Get
|
|
Set(ByVal value As Integer)
|
|
If ActivMark_Enabled() Then
|
|
If (value >= 0) And Not (Me.aMarks(nActivMarkIndex).Top = value) Then
|
|
Dim Answer As String = Me.Marks_Update(Me.aMarks(nActivMarkIndex).ID, "Change", Me.aMarks(nActivMarkIndex).Left, value, Me.aMarks(nActivMarkIndex).Width, Me.aMarks(nActivMarkIndex).Height, Me.aMarks(nActivMarkIndex).Name, Me.aMarks(nActivMarkIndex).Description)
|
|
If Debugging And Not Answer = "Success" Then MsgBox(Answer)
|
|
RaiseEvent ActivMarkTopChanged()
|
|
RaiseEvent ActivMarkPositionChanged()
|
|
End If
|
|
End If
|
|
End Set
|
|
End Property 'ActivMarkTop
|
|
|
|
Public Property ActivMarkWidth() As Integer
|
|
Get
|
|
If ActivMark_Enabled() Then
|
|
Return Me.aMarks(nActivMarkIndex).Width
|
|
Else
|
|
Return -1
|
|
End If
|
|
End Get
|
|
Set(ByVal value As Integer)
|
|
If ActivMark_Enabled() Then
|
|
If (value >= 0) And Not (Me.aMarks(nActivMarkIndex).Width = value) Then
|
|
Dim Answer As String = Me.Marks_Update(Me.aMarks(nActivMarkIndex).ID, "Change", Me.aMarks(nActivMarkIndex).Left, Me.aMarks(nActivMarkIndex).Top, value, Me.aMarks(nActivMarkIndex).Height, Me.aMarks(nActivMarkIndex).Name, Me.aMarks(nActivMarkIndex).Description)
|
|
If Debugging And Not Answer = "Success" Then MsgBox(Answer)
|
|
RaiseEvent ActivMarkWidthChanged()
|
|
RaiseEvent ActivMarkPositionChanged()
|
|
End If
|
|
End If
|
|
End Set
|
|
End Property ' ActivMarkWidth
|
|
|
|
Public Property ActivMarkHeight() As Integer
|
|
Get
|
|
If ActivMark_Enabled() Then
|
|
Return Me.aMarks(nActivMarkIndex).Height
|
|
Else
|
|
Return -1
|
|
End If
|
|
End Get
|
|
Set(ByVal value As Integer)
|
|
If ActivMark_Enabled() Then
|
|
If (value >= 0) And Not (Me.aMarks(nActivMarkIndex).Height = value) Then
|
|
Dim Answer As String = Me.Marks_Update(Me.aMarks(nActivMarkIndex).ID, "Change", Me.aMarks(nActivMarkIndex).Left, Me.aMarks(nActivMarkIndex).Top, Me.aMarks(nActivMarkIndex).Width, value, Me.aMarks(nActivMarkIndex).Name, Me.aMarks(nActivMarkIndex).Description)
|
|
If Debugging And Not Answer = "Success" Then MsgBox(Answer)
|
|
RaiseEvent ActivMarkHeightChanged()
|
|
RaiseEvent ActivMarkPositionChanged()
|
|
End If
|
|
End If
|
|
End Set
|
|
End Property 'ActivMarkHeight
|
|
|
|
Public Property ActivMarkName As String
|
|
Get
|
|
If ActivMark_Enabled() Then
|
|
Return Me.aMarks(nActivMarkIndex).Name
|
|
Else
|
|
Return ""
|
|
End If
|
|
End Get
|
|
Set(ByVal value As String)
|
|
If ActivMark_Enabled() Then
|
|
If Not (Me.aMarks(nActivMarkIndex).Name = value) Then
|
|
Dim Answer As String = Me.Marks_Update(Me.aMarks(nActivMarkIndex).ID, "Change", Me.aMarks(nActivMarkIndex).Left, Me.aMarks(nActivMarkIndex).Top, Me.aMarks(nActivMarkIndex).Width, Me.aMarks(nActivMarkIndex).Height, value, Me.aMarks(nActivMarkIndex).Description)
|
|
If Debugging And Not Answer = "Success" Then MsgBox(Answer)
|
|
RaiseEvent ActivMarkNameChanged()
|
|
RaiseEvent ActivMarkTaggChanged()
|
|
End If
|
|
End If
|
|
End Set
|
|
End Property 'ActivMarkName
|
|
|
|
Public Property ActivMarkDescription As String
|
|
Get
|
|
If ActivMark_Enabled() Then
|
|
Return Me.aMarks(nActivMarkIndex).Description
|
|
Else
|
|
Return ""
|
|
End If
|
|
End Get
|
|
Set(ByVal value As String)
|
|
If ActivMark_Enabled() Then
|
|
If Not (Me.aMarks(nActivMarkIndex).Description = value) Then
|
|
Dim Answer As String = Me.Marks_Update(Me.aMarks(nActivMarkIndex).ID, "Change", Me.aMarks(nActivMarkIndex).Left, Me.aMarks(nActivMarkIndex).Top, Me.aMarks(nActivMarkIndex).Width, Me.aMarks(nActivMarkIndex).Height, Me.aMarks(nActivMarkIndex).Name, value)
|
|
If Debugging And Not Answer = "Success" Then MsgBox(Answer)
|
|
RaiseEvent ActivMarkDescriptionChanged()
|
|
RaiseEvent ActivMarkTaggChanged()
|
|
End If
|
|
End If
|
|
End Set
|
|
End Property 'ActivMarkDescription
|
|
|
|
|
|
'######################
|
|
'### Private Subs ###
|
|
'######################
|
|
|
|
Private Sub ActivMark_Clear()
|
|
Me.ActivMark_Update()
|
|
End Sub 'ActivMark_Clear
|
|
|
|
Private Sub ActivMark_Update(Optional ByVal Index As Integer = -1)
|
|
Me.nActivMarkIndex = Index
|
|
Dim btmp = Me.ActivMark_Enabled
|
|
RaiseEvent ActivMarkChanged(btmp)
|
|
End Sub 'ActivMark_Update
|
|
|
|
Private Sub ActivMark_EventSiceChanged()
|
|
RaiseEvent ActivMarkPositionChanged()
|
|
End Sub
|
|
|
|
|
|
'###########################
|
|
'### Private Functions ###
|
|
'###########################
|
|
|
|
Private Function ActivMark_Enabled()
|
|
ActivMark_Enabled = False
|
|
If nActivMarkIndex >= 0 Then ActivMark_Enabled = True
|
|
End Function 'ActivMark_Enabled ### Return True If any ActivMark is Enabled ###
|
|
|
|
|
|
'########################
|
|
'### Handles Events ###
|
|
'########################
|
|
|
|
Private Sub ActivMark_LuseFokus() Handles Me.Click
|
|
ActivMark_Update(-1)
|
|
End Sub 'ActivMark_LuseFokus ### Handles Me.Click
|
|
|
|
|
|
#End Region 'ActivMark
|
|
|
|
|
|
End Class 'TaggedIMG
|
|
'######################################################################################## |