My RibbonBar + ExplorerBar

[fafi]

Hi ! Antonio.. FWH is the Best.. I created OCX with VB.. then use in FWH

Friend's

Please vote my OCX :
http://www.mediafire.com/?sharekey=4e91 ... f6e8ebb871


Regards
Fafi,

[ukoenig]

Hello fafi,

I wanted to test Your application ( with Vista )
There was a problem ( didn't run, Vista-message : Main.exe doesn't work anymore ).
I compiled new and noticed my Exe (1.4 MB) was twice bigger than Yours ( 578 KB ) in the Zip-file.
After running the new Exe, nothing happend, but the prog. runs in memory.
To kill the task was not possible. The Task-manager doesn't show something.
For the moment I cannot reboot, but I will try again.
Maybe I have to use the latest xHarbour ?

Regards
Uwe

[fafi]

I compiled new and noticed my Exe (1.4 MB) was twice bigger than Yours ( 578 KB ) in the Zip-file.

Hi ! Uwe ..Thank's for your report

my main.exe packed by UPX

then recompile with
- xHarbour Compiler build 1.1.0 (SimpLex)
- BCC55
- FWH 8.05

the size 1.4 MB.. run ok with XP 2

Waiting for another vote..

Thank's
Fafi,

[Ricardo Ramirez E.]

main.exe 1,873,408 bytes decompressed
Error In Windows Vista Failded

tks

[Antonio Linares]

Fafi,

This is very interesting!
Congratulations for this great and clever idea

Would you mind to explain how you have build those OCXs ? Is the RibbonBar a native VB control ?

Are you using a third party control for the Ribbonbar ? Are there any licence issues or are they really free ?

[ukoenig]

Hello fafi,

the new compiled exe-file I tested with WIN 2000, Vista and XP.

With XP it runs without Errors.

With WIN 2000 I get the following Error :
Runtime-Error 91 from ExplorerBar :
Object-Var or With-Blockvar not defined.

With Vista, nothing happens. The File is loaded without display.

Regards
Uwe

[fafi]

UWE, Ricardo thank's for vote

Would you mind to explain how you have build those OCXs ? Is the RibbonBar a native VB control ?

Are you using a third party control for the Ribbonbar ? Are there any licence issues or are they really free ?

Antonio,
Pure VB Code, no third party, it's free, just for test my skill on vb, I used API below :

Code: Select all  Expand view

Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

 

then for the control I used Image and Label with array

Code: Select all  Expand view

Private Sub ButMouse_Click(Index As Integer)
    On Error Resume Next
    RaiseEvent ButtonClick(ButMouse(Index).Tag, Button_Caption(Index).Caption)
End Sub
Private Sub ButMouse_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    Button_left_over(Index).Visible = True
    Button_center_over(Index).Visible = True
    Button_right_over(Index).Visible = True
End Sub
Private Sub ButMouse_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    TabNone
    CatNone Button_center(Index).Tag
    ButNone Index
End Sub
Private Sub ButMouse_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    Button_left_over(Index).Visible = False
    Button_center_over(Index).Visible = False
    Button_right_over(Index).Visible = False
End Sub

 

Antonio,
my problem is : I can't send FWH Imagelist to VB , to set this property Set TopBuI(TotalButton - 1) = LoadResPicture(nIcon, "CUSTOM")
as you know in VB there is control Imagelist below :

Code: Select all  Expand view

Dim zImg As ImageList

Set TopBuI(TotalButton - 1) = zImg.ListImages.Item(zPicture).Picture

Public Property Let ImageList(ByVal zImageList As ImageList)
    Set zImg = zImageList
End Property

 

to call class from FWH = oAct:Do("Imagelist", with FWH Imagelist )
as you see in VB, the parameters ByVal zImageList As ImageList
I can't create this class on VB, cause don't know.. what's object type to instead Imagelist on VB, when I send Imagelist Object from FWH...

Can we create this RibbonBar with FWH CLASS together ?

Antonio,
If you don't mind, just teach me how to create class with FWH about :
Mouse Over, Mouse Move, Mouse Down, Mouse Up and How to call this :
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long with FWH.

Thank's for help



Regards
Fafi,

[Antonio Linares]

Fafi,

to call class from FWH = oAct:Do("Imagelist", with FWH Imagelist )

Try this:
oAct:SetProp( "Imagelist", oImageList:hImageList )

Can we create this RibbonBar with FWH CLASS together ?

yes Please post the VB code here or email it to me, and we will test it together. Thanks,

If you don't mind, just teach me how to create class with FWH about :
Mouse Over, Mouse Move, Mouse Down, Mouse Up and How to call this :

Are you using buttons for the RibbonBar Tabs ? I mean the tabs on the top of the control. Are they bitmaps ?

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long with FWH.

FWH provides GetWindowLong() with same parameters

[fafi]

Antonio,

Are you using buttons for the RibbonBar Tabs ? I mean the tabs on the top of the control. Are they bitmaps ?

Yes ! I added Images to usercontrol, about 3 images for each one tab :
1. ImageLeft
2. ImageCenter
3. ImageRight

FWH can do it with oBitmap ( ABPaint )

then for check MouseEvent, I used Label

FWH can do it with oSay

Please post the VB code here or email it to me, and we will test it together. Thanks,

I prefer to email you..

Antonio,

I have StyleButton also :


here is my ocx : http://www.veteranclipper.com/StyleButton.rar

Code: Select all  Expand view

/*
 My OCX create with VB
 by Fafi
 
*/

#include "FiveWin.ch"

static oGetEvent,cGetEvent,oWnd,oBrushSilver,oBrushBlack,oBrushBlue,oAct1,oAct2,oAct

function Main()  
     
   

   RegisterServer( "StyleButton.ocx" )

   RegisterServer( "FafiXPBar.ocx" )
   
   RegisterServer( "FafiXRBar.ocx" )
     
   cGetEvent := ""+CRLF
   
   DEFINE FONT oFont NAME "Tahoma" size 0,-32 BOLD
   
   DEFINE ICON oIcon NAME "BASEPRO"
   
   DEFINE BRUSH oBrushSilver COLOR nRGB(208,212,221)
   
   DEFINE BRUSH oBrushBlack COLOR nRGB(83,83,83)
   
   DEFINE BRUSH oBrushBlue COLOR nRGB(142,176,218)
   
   DEFINE WINDOW oWnd TITLE "FWH Support Fafi OCX" MENU BuildMenu() BRUSH oBrushSilver ICON oIcon
   
   define dialog oDlg from 120,202 to 742,1600 pixel of oWnd style nOR( WS_VISIBLE, WS_CHILD ) BRUSH oBrushBlue transparent
   
   
   
   @70,150 say "Hi ! Antonio.. FWH is the Best for ActiveX Support.. I Created OCX with VB.. then use in FWH" size 300,200 of oDlg pixel font oFont color CLR_YELLOW
   
   @70,10 say "Hello Event " size 60,12 of oDlg pixel
   
   @80,10 get oGetEvent var cGetEvent size 120,200 of oDlg pixel memo
                                                            // nTop, nLeft. nWidth, nHeight
   oAct2 := TActiveX():New( oWnd, "FafiButton.StylerButton", 130, 220, 350, 100 )  
   oAct2:SetProp("Caption","Fafi Button")
   
   oAct3 := TActiveX():New( oWnd, "FafiButton.StylerButton", 130, 600, 350, 100 )  
   oAct3:SetProp("Caption","Fivewin 8.05")
   
   oAct3:SetProp("RoundedValue",20)
   
   oAct3:SetProp("FocusDottedRect",.f.)
   oAct2:SetProp("FocusDottedRect",.f.)
   
   oFontButton := TOleAuto():New( ActXPdisp( oAct3:hActiveX ) )
   oFontButton := oFontButton:Font()
   oFontButton:Size := 48
   oFontButton:Name := "Times New Roman"
   
   oFontButton := TOleAuto():New( ActXPdisp( oAct2:hActiveX ) )
   oFontButton := oFontButton:Font()
   oFontButton:Size := 48
   oFontButton:Name := "Times New Roman"


   oAct2:bOnEvent := { | cEvent, aParams, pParams | ButtonEvent( cEvent, aParams, pParams ) }
   
   oAct3:bOnEvent := { | cEvent, aParams, pParams | ButtonEvent( cEvent, aParams, pParams ) }
   
   
   oAct1 := TActiveX():New( oWnd, "FafiOCX.RibbonBar", 0, 0, 1800, 120 )  
   oAct1:bOnEvent := { | cEvent, aParams, pParams | RibbonEvent( cEvent, aParams, pParams ) }
   
oAct1:SetProp("Theme",2)
   
oAct1:do("AddTab", "1", "Effect")
oAct1:do("AddTab", "2", "Tab 2" )
oAct1:do("AddTab", "3", "Sample Tab")
oAct1:do("AddTab", "4", "New Tab")
oAct1:do("AddTab", "5", "Print")
oAct1:do("AddTab", "6", "Exit")
oAct1:do("Refresh")

oAct1:do("AddCat"   , "1", "1", "Please select Effect Button", .f.)
oAct1:do("AddButton", "1", "1", "  SILVER ", 501 )
oAct1:do("AddButton", "2", "1", "  BLACK  ", 5 )
oAct1:do("AddButton", "3", "1", "  BLUE   ", 5 )
oAct1:do("Refresh")


   oAct := TActiveX():New( oWnd, "FafiOCX.ExpBar", 120, 0, 200, 578 )  
   
   oAct:Do("AddSpecialItem","File")
   oAct:Do("AddSubItem", 1, "Open")
   oAct:Do("AddSubItem", 1, "Close")
   
   oAct:Do("AddSpecialItem","Print")
   oAct:Do("AddSubItem", 2, "Setup")
   oAct:Do("AddSubItem", 2, "Preview")
   
   oAct:Do("AddSpecialItem","Event")
   oAct:Do("AddSubItem", 3, "Clear Event")
   
   oAct:Do("AddSpecialItem","Change Fafi Button Theme")
   oAct:Do("AddSubItem", 4, "Media Center Edition")
   oAct:Do("AddSubItem", 4, "Media Player 11")
   oAct:Do("AddSubItem", 4, "Office 2007 1")
   oAct:Do("AddSubItem", 4, "Office 2007 2")
   oAct:Do("AddSubItem", 4, "Vista 1")
   oAct:Do("AddSubItem", 4, "Vista 2")
   oAct:Do("AddSubItem", 4, "XP Blue")
   oAct:Do("AddSubItem", 4, "XP Olive Green")
   oAct:Do("AddSubItem", 4, "XP Silver")
   
   //oAct:Do("AddSpecialItem","Change Fafi Button Style")
   //oAct:Do("AddSubItem", 5, "Normal")
   //oAct:Do("AddSubItem", 5, "Round")
   //oAct:Do("AddSubItem", 5, "More Round")
   
   
   oAct:bOnEvent := { | cEvent, aParams, pParams | ExplorerBarEvent( cEvent, aParams, pParams ) }

   activate dialog oDlg nowait
   
   SET MESSAGE OF oWnd TO "Ready" NOINSET CLOCK DATE KEYBOARD 2007
   
   ACTIVATE WINDOW oWnd MAXIMIZED
     
