OPT_AxSuite3_2.bas

'compile with freebasic 0.24

'	Name for RC module
' can hold a complete path, or only the name with extension
_:[CSED_COMPIL_RC]:   AxSuite3.rc   ' with ou without double quotes !

'	Name for module to compile :  EXE ; DLL ; LIB (A) ; or OCX ; or O (Obj)
' can hold a complete path, or only the name with extension, or only extension
_:[CSED_COMPIL_NAME]:   AxSuite3_2.exe  ' with ou without double quotes !


'_:[CSED_OPTIMIZE]: 'Private procs , dead code Removal


'_:[CSED_CLEAN]:  'Private procs , dead code Removal and Cleaned commented lines

'=========================================================================
'Include files of control
'=========================================================================
#include once "windows.bi"
#include once "win/richedit.bi"
#Include Once "win/ocidl.bi"
#Include Once "win/shellapi.bi"
#include once "win/commctrl.bi"
#include once "win/commdlg.bi"

' Incorporated here : #Include once "inc_files.bi"
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' START INCLUDE ¤ 001 _ C:\Documents and Settings\Perso\Mes documents\axsuite2pkg\axsuite2pkg\AxSuite2\inc_files.bi

#IFNDEF INCFILE_PLUS
   #DEFINE INCFILE_PLUS

   Private Function MakeFileImport_(TabU1 as ubyte ptr, IncFil_len As Uinteger, NewFile As String) As integer
      Dim lFile AS short
      lFile = FreeFile                           'find next open file number
      Open NewFile For Binary As #lFile          'create the new file
      Put #lFile,, TabU1[0], IncFil_len          'write the buffer to the file
      Close #lFile                               'close the file
      Function = 1                               'worked so return a 1
   End Function

	Private function StringImport_(TabU1 as ubyte ptr, IncFil_len As Uinteger, Newvar As String)as string
      dim x as integer
		for x=0 to IncFil_len
			Newvar[x]=TabU1[x]
      NEXT
		function = Newvar
   End function

	Private Function mem_ClipboardSetText(TabU1 as ubyte ptr, IncFil_len As Uinteger) As Long
		dim pstr as zstring ptr
		pstr=TabU1
		Var hGlobalClip = GlobalAlloc(GMEM_MOVEABLE Or GMEM_SHARE, IncFil_len + 1)
		If OpenClipboard(0) Then
			EmptyClipboard()
			Var lpMem = GlobalLock(hGlobalClip)
			If lpMem Then
				CopyMemory(lpMem, pstr, IncFil_len)
				GlobalUnlock(lpMem)
				Function = cast(long, SetClipboardData(CF_TEXT, hGlobalClip))
			End If
			CloseClipboard()
		else
			Function = 0
		End If
	End Function

   #MACRO IncFilePlus(label, file, sectionName, attr)
      #if __FUNCTION__ <> "__FB_MAINPROC__"
         #IfnDef Var__##label##__Import__
            'Dim label As Const UByte Ptr = Any
            Dim label As UByte Ptr = Any
            Dim label##_len As UInteger = Any
         #endif
         #if __FB_DEBUG__
            asm jmp .LT_END_OF_FILE_##label##_DEBUG_JMP
         #else
            ' Switch to/Create the specified section
            #if attr = ""
               asm .section sectionName
            #else
               asm .section sectionName , attr
            #endif
         #endif

         ' Assign a label to the beginning of the file
         asm .LT_START_OF_FILE_##label#:
         asm __##label##__start = .
         ' Include the file
         asm .incbin ##file
         ' Mark the end of the the file
         asm __##label##__len = . - __##label##__start
         asm .LT_END_OF_FILE_##label:
         ' Pad it with a NULL Integer (harmless, yet useful for text files)
         asm .LONG 0
         #if __FB_DEBUG__
            asm .LT_END_OF_FILE_##label##_DEBUG_JMP:
         #else
            ' Switch back to the .text (code) section
            asm .section .text
            asm .balign 16
         #endif
         asm .LT_SKIP_FILE_##label:
         asm mov dword ptr [label ] , offset .LT_START_OF_FILE_##label#
         asm mov dword ptr [label##_len ] , offset __##label##__len

      #else
         #IfnDef Var__##label##__Import__
            Extern "c"
               Extern label As UByte Ptr
               Extern label##_len As UInteger
            End Extern
         #endif
         #if __FB_DEBUG__
            asm jmp .LT_END_OF_FILE_##label##_DEBUG_JMP
         #else
            ' Switch to/create the specified section
            #if attr = ""
               asm .section sectionName
            #else
               asm .section sectionName , attr
            #endif
         #endif
         ' Assign a label to the beginning of the file
         asm .LT_START_OF_FILE_##label#:
         asm __##label##__start = .
         ' Include the file
         asm .incbin ##file
         ' Mark the end of the the file
         asm __##label##__len = . - __##label##__start
         asm .LT_END_OF_FILE_##label:
         ' Pad it with a NULL Integer (harmless, yet useful for text files)
         asm .LONG 0
         asm label:
         asm .int .LT_START_OF_FILE_##label#
         asm label##_len:
         asm .int __##label##__len
         #if __FB_DEBUG__
            asm .LT_END_OF_FILE_##label##_DEBUG_JMP:
         #else
            ' Switch back to the .text (code) section
            asm .section .text
            asm .balign 16
         #endif
         asm .LT_SKIP_FILE_##label:
      #endif

   #endmacro

   #macro IncFileMem(label, file)
      IncFilePlus(label, file,.data, "")         'Use the .data (storage) section (SHARED)
      'IncFilePlus(label, file, firo, "") ' or what you want
   #endmacro

   #macro ImportFile(label, file, NewFile)
      #define Var__##label##__Import__
      #if __FUNCTION__ <> "__FB_MAINPROC__"
         'Dim label As Const Ubyte Ptr = Any
         Dim label As Ubyte Ptr = Any
         Dim label##_len As Uinteger = Any
      #Else
         Extern "c"
            Extern label As Ubyte Ptr
            Extern label##_len As Uinteger
         End Extern
      #endif
      IncFilePlus(label, file,.data, "")         'Use the .data (storage) section (SHARED)
      MakeFileImport_(label, label##_len, NewFile)
   #endmacro

#endif



IncFileMem(inc1,"ATL.DLL")			'MakeFile(lpFile_inc1, "new path", is1_inc1)
IncFileMem(inc2,"ATL71.DLL")			'MakeFile(lpFile_inc2, "new path", is1_inc2)
IncFileMem(inc5,"atlCtl.dll")
IncFileMem(inc6,"atl71Ctl.dll")
IncFileMem(inc9,"Ax_Lite.bi")		'Mak


Private Function RegisterServer(hWnd As hwnd, filePath As String, Mode As integer=1)as integer
  Dim hLib As HMODULE
  Dim ProcAd As any ptr
  Dim sMod As String
  Dim res As integer

  if mode=0 THEN
	  sMod = "DllUnregisterServer"
  else
	  sMod = "DllRegisterServer"
  END IF

  hLib = LoadLibrary(filePath)
  ProcAd = GetProcAddress(hLib, sMod)

  res = CallWindowProc(ProcAd, hwnd, 0, 0, 0)

  FreeLibrary hLib
  Function = cast(integer,res)

End Function


' FINISH INCLUDE ¤ 001 _ C:\Documents and Settings\Perso\Mes documents\axsuite2pkg\axsuite2pkg\AxSuite2\inc_files.bi
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

'=========================================================================
'Defined Constants
'=========================================================================
Const szNULL = !"\0"
Const szOpen = "File type : Exe ; Dll ; Ocx  (*.exe ,*.dll ,ocx)" & szNULL & "*.exe;*.dll;*.ocx" & szNULL & "File type : Tlb or Olb    (*.tlb ,*.olb)" & szNULL & "*.tlb;*.olb" & szNULL
Const szSave = "Include File : bi (*.bi)" & szNULL
Const szDll = "File : dll (*.dll)" & szNULL

Const crlf = Chr$(13, 10)
Const dq = Chr$(34)
Const Tb = Chr$(9)
Const d_bc = Chr$(47,39)
Const f_bc = Chr$(39,47)

'=========================================================================
'Defined Types
'=========================================================================
Type TV_HITTESTINFO
   pt                              As POINT
   flags                           As UINT
   hitem                           As HTREEITEM
End Type

Type LPTV_HITTESTINFO As TV_HITTESTINFO ptr


'=========================================================================
'Include file from  original axhelper.bi + strwrap.bi + lv.bi + tv.bi
'=========================================================================
' Incorporated here : #Include Once "Ax_Utils.bi"                   ' axhelper + strwrap + lv + tv
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' START INCLUDE ¤ 002 _ C:\Documents and Settings\Perso\Mes documents\axsuite2pkg\axsuite2pkg\AxSuite2\Ax_Utils.bi

'from lv.bi
const LVM_SORTITEMSEX = LVM_FIRST + 81

TYPE LV_DISPINFO
   hdr                             AS NMHDR
   item                            AS LV_ITEM
END TYPE


'from axhelper.bi

'convert string to bstr
'please follow with sysfreestring(bstr) after use to avoid memory leak
Private Function StringToBSTR(cnv_string As String) As BSTR
   Dim sb As BSTR
   Dim As Integer n
   n = (MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, cnv_string, - 1, NULL, 0)) - 1
   sb = SysAllocStringLen(sb, n)
   MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, cnv_string, - 1, sb, n)
   Return sb
End Function

Private Function FromBSTR(ByVal szW As BSTR) As String
      dim as string sret
      dim as integer L1
      If szW = Null Then Return ""
      L1 = WideCharToMultiByte(CP_ACP, 0, SzW, - 1, Null, 0, Null, Null) - 1
      sret = space(L1)
      WideCharToMultiByte(CP_ACP, 0, SzW, L1, sret, L1, Null, Null)
      Return sret
   End Function



'return numeric value from variant
Private Function Variantv(ByRef v As variant) As Double
   Dim vvar As variant
   VariantChangeTypeEx(@vvar, @v, NULL, VARIANT_NOVALUEPROP, VT_R8)
   Return vvar.dblval
End Function



'from strwrap.bi
'******************************************
'remove match string from source string
'******************************************
Private Function str_remove(ByRef source As String, byref match As String) As String
   dim as long s = 1, lmt
   Dim As String txt
   txt = source
   lmt = Len(match)
   Do
      s = InStr(s, txt, match)
      If s Then txt = Left(txt, s - 1) + Right(txt, Len(txt) - lmt - (s - 1))
   Loop While s
   Function = txt
end function

'***********************************************************************
'remove any character in Match string from stxt string
'***********************************************************************
Private Function Str_removeany(ByRef source As String, ByRef match As String) As String
   dim as long s = 1
   Dim As String txt
   txt = source
   Do
      s = Instr(s, txt, Any match)
      If s Then txt = Left(txt, s - 1) + Right(txt, Len(txt) - 1 - (s - 1))
   Loop While s
   Function = txt
end Function

'***************************************************************
'count number of parse string, separated by delimiter of source
'***************************************************************
Private Function str_numparse(ByRef source as string, ByRef delimiter as string) as long
   Dim As Long s = 1, c, l
   l = Len(delimiter)
   Do
      s = instr(s, source, delimiter)
      If s then
         c += 1
         s += l
      end if
   Loop While s
   Function = c + 1
end function

'************************************************************
'parse source string, indexed by delimiter string at idx
'************************************************************
Private Function str_parse( source As String,  delimiter As String, ByVal idx As integer) As String
   Dim As integer s = 1, c, l
   l = Len(delimiter)
   Do
      If c = idx - 1 then Return mid(source, s, instr(s, source, delimiter) - s)
      s = instr(s, source, delimiter)
      If s then
         c += 1
         s += l
      end if
   Loop While s
End Function

'**********************************************************
'find index of match string as parse source by delimiter
'**********************************************************
Private Function str_parsepos(ByRef match As String, byref source As String, ByRef delimiter As String) As Integer
   Dim As Integer i
   For i = 1 To str_numparse(source, delimiter)
      If str_parse(source, delimiter, i) = match Then Return i
   Next
   Function = 0
End Function

'************************************************************************
'count number of parse string, separated by any character in delimiter string
'************************************************************************
Private Function str_numparseany(ByRef source As String, Byref delimiter As String) As Long
   Dim As Long s = 1, c
   Do
      s = Instr(s, source, Any delimiter)
      If s Then
         c += 1
         s += 1
      End If
   Loop While s
   Function = c + 1
End Function

'********************************************************************
'parse source string, separated by any character in delimiter string
'********************************************************************
Private Function str_parseany(ByRef source As String, Byref delimiter As String, ByVal idx As Long) As String
   Dim As Long s = 1, c
   Do
      If c = idx - 1 Then Return Mid(source, s, Instr(s, source, Any delimiter) - s)
      s = Instr(s, source, Any delimiter)
      If s Then
         c += 1
         s += 1
      End If
   Loop While s
End Function

'**********************************************************
'find index of match string as parse source by delimiter
'**********************************************************
Private Function str_parseanypos(ByRef match As String, byref source As String, ByRef delimiter As String) As Integer
   Dim As Integer i
   For i = 1 To str_numparseany(source, delimiter)
      If str_parseany(source, delimiter, i) = match Then Return i
   Next
   Function = 0
End Function

'*****************************************************
'count occurance of delimiter string in source string
'*****************************************************
Private function str_tally(ByRef source as string, byref delimiter as string) as long
   Dim As Long s = 1, c, l = Len(delimiter)
   Do
      s = instr(s, source, delimiter)
      If s then
         c += 1
         s += l
      end if
   Loop While s
   Function = c
End function

'**************************************************************
'count occurance of any character in del string in cmd string
'**************************************************************
Private function str_tallyany(ByRef source as string, byref delimiter as string) as long
   Dim As Long s = 1, c
   Do
      s = InStr(s, source, any delimiter)
      If s then
         c += 1
         s += 1
      end if
   Loop While s
   Function = c
End function


Private Function FF_Replace( ByRef sText        As String, _
                     ByRef sLookFor     As String, _
                     ByRef sReplaceWith As String _
                     ) As String

   Dim sTemp As String  = sText
   Dim f     As Integer = 1
   If sLookFor = sReplaceWith Then

      Function = sTemp
      Exit Function
   EndIf
   If InStr(sReplaceWith,sLookFor) Then
        Do Until f = 0
           f = InStr( sTemp, sLookFor )
           If f Then
              sTemp = Left(sTemp, f-1) & "#§§~¿~§§#" & Mid(sTemp, f + Len(sLookFor))
           End If
        Loop
        f = 1
        Do Until f = 0
          f = InStr( sTemp, "#§§~¿~§§#" )
          If f Then
             sTemp = Left(sTemp, f-1) & sReplaceWith & Mid(sTemp, f + 9)
          End If
        Loop

        Function = sTemp
        Exit Function
   EndIf
   Do Until f = 0
      f = InStr( sTemp, sLookFor )
      If f Then
         sTemp = Left(sTemp, f-1) & sReplaceWith & Mid(sTemp, f + Len(sLookFor))
      End If
   Loop

   Function = sTemp

End Function



'***********************************************************
'replace first occurance of match string with replace string in source string
'***********************************************************
Private Function str_replace(ByRef match As String, Byref sreplace As String, Byref source As String) As String
   Dim As Long s = 1, c = len(sreplace), l = len(match)
   Dim As String text
   text = source
   Do
      s = InStr(s, text, match)
      If s then
         text = Mid$(text, 1, s - 1) + sreplace + Mid$(text, s + l, - 1)
         s += c
      end if
   Loop While s
   Function = text
End Function

'****************************************************************
'replace first occurance of any character in del string with r string in cmd string
'*****************************************************************
Private Function Str_replaceany(ByRef match As String, Byref sreplace As String, Byref source As String) As String
   Dim As Long s = 1, c = len(sreplace)
   Dim As String text
   text = source
   Do
      s = InStr(s, text, Any match)
      If s then
         text = Mid$(text, 1, s - 1) + sreplace + Mid$(text, s + 1, - 1)
         s += c
      end if
   Loop While s
   Function = text
End Function

'****************************************************************
'replace all occurance of any character in del string with r string in cmd string
'*****************************************************************
Private Function str_ReplaceAll(ByRef match As String, ByRef sreplace As String, ByRef source As String) As String
   Dim text As String
   text = source
   While InStr(text, match)
      text = str_replace(match, sreplace, text)
   Wend
   Function = text
End Function

'****************************************************************
'replace all occurance of any character in del string with r string in cmd string
'*****************************************************************
Private Function str_ReplaceAnyAll(ByRef match As String, ByRef sreplace As String, ByRef source As String) As String
   Dim text As String
   text = source
   While InStr(text, Any match)
      text = str_replaceany(match, sreplace, text)
   Wend
   Function = text
End Function


'from lv.bi

Private Sub LvInit
   dim iccex AS InitCommonControlsEx
   iccex.dwSize = SIZEOF(iccex)
   iccex.dwICC = ICC_LISTVIEW_CLASSES
   InitCommonControlsEx(@iccex)
End Sub

Private SUB LVSetHeader(BYVAL lvg AS uinteger, BYVAL strItem AS STRING)
   dim szItem AS zstring * MAX_PATH              ' working variable
   dim tlvc AS LVCOLUMN                          ' specifies or receives the attributes of a listview column
   dim tlvi AS LVITEM                            ' specifies or receives the attributes of a listview item
   dim iItem AS LONG
   dim nItem AS LONG

   nItem = str_numparse(stritem, "|")

   FOR iItem = 1 TO nItem
      szItem = str_parse(stritem, "|", iItem)
      tlvc.mask = LVCF_FMT OR LVCF_WIDTH OR LVCF_TEXT OR LVCF_SUBITEM
      tlvc.fmt = LVCFMT_LEFT
      tlvc.cx = 96
      tlvc.pszText = VARPTR(szItem)
      tlvc.iSubItem = iitem - 1
      SendMessage cast(hwnd, lvg), LVM_SETCOLUMN, iitem - 1, cast(LPARAM, VARPTR(tlvc))
   NEXT
END Sub

Private Sub LVSetColFmt(BYVAL lvg AS uinteger, ByVal col As LONG, BYVAL fmt AS LONG)
   dim szItem AS zstring * MAX_PATH              ' working variable
   dim tlvc AS LVCOLUMN                          ' specifies or receives the attributes of a listview column
   'dim tlvi          AS LV_ITEM               ' specifies or receives the attributes of a listview item

   tlvc.mask = LVCF_FMT OR LVCF_SUBITEM
   tlvc.fmt = fmt
   tlvc.iSubItem = col
   SendMessage cast(hwnd, lvg), LVM_SETCOLUMN, col, cast(LPARAM, VARPTR(tlvc))

End Sub

Private SUB LVSetMaxCols(BYVAL rr AS uinteger, BYVAL cols AS LONG)
   dim tlvc AS LVCOLUMN
   dim col AS LONG

   FOR col = 0 TO cols - 1 :SendMessage cast(hwnd, rr), LVM_INSERTCOLUMN, 0, cast(LPARAM, VARPTR(tlvc)) :NEXT
END SUB

Private SUB LVSetMaxRows(BYVAL rr as uinteger, BYVAL rows AS LONG)
   dim irow AS LONG
   dim tlvi AS LVITEM
   dim glvnumrows as long
   glvnumrows = sendmessage(cast(hwnd, rr), LVM_GETITEMCOUNT, 0, 0)
   IF glvnumrows <= rows THEN
      FOR irow = glvnumrows TO rows - 1
         tlvi.iItem = irow
         SendMessage cast(hwnd, rr), LVM_INSERTITEM, irow, cast(LPARAM, VARPTR(tlvi))
      NEXT
   ELSE
      FOR irow = rows TO glvnumrows - 1
         SendMessage cast(hwnd, rr), LVM_DELETEITEM, 0, cast(LPARAM, rows)
      NEXT
   END IF
END SUB

Private SUB LVSetValue(BYVAL rr AS uinteger, BYVAL item AS LONG, BYVAL column AS LONG, BYVAL strs AS STRING)
   dim ms_lvi AS LVITEM
   dim psztext as zstring*max_path
   psztext = strs
   ms_lvi.iitem = item
   ms_lvi.iSubItem = column
   ms_lvi.pszText = @pszText
   ms_lvi.lparam = item
   SendMessage cast(hwnd, rr), LVM_SETITEMTEXT, item, cast(LPARAM, VARPTR(ms_lvi))
END SUB

Private FUNCTION LVGetValue(BYVAL rr AS uinteger, BYVAL item AS LONG, BYVAL column AS LONG) AS STRING
   dim ms_lvi AS LV_ITEM
   dim psztext as zstring*max_path
   ms_lvi.iSubItem = Column
   ms_lvi.cchTextMax = max_path
   ms_lvi.pszText = @pszText
   SendMessage cast(hwnd, rr), LVM_GETITEMTEXT, item, cast(LPARAM, @ms_lvi)
   FUNCTION = psztext
END FUNCTION

Private function lvFindItem(hList AS LONG, Value AS STRING) as integer
   DIM lvf AS LVFINDINFO
   DIM i AS integer
   DIM szStr AS zstring * 300
   DIM iStatus AS INTEGER

   lvf.flags = LVFI_STRING OR LVFI_Partial
   szStr = ucase$(Value)

   lvf.psz = @szStr
   i = SendMessage(cast(hwnd, hList), LVM_FINDITEM, - 1, cast(LPARAM, @lvf))
   IF i >= 0 THEN
      istatus = ListView_EnsureVisible(cast(hwnd, hList), i, true)
   END IF
   function = i
END function

Private SUB LVSetItem(hList AS LONG, byval item as long, Rec AS STRING)
   DIM z AS INTEGER
   DIM iStatus AS INTEGER
   DIM szStr AS zstring* 300
   DIM lvi AS LV_ITEM
   dim x AS LONG

   'this will be the next record

   lvi.iItem = item
   lvi.mask = LVIF_TEXT
   lvi.stateMask = LVIS_FOCUSED                  '%LVIS_SELECTED
   lvi.pszText = @szStr

   FOR z = 0 TO str_numparse(Rec, "|") - 1
      szStr = str_parse(Rec, "|", z + 1)
      lvi.iSubItem = z

      lvi.lParam = lvi.iItem
      IF z = 0 THEN
         lvi.mask = LVIF_TEXT OR LVIF_PARAM OR LVIF_STATE
         iStatus = ListView_setItem(cast(hwnd, hList), @lvi)
      ELSE
         lvi.mask = LVIF_TEXT
         iStatus = ListView_SetItem(cast(hwnd, hList), @lvi)
      END IF
   NEXT
END SUB


Private SUB LVAddItem(hList AS LONG, Rec AS STRING)
   DIM z AS INTEGER
   DIM iStatus AS INTEGER
   DIM szStr AS zstring* 300
   DIM lvi AS LV_ITEM
   dim x AS LONG

   'this will be the next record

   'ListView_GetItemCount(hList) '+ 1
   lvi.iItem = sendmessage(cast(hwnd, hlist), lvm_GetItemCount, 0, 0)

   lvi.mask = LVIF_TEXT
   lvi.stateMask = LVIS_FOCUSED                  '%LVIS_SELECTED
   lvi.pszText = @szStr

   FOR z = 0 TO str_numparse(Rec, "|") - 1
      szStr = str_parse(Rec, "|", z + 1)
      lvi.iSubItem = z

      lvi.lParam = lvi.iItem
      IF z = 0 THEN
         lvi.mask = LVIF_TEXT OR LVIF_PARAM OR LVIF_STATE
         iStatus = ListView_InsertItem(cast(hwnd, hList), @lvi)
      ELSE
         lvi.mask = LVIF_TEXT
         iStatus = ListView_SetItem(cast(hwnd, hList), @lvi)
      END IF
   NEXT
END SUB


'from tv.bi
Private Function TreeViewInsertItem(BYVAL hTreeView AS long, BYVAL hParent AS long, sItem AS STRING) AS LONG
   Dim tTVInsert AS TV_INSERTSTRUCT
   Dim tTVItem AS TV_ITEM

   If hParent THEN
      tTVItem.mask = TVIF_CHILDREN OR TVIF_HANDLE
      tTVItem.hItem = cast(HTREEITEM, hParent)
      tTVItem.cchildren = 1
      TreeView_SetItem(cast(hwnd, hTreeView), @tTVItem)
   END IF

   tTVInsert.hParent = cast(HTREEITEM, hParent)
   tTVInsert.Item.mask = TVIF_TEXT Or TVIF_STATE
   tTVInsert.Item.state = TVIS_EXPANDED
   tTVInsert.Item.pszText = STRPTR(sItem)
   tTVInsert.Item.cchTextMax = LEN(sItem)
   FUNCTION = cast(long, TreeView_InsertItem(cast(hwnd, hTreeView), @tTVInsert))
END Function

Private Function TreeView_GetItemText(ByVal hTreeView As Long, ByVal hItem As Long) As String
   Dim ItemText As zstring*32765
   Dim Item As TV_ITEM
   Item.hItem = cast(HTREEITEM, hItem)
   Item.Mask = TVIF_TEXT
   Item.cchTextMax = 32765
   Item.pszText = @ItemText
   SendMessage cast(hwnd, hTreeView), TVM_GETITEM, 0, cast(LPARAM, @Item)
   Function = ItemText
End Function

Private Function TreeView_ChangeChildState(ByVal hTreeView As Long, ByVal hItem As Long, ByVal iState As Long) As Long
   Dim hTmpItem As HTREEITEM
   Dim TVITEM As TV_ITEM
   hTmpItem = TreeView_GetChild(cast(hwnd, hTreeView), hItem)
   While hTmpItem
      TVITEM.mask = TVIF_STATE Or TVIF_HANDLE
      TVITEM.hItem = hTmpItem
      TVITEM.stateMask = TVIS_STATEIMAGEMASK
      TVITEM.state = (iState + 1) Shl 12
      sendmessage cast(hwnd, hTreeView), TVM_SetItem, 0, cast(LPARAM, @TVITEM)
      TreeView_ChangeChildState hTreeView, cast(long, hTmpItem), iState
      hTmpItem = treeview_getnextitem(cast(hwnd, htreeview), hTmpItem, TVGN_NEXT)
   wend
   function = 1
End Function

Private Function TreeView_ChangeParentState(ByVal hTreeView As Long, ByVal hItem As Long, ByVal iState As Long) As Long
   Dim hTmpItem As HTREEITEM
   Dim TVITEM As TV_ITEM
   hTmpItem = TreeView_GetParent(cast(hwnd, hTreeView), hItem)
   If hTmpItem then
      TVITEM.mask = TVIF_STATE Or TVIF_HANDLE
      TVITEM.hItem = hTmpItem
      TVITEM.stateMask = TVIS_STATEIMAGEMASK
      TVITEM.state = (iState + 1) Shl 12
      sendmessage cast(hwnd, hTreeView), TVM_SetItem, 0, cast(LPARAM, @TVITEM)
      TreeView_ChangeParentState hTreeView, cast(long, hTmpItem), 0
   End If
   function = 1
End Function

Private Function TreeView_SetCheckState(ByVal hTreeView As Long, ByVal hItem As Long, ByVal iState As Long) As Long
   Dim TVITEM As TV_ITEM
   TVITEM.mask = TVIF_STATE Or TVIF_HANDLE
   TVITEM.hItem = cast(HTREEITEM, hItem)
   TVITEM.stateMask = TVIS_STATEIMAGEMASK
   TVITEM.state = (iState + 1) Shl 12
   sendmessage cast(hwnd, hTreeView), TVM_SetItem, 0, cast(LPARAM, @TVITEM)
   function = 1
End Function

Private Function TreeView_GetCheckState(ByVal hWnd1 As Long, ByVal hItem As Long) As Long
   Dim tvItem As TV_ITEM
   tvItem.mask = TVIF_HANDLE Or TVIF_STATE
   tvItem.hItem = cast(HTREEITEM, hItem)
   tvItem.stateMask = TVIS_STATEIMAGEMASK
   sendmessage cast(hwnd, hwnd1), TVM_GetItem, 0, cast(LPARAM, @tvItem)
   tvItem.state Shr= 12
   tvItem.state -= 1
   Function = tvItem.state Xor 1
End Function

Const TV_UNCHECKED as integer = 1  ' for treeview checked
Const TV_CHECKED as integer = 2

