will the coding do,

or need a compiled project instead???

 

thanx

 

angel

 

------------------------------------------------------------------------------------------

Option Explicit

Const MODULE_NAME As String = "Multi"
Const ID_TOT = 1
Const ID_PC1 = 2
Const ID_PC = 1
Const ID_FS = 2
Const ID_FS1 = 1
Const ID_FS2 = 2
Const TOT_RESET = "Total :- "

Dim CB As CodeBook
Dim WithEvents m_Drg As cDrag_Drop   '** attach drag drop function to listbox

'*************************************************************
'Created on:   04/22/08
'Procedure:    private Method CreateTaskPanel
'*************************************************************
Private Sub CreateTaskPanel()
'/* Begin Error Handler
On Error GoTo HandleError
    Call mProcStack.EnterProc("CreateTaskPanel", MODULE_NAME)

    Dim Group As TaskPanelGroup
    Dim Item As TaskPanelGroupItem
   
    Set Group = TaskP1.Groups.Add(ID_PC, "Print Counter")
    Group.Tooltip = "Total Print Counter"
    Group.IconIndex = 1
   
    Group.Items.Add ID_TOT, TOT_RESET, xtpTaskItemTypeText
    Group.Items.Item(ID_TOT).Bold = True
    Group.Items.Item(ID_TOT).SetMargins 35, 0, 0, 0
   
    Set Item = Group.Items.Add(ID_PC1, "", xtpTaskItemTypeControl)
    Set Item.Control = Picture1
    Item.SetMargins 45, 10, 0, 0
    PC1.BackColor = Item.BackColor
    Picture1.BackColor = Item.BackColor
   
    Set Group = TaskP1.Groups.Add(ID_FS, " File Search")
    Group.Tooltip = "Search Files"
    Group.IconIndex = 2
    Group.SetIconPadding 4, 0, 0, 0
    Group.Expanded = False     <-------------------------------------- the error comes from here.......if i disable this line then the error goes away.
    
    Set Item = Group.Items.Add(ID_FS1, "", xtpTaskItemTypeControl)
    Set Item.Control = Picture2
    Picture2.BackColor = Item.BackColor
    Label1.BackColor = Item.BackColor
   
    Set Item = Group.Items.Add(ID_FS2, "Add Path", xtpTaskItemTypeLink)
    Item.SetMargins 40, 8, 0, 0
   
    TaskP1.SetImageList ImageList1

'/* End Error Handler
CreateTaskPanel_Done:
    Call mProcStack.ExitProc("CreateTaskPanel")
    Exit Sub

HandleError:
    Process_Error MODULE_NAME, Err, "CreateTaskPanel"
    Resume CreateTaskPanel_Done

End Sub

'*************************************************************
'Created on:   04/23/08
'Procedure:    Private Method AddPrint
'*************************************************************
Private Function AddPrint(FN As String) As Integer
'/* Begin Error Handler
On Error GoTo HandleError
    Call mProcStack.EnterProc("AddPrint", MODULE_NAME)

    Dim Pos As Integer
    Dim Tmp As String
    Dim SingleTmp As String
   
    Pos = InStrRev(FN, "=")
    Pos = Pos + 1
    Do
                   
        Tmp = Mid(FN, Pos, 1)
                       
        If Tmp <> " " Then
            If IsNumeric(Tmp) = True Then
                SingleTmp = SingleTmp + Tmp
            Else
                Exit Do
            End If
        End If
                       
        Pos = Pos + 1
                   
    Loop While Pos <= Len(FN)
   
    AddPrint = Val(SingleTmp)

'/* End Error Handler
AddPrint_Done:
    Call mProcStack.ExitProc("AddPrint")
    Exit Function

HandleError:
    Process_Error MODULE_NAME, Err, "AddPrint"
    Resume AddPrint_Done

End Function

'*************************************************************
'Created on:   04/22/08
'Procedure:    Private Method count
'*************************************************************
Private Sub CountPrint()
'/* Begin Error Handler
On Error GoTo HandleError
    Call mProcStack.EnterProc("CountPrint", MODULE_NAME)

    Dim i As Integer
    Dim TCount As Integer
    Dim FdrCount As Integer
    Dim TmpCount As Integer
    Dim FdrTmp As String
    Dim fName As String
   
    TCount = 0
    FdrCount = 0
    i = 1
   
    Do
        With ListView1
            With .ListItems(i)
           
                If .SubItems(2).Text = True Then
               
                    TCount = TCount + AddPrint(.Text)
               
                Else
               
                    FdrTmp = CB.Search(.SubItems(1).Text, "*.jpg", True, rtnFILE)
                   
                    If FdrTmp <> "" Then
                   
                        Do
                       
                            fName = CB.StripDelimitedItem(FdrTmp, ";", False)
                            TmpCount = AddPrint(fName)
                            TCount = TCount + TmpCount
                            FdrCount = FdrCount + TmpCount
                       
                        Loop While Len(FdrTmp) > 0
                       
                        If PC1.Value = xtpChecked Then
                       
                            If Right$(Trim$(.Text), 1) <> "=" Then
                                fName = .SubItems(1).Text & "=" & FdrCount
                            Else
                                fName = .SubItems(1).Text & FdrCount
                            End If
                       
                            CB.Rename .SubItems(1).Text, fName
                            FdrCount = 0
                       
                        End If
                   
                    End If
               
                End If
               
                i = i + 1
           
            End With
        End With

    Loop While i <= ListView1.ListItems.Count
   
    TaskP1.Groups.Item(1).Items.Item(ID_TOT).Caption = TOT_RESET & TCount & " Sheets"