return nil

static function ExplorerBarEvent( cEvent, aParams, pParams )
   
   cEvent := upper(alltrim(cEvent))
   
   if left(cEvent,5) == "MOUSE" // don't use mouse event
   else  
      cGetEvent += cEvent + CRLF
   endif
   
   do case
     
      case cEvent == "SUBITEMCLICK"
       cGetEvent += alltrim(oAct:do("SubItem",aParams[1],aParams[2]))+CRLF
     
       if upper(alltrim(oAct:do("SubItem",aParams[1],aParams[2]))) == "CLEAR EVENT"
          cGetEvent := ""+CRLF
       endif  
       
       if upper(alltrim(oAct:do("SubItem",aParams[1],aParams[2]))) == upper("Media Center Edition")
          oAct2:SetProp("Theme",1)
          oAct3:SetProp("Theme",1)
       endif  
       
       if upper(alltrim(oAct:do("SubItem",aParams[1],aParams[2]))) == upper("Media Player 11")
          oAct2:SetProp("Theme",2)
          oAct3:SetProp("Theme",2)
       endif  
       
       if upper(alltrim(oAct:do("SubItem",aParams[1],aParams[2]))) == upper("Office 2007 1")
          oAct2:SetProp("Theme",3)
          oAct3:SetProp("Theme",3)
       endif  
       
       if upper(alltrim(oAct:do("SubItem",aParams[1],aParams[2]))) == upper("Office 2007 2")
          oAct2:SetProp("Theme",4)
          oAct3:SetProp("Theme",4)
       endif  
       
       if upper(alltrim(oAct:do("SubItem",aParams[1],aParams[2]))) == upper("Vista 1")
          oAct2:SetProp("Theme",5)
          oAct3:SetProp("Theme",5)
       endif  
       
       if upper(alltrim(oAct:do("SubItem",aParams[1],aParams[2]))) == upper("Vista 2")
          oAct2:SetProp("Theme",6)
          oAct3:SetProp("Theme",6)
       endif  
       
       if upper(alltrim(oAct:do("SubItem",aParams[1],aParams[2]))) == upper("XP Blue")
          oAct2:SetProp("Theme",7)
          oAct3:SetProp("Theme",7)
       endif  
       
       if upper(alltrim(oAct:do("SubItem",aParams[1],aParams[2]))) == upper("XP Olive Green")
          oAct2:SetProp("Theme",8)
          oAct3:SetProp("Theme",8)
       endif  
       
       if upper(alltrim(oAct:do("SubItem",aParams[1],aParams[2]))) == upper("XP Silver")
          oAct2:SetProp("Theme",9)
          oAct3:SetProp("Theme",9)
       endif  
   
   endcase
   
   oGetEvent:Refresh()                                            
   
return nil


static function RibbonEvent( cEvent, aParams, pParams )
   
   cEvent := upper(alltrim(cEvent))
   
   if left(cEvent,5) == "MOUSE" // don't use mouse event
   else  
      cGetEvent += cEvent + CRLF
   endif
   
   do case
      case cEvent == "TABCLICK"
           cGetEvent += aParams[2]+ CRLF
           if upper(alltrim(aParams[2])) == "EXIT"
              if MsgYesNo("Want to Exit ?")
                 oWnd:End()
              endif  
           endif  
           
      case cEvent == "BUTTONCLICK"
       
       cGetEvent += aParams[2]+ CRLF
       cAction := upper(alltrim(aParams[2]))
       
       if cAction == "DIALOG"
          Dlg()
       endif  
         
       if cAction == "BLUE"
          oWnd:oBrush := oBrushBlue
          oWnd:Refresh()                    
          oAct1:SetProp("Theme",1)
          oAct1:do("refresh")
       endif  
       
       if cAction == "BLACK"
          oWnd:oBrush := oBrushBlack
          oWnd:Refresh()          
          oAct1:SetProp("Theme",0)
          oAct1:do("refresh")
         
       endif  
       
       if cAction == "SILVER"
          oWnd:oBrush := oBrushSilver
          oWnd:Refresh()
          oAct1:SetProp("Theme",2)
          oAct1:do("refresh")
       endif  
       
       if upper(alltrim(aParams[2])) == ""
          cGetEvent := "Event : "+CRLF
       endif  
   
   endcase
   
   oGetEvent:Refresh()                                            
   
return nil


static function ButtonEvent( cEvent, aParams, pParams )
   
   cEvent := upper(alltrim(cEvent))
   
   if left(cEvent,5) == "MOUSE" // don't use mouse event
   else  
      cGetEvent += cEvent + CRLF
   endif
   
   if cEvent == "CLICK"
      cGetEvent += aParams[1]+ CRLF
   endif  
   
     
   oGetEvent:Refresh()                                            
   
return nil

static function ButtonEvent3( cEvent, aParams, pParams )
   
   cEvent := upper(alltrim(cEvent))
   
   if left(cEvent,5) == "MOUSE" // don't use mouse event
   else  
      cGetEvent += cEvent + CRLF
   endif
   
   if cEvent == "CLICK"
      cGetEvent += aParams[1]+ CRLF
   endif  
   
   oGetEvent:Refresh()                                            
   
return nil





FUNCTION BuildMenu()

   local oMenu, oMenu1, oMenu2
   local oSub1,oSub2,oSub3
   MENU oMenu 2007
   MENUITEM oMenu1 PROMPT "Test &1"
     MENU
       MENUITEM oSub1 PROMPT "Subject&1" CHECKED
         /*
         MENU
           MENUITEM "Choice 1"
           MENUITEM "Choice 2"
           MENUITEM "Choice 3"
         ENDMENU */
       MENUITEM "Subject&2"
         MENU
           MENUITEM "Option 1"
           MENUITEM "Option 2"
           MENUITEM "Option 3"
           MENU
             MENUITEM "Selection 1"
             MENUITEM "Selection 2"
             MENUITEM "Selection 3"
             MENU
               MENUITEM "Sub-selection 1"
               MENUITEM "Sub-selection 2"
               MENU
                 MENUITEM "Sub-sub-selection 1"
                 MENUITEM "Sub-sub-selection 2"
                 MENUITEM "Sub-sub-selection 3"
                 MENU
                   MENUITEM "Lowest level 1"
                   MENUITEM "Lowest level 2"
                 ENDMENU
               ENDMENU
             ENDMENU
             MENUITEM "Selection 4"
           ENDMENU
         ENDMENU
      MENUITEM "Toggle Subject 1 Check" ACTION oSub1:SetCheck( ! oSub1:lChecked )
     ENDMENU
   MENUITEM "Test 2"
     MENU
       MENUITEM "Item 1"
       MENUITEM "Item 2"
     ENDMENU
   ENDMENU
   // oMenu2:Disable()
RETURN (oMenu)

static function Dlg()
   
   define dialog oDlg from 1,1 to 600,800 pixel of oWnd
   
   activate dialog oDlg centered
   
return nil  


#pragma BEGINDUMP

#include <hbapi.h>
#include <windows.h>

typedef LONG ( * PDLLREGISTERSERVER ) ( void );

HB_FUNC( REGISTERSERVER )
{
   HMODULE hDll = LoadLibrary( hb_parc( 1 ) );
   LONG lReturn = 0;
   
   if( hDll )
   {
      FARPROC pRegisterServer = GetProcAddress( hDll, "DllRegisterServer" );
     
      if( pRegisterServer )
         lReturn = ( ( PDLLREGISTERSERVER ) pRegisterServer )();

      FreeLibrary( hDll );
   }
   
   hb_retnl( lReturn );
}        

#pragma ENDDUMP

 

[Antonio Linares]

Fafi,

ok, I wait for your email

Do you use VB Express ?

[fafi]

Antonio,

>> ok, I wait for your email
Your email please ..

>> Do you use VB Express ?
I used VB 6

Regards
Fafi

[Antonio Linares]

Fafi,

Before you email me anything, please consider that I would like to publically explain here how to build an OCX using VB that can be used from FWH.

I don't want any troubles about this. So if you don't want to share your code or ideas, then please don't email it to me. I hope that you understand me, Thanks

[fafi]

Antonio,

Ok.. no problem Sir !

Here is :

Code: Select all  Expand view

Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH = 260

Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long

Dim TotalButton As Integer
Dim TotalTabs As Integer
Dim TotalCats As Integer
Dim TabSelected As String
Dim TabID(30) As String
Dim TabC(30) As String
Dim CatsID(30) As String
Dim CatsC(30) As String
Dim CatsT(30) As String
Dim CatsD(30) As Boolean

Dim TopBuID(90) As String
Dim TopBuS(90) As String
Dim TopBuC(90) As String
Dim TopBuI(90) As Picture
Dim TopBuT(90) As String
Dim TopBuG(90) As Boolean

Dim MS As Boolean
Dim Mx, My As Integer
Event TabClick(ByVal ID As String, ByVal Caption As String)
Event CatClick(ByVal ID As String, ByVal Caption As String)
Event ButtonClick(ByVal ID As String, ByVal Caption As String)
Const m_def_Theme = 0
Const m_def_BC = False
Dim m_Theme As Variant
Dim m_BC As Boolean
Dim zImg As ImageList

Dim TAB_NORMAL
Dim TAB_SELECTED
Private Sub TabNone(Optional Index As Integer = -1)
    If Index <> -1 Then
        For i = 0 To Index - 1
            If Tab_center_over(i).Visible = True Then
                Tab_center_over(i).Visible = False
                Tab_left_over(i).Visible = False
                Tab_right_over(i).Visible = False
            End If
        Next
        If Tab_center(Index).Visible = False Then
            Tab_center_over(Index).Visible = True
            Tab_left_over(Index).Visible = True
            Tab_right_over(Index).Visible = True
        End If
        For i = Index + 1 To TabMouse.UBound
            If Tab_center_over(i).Visible = True Then
                Tab_center_over(i).Visible = False
                Tab_left_over(i).Visible = False
                Tab_right_over(i).Visible = False
            End If
        Next
    Else
        For i = 0 To TabMouse.UBound
            If Tab_center_over(i).Visible = True Then
                Tab_center_over(i).Visible = False
                Tab_left_over(i).Visible = False
                Tab_right_over(i).Visible = False
            End If
        Next
    End If