'---------------------------------------------------
'Determines if the current state image of the
'specified treeview item is set to the checked
'checkbox image index.
'
'hwndTV - treeview window handle
'hItem - item's handle whose checkbox state is to be to returned
'
'Returns true if the item's state image is
'set to the checked checkbox index, returns
'false otherwise.
'---------------------------------------------------
Private Function IsTVItemChecked(hwndTV as Long, hItem as Long) as integer
	Dim tvi as TV_ITEM
	dim i1 as integer
	'Initialize the struct and get the item's state value.
	With tvi
	.mask = TVIF_STATE
	.hItem = cast(HTREEITEM, hItem)
	.stateMask = TVIS_STATEIMAGEMASK
	End With
	sendmessage cast(hwnd, hwndTV), TVM_GetItem, 0, cast(LPARAM, @tvi)
	'We have to test to see if the treeview
	'checked state image *is* set since the logical
	'And test on the unchecked image (1) will
	'evaluate to true when either checkbox image
	'is set.
	i1=(tvi.state And INDEXTOSTATEIMAGEMASK(TV_CHECKED))
	i1 Shr= 13
	function = i1

End Function


Private Function FF_FileName (Src As String) As String
    Dim x As Integer
    x = InStrRev( Src, Any ":/\")
    If x Then
        Function = Mid(Src, x + 1)
    Else
        Function = Src
    End If
End Function

' FINISH INCLUDE ¤ 002 _ C:\Documents and Settings\Perso\Mes documents\axsuite2pkg\axsuite2pkg\AxSuite2\Ax_Utils.bi
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤



'=========================================================================
'Defined constant in .rc file.
'Please delete this section if you have included exported names of resource.
'=========================================================================
#define dlgMain 1000
#define IDC_TAB1 1001
#define IDC_STC3 1002
#define IDC_EDT1 1003
#define IDC_SBR1 1004

#define dlgList 1100
#define IDC_LSV1 1101
#define dlgCode 1200
#define IDC_RED1 1201
#Define dlgTree 1300
#define IDC_TRV1 1301
#define dlgAbout 1400
#define IDC_STC1 1402

#define dlg_Ask 1410
#define IDC_BTN21 1412
#define IDC_EDT11 1413
#define IDC_BTN11 1414
#define IDC_STC11 1415

#define IDC_STC31 1430
#define IDC_EDT31 1432


#define IDR_MENU1 10000
#define IDM_TypeLibs 10001
#define tlb_reged 10002
#define tlb_libfile 10003
#define tlb_exit 10004
#define IDM_Code 10005
#define code_const 10006
#define code_Module 10007
#define code_vtable 10008
#define code_Invoke 10009
#define code_event 10010
#define IDM_Help 10011
#define hlp_About 10012
#Define hlp_axsuite 10013
#Define code_init 10014
#Define code_full 10015
#define code_codegen 10016
#define code_save 10017
#Define code_full2 10018
#define code_ident 10019
#Define uOcx1 10020
#Define uOcx2 10021
#Define codll 10022
#Define codll71 10023
#Define aodll 10024
#Define aodll71 10025
#Define regf 10026
#Define unregl 10027
#Define code_Disp 10028
#Define code_Disp2 10029
#Define code_mkDisp2 10030
'#Define Static3 10031
'#Define Static4 10032
#Define Static5 10033
#Define Static6 10034
#define Search_F2 10035
#define Search_F3 10036
#define Search_F4 10037

#define code_Cop 10041
#define code_All 10042
#define code_Not 10043
#define code_Copall 10044


#define As_AxSuite 10060
#define As_DispHelper 10061

#define Copy_GUID 10071
#define Copy_NAME 10072
#define Copy_PATH 10073
#define code_search 1480
#define code_search1 1481
#define code_search2 1482
'=========================================================================
'Global variable
'=========================================================================
dim iccex AS InitCommonControlsEx
Dim Shared as HINSTANCE hinstance
Dim Shared As hwnd htab0, htab1, htab2, hList, hCode, hTree, hmain
Dim Shared as HMENU hPopupMenu
Dim shared hIDC_RED1 as HWND
Dim Shared As Integer lviewsort
dim Shared selpath as zstring*max_path, prefix As ZString*11
Dim shared as string clsids, tldesc,OcxName
Dim Shared hParent(7) As Long, rtab As rect
dim shared As integer ABOUT_TIMER
Dim Shared hdll As Any Ptr
Dim Shared sreport As String, savepath As String
Dim Shared ptli as lptypelib
Dim Shared EvtList As String
Dim Shared searching As String
Dim Shared HWND_FORM1_LISTVIEW1 as hwnd
Dim shared As integer pos0,pos0bak
Dim shared as integer nt1,nowin , icoclass ,isevent ,nook
Dim shared as integer gene1,xret1,xret2,xfull,notsure
Dim Shared searching2 As String, iscod as integer
dim shared as string coclass(),sevent,sinfcode
'=========================================================================
'declarations
'=========================================================================
declare Function FF_ClipboardSetText(ByVal TheText As String) As Long
Declare Sub showinfo()
declare sub dlgMain_IDC_TAB1_Sample(byval hWin as hwnd, byval CTLID as integer)
declare Function dlgMain_Init(Byval hWin as hwnd, Byval wParam as wParam, Byval lParam as lParam) as Integer
declare Function dlgMain_OnSize(Byval hWin as hwnd, Byval lState as long, Byval cx as long, Byval cy as long) as Integer
declare Function dlgMain_OnClose(Byval hWin as hwnd) as Integer
declare Function dlgMain_OnDestroy(Byval hWin as hwnd) as Integer
declare Function dlgMain_OnNotify(Byval hWin as hwnd, Byval lCtlID as long, Byval lpNMHDR as NMHDR ptr, Byref lresult as long) as Integer
declare Function dlgMain_OnTimer(Byval hWin as hwnd, Byval wTimerID as word) as Integer
declare Function dlgMain_IDC_TAB1_SelChange(byval hWin as hwnd, byval lpNMHDR as NMHDR ptr, Byref lresult as long) as long
declare Function dlgMain_IDC_TAB1_SelChanging(byval hWin as hwnd, byval lpNMHDR as NMHDR ptr, Byref lresult as long) as long
declare Function dlgMain_IDR_MENU1_menu(byval hwin as hwnd, byval id as long) as long
declare sub dlgList_IDC_LSV1_Sample(byval hWin as hwnd, byval CTLID as integer)
declare Function dlgList_Init(Byval hWin as hwnd, Byval wParam as wParam, Byval lParam as lParam) as Integer
declare Function dlgList_OnSize(Byval hWin as hwnd, Byval lState as long, Byval cx as long, Byval cy as long) as Integer
declare Function dlgList_OnClose(Byval hWin as hwnd) as Integer
declare Function dlgList_OnDestroy(Byval hWin as hwnd) as Integer
declare Function dlgList_OnNotify(Byval hWin as hwnd, Byval lCtlID as long, Byval lpNMHDR as NMHDR ptr, Byref lresult as long) as Integer
declare Function dlgList_OnTimer(Byval hWin as hwnd, Byval wTimerID as word) as Integer
declare function dlgList_IDC_LSV1_Clicked(Byval hWin as hwnd, Byval pNMLV as NMLISTVIEW ptr) as long
declare Function dlgCode_Init(Byval hWin as hwnd, Byval wParam as wParam, Byval lParam as lParam) as Integer
declare Function dlgCode_OnSize(Byval hWin as hwnd, Byval lState as long, Byval cx as long, Byval cy as long) as Integer
declare Function dlgCode_OnClose(Byval hWin as hwnd) as Integer
declare Function dlgCode_OnDestroy(Byval hWin as hwnd) as Integer
declare Function dlgCode_OnNotify(Byval hWin as hwnd, Byval lCtlID as long, Byval lpNMHDR as NMHDR ptr, Byref lresult as long) as Integer
declare Function dlgCode_OnTimer(Byval hWin as hwnd, Byval wTimerID as word) as Integer
declare Function dlgTree_Init(Byval hWin as hwnd, Byval wParam as wParam, Byval lParam as lParam) as Integer
declare Function dlgTree_OnSize(Byval hWin as hwnd, Byval lState as long, Byval cx as long, Byval cy as long) as Integer
declare Function dlgTree_OnClose(Byval hWin as hwnd) as Integer
declare Function dlgTree_OnDestroy(Byval hWin as hwnd) as Integer
declare Function dlgTree_OnNotify(Byval hWin as hwnd, Byval lCtlID as long, Byval lpNMHDR as NMHDR ptr, Byref lresult as long) as Integer
declare Function dlgTree_OnTimer(Byval hWin as hwnd, Byval wTimerID as word) as Integer
declare Function dlgAbout_Init(Byval hWin as hwnd, Byval wParam as wParam, Byval lParam as lParam) as Integer
declare Function dlgAbout_OnSize(Byval hWin as hwnd, Byval lState as long, Byval cx as long, Byval cy as long) as Integer
declare Function dlgAbout_OnClose(Byval hWin as hwnd) as Integer
declare Function dlgAbout_OnDestroy(Byval hWin as hwnd) as Integer
declare Function dlgAbout_OnNotify(Byval hWin as hwnd, Byval lCtlID as long, Byval lpNMHDR as NMHDR ptr, Byref lresult as long) as Integer
declare Function dlgAbout_OnTimer(Byval hWin as hwnd, Byval wTimerID as word) as Integer
declare Function dlgMain_DlgProc(byval hWin as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as integer
declare Function dlgList_DlgProc(byval hWin as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as integer
declare Function dlgCode_DlgProc(byval hWin as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as integer
declare Function dlgTree_DlgProc(byval hWin as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as Integer
declare Function dlgAbout_DlgProc(byval hWin as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as Integer
declare Function dlgAsk_DlgProc(byval hWin as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as Integer
declare Function AskMain(ByVal hwParent As hwnd) As Integer
declare Function AskMain2(ByVal hwParent As hwnd) As Integer
declare Function StringToBSTR1(cnv_string As String) As BSTR
declare Function TreeView_GetItemText1(ByVal hTreeView As Long, ByVal hItem As Long) As String
declare sub GetCopy1(posi1 as integer)
declare function tab_pos(hWin1 as hwnd) as integer
declare function FF_ListView_SetSelectedItem(byval hlist as hwnd, byval i as integer) as integer
declare function dlgList_IDC_LSV1_Click1(Byval hWin as hwnd, Byval pNMLV as NMLISTVIEW ptr) as long
declare function force_click(hWin as hwnd) as integer
declare Function FF_ListView_GetItemText(ByVal hWndControl As hWnd, ByVal iRow As Integer, ByVal iColumn As Integer ) As String
declare Function FF_ListView_GetSelectedItem(ByVal hWndControl As hWnd) As Integer
declare sub search1()
'=========================================================================
'Include files of code
'=========================================================================
' Incorporated here : #Include Once "tlbcode1.bi"
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' START INCLUDE ¤ 003 _ C:\Documents and Settings\Perso\Mes documents\axsuite2pkg\axsuite2pkg\AxSuite2\tlbcode1.bi

Private sub GetPrefix()
	sendmessage getdlgitem(hmain, idc_edt1), wm_gettext, 10, cast(lparam, @prefix)
END sub

Private Function TreeView_GetCheckState1( ByVal hWnd As Long, ByVal hItem As long ) As uinteger
	Dim tvItem As TV_ITEM
	dim as uinteger st1
	tvItem.mask         = TVIS_SELECTED'TVIF_HANDLE Or TVIF_STATE
	tvItem.hItem        = cast(HTREEITEM, hItem)
	tvItem.stateMask    = TVIS_SELECTED'TVIS_STATEIMAGEMASK
	If TreeView_GetItem (cast(hwnd,hWnd), @tvItem ) = 0 Then
		Return 0
	Else
		st1=tvItem.state
		if st1 > 4193 THEN
			Return 1
		else
			Return 0
      END IF
	End If
End Function


Private Function TreeView_GetItemText1(ByVal hTreeView As Long, ByVal hItem As Long) As String
   Dim ItemText As zstring*32765
	Dim Item As TV_ITEM
	dim as integer gi1= TreeView_GetCheckState1(hTreeView,hItem)
	'dim as integer gi2= IsTVItemChecked(hTreeView,hItem)
		Item.hItem = cast(HTREEITEM, hItem)
		Item.Mask = TVIF_TEXT
		Item.cchTextMax = 32765
		Item.pszText = @ItemText
		SendMessage cast(hwnd,hTreeView), TVM_GETITEM, 0, cast(LPARAM,@Item)
	if gi1=0 and xfull = 0 THEN
		function= ItemText & "          'NOT'" ' 10 spaces
	else
		Function = ItemText
	end if
	'print "State = " & str(gi1) & crlf & ">" ;ItemText :print "State2 = " & str(gi2) :print
End Function



Private Sub putEvtList Cdecl Alias "putEvtList"(evt As String)
   EvtList &= evt & "|"
	'print EvtList
End Sub

Private Sub clrEvtList Cdecl Alias "clrEvtList"()
   EvtList = ""
End Sub

Private Function inEvtList(evt As String) As Long
   For i As Short = 1 To str_numparse(evtlist, "|")
      If evt = str_parse(evtlist, "|", i) Then Return TRUE
   Next
End Function

Private sub inEvtList2()
   For i As Short = 1 To str_numparse(evtlist, "|")
      'print str(i) & "  :  " &  str_parse(evtlist, "|", i)
   Next
End sub






Private Function EnumCoClass2 (hTree As Long, hParent() As long) As String
   Dim Parents() As Long
   Dim hNextItem As Long
   Dim HasChilds As Long
   Dim token As String
   Dim As String clsids,  tldesc
   Dim hItem as long

   Dim s as string
	redim Parents(0)
	hItem = hparent(tkind_coclass)
   tldesc = TreeView_GetItemText(hTree, cast(long, treeview_getnextitem(cast(hwnd, htree), hitem, TVGN_PARENT)))
   haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hitem))
   If haschilds Then
      hnextitem = haschilds
      While hnextitem
         token = TreeView_GetItemText(hTree, hNextItem)
         clsids &=  str_parse(token, "?", 1) & "=" & dq & str_parse(token, "?", 2) & dq & crlf
          hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
      Wend
   End If

   's &= "'CLSID - " & tldesc & crlf
   s &= clsids & crlf

   Return s
End Function


Private Function EnumvTable cdecl Alias "EnumvTable"(hTree As Long, hParent() As long) As zString Ptr
   Dim Parents() As Long
   Dim hNextItem As Long
   Dim HasChilds As Long
   Dim hItem1 as Long,virg as integer,xvir as integer,in1 as integer,bevent as integer
   Dim token As String, s0 As String, tldesc As String, cor1 as string, cor2 as string, cor3 as string,sp1 as string
   Dim xface As String, memid As Integer, member As String, offs As Integer
	redim Parents(0)
   Dim s as String,us as string,xface0 as string,svt as string,s1 as string
	dim as string str1, strclasses, interf, siid
	GetPrefix()
	'strclasses =EnumCoClass2 (hTree , hParent())
	's &=strclasses
	str1 = trim(prefix, any "-_ ")
   hItem1 = hparent(tkind_interface)
   tldesc = TreeView_GetItemText(hTree, cast(long, treeview_getnextitem(cast(hwnd, htree), hitem1, TVGN_PARENT)))
   'print "tldesc = " ; tldesc
	haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hitem1))
	'print "haschilds = ";haschilds
   If haschilds Then
      svt &= "'" & String(80, "=") & crlf
      svt &= "'vTable - " & tldesc & crlf
      svt &= "'" & String(80, "=") & crlf
      hnextitem = haschilds
      While hnextitem
         token = TreeView_GetItemText(hTree, hNextItem)
			'print "token = ";token
         haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hnextitem))
			'haschilds = treeview_getchild( htree, hnextitem)
			'print "haschilds =";haschilds ; "  UBound(parents)= " ;UBound(parents)
         If haschilds <> 0 And UBound(parents) = 0 Then
			'If haschilds <> 0 And UBound(parents) < 1 Then
				interf = str_parse(token, "?", 2)
				'print "interf >" ; interf ; "<"
            'xface = str1 & str_parse(token, "?", 1)

				xface = str_parse(token, "?", 1)
				xface0=xface
				xface= str1 & xface
            bevent = inevtlist(xface0)
            If bevent=0 THEN
					if instr(ucase(xface0),"EVENT") THEN bevent= 2
				end if
				s1 = "'" & String(80, "=") & crlf
				s1 &= "'Interface " &  xface & "     ?" & str_parse(token, "?", 3) & crlf
				s1 &= "'Const IID_" &  xface & "=" & dq & str_parse(token, "?", 2) & dq & crlf
				s1 &= "'" & String(80, "=") & crlf
				s1 &= "Type " &  xface & "vTbl" & crlf

         ElseIf (UBound(parents) <> 0) Then
			'ElseIf (UBound(parents) > 0) Then
            memid = Val(str_parse(token, "?", 1))
            member = str_parse(token, "?", 3) & "     '" & str_parse(token, "?", 4)
				'print " memid = " & memid
				'print "member = " & member
            If offs = 0 Then
               If memid > 8 Then
                  s1 &= tb & "QueryInterface As Function (Byval pThis As Any ptr,Byref riid As GUID,Byref ppvObj As Dword) As hResult" & crlf
                  s1 &= tb & "AddRef As Function (Byval pThis As Any ptr) As Ulong" & crlf
                  s1 &= tb & "Release As Function (Byval pThis As Any ptr) As Ulong" & crlf
                  offs = 8
               End If
               If memid > 24 Then
                  s1 &= tb & "GetTypeInfoCount As Function (Byval pThis As Any ptr,Byref pctinfo As Uinteger) As hResult" & crlf
                  s1 &= tb & "GetTypeInfo As Function (Byval pThis As Any ptr,Byval itinfo As Uinteger,Byval lcid As Uinteger,Byref pptinfo As Any Ptr) As hResult" & crlf
                  s1 &= tb & "GetIDsOfNames As Function (Byval pThis As Any ptr,Byval riid As GUID,Byval rgszNames As Byte,Byval cNames As Uinteger,Byval lcid As Uinteger,Byref rgdispid As Integer) As hResult" & crlf
                  s1 &= tb & "Invoke As Function (Byval pThis As Any ptr,Byval dispidMember As Integer,Byval riid As GUID,Byval lcid As Uinteger,Byval wFlags As Ushort,Byval pdispparams As DISPPARAMS,Byref pvarResult As Variant,Byref pexcepinfo As EXCEPINFO,Byref puArgErr As Uinteger) As hResult" & crlf
                  offs = 24
               End If
            End If
            s0 = ""
            offs = memid - offs - 4
            If offs > 0 Then s0 = "(" &(offs - 1) & ") As Byte" & crlf
            offs = memid
            If Len(s0) Then s1 &= tb & "Offset" & offs & s0

'				if instr(ucase(member),")AS HRESULT ") = 0 and instr(ucase(member),") AS HRESULT ") = 0 then
'					if instr(member," As Function(")>0 then
'						member=FF_replace(member," As Function("," As Sub(")
'					end if
'					'print member
'				end if
            If InStr(member, "()") and InStr(member, " As Sub()")>0 Then
					s1 &= tb & str_parse(member, "(", 1) & "(ByVal pThis As Any Ptr)" & crlf
				elseIf InStr(member, "()") and InStr(member, " As Function()")>0 Then
               s1 &= tb & str_parse(member, "(", 1) & "(ByVal pThis As Any Ptr" & Mid(member, Len(str_parse(member, "(", 1)) + 2, - 1) & crlf
            ElseIf InStr(member, "()")= 0 then
					cor1= str_parse(member, "(", 1) & "(ByVal pThis As Any Ptr," & Mid(member, Len(str_parse(member, "(", 1)) + 2, - 1) & crlf

					sp1= ") As " & str_parse(cor1,") As ",str_numparse(cor1, ") As " ))
					cor1= str_parse(cor1,") As ",1)
					virg = str_numparse(cor1, "," )
					for xvir = 2 to virg
						cor2 = str_parse(cor1, "," , xvir)
						if instr(cor2," As ") THEN
							cor3 = "ByVal " & cor2
							cor1 = FF_Replace( cor1 ,cor2,cor3)
                  END IF
               NEXT

					cor1 = FF_Replace( cor1 ,",ByVal  As",",ByVal VarAny As")
				   s1 &= tb & cor1 & sp1
            End If

         End If

         If haschilds Then
            ReDim Preserve parents(UBound(parents) + 1)
            parents(UBound(parents)) = hnextitem
            hnextitem = haschilds
         Else
            hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
            If hnextitem = 0 And UBound(parents) > 0 Then
               hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), parents(UBound(parents)), TVGN_NEXT))
               ReDim Preserve parents(UBound(parents) - 1)
               s1 &= "End Type      '" &  xface & "vTbl" & crlf & crlf
               s1 &= "Type " &  xface & "_"& crlf
               s1 &= tb & "lpvtbl As " &  xface & "vTbl Ptr" & crlf
               s1 &= "End Type" & crlf & crlf
					if bevent=0 then us &= tb & "Type  " & xface & "    as  " & xface & "_     ' Interface :  " &  xface  & crlf
					s1 &= tb & "'     best way to do ...            Dim Shared As " & xface & " ptr  " & str1 & "pVTI  " & crlf
					s1 &= tb & "'     ex:  "  & str1 & "pVTI->lpvtbl->SetColor( " & str1 & "pVTI ,...)" & crlf
					s1 &= tb & "'     or    Ax_Vt ( " & str1 & "pVTI , SetColor ,...)" & crlf
					s1 &= tb & "'     or    Ax_Vt0 ( " & str1 & "pVTI , About )" & crlf & crlf
					in1=0
					for xvir = 1 to icoclass
						if coclass(xvir,5) = interf THEN
							'print coclass(xvir,4)
							in1=xvir
							exit for
                  END IF
               NEXT
					if in1 THEN
						s1 &= "Function Create_" & xface & "() As any ptr" & crlf
						s1 &= tb & "Function = AxCreate_object( """ & coclass(in1,3) & """ , """ & coclass(in1,5)& """ )" & crlf
						s1 &= "End Function" & crlf & crlf
						s1 &= " ' use  normaly    like that  :      " & str1 & "pVTI = " & str1 & "Obj_Ptr" & crlf
						s1 &= " ' but if problem try         :      " & str1 & "pVTI = Create_" & xface & "()"  & crlf & crlf & crlf
					else
						s1 &= " ' use   " & str1 & "pVTI = " & str1 & "Obj_Ptr" & crlf & crlf & crlf
               END IF
					if bevent=0 then  s &= s1
               offs = 0
            End If
         End If
      Wend

   End If
	if s <> "" THEN
		s = "'" & String(80, "*") & crlf & "'  Interface vTable Types :" & crlf & crlf & us & crlf & crlf & "'" & String(80, "*") & crlf & crlf & s
		s = svt & crlf & crlf & s
	END IF

   'print s

	if instr(s , " _Collection Ptr" ) THEN
		us= "'================================================================================" & crlf & crlf
		us &= "'Interface _Collection  , Standard Vb6/Vba collection vTable needed here" & crlf & crlf
		us &= "Type _CollectionvTbl" & crlf
		us &= tb & "QueryInterface As Function (Byval pThis As Any ptr,Byref riid As GUID,Byref ppvObj As Dword) As hResult" & crlf
		us &= tb & "AddRef As Function (Byval pThis As Any ptr) As Ulong" & crlf
		us &= tb & "Release As Function (Byval pThis As Any ptr) As Ulong" & crlf
		us &= tb & "GetTypeInfoCount As Function (Byval pThis As Any ptr,Byref pctinfo As Uinteger) As hResult" & crlf
		us &= tb & "GetTypeInfo As Function (Byval pThis As Any ptr,Byval itinfo As Uinteger,Byval lcid As Uinteger,Byref pptinfo As Any Ptr) As hResult" & crlf
		us &= tb & "GetIDsOfNames As Function (Byval pThis As Any ptr,Byval riid As GUID,Byval rgszNames As Byte,Byval cNames As Uinteger,Byval lcid As Uinteger,Byref rgdispid As Integer) As hResult" & crlf
		us &= tb & "Invoke As Function (Byval pThis As Any ptr,Byval dispidMember As Integer,Byval riid As GUID,Byval lcid As Uinteger,Byval wFlags As Ushort,Byval pdispparams As DISPPARAMS,Byref pvarResult As Variant,Byref pexcepinfo As EXCEPINFO,Byref puArgErr As Uinteger) As hResult" & crlf
		us &= tb & "Item As Function(ByVal pThis As Any Ptr,ByVal Index As VARIANT Ptr,ByVal pvarRet As VARIANT Ptr) As HRESULT      '" & crlf
		us &= tb & "Add As Function(ByVal pThis As Any Ptr,ByVal Item As VARIANT Ptr,ByVal Key As VARIANT Ptr=0,ByVal Before As VARIANT Ptr=0,ByVal After As VARIANT Ptr=0) As HRESULT     '" & crlf
		us &= tb & "Count As Function(ByVal pThis As Any Ptr,ByVal pi4 As Integer Ptr) As HRESULT     '" & crlf
		us &= tb & "Remove As Function(ByVal pThis As Any Ptr,ByVal Index As VARIANT Ptr) As HRESULT     '" & crlf
		us &= tb & "_NewEnum As Function(ByVal pThis As Any Ptr,ByVal ppunk As LPUNKNOWN Ptr) As HRESULT     '" & crlf
		us &= "End Type      '_CollectionvTbl" & crlf & crlf
		us &= "Type _Collection" & crlf
		us &= tb & "lpvtbl As _CollectionvTbl Ptr" & crlf
		us &= "End Type" & crlf
		us &= "'================================================================================" & crlf
		s = us & crlf & s
   END IF

	Return cast(zstring ptr, sysallocstringbytelen(s, len(s)))
End Function

Private Function EnumInvoke cdecl Alias "EnumInvoke"(hTree As Long, hParent() As long) As zString Ptr
   Dim Parents() As Long
   Dim hNextItem As Long
   Dim HasChilds As Long

   Dim token As String, tldesc As String
   Dim hItem as Long
   Dim xface As String, memid As String, member As String,s1 as string,xface0 as string,sinv as string
   Dim As Integer cpar,  bevent
   '  Dim s22 as String
   Dim s as String
	dim as string str1
	redim Parents(0)
	GetPrefix()
	str1 = trim(prefix, any "-_ ")
	'inEvtList2()
   hItem = hparent(tkind_dispatch)
   tldesc =  TreeView_GetItemText(hTree, cast(long, treeview_getnextitem(cast(hwnd, htree), hitem, TVGN_PARENT)))
   haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hitem))
   If haschilds Then
      sinv = "'" & String(80, "=") & crlf
      sinv &= "'Invoke - " & tldesc & crlf
      sinv &= "'" & String(80, "=") & crlf
      hnextitem = haschilds
      While hnextitem
         token = TreeView_GetItemText(hTree, hNextItem)
         haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hnextitem))
         If (haschilds <> 0) And (UBound(parents) = 0) Then
            'xface = str1 & str_parse(token, "?", 1)
				xface = str_parse(token, "?", 1)
				xface0=xface
				xface= str1 & xface
            bevent = inevtlist(xface0)
				If bevent=0 THEN
					if instr(ucase(xface0),"EVENT") THEN bevent= 2
				end if
				'print xface0 & "  = " & str(bevent)
            s1 = "'" & String(80, "=") & crlf
            s1 &= "'Dispatch " & xface & "     ?" & str_parse(token, "?", 3) & crlf
            s1 &= "'Const IID_" & xface & "=" & dq & str_parse(token, "?", 2) & dq & crlf
            s1 &= "'" & String(80, "=") & crlf
            s1 &= "Type " & xface & crlf
         ElseIf (UBound(parents) <> 0) then
            memid = str_parse(token, "?", 1)
            member = str_parse(token, "?", 3)
				member = FF_Replace( member , "Const ", "")
				member=rtrim(member,any"'= " & dq)
				if instr(member,")")=0 and instr(member,"(")THEN member=member & ")"

            cpar = str_numparse(member, ",")
            If Len(str_parse(str_parse(member, "(", 2), ")", 1)) = 0 Then cpar = 0
				s1 &=tb & str_parse(member," As ",1) & " As tMember = ("
				's22 &=tb & str_parse(member," As ",1)
				s1 &= memid & ",2," & cpar & "," & str_parse(token,"?",2) & ")    '" & str_remove(member,str_parse(member," As ",1))  & crlf
            ' s22 &=str_remove(member,str_parse(member," As ",1))  & crlf
         End If

         If haschilds Then
            ReDim Preserve parents(UBound(parents) + 1)
            parents(UBound(parents)) = hnextitem
            hnextitem = haschilds
         Else
            hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
            If hnextitem = 0 And UBound(parents) > 0 Then
               hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), parents(UBound(parents)), TVGN_NEXT))
               ReDim Preserve parents(UBound(parents) - 1)
					s1 &= tb & "pMark As Integer = -1" & crlf
					s1 &= tb & "pThis As Integer" & crlf
               s1 &= "End Type        ' " & xface & crlf & crlf
					s1 &= "	'Use like that to use these dispach/invoke functions" & crlf
					s1 &= "	'  Dim Shared As " & xface & " " & str1 & "Obj_Disp" & crlf
					s1 &= "	'  SetObj ( @" & str1 & "Obj_Disp , " & str1 & "Obj_Ptr ) ' connect to object"  & crlf
					s1 &= "	'  ex : AxCall " & str1 & "Obj_Disp.putMonth,vptr(05)"  & crlf & crlf & crlf
					if bevent =0 THEN s &=s1
				End If

         End If

      Wend
		if s <> "" THEN s = sinv & crlf & crlf & s
   End If
   'print s22
   Return cast(zstring ptr, sysallocstringbytelen(s, len(s)))
End Function

Function EnumEvent2 (hTree As Long, hParent() As long, hItem as Long )as String
	Dim Parents() As Long
   Dim hNextItem As Long
   Dim HasChilds As Long

   Dim token As String, tldesc As String

   Dim As String xface, member, help, temp ,xface0,us,memberF,memberV, temp2
   Dim As Integer  bevent,numF,x1,itemp

   Dim s as String
	dim as string str1,st_evt(),st_M(),sieven  ',st_F()
	redim Parents(0)
	redim st_evt(0)
	'redim st_F(0)
	redim st_M(0)
	numF = 0

	GetPrefix()
	str1 = trim(prefix, any "-_ ")

	'print "sevent = " ; sevent
   'hItem = hparent(tkind_interface)

   tldesc = str1 & TreeView_GetItemText(hTree, cast(long, treeview_getnextitem(cast(hwnd, htree), hitem, TVGN_PARENT)))
   haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hitem))
   If haschilds Then


      us = "'" & String(80, "=") & crlf
      us &= "'Event - " & tldesc & crlf
      us &= "'" & String(80, "=") & crlf
      hnextitem = haschilds
      While hnextitem

         token = TreeView_GetItemText(hTree, hNextItem)
         haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hnextitem))
         If (haschilds <> 0) And (UBound(parents) = 0) Then
				xface = str_parse(token, "?", 1)
				xface0=xface
				xface= str1 & xface
            bevent = inevtlist(xface0)
            If bevent Then
					sieven = str_parse(token, "?", 2)
					'print "sieven = " ; sieven
					if sevent = "" or sieven = sevent THEN
						s &= "'" & String(80, "=") & crlf
						s &= "'Event vTable - " & xface & "     ?" & str_parse(token, "?", 3) & crlf
						s &= "Const " & xface & "_Ev_IID_CP = " & dq & str_parse(token, "?", 2) & dq & crlf
						s &= "'" & String(80, "=") & crlf & crlf & crlf
               END IF
            End If
         ElseIf (UBound(parents) <> 0) then
            numF +=1
            memberF = str_parse(token, "?", 3)
				memberF = FF_Replace(memberF,"   "," ")
				memberF = FF_Replace(memberF,"  "," ")
				memberF = FF_Replace(memberF,"  "," ")
				memberF = FF_Replace(memberF,"  "," ")
				memberF = trim (memberF)
				temp2 = memberF
				memberF = lcase(memberF)

            help = str_parse(token, "?", 4)

            redim preserve st_evt(1 to numF )
				'redim preserve st_F(1 to numF)
				redim preserve st_M(1 to numF)
				itemp = instr(memberF, " as ")

				member = left(temp2,itemp -1)

				st_M(numF)= xface & "_" & member
				If InStr(memberF, " as sub()")>0 or InStr(memberF, " as sub ()")> 0 _
							or	InStr(memberF, " as sub ( )")>0 or	InStr(memberF, " as sub( )")>0 Then
					memberF= member & "     As Sub ( ByVal pThis As Any Ptr )"
				elseIf InStr(memberF, " as function()")>0 or InStr(memberF, " as function ()")> 0 _
							or	InStr(memberF, " as function ( )")>0 or	InStr(memberF, " as function( )")>0 Then
               memberF= member & "     As Function ( ByVal pThis As Any Ptr )" & str_parse(temp2, ")", 2)
				elseIf InStr(memberF, " as function(")>0 or InStr(memberF, " as function (")> 0 then
					memberF= member & "     As Function ( ByVal pThis As Any Ptr , " & str_parse(temp2, "(", 2)
				elseIf InStr(memberF, " as sub(")>0 or InStr(memberF, " as sub (")> 0 then
					memberF= member & "     As Sub ( ByVal pThis As Any Ptr , " & str_parse(temp2, "(", 2)
				end if



				st_evt(numF )= memberF

				'print memberF

				temp = mid(memberF, instr(memberF," As ") +3)
				temp = trim(temp)

				'print " temp = " & temp & "   numf = " & str(numF)

				if left(temp,3)="Sub" THEN
					temp = "Sub " &  st_M(numF) & "( " & str_parse(temp, "(", 2)

				else
					temp = "Function " &  st_M(numF) & "( " & str_parse(temp, "(", 2)
            END IF


            If bevent and (sevent = "" or sieven = sevent) Then
               s &= "'" & String(80, "=") & crlf
               s &= "'Event # " & str(numF) & "   " & member & "   ? " & help & crlf
               s &= "'" & String(80, "=") & crlf
					memberV = temp
               s &= memberV & crlf & crlf
               s &= tb & "'*** Put your code here ***" & crlf & crlf & crlf
					if left(ucase(memberV),3)="SUB" THEN
						 s &= "End Sub" & crlf & crlf
					else
						s &= tb & "Function = S_OK   ' change if needed" & crlf
						s &= "End Function" & crlf & crlf
               END IF
            End If
         End If
         If haschilds Then
            ReDim Preserve parents(UBound(parents) + 1)
            parents(UBound(parents)) = hnextitem
            hnextitem = haschilds
         Else
            hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
            If hnextitem = 0 And UBound(parents) > 0 Then
               hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), parents(UBound(parents)), TVGN_NEXT))
               ReDim Preserve parents(UBound(parents) - 1)

               If bevent and (sevent = "" or sieven = sevent) and numF >0 Then
						s &= "Type " & xface & "Vtbl_Ev" & crlf
						s &= tb & "QueryInterface   As Function ( ByVal pThis As Any Ptr, ByRef riid As GUID, ByRef ppvObj As Dword ) As hResult" & crlf
						s &= tb & "AddRef           As Function ( ByVal pThis As Any Ptr ) As Ulong" & crlf
						s &= tb & "Release          As Function ( ByVal pThis As Any Ptr ) As Ulong" & crlf
						for x1 = 1 to numF
							s &= tb & st_evt(x1) & crlf
						NEXT
						s &= "End type" & crlf & crlf
						s &= "Type " & xface & "_Ev" & crlf
						s &= tb & "lpVtbl           As " & xface & "Vtbl_Ev Ptr" & crlf
						s &= "End type" & crlf & crlf
'						for x1 = 1 to numF
'							s &= "Declare " & st_F & crlf
'						NEXT
						s &= "Dim Shared " & xface & "_EvTable As " & xface & "Vtbl_Ev = ( @ Ev_Vtbl_QueryInterface, _" & crlf
						s &= tb & tb & tb & tb & tb & "@ Ev_Vtbl_AddRef, _" & crlf
						s &= tb & tb & tb & tb & tb & "@ Ev_Vtbl_Release"
						for x1 = 1 to numF
							s &= ", _" & crlf & tb & tb & tb & tb & tb & "@ " & st_M (x1)
						NEXT
						s &= ")"	 & crlf & crlf
						s &= "Dim Shared " & xface & "pSEvent As " & xface & "_Ev" & crlf & crlf
						s &= tb & tb & xface & "pSEvent.lpvtbl =  @ " & xface & "_EvTable" & crlf & crlf
						s &= "Function " & xface & "_Events_Connect ( ByVal pUnk As Any Ptr, ByRef EvdwCookie As Dword ) As Integer" & crlf
						s &= tb & "EvdwCookie = Ev_Vtbl_Cp ( pUnk , " & xface & "_Ev_IID_CP, cast( Dword, @ " & xface & "pSEvent ))" & crlf
						s &= tb & "Function = cast ( integer, EvdwCookie )" & crlf
						s &= "End Function" & crlf & crlf
						s &= "Function " & xface & "_Events_Disconnect ( ByVal pUnk As Any Ptr, ByVal EvdwCookie As Dword ) As Integer " & crlf
						s &= tb & "Function = cast ( integer, Ev_Vtbl_Cp ( pUnk, " & xface & "_Ev_IID_CP, cast( Dword, @ " & xface & "pSEvent ), EvdwCookie ) )" & crlf
						s &= "End Function" & crlf & crlf
               End If
					numF = 0
					redim st_evt(0)
					'redim st_F(0)
					redim st_M(0)
            End If
         End If
      Wend
		'if s<>"" THEN s= us & crlf & s
		function=s
   End If
end function

Private Function EnumEvent cdecl Alias "EnumEvent"(hTree As Long, hParent() As long) As zString Ptr
   Dim Parents() As Long
   Dim hNextItem As Long
   Dim HasChilds As Long

   Dim token As String, tldesc As String
   Dim hItem as Long
   Dim As String xface, memid, member, par, help, temp,xface0,us
   Dim As Integer cpar, bevent,pass

   Dim s as String
	dim as string str1,st_as(),sieven
	dim as integer i_as()
	redim Parents(0)
	GetPrefix()
	str1 = trim(prefix, any "-_ ")

	'print "sevent = " ; sevent
   hItem = hparent(tkind_dispatch)

   tldesc = str1 & TreeView_GetItemText(hTree, cast(long, treeview_getnextitem(cast(hwnd, htree), hitem, TVGN_PARENT)))
   haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hitem))
   If haschilds Then
      us = "'" & String(80, "=") & crlf
      us &= "'Event - " & tldesc & crlf
      us &= "'" & String(80, "=") & crlf
      hnextitem = haschilds
      While hnextitem
         token = TreeView_GetItemText(hTree, hNextItem)
         haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hnextitem))
         If (haschilds <> 0) And (UBound(parents) = 0) Then
				xface = str_parse(token, "?", 1)
				xface0=xface
				xface= str1 & xface
            bevent = inevtlist(xface0)
            If bevent Then
					sieven = str_parse(token, "?", 2)
					'print "sieven = " ; sieven
					if sevent = "" or sieven = sevent THEN
						s &= "'" & String(80, "=") & crlf
						s &= "'Event Dispatch - " & xface & "     ?" & str_parse(token, "?", 3) & crlf
						s &= "Const " & xface & "_IID_CP" & "=" & dq & str_parse(token, "?", 2) & dq & crlf
						s &= "'" & String(80, "=") & crlf
               END IF
            End If
         ElseIf (UBound(parents) <> 0) then
            memid = str_parse(token, "?", 1)
            member = str_parse(token, "?", 3)
            par = str_parse(str_parse(member, "(", 2), ")", 1)
            member = str_parse(member, " As", 1)
            help = str_parse(token, "?", 4)
            cpar = str_numparse(par, ",")
				if ucase(member)<> "QUERYINTERFACE"  and ucase(member)<>"ADDREF"  _
						and ucase(member)<>"RELEASE" and ucase(member)<>"GETTYPEINFOCOUNT" _
						and ucase(member)<>"GETTYPEINFO"  and ucase(member)<>"GETIDSOFNAMES" _
						and ucase(member)<>"INVOKE" THEN
					If Len(par) = 0 Then cpar = 0
					If bevent and (sevent = "" or sieven = sevent) Then
						s &= "'" & String(80, "=") & crlf
						s &= "'Event=" & member & ", ID=" & memid & " ?" & help & crlf
						s &= "'" & String(80, "=") & crlf
						s &= "Function " & xface & "_" & member & "(ByVal pCookie As Events_IDispatchVtbl Ptr, ByVal pdispparams As DISPPARAMS Ptr) As HRESULT" & crlf
						s &= tb & "Dim pThis As Dword=>pCookie->pThis" & crlf
						s &= tb & "Dim IdEvent As Dword = cast(Dword, pCookie)" & crlf
						temp &= tb & tb & tb & "Case " & memid & " '" & help & crlf
						temp &= tb & tb & tb & tb & "Function=" & xface & "_" & member & "(cast(Any Ptr,pUnk), pdispparams)" & crlf
						If cpar Then s &= tb & "Dim pv As Variant Ptr = pdispparams->rgVArg" & crlf
						redim i_as(1 to cpar)
						redim st_as(1 to cpar)
						For i As Short = 1 To cpar
							st_as(i)= trim(str_parse(par, ",", i))
							if left(st_as(i),5)= "Data " THEN st_as(i) = "Data1 " & mid (st_as(i),6)
							if instr(st_as(i)," DataObject Ptr") then
								st_as(i)=FF_Replace( st_as(i), " DataObject Ptr"," IDispatch Ptr    ' DataObject Ptr" )
							elseif instr(st_as(i)," DataObject") then
								st_as(i)=FF_Replace( st_as(i), " DataObject"," IDispatch    ' DataObject" )
							end if
							if right(st_as(i),3)= "Ptr" THEN st_as(i) = left(st_as(i) ,len(st_as(i))- 4)
							s &= tb & "Dim " & st_as(i)  & crlf
							if right(st_as(i),3)= "Ptr" THEN i_as(i)=1
						Next
						s &= crlf
						For i As Short = 1 To cpar
							if i_as(i)=1 THEN
								s &= tb & str_parse(st_as(i), " As", 1) & "=cast(Any Ptr,CUInt(VariantV(pv[" & cpar - i & "])))" & crlf
							else
								s &= tb & str_parse(st_as(i), " As", 1) & "=VariantV(pv[" & cpar - i & "])" & crlf
							end if
						Next
						s &= tb & "'*** Put your code here ***" & crlf & crlf
						s &= tb & "Function=S_OK" & crlf
						s &= "End Function" & crlf & crlf
					End If
				End If
         End If
         If haschilds Then
            ReDim Preserve parents(UBound(parents) + 1)
            parents(UBound(parents)) = hnextitem
            hnextitem = haschilds
         Else
            hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
            If hnextitem = 0 And UBound(parents) > 0 Then
               hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), parents(UBound(parents)), TVGN_NEXT))
               ReDim Preserve parents(UBound(parents) - 1)
               If bevent and (sevent = "" or sieven = sevent) Then
                  temp = "Function " & xface & "_IDispatch_Invoke(ByVal pUnk As IDispatch Ptr, ByVal dispidMember As DispID, ByVal riid As IID Ptr, _" & crlf & _
                        "  ByVal lcid As LCID, ByVal wFlags As Ushort, ByVal pdispparams As DISPPARAMS Ptr, Byval pvarResult As Variant Ptr, _" & crlf & _
                        "  ByVal pexcepinfo As EXCEPINFO Ptr, ByVal puArgErr As Uint Ptr) As Hresult" & crlf & crlf & _
                        tb & "If Varptr(pdispparams) Then" & crlf & _
                        tb & tb & "Select Case dispidMember" & crlf & _
                        temp & _
                        tb & tb & tb & "Case Else" & crlf & _
                        tb & tb & tb & tb & "Function = DISP_E_MEMBERNOTFOUND" & crlf & _
                        tb & tb & "End Select" & crlf & _
                        tb & "End If" & crlf & _
                        "End Function" & crlf & crlf
                  s &= temp
                  temp = ""

                  s &= "' --------------------------------------------------------------------------------------------" & CRLF
                  s &= "' " & xface & " Events Connection function" & crlf
                  s &= "' --------------------------------------------------------------------------------------------" & CRLF
                  s &= "Function " & xface & "_Events_Connect ( ByVal pUnk As Any Ptr, ByRef dwcookie As Dword ) As Integer" & crlf
						s &= tb & "Function = Ax_Events_cnx ( " & xface & "_IID_CP , pUnk , dwcookie, ProcPtr ( " & xface & "_IDispatch_Invoke ))" & crlf
                  s &= "End Function" & crlf & crlf
                  s &= "Function " & xface & "_Events_Disconnect ( ByVal pUnk As Any Ptr, ByVal dwcookie As Dword ) As Integer" & crlf
						s &= tb & "Function = Ax_Events_cnx ( " & xface & "_IID_CP , pUnk , dwcookie )" & crlf
                  s &= "End Function" & crlf & crlf
               End If
            End If
         End If
      Wend
		if s<>"" THEN s= us & crlf & s
   End If
	if s="" THEN
		if pass =1 THEN
			s=" No Event "
		else
			hItem = hparent(tkind_interface)
			s="" : us = ""
			pass =1
			s=EnumEvent2 (hTree , hParent(), hItem )
			if s="" THEN
				s= "'  No Events ! "
			else
				s= "'       vTable Events ! " & crlf & crlf & crlf & s
         END IF
      END IF
	else
		s= "'       Dispach Events ! " & crlf & crlf & crlf & s
	END IF
   Return cast(zstring ptr, sysallocstringbytelen(s, len(s)))
End Function

Private Function EnumEnum cdecl Alias "EnumEnum"(hTree As Long, hParent() As long) As zString Ptr
   Dim Parents() As Long
   Dim hNextItem As Long
   Dim HasChilds As Long

   Dim token As String, tldesc As String
   Dim hItem as Long

   Dim s as String

	redim Parents(0)
   hItem = hparent(tkind_enum)
   tldesc = TreeView_GetItemText(hTree, cast(long, treeview_getnextitem(cast(hwnd, htree), hitem, TVGN_PARENT)))
   haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hitem))
   If haschilds Then
      s &= "'" & String(80, "=") & crlf
      s &= "'Enum -  " & tldesc & crlf
      s &= "'" & String(80, "=") & crlf
      hnextitem = haschilds
      While hnextitem
         token = TreeView_GetItemText(hTree, hNextItem)
         haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hnextitem))
         If UBound(parents) = 0 Then
            s &= "'" & String(80, "=") & crlf
            s &= "Type " & str_parse(token, "?", 1) & " As Integer     '" & str_parse(token, "?", 2) & crlf
            s &= "'" & String(80, "=") & crlf
         Else
            s &= str_parse(token, "?", 1) & "     '" & str_parse(token, "?", 1) & crlf
         End If
         If haschilds Then
            ReDim Preserve parents(UBound(parents) + 1)
            parents(UBound(parents)) = hnextitem
            hnextitem = haschilds
         Else
            hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
            If hnextitem = 0 And UBound(parents) > 0 Then
               hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), parents(UBound(parents)), TVGN_NEXT))
               ReDim Preserve parents(UBound(parents) - 1)
               s &= crlf
            End If
         end if
      Wend
   End If
   Return cast(zstring ptr, sysallocstringbytelen(s, len(s)))
End Function

Private Function EnumRecord cdecl Alias "EnumRecord"(hTree As Long, hParent() As long) As zString Ptr
   Dim Parents() As Long
   Dim hNextItem As Long
   Dim HasChilds As Long
   Dim token As String
   Dim hItem as Long
   Dim s as String
	redim Parents(0)
   hItem = hparent(tkind_record)
   haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hitem))
   If haschilds Then
      hnextitem = haschilds
      While hnextitem
         token = TreeView_GetItemText(hTree, hNextItem)
         haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hnextitem))
         If haschilds <> 0 And UBound(parents) = 0 Then
            s &= "'" & String(80, "=") & crlf
            s &= "'Record " & str_parse(token, "?", 1) & "     '" & str_parse(token, "?", 2) & crlf
            s &= "'" & String(80, "=") & crlf
            s &= "Type " & str_parse(token, "?", 1) & crlf
         ElseIf UBound(parents) <> 0 then
            s &= tb & token & crlf
         End If

         If haschilds Then
            ReDim Preserve parents(UBound(parents) + 1)
            parents(UBound(parents)) = hnextitem
            hnextitem = haschilds
         Else
            hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
            If hnextitem = 0 And UBound(parents) > 0 Then
               hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), parents(UBound(parents)), TVGN_NEXT))
               ReDim Preserve parents(UBound(parents) - 1)
               s &= "End Type" & crlf
            End If
         End If
      Wend
   End If
   Return cast(zstring ptr, sysallocstringbytelen(s, len(s)))
End Function

Private Function EnumUnion cdecl Alias "EnumUnion"(hTree As Long, hParent() As long) As zString Ptr
   Dim Parents() As Long
   Dim hNextItem As Long
   Dim HasChilds As Long
   Dim token As String
   Dim hItem as Long

   Dim s as String

	redim Parents(0)
   hItem = hparent(tkind_union)
   haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hitem))
   If haschilds Then
      hnextitem = haschilds
      While hnextitem
         token = TreeView_GetItemText(hTree, hNextItem)
         haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hnextitem))
         If haschilds <> 0 And UBound(parents) = 0 Then
            s &= "'" & String(80, "=") & crlf
            s &= "'Union " & str_parse(token, "?", 1) & "     '" & str_parse(token, "?", 2) & crlf
            s &= "'" & String(80, "=") & crlf
            s &= "Union " & str_parse(token, "?", 1) & crlf
         Else
            s &= tb & token & crlf
         End If

         If haschilds Then
            ReDim Preserve parents(UBound(parents) + 1)
            parents(UBound(parents)) = hnextitem
            hnextitem = haschilds
         Else
            hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
            If hnextitem = 0 And UBound(parents) > 0 Then
               hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), parents(UBound(parents)), TVGN_NEXT))
               ReDim Preserve parents(UBound(parents) - 1)
               s &= "End Union" & crlf
            End If
         End If
      Wend
   End If
   Return cast(zstring ptr, sysallocstringbytelen(s, len(s)))
End Function

Private Function EnumModule cdecl Alias "EnumModule"(hTree As Long,hParent() As long)As zString Ptr
	Dim Parents() As Long
	Dim hNextItem As Long
	Dim HasChilds As Long
	Dim token As String,tldesc As String
	Dim hItem as Long
	Dim as String s,func,dlls,aliass,ord,us,d1,d2
	redim Parents(0)
	hItem=hparent(tkind_module)
	'tldesc=TreeView_GetItemText(hTree,treeview_getnextitem(htree,hitem,TVGN_PARENT))
	'haschilds=treeview_getchild(htree,hitem)
	tldesc = TreeView_GetItemText(hTree, cast(long, treeview_getnextitem(cast(hwnd, htree), hitem, TVGN_PARENT)))
   haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hitem))
	If haschilds Then
	s &="'" & String(80,"=") & crlf
	s &="'Module - " & tldesc & crlf
	s &="'" & String(80,"=") & crlf
	hnextitem=haschilds
	While hnextitem
'		While treeview_getcheckstate(htree,hnextitem)=1
'			'hnextitem=treeview_getnextitem(htree,hnextitem,TVGN_NEXT)
'			hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
'			If hnextitem=0 Then Return cast(zstring ptr, sysallocstringbytelen(s, len(s)))
'		Wend

		token=TreeView_GetItemText(hTree,hNextItem)
		If UBound(parents)=0 Then
			s &="'" & String(80,"=") & crlf
			s &="'" & str_parse(token,"?",1) & "     ?" & str_parse(token,"?",2) & crlf
			s &="'" & String(80,"=") & crlf
		Else
			If Left(token,5)<>"Const" Then
				dlls=str_parse(token,"?",1):aliass=str_parse(token,"?",2)
				ord=str_parse(token,"?",3):func=str_parse(token,"?",4)
				s &="Dim shared " & func & "     '" & str_parse(token,"?",5) & crlf
				If Len(aliass) Then
					s &=str_parse(func," As",1) & " = DylibSymbol(h" & str_parse(dlls,".",1) & "," & dq & aliass & dq & ")"
				Else
					s &=str_parse(func," As",1) & " = DylibSymbol(h" & str_parse(dlls,".",1) & "," & ord & ")"
				EndIf
				s &="     'h" & str_parse(dlls,".",1) & " = DylibLoad(" & dq & dlls & dq & ")" & crlf
				d1="h" & str_parse(dlls,".",1) & " = DylibLoad(" & dq & dlls & dq & ")"
				if instr(ucase(us),ucase("Dim Shared h" & str_parse(dlls,".",1)))= 0 THEN
					'print selpath
					d2=selpath
					if instr( d2,dlls)THEN
						d1= ff_replace(d1,dlls,d2)
               END IF
					us &= "Dim Shared h" & str_parse(dlls,".",1) & " As Any Ptr " & crlf & d1 & crlf & crlf
            END IF
			Else
				s &=str_parse(token,"?",1) & "     '" & str_parse(token,"?",2) & crlf
			EndIf
		EndIf

		'haschilds=treeview_getchild(htree,hnextitem)
		haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hnextitem))
		If haschilds Then
			ReDim Preserve parents(UBound(parents)+1)
			parents(UBound(parents))=hnextitem
			hnextitem=haschilds
		Else
			'hnextitem=treeview_getnextitem(htree,hnextitem,TVGN_NEXT)
			hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
			If hnextitem=0 And UBound(parents)>0 Then
				'hnextitem=treeview_getnextitem(htree,parents(UBound(parents)),TVGN_NEXT)
				hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), parents(UBound(parents)), TVGN_NEXT))
				ReDim Preserve parents(UBound(parents)-1)
				s &=crlf
			EndIf
		endif
	Wend
	EndIf
	s= us & crlf & crlf & s
	'Return sysallocstringbytelen(s,len(s))
	Return cast(zstring ptr, sysallocstringbytelen(s, len(s)))
End Function


Private Function EnumModule2 cdecl Alias "EnumModule2"(hTree As Long, hParent() As long) As zString Ptr
   Dim Parents() As Long
   Dim hNextItem As Long
   Dim HasChilds As Long
   Dim token As String, tldesc As String
   Dim hItem as Long

   Dim s as String,us as string
	redim Parents(0)
   hItem = hparent(tkind_module)
   tldesc = TreeView_GetItemText(hTree, cast(long, treeview_getnextitem(cast(hwnd, htree), hitem, TVGN_PARENT)))
   haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hitem))
   If haschilds Then
      s &= "'" & String(80, "=") & crlf
      s &= "'Module - " & tldesc & crlf
      s &= "'" & String(80, "=") & crlf
      hnextitem = haschilds
      While hnextitem

         token = TreeView_GetItemText(hTree, hNextItem)
         If UBound(parents) = 0 Then
            s &= "'" & String(80, "=") & crlf
            s &= "'" & str_parse(token, "?", 1) & "     ?" & str_parse(token, "?", 2) & crlf
            s &= "'" & String(80, "=") & crlf
         Else
            s &= str_parse(token, "?", 1) & "     '" & str_parse(token, "?", 2) & crlf
         End If

         haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hnextitem))
         If haschilds Then
            ReDim Preserve parents(UBound(parents) + 1)
            parents(UBound(parents)) = hnextitem
            hnextitem = haschilds
         Else
            hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
            If hnextitem = 0 And UBound(parents) > 0 Then
               hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), parents(UBound(parents)), TVGN_NEXT))
               ReDim Preserve parents(UBound(parents) - 1)
               s &= crlf
            End If
         end if
      Wend
   End If
   Return cast(zstring ptr, sysallocstringbytelen(s, len(s)))
End Function


Private Function EnumAlias cdecl Alias "EnumAlias"(hTree As Long, hParent() As long) As zString Ptr
   Dim Parents() As Long
   Dim hNextItem As Long
   Dim HasChilds As Long
   Dim token As String
   Dim hItem as Long
   Dim as String s, tldesc
	redim Parents(0)
   hItem = hparent(tkind_alias)
   tldesc = TreeView_GetItemText(hTree, cast(long, treeview_getnextitem(cast(hwnd, htree), hitem, TVGN_PARENT)))
   haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hitem))
   If haschilds Then
      s &= "'" & String(80, "=") & crlf
      s &= "'Alias - " & tldesc & crlf
      s &= "'" & String(80, "=") & crlf
      hnextitem = haschilds
      While hnextitem
         token = TreeView_GetItemText(hTree, hNextItem)
         s &= token & crlf
         hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
      Wend
   End If
   Return cast(zstring ptr, sysallocstringbytelen(s, len(s)))
End Function

Private Function EnumCoClass cdecl Alias "EnumCoClass"(hTree As Long, hParent() As long) As zString Ptr
   Dim Parents() As Long
   Dim hNextItem As Long
   Dim HasChilds As Long
   Dim token As String, progid As WString Ptr, clssid As clsid
   Dim As String clsids, progids, tldesc
   Dim hItem as long

   Dim s as string, str1 as string
	redim Parents(0)
	GetPrefix()
	str1 = trim(prefix, any "-_ ")

	hItem = hparent(tkind_coclass)
   tldesc = TreeView_GetItemText(hTree, cast(long, treeview_getnextitem(cast(hwnd, htree), hitem, TVGN_PARENT)))
   haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hitem))
   If haschilds Then
      hnextitem = haschilds
      While hnextitem
         token = TreeView_GetItemText(hTree, hNextItem)
         clsids &= "   Const CLSID_" & str1 & str_parse(token, "?", 1) & "=" & dq & str_parse(token, "?", 2) & dq & "     '" & str_parse(token, "?", 3) & crlf
         progid = Stringtobstr(str_parse(token, "?", 2))
         clsidfromString(progid, @clssid)
         sysfreeString(progid)
         progidfromclsid(@clssid, @progid)
			If Len(*progid) Then progids &="Const ProgID_" & str_parse(token,"?",1) & "=" & dq & *progid & dq & crlf
         sysfreeString(progid)
         hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
      Wend
   End If
	s &= "' Warning : Do not use vTable and Invoke/Dispatch methods on the same program !" & crlf
	s &= "'           It will be duplicated constants and type confusion "& crlf
	s &= "'           or use different prefix to differentiate them ..." & crlf & crlf
   s &= "'" & String(80, "=") & crlf
   s &= "'CLSID - " & tldesc & crlf
   s &= "'" & String(80, "=") & crlf
   s &= clsids & crlf
   s &= "'" & String(80, "=") & crlf
   s &= "'ProgID - " & tldesc & crlf
   s &= "'" & String(80, "=") & crlf
   s &= progids & crlf
   Return cast(zstring ptr, SysAllocStringByteLen(s, len(s)))
End Function





Private Function Full_control(xface as string, s_connect as string, s_disc as string, L1 as integer) as string
   dim as string s
	if L1 THEN
		if notsure = 1 THEN
			s = crlf  & tb & "' The events are not connected ....." & crlf
			s &= tb & "' not sure : more than 1 connection to connect, check yourself ... if ok uncomment or modify " & crlf
			s &= tb & "'   Declare " & s_connect & "(ByVal As any Ptr,ByRef As Dword) As Integer" & crlf
			s &= tb & "'   Declare " & s_disc & "(ByVal As any Ptr, ByVal As Dword) As Integer"  & crlf & crlf & crlf
		else
			s = crlf &  tb & "' The events can be connected ....." & crlf
			s &= tb & "#Define Decl_Ev1_" & xface & " Declare Function " & s_connect & "(ByVal As any Ptr, ByRef As dword) As Integer" & crlf
			s &= tb & "#Define Decl_Ev2_" & xface & " Declare Function " & s_disc & "(ByVal As any Ptr, ByVal As dword) As Integer"  & crlf
			s &= tb & "Decl_Ev1_" & xface & "      ' indirect declare to avoid FireFly duplication " & crlf
			s &= tb & "Decl_Ev2_" & xface & "      ' indirect declare to avoid FireFly duplication " & crlf
		END IF
	END IF
	s &= "#EndIf" & crlf & crlf & crlf
	s &= "Sub " & xface & "Call_Init()			' be called from initialization of the control form" & crlf
   s &= tb & xface & "Obj_Ptr = AxCreate_Object( " & xface & "OcxHwnd  )  			             'get object control address with control hwnd" & crlf & crlf
	s &= tb & "'    if use of vTable functions ...  Dim Shared " & xface & "pVTI As ... with the right TYPE see in vtable code" & crlf
	s &= tb & "'    " & xface & "pVTI = " & xface & "Obj_Ptr   ':  " & xface & "pVTI->lpvtbl->SetColor( " & xface & "pVTI ,... )" & crlf
   s &= tb & "'                            or Ax_Vt ( " & xface & "pVTI, SetColor, arg... )  or  Ax_Vt0 ( " & xface & "pVTI, About )" & crlf & crlf
   s &= tb & "'    if use of Invoke/dispatch functions ...  Dim Shared " & xface & "pDisp As ... with the right TYPE see in Invoke code" & crlf
	s &= tb & "'    SetObj ( @" & xface & "pDisp , " & xface & "Obj_Ptr )   ':   AxCall " & xface & "pDisp.PutValue , vptr(x) , vptr(y) , ..." & crlf & crlf

	if L1 THEN
		if notsure = 1 THEN
			s &= tb & "' not sure : more than 1 connection to connect, check yourself ... if ok uncomment or modify " & crlf
			s &= tb & "'  " & s_connect & "( " & xface & "Obj_Ptr , " & xface & "Obj_Event ) 'connect object with its event" & crlf & crlf
		else
			s &= tb &"' The events are now connected ....." & crlf
			s &= tb & s_connect & "( " & xface & "Obj_Ptr , " & xface & "Obj_Event ) 'connect object with its event" & crlf & crlf
		end if
	END IF
   s &= tb & xface & "Call_Sett() 'initial settings if you want some" & crlf
   s &= "End Sub" & crlf & crlf & crlf
   s &= "Sub " & xface & "Call_OnClose() ' normaly be called from close form command" & crlf
   if L1 THEN
		if notsure = 1 THEN
			s &= tb & "' not sure : more than 1 connection to connect, check yourself ... if ok uncomment or modify " & crlf
			s &= tb & "'  " & s_disc & "( " & xface & "Obj_Ptr , " & xface & "Obj_Event ) 'disconnect  event from object" & crlf
		else
			s &= tb &"' The events are now disconnected ....." & crlf
			s &= tb & s_disc & " ( " & xface & "Obj_Ptr , " & xface & "Obj_Event ) 'disconnect  event from object" & crlf
		end if
	END IF
   s &= tb & " AxRelease_Object(" & xface & "Obj_Ptr)     'release object" & crlf
   s &= tb & "'AxStop()         'only one by project, better on the WM_close of last Form" & crlf
   s &= "End Sub" & crlf & crlf & crlf
   s &= "Sub " & xface & "Call_Sett()   'initial settings here" & crlf
   s &= tb & "'ex put/ get /call values  " & crlf
   s &= "End Sub" & crlf
   s &= "'================================================================================" & crlf
	if isevent=0 THEN
			s &= "'  No Events for that ActiveX Control interface " & crlf
	elseif L1 =0 and isevent=1 THEN
			s &= "'  Events exist for that ActiveX Control interface, if needed select Template with events !" & crlf
	end if
	s &= "'================================================================================" & crlf
   function = s
END FUNCTION

Private Function Simple_control(xface as string, ret1 as string, tldesc as string, progids as string, l1 as integer) as string
   dim as string s
   s = "'" & String(80, "=") & crlf
   s &= "'ProgID - " & tldesc & crlf
   s &= "'" & String(80, "=") & crlf
   s &= progids & crlf

   if ret1 = " ProgID " then
      s &= "'    not unique ProgID   - Select only 1 CoClass in tree to get the one needed to create object " & crlf & crlf
		function = s
		if xfull = 0 THEN exit function
	elseif ret1 = " No ProgID " then
		s &= "'    No ProgID   - Select 1 CoClass in tree to get the one needed to create object " & crlf & crlf
		function = s
		if xfull = 0 THEN exit function
	end if
   s &= "'" & String(80, "=") & crlf & crlf
   s &= "'   Use Prefix in AxSuite3 to differenciate the functions names / variables names" & crlf & crlf
   s &= "'================================================================================" & crlf
   s &= "'for that control :  use  variable Classname > Var_ATL_Win_     and Caption = " & ret1  & crlf
   s &= "'================================================================================" & crlf
   s &= "Dim Shared As any ptr      " & xface & "Obj_Ptr      ' object Ptr   " & crlf
   if l1 = 1 then s &= "Dim Shared As Dword        " & xface & "Obj_Event    ' cookie for object events" & crlf
	s &= "Dim Shared As hwnd         " & xface & "OcxHwnd      ' Ocx handle " & crlf & crlf
   s &=  "' If use of Firefly Custom Control for OCX,  this following function is not needed, you can comment it... " & crlf
	s &=  "Function " & xface & "WinOcx  ( hparent as hwnd ) as hwnd 		' make window for control"& crlf
	s &= tb & "Dim as integer x= 0 								' x left position , change for your need" & crlf
	s &= tb & "Dim as integer y= 0 								' y top position , change for your need" & crlf
	s &= tb & "Dim as integer w= 200 							' w width  , change for your need" & crlf
	s &= tb & "Dim as integer h= 150 							' h heigth  , change for your need" & crlf
	s &= tb & "dim as string N = """ & xface & " WinOcxName1""  					' Name of the window , change for your need" & crlf
	s &= tb & "dim as string P = """ & ret1 & """  			' prodId of the window , change for your need" & crlf
	s &= tb & xface & "OcxHwnd = AxWinChild( hparent , N , P , x , y , w , h ) 		' adapt to your needs  see Axlite.bi" & crlf
	s &= tb & xface & "'OcxHwnd = AxWinTool( hparent , N , P , x , y , w , h ) 		' or try this for Toll floating window" & crlf
	s &= tb & xface & "'OcxHwnd = AxWinFull( hparent , N , P , x , y , w , h ) 		' or try this for Full floating window" & crlf
	s &= tb & "Function = " & xface & "OcxHwnd" & crlf
	s &= "End Function " & crlf & crlf
	s &= "#IfnDef _PARSED_MOD_FF3_         'Defined in FireFly to avoid duplications " & crlf & crlf
	s &= tb & "#Define Decl_Set_" & xface & " Declare Sub " & xface & "Call_Sett()" & crlf
	s &= tb & "Decl_Set_" & xface & "      ' indirect declare to avoid FireFly duplication " & crlf & crlf
   function = s
END FUNCTION

Private Function Full_nowin(xface as string, s_connect as string, s_disc as string, L1 as integer,ret1 as string) as string
   dim as string s
	if L1 THEN
		if notsure = 1 THEN
			s = crlf  & tb & "' The events are not connected ....." & crlf
			s &= tb & "' not sure : more than 1 connection to connect, check yourself ... if ok uncomment or modify " & crlf
			s &= tb & "'   Declare " & s_connect & "(ByVal As any Ptr, ByRef As Dword) As Integer" & crlf
			s &= tb & "'   Declare " & s_disc & "(ByVal As any Ptr, ByVal As Dword) As Integer"  & crlf & crlf & crlf
		else
			s = crlf & tb & "' The events can be connected ....." & crlf
			s &= tb & "#Define Decl_Ev1_" & xface & " Declare Function " & s_connect & "(ByVal As any Ptr, ByRef As dword) As Integer" & crlf
			s &= tb & "#Define Decl_Ev2_" & xface & " Declare Function " & s_disc & "(ByVal As any Ptr, ByVal As dword) As Integer"  & crlf
			s &= tb & "Decl_Ev1_" & xface & "      ' indirect declare to avoid FireFly duplication " & crlf
			s &= tb & "Decl_Ev2_" & xface & "      ' indirect declare to avoid FireFly duplication " & crlf
		END IF
	END IF
	s &= "#EndIf" & crlf & crlf & crlf
	s &= "Sub " & xface & "Call_Init()				' be called from initialization " & crlf
   s &= tb & xface & "Obj_Ptr = AxCreate_Object( " & ret1 & " )  			             'get object control address with prodid" & crlf & crlf
	s &= tb & "'    if use of vTable functions ...  Dim Shared " & xface & "pVTI As ... with the right TYPE see in vtable code" & crlf
	s &= tb & "'    " & xface & "pVTI = " & xface & "Obj_Ptr   ':  " & xface & "pVTI->lpvtbl->SetColor( " & xface & "pVTI ,... )" & crlf
   s &= tb & "'                            or Ax_Vt ( " & xface & "pVTI, SetColor, arg... )  or  Ax_Vt0 ( " & xface & "pVTI, About )" & crlf & crlf
	s &= tb & "'    if use of Invoke/dispatch functions ...  Dim Shared " & xface & "pDisp As ... with the right TYPE see in Invoke code" & crlf
	s &= tb & "'    SetObj ( @" & xface & "pDisp , " & xface & "Obj_Ptr )   ':   AxCall " & xface & "pDisp.PutValue , vptr(x) , vptr(y) , ..." & crlf & crlf

	if L1 THEN
		if notsure = 1 THEN
			s &= tb & "' not sure : more than 1 connection to connect, check yourself ... if ok uncomment or modify " & crlf
			s &= tb & "'  " & s_connect & " ( " & xface & "Obj_Ptr , " & xface & "Obj_Event ) 'connect object with its event" & crlf & crlf
		else
			s &= tb &"' The events are now connected ....." & crlf
			s &= tb & s_connect & " (  " & xface & "Obj_Ptr , " & xface & "Obj_Event ) 'connect object with its event" & crlf & crlf
		end if
	END IF
   s &= tb & xface & "Call_Sett() 'initial settings if you want some" & crlf
   s &= "End Sub" & crlf & crlf & crlf
   s &= "Sub " & xface & "Call_OnClose() ' normaly be called from close form command" & crlf
   if L1 THEN
		if notsure = 1 THEN
			s &= tb & "' not sure : more than 1 connection to connect, check yourself ... if ok uncomment or modify " & crlf
			s &= tb & "'  " & s_disc & "( " & xface & "Obj_Ptr , " & xface & "Obj_Event ) 'disconnect  event from object" & crlf
		else
			s &= tb &"' The events are now disconnected ....." & crlf
			s &= tb & s_disc & "( " & xface & "Obj_Ptr , " & xface & "Obj_Event ) 'disconnect  event from object" & crlf
		end if
	END IF
   s &= tb & " AxRelease_Object( " & xface & "Obj_Ptr )     'release object" & crlf
   s &= tb & "'AxStop()         'only one by project, better on the WM_close of last Form" & crlf
   s &= "End Sub" & crlf & crlf & crlf
   s &= "Sub " & xface & "Call_Sett()   'initial settings here" & crlf
   s &= tb & "'ex put/ get /call values  " & crlf
   s &= "End Sub" & crlf
   s &= "'================================================================================" & crlf
	if isevent=0 THEN
			s &= "'  No Events for that ActiveX Control interface " & crlf
	elseif L1 =0 and isevent=1 THEN
			s &= "'  Events exist for that ActiveX Control interface, if needed select Template with events !" & crlf
	end if
	s &= "'================================================================================" & crlf
   function = s
END FUNCTION


Private Function Simple_nowin(xface as string, ret1 as string, tldesc as string, progids as string, l1 as integer) as string
   dim as string s
   s = "'" & String(80, "=") & crlf
   s &= "'ProgID - " & tldesc & crlf
   s &= "'" & String(80, "=") & crlf
   s &= progids & crlf

   if ret1 = " ProgID " then
      s &= "'    not unique ProgID   - Select only 1 CoClass in tree to get the one needed to create object " & crlf & crlf
		function = s
		if xfull = 0 THEN exit function
	elseif ret1 = " No ProgID " then
		s &= "'    No ProgID   - Select 1 CoClass in tree to get the one needed to create object " & crlf & crlf
		function = s
		if xfull = 0 THEN exit function
	end if
   s &= "'" & String(80, "=") & crlf & crlf
   s &= "'   Use Prefix in AxSuite3 to differenciate the functions names / variables names" & crlf & crlf
   s &= "'================================================================================" & crlf
   s &= "Dim Shared As any ptr      " & xface & "Obj_Ptr      ' object Ptr   " & crlf
   if l1 = 1 then s &= "Dim Shared As Dword        " & xface & "Obj_Event    ' cookie for object events" & crlf & crlf & crlf
   s &= "#IfnDef _PARSED_MOD_FF3_         'Defined in FireFly to avoid duplications " & crlf & crlf
	s &= tb & "#Define Decl_Set_" & xface & " Declare Sub " & xface & "Call_Sett()" & crlf
	s &= tb & "Decl_Set_" & xface & "      ' indirect declare to avoid FireFly duplication " & crlf & crlf
   function = s
END FUNCTION

Function Ini_templ() as string
   dim as string s
   s = "'" & String(80, "=") & crlf
   s &= "'Template to use OCX / ActiveX / COM " & crlf
   s &= "'" & String(80, "=") & crlf & crlf
'	if nowin=0  THEN
'		s &= "'#Define useATL71             'to use ATL71.dll  uncomment,  else commented use of ATL.dll"& crlf & crlf
'  END IF
	if nowin<>0  THEN
		s &= "'#Define Ax_NoAtl        				'to use Ax_Lite.bi without atl.dll , when no control window ( reduce size of exe)"& crlf & crlf
	END IF
	s &= "#Include Once ""Windows.bi""        ' Windows specific, if not defined yet" & crlf
	s &= "#Include Once ""Ax_lite.bi""        ' this one is needed" & crlf & crlf
	's &= "'#Include Once ""Ax_lite_lib.bi""    ' use libAx_lite.a static lib   ( reduce size of exe)" & crlf

	if nowin=0  THEN
		s &= "'Select_ATL(71)   '   to use ATL71.dll  uncomment,  else commented use of ATL.dll" & crlf
		s &= "'                     Select_ATL instruction must be put before AxInit , after it has no effect" & crlf & crlf
		s &= "' Global COM instance initialization , only one by project" & crlf
		s &= "AxInit(True)      '   True : if at least 1 Ocx control is a Visual control (use Atl) , else False" & crlf & crlf
	else
		s &= "' Global COM instance initialization , only one by project" & crlf
		s &= "AxInit(False)     '   False : if all Ocx controls are Not-Visual controls , else True" & crlf & crlf
   END IF
   s &= "' AxStop()       'use only one by project to stop COM instance , put at the end of program" & crlf & crlf
   s &= "'" & String(80, "=") & crlf
   function = s
END FUNCTION




Private sub EnumCoClassB (hTree As Long, hParent() As long)
   Dim Parents() As Long
   Dim hNextItem As Long
   Dim HasChilds As Long
   Dim token As String, progid As WString Ptr, clssid As clsid
   Dim As String  ret1, ret2
   Dim hItem as long
   Dim nitem as long
   Dim u1 as integer, n1 as integer,inot as integer, x as integer
   Dim s as string,iseul as string,clsids as string,progids as string,tldesc as string
	redim Parents(0)
'   Dim xface as string, ss22 as string
'	GetPrefix()
'	xface = trim(prefix, any "-_ ")
'   if xface <> "" THEN xface = xface & "_"
	hItem = hparent(tkind_coclass)

   tldesc = TreeView_GetItemText(hTree, cast(long, treeview_getnextitem(cast(hwnd, htree), hitem, TVGN_PARENT)))
   haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hitem))
	'tldesc = TreeView_GetItemText(hTree, treeview_getnextitem (htree, hitem, TVGN_PARENT))
   'haschilds = treeview_getchild(htree, hitem)
   If haschilds Then
      hnextitem = haschilds
      While hnextitem
         token = TreeView_GetItemText1(hTree, hNextItem)
			if instr(token,"          'NOT'") THEN
				token=left(token , len(token)-len("          'NOT'"))
				inot=1
			else
				inot=0
			end if
				if inot=0 THEN
					clsids &= "  ' Const CLSID_" & str_parse(token, "?", 1) & "=" & dq & str_parse(token, "?", 2) & dq & "     '" & str_parse(token, "?", 3) & crlf
'					ss22= dq & str_parse(token, "?", 2) & dq
'					clsids &="'ss22 = " & ss22 & crlf
'					s &= clsids
				end if
				progid = Stringtobstr(str_parse(token, "?", 2))
				clsidfromString(progid, @clssid)
				sysfreeString(progid)
				progidfromclsid(@clssid, @progid)
				ret1 = *progid
				if inot=1 THEN ret1 = ""
				ret2 = ret1
				if ret1 <> "" THEN
					n1 = 0 :u1 = 0
					do
						u1 = instr(u1 + 1, ret1, ".")
						if u1 > 0 THEN
							n1 = n1 + 1
							if n1 = 2 THEN
								ret1 = left(ret1, u1 - 1)
								progids &= "  ' Const I_ProgID_" & str_parse(token, "?", 1) & "=" & dq & ret1 & dq & _
										"                 '*** Version independent ProgID" & crlf
								if nitem = 0 THEN
									iseul = ret1
									'ss22= dq & str_parse(token, "?", 2) & dq
								end if
								exit do
							END IF
						END IF
					LOOP UNTIL u1 = 0
				END IF
				if ret2 <> ret1 THEN
					progids &= "  ' Const ProgID_" & str_parse(token, "?", 1) & "=" & dq & *progid & dq & _
							"                                       'Version dependent ProgID" & crlf & crlf
				else
					if *progid="" THEN
					elseif ret1 = "" THEN
						if inot=0 THEN progids &= "  ' Const ProgID_" & str_parse(token, "?", 1) & "=" & dq & *progid & dq & crlf & crlf
					else
						progids &= "  ' Const ProgID_" & str_parse(token, "?", 1) & "=" & dq & *progid & dq & _
								"                 '*** Version independent ProgID" & crlf & crlf
						if nitem = 0 THEN
							iseul = *progid
							'ss22 = dq & str_parse(token, "?", 2) & dq
						end if
					END IF
				END IF
				if inot=0 and *progid <> "" THEN nitem += 1
				sysfreeString(progid)
				hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
				'hnextitem = treeview_getnextitem( htree, hnextitem, TVGN_NEXT)
      Wend
   End If
	sevent =""
   if nitem = 1 then
		ret1 =  iseul
		for x= 1 to icoclass
			if coclass(x,2)= ret1 then
				sevent = coclass(x,7)
				'print "sevent" ; sevent
				exit for
			end if
      NEXT
   end if

End sub


Private Function EnumCoClassA (hTree As Long, hParent() As long,byRef clsids as string,byRef progids as string,Byref tldesc as string) As String
   Dim Parents() As Long
   Dim hNextItem As Long
   Dim HasChilds As Long
   Dim token As String, progid As WString Ptr, clssid As clsid
   Dim As String  ret1, ret2
   Dim hItem as long
   Dim nitem as long
   Dim u1 as integer, n1 as integer,inot as integer, x as integer
   Dim s as string,iseul as string,iseul2 as string
	redim Parents(0)
'   Dim xface as string, ss22 as string
'	GetPrefix()
'	xface = trim(prefix, any "-_ ")
'   if xface <> "" THEN xface = xface & "_"
	hItem = hparent(tkind_coclass)
	clsids = ""
   tldesc = TreeView_GetItemText(hTree, cast(long, treeview_getnextitem(cast(hwnd, htree), hitem, TVGN_PARENT)))
   iseul2 = tldesc
	haschilds = cast(long, treeview_getchild(cast(hwnd, htree), hitem))
	'tldesc = TreeView_GetItemText(hTree, treeview_getnextitem (htree, hitem, TVGN_PARENT))
   'haschilds = treeview_getchild(htree, hitem)
   If haschilds Then
      hnextitem = haschilds
      While hnextitem
         token = TreeView_GetItemText1(hTree, hNextItem)
			if instr(token,"          'NOT'") THEN
				token=left(token , len(token)-len("          'NOT'"))
				inot=1
			else
				inot=0
			end if
				if inot=0 THEN
					if clsids = "" THEN
						clsids =  dq & str_parse(token, "?", 2) & dq
					else
						iseul2 =""
               END IF

'					ss22= dq & str_parse(token, "?", 2) & dq
'					clsids &="'ss22 = " & ss22 & crlf
'					s &= clsids
				end if
				progid = Stringtobstr(str_parse(token, "?", 2))
				clsidfromString(progid, @clssid)
				sysfreeString(progid)
				progidfromclsid(@clssid, @progid)
				ret1 = *progid
				if inot=1 THEN ret1 = ""
				ret2 = ret1
				if ret1 <> "" THEN
					n1 = 0 :u1 = 0
					do
						u1 = instr(u1 + 1, ret1, ".")
						if u1 > 0 THEN
							n1 = n1 + 1
							if n1 = 2 THEN
								ret1 = left(ret1, u1 - 1)
								progids &= "  ' Const I_ProgID_" & str_parse(token, "?", 1) & "=" & dq & ret1 & dq & _
										"                 '*** Version independent ProgID" & crlf
								if nitem = 0 THEN
									iseul = ret1
									'ss22= dq & str_parse(token, "?", 2) & dq
								end if
								exit do
							END IF
						END IF
					LOOP UNTIL u1 = 0
				END IF
				if ret2 <> ret1 THEN
					progids &= "  ' Const ProgID_" & str_parse(token, "?", 1) & "=" & dq & *progid & dq & _
							"                                       'Version dependent ProgID" & crlf & crlf
				else
					if *progid="" THEN
					elseif ret1 = "" THEN
						if inot=0 THEN progids &= "  ' Const ProgID_" & str_parse(token, "?", 1) & "=" & dq & *progid & dq & crlf & crlf
					else
						progids &= "  ' Const ProgID_" & str_parse(token, "?", 1) & "=" & dq & *progid & dq & _
								"                 '*** Version independent ProgID" & crlf & crlf
						if nitem = 0 THEN
							iseul = *progid
							'ss22 = dq & str_parse(token, "?", 2) & dq
						end if
					END IF
				END IF
				if inot=0 and *progid <> "" THEN nitem += 1
				sysfreeString(progid)
				hnextitem = cast(long, treeview_getnextitem(cast(hwnd, htree), hnextitem, TVGN_NEXT))
				'hnextitem = treeview_getnextitem( htree, hnextitem, TVGN_NEXT)
      Wend
   End If
	sevent =""
   if nitem = 1 then
      FF_ClipboardSetText(iseul)
		ret1 =  iseul
'		for x= 1 to icoclass
'			if coclass(x,2)= ret1 then
'				sevent = coclass(x,7)
'				print "sevent" ; sevent
'			end if
'      NEXT
	elseif nitem = 0 then
		FF_ClipboardSetText( "")
		ret1 = " No ProgID "
   else
      FF_ClipboardSetText( "")
      ret1 = " ProgID "
   end if
	tldesc = iseul2
	function = ret1
End Function


Private Function EnumCoClass1 cdecl Alias "EnumCoClass1"(hTree As Long, hParent() As long, l1 as integer, _
         s_conect as string, s_disc as string) As zString Ptr
	Dim As String clsids, progids, tldesc , ret1
   Dim s as string,iseul as string
   Dim xface as string, ss22 as string
	Dim x as integer
	GetPrefix()
	xface = trim(prefix, any "-_ ")
   if xface <> "" THEN xface = xface & "_"
	isevent=0

	ret1=EnumCoClassA(hTree , hParent(),clsids, progids, tldesc )
	if nowin=0 THEN
		s = Simple_control(xface, ret1, tldesc, progids, l1)
		if (ret1 <> " ProgID " and ret1 <> " No ProgID " ) or xfull =1 THEN
			xret1=0

			for x= 1 to icoclass
				if coclass(x,2)=ret1 THEN
					'ret1 = dq & coclass(x,2) & dq & " , " & dq & coclass(x,5)& dq
					if coclass(x,7)<>"" then isevent=1
					exit for
            END IF
         NEXT

			s &= Full_control(xface,s_conect, s_disc, l1)
		else
			xret1=1
			s="'   " & ret1
			messagebox(getactivewindow()," ProgId not defined... Select only 1 Coclass on the tree view ( with ProgId)."  ,"Error",MB_ICONERROR)
			goto ddetour
		END IF
	else
		s = Simple_nowin(xface, ret1, tldesc, progids, l1)
		if (ret1 <> " ProgID " and ret1 <> " No ProgID " ) or xfull =1 THEN
			xret1=0
			'coclass(i,2)= s1
			for x= 1 to icoclass
				if coclass(x,2)=ret1 THEN
					ret1 = dq & coclass(x,2) & dq & " , " & dq & coclass(x,5)& dq
					if coclass(x,7)<>"" then isevent=1
					exit for
            END IF
         NEXT
			s &= Full_nowin(xface,s_conect, s_disc, l1,ret1)
		else
			xret1=1
			s="'   " & ret1
			messagebox(getactivewindow()," ProgId not defined... Select 1 Coclass only on the tree view ( with ProgId)."  ,"Error",MB_ICONERROR)
			goto ddetour
		END IF
   END IF
ddetour:
   Return cast(zstring ptr, SysAllocStringByteLen(s, len(s)))

End Function


Private Function EnumCoClass3 (hTree As Long, hParent() As long) As zString Ptr
	Dim As String clsids, progids, tldesc , ret1
   Dim s as string
   Dim xface as string
	Dim x as integer
	GetPrefix()
	xface = trim(prefix, any "-_ ")
   if xface <> "" THEN xface = xface & "_"

	ret1=EnumCoClassA(hTree , hParent(),clsids, progids, tldesc )
		if (clsids <> "" and tldesc <> "" ) THEN
			for x= 1 to icoclass
				if clsids = dq & coclass(x,3) & dq THEN
					s = "'" & String(80, "=") & crlf
					s &= "'   CoClass     " & coclass(x,1) &   "      " & clsids & crlf
					s &= "'   Interface   " & coclass(x,4) &   "      " & dq & coclass(x,5)& dq & crlf
					s &= "'" & String(80, "=") & crlf & crlf & crlf
					s &= "  'Dim Shared As any ptr      " & xface & "uObj_Ptr   ' unRegistered Object Ptr   " & crlf & crlf
					s &= "  'Dim Shared As Hmodule      " & xface & "hdll       ' Ocx/Dll library   " & crlf
					s &= "  '" & xface & "hdll = LoadLibrary ( """ & OcxName & """ )    ' adapt to your target path" & crlf & crlf

					if nowin=0 THEN
						s &= "  'Dim Shared As hwnd         " & xface & "hWndOcx	  ' Win handle for Ocx" & crlf & crlf & crlf
						s &= "  ' Put the following code to initialize the control where it is needed " & crlf
						s &= "  '" & xface & "hWndOcx = AxWinUnreg( Hparent , 350 , 300 , 250 , 170 ) ' define your needs for control window , Hparent (hwnd) for parent window"	& crlf & crlf
						s &= "  '" & xface & "uObj_Ptr = AxCreate_Unreg( " & xface & "hdll , " & dq & coclass(x,3) & dq & " , " & dq & coclass(x,5)& dq & " , " & xface & "hWndOcx )"& crlf & crlf
               else
						s &= "  ' Put the following code to initialize the control where it is needed " & crlf
						s &= "  '" & xface & "uObj_Ptr = AxCreate_Unreg( " & xface & "hdll , " & dq & coclass(x,3) & dq & " , " & dq & coclass(x,5)& dq & " )"& crlf & crlf
					END IF
					s &= "  ' Put the following code to Free the control after the Release command " & crlf
					s &= "  ' FreeLibrary ( " & xface & "hdll )" & crlf
					exit for
            END IF
         NEXT
			s= "'   Mini Template for unRegistered Ocx : remind, use prefix to differentiate variables " & crlf & crlf  & s
		else
			s= "'   CoClass not defined... Select only 1 Coclass on the tree view ."
			messagebox(getactivewindow()," CoClass not defined... Select only 1 Coclass on the tree view ."  ,"Error",MB_ICONERROR)
		END IF

   Return cast(zstring ptr, SysAllocStringByteLen(s, len(s)))

End Function



' FINISH INCLUDE ¤ 003 _ C:\Documents and Settings\Perso\Mes documents\axsuite2pkg\axsuite2pkg\AxSuite2\tlbcode1.bi
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

' Incorporated here : #Include Once "tlib1.bi"
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' START INCLUDE ¤ 004 _ C:\Documents and Settings\Perso\Mes documents\axsuite2pkg\axsuite2pkg\AxSuite2\tlib1.bi



Private Function RegSearchWin32(tszKey AS string) AS STRING
   Dim szKeyName AS zstring * max_PATH
   Dim szKey AS zstring * max_PATH
   Dim szClass AS zstring * max_PATH
   dim ft AS FILETIME
   Dim hKey AS HKEY
   Dim dwIdx AS uinteger
   Dim hr AS uinteger
   Dim dwname as uinteger = max_path
   Dim dwclass as uinteger = max_path
   szkey = tszkey
   DO
      hr = RegOpenKeyEx(hkey_CLASSES_ROOT, @szKey, 0, KEY_READ, @hKey)
      IF hr = ERROR_NO_MORE_ITEMS THEN EXIT FUNCTION
      IF hKey = 0 THEN EXIT FUNCTION
      dwname = max_path
      dwclass = max_path

      hr = RegEnumKeyEx(hKey, dwIdx, @szKeyName, @dwname, 0, @szClass, @dwclass, @ft)
      IF hr <> 0 THEN EXIT DO
      IF UCASE$(szKeyName) = "WIN32" THEN EXIT DO
      dwIdx += 1
   LOOP WHILE hr = 0
   RegCloseKey hKey
   IF hr <> 0 OR szKeyName = "" THEN EXIT FUNCTION
   FUNCTION = szKey
END FUNCTION

Private FUNCTION RegEnumDirectory(sKey AS STRING) AS STRING
   Dim szKey AS zstring * max_PATH
   Dim szKeyName AS zstring * max_PATH
   Dim szClass AS zstring * max_PATH
   Dim ft AS FILETIME
   Dim hKey AS HKEY
   Dim dwIdx AS uinteger
   Dim hr AS uinteger
   dim sSubkey AS STRING
   Dim dwname as uinteger
   Dim dwclass as uinteger

   ' Searches the HKEY_CLASSES_ROOT\TypeLib\<LIBID> node.
   szKey = sKey
   hr = RegOpenKeyEx(hkey_CLASSES_ROOT, @szKey, 0, KEY_READ, @hKey)
   IF hr <> ERROR_SUCCESS THEN EXIT FUNCTION
   IF hKey = 0 THEN EXIT FUNCTION
   dwIdx = 0
   DO
      dwname = max_path
      dwclass = max_path
      hr = RegEnumKeyEx(hKey, dwIdx, @szKeyName, @dwname, 0, @szClass, @dwclass, @ft)
      IF hr = ERROR_NO_MORE_ITEMS THEN EXIT DO
      sSubkey = RegSearchWin32(szKey & "\" & szKeyName)
      IF LEN(sSubkey) THEN EXIT DO
      dwIdx += 1
   LOOP
   RegCloseKey hKey
   IF hr <> 0 OR sSubkey = "" THEN EXIT FUNCTION

   dim szValueName AS zstring * max_PATH
   Dim KeyType AS DWORD
   Dim szKeyValue AS zstring * max_PATH
   Dim cValueName AS DWORD
   Dim cbData AS DWORD

   ' win32 node
   dwIdx = 0
   cValueName = max_PATH
   cbData = max_PATH
   szKey = sSubkey & "\" & "win32"
   hr = RegOpenKeyEx(hkey_CLASSES_ROOT, @szKey, 0, KEY_READ, @hKey)
   IF hr <> ERROR_SUCCESS THEN EXIT FUNCTION
   hr = RegEnumValue(hKey, dwIdx, @szValueName, @cValueName, BYVAL NULL, @KeyType, @szKeyValue, @cbData)
   RegCloseKey hKey
   FUNCTION = szKeyValue
END FUNCTION

Private Function CheckEnvVar(BYVAL sTextIn AS STRING) AS STRING
   Dim iPos AS LONG
   dim iSafety AS LONG
   Dim sTemp AS STRING
   Dim sNew AS String
   Dim ttxt As String

   ttxt = stextin
   DO UNTIL str_TALLY(ttxt, "%") < 2
      iPos = INSTR(1, ttxt, "%")                 'get first position
      sTemp = MID$(ttxt, iPos + 1,(INSTR(iPos + 1, ttxt, "%") - (iPos + 1)))
      sNew = ENVIRON$(sTemp)
      ttxt = str_replace( "%" + sTemp + "%", sNew, ttxt)
      iSafety += 1 :IF iSafety > 5 THEN EXIT do  'if we find more than 5 vars...  something is wrong
   LOOP
   FUNCTION = ttxt
End FUNCTION

Private Function RegEnumVersions(sCLSID AS STRING) AS LONG
   Dim szKey AS zstring * max_PATH
   dim szKeyName AS zstring * max_PATH
   dim szClass AS zstring * max_PATH
   dim ft AS FILETIME
   dim hKey AS HKEY
   dim dwIdx AS DWORD
   dim hr AS DWORD
   dim idx AS LONG
   dim sPath AS STRING
   dim PathPos AS LONG
   dim sFile AS STRING
   dim i AS LONG
   dim lvi as lv_item

   dim szValueName AS zstring * max_PATH
   dim KeyType AS DWORD
   dim szKeyValue AS zstring * max_PATH
   dim tsz AS zstring * max_PATH
   dim tsz0 AS zstring * max_PATH
   dim tsz1 AS zstring * max_PATH

   dim cValueName AS DWORD
   dim cbData AS DWORD
   dim hVerKey AS HKEY
   dim verIdx AS DWORD
   dim vmax_path as uinteger
   dim dwname as uinteger
   dim dwclass as uinteger

   cValueName = max_PATH
   cbData = max_PATH
   ' // Searches the HKEY_CLASSES_ROOT\TypeLib\<LIBID> node.
   szKey = "TypeLib\" & sCLSID

   hr = RegOpenKeyEx(hkey_CLASSES_ROOT, @szKey, 0, KEY_READ, @hKey)
   IF hr <> ERROR_SUCCESS THEN EXIT Function
   IF hKey = 0 THEN EXIT FUNCTION
   dwIdx = 0
   ' // Open the subtrees of the different versions of the TypeLib library
   ' // and store the filenames, descriptions, paths and CLSIDs in a 4D array.
   DO
      dwname = max_path
      dwclass = max_path
      hr = RegEnumKeyEx(hKey, dwIdx, @szKeyName, @dwname, 0, @szClass, @dwclass, @ft)
      IF hr = ERROR_NO_MORE_ITEMS THEN EXIT DO
      tsz0 = UCASE$(sCLSID)

      ' -- Get default value -------------------------------------------
      verIdx = 0
      cvaluename = max_path
      cbdata = max_path
      tsz = szKey & "\" & szKeyName
      hr = RegOpenKeyEx(hkey_CLASSES_ROOT, @tsz, 0, KEY_READ, @hVerKey)
      'Default value
      hr = RegEnumValue(hVerKey, verIdx, @szValueName, @cValueName, NULL, @KeyType, @szKeyValue, @cbData)
      RegCloseKey hVerKey
      IF szValueName = "" THEN
         tsz1 = szKeyvalue
      Else
         tsz1 = szValueName
      End IF

      '-----------------------------------------------------------------
      sPath = RegEnumDirectory(szKey & "\" & szKeyName)
      ' Check for environment variables
      IF INSTR(sPath, "%") THEN
         sPath = CheckEnvVar(sPath)              '-- added in July 25th, 2003
      End If
      spath = trim(spath, any "" " ")
		spath = trim(spath, dq)
      sfile = str_parse(spath, "\", str_numparse(spath, "\"))
      If InStr(sfile, ".") = 0 Then sfile = str_parse(spath, "\", str_numparse(spath, "\") - 1)
      sfile = ucase(sfile)
      if tsz0 <> "" and tsz1 <> "" and sfile <> "" then ' and spath <> "" THEN

         lvi.iItem = 0
         lvi.mask = LVIF_TEXT
         lvi.iSubItem = 0
         lvi.pszText = VARPTR(tsz0)
         SendMessage hlist, LVM_INSERTITEM, 0, cast(lParam, @lvi)

         lvi.iSubItem = 1
         lvi.pszText = VARPTR(tsz1)
         SendMessage hlist, LVM_SETITEM, 0, cast(lparam, @lvi)

         lvi.iSubItem = 2
         lvi.pszText = strptr(sfile)
         SendMessage hlist, LVM_SETITEM, 0, cast(lparam, @lvi)

         lvi.iSubItem = 3
         lvi.pszText = strptr(spath)
         SendMessage hlist, LVM_SETITEM, 0, cast(lparam, @lvi)

         nt1 += 1                                'count libs
      END IF
      dwIdx += 1											 'loop registry
   Loop
   ' // Close the registry
   RegCloseKey hKey
   function = 1
END FUNCTION

' *********************************************************************************************
' Enumerates all the typelibs.
' *********************************************************************************************
Private SUB RegEnumTypeLibs
   Dim szKey AS zstring*max_path
   dim szKeyName AS zstring*max_path
   dim szClass AS zstring*max_path
   dim ft AS FILETIME
   dim hKey AS hkey
   dim dwIdx AS uinteger
   dim hr AS uinteger
   dim ttxt as string
   dim dwname as dword
   dim dwclass as dword


   ' // Open the HKEY_CLASSES_ROOT\TypeLib subtree.
   szKey = "TypeLib"
   hr = RegOpenKeyEx(HKEY_CLASSES_ROOT, @szKey, 0, key_read, @hKey)
   IF hr <> ERROR_SUCCESS THEN EXIT SUB
   IF hKey = 0 THEN EXIT SUB
   ' // Parse all the TypeLib subtree and get the CLSIDs of all the TypeLibs.
   dwIdx = 0
   Do
      dwname = MAX_PATH :dwclass = max_path
      hr = RegEnumKeyEx(hKey, dwIdx, @szKeyName, @dwname, 0, @szClass, @dwclass, @ft)
      IF hr = ERROR_NO_MORE_ITEMS THEN EXIT DO
      dwIdx += 1
      RegEnumVersions(left(szKeyName, dwname))
   LOOP
   ' // Close the registry
   RegCloseKey(hKey)
End SUB

#define ListView_SetItemCountEx(l, c, f) SendMessage(cast(hwnd, L), LVM_SETITEMCOUNT, c, F)
Private FUNCTION SearchTypeLibs() AS LONG
   Dim i AS LONG
   dim ttxt as string
   SendMessage hlist, LVM_DELETEALLITEMS, 0, 0
   nt1 = 0
   RegEnumTypeLibs
   SetWindowText(hmain, "AxSuite3           ....  " & str(nt1) & " registered libs")
   FF_ListView_SetSelectedItem(hlist, 0)
   'lvsetheader(hlist,"GUID|Description                  ....  listed : " & str(nt1) & " libs |File|Path")
   function = 1
End Function

'Custom Type string
Private Function CTStr(reftype As hreftype, pti As lptypeinfo) As String
   Dim As lptypeinfo pcti
   Dim As WString Ptr iname, ihelp
   Dim hr As hresult

   hr = pTI -> lpvtbl -> GetRefTypeInfo(pti, refType, @pCTI)
   If hr Then return "UnknownCustomType"
   hr = pCTI -> lpvtbl -> GetDocumentation(pcti, - 1, @iname, 0, 0, 0)
   If hr then return "UnknownCustomType"
   Return " As " & *iname
End Function

'typedesc string
Private Function TDStr(ptD As typedesc ptr, pTI As lptypeinfo) As String
   Dim oss As String
   Dim s2 As safearraybound Ptr
   Dim u2 As UShort Ptr
   Dim st1 As String

   If ptD -> vt = VT_PTR Then
      oss = TDStr(ptD -> lptdesc, pTI) & " Ptr"
      If oss = " As void Ptr" Then Return " As lpvoid" Else Return oss
   End If

   If ptd -> vt = VT_SAFEARRAY Then
		st1="_SafeArray" & tdstr(ptd->lptdesc, pTI)
		st1 = Str_removeany(st1,"()")
		st1 = Str_ReplaceAll(" ", "_", st1)
		oss=  st1 & " As Dword"
      Return oss
   End If

   If ptd -> vt = vt_carray Then
      oss = "("
      For i As UShort = 0 To ptd -> lpadesc -> cdims - 1
         oss &= ptd -> lpadesc -> rgbounds(i).llbound & " To "
         oss &= ptd -> lpadesc -> rgbounds(i).llbound + ptd -> lpadesc -> rgbounds(i).celements - 1 & ","
      Next
      oss = Trim(oss, ",")
      oss &= ")"
      oss &= tdstr(@ptd -> lpadesc -> tdescElem, pTI)
      Return oss
   End If

   If ptd -> vt = VT_USERDEFINED Then
      oss = CTstr(ptd -> hreftype, pTI)
'		if instr(lcase(oss),"collection") THEN
'			print "collection : " & oss
'      END IF
      Return oss
   End If

   Select Case ptd -> vt  ' VARIANT/VARIANTARG compatible types
      Case VT_I2 :Return " As Short"
      Case VT_I4 :Return " As Integer"
      Case VT_R4 :Return " As Single"
      Case VT_R8 :Return " As Double"
      Case VT_CY :Return " As CY"
      Case VT_DATE :Return " As DATE"
      Case VT_BSTR :Return " As BSTR"
      Case VT_DISPATCH :Return " As LPDISPATCH"
      Case VT_ERROR :Return " As SCODE"
      Case VT_BOOL :Return " As BOOL"
      Case VT_VARIANT :Return " As VARIANT"
      Case VT_UNKNOWN :Return " As LPUNKNOWN"
      Case VT_UI1 :Return " As Ubyte"
      Case VT_DECIMAL :Return " As DECIMAL"
      Case VT_I1 :Return " As Byte"
      Case VT_UI2 :Return " As Ushort"
      Case VT_UI4 :Return " As Uinteger"
      Case VT_I8 :Return " As LongInt"
      Case VT_UI8 :Return " As UlongInt"
      Case VT_INT :Return " As Integer"
      Case VT_UINT :Return " As Uinteger"
      Case VT_HRESULT :Return " As HRESULT"
      Case VT_VOID :Return " As any ptr"
      Case VT_LPSTR :Return " As Zstring ptr"
      Case VT_LPWSTR :Return " As Wstring ptr"
		'Case VT_LPTSTR :Return " As LPTSTR"
		case else : Return " As any ptr"

   End Select
End Function

'vardesc string
Private Function VDStr(ByVal pvd As lpVARDESC, byval pti As lptypeinfo, tk As Integer) As String
   Dim As WString Ptr iname, ihelp
   Dim hr As hresult
   Dim oss As String
   Dim vvar As variant

   If (tk = TKIND_ENUM) or (tk = TKIND_MODULE) Then tk = var_const Else tk = pvd -> varkind
   If (tk And var_const) = var_const Then oss = "Const "
   hr = pti -> lpvtbl -> GetDocumentation(pti, pvd -> memid, @iName, @ihelp, 0, 0)
   If hr Then return "UnknownName"
   oss &= *iName & " "
   oss &= tdstr(@pvd -> elemdescVar.tdesc, pti)
   If (tk and var_const) <> var_const Then Return oss
   oss &= "="
   hr = VariantChangeType(@vvar, pvd -> lpvarValue, 0, VT_BSTR)
   If hr Then
      oss &= "'''" & "?" & *ihelp
   Else
      oss &= *Cast(WString Ptr, vvar.bstrval) & "?" & *ihelp
   End If
   If tdstr(@pvd -> elemdescVar.tdesc, pti) = " As BSTR" Then
      oss = str_replace( " As BSTR", " As String", oss)
      oss = str_replace( "=", "=" & dq, oss)
      oss = str_replace( "?", dq & "?", oss)
   End If
   SysFreeString(iname)
   SysFreeString(ihelp)
   Return oss
End function

Private Sub mkConst(pti As lptypeinfo, pta As lptypeattr, tk As typekind)
   Dim As WString ptr iname, ihelp
   Dim hroot As Long, hr As Long, pvd As lpVarDesc

   pTI -> lpvtbl -> GetDocumentation(pti, - 1, @iname, @ihelp, 0, 0)
   hroot = TreeViewInsertItem(cast(long, htree), hParent(tk), *iname & "?" & *ihelp)
   sysfreestring(iname)
   SysFreeString(ihelp)
   For j As Integer = 0 To pta -> cVars - 1
      hr = pTI -> lpvtbl -> GetVarDesc(pti, j, @pvd)
      TreeViewInsertItem(cast(long, htree), hroot, VDStr(pvd, pTI, tk))
      pTI -> lpvtbl -> ReleaseVarDesc(pti, pvd)
   Next
End Sub

Private Sub mkInterface(pti As lptypeinfo, pta As lptypeattr, tk As typekind)
   Dim As WString ptr iname, ihelp, dlls, aliass, iids
   Dim As String oss, prop, sk, ok, par
   Dim hroot As Long, hr As Long
   Dim pvd As lpVarDesc, pfd As lpfuncdesc, pd As paramdesc
   Dim names() As WString Ptr, cnames As Integer, ord As Short
   Dim otli As lptypelib

   hr = pTI -> lpvtbl -> GetDocumentation(pti, - 1, @iname, @ihelp, 0, 0)
   If tk = tkind_module Then
      hroot = TreeViewInsertItem(cast(long, htree), hParent(tk), *iname & "?" & *ihelp)
   Else
      stringfromiid(@pta -> guid, @iids)
      'hroot = TreeViewInsertItem(cast(long, htree), hParent(tk), prefix & *iname & "?" & *iids & "?" & *ihelp)
		hroot = TreeViewInsertItem(cast(long, htree), hParent(tk), *iname & "?" & *iids & "?" & *ihelp)
      SysFreeString(iids)
   End If
   sysfreestring(iname)
   SysFreeString(ihelp)
   For ifunc As Integer = 0 To pta -> cvars - 1
      pTI -> lpvtbl -> GetvarDesc(pti, ifunc, @pvd)
      pTI -> lpvtbl -> GetDocumentation(pti, ifunc, @iname, @ihelp, 0, 0)
      If tk = tkind_dispatch Then ok = Str(pvd -> memid) Else ok = Str(pvd -> oInst)
      oss = ok & "?2" & "?get" & str_parse(VDStr(pvd, pti, tk), " As ", 1) & " As Function()As " & str_parse(VDStr(pvd, pti, tk), " As ", 2) & "?" & *ihelp
      TreeViewInsertItem(cast(long, htree), hroot, oss)
      oss = ok & "?4" & "?put" & str_parse(VDStr(pvd, pti, tk), " As ", 1) & " As Sub(" & VDStr(pvd, pti, tk) & ")?" & *ihelp
      TreeViewInsertItem(cast(long, htree), hroot, oss)
      pTI -> lpvtbl -> ReleasevarDesc(pti, pvd)
      SysFreeString(iname)
      SysFreeString(ihelp)
   Next
   For ifunc As Integer = 0 To pta -> cfuncs - 1
      pTI -> lpvtbl -> GetfuncDesc(pti, ifunc, @pfd)
      pTI -> lpvtbl -> GetDocumentation(pti, pfd -> memid, @iname, @ihelp, 0, 0)
      ReDim names(pfd -> cparams)
      pti -> lpvtbl -> getnames(pti, pfd -> memid, @names(0), 1 + pfd -> cparams, @cnames)
      sysfreestring(names(0))
      If pfD -> cParams = 0 Then
         oss = "()"
      Else
         oss = "("
         For ipar As Integer = 1 To pfD -> cParams
            oss &= *names(ipar) :
            sysfreestring(names(ipar))
            par = TDStr(@pfd -> lprgelemdescParam[iPar - 1].tdesc, pti)
            pd = pfd -> lprgelemdescParam[iPar - 1].paramdesc

            If (pd.wParamFlags and PARAMFLAG_FHASDEFAULT) = PARAMFLAG_FHASDEFAULT Then
               If par = " As VARIANT" Then
                  oss &= par & "=Type(" & pd.pparamdescex -> varDefaultValue.vt & ",0,0,0," & variantv(pd.pparamdescex -> varDefaultValue) & ")"
               Else
                  oss &= par & "=" & variantv(pd.pparamdescex -> varDefaultValue)
               End If
            ElseIf (pd.wParamFlags and PARAMFLAG_FOPT) = PARAMFLAG_FOPT Then
               If par = " As VARIANT" Then oss &= par & "=Type(0,0,0,0,0)" Else oss &= par & "=0"
            Else
               oss &= par
            End If
            If ipar < pfD -> cParams Then oss &= ","
         Next
         oss &= ")"
      End If
      Select Case pfd -> invkind
         Case INVOKE_PROPERTYGET
            prop = "get"
         Case INVOKE_PROPERTYPUT
            prop = "put"
         Case INVOKE_PROPERTYPUTREF
            prop = "set"
         Case Else
            prop = ""
      End Select
      If tk = tkind_dispatch Then ok = Str(pfd -> memid) Else ok = Str(pfd -> oVft)
      If tk = tkind_module Then sk = "" Else sk = ok & "?" & pfd -> invkind & "?"
      If UCase(TDStr(@pfd -> elemdescfunc.tdesc, pti)) = " AS VOID" Then
         oss = sk & prop & *iname & " As Sub" & oss & "?" & *ihelp
      Else
         oss = sk & prop & *iname & " As Function" & oss & TDStr(@pfd -> elemdescfunc.tdesc, pti) & "?" & *ihelp
      End If
      If tk = tkind_module Then
         pti -> lpvtbl -> GetDllEntry(pti, pfd -> memid, pfd -> invkind, @dlls, @aliass, @ord)
         prop = *dlls & "?" & *aliass & "?" & ord & "?"
         oss = prop & oss
         sysfreestring(dlls)
         sysfreestring(aliass)
      End If
      TreeViewInsertItem(cast(long, htree), hroot, oss)
      SysFreeString(iname)
      SysFreeString(ihelp)
      pTI -> lpvtbl -> ReleasefuncDesc(pti, pfd)
   Next
End Sub

Private Sub fs_ENUM(ByVal i As uint)
   Dim oss As String
   Dim pti As lpTypeInfo, pta As lpTypeAttr
   pTLi -> lpvtbl -> GetTypeInfo(ptli, i, @pti)
   pTI -> lpvtbl -> GetTypeAttr(pti, @ptA)
   mkConst(pti, pta, tkind_enum)
End Sub

Private Sub fs_RECORD(ByVal i As uint)
   Dim As WString ptr iname, ihelp
   Dim attr As UShort
   Dim hroot As Long, hr As Long
   Dim pti As lpTypeInfo, pta As lpTypeAttr, pvd As lpVarDesc, pv As lpVariant

   hr = pTLi -> lpvtbl -> GetTypeInfo(ptli, i, @pti)
   hr = pTI -> lpvtbl -> GetTypeAttr(pti, @ptA)
   hr = pTI -> lpvtbl -> GetDocumentation(pti, - 1, @iname, @ihelp, 0, 0)
   hroot = TreeViewInsertItem(cast(long, htree), hParent(TKIND_RECORD), *iname & "?" & *ihelp)
   sysfreestring(iname)
   SysFreeString(ihelp)
   For j As Integer = 0 To pta -> cVars - 1
      hr = pTI -> lpvtbl -> GetVarDesc(pti, j, @pvd)
      TreeViewInsertItem(cast(long, htree), hroot, VDStr(pvd, pTI, tkind_record))
      pTI -> lpvtbl -> ReleaseVarDesc(pti, pvd)
   Next
   pTI -> lpvtbl -> ReleaseTypeAttr(pti, ptA)
End Sub

Private Sub fs_MODULE(ByVal i As uint)
   Dim hr As Long
   Dim pti As lpTypeInfo, pta As lpTypeAttr

   hr = pTLi -> lpvtbl -> GetTypeInfo(ptli, i, @pti)
   hr = pTI -> lpvtbl -> GetTypeAttr(pti, @ptA)
   If pta -> cvars Then mkConst(pti, pta, tkind_module)
   If pta -> cfuncs Then mkInterface(pti, pta, tkind_module)
End Sub

Private Sub fs_INTERFACE(ByVal i As uint)
   Dim hr As Long
   Dim pti As lpTypeInfo, pta As lpTypeAttr, hrt As HREFTYPE, prti As lpTypeInfo

   hr = pTLi -> lpvtbl -> GetTypeInfo(ptli, i, @pti)
   hr = pTI -> lpvtbl -> GetTypeAttr(pti, @ptA)
   mkInterface(pti, pta, tkind_interface)

   If (pta -> wTypeFlags And TYPEFLAG_FDUAL) = TYPEFLAG_FDUAL Then
      hr = pti -> lpvtbl -> GetRefTypeOfImplType(pti, - 1, @hrt)
      hr = pti -> lpvtbl -> GetRefTypeInfo(pti, hrt, @prti)
      pTI -> lpvtbl -> ReleaseTypeAttr(pti, ptA)
      hr = prTI -> lpvtbl -> GetTypeAttr(prti, @ptA)
      mkInterface(prti, pta, tkind_dispatch)
      prTI -> lpvtbl -> ReleaseTypeAttr(prti, ptA)
   Else
      pTI -> lpvtbl -> ReleaseTypeAttr(pti, ptA)
   End If
End Sub

Private Sub fs_DISPATCH(ByVal i As uint)
   Dim hr As Long
   Dim pti As lpTypeInfo, pta As lpTypeAttr, hrt As HREFTYPE, prti As lpTypeInfo

   hr = pTLi -> lpvtbl -> GetTypeInfo(ptli, i, @pti)
   hr = pTI -> lpvtbl -> GetTypeAttr(pti, @ptA)
   mkInterface(pti, pta, tkind_dispatch)
   If (pta -> wTypeFlags And TYPEFLAG_FDUAL) = TYPEFLAG_FDUAL Then
      hr = pti -> lpvtbl -> GetRefTypeOfImplType(pti, - 1, @hrt)
      hr = pti -> lpvtbl -> GetRefTypeInfo(pti, hrt, @prti)
      pTI -> lpvtbl -> ReleaseTypeAttr(pti, ptA)
      hr = prTI -> lpvtbl -> GetTypeAttr(prti, @ptA)
      mkInterface(prti, pta, tkind_interface)
      prTI -> lpvtbl -> ReleaseTypeAttr(prti, ptA)
   Else
      pTI -> lpvtbl -> ReleaseTypeAttr(pti, ptA)
   End If
End Sub

Private sub fs_COCLASS(ByVal i As uint)
   Dim As WString ptr iname, ihelp
   Dim hroot As Long, hr As Long, cit As Short, litf As memberid, x As Short, prt As hreftype, s As String
   Dim pti As lpTypeInfo, pIti As lpTypeInfo, pta As lpTypeAttr, Clsids As wString Ptr, progid As WString ptr
	Dim ptB as lpTypeAttr, interf As wString Ptr ',ClassID As CLSID,wcl as LPOLESTR
	Dim as integer ievent,iclass,ipar
	Dim as string s0,s1


   pTLi -> lpvtbl -> GetTypeInfo(ptli, i, @pti)
   hr = pTI -> lpvtbl -> GetDocumentation(pti, - 1, @iname, @ihelp, 0, 0)
   hr = pTI -> lpvtbl -> GetTypeAttr(pti, @ptA)
   stringfromiid(@pta -> guid, @clsids)
   progidfromclsid(@pta -> guid, @progid)
   hroot = TreeViewInsertItem(cast(long, htree), hParent(TKIND_COCLASS), *iname & "?" & *clsids & "?" & *ihelp)
	s1= *progid
	ipar=str_numparse(s1,".")
	if ipar > 2 then
		s1= str_parse(s1,".",1) & "." & str_parse(s1,".",2)
	end if

	TreeViewInsertItem(cast(long, htree), hroot,"ProgID Version Independant >>> " & s1)
	s0=*iname
	if ubound(coclass)= icoclass then redim preserve coclass(1 to icoclass + 25 , 1 to 7) as string
	icoclass += 1
	'print "icoclass = "; icoclass
	coclass(icoclass,1)= s0
	coclass(icoclass,2)= s1
	coclass(icoclass,3)= *clsids : coclass(icoclass,3)=trim(coclass(icoclass,3),any " " & chr(0) & chr(9)& chr(10)& chr(13) )
   sysfreestring(iname)
   sysfreestring(clsids)
   sysfreestring(ihelp)
   cIT = pTa -> cImplTypes
	'print " cIT = " ; cIT
   For x = 0 TO cIT - 1
      lITF = 0
      prt = 0
      hr = pTI -> lpvtbl -> GetImplTypeFlags(pti, x, @lITF)
      hr = pTI -> lpvtbl -> GetRefTypeOfImplType(pti, x, @prt)
      hr = pTI -> lpvtbl -> GetRefTypeInfo(pti, prt, @pITI)

      If piti Then
         hr = pITI -> lpvtbl -> GetDocumentation(piti, - 1, @iname, @ihelp, 0, 0)
			hr = pITI -> lpvtbl -> GetTypeAttr(piti, @ptB)
			stringfromiid(@ptB -> guid, @interf)
         IF lITF = 2 OR lITF = 3 Then            ' // Events interface / Default events interface
            ' Store the name of the event interface for later use
            s = *iname
				's = prefix & *iname
            putevtlist(s)

					TreeViewInsertItem(cast(long, htree), hParent(8), s0 & " ( " & s & " )" )
					if lITF = 3 THEN
						TreeViewInsertItem(cast(long, htree), hroot, "Default Event Interface >>> " & *iname  & " >>> " & *interf )
						coclass(icoclass,6)= *iname
						coclass(icoclass,7)= *interf : coclass(icoclass,7)=trim(coclass(icoclass,7),any " " & chr(0) & chr(9)& chr(10)& chr(13))
						ievent=1
					else
						TreeViewInsertItem(cast(long, htree), hroot, "Event Interface >>> " & *iname  & " >>> " & *interf )
					END IF

			elseif lITF = 1 Then ' //  Default interface
				'if iclass= 0 THEN
					TreeViewInsertItem(cast(long, htree), hroot,"Default Interface >>> " & *iname  & " >>> " & *interf )
					coclass(icoclass,4)= *iname
					coclass(icoclass,5)= *interf : coclass(icoclass,5)=trim(coclass(icoclass,5),any " " & chr(0) & chr(9)& chr(10)& chr(13))
					iclass= 1
					'print "icoclass= " ; icoclass, s0,*iname,*interf
				'END IF
			elseif lITF = 4 Then ' //  Restricted
					TreeViewInsertItem(cast(long, htree), hroot,"Restricted Interface >>> " & *iname  & " >>> " & *interf )

			elseif lITF = 8 Then ' //  Default vTable
					TreeViewInsertItem(cast(long, htree), hroot,"Default vTable Interface >>> " & *iname  & " >>> " & *interf )
         End If
         sysfreestring(iname)
         sysfreestring(ihelp)
			sysfreestring(interf)
      End If

   Next
End Sub



Private sub fs_ALIAS(ByVal i As uint)
   Dim As WString ptr iname, ihelp
   Dim hroot As Long, hr As Long, oss As String
   Dim pti As lpTypeInfo, pta As lpTypeAttr, pvd As lpVarDesc, pv As lpVariant

   pTLi -> lpvtbl -> GetTypeInfo(ptli, i, @pti)
   pTI -> lpvtbl -> GetTypeAttr(pti, @pta)
   hr = pTI -> lpvtbl -> GetDocumentation(pti, - 1, @iname, @ihelp, 0, 0)
   If hr then oss &= "UnknownTypedefName" Else oss = "Type " & *iname
   oss &= tdstr(@pta -> tdescAlias, pTI)
   hroot = TreeViewInsertItem(cast(long, htree), hparent(tkind_alias), oss & "     '" & *ihelp)
   pTI -> lpvtbl -> ReleaseTypeAttr(pti, pta)
   sysfreestring(iname)
   SysFreeString(ihelp)
End Sub

Private sub fs_UNION(ByVal i As uint)
   Dim As WString ptr iname, ihelp
   Dim attr As UShort
   Dim hroot As Long, hr As Long
   Dim pti As lpTypeInfo, pta As lpTypeAttr, pvd As lpVarDesc, pv As lpVariant

   hr = pTLi -> lpvtbl -> GetTypeInfo(ptli, i, @pti)
   hr = pTI -> lpvtbl -> GetTypeAttr(pti, @ptA)
   hr = pTI -> lpvtbl -> GetDocumentation(pti, - 1, @iname, @ihelp, 0, 0)
   hroot = TreeViewInsertItem(cast(long, htree), hParent(TKIND_UNION), *iname & "?" & *ihelp)
   sysfreestring(iname)
   SysFreeString(ihelp)
   For j As Integer = 0 To pta -> cVars - 1
      hr = pTI -> lpvtbl -> GetVarDesc(pti, j, @pvd)
      TreeViewInsertItem(cast(long, htree), hroot, VDStr(pvd, pTI, tkind_union))
      pTI -> lpvtbl -> ReleaseVarDesc(pti, pvd)
   Next
   pTI -> lpvtbl -> ReleaseTypeAttr(pti, ptA)
End Sub

Private Sub LoadTLI
   Dim As Integer cti, i
   Dim tk As typekind
   sreport = ""
	icoclass=0
	dim as string act1
	redim coclass(1 to 50, 1 to 7) as string
	act1=selpath
	act1=FF_FileName (act1)
	OcxName=act1
	'setwindowtext GetDlgItem(hmain, IDC_SBR1)," Selected :  " & act1 & "    |    Path :  " & selpath
	act1= " Selected File :  " & act1 & "    |    Path :  " & selpath
	sendmessage GetDlgItem(hmain, IDC_SBR1),WM_SETTEXT ,0,cast(lparam,strptr(act1))
   sendmessage hcode, wm_settext, 0, 0
   sendmessage getdlgitem(hmain, idc_edt1), wm_gettext, 10, cast(lparam, @prefix)
	InvalidateRect hmain, ByVal 0, True
	UpdateWindow hmain
   cti = pTLI -> lpvtbl -> gettypeinfocount(pTLI)
   If cti = 0 then exit sub
	'print "cti = " ; cti
   for i = 0 To cti - 1
      pTLI -> lpvtbl -> GetTypeInfoType(pTLI, i, @tk)
      select case tk
         case TKIND_ENUM
            fs_ENUM(i)
         case TKIND_RECORD
            fs_RECORD(i)
         case TKIND_MODULE
            fs_MODULE(i)
         case TKIND_INTERFACE
            fs_INTERFACE(i)
         case TKIND_DISPATCH
            fs_DISPATCH(i)
         case TKIND_COCLASS
            fs_COCLASS(i)
         Case TKIND_ALIAS
            fs_ALIAS(i)
         case TKIND_UNION
            fs_UNION(i)
      End select
   Next
End Sub

Private Sub cleartli
   Dim hRoot As Long
   clrevtlist()
   TreeView_DeleteAllItems(htree)
   hRoot = TreeViewInsertItem(cast(long, htree), 0, tldesc & "?" & clsids)
	hParent(5) = TreeViewInsertItem(cast(long, htree), hRoot, "CoClass   : progID , CLSID , Default Interface , Default Event Interface")
	hParent(3) = TreeViewInsertItem(cast(long, htree), hRoot, "VTable : Interface")
	hParent(4) = TreeViewInsertItem(cast(long, htree), hRoot, "Invoke : Dispatch")
   hParent(0) = TreeViewInsertItem(cast(long, htree), hRoot, "Enum")
   hParent(1) = TreeViewInsertItem(cast(long, htree), hRoot, "Record")
   hParent(2) = TreeViewInsertItem(cast(long, htree), hRoot, "Module")
   hParent(6) = TreeViewInsertItem(cast(long, htree), hRoot, "Alias")
   hParent(7) = TreeViewInsertItem(cast(long, htree), hRoot, "Union")
	hParent(8) = TreeViewInsertItem(cast(long, htree), hRoot, "Events")
End Sub

Private Sub showinfo()
	'sreport= ff_replace(sreport,chr(9),"   ")
	sreport= "'   " &  sinfcode & crlf & crlf & sreport
   sendmessage hcode, wm_settext, 0, cast(lparam, StrPtr(sreport))
end Sub


' FINISH INCLUDE ¤ 004 _ C:\Documents and Settings\Perso\Mes documents\axsuite2pkg\axsuite2pkg\AxSuite2\tlib1.bi
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

' Incorporated here : #Include once "dlgMain1.bi"
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' START INCLUDE ¤ 005 _ C:\Documents and Settings\Perso\Mes documents\axsuite2pkg\axsuite2pkg\AxSuite2\dlgMain1.bi

Private Function FileFound(mes As String) As Integer
     Dim  As Integer  myHandle , fileSize, result
     If mes = "" Then Return 0
     myHandle = Freefile()
     result = Open (mes For Binary Access Read As #myHandle )
     If result <> 0 Then
        Close #myHandle
        Function = 0
        Exit Function
     End If
     fileSize = LOF(myHandle)
	  Close #myHandle
     If fileSize=0 Then
       Function = 0
		 kill mes
		 Sleep 10
       Exit Function
     End If
	  Sleep 50
     Function = 1
End Function


Private function idem_prefix(hwin as hwnd) as integer
   dim prefix1 as zstring *11,prefix0 as zstring *11
	dim as integer i1=0
   getwindowtext getdlgitem(hwin, idc_edt1), prefix1, 10
	prefix0=prefix
	prefix1=trim(prefix1)
   if LEN(SelPath) > 0 Then
		if prefix1 = prefix0 THEN i1 = 1
	end if
	prefix=prefix1
	function= i1
	'print "function= " & i1 & "    prefix0  >" & prefix0 & "<   prefix  >" & prefix1 & "<"
END FUNCTION

Private Function FF_ClipboardSetText(ByVal Text As String) As Long
   Var hGlobalClip = GlobalAlloc(GMEM_MOVEABLE Or GMEM_SHARE, Len(Text) + 1)
   If OpenClipboard(0) Then
      EmptyClipboard()
      Var lpMem = GlobalLock(hGlobalClip)
      If lpMem Then
         CopyMemory(lpMem, StrPtr(Text), Len(text))
         GlobalUnlock(lpMem)
         Function = cast(long, SetClipboardData(CF_TEXT, hGlobalClip))
      End If
      CloseClipboard()
   else
      Function = 0
   End If
End Function

Private Sub mkInit()
	sevent=""
   sreport = Ini_templ()
   showinfo
END SUB

Private Sub mkvident
   Dim b As zString Ptr
	sevent=""
	sreport= Ini_templ()
   b = EnumCoClass1(cast(long, htree), hparent(), 0, "", "")
   sreport &=  *b :sysfreestring(cast(BSTR, b))
	if xret1=0 then
'		b = EnumModel(cast(long, htree), hparent())
'		sreport &= *b :sysfreestring(cast(BSTR, b))
	end if
	xret1=0
	xfull=0
   showinfo
End Sub

Private Sub mkuOcx1
   Dim b As zString Ptr
	sevent=""
   b = EnumCoClass3(cast(long, htree), hparent())
   sreport =  *b :sysfreestring(cast(BSTR, b))
	xret1=0
	xfull=0
   showinfo
End Sub

Private Sub mkuOcx2
   Dim b As zString Ptr
	sevent=""
   b = EnumCoClass3(cast(long, htree), hparent())
   sreport =  *b :sysfreestring(cast(BSTR, b))
	xret1=0
	xfull=0
   showinfo
End Sub

Private Sub mkConstant
   Dim b As zString Ptr
	sevent=""
   b = EnumEnum(cast(long, htree), hparent())
   sreport = *b :sysfreestring(cast(BSTR, b))
   b = EnumUnion(cast(long, htree), hparent())
   sreport &= *b :sysfreestring(cast(BSTR, b))
   b = EnumAlias(cast(long, htree), hparent())
   sreport &= *b :sysfreestring(cast(BSTR, b))
   b = EnumRecord(cast(long, htree), hparent())
   sreport &= *b :sysfreestring(cast(BSTR, b))
   showinfo
End Sub

Private function verif(s1 as string) as string
   dim as integer i1, i2
	notsure = 0
   i1 = instr(s1, "_Events_Disconnect")
   if i1 = 0 THEN
      function = ""
      exit function
   END IF
   i2 = InStrRev(s1, "Function ", i1)
   if i2 = 0 THEN
      function = ""
      exit function
   END IF
   if instr(i1 + 18, s1, "_Events_Disconnect") THEN
      function =  mid(s1, i2 + 9, i1 - (i2 + 9))
		notsure = 1
      exit function
   END IF
   function = mid(s1, i2 + 9, i1 - (i2 + 9))
END Function



Private Sub mkFull
   Dim b As zString Ptr
   dim as string s1, s2, s3
	sevent=""
	EnumCoClassB (cast(long, htree), hparent())
	sreport= Ini_templ()
	b = EnumEvent(cast(long, htree), hparent())
	s1 = *b :sysfreestring(cast(BSTR, b))
	s2 = verif(s1)

	'b = EnumModel(cast(long, htree), hparent())
	's3= *b :sysfreestring(cast(BSTR, b))

   if s1 = "" or s2 = "" THEN
      s1 = ""
      b = EnumCoClass1(cast(long, htree), hparent(), 0, "", "")
   else
		if xret2=0 then
			b = EnumCoClass1(cast(long, htree), hparent(), 1 , s2 & "_Events_Connect", s2 & "_Events_Disconnect")
		else
			b = EnumCoClass1(cast(long, htree), hparent(), 0, "", "")
		end if
	END IF
   sreport &=  *b :sysfreestring(cast(BSTR, b))
	if xret1=0 then
		sreport &= s3
		if s2<>"" and xret2=0 then
			sreport &= s1
		elseif s2<>"" then
			sreport &= crlf & "'  Events are not shown, you must select the only Interface : CoClass you need"	& crlf & crlf
		end if
	end if
	xret2=0
	xret1=0
   showinfo
End sub

Private Sub mkModule
   Dim b As zString Ptr
	sevent=""
   b = EnumModule(cast(long, htree), hparent())
   sreport = *b :sysfreestring(cast(BSTR, b))
   showinfo
end sub

Private Sub kDisp
   Dim b As zString Ptr
	sevent=""
	sreport= Ini_templ()
   b = EnumCoClass1(cast(long, htree), hparent(), 0, "", "")
   sreport &= *b :sysfreestring(cast(BSTR, b))
	if xret1=0 then
		'b = EnumInvoke1(cast(long, htree), hparent())
		'sreport &= *b :sysfreestring(cast(BSTR, b))
	end if
	xret1=0
	xfull=0
   showinfo
End Sub

Private Sub kDisp2
   Dim b As zString Ptr
   dim as string s1, s2, s3
	sevent=""
	EnumCoClassB (cast(long, htree), hparent())
	sreport= Ini_templ()
	b = EnumEvent(cast(long, htree), hparent())
	s1 = *b :sysfreestring(cast(BSTR, b))
	s2 = verif(s1)

	'b = EnumInvoke1(cast(long, htree), hparent())
	's3= *b :sysfreestring(cast(BSTR, b))

   if s1 = "" or s2 = "" THEN
      s1 = ""
      b = EnumCoClass1(cast(long, htree), hparent(), 0, "", "")
   else
		if xret2=0 then
			b = EnumCoClass1(cast(long, htree), hparent(), 1 , s2 & "_Events_Connect", s2 & "_Events_Disconnect")
		else
			b = EnumCoClass1(cast(long, htree), hparent(), 0, "", "")
		end if
	END IF
   sreport &=  *b :sysfreestring(cast(BSTR, b))
	if xret1=0 then
		sreport &= s3
		if s2<>"" and xret2=0 then
			sreport &= s1
		elseif s2<>"" then
			sreport &= crlf & "'  Events are not shown, you must select the only Interface : CoClass you need"	& crlf & crlf
		end if
	end if
	xret2=0
	xret1=0
   showinfo
End sub


Private Sub mkvtable
   Dim b As zString Ptr
	sevent=""
   b = EnumCoClass(cast(long, htree), hparent())
   sreport = *b :sysfreestring(cast(BSTR, b))
   b = EnumvTable(cast(long, htree), hparent())
   sreport &= *b :sysfreestring(cast(BSTR, b))
   showinfo
End Sub

Private Sub mkInvoke
   Dim b As zString Ptr
	sevent=""
   b = EnumCoClass(cast(long, htree), hparent())
   sreport = *b :sysfreestring(cast(BSTR, b))
   b = EnumInvoke(cast(long, htree), hparent())
   sreport &= *b :sysfreestring(cast(BSTR, b))
   showinfo
End Sub

Private Sub mkEvent
   Dim b As zString Ptr
	sevent=""
   b = EnumEvent(cast(long, htree), hparent())
   sreport = *b :sysfreestring(cast(BSTR, b))
   showinfo
End Sub

Private sub dlgMain_IDC_TAB1_Sample(byval hWin as hwnd, byval CTLID as integer)
   dim hCTLID as hwnd
   dim ts as TCITEM
   'Creating Tab
   hCTLID = GetDlgItem(hWin, CTLID)
   ts.mask = TCIF_TEXT
   ts.pszText = StrPtr( "Registered")
   SendMessage(hCTLID, TCM_INSERTITEM, 0, cast(lparam, @ts))
   ts.pszText = StrPtr( "Tree ")
   SendMessage(hCTLID, TCM_INSERTITEM, 1, cast(lparam, @ts))
   ts.pszText = StrPtr( "Code ")
   SendMessage(hCTLID, TCM_INSERTITEM, 2, cast(lparam, @ts))
   hTab0 = CreateDialogParam(hinstance, cast(LPCTSTR, dlgList), hCTLID, @dlgList_DlgProc, 0)
   hTab1 = CreateDialogParam(hinstance, cast(LPCTSTR, dlgTree), hCTLID, @dlgTree_DlgProc, 0)
   hTab2 = CreateDialogParam(hinstance, cast(LPCTSTR, dlgCode), hCTLID, @dlgCode_dlgProc, 0)
   ShowWindow(hTab0, SW_SHOW)
   ShowWindow(hTab1, SW_HIDE)
   ShowWindow(hTab2, SW_HIDE)
end sub

Private Function dlgMain_Init(Byval hWin as hwnd, Byval wParam as wParam, Byval lParam as lParam) as Integer
   Dim hicon As Integer
   hinstance = cast(hinstance, getwindowlong(hwin, gwl_hInstance))
   hmain = hwin
   hIcon = cast(integer, LoadIcon(hinstance, cast(LPCTSTR, 100)))
   SendMessage hwin, WM_SETICON, ICON_SMALL, hIcon
   dlgMain_IDC_TAB1_Sample(hWin, IDC_TAB1)
   TabCtrl_GetItemRect(getdlgitem(hwin, idc_tab1), 2, @rtab)
   movewindow(getdlgitem(hwin, idc_stc3), rtab.right + 25, rtab.top, 40, 18, TRUE)
   movewindow(getdlgitem(hwin, idc_edt1), rtab.right + 68, rtab.top, 100, 18, TRUE)
   SearchTypeLibs
'	InvalidateRect hmain, ByVal 0, True
'	UpdateWindow hmain
   listview_setcolumnwidth(hlist, 1, LVSCW_AUTOSIZE)

   function = 0
End Function

Private Function dlgMain_OnSize(Byval hWin as hwnd, Byval lState as long, Byval cx as long, Byval cy as long) as Integer
   movewindow(getdlgitem(hwin, idc_tab1), 0, 0, cx, cy, TRUE)
   movewindow(htab0, 0, 22, cx, cy - 43, TRUE)
   movewindow(htab1, 0, 22, cx, cy - 43, TRUE)
   movewindow(htab2, 0, 22, cx, cy - 43, TRUE)
	movewindow(getdlgitem(hwin, IDC_SBR1), 6 , cy-12, cx-20, 12, TRUE)
   function = 0
End Function

Private Function dlgMain_OnClose(Byval hWin as hwnd) as Integer
   function = 0
End Function

Private Function dlgMain_OnDestroy(Byval hWin as hwnd) as Integer
   function = 0
End Function

Private Function dlgMain_OnNotify(Byval hWin as hwnd, Byval lCtlID as long, Byval lpNMHDR as NMHDR ptr, Byref lresult as long) as Integer
   function = 0
End Function

Private Function dlgMain_OnTimer(Byval hWin as hwnd, Byval wTimerID as word) as Integer
   function = 0
End Function

Private Function dlgMain_IDC_TAB1_SelChange(byval hWin as hwnd, byval lpNMHDR as NMHDR ptr, Byref lresult as long) as long
   dim TabID as Long
   dim hIDC_TAB1 as hwnd
   hIDC_TAB1 = getdlgitem(hWin, IDC_TAB1)
   TabID = SendMessage(hIDC_TAB1, TCM_GETCURSEL, 0, 0)
   select case TabID
      case 0
         ShowWindow(hTab0, SW_SHOW)
         ShowWindow(hTab1, SW_HIDE)
         ShowWindow(hTab2, SW_HIDE)
			ShowWindow(GetDlgItem(hWin, IDC_STC31), SW_SHOW)
         ShowWindow(GetDlgItem(hWin, IDC_EDT31), SW_SHOW)
         setfocus hlist
			exit function
      Case 1
         ShowWindow(hTab0, SW_HIDE)
         ShowWindow(hTab1, SW_SHOW)
         ShowWindow(hTab2, SW_HIDE)

			ShowWindow(GetDlgItem(hWin, IDC_STC31), SW_HIDE)
         ShowWindow(GetDlgItem(hWin, IDC_EDT31), SW_HIDE)
         setfocus htree
			exit function
      Case 2
         ShowWindow(hTab0, SW_HIDE)
         ShowWindow(hTab1, SW_HIDE)
         ShowWindow(hTab2, SW_SHOW)
			ShowWindow(GetDlgItem(hWin, IDC_STC31), SW_HIDE)
         ShowWindow(GetDlgItem(hWin, IDC_EDT31), SW_HIDE)


         setfocus hcode
			exit function
   end select
   function = 0
End function

Private Function dlgMain_IDC_TAB1_SelChanging(byval hWin as hwnd, byval lpNMHDR as NMHDR ptr, Byref lresult as long) as long
   dim TabID as Long
   dim hIDC_TAB1 as hwnd
   hIDC_TAB1 = getdlgitem(hWin, IDC_TAB1)
   TabID = SendMessage(hIDC_TAB1, TCM_GETCURSEL, 0, 0)
   select case TabID
      case 0
         'ShowWindow(hTabDlg0,SW_HIDE)
      case 1
         'ShowWindow(hTabDlg1,SW_HIDE)
   end select
   function = 0
End Function

Private Sub chgtab(ByVal p As Integer)
   Dim nmh As nmhdr
   nmh.hwndfrom = getdlgitem(hmain, idc_tab1)
   nmh.idfrom = idc_tab1
   nmh.code = TCN_SELCHANGE
   sendmessage getdlgitem(hmain, idc_tab1), TCM_SETCURSEL, p, 0
   sendmessage getdlgitem(hmain, idc_tab1), WM_NOTIFY, idc_tab1, cast(lparam, @nmh)
   If p = 1 Then
      treeview_setcheckstate(cast(long, htree), cast(long, TreeView_GetChild(hTree, 0)), 1)
      treeview_changechildstate(cast(long, htree), cast(long, TreeView_GetChild(hTree, 0)), 1)
   End If
End Sub

Private Sub chgtab1()
   treeview_setcheckstate(cast(long, htree), cast(long, TreeView_GetChild(hTree, 0)), 1)
   treeview_changechildstate(cast(long, htree), cast(long, TreeView_GetChild(hTree, 0)), 1)
End Sub

Private Function dlgMain_IDR_MENU1_menu(byval hwin as hwnd, byval id as long) as Long
   dim as OPENFILENAME ofn
   dim as zstring*max_path pathfilename
	dim as zstring * max_path fstatic1,fstatic2
	dim as string fsave
   Dim dllpath As String
   dim as string str1
	dim as string sitem,Newvar
   dim as integer r1

   Select Case id
		Case regf
			ofn.lStructSize = sizeof(OPENFILENAME)
         ofn.hwndOwner = hwin
         ofn.hInstance = cast(hinstance, GetWindowLong(hwin, GWL_HINSTANCE))
         ofn.lpstrFile = @pathFileName
         ofn.nMaxFile = 260
         ofn.lpstrFilter = @szOpen
         ofn.Flags = OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_PATHMUSTEXIST
         if GetOpenFileName(@ofn) Then sitem = pathfilename
         IF LEN(sitem) Then
				r1=RegisterServer(hwin, sitem, 1)
            if r1 <> 0 then
					MessageBox getactiveWindow(), "Unable to Register " & crlf & crlf  & sitem, _
                     "Error", MB_OK OR MB_ICONERROR OR MB_TASKMODAL
				else
					MessageBox getactiveWindow(), "Registered !  " & crlf & crlf & sitem, _
                     "Done", MB_OK OR MB_ICONINFORMATION OR MB_TASKMODAL
					SearchTypeLibs
					searching = str_parse(sitem, "\", str_numparse(sitem, "\"))
					SetWindowText GetDlgItem(hWin, IDC_EDT31),searching
					if  searching <> "" THEN search1()
					setfocus GetDlgItem(hWin, IDC_EDT31)
				End If
         End If
			exit function
		Case unregl
			chgtab(0)
			dim as integer irow = FF_ListView_GetSelectedItem(hList)
			'messagebox 0 , "selected pos = " & str(irow),"Warning",mb_ok
			if irow > - 1 THEN
				sitem = FF_ListView_GetItemText(hList, irow, 3)
				IF LEN(sitem) Then
					r1=MessageBox (getactiveWindow(), "Are you sure, you want to unregister : " & crlf & crlf  _
							& sitem, "Confirmation", MB_YESNO OR MB_ICONWARNING OR MB_TASKMODAL	)
					if r1= IDYES THEN
						r1=RegisterServer(hwin, sitem, 0)
						if r1 <> 0 then
							MessageBox getactiveWindow(), "Unable to Unregister " & crlf & crlf  & sitem, _
									"Error", MB_OK OR MB_ICONERROR OR MB_TASKMODAL
						else
							MessageBox getactiveWindow(), "Unregistered !  " & crlf & crlf & sitem, _
									"Done", MB_OK OR MB_ICONINFORMATION OR MB_TASKMODAL
							cleartli
							selpath=""
							SearchTypeLibs
							searching=""
							sendmessage GetDlgItem(hmain, IDC_SBR1),WM_SETTEXT ,0,cast(lparam,strptr("Nothing selected"))
							SetWindowText GetDlgItem(hWin, IDC_EDT31), ""
							setfocus GetDlgItem(hWin, IDC_EDT31)
						End If
					end if
				End If
			else
				MessageBox getactiveWindow(), "Nothing selected " & crlf & crlf  & "Selec a line, please" , _
									"Error", MB_OK OR MB_ICONERROR OR MB_TASKMODAL
			End If
			exit function
      case tlb_reged
         SearchTypeLibs
'			InvalidateRect hmain, ByVal 0, True
'			UpdateWindow hmain
			exit function
      Case tlb_libfile
         ofn.lStructSize = sizeof(OPENFILENAME)
         ofn.hwndOwner = hwin
         ofn.hInstance = cast(hinstance, GetWindowLong(hwin, GWL_HINSTANCE))
         ofn.lpstrFile = @pathFileName
         ofn.nMaxFile = 260
         ofn.lpstrFilter = @szOpen
         ofn.Flags = OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_PATHMUSTEXIST
         if GetOpenFileName(@ofn) Then selpath = pathfilename
         IF LEN(SelPath) Then
            clsids = ""
            tldesc = ""
            cleartli
            IF LoadtypeLib(stringtobstr(selpath), @ptli) Then
               MessageBox BYVAL NULL, "Unable to load " & SelPath, _
                     "Error", MB_OK OR MB_ICONERROR OR MB_TASKMODAL
            Else
               LoadTLI

               chgtab(1)
               treeview_select(htree, hparent(0), TVGN_CARET)
            End If
         End If
			exit function
      case tlb_exit
         EndDialog(hWin, 0)
			exit function
      Case code_init
         savepath = "Init"
			sinfcode = "Init Code"
         mkInit()
         chgtab(2)
         gene1 = code_init
			exit function
		Case uOcx1 '10020
			iscod=0
         if idem_prefix(hWin) = 0 then
            r1 = force_click(hWin)
            if r1 = 0 THEN exit Function
         END IF
         savepath = "Unreg_Win"
			sinfcode = "Unregistered Visual Control"
			nowin=0
			mkuOcx2
			chgtab(2)
         gene1 = uOcx1
			exit function
		Case uOcx2 '10021
			iscod=0
         if idem_prefix(hWin) = 0 then
            r1 = force_click(hWin)
            if r1 = 0 THEN exit Function
         END IF
         savepath = "Unreg_NoWin"
			sinfcode = "Unregistered Not-Visual Control"
			nowin=1
			mkuOcx2
			chgtab(2)
         gene1 = uOcx2
			exit function
      Case code_ident
			iscod=0
         if idem_prefix(hWin) = 0 then
            r1 = force_click(hWin)
            if r1 = 0 THEN exit Function
         END IF
         savepath = "Win_noEv"
			sinfcode = "Visual Control"
			nowin=0
         mkvident
         chgtab(2)
         gene1 = code_ident
			exit function
      case code_const
			iscod=0
         if idem_prefix(hWin) = 0 then
            r1 = force_click(hWin)
            if r1 = 0 THEN exit Function
         END IF
         savepath = "Constant"
			sinfcode = "Constants Code"
         mkconstant
         chgtab(2)
         gene1 = code_const
			exit function
		Case code_Disp
			iscod=0
			if idem_prefix(hWin) = 0 then
            r1 = force_click(hWin)
            if r1 = 0 THEN exit Function
         END IF
         savepath = "noWin_noEv"
			sinfcode = "Not-Visual Control"
			nowin=1
         kDisp
         chgtab(2)
         gene1 = code_Disp
			exit function
		Case code_Disp2
			iscod=0
			if idem_prefix(hWin) = 0 then
            r1 = force_click(hWin)
            if r1 = 0 THEN exit Function
         END IF
         savepath = "noWin_Ev"
			sinfcode = "Not-Visual Control + Events"
			nowin=1
         kDisp2
         chgtab(2)
         gene1 = code_Disp2
			exit function

      Case code_full
			iscod=0
         if idem_prefix(hWin) = 0 then
            r1 = force_click(hWin)
            if r1 = 0 THEN exit Function
         END IF
         savepath = "Win_Ev"
			sinfcode = "Visual Control + Events"
			nowin=0
         mkFull
         chgtab(2)
         gene1 = code_full
			exit function

      Case code_Module
			iscod=0
         if idem_prefix(hWin) = 0 then
            r1 = force_click(hWin)
            if r1 = 0 THEN exit Function
         END IF
         savepath = "Module"
			sinfcode = "Module Code"
         mkModule
         chgtab(2)
         gene1 = code_Module
			exit function
      Case code_vTable
			iscod=0
         if idem_prefix(hWin) = 0 then
            r1 = force_click(hWin)
            if r1 = 0 THEN exit Function
         END IF
         savepath = "vTable"
			sinfcode = "vTable Code"
         mkvtable
         chgtab(2)
         gene1 = code_vTable
			exit function
      case code_Invoke
			iscod=0
         if idem_prefix(hWin) = 0 then
            r1 = force_click(hWin)
            if r1 = 0 THEN exit Function
         END IF
         savepath = "Invoke"
			sinfcode = "Invoke Code"
         mkInvoke
         chgtab(2)
         gene1 = code_Invoke
			exit function
      case code_event
			iscod=0
         if idem_prefix(hWin) = 0 then
            r1 = force_click(hWin)
            if r1 = 0 THEN exit Function
         END IF
         savepath = "Event"
			sinfcode = "Events Code"
         mkEvent
         chgtab(2)
         gene1 = code_event
			exit function
      Case code_save
         if sreport <> "" then
            str1 = trim(prefix, any "-_ ")
            if str1 <> "" THEN
               str1 = trim(str1, any "-_ ")
               if str1 <> "" THEN str1 = str1 & "_"
            END IF
            pathfilename = str1 & str_parse(str_parse(selpath, "\", str_numparse(selpath, "\")), ".", 1)
            pathfilename &= "_" & savepath & ".bi"
            ofn.lStructSize = sizeof(OPENFILENAME)
            ofn.hwndOwner = hwin
            ofn.hInstance = cast(hinstance, GetWindowLong(hwin, GWL_HINSTANCE))
            ofn.lpstrFile = @pathFileName
            ofn.nMaxFile = 260
            ofn.lpstrFilter = @szSave
            ofn.Flags = OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_PATHMUSTEXIST
            if GetSaveFileName(@ofn) Then savepath = pathfilename
            IF LEN(SavePath) Then
               Open savepath for Binary As #1
               Put #1,, sreport
               Close #1
            End If
         End if
			exit function

		Case Static5
			fstatic1="Ax_Lite.bi"
			fstatic2="Include file   Ax_Lite" & szNULL & "*.bi" & szNULL
			ofn.lStructSize = sizeof(OPENFILENAME)
			ofn.hwndOwner = hwin
			ofn.hInstance = cast(hinstance, GetWindowLong(hwin, GWL_HINSTANCE))
			ofn.lpstrFile = @fstatic1
			ofn.nMaxFile = 260
			ofn.lpstrFilter = @fstatic2
			ofn.Flags = OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_PATHMUSTEXIST
			if GetSaveFileName(@ofn) Then fsave=fstatic1
			'print " fsave "; fsave
			IF LEN(fsave) Then
				'print " MakeFile "; fsave
				MakeFileImport_(inc9, inc9_len, fsave)
			End If
			exit function
		Case Static6
			mem_ClipboardSetText(inc9, inc9_len)
			exit function


		Case codll
			fstatic1="ATL.DLL"
			fstatic2="Atl Dll file " & szNULL & "*.dll" & szNULL
			ofn.lStructSize = sizeof(OPENFILENAME)
			ofn.hwndOwner = hwin
			ofn.hInstance = cast(hinstance, GetWindowLong(hwin, GWL_HINSTANCE))
			ofn.lpstrFile = @fstatic1
			ofn.nMaxFile = 260
			ofn.lpstrFilter = @fstatic2
			ofn.Flags = OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_PATHMUSTEXIST
			if GetSaveFileName(@ofn) Then fsave=fstatic1
			'print " fsave "; fsave
			IF LEN(fsave) Then
				'print " MakeFile "; fsave
				MakeFileImport_(inc1, inc1_len, fsave)
			End If
			exit function
		Case codll71
			fstatic1="ATL71.DLL"
			fstatic2="Atl71 Dll file " & szNULL & "*.dll" & szNULL
			ofn.lStructSize = sizeof(OPENFILENAME)
			ofn.hwndOwner = hwin
			ofn.hInstance = cast(hinstance, GetWindowLong(hwin, GWL_HINSTANCE))
			ofn.lpstrFile = @fstatic1
			ofn.nMaxFile = 260
			ofn.lpstrFilter = @fstatic2
			ofn.Flags = OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_PATHMUSTEXIST
			if GetSaveFileName(@ofn) Then fsave=fstatic1
			'print " fsave "; fsave
			IF LEN(fsave) Then
				'print " MakeFile "; fsave
				MakeFileImport_(inc2, inc2_len, fsave)
			End If
			exit function
		Case aodll
			fstatic1="atlCtl.dll"
			fstatic2="Atl FbEdit Addin " & szNULL & "*.dll" & szNULL
			ofn.lStructSize = sizeof(OPENFILENAME)
			ofn.hwndOwner = hwin
			ofn.hInstance = cast(hinstance, GetWindowLong(hwin, GWL_HINSTANCE))
			ofn.lpstrFile = @fstatic1
			ofn.nMaxFile = 260
			ofn.lpstrFilter = @fstatic2
			ofn.Flags = OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_PATHMUSTEXIST
			if GetSaveFileName(@ofn) Then fsave=fstatic1
			'print " fsave "; fsave
			IF LEN(fsave) Then
				'print " MakeFile "; fsave
				MakeFileImport_(inc5, inc5_len, fsave)
			End If
			exit function
		Case aodll71
			fstatic1="atl71Ctl.dll"
			fstatic2="Atl71 FbEdit Addin " & szNULL & "*.dll" & szNULL
			ofn.lStructSize = sizeof(OPENFILENAME)
			ofn.hwndOwner = hwin
			ofn.hInstance = cast(hinstance, GetWindowLong(hwin, GWL_HINSTANCE))
			ofn.lpstrFile = @fstatic1
			ofn.nMaxFile = 260
			ofn.lpstrFilter = @fstatic2
			ofn.Flags = OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_PATHMUSTEXIST
			if GetSaveFileName(@ofn) Then fsave=fstatic1
			'print " fsave "; fsave
			IF LEN(fsave) Then
				'print " MakeFile "; fsave
				MakeFileImport_(inc6, inc6_len, fsave)
			End If
			exit function
      Case code_codegen
         if sreport <> "" then
            FF_ClipboardSetText(sreport)
         End if
			exit function
      case hlp_axsuite
         pathfilename = ExePath & "\axsuite3.chm"
			if FileFound(pathfilename)= 0 then
				messagebox (getactivewindow(), "File : AxSuite3.Chm not found ", "Error",MB_ICONERROR or MB_SYSTEMMODAL)
			else
				shellexecute 0, strptr( "Open"), @pathfilename, NULL, NULL, SW_SHOWNORMAL
			end if
			exit function
      case hlp_About
         DialogBoxParam(GetModuleHandle(NULL), cast(LPCTSTR, dlgAbout), hwin, @dlgAbout_DlgProc, NULL)
			exit function
      case As_AxSuite
         pathfilename = ExePath & "\axsuite3.pdf"
			if FileFound(pathfilename)= 0 then
				messagebox (getactivewindow(), "File : AxSuite3.Pdf not found ", "Error",MB_ICONERROR or MB_SYSTEMMODAL)
			else
				shellexecute 0, strptr( "Open"), @pathfilename, NULL, NULL, SW_SHOWNORMAL
			end if
			exit function
   End Select
   function = 0
End Function

Private Function FF_ListView_GetSelectedItem(ByVal hWndControl As hWnd) As Integer
   ' Do a check to ensure that this is actually a window handle
   If IsWindow(hWndControl) Then
      Function = SendMessage(hWndControl, LVM_GETSELECTIONMARK, 0, 0)
   End If

End Function

Private Function FF_ListView_GetItemText(ByVal hWndControl As hWnd, ByVal iRow As Integer, ByVal iColumn As Integer ) As String
   Dim tlv_item As LV_ITEM
   Dim zText As ZString * MAX_PATH
   Dim Text1 as string
   ' Do a check to ensure that this is actually a window handle
   If IsWindow(hWndControl) Then
      tlv_item.mask = LVIF_TEXT
      tlv_item.iItem = iRow
      tlv_item.iSubItem = iColumn
      tlv_item.pszText = VarPtr(zText)
      tlv_item.cchTextMax = SizeOf(zText)

      If SendMessage(hWndControl, LVM_GETITEM, 0, Cast(LPARAM, VarPtr(tlv_item))) Then
         Text1 = zText
         Function = Text1
      End If
   End If

End Function

Private Function FF_ListView_SetSelectedItem(ByVal hWndControl As hWnd, ByVal nIndex As Integer ) As Integer

   ' Do a check to ensure that this is actually a window handle
   If IsWindow(hWndControl) Then
      Function = SendMessage(hWndControl, LVM_SETSELECTIONMARK, 0, nIndex)

      'ensure that the item is set visually as well
      Dim tItem As LVITEM
      tItem.mask = LVIF_STATE
      tItem.iItem = nIndex
      tItem.iSubItem = 0
      tItem.State = LVIS_FOCUSED Or LVIS_SELECTED
      tItem.statemask = LVIS_FOCUSED Or LVIS_SELECTED
      SendMessage hWndControl, LVM_SETITEMSTATE, nIndex, Cast(LPARAM, VarPtr(tItem))
   End If

End Function

Private Function FF_ListView_GetTopIndex(ByVal hWndControl As hWnd) As Integer

   ' Do a check to ensure that this is actually a window handle
   If IsWindow(hWndControl) Then

      Function = SendMessage(hWndControl, LVM_GETTOPINDEX, 0, 0)

   End If

End Function

Private Sub FF_Control_Redraw(ByVal hWndControl As hWnd)

   ' Do a check to ensure that this is actually a window handle
   If IsWindow(hWndControl) Then

      ' Signal the Control to be redrawn.
      InvalidateRect hWndControl, ByVal 0, True
      UpdateWindow hWndControl

   End If
End Sub

Private sub show_line(ret1 As integer)
	dim as integer nScroll,pos1,i
   FF_ListView_SetSelectedItem(HWND_FORM1_LISTVIEW1, ret1)
	pos1 = FF_ListView_GetTopIndex(HWND_FORM1_LISTVIEW1)

	nScroll = pos1 - ret1
	If nScroll > 0 Then
		For i = 1 To nScroll
			SendMessage HWND_FORM1_LISTVIEW1, WM_VSCROLL, SB_LINEUP, 0
		Next
	Else
		For i = 1 To - nScroll
			SendMessage HWND_FORM1_LISTVIEW1, WM_VSCROLL, SB_LINEDOWN, 0
		Next
	End If

	SendMessage HWND_FORM1_LISTVIEW1, WM_SETREDRAW, TRUE, 0
	FF_Control_Redraw HWND_FORM1_LISTVIEW1

END sub



Private Function getsearch(str1 As String, ini As integer) As integer
   dim x As integer
   dim y As integer
   dim as string mess1, mess2
   'messagebox 0 , "nt1=  " & str(nt1) & "   str1 = " & str1  & "   ini = " & str( ini) , _
   '"HWND_FORM1_LISTVIEW1 = " & str(HWND_FORM1_LISTVIEW1),MB_ICONINFORMATION
   mess2 = ucase(str1)
   For x = ini To nt1 - 1
      For y = 0 To 3
         mess1 = UCase(FF_ListView_GetItemText(HWND_FORM1_LISTVIEW1, x, y))
         If Instr(mess1, mess2) > 0 Then
            Function = x
            Exit Function
         End If
      Next
   Next
   If ini = 0 Then
      messagebox 0, "Search not found  ! " & Chr(13) & Chr(13) & str1, "Information", MB_ICONINFORMATION
   Else
		if ini >1 then
			show_line(ini -1)
		else
			show_line(0)
		end if
      messagebox 0, "No more occurrence ! " & Chr(13) & Chr(13) & str1, "Information", MB_ICONINFORMATION
   End If
   Function = - 1
End Function

Private sub search1()

   Dim ret1 As integer, i As integer
   Dim pos1 As integer
   Dim nScroll As integer
   SelPath = ""
   pos0 = 0

   If searching <> "" Then
      ret1 = getsearch(searching, 0)
      If ret1 > - 1 Then
         pos0 = ret1
         FF_ListView_SetSelectedItem(HWND_FORM1_LISTVIEW1, ret1)
         pos1 = FF_ListView_GetTopIndex(HWND_FORM1_LISTVIEW1)

         nScroll = pos1 - ret1
         If nScroll > 0 Then
            For i = 1 To nScroll
               SendMessage HWND_FORM1_LISTVIEW1, WM_VSCROLL, SB_LINEUP, 0
            Next
         Else
            For i = 1 To - nScroll
               SendMessage HWND_FORM1_LISTVIEW1, WM_VSCROLL, SB_LINEDOWN, 0
            Next
         End If

         SendMessage HWND_FORM1_LISTVIEW1, WM_SETREDRAW, TRUE, 0
         FF_Control_Redraw HWND_FORM1_LISTVIEW1

      End If
   End If
   SendMessage getdlgitem(hmain, idc_edt31), EM_SETSEL, 0, - 1
   setfocus getdlgitem(hmain, idc_edt31)
End sub


Private sub next1()

   dim ret1 As integer, i As integer
   dim pos1 As integer
   dim nScroll As integer
   SelPath = ""
   If searching <> "" And pos0 < nt1 - 1 Then
      ret1 = getsearch(searching, pos0 + 1)
      If ret1 > - 1 Then
         pos0 = ret1
         FF_ListView_SetSelectedItem(HWND_FORM1_LISTVIEW1, ret1)
         pos1 = FF_ListView_GetTopIndex(HWND_FORM1_LISTVIEW1)

         nScroll = pos1 - ret1
         If nScroll > 0 Then
            For i = 1 To nScroll
               SendMessage HWND_FORM1_LISTVIEW1, WM_VSCROLL, SB_LINEUP, 0
            Next
         Else
            For i = 1 To - nScroll
               SendMessage HWND_FORM1_LISTVIEW1, WM_VSCROLL, SB_LINEDOWN, 0
            Next
         End If

         SendMessage HWND_FORM1_LISTVIEW1, WM_SETREDRAW, TRUE, 0
         FF_Control_Redraw HWND_FORM1_LISTVIEW1
      End If
   elseIf searching <> "" And pos0 = nt1 - 1 Then

		messagebox 0, "No more occurrence ! " & Chr(13) & Chr(13) & searching, "Information", MB_ICONINFORMATION
   elseIf searching = "" Then
      messagebox 0, "Nothing to search ! ", "Information", MB_ICONINFORMATION
   End If
   SendMessage getdlgitem(hmain, idc_edt31), EM_SETSEL, 0, - 1
   setfocus getdlgitem(hmain, idc_edt31)
End sub



Private Function revsearch(str1 As String, ini As integer) As integer
   dim x As integer
   dim y As integer
   dim as string mess1, mess2

   mess2 = ucase(str1)
   For x = ini To 0 Step - 1
      For y = 0 To 3
         mess1 = UCase(FF_ListView_GetItemText(HWND_FORM1_LISTVIEW1, x, y))
         If Instr(mess1, mess2) > 0 Then
            Function = x
            Exit Function
         End If
      Next
   Next
	show_line(ini + 1)
   messagebox 0, "No more occurrence ! " & Chr(13) & Chr(13) & str1, "Information", MB_ICONINFORMATION
   Function = - 1
End Function


Private sub previous1()

   dim ret1 As integer, i As integer
   dim pos1 As integer
   dim nScroll As integer
   SelPath = ""
   If searching <> "" And pos0 > 0 Then
      ret1 = revsearch(searching, pos0 - 1)
      If ret1 > - 1 Then
         pos0 = ret1


         FF_ListView_SetSelectedItem(HWND_FORM1_LISTVIEW1, ret1)
         pos1 = FF_ListView_GetTopIndex(HWND_FORM1_LISTVIEW1)

         nScroll = pos1 - ret1
         If nScroll > 0 Then
            For i = 1 To nScroll
               SendMessage HWND_FORM1_LISTVIEW1, WM_VSCROLL, SB_LINEUP, 0
            Next
         Else
            For i = 1 To - nScroll
               SendMessage HWND_FORM1_LISTVIEW1, WM_VSCROLL, SB_LINEDOWN, 0
            Next
         End If
         SendMessage HWND_FORM1_LISTVIEW1, WM_SETREDRAW, TRUE, 0
         FF_Control_Redraw HWND_FORM1_LISTVIEW1

      End If
   elseIf searching <> "" And pos0 = 0 Then


      messagebox 0, "No more occurrence ! " & Chr(13) & Chr(13) & searching, "Information", MB_ICONINFORMATION
   elseIf searching = "" Then
      messagebox 0, "Nothing to search ! ", "Information", MB_ICONINFORMATION
   End If
   SendMessage getdlgitem(hmain, idc_edt31), EM_SETSEL, 0, - 1
   setfocus getdlgitem(hmain, idc_edt31)
End sub

Private function force_click(hWin as hwnd) as integer
   dim as integer itab0, irow0, i
   dim lret As Long
   function = 0
   itab0 = tab_pos(hWin)
   getwindowtext getdlgitem(hWin, idc_edt1), prefix, 10
   IF LEN(SelPath) Then

   else
      if tab_pos(hWin) = 2 then
         sreport = ""
         showinfo
      end if
      chgtab(0)
      MessageBox BYVAL NULL, "Nothing selected !" & crlf & crlf & _
            "Click to select one on registered list or open a lib file.", _
            "Error", MB_OK OR MB_ICONERROR OR MB_TASKMODAL
      SendMessage getdlgitem(hWin, idc_edt31), EM_SETSEL, 0, - 1
      setfocus getdlgitem(hWin, idc_edt31)
      exit function

   End If
   function = 1
   if gene1 > 0 then sendmessage hWin, WM_COMMAND, cast(wparam, gene1), 0
END function




' FINISH INCLUDE ¤ 005 _ C:\Documents and Settings\Perso\Mes documents\axsuite2pkg\axsuite2pkg\AxSuite2\dlgMain1.bi
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤


'=========================================================================


Private Function dlgCode_Init(Byval hWin as hwnd, Byval wParam as wParam, Byval lParam as lParam) as Integer
   hcode = getdlgitem(hwin, idc_red1)
   sendmessage hcode, wm_settext, 0, 0
   function = 0
End Function

Private Function dlgCode_OnSize(Byval hWin as hwnd, Byval lState as long, Byval cx as long, Byval cy as long) as Integer
   movewindow(getdlgitem(hwin, idc_red1), 0, 0, cx, cy, true)
   function = 0
End Function

Private Function dlgCode_OnClose(Byval hWin as hwnd) as Integer
   function = 0
End Function

Private Function dlgCode_OnDestroy(Byval hWin as hwnd) as Integer
   function = 0
End Function

Private Function dlgCode_OnNotify(Byval hWin as hwnd, Byval lCtlID as long, Byval lpNMHDR as NMHDR ptr, Byref lresult as long) as Integer
   function = 0
End Function

Private Function dlgCode_OnTimer(Byval hWin as hwnd, Byval wTimerID as word) as Integer
   function = 0
End Function

Private Function dlgTree_Init(Byval hWin as hwnd, Byval wParam as wParam, Byval lParam as lParam) as Integer
   htree = getdlgitem(hwin, idc_trv1)
   function = 0
End Function

Private Function dlgTree_OnSize(Byval hWin as hwnd, Byval lState as long, Byval cx as long, ByVal cy as long) as Integer
   movewindow(htree, 0, 0, cx, cy, true)
   function = 0
End Function

Private Function dlgTree_OnClose(Byval hWin as hwnd) as Integer
   function = 0
End Function

Private Function dlgTree_OnDestroy(Byval hWin as hwnd) as Integer
   function = 0
End Function



Private function IDD_DLG1_idc_trv1_chk(Byval hWin as hwnd, ByVal hitem as integer) as Long
   Dim tstate As Integer
   tstate = TreeView_GetCheckState(cast(long, hwin), hitem)
   Treeview_ChangeChildState(cast(long, hwin), hitem, tstate)
   Treeview_ChangeParentState(cast(long, hwin), hitem, 0)
   function = 0
End Function

Private Function dlgTree_OnNotify(Byval hWin as hwnd, Byval lCtlID as long, Byval lpNMHDR as NMHDR ptr, Byref lresult as long) as Integer
   Dim As Long event, itmp
   Dim ht As TV_HITTESTINFO
   Dim As dword dwpos
   event = lpnmhdr -> code
   if lctlid = idc_trv1 Then
      If event = NM_CLICK Then
         dwpos = GetMessagePos()
         iTmp = LoWord(dwpos)
         ht.pt.x = iTmp
         iTmp = HiWord(dwpos)
         ht.pt.y = iTmp
         MapWindowPoints(HWND_DESKTOP, lpnmhdr -> hWndFrom, @ht.pt, 1)
         TreeView_HitTest(lpnmhdr -> hwndFrom, @ht)
         If ht.flags = TVHT_ONITEMSTATEICON Then
            IDD_DLG1_idc_trv1_chk(lpnmhdr -> hWndFrom, cast(long, ht.hItem))
				'IDD_DLG1_idc_trv1_chk(lpnmhdr -> hWndFrom,ht.hItem)
         End If
      End If
   End If
   function = 0
End Function

Private Function dlgTree_OnTimer(Byval hWin as hwnd, Byval wTimerID as word) as Integer
   function = 0
End Function

Private sub dlgList_IDC_LSV1_Sample(byval hWin as hwnd, byval CTLID as integer)
   'dim hCTLID as hwnd
   dim dwStyle as dword
   hlist = getdlgitem(hwin, CTLID)
   dwStyle = SendMessage(hlist, LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
   dwStyle = dwStyle OR LVS_REPORT or LVS_EX_FULLROWSELECT
   sendmessage hlist, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, dwStyle
   lvsetmaxcols(cast(long, hlist), 4)

   lvsetheader(cast(long, hlist), "GUID|Description|File|Path")
End sub

Private FUNCTION compare(BYVAL lParam1 AS LONG, BYVAL lParam2 AS LONG, BYVAL lParamsort AS LONG) AS Integer
   dim value1 AS zstring * 300
   dim value2 AS zstring * 300
   dim j as integer

   FUNCTION = 0

   value1 = ucase(LVGetValue(cast(long, hlist), lParam1, lParamsort))
   value2 = ucase(LVGetValue(cast(long, hlist), lParam2, lParamsort))
   SELECT CASE lviewSort
      CASE 0                                     'ascending
         j = 1
      CASE ELSE                                  'descending
         j = - 1
   END SELECT
   IF value1 < value2 THEN
      FUNCTION = - 1 * j
   ELSEIF value1 = value2 THEN
      FUNCTION = 0
   ELSE
      FUNCTION = 1 * j
   END IF
END Function

Private SUB ResetLParam(ByRef hList AS LONG)
   dim i AS LONG
   dim recs AS LONG
   dim lvi AS LV_ITEM
   dim x AS LONG

   lvi.mask = LVIF_PARAM
   lvi.iSubItem = 0
   recs = sendmessage(cast(hwnd, hlist), lvm_GetItemCount, 0, 0)
   FOR i = 0 TO recs - 1
      lvi.iItem = i
      x = SendMessage(cast(hwnd, hlist), LVM_GetItem, 0, cast(lparam, @lvi))
      lvi.lParam = lvi.iItem
      x = SendMessage(cast(hwnd, hlist), LVM_SetItem, 0, cast(lparam, @lvi))
   NEXT
END SUB

Private Function dlgList_Init(Byval hWin as hwnd, Byval wParam as wParam, Byval lParam as lParam) as Integer
   dlgList_IDC_LSV1_Sample(hWin, IDC_LSV1)
   function = 0
End Function

Private Function dlgList_OnSize(Byval hWin as hwnd, Byval lState as long, Byval cx as long, Byval cy as long) as Integer
   movewindow(getdlgitem(hwin, idc_lsv1), 0, 0, cx, cy, true)
   function = 0
End Function

Private Function dlgList_OnClose(Byval hWin as hwnd) as Integer
   function = 0
End Function

Private Function dlgList_OnDestroy(Byval hWin as hwnd) as Integer
   function = 0
End Function

Private Function dlgList_OnNotify(Byval hWin as hwnd, Byval lCtlID as long, Byval lpNMHDR as NMHDR ptr, Byref lresult as long) as Integer
   Dim pnmlv As NMLISTVIEW Ptr
   Dim item As Integer
   SELECT CASE lpNMHdr -> idFrom
      CASE idc_LSV1
         pNMLV = cast(NMLISTVIEW Ptr, lpnmhdr)
         SELECT CASE pNmlv -> hdr.Code
            Case LVN_COLUMNCLICK
               IF pNmLv -> iSubItem <> - 1 THEN
                  'toggle ascending/descending
                  lviewSort = NOT lviewSort
                  ListView_SortItems(hList, procPTR(compare), pNmLv -> iSubItem)
                  ResetLParam cast(long, hList)
               END If
         End select
   End select
   function = 0
End Function

Private Function dlgList_OnTimer(Byval hWin as hwnd, Byval wTimerID as word) as Integer
   function = 0
End Function

Private function dlgList_IDC_LSV1_Clicked(Byval hWin as hwnd, Byval pNMLV as NMLISTVIEW ptr) as long
   dim hIDC_LSV1 as hwnd
   dim item as Long, lret As Long
	dim as string act1
   hIDC_LSV1 = GetDlgItem(hWin, IDC_LSV1)
   item = pnmlv -> iitem
   selpath = lvgetvalue(cast(long, hlist), item, 3)
   clsids = LVGetvalue(cast(long, hlist), item, 0)
   tldesc = LVGetvalue(cast(long, hlist), item, 1)
	act1=LVGetvalue(cast(long, hlist), item, 2)
   IF LEN(SelPath) Then
      cleartli
      lret = LoadtypeLib(stringtobstr(selpath), @ptli)
      IF lret Then
         MessageBox BYVAL NULL, "Unable to load " & SelPath, _
               "Error", MB_OK OR MB_ICONERROR OR MB_TASKMODAL
      Else
			'act1=" Selected :  " & act1 & "    |    Path :  " & selpath
         'sendmessage GetDlgItem(hmain, IDC_SBR1),WM_SETTEXT ,0,cast(lparam,strptr(act1))
			setwindowtext GetDlgItem(hmain, IDC_SBR1)," Selected :  " & act1 & "    |    Path :  " & selpath
			LoadTLI
         chgtab(1)
         treeview_select(htree, hparent(0), TVGN_CARET)
      End If
   End If
   gene1 = 0
	searching=""
   function = 0
end function


Private function dlgList_IDC_LSV1_Click1(Byval hWin as hwnd, Byval pNMLV as NMLISTVIEW ptr) as long
   dim hIDC_LSV1 as hwnd
   dim item as Long, lret As Long
	dim as string act1
   hIDC_LSV1 = GetDlgItem(hWin, IDC_LSV1)
   item = pnmlv -> iitem
   selpath = lvgetvalue(cast(long, hlist), item, 3)
   clsids = LVGetvalue(cast(long, hlist), item, 0)
   tldesc = LVGetvalue(cast(long, hlist), item, 1)
	act1=LVGetvalue(cast(long, hlist), item, 2)
   IF LEN(SelPath) Then
      cleartli
      lret = LoadtypeLib(stringtobstr(selpath), @ptli)
      IF lret Then
         MessageBox BYVAL NULL, "Unable to load " & SelPath, _
               "Error", MB_OK OR MB_ICONERROR OR MB_TASKMODAL
      Else
			'act1=" Selected :  " & act1 & "    |    Path :  " & selpath
         'sendmessage GetDlgItem(hmain, IDC_SBR1),WM_SETTEXT ,0,cast(lparam,strptr(act1))
			setwindowtext GetDlgItem(hmain, IDC_SBR1)," Selected :  " & act1 & "    |    Path :  " & selpath
         LoadTLI
         chgtab1()
         treeview_select(htree, hparent(0), TVGN_CARET)
         'chgtab(0)

      End If
   End If
   gene1 = 0
	searching=""
   function = 0
end function


Private function makefont(byval lCyPixels as long, sFntName as string, byval fFntSize as long, byval lWeight as long, byval lUnderlined as long, byval lItalic as long, byval lStrike as long, byval lCharSet as long) as long
   dim lf as LOGFONT
   lF.lfHeight = - (fFntSize * lCyPixels) \ 69
   lF.lfFaceName = sFntName
   IF lWeight = FW_DONTCARE THEN
      lf.lfWeight = FW_NORMAL
   ELSE
      lf.lfWeight = lWeight
   END IF
   lf.lfUnderline = lUnderlined
   lf.lfItalic = lItalic
   lf.lfStrikeOut = lStrike
   lf.lfCharSet = lCharSet
   'create font and assign handle to a global 'variable
   function = cast(long, CreateFontIndirect(BYVAL VARPTR(lF)))
end Function

Private Function dlgAbout_Init(Byval hWin as hwnd, Byval wParam as wParam, Byval lParam as lParam) as Integer
   Dim text As String
   Dim As Integer hIcon, hFont, hDC

   SetTimer hwin, ABOUT_TIMER, 5000, NULL

   hIcon = cast(integer, LoadIcon(0, IDI_ASTERISK))
   SendMessage hwin, WM_SETICON, ICON_BIG, hIcon

   hDC = cast(integer, GetDC(0))
   hfont = MakeFont(GetDeviceCaps(cast(hdc, hDC), LOGPIXELSY), "Times New Roman", 20, fw_bold, false, false, FALSE, ANSI_CHARSET)
   ReleaseDC 0, cast(hdc, hDC)
   SendMessage GetDlgItem(hwin, idc_stc1), WM_SETFONT, hFont, 0
   function = 0
End Function

Private Function dlgAbout_OnSize(Byval hWin as hwnd, Byval lState as long, Byval cx as long, Byval cy as long) as Integer
   function = 0
End Function

Private Function dlgAbout_OnClose(Byval hWin as hwnd) as Integer
   function = 0
End Function

Private Function dlgAbout_OnDestroy(Byval hWin as hwnd) as Integer
   function = 0
End Function






'=========================================================================
'Initial code of control
'=========================================================================
iccex.dwSize = SIZEOF(iccex)
iccex.dwICC = ICC_TAB_CLASSES
InitCommonControlsEx(@iccex)
iccex.dwSize = SIZEOF(iccex)
iccex.dwICC = ICC_LISTVIEW_CLASSES
InitCommonControlsEx(@iccex)
iccex.dwSize = SIZEOF(iccex)
iccex.dwICC = ICC_TREEVIEW_CLASSES
InitCommonControlsEx(@iccex)
hIDC_RED1 = dylibload( "riched20.dll")

DialogBoxParam(GetModuleHandle(NULL), Cast(zstring ptr, dlgMain), NULL, @dlgMain_DlgProc, NULL)

DylibFree(hdll)
ExitProcess(0)
end

'=========================================================================
'Dialog callback procedure
'=========================================================================
Private Function dlgMain_DlgProc(byval hWin as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as integer
   dim as long id, event, lresult
   dim lpNMHDR as NMHDR ptr
   dim nBuffer AS string = space(250)
   dim itab0 as integer

   select case uMsg
      case WM_INITDIALOG
         if dlgMain_Init(hWin, wparam, lparam) then
            function = false
            exit function
         end if
      case WM_COMMAND
         HWND_FORM1_LISTVIEW1 = hlist
         id = loword(wParam)
         event = hiword(wParam)
         select CASE id
            case IDC_STC3
               'messagebox 0, "lParam = " & lparam ,"prefix", mb_ok
               force_click(hWin)
               exit function
            case IDC_STC31
               if tab_pos(hWin) <> 0 THEN exit function
               'messagebox 0, "search" ,"info", mb_ok
               GetWindowText GetDlgItem(hWin, IDC_EDT31), nBuffer, 250
               nBuffer = trim(nBuffer)
               if searching <> nBuffer and nBuffer <> "" THEN
                  searching = nBuffer
                  search1()
               else
                  next1()
               END IF
               exit function
            case Search_F2
					'messagebox 0 ,"Search","DDD" ,0
					chgtab(0)
               'if tab_pos(hWin) <> 0 THEN exit function
               AskMain(hWin)
               SetWindowText GetDlgItem(hWin, IDC_EDT31), searching
               if searching <> "" and nook=0 THEN
                  search1()
               END IF
					nook=0
               exit function
            case Search_F3
					chgtab(0)
               'if tab_pos(hWin) <> 0 THEN exit function
               GetWindowText GetDlgItem(hWin, IDC_EDT31), nBuffer, 250
               nBuffer = trim(nBuffer)
               if searching <> nBuffer and nBuffer <> "" THEN
                  searching = nBuffer
                  search1()
                elseif nBuffer <> "" THEN
                  next1()
               END IF
               exit function
            case Search_F4
					chgtab(0)
               'if tab_pos(hWin) <> 0 THEN exit function
               GetWindowText GetDlgItem(hWin, IDC_EDT31), nBuffer, 250
               nBuffer = trim(nBuffer)
               if searching <> nBuffer and nBuffer <> "" THEN
                  searching = nBuffer
                  search1()
               elseif nBuffer <> "" THEN
                  previous1()
               END IF
               exit function

         END SELECT
         If dlgMain_IDR_MENU1_menu(hwin, id) Then
            function = false
            exit Function
         End If

      case WM_SIZE
         if dlgMain_OnSize(hWin, wparam, loword(lparam), hiword(lparam)) then
            function = false
            exit function
         end if

      case WM_NOTIFY
         lpNMHDR = cast(NMHDR ptr, lparam)
         id = lpnmhdr -> idfrom
         event = lpnmhdr -> code
         if id = IDC_TAB1 then
            if event = TCN_SELCHANGE then
               'A tab selection is made
               if dlgMain_IDC_TAB1_SelChange(hWin, lpNMHDR, lresult) then
                  function = lresult
                  exit function
               end if
            end if
            if event = TCN_SELCHANGING then
               if dlgMain_IDC_TAB1_SelChanging(hWin, lpNMHDR, lresult) then
                  function = lresult
                  exit function
               end if
            end if
         end if
         if dlgMain_OnNotify(hWin, wparam, cast(NMHDR ptr, lparam), lresult) then
            function = lresult
            exit function
         end if
      case WM_TIMER
         if dlgMain_OnTimer(hWin, wparam) then
            function = false
            exit function
         end if
      case WM_CLOSE
         if dlgMain_OnClose(hWin) then
            function = false
            exit function
         end if
         EndDialog(hWin, 0)
      case WM_DESTROY
         dlgMain_OnDestroy(hWin)
         function = false
         exit function
      case else
         return FALSE
   end select
   return TRUE
End Function

Private Function dlgList_DlgProc(byval hWin as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as integer
   dim as long id, event, lresult
   dim lpNMHDR as NMHDR ptr
   dim pNMLV AS NMLISTVIEW ptr
   dim as string mess1, mess2
   dim nBuffer AS string = space(250)

   select case uMsg
      case WM_INITDIALOG
         if dlgList_Init(hWin, wparam, lparam) then
            function = false
            exit function
         end if
      case WM_COMMAND
         id = loword(wParam)
         event = hiword(wParam)
         HWND_FORM1_LISTVIEW1 = hList
         SELECT CASE id
            case Search_F2
               AskMain(hWin)
               SetWindowText GetDlgItem(hmain, IDC_EDT31), searching
               if searching <> "" and nook=0 THEN
                  search1()
               END IF
					nook=0
               exit function
            case Search_F3
               GetWindowText GetDlgItem(hmain, IDC_EDT31), nBuffer, 250
               nBuffer = trim(nBuffer)
               if searching <> nBuffer and nBuffer <> "" THEN
                  searching = nBuffer
                  search1()
               else
                  next1()
               END IF
               exit function
            case Search_F4
               GetWindowText GetDlgItem(hmain, IDC_EDT31), nBuffer, 250
               nBuffer = trim(nBuffer)
               if searching <> nBuffer and nBuffer <> "" THEN
                  searching = nBuffer
                  search1()
               else
                  previous1()
               END IF
               exit function
            case Copy_GUID
               GetCopy1 0
               exit function
            case Copy_NAME
               GetCopy1 2
               exit function
            case Copy_PATH
               GetCopy1 3
               exit function
         end select
      case WM_SIZE
         if dlgList_OnSize(hWin, wparam, loword(lparam), hiword(lparam)) then
            function = false
            exit function
         end if
      case WM_CONTEXTMENU
         If hPopupMenu Then DestroyMenu hPopupMenu
         hPopupMenu = CreatePopupMenu()
         AppendMenu hPopupMenu, MF_STRING, Search_F2, "New Search... "
         AppendMenu hPopupMenu, MF_SEPARATOR, 0, ""
         AppendMenu hPopupMenu, MF_STRING, Search_F3, "Find Next "
         AppendMenu hPopupMenu, MF_STRING, Search_F4, "Find Previous "
         AppendMenu hPopupMenu, MF_SEPARATOR, 0, ""
         AppendMenu hPopupMenu, MF_SEPARATOR, 0, ""
         AppendMenu hPopupMenu, MF_STRING, Copy_GUID, "Copy GUID "
         AppendMenu hPopupMenu, MF_STRING, Copy_NAME, "Copy File Name "
         AppendMenu hPopupMenu, MF_STRING, Copy_PATH, "Copy Full Path "
         AppendMenu hPopupMenu, MF_SEPARATOR, 0, ""
         TrackPopupMenu hPopupMenu, TPM_LEFTALIGN Or TPM_LEFTBUTTON, loword(lparam), hiword(lparam), 0, hWin, 0
		case WM_NOTIFY
         lpNMHDR = cast(NMHDR ptr, lparam)
         id = lpnmhdr -> idfrom
         event = lpnmhdr -> code
         if id = IDC_LSV1 then
            pNMLV = cast(NMLISTVIEW ptr, lpNMHDR)
            if pNMLV -> hdr.code = NM_DBLCLK then
               if dlgList_IDC_LSV1_Clicked(hWin, cast(NMLISTVIEW ptr, lparam)) then
                  function = false
                  exit function
               end if
            elseif pNMLV -> hdr.code = NM_CLICK then
               if dlgList_IDC_LSV1_Click1(hWin, cast(NMLISTVIEW ptr, lparam)) then
                  function = false
                  exit function
               end if
				elseif pNMLV -> hdr.code = NM_RCLICK then
               if dlgList_IDC_LSV1_Click1(hWin, cast(NMLISTVIEW ptr, lparam)) then
                  function = false
                  exit function
               end if
            end if
         end if
         if dlgList_OnNotify(hWin, wparam, cast(NMHDR ptr, lparam), lresult) then
            function = lresult
            exit function
         end if
      case WM_TIMER
         if dlgList_OnTimer(hWin, wparam) then
            function = false
            exit function
         end if
      case WM_CLOSE
         if dlgList_OnClose(hWin) then
            function = false
            exit function
         end if
         EndDialog(hWin, 0)
			exit function
      case WM_DESTROY

         dlgList_OnDestroy(hWin)
         function = false
         exit function
      case else
         return FALSE
   end select
   return TRUE
End Function

sub cop_all()
   SendMessage hcode, EM_SETSEL, 0, - 1
   SendMessage hcode, WM_COPY, 0, 0
   SendMessage hcode, EM_SETSEL, - 1, 0
   SendMessage hcode, EM_SETSEL, 0, 0
END SUB

sub cod21(byval iv as integer)

	dim D as GetTextLengthEX, T as GETTEXTEX, iLengthText as integer ,buf as string
	D.flags = GTL_DEFAULT
	D.codepage = CP_ACP
   'return number of characters
   iLengthText = SendMessage(hcode, EM_GetTextLengthEX, cast(wparam,VarPTR(D)),0)
	'print " iLengthText = " ;iLengthText & "  len(sreport) = "; len(sreport)
	buf = Space(iLengthText)

	T.cb = iLengthText + 1
	T.flags = GT_DEFAULT
	T.codepage = CP_ACP
	T.lpDefaultChar = NULL
	T.lpUsedDefChar = NULL
	SendMessage hcode, EM_GETTEXTEX, cast(wparam,varptr(T)), cast(lparam,StrPTR(buf))
	if iv = 0 THEN
		iscod= Instr(iscod +1 , ucase(buf), ucase(searching2))
		'print " + " ;iscod
	elseif iv = 1 THEN
		iscod= Instrrev( ucase(buf), ucase(searching2),iscod -1)
		'print " - " ;iscod
   END IF
   If iscod Then
		SendMessage hcode, EM_SetSel , iscod-1, iscod + Len(searching2)-1  '+/-1 to convert to zero-based
		SendMessage hcode, EM_SCROLLCARET, 0, 0
	else
		messagebox 0, searching2 & "  : no more to find ! " , "Warning", mb_ok
	END IF
END SUB

Private Function dlgCode_DlgProc(byval hWin as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as integer
   dim as long id, event, lresult
   dim lpNMHDR as NMHDR ptr
   dim nBuffer AS string = space(250)

   select case uMsg
      case WM_INITDIALOG
         if dlgCode_Init(hWin, wparam, lparam) then
            function = false
            exit function
         end if
      case WM_COMMAND
         id = loword(wParam)
         event = hiword(wParam)
         SELECT CASE id
            case code_Cop
               SendMessage hcode, WM_COPY, 0, 0
               exit function
            case code_Copall
               cop_all()
               exit function
            case code_All
               SendMessage hcode, EM_SETSEL, 0, - 1
               exit function
            case code_save
               dlgMain_IDR_MENU1_menu(hwin, code_save)
               exit function
            case code_Not
               SendMessage hcode, EM_SETSEL, - 1, 0
               exit function
				case code_Search
					AskMain2(hWin)
					if searching2 <> "" and searching2 <>"Searching Item" and nook=0 THEN cod21(0)
					nook=0
					exit function
				case code_Search1
					if searching2 <> "" and searching2 <>"Searching Item" THEN
						cod21(0)
					else
						AskMain2(hWin)
						if searching2 <> "" and searching2 <>"Searching Item" and nook=0 THEN	cod21(0)
						nook=0
               END IF
					exit function
				case code_Search2
					if searching2 <> "" and searching2 <>"Searching Item" THEN
						'print "reverse"
						cod21(1)
					else
						AskMain2(hWin)
						if searching2 <> "" and searching2 <>"Searching Item" and nook=0 THEN	cod21(0)
						nook=0
               END IF
					exit function
         end select
      case WM_SIZE
         if dlgCode_OnSize(hWin, wparam, loword(lparam), hiword(lparam)) then
            function = false
            exit function
         end if
      case WM_CONTEXTMENU
         If hPopupMenu Then DestroyMenu hPopupMenu
         hPopupMenu = CreatePopupMenu()
         AppendMenu hPopupMenu, MF_STRING, code_Cop, "Copy Selection   / Ctrl-C"
         AppendMenu hPopupMenu, MF_STRING, code_Copall, "Copy All"
         AppendMenu hPopupMenu, MF_SEPARATOR, 0, ""
         AppendMenu hPopupMenu, MF_STRING, code_save, "Save All to File"
         AppendMenu hPopupMenu, MF_SEPARATOR, 0, ""
         AppendMenu hPopupMenu, MF_STRING, code_All, "Select All            / Ctrl-A"
         AppendMenu hPopupMenu, MF_STRING, code_Not, "Unselect"
			AppendMenu hPopupMenu, MF_SEPARATOR, 0, ""
			AppendMenu hPopupMenu, MF_STRING, code_Search, "New Search..."
			AppendMenu hPopupMenu, MF_STRING, code_Search1, "Next"
			AppendMenu hPopupMenu, MF_STRING, code_Search2, "Previous"
         TrackPopupMenu hPopupMenu, TPM_LEFTALIGN Or TPM_LEFTBUTTON, loword(lparam), hiword(lparam), 0, hWin, 0
      case WM_NOTIFY
         lpNMHDR = cast(NMHDR ptr, lparam)
         id = lpnmhdr -> idfrom
         event = lpnmhdr -> code

         if dlgCode_OnNotify(hWin, wparam, cast(NMHDR ptr, lparam), lresult) then
            function = lresult
            exit function
         end if
      case WM_TIMER
         if dlgCode_OnTimer(hWin, wparam) then
            function = false
            exit function
         end if
      case WM_CLOSE
         if dlgCode_OnClose(hWin) then
            function = false
            exit function
         end if
         EndDialog(hWin, 0)
      case WM_DESTROY
         'dylibfree(hIDC_RED1)

         dlgCode_OnDestroy(hWin)
         function = false
         exit function
      case else
         return FALSE
   end select
   return TRUE
End Function


Private Function dlgTree_DlgProc(byval hWin as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as integer
   dim as long id, event, lresult
   dim lpNMHDR as NMHDR ptr

   select case uMsg
      case WM_INITDIALOG
         if dlgTree_Init(hWin, wparam, lparam) then
            function = false
            exit function
         end if
      case WM_COMMAND
         id = loword(wParam)
         event = hiword(wParam)
      case WM_SIZE
         if dlgTree_OnSize(hWin, wparam, loword(lparam), hiword(lparam)) then
            function = false
            exit function
         end if
      case WM_NOTIFY
         lpNMHDR = cast(NMHDR ptr, lparam)
         id = lpnmhdr -> idfrom
         event = lpnmhdr -> code
         if dlgTree_OnNotify(hWin, wparam, cast(NMHDR ptr, lparam), lresult) then
            function = lresult
            exit function
         end if
      case WM_TIMER
         if dlgTree_OnTimer(hWin, wparam) then
            function = false
            exit function
         end if
      case WM_CLOSE
         if dlgTree_OnClose(hWin) then
            function = false
            exit function
         end if
         EndDialog(hWin, 0)
      case WM_DESTROY
         dlgTree_OnDestroy(hWin)
         function = false
         exit function
      case else
         return FALSE
   end select
   return TRUE
End Function


Private Function dlgAbout_DlgProc(byval hWin as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as integer
   dim as long id, event, lresult
   dim lpNMHDR as NMHDR ptr

   select case uMsg
      case WM_INITDIALOG
         if dlgAbout_Init(hWin, wparam, lparam) then
            function = false
            exit function
         end if
      case WM_CLOSE
         if dlgAbout_OnClose(hWin) then
            function = false
            exit function
         end if
         EndDialog(hWin, 0)
      case WM_DESTROY
         dlgAbout_OnDestroy(hWin)
         function = false
         exit function
      case else
         return FALSE
   end select
   return TRUE
End Function


Private function tab_pos(hWin1 as hwnd) as integer
   dim TabID as integer
   dim hIDC_TAB1 as hwnd
   hIDC_TAB1 = getdlgitem(hWin1, IDC_TAB1)
   TabID = SendMessage(hIDC_TAB1, TCM_GETCURSEL, 0, 0)
   'messagebox 0 , "Tab = " & str(TabID),"Tab",mb_ok
   function = TabID
END FUNCTION



Private sub GetCopy1(posi1 as integer)
   dim as string sitem
   dim as integer irow = FF_ListView_GetSelectedItem(hList)
   'messagebox 0 , "selected pos = " & str(irow),"Warning",mb_ok
   if irow > - 1 THEN
      sitem = FF_ListView_GetItemText(hList, irow, posi1)
      FF_ClipboardSetText(sitem)
   else
      messagebox 0, "Nothing selected !", "Warning", mb_ok
   END IF
end sub

Private Function AskMain(ByVal hwParent As hwnd) As Integer
   if tab_pos(hwParent) = 0 then
      DialogBoxParam(GetModuleHandle(NULL), Cast(ZString Ptr, dlg_Ask), hwParent, @dlgAsk_DlgProc, 0)
      'messagebox 0,searching,"retour",mb_ok
      Return True
   Else
      messagebox 0, "Not in the list view tab !", "Warning", mb_ok
   End if
   Return False
End Function

Private Function dlgAsk_DlgProc(ByVal hWin As hWnd, ByVal uMsg As Uinteger, _
         ByVal wParam1 As wParam, _
         ByVal lParam1 As lParam) As Integer
   Dim AS Integer id
   Dim AS Integer Event1
	nook=0
   dim nBuffer AS string = space(250)
   dim info as string
   Select Case uMsg
      Case WM_INITDIALOG
         SelPath = ""
         GetWindowText GetDlgItem(hmain, IDC_EDT31), nBuffer, 250
         nBuffer = trim(nBuffer)
         if searching <> nBuffer and nBuffer <> "" THEN searching = nBuffer
         info = searching
         if info = "" THEN info = "Searching Item"
         SetWindowText GetDlgItem(hWin, IDC_EDT11), info
         SendMessage GetDlgItem(hWin, IDC_EDT11), EM_SETSEL, 0, - 1
			setfocus(GetDlgItem(hWin, IDC_EDT11))
			exit function
      Case WM_CLOSE
         SendMessage getdlgitem(hmain, idc_edt31), EM_SETSEL, 0, - 1
         setfocus getdlgitem(hmain, idc_edt31)
         EndDialog(hWin, 0)
			exit function
      Case WM_COMMAND
         id = LoWord(wParam1)
         Event1 = HiWord(wParam1)
         Select Case id
            Case IDC_BTN11
               GetWindowText GetDlgItem(hWin, IDC_EDT11), nBuffer, 250
               searching = trim(nBuffer)
               SendMessage getdlgitem(hmain, idc_edt31), EM_SETSEL, 0, - 1
               setfocus getdlgitem(hmain, idc_edt31)
               EndDialog(hWin, 0)
					exit function
            Case IDC_BTN21
               SendMessage getdlgitem(hmain, idc_edt31), EM_SETSEL, 0, - 1
               setfocus getdlgitem(hmain, idc_edt31)
					nook=1
               EndDialog(hWin, 0)
					exit function
         End Select
      Case Else
         Return FALSE
   End Select
   Return TRUE
End Function

Private Function dlgAsk_DlgProc2(ByVal hWin As hWnd, ByVal uMsg As Uinteger, _
         ByVal wParam1 As wParam, _
         ByVal lParam1 As lParam) As Integer
   Dim AS Integer id
   Dim AS Integer Event1

   dim nBuffer AS string = space(250)
   dim info as string
   Select Case uMsg
      Case WM_INITDIALOG
         info = searching2
         if info = "" THEN info = "Searching Item"
         SetWindowText GetDlgItem(hWin, IDC_EDT11), info
         SendMessage GetDlgItem(hWin, IDC_EDT11), EM_SETSEL, 0, - 1
			setfocus(GetDlgItem(hWin, IDC_EDT11))
			exit function
      Case WM_CLOSE
         EndDialog(hWin, 0)
			setfocus(hcode)
			exit function
      Case WM_COMMAND
         id = LoWord(wParam1)
         Event1 = HiWord(wParam1)
         Select Case id
            Case IDC_BTN11
               GetWindowText GetDlgItem(hWin, IDC_EDT11), nBuffer, 250
               searching2 = trim(nBuffer)
               EndDialog(hWin, 0)
					setfocus(hcode)
					exit function
            Case IDC_BTN21
               EndDialog(hWin, 0)
					setfocus(hcode)
					nook=1
					exit function
         End Select
      Case Else
         Return FALSE
   End Select
   Return TRUE
End Function

Private Function AskMain2(ByVal hwParent As hwnd) As Integer
		iscod=1
		nook=0
      DialogBoxParam(GetModuleHandle(NULL), Cast(ZString Ptr, dlg_Ask), hwParent, @dlgAsk_DlgProc2, 0)
      Return True
End Function