'/* End Error Handler
CountPrint_Done:
    Call mProcStack.ExitProc("CountPrint")
    Exit Sub

HandleError:
    Process_Error MODULE_NAME, Err, "CountPrint"
    Resume CountPrint_Done

End Sub

'*************************************************************
'Created on:   04/22/08
'Procedure:    Private Method Form_Load
'*************************************************************
Private Sub Form_Load()
'/* Begin Error Handler
On Error GoTo HandleError
    Call mProcStack.EnterProc("Form_Load", MODULE_NAME)
   
    Dim cReg As cRegistry
   
    Set CB = New CodeBook
    Set m_Drg = New cDrag_Drop
    Set cReg = New cRegistry
   
    With cReg   '** create registry entries
   
        .ClassKey = HKEY_CURRENT_USER
        .SectionKey = "Software\Multi-Op\Paths"
        If .KeyExists = False Then .CreateKey
   
    End With
   
    CreateTaskPanel   '** creating the task panel
   
    sForm.Show   '** load search paths in the beginning
    sForm.Hide
   
'/* End Error Handler
Form_Load_Done:
    Call mProcStack.ExitProc("Form_Load")
    Exit Sub

HandleError:
    Process_Error MODULE_NAME, Err, "Form_Load"
    Resume Form_Load_Done

End Sub

'*************************************************************
'Created on:   04/23/08
'Procedure:    Private Method Form_Resize
'*************************************************************
Private Sub Form_Resize()

    If Me.WindowState = vbMinimized Then TrayIcon1.MinimizeToTray Me.hwnd

End Sub

'*************************************************************
'Created on:   04/22/08
'Procedure:    Private Method Form_Unload
'*************************************************************
Private Sub Form_Unload(Cancel As Integer)
'/* Begin Error Handler
On Error GoTo HandleError
    Call mProcStack.EnterProc("Form_Unload", MODULE_NAME)
   
    If m_Drg.DragHwnd <> 0 Then m_Drg.StopDrag
    Unload sForm

 

'/* End Error Handler
Form_Unload_Done:
    Call mProcStack.ExitProc("Form_Unload")
    Exit Sub

HandleError:
    Process_Error MODULE_NAME, Err, "Form_Unload"
    Resume Form_Unload_Done

End Sub

 

'*************************************************************
'Created on:   04/25/08
'Procedure:    Private Method ListView1_ItemDblClick
'*************************************************************
Private Sub ListView1_ItemDblClick(Button As Integer, Item As ciaXPListView30.tListItemInfo, ItemIndex As Long)

    If ListView1.CtrlKeyStatus = False Then
       
        CB.ExecuteFile ListView1.ListItems(ItemIndex).SubItems(1).Text, essSW_MAXIMIZE
   
    Else
   
        CB.ExecuteFile ListView1.ListItems(ItemIndex).SubItems(1).Text, essSW_MAXIMIZE, , , "edit"
   
    End If

End Sub

 

Private Sub ListView1_KeyDown(KeyCode As Integer, Shift As Integer)

    Dim Result As Integer
    Dim Tmp As String
    Dim delRes As Long
    Dim cFile(0) As String
   
    Tmp = ListView1.ListItems(ListView1.SelectedIndex).SubItems(1).Text
   
    If KeyCode = 46 Then
   
        Result = MsgBox("Do You Want To Delete?", vbInformation + vbSystemModal + vbYesNo, "Delete File")
       
        CB.StripDelimitedItem Tmp, "\", True
       
        If Result = 6 Then
            delRes = CB.DeleteFiles(Tmp, ListView1.ListItems(ListView1.SelectedIndex).Text, True, True, True, True)
            If delRes = 0 Then ListView1.ItemsDeleteSelected
        End If
   
    End If
   
    If ListView1.CtrlKeyStatus = True And KeyCode = vbKeyC Then
   
        cFile(0) = Tmp
        CB.ClipboardCopyFiles cFile
   
    End If
   