End Sub
Private Sub CatNone(Optional Index As Integer = -1)
    If Index <> -1 Then
        For i = 0 To Index - 1
            If Cat_Center_on(i).Visible = True Then
                Cat_Center_on(i).Visible = False
                Cat_Left_on(i).Visible = False
                Cat_Right_on(i).Visible = False
                If Cat_Dlg(i).Visible = True Then
                    Cat_Dlg_on(i).Visible = False
                    Cat_Dlg_over(i).Visible = False
                End If
            End If
        Next
        Cat_Center_on(Index).Visible = True
        Cat_Left_on(Index).Visible = True
        Cat_Right_on(Index).Visible = True
        If Cat_Dlg(Index).Visible = True Then
            Cat_Dlg_on(Index).Visible = True
            Cat_Dlg_over(Index).Visible = False
        End If
        For i = Index + 1 To CatMouse.UBound
            If Cat_Center_on(i).Visible = True Then
                Cat_Center_on(i).Visible = False
                Cat_Left_on(i).Visible = False
                Cat_Right_on(i).Visible = False
                If Cat_Dlg(i).Visible = True Then
                    Cat_Dlg_on(i).Visible = False
                    Cat_Dlg_over(i).Visible = False
                End If
            End If
        Next
    Else
        For i = 0 To CatMouse.UBound
            If Cat_Center_on(i).Visible = True Then
                Cat_Center_on(i).Visible = False
                Cat_Left_on(i).Visible = False
                Cat_Right_on(i).Visible = False
                If Cat_Dlg(i).Visible = True Then
                    Cat_Dlg_on(i).Visible = False
                    Cat_Dlg_over(i).Visible = False
                End If
            End If
        Next
    End If
End Sub
Private Sub ButNone(Optional Index As Integer = -1)
    If Index <> -1 Then
        For KL = 0 To Index - 1
            If Button_center(KL).Visible = True Then
                Button_left(KL).Visible = False
                Button_right(KL).Visible = False
                Button_center(KL).Visible = False
                If Glip_off(i).Visible = True Then
                    Glip_on(i).Visible = False
                End If
            End If
        Next
        If Button_left(Index).Visible = False Then
            Button_left(Index).Visible = True
            Button_center(Index).Visible = True
            Button_right(Index).Visible = True
            If Glip_off(Index).Visible = True Then
                Glip_on(Index).Visible = True
            End If
        End If
        For KL = Index + 1 To ButMouse.UBound
            If Button_center(KL).Visible = True Then
                Button_left(KL).Visible = False
                Button_right(KL).Visible = False
                Button_center(KL).Visible = False
                If Glip_off(i).Visible = True Then
                    Glip_on(i).Visible = False
                End If
            End If
        Next
    Else
        For KL = 0 To ButMouse.UBound
            If Button_center(KL).Visible = True Then
                Button_left(KL).Visible = False
                Button_right(KL).Visible = False
                Button_center(KL).Visible = False
                If Glip_off(i).Visible = True Then
                    Glip_on(i).Visible = False
                End If
            End If
        Next
    End If
End Sub
Private Sub Barra2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone
    CatNone
    ButNone
End Sub
Private Sub BarraLeft_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone
    CatNone
    ButNone
End Sub
Private Sub BarraRight_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone
    CatNone
    ButNone
End Sub
Private Sub ButMouse_Click(Index As Integer)
    RaiseEvent ButtonClick(ButMouse(Index).Tag, Button_Caption(Index).Caption)
End Sub
Private Sub ButMouse_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Button_left_over(Index).Visible = True
    Button_center_over(Index).Visible = True
    Button_right_over(Index).Visible = True
End Sub
Private Sub ButMouse_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone
    CatNone Button_center(Index).Tag
    ButNone Index
End Sub
Private Sub ButMouse_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Button_left_over(Index).Visible = False
    Button_center_over(Index).Visible = False
    Button_right_over(Index).Visible = False
End Sub
Private Sub Cat_Dlg_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone
    CatNone Index
    ButNone
End Sub
Private Sub Cat_Dlg_on_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone
    CatNone Index
    ButNone
    Cat_Dlg_over(Index).Visible = True
End Sub
Private Sub Cat_Dlg_over_Click(Index As Integer)
    RaiseEvent CatClick(Cat_Caption(Index).Tag, Cat_Caption(Index).Caption)
End Sub
Private Sub CatMouse_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone
    CatNone Index
    ButNone
End Sub
Private Sub TabMouse_Click(Index As Integer)
    TabNone
    For i = 0 To Index - 1
        Tab_center(i).Visible = False
        Tab_left(i).Visible = False
        Tab_right(i).Visible = False
        Tab_caption(i).ForeColor = TAB_NORMAL
    Next
    Tab_caption(Index).ForeColor = TAB_SELECTED
    Tab_center(Index).Visible = True
    Tab_left(Index).Visible = True
    Tab_right(Index).Visible = True
    For i = Index + 1 To TabMouse.UBound
        Tab_center(i).Visible = False
        Tab_left(i).Visible = False
        Tab_right(i).Visible = False
        Tab_caption(i).ForeColor = TAB_NORMAL
    Next
    TabSelected = TabID(Index)
    CatsUpdate
    RaiseEvent TabClick(TabID(Index), TabC(Index))
End Sub
Private Sub TabMouse_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone Index
    CatNone
    ButNone
End Sub
Private Sub UserControl_Initialize()
    Barra2.Top = -(26 * 15)
    BarraLeft.Top = Barra2.Top
    BarraRight.Top = Barra2.Top

    UserControl.Height = Barra2.Height
    Barra2.Width = 2048 * 15
    TotalTopButton = 0
    TotalButton = 0
    TotalTabs = 0
    TotalCats = 0
    TabSelected = ""
    TabMouse(0).BackStyle = 0
    CatMouse(0).BackStyle = 0
    ButMouse(0).BackStyle = 0
End Sub
Private Sub TabsUpdate()
    On Error Resume Next
    For i = 1 To (TotalTabs - 1)
        Unload Tab_caption(i)
        Unload Tab_left(i)
        Unload Tab_center(i)
        Unload Tab_right(i)
        Unload Tab_left_over(i)
        Unload Tab_center_over(i)
        Unload Tab_right_over(i)
        Unload TabMouse(i)
    Next
    For i = 0 To (TotalTabs - 1)
        If i <> 0 Then
            Load Tab_caption(i)
            Load Tab_left(i)
            Load Tab_center(i)
            Load Tab_right(i)
            Load Tab_left_over(i)
            Load Tab_center_over(i)
            Load Tab_right_over(i)
            Load TabMouse(i)
            Tab_left(i).Left = Tab_right(i - 1).Left + Tab_right(i).Width
        Else
            Tab_left(0).Left = 90
        End If
        TabMouse(i).Left = Tab_left(i).Left
       
        Tab_caption(i).Top = 0 + 60
        Tab_center(i).Top = 0
        Tab_left(i).Top = 0
        Tab_right(i).Top = 0
        Tab_center_over(i).Top = 0
        Tab_left_over(i).Top = 0
        Tab_right_over(i).Top = 0
        TabMouse(i).Top = 0
       
        Tab_caption(i) = TabC(i)
        Tab_center(i).Width = Tab_caption(i).Width
        Tab_center(i).Left = Tab_left(i).Left + Tab_left(i).Width
        Tab_caption(i).Left = Tab_center(i).Left
        Tab_right(i).Left = Tab_center(i).Left + Tab_center(i).Width
       
        Tab_center_over(i).Width = Tab_center(i).Width
        Tab_center_over(i).Left = Tab_center(i).Left
        Tab_left_over(i).Left = Tab_left(i).Left
        Tab_right_over(i).Left = Tab_right(i).Left
       
        TabMouse(i).Width = Tab_left(i).Width + Tab_right(i).Width + Tab_center(i).Width
       
        Tab_caption(i).ForeColor = TAB_NORMAL
       
        Tab_caption(i).Visible = True
        If i = 0 Then
            Tab_center(i).Visible = True
            Tab_left(i).Visible = True
            Tab_right(i).Visible = True
            Tab_caption(i).ForeColor = TAB_SELECTED
        End If
        TabMouse(i).Visible = True
   
        Tab_center(i).ZOrder 0
        Tab_left(i).ZOrder 0
        Tab_right(i).ZOrder 0
       
        Tab_center_over(i).ZOrder 0
        Tab_left_over(i).ZOrder 0
        Tab_right_over(i).ZOrder 0
       
        Tab_caption(i).ZOrder 0
        TabMouse(i).ZOrder 0
    Next
