<?xml version="1.0" encoding="utf-16" standalone="yes"?>
<!--Created: 09.07.2015 11:45:38-->
<!--ACTOptimumVersion: 6.0.5581.26549-->
<AutoDataItems ACTOptimumVersion="6.0.5581.26549" Created="09.07.2015 11:45:38">
    <AutoDataControl Created="09.07.2015 11:45:38" ClassName="Melville_Schellmann.ACTOptimum3.Control.AutoData3.AutoData3" PrefClassVersion="1.0" ACTOptimumVersion="6.0.5581.26549">
        <Source>' #ScriptName: ImageResizer
    ' #Description: DEUTSCH:
    '               Ermöglicht die Einbettung einer Bilddatei in ein Act!-Bildfeld. Dabei ermittelt es die Bildgröße und skaliert das Bild (nur nach unten) auf die Rahmengröße des Act!-Bildfeldes.
    '               
    '               ENGLISH:
    '               Allows you to embed an image file into an Act! picture field. It determines the image size and scales the image (only downward) on the frame size of the Act! picture field.
    ' #Copyright: © 2011 by Melville-Schellmann
    ' #Author: Robert Schellmann, rs@melville-schellmann.de
    ' #Version: 1.0 (07.04.2011) 
    
    ' Deutsch: Die folgenden Feldnamen zwischen den Anführungszeichen müssen an die jeweilige Datenbank angepasst bzw. die Felder in der Datenbank erstellt werden.
    ' English: The following field names between the quotation marks must be adapted to the particular database or creates the fields in the database.
    
 
    
    Dim sFieldNameImage As String = "Bild01"
    Dim oTargetSize As New Drawing.Size(300, 300)
    Dim oDefaultBackroundColor As Drawing.Color = Drawing.Color.White

    '#################################################################### ab hier bitte keine Änderungen machen / from here please do not make changes

    Dim sScriptName As String = "ImageResizer"
    Dim oCurrentEntity As Act.Framework.MutableEntities.MutableEntity = Nothing
    Dim oCurrentLookup As Act.Framework.MutableEntities.MutableEntityList = Nothing
    Dim oFieldDescriptors() As Act.Framework.MutableEntities.MutableEntityFieldDescriptor = Nothing
    Dim oFieldImage As Act.Framework.MutableEntities.MutableEntityFieldDescriptor
    Dim oCurrentImage As Drawing.Image
    'Dim oTargetImage As Drawing.Image
    Dim oResizedImage As Drawing.Image

    Dim oDialog As OpenFileDialog
    'Dim oTargetGraphics As Drawing.Graphics
    Dim sCopyrightText As String = "© {0} by Melville-Schellmann"

    'ACTApp.Cursor = Cursors.WaitCursor
    'ACTApp.ExecuteCommand("act-ui://com.act/application/menu/view/refresh")
    'System.Windows.Forms.Application.DoEvents()
    'ACTApp.Cursor = Cursors.Default


    ' Überprüfe aktuelle ACT!-Ansicht
    If TypeOf ACTApp.CurrentView Is Act.UI.IContactDetailView Then
      oCurrentLookup = ACTApp.ApplicationState.CurrentContactList
      oFieldDescriptors = ACTApp.ActFramework.Contacts.GetMutableEntityFieldDescriptors
      oCurrentEntity = ACTApp.ApplicationState.CurrentContact
    End If
    If TypeOf ACTApp.CurrentView Is Act.UI.ICompanyDetailView Then
      oCurrentLookup = ACTApp.ApplicationState.CurrentCompanyList
      oFieldDescriptors = ACTApp.ActFramework.Companies.GetMutableEntityFieldDescriptors
      oCurrentEntity = ACTApp.ApplicationState.CurrentCompany
    End If
    If TypeOf ACTApp.CurrentView Is Act.UI.IGroupDetailView Then
      oCurrentLookup = ACTApp.ApplicationState.CurrentGroupList
      oFieldDescriptors = ACTApp.ActFramework.Groups.GetMutableEntityFieldDescriptors
      oCurrentEntity = ACTApp.ApplicationState.CurrentGroup
    End If
    If TypeOf ACTApp.CurrentView Is Act.UI.IOpportunityDetailView Then
      oCurrentLookup = ACTApp.ApplicationState.CurrentOpportunities
      oFieldDescriptors = ACTApp.ActFramework.Opportunities.GetMutableEntityFieldDescriptors
      oCurrentEntity = ACTApp.ApplicationState.CurrentOpportunity
    End If
    If oCurrentLookup Is Nothing Or oFieldDescriptors Is Nothing Then
      MsgBox("Falsche ACT!-Ansicht.", MsgBoxStyle.Information, sScriptName)
      GoTo Abbruch
    End If
    ' Überprüfe Feldnamen

    If Not FieldExist(sFieldNameImage, oFieldDescriptors, "sFieldNameImage") Then
      GoTo Abbruch
    End If
    oFieldImage = oFieldDescriptors(GetFieldIndex(sFieldNameImage, oFieldDescriptors))
    If oFieldImage.ACTFieldType &lt;&gt; Act.Framework.Database.FieldDataType.Picture Then
      MsgBox(String.Format("Das Feld '{0}' ist kein Bildfeld", sFieldNameImage), MsgBoxStyle.Information, sScriptName)
      GoTo Abbruch
    End If
    'oCurrentImage = TryCast(oFieldImage.GetValue(oCurrentEntity), Drawing.Image)
    'If oCurrentImage Is Nothing Then
    oDialog = New OpenFileDialog
    oDialog.Filter = "Alle Bilddateien (*.bmp,*.gif,*.jpg,*.png,*ico,*.emf,*.wmf)|*.bmp;*.gif;*.jpg;*.png;*ico;*.emf;*.wmf"
    oDialog.Title = "Bildauswahl"
    oDialog.Multiselect = False
    If (oDialog.ShowDialog = DialogResult.OK) Then
      oCurrentImage = Drawing.Image.FromFile(oDialog.FileName)
    Else
      GoTo Abbruch
    End If

    '    End If
    'oTargetImage = New Drawing.Bitmap(oTargetSize.Width, oTargetSize.Height)
    'oTargetGraphics = Drawing.Graphics.FromImage(oTargetImage)
    'oTargetGraphics.Clear(oDefaultBackroundColor)
    sCopyrightText = String.Format(sCopyrightText, IO.File.GetCreationTime(oDialog.FileName).Year)
    sCopyrightText = InputBox("Copyrighttext:", sScriptName, sCopyrightText)
    oResizedImage = ResizeImage(oCurrentImage, oTargetSize, sCopyrightText)

    oFieldImage.SetValue(oCurrentEntity, oResizedImage)
    oCurrentEntity.Update()

    ACTApp.Cursor = Cursors.WaitCursor
    ACTApp.ExecuteCommand("act-ui://com.act/application/menu/view/refresh")
    System.Windows.Forms.Application.DoEvents()
    ACTApp.Cursor = Cursors.Default

    Abbruch:
    Return String.Empty

  End Function
  Private Shared Function ResizeImage(ByVal oImage As Drawing.Image, ByVal oSize As Drawing.Size, ByVal sCopyrightText As String) As Drawing.Image

    Dim oOrgBitmap As Drawing.Bitmap
    Dim oNewBitmap As Drawing.Bitmap
    'Dim oMemoryStream As IO.MemoryStream
    'Dim aBytes() As Byte

    Dim oNewGraphics As Drawing.Graphics
    Dim divideBy, divideByH, divideByW As Double
    Dim lNewWidth As Integer
    Dim lNewHeight As Integer

    oOrgBitmap = New Drawing.Bitmap(oImage)

    divideByW = oOrgBitmap.Width / oSize.Width
    divideByH = oOrgBitmap.Height / oSize.Height
    If divideByW &gt; 1 Or divideByH &gt; 1 Then
      'OrgImage ist in der Höhe oder Breite größer als das TargetImage
      If divideByW &gt; divideByH Then
        ' OrgImage ist in der Breite gößer als das das Zielbild und
        ' das Verhältnis zwichen den Breiten ist größer als zwischen den Höhen
        divideBy = divideByW
        ' Das Breitenverhältnis gibt den Skalierungsfaktor vor 
      Else
        ' Das Höhenverhältnis gibt den Skalierungsfaktor vor 
        divideBy = divideByH
      End If
      ' Neue Bitmap in der runterskalierten Größe erstellen
      lNewWidth = CInt(CDbl(oOrgBitmap.Width) / divideBy)
      lNewHeight = CInt(CDbl(oOrgBitmap.Height) / divideBy)
    Else
      ' OrgImage ist kleiner als das TargetImage
      lNewWidth = oOrgBitmap.Width
      lNewHeight = oOrgBitmap.Height
    End If
    oNewBitmap = New Drawing.Bitmap(lNewWidth, lNewHeight)
    oNewBitmap.SetResolution(oOrgBitmap.HorizontalResolution, oOrgBitmap.VerticalResolution)
    ' Den Graphics-Kontext der neuen Bitmap ermitteln
    oNewGraphics = Drawing.Graphics.FromImage(oNewBitmap)
    oNewGraphics.InterpolationMode = Drawing.Drawing2D.InterpolationMode.HighQualityBicubic
    oNewGraphics.DrawImage(oOrgBitmap, New Drawing.Rectangle(0, 0, lNewWidth, lNewHeight), 0, 0, oOrgBitmap.Width, oOrgBitmap.Height, Drawing.GraphicsUnit.Pixel)
    If sCopyrightText &lt;&gt; String.Empty Then
      oNewGraphics.DrawString(sCopyrightText, _
        New Drawing.Font(Drawing.FontFamily.GenericSansSerif, 9, Drawing.FontStyle.Regular, Drawing.GraphicsUnit.Pixel), _
        Drawing.Brushes.DarkGray, 2 + 1, lNewHeight - 10 - 4 + 1)
      oNewGraphics.DrawString(sCopyrightText, _
        New Drawing.Font(Drawing.FontFamily.GenericSansSerif, 9, Drawing.FontStyle.Regular, Drawing.GraphicsUnit.Pixel), _
        Drawing.Brushes.Black, 2, lNewHeight - 10 - 4)
    End If
    oNewGraphics.Dispose()
    oOrgBitmap.Dispose()
    Return oNewBitmap
  End Function
  Private Shared Function GetFieldValue(ByVal FieldName As String, ByVal FieldDescriptors() As Act.Framework.MutableEntities.MutableEntityFieldDescriptor, ByVal Entity As Act.Framework.MutableEntities.MutableEntity) As Object
    Dim lIndex As Integer

    lIndex = GetFieldIndex(FieldName, FieldDescriptors)
    If lIndex &gt;= 0 Then
      If FieldDescriptors(lIndex).GetValue(Entity) Is Nothing Then
        Return String.Empty
      Else
        Return FieldDescriptors(lIndex).GetValue(Entity)
      End If
    Else
      Return String.Empty
    End If
  End Function
  Private Shared Sub SetFieldValue(ByVal FieldName As String, ByVal FieldValue As Object, ByVal FieldDescriptors() As Act.Framework.MutableEntities.MutableEntityFieldDescriptor, ByVal Entity As Act.Framework.MutableEntities.MutableEntity)
    Dim lIndex As Integer

    lIndex = GetFieldIndex(FieldName, FieldDescriptors)
    If lIndex &gt;= 0 Then
      Select Case FieldDescriptors(lIndex).ACTFieldType
        Case Act.Framework.Database.FieldDataType.AnnualEvent, Act.Framework.Database.FieldDataType.Date, Act.Framework.Database.FieldDataType.DateTime
          If FieldValue Is Nothing Then
            FieldDescriptors(lIndex).ResetValue(Entity)
          Else
            FieldDescriptors(lIndex).SetValue(Entity, FieldValue)
          End If
        Case Act.Framework.Database.FieldDataType.Currency, Act.Framework.Database.FieldDataType.Decimal
          If FieldValue Is Nothing Then
            FieldValue = 0.0
          End If
          FieldDescriptors(lIndex).SetValue(Entity, FieldValue)
        Case Act.Framework.Database.FieldDataType.Number
          If FieldValue Is Nothing Then
            FieldValue = 0
          End If
          FieldDescriptors(lIndex).SetValue(Entity, FieldValue)
        Case Act.Framework.Database.FieldDataType.YesNo
          FieldDescriptors(lIndex).SetValue(Entity, FieldValue)
        Case Else
          FieldDescriptors(lIndex).SetValue(Entity, FieldValue)
      End Select

    End If
  End Sub
  Private Shared Function GetFieldIndex(ByVal FieldName As String, ByVal FieldDescriptors() As Act.Framework.MutableEntities.MutableEntityFieldDescriptor) As Integer
    Dim lIndex As Integer

    If FieldName = String.Empty Then
      Return -1
    End If
    For lIndex = 0 To FieldDescriptors.Length - 1
      If String.Compare(FieldDescriptors(lIndex).DisplayName, FieldName, True) = 0 Then
        Return lIndex
      End If
    Next
    Return -1
  End Function
  Private Shared Function FieldExist(ByVal FieldName As String, ByVal FieldDescriptors() As Act.Framework.MutableEntities.MutableEntityFieldDescriptor, ByVal VarName As String) As Boolean

    If GetFieldIndex(FieldName, FieldDescriptors) &gt;= 0 Then
      Return True
    Else
      If FieldName = String.Empty Then
        Return True
      Else
        MsgBox(String.Format("Ein Feld mit dem Name '{0}' aus der Variable '{1}' existiert nicht.", FieldName, VarName), MsgBoxStyle.Exclamation, "GeoCodeManager")
        Return False
      End If
    End If
  End Function

  Private Shared Sub LoadImageToPicturebox(ByVal oPic As System.Windows.Forms.PictureBox, ByVal URL As String)

    Dim oForm As System.Windows.Forms.Form
    Dim oImageStream As IO.MemoryStream
    Dim oWebClient As Net.WebClient

    oForm = CType(oPic.Parent, System.Windows.Forms.Form)
    oForm.Cursor = Cursors.WaitCursor
    Try
      oWebClient = New Net.WebClient()
      oImageStream = New IO.MemoryStream(oWebClient.DownloadData(URL))
      oPic.Image = System.Drawing.Image.FromStream(oImageStream)
    Catch ex As Exception
      'MsgBox("Es ist ein Fehler beim Laden der Grafik aufgetreten." &amp; vbCrLf &amp; ex.Message, MsgBoxStyle.Exclamation, "GeoCode")
    End Try
    oForm.Cursor = Cursors.Default

  End Sub

  Private Function Dummy() As String
    Return String.Empty</Source>
        <SourceComment>Begriff: {0}</SourceComment>
        <TargetFields></TargetFields>
        <MsgText>{0}</MsgText>
        <Picklist></Picklist>
        <Multiple>False</Multiple>
        <Expandable>True</Expandable>
        <OverwriteAlways>True</OverwriteAlways>
        <CopyToClipboard>False</CopyToClipboard>
        <ShowMsgBox>False</ShowMsgBox>
        <PositionMode>1</PositionMode>
        <FlatStyle>Standard</FlatStyle>
        <AutoDataText>Bildauswahl...</AutoDataText>
        <TextAlign>MiddleCenter</TextAlign>
        <AutoDataFormSize>160; 270</AutoDataFormSize>
        <TooltipText></TooltipText>
        <RefreshLoadedViews>False</RefreshLoadedViews>
    </AutoDataControl>
</AutoDataItems>