End Sub

'*************************************************************
'Created on:   04/22/08
'Procedure:    Private Method m_Drg_FilesDroped
'*************************************************************
Private Sub m_Drg_FilesDroped()
'/* Begin Error Handler
On Error GoTo HandleError
    Call mProcStack.EnterProc("m_Drg_FilesDroped", MODULE_NAME)

    Dim i As Integer
    Dim colX As cColumn
    Dim itmX As cListItem
    Dim fName As String
    Dim FileOK As Boolean
    i = 0
   
    ListView1.BeginUpdate
    ListView1.ClearAll
   
    ListView1.Columns.Add "  File Names", , 150
    ListView1.Columns.Add "  Paths", , 290
    ListView1.Columns.Add "", , 0
   
    Do
       
        If CB.FileExists(m_Drg.FileName(i)) = True Then
            fName = CB.GetFileNameFromPath(m_Drg.FileName(i))
            FileOK = True
        Else
            If CB.FolderExists(m_Drg.FileName(i)) = True Then
                fName = CB.StripDelimitedItem(CB.TrimNull(m_Drg.FileName(i)), "\", True)
                FileOK = False
            End If
        End If
       
        With ListView1
            With .ListItems
           
                Set itmX = .Add(fName)
                itmX.SubItems(1).Text = m_Drg.FileName(i)
                itmX.SubItems(2).Text = FileOK
           
            End With
        End With
       
        i = i + 1
   
    Loop While i < m_Drg.FileCount
   
    ListView1.EndUpdate
    ListView1.Sort 1, LVSortOrderAscending
   
    CountPrint
   
'/* End Error Handler
m_Drg_FilesDroped_Done:
    Call mProcStack.ExitProc("m_Drg_FilesDroped")
    Exit Sub

HandleError:
    Process_Error MODULE_NAME, Err, "m_Drg_FilesDroped"
    Resume m_Drg_FilesDroped_Done

End Sub

'*************************************************************
'Created on:   04/24/08
'Procedure:    Private Method SearchBox_KeyPress
'*************************************************************
Private Sub SearchBox_KeyPress(KeyAscii As Integer)
   
    If KeyAscii = 13 Then SearchBtn_Click

End Sub

'*************************************************************
'Created on:   04/25/08
'Procedure:    Private Method SearchFiles
'*************************************************************
Private Sub SearchFiles()

    Dim i As Integer
    Dim sFound As String
    Dim sTmp As String
    Dim itmX As cListItem
    i = 1
    sFound = ""
   
    ListView1.ClearAll
   
    ListView1.Columns.Add "  File Names", , 150
    ListView1.Columns.Add "  Paths", , 290
   
    Do
       
        With sForm.sListView
       
            If .ListItems(i).Checked = True Then
           
                sString.Caption = CB.CompactPath(.ListItems(i).SubItems(2).Text, sString.Width - 1, Me.hDC)
                sFound = CB.Search(.ListItems(i).SubItems(2).Text, "*" & Trim$(SearchBox.Text) & "*", True, rtnFILE)
               
                If Trim(sFound) <> "" Then
               
                    ListView1.BeginUpdate
                   
                    Do
                   
                        sTmp = CB.StripDelimitedItem(sFound, ";", False)
                        Set itmX = ListView1.ListItems.Add(CB.GetFileNameFromPath(sTmp))
                        itmX.SubItems(1).Text = sTmp
                   
                    Loop While Len(sFound) > 0
                   
                    ListView1.EndUpdate
                   
                End If
               
               
                If CB.SearchBrk = True Then Exit Do
           
            End If
       
        End With
       
        i = i + 1
   
    Loop While i <= sForm.sListView.ListItems.Count
   
End Sub

'*************************************************************
'Created on:   04/24/08
'Procedure:    Private Method SearchBtn_Click
'*************************************************************
Private Sub SearchBtn_Click()

    If Trim(SearchBox.Text) = "" Then Exit Sub
   
    If sForm.sListView.CheckedCount = 0 Then
   
        MsgBox "No Path Selected To Search!", vbCritical + vbOKOnly, "Search"
        Exit Sub
   
    End If
   
    SearchBtn.Enabled = False
    SearchBox.Locked = True
    TaskP1.Groups.Item(ID_FS).Items(ID_FS2).Enabled = False
    Label1.Visible = True
    sString.Visible = True
    CancelBtn.Enabled = True
   
    SearchFiles
   
    If CB.SearchBrk = False Then CancelBtn_Click

End Sub

'*************************************************************
'Created on:   04/24/08
'Procedure:    Private Method CancelBtn_Click
'*************************************************************
Private Sub CancelBtn_Click()

    SearchBtn.Enabled = True
    TaskP1.Groups.Item(ID_FS).Items(ID_FS2).Enabled = True
    Label1.Visible = False
    sString.Visible = False
    CancelBtn.Enabled = False
    SearchBox.Locked = False
   
    CB.SearchBrk = True

End Sub

'*************************************************************
'Created on:   04/23/08
'Procedure:    Private Method TaskP1_GroupExpanding
'*************************************************************
Private Sub TaskP1_GroupExpanding(ByVal Group As XtremeTaskPanel.ITaskPanelGroup, ByVal Expanding As Boolean, Cancel As Boolean)

    If Expanding = False Then

        If Group.Id = ID_PC Then
   
            TaskP1.Groups(ID_FS).Expanded = True
   
        Else
   
            TaskP1.Groups(ID_PC).Expanded = True
   
        End If

    Else

        If Group.Id = ID_PC Then
   
            m_Drg.DragHwnd = ListView1.hwnd
            m_Drg.StartDrag
            ListView1.AllowColumnSorting = False
            ListView1.ClearAll
            TaskP1.Groups(ID_FS).Expanded = False
   
        ElseIf Group.Id = ID_FS Then
   
            m_Drg.StopDrag
            ListView1.AllowColumnSorting = True
            ListView1.ClearAll
            TaskP1.Groups(ID_PC).Expanded = False
   
        End If

    End If

End Sub

'*************************************************************
'Created on:   04/24/08
'Procedure:    Private Method TaskP1_ItemClick
'*************************************************************
Private Sub TaskP1_ItemClick(ByVal Item As XtremeTaskPanel.ITaskPanelGroupItem)

    If Item.Id = ID_FS2 Then sForm.Show 1

End Sub

'*************************************************************
'Created on:   04/23/08
'Procedure:    Private Method TrayIcon1_Click
'*************************************************************
Private Sub TrayIcon1_Click()

    TrayIcon1.MaximizeFromTray Me.hwnd

End Sub

-------------------------------------------------------------------------------------------------------------------------------------------

 

this is the main form of my project..........

 

hope this helps......

 

thanx

 

angel

Can you try reproduce it with samller project and attach it for review.

i created an app with codejock activex 11.2.2, using the controls and taskpanel ocx

but the problem is,....

 

the soft is working fine on the system i created,, but when i ran the prog on my home pc.... it gave me error message

"runtime error = -2147417848 (80010108) = the object invoked has disconnected from its client." (pertaining to taskpanel)

 

in my formload event, i wrote,,,, CreateTaskPanel"

rest here is my procedure for "CreateTaskPanel"

 

------------------------------------------------------------------------

Private Sub CreateTaskPanel()
'/* Begin Error Handler
On Error GoTo HandleError
    Call mProcStack.EnterProc("CreateTaskPanel", MODULE_NAME)

    Dim Group As TaskPanelGroup
    Dim Item As TaskPanelGroupItem
   
    Set Group = TaskP1.Groups.Add(ID_PC, "Print Counter")
    Group.Tooltip = "Total Print Counter"
    Group.IconIndex = 1
   
    Group.Items.Add ID_TOT, TOT_RESET, xtpTaskItemTypeText
    Group.Items.Item(ID_TOT).Bold = True
    Group.Items.Item(ID_TOT).SetMargins 35, 0, 0, 0
   
    Set Item = Group.Items.Add(ID_PC1, "", xtpTaskItemTypeControl)
    Set Item.Control = Picture1
    Item.SetMargins 45, 10, 0, 0
    PC1.BackColor = Item.BackColor
    Picture1.BackColor = Item.BackColor
   
    Set Group = TaskP1.Groups.Add(ID_FS, " File Search")
    Group.Tooltip = "Search Files"
    Group.IconIndex = 2
    Group.SetIconPadding 4, 0, 0, 0
    Group.Expanded = False                  <----------------------------- the error comes in from here if disabled then the prog starts... but doesnt fulfil me work
    
    Set Item = Group.Items.Add(ID_FS1, "", xtpTaskItemTypeControl)
    Set Item.Control = Picture2
    Picture2.BackColor = Item.BackColor
    Label1.BackColor = Item.BackColor
   
    Set Item = Group.Items.Add(ID_FS2, "Add Path", xtpTaskItemTypeLink)
    Item.SetMargins 40, 8, 0, 0
   
    TaskP1.SetImageList ImageList1

'/* End Error Handler
CreateTaskPanel_Done:
    Call mProcStack.ExitProc("CreateTaskPanel")
    Exit Sub

HandleError:
    Process_Error MODULE_NAME, Err, "CreateTaskPanel"
    Resume CreateTaskPanel_Done

End Sub
-----------------------------------------------------------------------

 

needed help in solving the problem,

i have also tried on many other pcs........

on some pcs the prog works fine, but on others,,,, the same problem......

 

thanx

 

angel