End Sub
Private Sub CatsUpdate()
    On Error Resume Next
    ztopo = 360
    Cat_Center_off(0).Top = ztopo
    Cat_Center_on(0).Top = ztopo
    Cat_Left_off(0).Top = ztopo
    Cat_Left_on(0).Top = ztopo
    Cat_Right_off(0).Top = ztopo
    Cat_Right_on(0).Top = ztopo
    CatMouse(0).Top = ztopo
    Cat_Caption(0).Top = 1400
   
    Dim TotalCatsT As Integer
    Dim CatsIDT(30) As String
    Dim CatsCT(30) As String
    Dim CatsTT(30) As String
    Dim CatsDT(30) As Boolean
    TotalCatsT = 0
    For i = 0 To TotalCats
        If CatsT(i) = TabSelected And TabSelected <> "" And CatsT(i) <> "" Then
            CatsIDT(TotalCatsT) = CatsID(i)
            CatsTT(TotalCatsT) = CatsT(i)
            CatsCT(TotalCatsT) = CatsC(i)
            CatsDT(TotalCatsT) = CatsD(i)
            TotalCatsT = TotalCatsT + 1
        End If
    Next
    For i = 1 To CatMouse.UBound
            Unload Cat_Left_off(i)
            Unload Cat_Left_on(i)
            Unload Cat_Right_off(i)
            Unload Cat_Right_on(i)
            Unload Cat_Center_off(i)
            Unload Cat_Center_on(i)
            Unload Cat_Caption(i)
            Unload CatMouse(i)
            Unload Cat_Dlg(i)
            Unload Cat_Dlg_on(i)
            Unload Cat_Dlg_over(i)
    Next
    For i = 1 To Button_center.UBound
        Unload Button_left(i)
        Unload Button_center(i)
        Unload Button_right(i)
        Unload Button_left_over(i)
        Unload Button_center_over(i)
        Unload Button_right_over(i)
        Unload Button_Caption(i)
        Unload Button_Icon(i)
        Unload Glip_on(i)
        Unload Glip_off(i)
        Unload ButMouse(i)
    Next
    Button_left(0).Visible = False
    Button_center(0).Visible = False
    Button_right(0).Visible = False
    Button_Caption(0).Visible = False
    Button_Icon(0).Visible = False
    ButMouse(0).Visible = False
   
    Cat_Left_off(0).Visible = False
    Cat_Left_on(0).Visible = False
    Cat_Right_off(0).Visible = False
    Cat_Right_on(0).Visible = False
    Cat_Center_off(0).Visible = False
    Cat_Center_on(0).Visible = False
    Cat_Caption(0).Visible = False
    CatMouse(0).Visible = False
    Cat_Dlg(0).Visible = False
    Cat_Dlg_on(0).Visible = False
    Cat_Dlg_over(0).Visible = False
    For i = 0 To (TotalCatsT - 1)
        If i <> 0 Then
            Load Cat_Left_off(i)
            Load Cat_Left_on(i)
            Load Cat_Right_off(i)
            Load Cat_Right_on(i)
            Load Cat_Center_off(i)
            Load Cat_Center_on(i)
            Load Cat_Caption(i)
            Load CatMouse(i)
            Load Cat_Dlg(i)
            Load Cat_Dlg_on(i)
            Load Cat_Dlg_over(i)
            Cat_Left_off(i).Left = Cat_Right_off(i - 1).Left + Cat_Right_off(i).Width
        Else
            Cat_Left_off(i).Left = 120
        End If
        CatMouse(i).Left = Cat_Left_off(i).Left
       
        Cat_Caption(i).Caption = CatsCT(i)
        Cat_Caption(i).Tag = CatsIDT(i)
       
        Cat_Center_off(i).Left = Cat_Left_off(i).Left + Cat_Left_off(i).Width
       
        BUTSIZE = ButtonsUpdate(CatsIDT(i), Cat_Center_off(i).Left, i + 0)
       
        If CatsDT(i) = True Then
            Cat_Center_off(i).Width = Cat_Caption(i).Width + Cat_Dlg(i).Width
        Else
            Cat_Center_off(i).Width = Cat_Caption(i).Width
        End If
       
        If Cat_Center_off(i).Width < BUTSIZE Then
            Cat_Center_off(i).Width = BUTSIZE
            Cat_Caption(i).Left = Cat_Center_off(i).Left + ((Cat_Center_off(i).Width - Cat_Caption(i).Width) / 2)
        Else
            Cat_Caption(i).Left = Cat_Center_off(i).Left
        End If
       
        Cat_Right_off(i).Left = Cat_Center_off(i).Left + Cat_Center_off(i).Width
       
        Cat_Center_on(i).Width = Cat_Center_off(i).Width
        Cat_Center_on(i).Left = Cat_Center_off(i).Left
        Cat_Left_on(i).Left = Cat_Left_off(i).Left
        Cat_Right_on(i).Left = Cat_Right_off(i).Left
       
        CatMouse(i).Width = Cat_Left_off(i).Width + Cat_Right_off(i).Width + Cat_Center_off(i).Width
       
        Cat_Caption(i).Visible = True
        Cat_Center_off(i).Visible = True
        Cat_Left_off(i).Visible = True
        Cat_Right_off(i).Visible = True
        CatMouse(i).Visible = True
   
        Cat_Center_off(i).ZOrder 0
        Cat_Left_off(i).ZOrder 0
        Cat_Right_off(i).ZOrder 0
       
        Cat_Center_on(i).ZOrder 0
        Cat_Left_on(i).ZOrder 0
        Cat_Right_on(i).ZOrder 0
       
        Cat_Caption(i).ZOrder 0
        CatMouse(i).ZOrder 0
       
        Cat_Dlg(i).Left = (Cat_Right_off(i).Left - Cat_Dlg(i).Width) + 15
        Cat_Dlg(i).Top = (Cat_Right_off(i).Top + Cat_Right_off(i).Height) - (Cat_Dlg(i).Height + 60)
       
        Cat_Dlg_on(i).Left = Cat_Dlg(i).Left
        Cat_Dlg_over(i).Left = Cat_Dlg(i).Left
       
        Cat_Dlg_on(i).Top = Cat_Dlg(i).Top
        Cat_Dlg_over(i).Top = Cat_Dlg(i).Top
       
       
        Cat_Dlg_on(i).Visible = False
        Cat_Dlg_over(i).Visible = False
       
        If CatsDT(i) = True Then
            Cat_Dlg(i).Visible = True
        End If
        Cat_Dlg(i).ZOrder 0
        Cat_Dlg_on(i).ZOrder 0
        Cat_Dlg_over(i).ZOrder 0
    Next
    DoEvents
    For KL = 0 To ButMouse.UBound
        Button_left(KL).Visible = False
        Button_left(KL).ZOrder 0
        Button_right(KL).Visible = False
        Button_right(KL).ZOrder 0
        Button_center(KL).Visible = False
        Button_center(KL).ZOrder 0
       
        Button_left_over(KL).Visible = False
        Button_left_over(KL).ZOrder 0
        Button_right_over(KL).Visible = False
        Button_right_over(KL).ZOrder 0
        Button_center_over(KL).Visible = False
        Button_center_over(KL).ZOrder 0
       
        Button_Icon(KL).ZOrder 0
        Button_Caption(KL).ZOrder 0
       
        Glip_off(KL).ZOrder 0
        Glip_on(KL).ZOrder 0
       
        ButMouse(KL).ZOrder 0
    Next
End Sub
Private Sub UserControl_Resize()
    'On Error Resume Next
    UserControl.Height = Barra2.Height - (26 * 15)
    'UserControl.Width = UserControl.ParentControls.Item(0).ScaleWidth
    'BarraRight.Left = UserControl.Width - BarraRight.Width
End Sub
Public Sub Refresh()
    UserControl_Resize
    TabsUpdate
    CatsUpdate
End Sub
Private Sub UserControl_InitProperties()
    m_Theme = m_def_Theme
    m_BC = m_def_BC
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_Theme = PropBag.ReadProperty("Theme", m_def_Theme)
    m_BC = PropBag.ReadProperty("ButtonCenter", m_def_BC)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Theme", m_Theme, m_def_Theme)
    Call PropBag.WriteProperty("ButtonCenter", m_BC, m_def_BC)
    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H464646)
    Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, &HFFFFFF)
End Sub
Public Function AddTab(zID As String, zCaption As String) As Boolean
    TotalTabs = TotalTabs + 1
    TabID(TotalTabs - 1) = zID
    zCaption = Replace(zCaption, vbNewLine, " ")
    TabC(TotalTabs - 1) = zCaption
    If TabSelected = "" Then
        TabSelected = zID
    End If
End Function
Public Function AddCat(zID As String, zTab As String, zCaption As String, zDlgButton As Boolean) As Boolean
    TotalCats = TotalCats + 1
    CatsID(TotalCats - 1) = zID
    CatsT(TotalCats - 1) = zTab
    zCaption = Replace(zCaption, vbNewLine, " ")
    CatsC(TotalCats - 1) = zCaption
    CatsD(TotalCats - 1) = zDlgButton
End Function
Public Function AddButton(zID As String, zSubCat As String, zCaption As String, zPicture As Integer, Optional zMore As Boolean = False, Optional zToolTip As String) As Boolean
    TotalButton = TotalButton + 1
    TopBuID(TotalButton - 1) = zID
    TopBuS(TotalButton - 1) = zSubCat
    TopBuC(TotalButton - 1) = zCaption
    If zToolTip = "" Or zToolTip = Null Then
        If InStr(zCaption, vbNewLine) Then
            zCaption = Replace(zCaption, vbNewLine, " ")
        End If
        TopBuT(TotalButton - 1) = zCaption
    Else
        zToolTip = Replace(zToolTip, vbNewLine, " ")
        TopBuT(TotalButton - 1) = zToolTip
    End If
    Set TopBuI(TotalButton - 1) = zImg.ListImages.Item(zPicture).Picture
    TopBuG(TotalButton - 1) = zMore
End Function
Private Function ButtonsUpdate(SubCat As String, PosIni As Integer, CatID As Integer) As Integer
    On Error Resume Next
    Dim TotalButtonT As Integer
    Dim TopBuIDT(90) As String
    Dim TopBuST(90) As String
    Dim TopBuCT(90) As String
    Dim TopBuIT(90) As Picture
    Dim TopBuTT(90) As String
    Dim TopBuGT(90) As Boolean
    TotalSize = 0
    TotalButtonT = 0
    For i = 0 To TotalButton
        If TopBuS(i) = SubCat Then
            TopBuIDT(TotalButtonT) = TopBuID(i)
            TopBuST(TotalButtonT) = TopBuS(i)
            TopBuCT(TotalButtonT) = TopBuC(i)
            TopBuTT(TotalButtonT) = TopBuT(i)
            Set TopBuIT(TotalButtonT) = TopBuI(i)
            TopBuGT(TotalButtonT) = TopBuG(i)
            TotalButtonT = TotalButtonT + 1
        End If
    Next
    Button_left(0).Visible = False
    Button_center(0).Visible = False
    Button_right(0).Visible = False
    Button_Caption(0).Visible = True
    Button_Icon(0).Visible = True
    ButMouse(0).Visible = True
    xt = ButMouse.UBound + 1
    For i = xt To (TotalButtonT - 1) + xt
        If i <> 0 Then
            Load Button_left(i)
            Load Button_center(i)
            Load Button_right(i)
            Load Button_left_over(i)
            Load Button_center_over(i)
            Load Button_right_over(i)
            Load Button_Caption(i)
            Load Button_Icon(i)
            Load Glip_on(i)
            Load Glip_off(i)
            Load ButMouse(i)
        End If
        ButMouse(i).Tag = TopBuIDT(i - xt)
       
        Button_center(i).Tag = CatID

        ButMouse(i).Top = Cat_Left_off(0).Top + 60
        Button_left(i).Top = ButMouse(i).Top
        Button_center(i).Top = ButMouse(i).Top
        Button_right(i).Top = ButMouse(i).Top
        Button_left_over(i).Top = ButMouse(i).Top
        Button_center_over(i).Top = ButMouse(i).Top
        Button_right_over(i).Top = ButMouse(i).Top
       
        If i = xt Then
            posatu = PosIni
        Else
            posatu = ButMouse(i - 1).Left + ButMouse(i - 1).Width + 30
        End If
        ButMouse(i).Left = posatu
        Button_left(i).Left = ButMouse(i).Left
        Button_left_over(i).Left = Button_left(i).Left
        Button_center(i).Left = Button_left(i).Left + Button_left(i).Width
        Button_center_over(i).Left = Button_center(i).Left
       
        Button_Caption(i).Caption = TopBuCT(i - xt)
       
        Set Button_Icon(i) = TopBuIT(i - xt)
       
        If m_BC = True Then
            ESP = Button_center(i).Height - (Button_Icon(i).Height + Button_Caption(i).Height)
            If TopBuGT(i - xt) = True Then
                Button_Icon(i).Top = Button_center(i).Top + ((ESP - (Button_Caption(i).Height / 2)) / 2)
            Else
                Button_Icon(i).Top = Button_center(i).Top + ((ESP) / 2)
            End If
        Else
            Button_Icon(i).Top = Button_center(i).Top + 90
        End If
           
       
        Button_Caption(i).Top = Button_Icon(i).Top + Button_Icon(i).Height
       
        Glip_off(i).Top = Button_Caption(i).Top + Button_Caption(i).Height + ((Button_Caption(i).Height - Glip_off(i).Height) / 2)
        Glip_on(i).Top = Glip_off(i).Top
       
       
        If Button_Caption(i).Width > Button_Icon(i).Width Then
            Button_Caption(i).Left = Button_center(i).Left
            esp2 = (Button_Caption(i).Width - Button_Icon(i).Width) / 2
            Button_Icon(i).Left = Button_Caption(i).Left + esp2
            Area = Button_Caption(i).Width
        Else
            Button_Icon(i).Left = Button_center(i).Left
            esp2 = (Button_Icon(i).Width - Button_Caption(i).Width) / 2
            Button_Caption(i).Left = Button_Icon(i).Left + esp2
            Area = Button_Icon(i).Width
        End If
   
        Glip_off(i).Left = Button_Caption(i).Left + ((Button_Caption(i).Width - Glip_on(i).Width) / 2)
        Glip_on(i).Left = Glip_off(i).Left
   
        Button_center(i).Width = Area
        Button_center_over(i).Width = Button_center(i).Width
        Button_right(i).Left = Button_center(i).Left + Button_center(i).Width
        Button_right_over(i).Left = Button_right(i).Left
        ButMouse(i).Width = (Button_right(i).Width + Button_right(i).Width) + Button_center(i).Width
       
        ButMouse(i).ToolTipText = TopBuTT(i - xt)
        Button_Icon(i).Visible = True
        Button_Caption(i).Visible = True
        ButMouse(i).Visible = True
        If TopBuGT(i - xt) = True Then
            Glip_off(i).Visible = True
            Glip_off(i).ZOrder 0
            Glip_on(i).ZOrder 0
        End If
   
        TotalSize = TotalSize + ButMouse(i).Width + 30
    Next
    ButtonsUpdate = TotalSize - 30
