<?xml version="1.0" encoding="utf-16" standalone="yes"?>
<!--Created: 29.01.2016 17:07:45-->
<!--ACTOptimumVersion: 6.0.5561.22526-->
<ACTOptimumItems ACTOptimumVersion="6.0.5561.22526" Created="29.01.2016 17:07:45">
    <AutoDataMenu Created="29.01.2016 17:07:45" ClassName="Melville_Schellmann.ACTOptimum6.Plugin.MenuItemAutoData" PrefClassVersion="1.0" ACTOptimumVersion="6.0.5561.22526">
        <GlobalPref>True</GlobalPref>
        <NeededRole>2</NeededRole>
        <Name>ADM_Multi-History-Maker</Name>
        <Tooltip>Creates histories for a contact lookup</Tooltip>
        <Description>Creates histories for a contact lookup</Description>
        <CommandBar>Connected Menus</CommandBar>
        <Menu>act-ui://com.act/application/menu/contact</Menu>
        <Index>-1</Index>
        <Separator>False</Separator>
        <Shortcut>None</Shortcut>
        <SourceCode>' #ScriptName: MultiHistoryMaker
    ' #Description: ENGLISH:
    '               Creates user-defined history entries for a contact lookup. Seperate histories will be created for each contact.
    ' #Copyright: © 2012 by Melville-Schellmann
    ' #Version: 1.2 (29.01.2016) Custom Regarding added.
    ' #Author: Wassim Amrou, wa@melville-schellmann.de - Robert Schellmann, rs@melville-schellmann.de
    ' #Version: 1.1 (31.05.2013) In For-Schleife die GarbageCollection eingaubt. 
    '                            Test mit 5000 Historien erfolgreich durchgeführt.
    ' #Version: 1.0 (16.05.2013) s.o.
	        
    m_sScript = "Multi-History-Maker"
    m_oACTApp = ACTApp

    Dim oActivityType As Object
    Dim oHistoryResult As Act.Framework.Histories.HistoryType
    Dim oHistory As Act.Framework.Histories.History
    Dim sHistoryRegarding As String
    Dim sHistoryDetails As String
    Dim sTitelActivity As String = "Select history type"
    Dim sTitleDetails As String = "Enter details"
    Dim sTitelDatumInput As String = "Enter date"
    Dim sTitelRecordManager As String = "Select Record Manager"
        ' English: The text within the "" can be changed acc. to your needs.
    Dim oContact As Act.Framework.Contacts.Contact
    Dim oContactlist As Act.Framework.Contacts.Contactlist
    Dim oRUser As Act.Framework.Contacts.Contact
    Dim oDate As System.datetime
    
   
    Dim lHistorytypes() As Act.Framework.Histories.HistoryType  
    oContactlist = m_oACTApp.ActFramework.CurrentLookupContactList
    If Not TypeOf m_oACTApp.CurrentView Is Act.UI.IContactListView Then
      
      'Check if correct view "Listview" is active 
      MsgBox("Wrong view. This function is only availabe in the contact list view.", MsgBoxStyle.Exclamation, m_sScript)
          ' English: The text within the "" can be changed acc. to your needs.
      GoTo Abbruch
    End If

    
    'Case: Standard activity types
    
    If trySelectActivityTyp(sTitelActivity, oActivityType) = False Then 
      GoTo abbruch
    End If
    
    If TypeOf(oActivityType) Is act.Framework.Activities.ActivityType Then 
      
      If trySelectHistoryResult(oActivityType, oHistoryResult) = False Then
        GoTo abbruch
        
      End If
      
      If TrySelectRegarding(oHistoryResult, sHistoryRegarding) = False Then
        GoTo abbruch
      End If 
      If InputMemo(sTitleDetails, sHistoryDetails, drawing.Icon.FromHandle(CType(oActivityType.Image, drawing.Bitmap).GetHicon)) = False Then
        GoTo abbruch
      End If
      
      'Case "other"
    Else 
      If trySelectOtherHistoryResult(oHistoryResult) = False Then 
        GoTo abbruch
      End If
      If tryGetCustumRegarding("Betreff", sHistoryRegarding) = False Then
        GoTo abbruch
      End If
      If InputMemo(sTitleDetails, sHistoryDetails, Melville_Schellmann.ACTOptimum6.Plugin.Icons.IconManager.GetIcon("ACTOPTIMUM_Logo")) = False Then
        GoTo abbruch
      End If
    End If
    
    
      
    If  TryInputDatum(sTitelDatumInput, oDate) = False 
      GoTo abbruch
    End If
    
    If tryselectRecordManager(sTitelRecordManager, oRUser) = False Then
      GoTo abbruch
    End If
    If msgbox(String.Format("Are you sure you want to create a history of type '{0}' for '{1}' Contact(s)? ", oHistoryResult, oContactlist.Count), MsgBoxStyle.Question Or MsgBoxStyle.YesNo, m_sScript) = MsgBoxResult.No Then 
      GoTo abbruch
    End If
    
    Dim i As Integer 
    m_oACTApp.Cursor = Cursors.WaitCursor
    For i = 0 To oContactlist.count - 1
      oContact = oContactlist.item(i)
      If  TryPrintStatus(String.Format("History for {0} Contact(s) of {1} created ; ", i + 1, oContactlist.Count)) = False Then
        GoTo Abbruch
      End If 
      Application.DoEvents
      Threading.thread.sleep(10)
      If tryCreateHistory(oContact, oHistoryResult, sHistoryRegarding, sHistoryDetails, oDate, oRUser, oHistory) = False Then
        GoTo abbruch
      End If 
      If i Mod 100 = 0 Then 
        If Not AppDomain.CurrentDomain.IsFinalizingForUnload AndAlso Not Environment.HasShutdownStarted Then
          ACTApp.StatusBar.Panels.item(1).text &amp;= "..."
          Application.DoEvents
          GC.Collect
          System.Threading.thread.sleep(100)
          GC.WaitForPendingFinalizers
        End If
      End If
    Next
    Abbruch:
    TryPrintStatus(String.Empty)
    m_oACTApp.Cursor = Cursors.Default
  End Sub
  Private Shared m_oACTApp As Act.UI.ActApplication  
  Private Shared m_sScript As String

  'Select activity type
  Private Shared Function trySelectActivityTyp(sTitle As String, ByRef oSelectedATyp As Object) As Boolean
    'Select activity type
    Dim oRegularActivityTypes() As Act.Framework.Activities.ActivityType
    Dim oSelectedType As Object   
    oSelectedATyp = Nothing
    
    oRegularActivityTypes = m_oACTApp.ActFramework.Activities.GetActivityTypes(True)
    Dim  oActivityTypes(oRegularActivityTypes.Length) As Object
    oRegularActivityTypes.CopyTo(oActivityTypes, 0)
    ' add selection "other"
    oActivityTypes(oActivityTypes.Length - 1) = "other"
    
    If TrySelectObject(sTitle, "Please select an activity type", "Activity types", "", "", "", oActivityTypes, oSelectedType) = True Then
     
      oSelectedATyp = oSelectedType 
      Return True   
    
    Else
      Return False
    End If 

  End Function
  
  'case: "other" input box for regarding
  Private Shared Function tryGetCustumRegarding(sTitle As String, ByRef sCRegarding As String) As Boolean
    Dim oCregarding As String
    Dim sdefaultvalue As String = "regarding"
    oCregarding = inputbox("regarding", sTitle, sdefaultvalue)
    If String.IsNullOrEmpty(oCregarding)Then 
      Return False
    Else
      sCRegarding = oCregarding
      Return True 
    End If 
  End Function
  
  'create history item
  Private Shared Function tryCreateHistory(oCntact As Act.Framework.Contacts.Contact, oHistType As Act.Framework.Histories.HistoryType, oRegrding As String, oDtails As String, odatetime As DateTime, oRecordMngr As  act.Framework.contacts.Contact, ByRef oHistory As act.Framework.Histories.History)As Boolean
    
    oHistory = Nothing
   
    Try
      oHistory = m_oACTApp.ActFramework.Histories.CreateHistory(oCntact, _
        guid.Empty, _
        oHistType, _
        False, _
        odatetime, _
        odatetime.Add(New TimeSpan(0, 5, 0)), _
        oRegrding, _
        oDtails, _
        Nothing, _
        m_oACTApp.ActFramework.CurrentUser.ID, _
        oRecordMngr.ID)

    Catch ex As Exception
      MsgBox("An error occurred." &amp; ex.Message, MsgBoxStyle.Exclamation, m_sScript)
    End Try
    If   TypeOf(oHistory) Is act.Framework.Histories.History Then 
      Return True
    Else 
      Return False
    End If
  End Function


  'Select Record Manager
  
  Private Shared Function tryselectRecordManager(sTitle As String, ByRef oUser As Act.Framework.Contacts.Contact)As Boolean
    
    Dim oUserlist As act.Framework.Contacts.ContactList
    Dim oselectedUser() As Object 
    Dim oRecordmanager As act.Framework.Contacts.Contact
    Dim i As Integer
    
    oUserlist = m_oACTApp.ActFramework.Contacts.GetContactsUsers(Nothing)
    ReDim oselectedUser(oUserlist.Count - 1)
    
    For i = 0 To oUserlist.Count - 1
      oselectedUser(i) = oUserlist.item(i)
    Next 
      
    If TrySelectObject("Record Manager selection", "Pls. select Record Manager", "Record Manager", "", "", "", oselectedUser, oRecordmanager) Then
      oUser = oRecordmanager
      Return True
    Else 
      Return False
    End If
   
  End Function
  
  ' select History Result
  Private Shared Function trySelectHistoryResult(oActivityType As Act.Framework.Activities.ActivityType, ByRef oSelectedHTyp As Act.Framework.Histories.HistoryType)As Boolean 
    
    
    Dim oHistoryTypes() As Act.Framework.Histories.HistoryType
    Dim oSelectedType As Act.Framework.Histories.HistoryType
    oSelectedType = Nothing
    
    oHistoryTypes = m_oACTApp.ActFramework.Histories.GetHistoryTypes(oActivityType)
    
    If TrySelectObject("History results", "Pls. select result", "History Results", "", "", "", oHistoryTypes, oSelectedType) = True Then
      
      oSelectedHTyp = oSelectedType
      Return True
    Else 
      Return False       
    End If

  End Function
  
  'case: "other" selection of history results matching the type "other"
  Private Shared Function trySelectOtherHistoryResult(ByRef oSelectedHTyp As Act.Framework.Histories.HistoryType)As Boolean
    
    Dim aOtherHistorieTypeID As Integer() = New Integer(){5,16,50,63,64,101,102,104}
    Dim aHistorytypes() As Act.Framework.Histories.HistoryType 
    Dim oHistoryType As Act.Framework.Histories.HistoryType 
   
    aHistorytypes = m_oACTApp.ActFramework.Histories.GetHistoryTypes(True, True)
    Dim lOtherHistoryTypes(aOtherHistorieTypeID.length -1) As Act.Framework.Histories.HistoryType 
    Dim k As Integer
    Dim j As Integer
    For k = 0 To aHistorytypes.Length - 1
      For j = 0 To aOtherHistorieTypeID.length - 1
        If aHistorytypes(k).HistoryTypeId() = aOtherHistorieTypeID(j) Then
          lOtherHistoryTypes.SetValue(aHistorytypes(k), j)
        
        End If   
      Next
    Next
    If TrySelectObject("Pls. slect a result", "Results", "", "", "", "", lOtherHistoryTypes, oHistoryType) = True Then 
      oSelectedHTyp = oHistoryType
      Return True
    Else 
      Return False
    End If
  End Function

  'date entry DD.MM.YYYY 
  Private Shared Function TryInputDatum(STitle As String, ByRef oDate As System.DateTime) As Boolean
    Dim oselectedDate As String
    Dim oDefaultvalue  As System.DateTime = Date.Now
    
    oselectedDate = inputbox(STitle, "Enter date", oDefaultvalue)
    If system.String.IsNullOrEmpty(oselectedDate)Then
      Return False
    End If
    If Date.TryParse(oselectedDate, oDate) = True Then
      
      Return True
    Else
      Msgbox(String.Format("Pls. enter a valid date"), MsgBoxStyle.Information, m_sScript)
      Return TryInputDatum("Pls. enter a valid date", oDate)

    End If

  End Function

  ' select regarding
  Private Shared Function TrySelectRegarding(oHistoryType As  Act.Framework.Histories.HistoryType, ByRef sHRegarding As String) As Boolean
    


    Dim oPickList As Act.Framework.PickLists.PickList
    Dim aList() As String
    Dim sCustomRegarding As String = "Custom regarding"
    Dim sRegarding As String = String.Empty
    Dim i As Integer
    
    oPickList = m_oACTApp.ActFramework.Histories.GetPicklistForHistoryType(oHistoryType)
    If oPicklist Is Nothing Then
      Msgbox(String.Format("Drop-down list for history result'{0}' not found.", oHistoryType.Name), MsgBoxStyle.Information, m_sScript)
    
    End If
    ReDim aList(oPickList.Items.Count)
    alist(0) = sCustomRegarding
    For i = 0 To oPickList.Items.Count - 1
      aList(i + 1) = oPickList.items(i).value.tostring
    Next
    
    If TrySelectObject("Regarding", "Pls. select regarding", "Regarding", "", "", "", aList, sRegarding) = True Then 
      If String.Compare(sRegarding, sCustomRegarding, True) = 0 Then 
        Return tryGetCustumRegarding("Regarding", sHRegarding)  
       
      Else 
        sHRegarding = sRegarding
        Return True
      
      End If
    Else 
      Return False

    End If
  
  End Function
  'Details entry
  Private Shared Function InputMemo(ByVal Title As String, ByRef MemoText As String, Icon As System.Drawing.Icon) As Boolean
    Dim frmInputMemo As System.Windows.Forms.Form
    Dim txbMemo As System.Windows.Forms.TextBox
    Dim btnOK As System.Windows.Forms.Button
    Dim btnCancel As System.Windows.Forms.Button
    
    frmInputMemo = New System.Windows.Forms.Form
    frmInputMemo.Text = Title
    frmInputMemo.Width = 480
    frmInputMemo.Height = 320
    frmInputMemo.StartPosition = System.Windows.Forms.FormStartPosition.CenterParent
    frmInputMemo.ShowInTaskbar = True
    frmInputMemo.MinimumSize = New Drawing.Size(320, 240)
    frmInputMemo.Icon = Icon
    txbMemo = New System.Windows.Forms.TextBox
   
    txbMemo.Multiline = True
    txbMemo.AcceptsReturn = True
    txbMemo.ScrollBars = System.Windows.Forms.ScrollBars.Both
    txbMemo.Dock = System.Windows.Forms.DockStyle.Fill
    txbMemo.Text = MemoText
    txbMemo.SelectionStart = txbMemo.Text.Length

    frmInputMemo.Controls.Add(txbMemo)

    btnOK = New System.Windows.Forms.Button
    btnOK.Text = "OK"
    btnOK.DialogResult = System.Windows.Forms.DialogResult.OK
    btnOK.Dock = System.Windows.Forms.DockStyle.Bottom
    frmInputMemo.Controls.Add(btnOK)
    
    btnCancel = New System.Windows.Forms.Button

    btnCancel.Text = "Cancel"
    btnCancel.DialogResult = System.Windows.Forms.DialogResult.Cancel
    btnCancel.Dock = System.Windows.Forms.DockStyle.Bottom
    
    frmInputMemo.Controls.Add(btnCancel)

    frmInputMemo.AcceptButton = btnOK
    frmInputMemo.CancelButton = btnCancel

    If frmInputMemo.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
      MemoText = txbMemo.Text
      Return True
    Else
      Return False
    End If
  End Function
  'Emergency exit:  ESC for abort
  
  Private Shared Function TryPrintStatus(sMessage As String) As Boolean
    Dim plStatus  As System.Windows.Forms.StatusBarPanel
    Dim sCancelMesssage As String = "Press ESC to cancel."
    
    TryPrintStatus = False
    
    If m_oACTApp Is Nothing Then
      Msgbox("m_oACTApp is missing.") 
      GoTo Abbruch
    End If
    If m_oACTApp.StatusBar Is Nothing Then
      Msgbox("Statusbar is missing.") 
      GoTo Abbruch
    End If
    plStatus = m_oACTApp.StatusBar.Panels.Item(1)
    
    
    If plStatus.ToolTipText.IndexOf(sCancelMesssage) &lt; 0 Then
      plStatus.ToolTipText = sCancelMesssage
      plStatus.Tag = Nothing
      AddHandler m_oACTApp.StatusBar.KeyUp, AddressOf Application_KeyUp
    Else
      If plStatus.Tag = "Cancel"  Then
        sMessage = String.Empty
      End If
    End If
    
    If  System.String.IsNullOrEmpty(sMessage) Then
      plStatus.Text = sMessage
      plStatus.ToolTipText = String.Empty
      plStatus.Tag = Nothing
      RemoveHandler m_oACTApp.StatusBar.KeyUp, AddressOf Application_KeyUp
    Else
      plStatus.Text = sMessage &amp; " " &amp; sCancelMesssage
      If m_oACTApp.StatusBar.Focused = False Then
        m_oACTApp.StatusBar.Focus
      End If
      TryPrintStatus = True
    End If
    
    Abbruch:
  End Function
  Private Shared Sub Application_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs)
    If  CType(sender, System.Windows.Forms.statusbar).Panels.Item(1).Tag Is Nothing Then
      If CType(e.KeyCode, Integer) = Keys.Escape Then
        If Msgbox("Do you want to cancel?", MsgBoxStyle.YesNo Or MsgBoxStyle.Question, "Operation cancelled") = MsgBoxResult.Yes Then
          CType(sender, System.Windows.Forms.statusbar).Panels.Item(1).Tag = "Cancel"
        End If 
      End If
    End If
  End Sub
  
  'Display dialogue "helper function"
  
  Private Shared Function TrySelectObject(ByVal Title As String, ByVal Details As String, ByVal  ColumnATitle As String, ByVal  ColumnBTitle As String, ByVal  ColumnAPropertyName As String, ByVal  ColumnBPropertyName As String, ByVal  Objects() As Object, ByRef oSelectedObject As Object) As Boolean
       
    Dim frmSelect As System.Windows.Forms.Form
    Dim lvList As System.Windows.Forms.ListView
    Dim btnOK As System.Windows.Forms.Button
    Dim btnCancel As System.Windows.Forms.Button
    Dim lbInfo As System.Windows.Forms.Label
    Dim ilSortDirection As system.windows.Forms.ImageList
    Dim resImages As system.Resources.ResourceManager
    Dim oBitmapUp As System.Drawing.Bitmap
    Dim oBitmapDown As System.Drawing.Bitmap
    
    frmSelect = New System.Windows.Forms.Form
    frmSelect.Text = Title
    frmSelect.Width = 320
    frmSelect.Height = 320
    frmSelect.ControlBox = False
    frmSelect.StartPosition = System.Windows.Forms.FormStartPosition.CenterParent
    frmSelect.ShowInTaskbar = True
    frmSelect.MinimumSize = New Drawing.Size(320, 240)
    
    'frmSelect.Icon = Icon
    lvList = New System.Windows.Forms.ListView
    lvlist.MultiSelect = False
    lvList.View = View.Details
    lvList.Dock = System.Windows.Forms.DockStyle.Fill
    lvList.FullRowSelect = True

    frmSelect.Controls.Add(lvList)

    lbInfo = New System.Windows.Forms.Label
    lbInfo.Text = Details
    lbInfo.Height = lbinfo.Font.Height * 3
    lbInfo.TextAlign = ContentAlignment.MiddleLeft
    lbInfo.Dock = DockStyle.Top
    frmSelect.Controls.Add(lbInfo)
    
    oBitmapUp = New Bitmap(GetType(system.Windows.Forms.ImageList), "ScrollButtonUp.bmp")
    oBitmapUp.MakeTransparent(Color.White)
    oBitmapDown = New Bitmap(GetType(system.Windows.Forms.ImageList), "ScrollButtonDown.bmp")
    oBitmapDown.MakeTransparent(Color.White)
    ilSortDirection = New system.Windows.Forms.ImageList
    ilSortDirection.ImageSize = oBitmapDown.Size
    ilSortDirection.ColorDepth = ColorDepth.Depth32Bit
    ilSortDirection.Images.add("Ascending", oBitmapUp)
    ilSortDirection.Images.add("Descending", oBitmapDown)
    ilSortDirection.Images.add("None", New Bitmap(oBitmapDown.Size.Width, oBitmapDown.Size.Height, Drawing.Imaging.PixelFormat.Format32bppArgb))
    'ilSortDirection.Images.Item("Ascending").MakeTransparent(Color.White)
    lvList.SmallImageList = ilSortDirection    

    btnOK = New System.Windows.Forms.Button
    btnOK.Text = "OK"
    btnOK.Name = "btnOK"
    btnOK.DialogResult = System.Windows.Forms.DialogResult.OK
    btnOK.Dock = System.Windows.Forms.DockStyle.Bottom
    frmSelect.Controls.Add(btnOK)
    
    btnCancel = New System.Windows.Forms.Button

    btnCancel.Text = "Cancel"
    btnCancel.Name = "btnCancel"
    btnCancel.DialogResult = System.Windows.Forms.DialogResult.Cancel
    btnCancel.Dock = System.Windows.Forms.DockStyle.Bottom
    
    frmSelect.Controls.Add(btnCancel)

    frmSelect.AcceptButton = btnOK
    frmSelect.CancelButton = btnCancel

    Dim lIndex As Integer 
    Dim oItem As System.Windows.Forms.ListViewItem
    Dim oColumnA As System.Windows.Forms.ColumnHeader
    Dim oColumnB As System.Windows.Forms.ColumnHeader

    lvList.Items.Clear
    oColumnA = lvList.Columns.Add(ColumnATitle)
    If Not String.IsNullOrEmpty(ColumnBTitle) Then
      oColumnB = lvList.Columns.Add(ColumnBTitle)
    Else
      oColumnB = Nothing
    End If
    lvList.Sorting = SortOrder.None
    lvList.BeginUpdate
    For lIndex = 0 To Objects.Length - 1
      oItem = lvList.Items.Add(GetPropertyValueFromObject(Objects(lIndex), ColumnAPropertyName))
      oItem.Tag = Objects(lIndex)
      If Not oColumnB Is Nothing Then
        oItem.SubItems.Add(GetPropertyValueFromObject(Objects(lIndex), ColumnBPropertyName))
      End If
      If lIndex = 0 Then
        oItem.Selected = True
      End If
    Next
    lvList.EndUpdate
    lvList.Focus
    If  oColumnB Is Nothing Then
      oColumnA.ImageIndex = 0
      oColumnA.Width = lvList.Width - 16
    Else
      oColumnA.ImageIndex = 0
      oColumnA.Width = lvList.Width \ 2
      oColumnB.ImageIndex = 2
      oColumnB.Width = lvList.Width \ 2 - 16
    End If
    lvList.GridLines = True
    lvList.Sorting = SortOrder.Ascending
    AddHandler lvList.ColumnClick , AddressOf lvList_ColumnClick
    AddHandler lvList.DoubleClick, AddressOf lvList_DoubleClick
    lvList.ListViewItemSorter = New ListViewItemComparer(0, lvList)  
    If frmSelect.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
      If  lvList.SelectedItems Is Nothing OrElse lvList.SelectedItems.Count = 0 Then
        oSelectedObject = Nothing
        Return False
      Else
        oSelectedObject = lvList.SelectedItems(0).Tag
        Return True
      End If
    Else
      oSelectedObject = Nothing
      Return False
    End If

  End Function
  Private Shared Function GetPropertyValueFromObject(oObject As Object, PropertyName As String) As String
    If oObject Is Nothing Then
      Return String.Empty
    End If
    If TypeOf(oObject) Is String Then
      Return oObject
    End If
    If String.IsNullOrEmpty(PropertyName)  Then
      Return oObject.ToString
    End If
    If String.Compare(PropertyName, "ToString", True) = 0 Then
      Return oObject.ToString
    End If
    Dim oProperty As System.Reflection.PropertyInfo 
    Dim oValue As Object
    Try
      oProperty = oObject.GetType.GetProperty(PropertyName)  
    Catch ex As Exception
      Msgbox(String.Format("Property '{0}' not found in Object '{0}'.", PropertyName, oObject.GetType().ToString) &amp; vbcrlf &amp; ex.Message)
      Return String.Empty
    End Try
    If oProperty Is Nothing Then
      Msgbox(String.Format("Property '{0}' not found in Object '{0}'.", PropertyName, oObject.GetType().ToString))
      Return String.Empty
    End If
    oValue = oProperty.GetValue(oObject, Nothing)
    If oValue Is Nothing Then 
      Return String.Empty
    End If
    Return oObject.tostring
  End Function
  
  Private Shared Sub lvList_ColumnClick(sender As Object, e As System.Windows.Forms.ColumnClickEventArgs)
    Dim lvList As System.Windows.Forms.ListView
    Dim oColumn As System.Windows.Forms.ColumnHeader
    Dim oItemComparer As ListViewItemComparer
    lvList = CType(sender, system.Windows.Forms.ListView)
    oColumn = CType(lvList.Columns(e.Column), System.Windows.Forms.ColumnHeader)
    oItemComparer = CType(lvList.ListViewItemSorter, listviewitemcomparer)
    If oItemComparer.SortColumn &lt;&gt; e.Column Then
      lvList.Columns.Item(oItemComparer.SortColumn).ImageIndex = 2
      oColumn.ImageIndex = 0
      lvList.Sorting = SortOrder.Ascending
      oItemComparer.SortColumn = e.Column
    Else
      If lvList.Sorting = SortOrder.Ascending Then
        oColumn.ImageIndex = 1
        lvList.Sorting = SortOrder.Descending
      Else
        oColumn.ImageIndex = 0
        lvList.Sorting = SortOrder.Ascending
      End If
    End If
    lvList.Sort
  End Sub
  Private Shared Sub lvList_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs)
    Dim lvList As System.Windows.Forms.ListView
    lvList = CType(sender, system.Windows.Forms.ListView)
    If Not lvList.SelectedItems Is Nothing  Then
      If lvList.SelectedItems.Count &gt; 0 Then
        CType(lvList.Parent.controls("btnOK"), System.Windows.Forms.Button).PerformClick
      End If
    End If
  End Sub
  Class ListViewItemComparer 
    ' IComparer Class 
    Implements IComparer
    Private m_lSortColumn As Integer 
    Private m_lvList As ListView
    Public Sub New()
      m_lSortColumn = 0
    End Sub 
    Public Property SortColumn() As Integer
      Get
        Return m_lSortColumn  
      End Get
      Set(value As Integer)
        m_lSortColumn = value
      End Set
    End Property
    Public Sub New(ByVal column As Integer, oListView As ListView)
      m_lSortColumn = column
      m_lvList = oListView
    End Sub 
    Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare
      Dim lResult As Integer
      lResult = System.String.Compare(CType(x, ListViewItem).SubItems(m_lSortColumn).Text, CType(y, ListViewItem).SubItems(m_lSortColumn).Text, True)  
      Select Case  m_lvList.Sorting
        Case SortOrder.Ascending
          Return lResult
        Case SortOrder.Descending
          Return -lResult
        Case SortOrder.None
          Return 0
      End Select
    End Function 
  End Class
  
  
  
  Private Sub empty()</SourceCode>
        <IconName>ACTOptimum_AutoData</IconName>
    </AutoDataMenu>
</ACTOptimumItems>