End Function
Public Property Get Theme() As Integer
    Theme = m_Theme
End Property
Public Property Let Theme(ByVal New_Theme As Integer)
    If New_Theme < 0 Or New_Theme > 2 Then New_Theme = 0
    m_Theme = New_Theme
    PropertyChanged "Theme"
    LoadTheme m_Theme
End Property
Public Property Get ButtonCenter() As Variant
    ButtonCenter = m_BC
End Property
Public Property Let ButtonCenter(ByVal New_BC As Variant)
    m_BC = New_BC
    PropertyChanged "ButtonCenter"
End Property
Private Function LoadTheme(iTema)
    Select Case iTema
        Case 0
            ID = "BLACK"
            Cat_Caption(0).ForeColor = &HFFFFFF
            TAB_NORMAL = vbWhite
            TAB_SELECTED = vbBlack
            Button_Caption(0).ForeColor = &H80000008
            UserControl.BackColor = &H464646
            UserControl.ForeColor = &HFFFFFF
        Case 1
            ID = "BLUE"
            Cat_Caption(0).ForeColor = &HB86A3E
            TAB_NORMAL = &H8B4215
            TAB_SELECTED = &H8B4215
            Button_Caption(0).ForeColor = &H8B4215
            UserControl.BackColor = &HDAB08E
            UserControl.ForeColor = &H8B4215
        Case 2
            ID = "SILVER"
            Cat_Caption(0).ForeColor = &H6A625C
            TAB_NORMAL = &H6A625C
            TAB_SELECTED = &H6A625C
            Button_Caption(0).ForeColor = &H6A625C
            UserControl.BackColor = &HDDD4D0
            UserControl.ForeColor = &H6A625C
        Case Else
            ID = "BLACK"
    End Select
    Set Barra2.Picture = LoadResPicture(101, ID)
    Set BarraLeft.Picture = LoadResPicture(102, ID)
    Set BarraRight.Picture = LoadResPicture(103, ID)
    Set Cat_Dlg(0).Picture = LoadResPicture(118, ID)
    Set Cat_Dlg_on(0).Picture = LoadResPicture(119, ID)
    Set Cat_Dlg_over(0).Picture = LoadResPicture(120, ID)
    Set Cat_Left_off(0).Picture = LoadResPicture(121, ID)
    Set Cat_Center_off(0).Picture = LoadResPicture(122, ID)
    Set Cat_Right_off(0).Picture = LoadResPicture(123, ID)
    Set Cat_Left_on(0).Picture = LoadResPicture(124, ID)
    Set Cat_Center_on(0).Picture = LoadResPicture(125, ID)
    Set Cat_Right_on(0).Picture = LoadResPicture(126, ID)
    Set Tab_left(0).Picture = LoadResPicture(127, ID)
    Set Tab_center(0).Picture = LoadResPicture(128, ID)
    Set Tab_right(0).Picture = LoadResPicture(129, ID)
    Set Tab_left_over(0).Picture = LoadResPicture(130, ID)
    Set Tab_center_over(0).Picture = LoadResPicture(131, ID)
    Set Tab_right_over(0).Picture = LoadResPicture(132, ID)
    Set Glip_off(0).Picture = LoadResPicture(133, ID)
    Set Glip_on(0).Picture = LoadResPicture(134, ID)
    Set Button_left_over(0).Picture = LoadResPicture(135, ID)
    Set Button_center_over(0).Picture = LoadResPicture(136, ID)
    Set Button_right_over(0).Picture = LoadResPicture(137, ID)
    Set Button_left(0).Picture = LoadResPicture(138, ID)
    Set Button_center(0).Picture = LoadResPicture(139, ID)
    Set Button_right(0).Picture = LoadResPicture(140, ID)
End Function
Private Property Get TempDir() As String
    Dim sRet As String, c As Long
    Dim lErr As Long
    sRet = String$(MAX_PATH, 0)
    c = GetTempPath(MAX_PATH, sRet)
    lErr = Err.LastDllError
    If c = 0 Then
        Err.Raise 10000 Or lErr, App.EXEName & ".cAniCursor", WinAPIError(lErr)
    End If
    TempDir = Left$(sRet, c)
End Property
Private Property Get TempFileName(Optional ByVal sPrefix As String, Optional ByVal sPathName As String) As String
    Dim lErr As Long
    Dim iPos As Long
    If sPrefix = "" Then sPrefix = ""
    If sPathName = "" Then sPathName = TempDir
    Dim sRet As String
    sRet = String(MAX_PATH, 0)
    GetTempFileName sPathName, sPrefix, 0, sRet
    lErr = Err.LastDllError
    If Not lErr = 0 Then
        Err.Raise 10000 Or lErr, App.EXEName & ".cAniCursor", WinAPIError(lErr)
    End If
    iPos = InStr(sRet, vbNullChar)
    If Not iPos = 0 Then
        TempFileName = Left$(sRet, iPos - 1)
    End If
End Property
Private Function WinAPIError(ByVal lLastDLLError As Long) As String
    Dim sBuff As String
    Dim lCount As Long
    sBuff = String$(256, 0)
    lCount = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0)
    If lCount Then
        WinAPIError = Left$(sBuff, lCount)
    End If
End Function
Public Property Get LoadBackground() As IPicture
    Dim sFile As String
    Dim b() As Byte
    Dim iFile As Integer
    On Error GoTo ErrorHandler
    Select Case m_Theme
        Case 0
            b = LoadResData(141, "BLACK")
        Case 1
            b = LoadResData(141, "BLUE")
        Case 2
            b = LoadResData(141, "SILVER")
    End Select
    sFile = TempFileName("LRP")
    iFile = FreeFile
    Open sFile For Binary Access Write Lock Read As #iFile
        Put #iFile, , b
    Close #iFile
    iFile = 0
    Set LoadBackground = LoadPicture(sFile)
    KillFile sFile
    Exit Property
ErrorHandler:
    Dim lErr As Long, sErr As String
    lErr = Err.Number:   sErr = Err.Description
    If Not iFile = 0 Then Close #iFile
    KillFile sFile
    Err.Raise Err.Number, App.EXEName & ".cLoadResPicture", Err.Description
    Exit Property
End Property
Private Property Get LoadResPicture(ByVal ID As Variant, ByVal Format As Variant) As IPicture
    Dim sFile As String
    Dim b() As Byte
    Dim iFile As Integer
    On Error GoTo ErrorHandler
    b = LoadResData(ID, Format)
    sFile = TempFileName("LRP")
    iFile = FreeFile
    Open sFile For Binary Access Write Lock Read As #iFile
        Put #iFile, , b
    Close #iFile
    iFile = 0
    Set LoadResPicture = LoadPicture(sFile)
    KillFile sFile
    Exit Property
ErrorHandler:
    Dim lErr As Long, sErr As String
    lErr = Err.Number:   sErr = Err.Description
    If Not iFile = 0 Then Close #iFile
    KillFile sFile
    Err.Raise Err.Number, App.EXEName & ".cLoadResPicture", Err.Description
    Exit Property
End Property
Private Sub KillFile(ByVal sFile As String)
    On Error Resume Next
    Kill sFile
End Sub
Public Sub Resize()
    UserControl_Resize
End Sub
Public Property Let ImageList(ByVal zImageList As ImageList)
    Set zImg = zImageList
End Property
Public Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End Property
Public Property Get ForeColor() As OLE_COLOR
    ForeColor = UserControl.ForeColor
End Property

Regards
Fafi

[Antonio Linares]

Fafi,

Many thanks for publically posting it

Antonio,

Ok.. no problem Sir !

Here is :

Code: Select all  Expand view

Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH = 260

Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long

Dim TotalButton As Integer
Dim TotalTabs As Integer
Dim TotalCats As Integer
Dim TabSelected As String
Dim TabID(30) As String
Dim TabC(30) As String
Dim CatsID(30) As String
Dim CatsC(30) As String
Dim CatsT(30) As String
Dim CatsD(30) As Boolean

Dim TopBuID(90) As String
Dim TopBuS(90) As String
Dim TopBuC(90) As String
Dim TopBuI(90) As Picture
Dim TopBuT(90) As String
Dim TopBuG(90) As Boolean

Dim MS As Boolean
Dim Mx, My As Integer
Event TabClick(ByVal ID As String, ByVal Caption As String)
Event CatClick(ByVal ID As String, ByVal Caption As String)
Event ButtonClick(ByVal ID As String, ByVal Caption As String)
Const m_def_Theme = 0
Const m_def_BC = False
Dim m_Theme As Variant
Dim m_BC As Boolean
Dim zImg As ImageList

Dim TAB_NORMAL
Dim TAB_SELECTED
Private Sub TabNone(Optional Index As Integer = -1)
    If Index <> -1 Then
        For i = 0 To Index - 1
            If Tab_center_over(i).Visible = True Then
                Tab_center_over(i).Visible = False
                Tab_left_over(i).Visible = False
                Tab_right_over(i).Visible = False
            End If
        Next
        If Tab_center(Index).Visible = False Then
            Tab_center_over(Index).Visible = True
            Tab_left_over(Index).Visible = True
            Tab_right_over(Index).Visible = True
        End If
        For i = Index + 1 To TabMouse.UBound
            If Tab_center_over(i).Visible = True Then
                Tab_center_over(i).Visible = False
                Tab_left_over(i).Visible = False
                Tab_right_over(i).Visible = False
            End If
        Next
    Else
        For i = 0 To TabMouse.UBound
            If Tab_center_over(i).Visible = True Then
                Tab_center_over(i).Visible = False
                Tab_left_over(i).Visible = False
                Tab_right_over(i).Visible = False
            End If
        Next
    End If
End Sub
Private Sub CatNone(Optional Index As Integer = -1)
    If Index <> -1 Then
        For i = 0 To Index - 1
            If Cat_Center_on(i).Visible = True Then
                Cat_Center_on(i).Visible = False
                Cat_Left_on(i).Visible = False
                Cat_Right_on(i).Visible = False
                If Cat_Dlg(i).Visible = True Then
                    Cat_Dlg_on(i).Visible = False
                    Cat_Dlg_over(i).Visible = False
                End If
            End If
        Next
        Cat_Center_on(Index).Visible = True
        Cat_Left_on(Index).Visible = True
        Cat_Right_on(Index).Visible = True
        If Cat_Dlg(Index).Visible = True Then
            Cat_Dlg_on(Index).Visible = True
            Cat_Dlg_over(Index).Visible = False
        End If
        For i = Index + 1 To CatMouse.UBound
            If Cat_Center_on(i).Visible = True Then
                Cat_Center_on(i).Visible = False
                Cat_Left_on(i).Visible = False
                Cat_Right_on(i).Visible = False
                If Cat_Dlg(i).Visible = True Then
                    Cat_Dlg_on(i).Visible = False
                    Cat_Dlg_over(i).Visible = False
                End If
            End If
        Next
    Else
        For i = 0 To CatMouse.UBound
            If Cat_Center_on(i).Visible = True Then
                Cat_Center_on(i).Visible = False
                Cat_Left_on(i).Visible = False
                Cat_Right_on(i).Visible = False
                If Cat_Dlg(i).Visible = True Then
                    Cat_Dlg_on(i).Visible = False
                    Cat_Dlg_over(i).Visible = False
                End If
            End If
        Next
    End If
End Sub
Private Sub ButNone(Optional Index As Integer = -1)
    If Index <> -1 Then
        For KL = 0 To Index - 1
            If Button_center(KL).Visible = True Then
                Button_left(KL).Visible = False
                Button_right(KL).Visible = False
                Button_center(KL).Visible = False
                If Glip_off(i).Visible = True Then
                    Glip_on(i).Visible = False
                End If
            End If
        Next
        If Button_left(Index).Visible = False Then
            Button_left(Index).Visible = True
            Button_center(Index).Visible = True
            Button_right(Index).Visible = True
            If Glip_off(Index).Visible = True Then
                Glip_on(Index).Visible = True
            End If
        End If
        For KL = Index + 1 To ButMouse.UBound
            If Button_center(KL).Visible = True Then
                Button_left(KL).Visible = False
                Button_right(KL).Visible = False
                Button_center(KL).Visible = False
                If Glip_off(i).Visible = True Then
                    Glip_on(i).Visible = False
                End If
            End If
        Next
    Else
        For KL = 0 To ButMouse.UBound
            If Button_center(KL).Visible = True Then
                Button_left(KL).Visible = False
                Button_right(KL).Visible = False
                Button_center(KL).Visible = False
                If Glip_off(i).Visible = True Then
                    Glip_on(i).Visible = False
                End If
            End If
        Next
    End If
End Sub
Private Sub Barra2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone
    CatNone
    ButNone
End Sub
Private Sub BarraLeft_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone
    CatNone
    ButNone
End Sub
Private Sub BarraRight_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone
    CatNone
    ButNone
End Sub
Private Sub ButMouse_Click(Index As Integer)
    RaiseEvent ButtonClick(ButMouse(Index).Tag, Button_Caption(Index).Caption)
End Sub
Private Sub ButMouse_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Button_left_over(Index).Visible = True
    Button_center_over(Index).Visible = True
    Button_right_over(Index).Visible = True
End Sub
Private Sub ButMouse_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone
    CatNone Button_center(Index).Tag
    ButNone Index
End Sub
Private Sub ButMouse_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Button_left_over(Index).Visible = False
    Button_center_over(Index).Visible = False
    Button_right_over(Index).Visible = False
End Sub
Private Sub Cat_Dlg_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone
    CatNone Index
    ButNone
End Sub
Private Sub Cat_Dlg_on_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone
    CatNone Index
    ButNone
    Cat_Dlg_over(Index).Visible = True
End Sub
Private Sub Cat_Dlg_over_Click(Index As Integer)
    RaiseEvent CatClick(Cat_Caption(Index).Tag, Cat_Caption(Index).Caption)
End Sub
Private Sub CatMouse_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone
    CatNone Index
    ButNone
End Sub
Private Sub TabMouse_Click(Index As Integer)
    TabNone
    For i = 0 To Index - 1
        Tab_center(i).Visible = False
        Tab_left(i).Visible = False
        Tab_right(i).Visible = False
        Tab_caption(i).ForeColor = TAB_NORMAL
    Next
    Tab_caption(Index).ForeColor = TAB_SELECTED
    Tab_center(Index).Visible = True
    Tab_left(Index).Visible = True
    Tab_right(Index).Visible = True
    For i = Index + 1 To TabMouse.UBound
        Tab_center(i).Visible = False
        Tab_left(i).Visible = False
        Tab_right(i).Visible = False
        Tab_caption(i).ForeColor = TAB_NORMAL
    Next
    TabSelected = TabID(Index)
    CatsUpdate
    RaiseEvent TabClick(TabID(Index), TabC(Index))
End Sub
Private Sub TabMouse_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    TabNone Index
    CatNone
    ButNone
End Sub
Private Sub UserControl_Initialize()
    Barra2.Top = -(26 * 15)
    BarraLeft.Top = Barra2.Top
    BarraRight.Top = Barra2.Top

    UserControl.Height = Barra2.Height
    Barra2.Width = 2048 * 15
    TotalTopButton = 0
    TotalButton = 0
    TotalTabs = 0
    TotalCats = 0
    TabSelected = ""
    TabMouse(0).BackStyle = 0
    CatMouse(0).BackStyle = 0
    ButMouse(0).BackStyle = 0
End Sub
Private Sub TabsUpdate()
    On Error Resume Next
    For i = 1 To (TotalTabs - 1)
        Unload Tab_caption(i)
        Unload Tab_left(i)
        Unload Tab_center(i)
        Unload Tab_right(i)
        Unload Tab_left_over(i)
        Unload Tab_center_over(i)
        Unload Tab_right_over(i)
        Unload TabMouse(i)
    Next
    For i = 0 To (TotalTabs - 1)
        If i <> 0 Then
            Load Tab_caption(i)
            Load Tab_left(i)
            Load Tab_center(i)
            Load Tab_right(i)
            Load Tab_left_over(i)
            Load Tab_center_over(i)
            Load Tab_right_over(i)
            Load TabMouse(i)
            Tab_left(i).Left = Tab_right(i - 1).Left + Tab_right(i).Width
        Else
            Tab_left(0).Left = 90
        End If
        TabMouse(i).Left = Tab_left(i).Left
       
        Tab_caption(i).Top = 0 + 60
        Tab_center(i).Top = 0
        Tab_left(i).Top = 0
        Tab_right(i).Top = 0
        Tab_center_over(i).Top = 0
        Tab_left_over(i).Top = 0
        Tab_right_over(i).Top = 0
        TabMouse(i).Top = 0
       
        Tab_caption(i) = TabC(i)
        Tab_center(i).Width = Tab_caption(i).Width
        Tab_center(i).Left = Tab_left(i).Left + Tab_left(i).Width
        Tab_caption(i).Left = Tab_center(i).Left
        Tab_right(i).Left = Tab_center(i).Left + Tab_center(i).Width
       
        Tab_center_over(i).Width = Tab_center(i).Width
        Tab_center_over(i).Left = Tab_center(i).Left
        Tab_left_over(i).Left = Tab_left(i).Left
        Tab_right_over(i).Left = Tab_right(i).Left
       
        TabMouse(i).Width = Tab_left(i).Width + Tab_right(i).Width + Tab_center(i).Width
       
        Tab_caption(i).ForeColor = TAB_NORMAL
       
        Tab_caption(i).Visible = True
        If i = 0 Then
            Tab_center(i).Visible = True
            Tab_left(i).Visible = True
            Tab_right(i).Visible = True
            Tab_caption(i).ForeColor = TAB_SELECTED
        End If
        TabMouse(i).Visible = True
   
        Tab_center(i).ZOrder 0
        Tab_left(i).ZOrder 0
        Tab_right(i).ZOrder 0
       
        Tab_center_over(i).ZOrder 0
        Tab_left_over(i).ZOrder 0
        Tab_right_over(i).ZOrder 0
       
        Tab_caption(i).ZOrder 0
        TabMouse(i).ZOrder 0
    Next
End Sub
Private Sub CatsUpdate()
    On Error Resume Next
    ztopo = 360
    Cat_Center_off(0).Top = ztopo
    Cat_Center_on(0).Top = ztopo
    Cat_Left_off(0).Top = ztopo
    Cat_Left_on(0).Top = ztopo
    Cat_Right_off(0).Top = ztopo
    Cat_Right_on(0).Top = ztopo
    CatMouse(0).Top = ztopo
    Cat_Caption(0).Top = 1400
   
    Dim TotalCatsT As Integer
    Dim CatsIDT(30) As String
    Dim CatsCT(30) As String
    Dim CatsTT(30) As String
    Dim CatsDT(30) As Boolean
    TotalCatsT = 0
    For i = 0 To TotalCats
        If CatsT(i) = TabSelected And TabSelected <> "" And CatsT(i) <> "" Then
            CatsIDT(TotalCatsT) = CatsID(i)
            CatsTT(TotalCatsT) = CatsT(i)
            CatsCT(TotalCatsT) = CatsC(i)
            CatsDT(TotalCatsT) = CatsD(i)
            TotalCatsT = TotalCatsT + 1
        End If
    Next
    For i = 1 To CatMouse.UBound
            Unload Cat_Left_off(i)
            Unload Cat_Left_on(i)
            Unload Cat_Right_off(i)
            Unload Cat_Right_on(i)
            Unload Cat_Center_off(i)
            Unload Cat_Center_on(i)
            Unload Cat_Caption(i)
            Unload CatMouse(i)
            Unload Cat_Dlg(i)
            Unload Cat_Dlg_on(i)
            Unload Cat_Dlg_over(i)
    Next
    For i = 1 To Button_center.UBound
        Unload Button_left(i)
        Unload Button_center(i)
        Unload Button_right(i)
        Unload Button_left_over(i)
        Unload Button_center_over(i)
        Unload Button_right_over(i)
        Unload Button_Caption(i)
        Unload Button_Icon(i)
        Unload Glip_on(i)
        Unload Glip_off(i)
        Unload ButMouse(i)
    Next
    Button_left(0).Visible = False
    Button_center(0).Visible = False
    Button_right(0).Visible = False
    Button_Caption(0).Visible = False
    Button_Icon(0).Visible = False
    ButMouse(0).Visible = False
   
    Cat_Left_off(0).Visible = False
    Cat_Left_on(0).Visible = False
    Cat_Right_off(0).Visible = False
    Cat_Right_on(0).Visible = False
    Cat_Center_off(0).Visible = False
    Cat_Center_on(0).Visible = False
    Cat_Caption(0).Visible = False
    CatMouse(0).Visible = False
    Cat_Dlg(0).Visible = False
    Cat_Dlg_on(0).Visible = False
    Cat_Dlg_over(0).Visible = False
    For i = 0 To (TotalCatsT - 1)
        If i <> 0 Then
            Load Cat_Left_off(i)
            Load Cat_Left_on(i)
            Load Cat_Right_off(i)
            Load Cat_Right_on(i)
            Load Cat_Center_off(i)
            Load Cat_Center_on(i)
            Load Cat_Caption(i)
            Load CatMouse(i)
            Load Cat_Dlg(i)
            Load Cat_Dlg_on(i)
            Load Cat_Dlg_over(i)
            Cat_Left_off(i).Left = Cat_Right_off(i - 1).Left + Cat_Right_off(i).Width
        Else
            Cat_Left_off(i).Left = 120
        End If
        CatMouse(i).Left = Cat_Left_off(i).Left
       
        Cat_Caption(i).Caption = CatsCT(i)
        Cat_Caption(i).Tag = CatsIDT(i)
       
        Cat_Center_off(i).Left = Cat_Left_off(i).Left + Cat_Left_off(i).Width
       
        BUTSIZE = ButtonsUpdate(CatsIDT(i), Cat_Center_off(i).Left, i + 0)
       
        If CatsDT(i) = True Then
            Cat_Center_off(i).Width = Cat_Caption(i).Width + Cat_Dlg(i).Width
        Else
            Cat_Center_off(i).Width = Cat_Caption(i).Width
        End If
       
        If Cat_Center_off(i).Width < BUTSIZE Then
            Cat_Center_off(i).Width = BUTSIZE
            Cat_Caption(i).Left = Cat_Center_off(i).Left + ((Cat_Center_off(i).Width - Cat_Caption(i).Width) / 2)
        Else
            Cat_Caption(i).Left = Cat_Center_off(i).Left
        End If
       
        Cat_Right_off(i).Left = Cat_Center_off(i).Left + Cat_Center_off(i).Width
       
        Cat_Center_on(i).Width = Cat_Center_off(i).Width
        Cat_Center_on(i).Left = Cat_Center_off(i).Left
        Cat_Left_on(i).Left = Cat_Left_off(i).Left
        Cat_Right_on(i).Left = Cat_Right_off(i).Left
       
        CatMouse(i).Width = Cat_Left_off(i).Width + Cat_Right_off(i).Width + Cat_Center_off(i).Width
       
        Cat_Caption(i).Visible = True
        Cat_Center_off(i).Visible = True
        Cat_Left_off(i).Visible = True
        Cat_Right_off(i).Visible = True
        CatMouse(i).Visible = True
   
        Cat_Center_off(i).ZOrder 0
        Cat_Left_off(i).ZOrder 0
        Cat_Right_off(i).ZOrder 0
       
        Cat_Center_on(i).ZOrder 0
        Cat_Left_on(i).ZOrder 0
        Cat_Right_on(i).ZOrder 0
       
        Cat_Caption(i).ZOrder 0
        CatMouse(i).ZOrder 0
       
        Cat_Dlg(i).Left = (Cat_Right_off(i).Left - Cat_Dlg(i).Width) + 15
        Cat_Dlg(i).Top = (Cat_Right_off(i).Top + Cat_Right_off(i).Height) - (Cat_Dlg(i).Height + 60)
       
        Cat_Dlg_on(i).Left = Cat_Dlg(i).Left
        Cat_Dlg_over(i).Left = Cat_Dlg(i).Left
       
        Cat_Dlg_on(i).Top = Cat_Dlg(i).Top
        Cat_Dlg_over(i).Top = Cat_Dlg(i).Top
       
       
        Cat_Dlg_on(i).Visible = False
        Cat_Dlg_over(i).Visible = False
       
        If CatsDT(i) = True Then
            Cat_Dlg(i).Visible = True
        End If
        Cat_Dlg(i).ZOrder 0
        Cat_Dlg_on(i).ZOrder 0
        Cat_Dlg_over(i).ZOrder 0
    Next
    DoEvents
    For KL = 0 To ButMouse.UBound
        Button_left(KL).Visible = False
        Button_left(KL).ZOrder 0
        Button_right(KL).Visible = False
        Button_right(KL).ZOrder 0
        Button_center(KL).Visible = False
        Button_center(KL).ZOrder 0
       
        Button_left_over(KL).Visible = False
        Button_left_over(KL).ZOrder 0
        Button_right_over(KL).Visible = False
        Button_right_over(KL).ZOrder 0
        Button_center_over(KL).Visible = False
        Button_center_over(KL).ZOrder 0
       
        Button_Icon(KL).ZOrder 0
        Button_Caption(KL).ZOrder 0
       
        Glip_off(KL).ZOrder 0
        Glip_on(KL).ZOrder 0
       
        ButMouse(KL).ZOrder 0
    Next
End Sub
Private Sub UserControl_Resize()
    'On Error Resume Next
    UserControl.Height = Barra2.Height - (26 * 15)
    'UserControl.Width = UserControl.ParentControls.Item(0).ScaleWidth
    'BarraRight.Left = UserControl.Width - BarraRight.Width
End Sub
Public Sub Refresh()
    UserControl_Resize
    TabsUpdate
    CatsUpdate
End Sub
Private Sub UserControl_InitProperties()
    m_Theme = m_def_Theme
    m_BC = m_def_BC
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_Theme = PropBag.ReadProperty("Theme", m_def_Theme)
    m_BC = PropBag.ReadProperty("ButtonCenter", m_def_BC)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Theme", m_Theme, m_def_Theme)
    Call PropBag.WriteProperty("ButtonCenter", m_BC, m_def_BC)
    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H464646)
    Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, &HFFFFFF)
End Sub
Public Function AddTab(zID As String, zCaption As String) As Boolean
    TotalTabs = TotalTabs + 1
    TabID(TotalTabs - 1) = zID
    zCaption = Replace(zCaption, vbNewLine, " ")
    TabC(TotalTabs - 1) = zCaption
    If TabSelected = "" Then
        TabSelected = zID
    End If
End Function
Public Function AddCat(zID As String, zTab As String, zCaption As String, zDlgButton As Boolean) As Boolean
    TotalCats = TotalCats + 1
    CatsID(TotalCats - 1) = zID
    CatsT(TotalCats - 1) = zTab
    zCaption = Replace(zCaption, vbNewLine, " ")
    CatsC(TotalCats - 1) = zCaption
    CatsD(TotalCats - 1) = zDlgButton
End Function
Public Function AddButton(zID As String, zSubCat As String, zCaption As String, zPicture As Integer, Optional zMore As Boolean = False, Optional zToolTip As String) As Boolean
    TotalButton = TotalButton + 1
    TopBuID(TotalButton - 1) = zID
    TopBuS(TotalButton - 1) = zSubCat
    TopBuC(TotalButton - 1) = zCaption
    If zToolTip = "" Or zToolTip = Null Then
        If InStr(zCaption, vbNewLine) Then
            zCaption = Replace(zCaption, vbNewLine, " ")
        End If
        TopBuT(TotalButton - 1) = zCaption
    Else
        zToolTip = Replace(zToolTip, vbNewLine, " ")
        TopBuT(TotalButton - 1) = zToolTip
    End If
    Set TopBuI(TotalButton - 1) = zImg.ListImages.Item(zPicture).Picture
    TopBuG(TotalButton - 1) = zMore
End Function
Private Function ButtonsUpdate(SubCat As String, PosIni As Integer, CatID As Integer) As Integer
    On Error Resume Next
    Dim TotalButtonT As Integer
    Dim TopBuIDT(90) As String
    Dim TopBuST(90) As String
    Dim TopBuCT(90) As String
    Dim TopBuIT(90) As Picture
    Dim TopBuTT(90) As String
    Dim TopBuGT(90) As Boolean
    TotalSize = 0
    TotalButtonT = 0
    For i = 0 To TotalButton
        If TopBuS(i) = SubCat Then
            TopBuIDT(TotalButtonT) = TopBuID(i)
            TopBuST(TotalButtonT) = TopBuS(i)
            TopBuCT(TotalButtonT) = TopBuC(i)
            TopBuTT(TotalButtonT) = TopBuT(i)
            Set TopBuIT(TotalButtonT) = TopBuI(i)
            TopBuGT(TotalButtonT) = TopBuG(i)
            TotalButtonT = TotalButtonT + 1
        End If
    Next
    Button_left(0).Visible = False
    Button_center(0).Visible = False
    Button_right(0).Visible = False
    Button_Caption(0).Visible = True
    Button_Icon(0).Visible = True
    ButMouse(0).Visible = True
    xt = ButMouse.UBound + 1
    For i = xt To (TotalButtonT - 1) + xt
        If i <> 0 Then
            Load Button_left(i)
            Load Button_center(i)
            Load Button_right(i)
            Load Button_left_over(i)
            Load Button_center_over(i)
            Load Button_right_over(i)
            Load Button_Caption(i)
            Load Button_Icon(i)
            Load Glip_on(i)
            Load Glip_off(i)
            Load ButMouse(i)
        End If
        ButMouse(i).Tag = TopBuIDT(i - xt)
       
        Button_center(i).Tag = CatID

        ButMouse(i).Top = Cat_Left_off(0).Top + 60
        Button_left(i).Top = ButMouse(i).Top
        Button_center(i).Top = ButMouse(i).Top
        Button_right(i).Top = ButMouse(i).Top
        Button_left_over(i).Top = ButMouse(i).Top
        Button_center_over(i).Top = ButMouse(i).Top
        Button_right_over(i).Top = ButMouse(i).Top
       
        If i = xt Then
            posatu = PosIni
        Else
            posatu = ButMouse(i - 1).Left + ButMouse(i - 1).Width + 30
        End If
        ButMouse(i).Left = posatu
        Button_left(i).Left = ButMouse(i).Left
        Button_left_over(i).Left = Button_left(i).Left
        Button_center(i).Left = Button_left(i).Left + Button_left(i).Width
        Button_center_over(i).Left = Button_center(i).Left
       
        Button_Caption(i).Caption = TopBuCT(i - xt)
       
        Set Button_Icon(i) = TopBuIT(i - xt)
       
        If m_BC = True Then
            ESP = Button_center(i).Height - (Button_Icon(i).Height + Button_Caption(i).Height)
            If TopBuGT(i - xt) = True Then
                Button_Icon(i).Top = Button_center(i).Top + ((ESP - (Button_Caption(i).Height / 2)) / 2)
            Else
                Button_Icon(i).Top = Button_center(i).Top + ((ESP) / 2)
            End If
        Else
            Button_Icon(i).Top = Button_center(i).Top + 90
        End If
           
       
        Button_Caption(i).Top = Button_Icon(i).Top + Button_Icon(i).Height
       
        Glip_off(i).Top = Button_Caption(i).Top + Button_Caption(i).Height + ((Button_Caption(i).Height - Glip_off(i).Height) / 2)
        Glip_on(i).Top = Glip_off(i).Top
       
       
        If Button_Caption(i).Width > Button_Icon(i).Width Then
            Button_Caption(i).Left = Button_center(i).Left
            esp2 = (Button_Caption(i).Width - Button_Icon(i).Width) / 2
            Button_Icon(i).Left = Button_Caption(i).Left + esp2
            Area = Button_Caption(i).Width
        Else
            Button_Icon(i).Left = Button_center(i).Left
            esp2 = (Button_Icon(i).Width - Button_Caption(i).Width) / 2
            Button_Caption(i).Left = Button_Icon(i).Left + esp2
            Area = Button_Icon(i).Width
        End If
   
        Glip_off(i).Left = Button_Caption(i).Left + ((Button_Caption(i).Width - Glip_on(i).Width) / 2)
        Glip_on(i).Left = Glip_off(i).Left
   
        Button_center(i).Width = Area
        Button_center_over(i).Width = Button_center(i).Width
        Button_right(i).Left = Button_center(i).Left + Button_center(i).Width
        Button_right_over(i).Left = Button_right(i).Left
        ButMouse(i).Width = (Button_right(i).Width + Button_right(i).Width) + Button_center(i).Width
       
        ButMouse(i).ToolTipText = TopBuTT(i - xt)
        Button_Icon(i).Visible = True
        Button_Caption(i).Visible = True
        ButMouse(i).Visible = True
        If TopBuGT(i - xt) = True Then
            Glip_off(i).Visible = True
            Glip_off(i).ZOrder 0
            Glip_on(i).ZOrder 0
        End If
   
        TotalSize = TotalSize + ButMouse(i).Width + 30
    Next
    ButtonsUpdate = TotalSize - 30
End Function
Public Property Get Theme() As Integer
    Theme = m_Theme
End Property
Public Property Let Theme(ByVal New_Theme As Integer)
    If New_Theme < 0 Or New_Theme > 2 Then New_Theme = 0
    m_Theme = New_Theme
    PropertyChanged "Theme"
    LoadTheme m_Theme
End Property
Public Property Get ButtonCenter() As Variant
    ButtonCenter = m_BC
End Property
Public Property Let ButtonCenter(ByVal New_BC As Variant)
    m_BC = New_BC
    PropertyChanged "ButtonCenter"
End Property
Private Function LoadTheme(iTema)
    Select Case iTema
        Case 0
            ID = "BLACK"
            Cat_Caption(0).ForeColor = &HFFFFFF
            TAB_NORMAL = vbWhite
            TAB_SELECTED = vbBlack
            Button_Caption(0).ForeColor = &H80000008
            UserControl.BackColor = &H464646
            UserControl.ForeColor = &HFFFFFF
        Case 1
            ID = "BLUE"
            Cat_Caption(0).ForeColor = &HB86A3E
            TAB_NORMAL = &H8B4215
            TAB_SELECTED = &H8B4215
            Button_Caption(0).ForeColor = &H8B4215
            UserControl.BackColor = &HDAB08E
            UserControl.ForeColor = &H8B4215
        Case 2
            ID = "SILVER"
            Cat_Caption(0).ForeColor = &H6A625C
            TAB_NORMAL = &H6A625C
            TAB_SELECTED = &H6A625C
            Button_Caption(0).ForeColor = &H6A625C
            UserControl.BackColor = &HDDD4D0
            UserControl.ForeColor = &H6A625C
        Case Else
            ID = "BLACK"
    End Select
    Set Barra2.Picture = LoadResPicture(101, ID)
    Set BarraLeft.Picture = LoadResPicture(102, ID)
    Set BarraRight.Picture = LoadResPicture(103, ID)
    Set Cat_Dlg(0).Picture = LoadResPicture(118, ID)
    Set Cat_Dlg_on(0).Picture = LoadResPicture(119, ID)
    Set Cat_Dlg_over(0).Picture = LoadResPicture(120, ID)
    Set Cat_Left_off(0).Picture = LoadResPicture(121, ID)
    Set Cat_Center_off(0).Picture = LoadResPicture(122, ID)
    Set Cat_Right_off(0).Picture = LoadResPicture(123, ID)
    Set Cat_Left_on(0).Picture = LoadResPicture(124, ID)
    Set Cat_Center_on(0).Picture = LoadResPicture(125, ID)
    Set Cat_Right_on(0).Picture = LoadResPicture(126, ID)
    Set Tab_left(0).Picture = LoadResPicture(127, ID)
    Set Tab_center(0).Picture = LoadResPicture(128, ID)
    Set Tab_right(0).Picture = LoadResPicture(129, ID)
    Set Tab_left_over(0).Picture = LoadResPicture(130, ID)
    Set Tab_center_over(0).Picture = LoadResPicture(131, ID)
    Set Tab_right_over(0).Picture = LoadResPicture(132, ID)
    Set Glip_off(0).Picture = LoadResPicture(133, ID)
    Set Glip_on(0).Picture = LoadResPicture(134, ID)
    Set Button_left_over(0).Picture = LoadResPicture(135, ID)
    Set Button_center_over(0).Picture = LoadResPicture(136, ID)
    Set Button_right_over(0).Picture = LoadResPicture(137, ID)
    Set Button_left(0).Picture = LoadResPicture(138, ID)
    Set Button_center(0).Picture = LoadResPicture(139, ID)
    Set Button_right(0).Picture = LoadResPicture(140, ID)
End Function
Private Property Get TempDir() As String
    Dim sRet As String, c As Long
    Dim lErr As Long
    sRet = String$(MAX_PATH, 0)
    c = GetTempPath(MAX_PATH, sRet)
    lErr = Err.LastDllError
    If c = 0 Then
        Err.Raise 10000 Or lErr, App.EXEName & ".cAniCursor", WinAPIError(lErr)
    End If
    TempDir = Left$(sRet, c)
End Property
Private Property Get TempFileName(Optional ByVal sPrefix As String, Optional ByVal sPathName As String) As String
    Dim lErr As Long
    Dim iPos As Long
    If sPrefix = "" Then sPrefix = ""
    If sPathName = "" Then sPathName = TempDir
    Dim sRet As String
    sRet = String(MAX_PATH, 0)
    GetTempFileName sPathName, sPrefix, 0, sRet
    lErr = Err.LastDllError
    If Not lErr = 0 Then
        Err.Raise 10000 Or lErr, App.EXEName & ".cAniCursor", WinAPIError(lErr)
    End If
    iPos = InStr(sRet, vbNullChar)
    If Not iPos = 0 Then
        TempFileName = Left$(sRet, iPos - 1)
    End If
End Property
Private Function WinAPIError(ByVal lLastDLLError As Long) As String
    Dim sBuff As String
    Dim lCount As Long
    sBuff = String$(256, 0)
    lCount = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0)
    If lCount Then
        WinAPIError = Left$(sBuff, lCount)
    End If
End Function
Public Property Get LoadBackground() As IPicture
    Dim sFile As String
    Dim b() As Byte
    Dim iFile As Integer
    On Error GoTo ErrorHandler
    Select Case m_Theme
        Case 0
            b = LoadResData(141, "BLACK")
        Case 1
            b = LoadResData(141, "BLUE")
        Case 2
            b = LoadResData(141, "SILVER")
    End Select
    sFile = TempFileName("LRP")
    iFile = FreeFile
    Open sFile For Binary Access Write Lock Read As #iFile
        Put #iFile, , b
    Close #iFile
    iFile = 0
    Set LoadBackground = LoadPicture(sFile)
    KillFile sFile
    Exit Property
ErrorHandler:
    Dim lErr As Long, sErr As String
    lErr = Err.Number:   sErr = Err.Description
    If Not iFile = 0 Then Close #iFile
    KillFile sFile
    Err.Raise Err.Number, App.EXEName & ".cLoadResPicture", Err.Description
    Exit Property
End Property
Private Property Get LoadResPicture(ByVal ID As Variant, ByVal Format As Variant) As IPicture
    Dim sFile As String
    Dim b() As Byte
    Dim iFile As Integer
    On Error GoTo ErrorHandler
    b = LoadResData(ID, Format)
    sFile = TempFileName("LRP")
    iFile = FreeFile
    Open sFile For Binary Access Write Lock Read As #iFile
        Put #iFile, , b
    Close #iFile
    iFile = 0
    Set LoadResPicture = LoadPicture(sFile)
    KillFile sFile
    Exit Property
ErrorHandler:
    Dim lErr As Long, sErr As String
    lErr = Err.Number:   sErr = Err.Description
    If Not iFile = 0 Then Close #iFile
    KillFile sFile
    Err.Raise Err.Number, App.EXEName & ".cLoadResPicture", Err.Description
    Exit Property
End Property
Private Sub KillFile(ByVal sFile As String)
    On Error Resume Next
    Kill sFile
End Sub
Public Sub Resize()
    UserControl_Resize
End Sub
Public Property Let ImageList(ByVal zImageList As ImageList)
    Set zImg = zImageList
End Property
Public Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End Property
Public Property Get ForeColor() As OLE_COLOR
    ForeColor = UserControl.ForeColor
End Property

Regards
Fafi

[fafi]

Look at here Sir !
>> Dim zImg As ImageList

I can't use this Imagelist :
because come from another OCX ( Microsoft Window Common Control )

and here :

>> Public Property Let ImageList(ByVal zImageList As ImageList)
>> Set zImg = zImageList
>> End Property

oAct:do("Imagelist", oImagelist )

Antonio,
What is Type of oImagelist in FWH ?

if oImageList is Object then I want to change Dim zImg As ImageList with Dim zImg As Object
but still error....

Please Help !

Regards
Fafi