Guidance
指路人
g.yi.org
software / rapidq / Examples / QObject / QCoolBarXP / QCoolBarXPv1d.inc

Register 
注册
Search 搜索
首页 
Home Home
Software
Upload

  
' Créé par D-évolution / Created by D-evolution -=@=- 2003 - 2005

' [Français]
' Dans la série des objets persos, voici QCoolBarXPv1 -- Immitation d'une Barre d'outil

' CoolBarXPv1 est une toute nouvelle version, complètement revue de ma CoolBar, version
' optimisée afin de réduire le scintillement lors du redimensionnement de la barre
' d'outil...
' Tout ça est possible via une modification de l'Add-On fournis avec QTButton
' Voyez-les posibilités !!!
' Il ne reste plus qu'a gérer l'effet Survole, placer une image de fond et on obtient
' une Barre d'outil casi identique à celles de WinXP (sous XP)

' Pour plus de détail sur l'utilisation de ce composant reportez vous à la documentation
' fournise... (QCoolBarXP.html)

' Si la doc n'est pas disponible actuellement elle le sera sous peu...

' [English]
' In the serie of custum objects here's QCoolBarXPv1 -- ToolBar look with XP support

' CoolBarXPv1 is a completly new version, this version is optimized to reduce flickering
' while resizing the toolbar...
' All that is possible via some modification of the Add-On that came with QTButton

' For more details on using this component please refer to the doc
' (QCoolBarXP.html)

' *You're free to fix my bad spelling ;)
     $OPTION EXPLICIT

     DIM custBG		AS QBITMAP
     DIM custGrip	AS QBITMAP

' ===
' Extrait de QTButton

     $IFNDEF __RQINC' ==(corrigé! doh!)
      $IFNDEF __RQINCTMP
       $DEFINE __RQINCTMP
       CONST False = 0
       CONST True	= 1

       CONST clBtnFace = -2147483633
       CONST clHilight	= -2147483635
       CONST clGrayText = -2147483631
       CONST clBtnText	= -2147483630
       CONST clPurple	= &HFF00FF

       CONST pf15bit	= 4
      $ENDIF ' __RQINCTMP
     $ENDIF ' __RQINC

     CONST rqNullChr_CBar = CHR$(0)
'Const rqSL		= CHR$(10)

     CONST DefPixelFormat_CBar = 4

'Dim QCBarBMP As QBitmap
'	QCBarBMP.BMPHandle = btn_BMP' REsource bitmap

     $IFNDEF __QTBTNSHARED95
      $DEFINE __QTBTNSHARED95
'
      DECLARE FUNCTION GetDC_QTBtn LIB "user32" _
       ALIAS "GetDC" _
       (BYVAL hwnd AS LONG) AS LONG
      DECLARE FUNCTION ReleaseDC_QTBtn LIB "user32" _
       ALIAS "ReleaseDC" ( _
       BYVAL hwnd AS LONG, _
       BYVAL hdc AS LONG) AS LONG

      CONST SrcCopy_QTBtn = &HCC0020	' Celui dans RapidQ.INC n'est pas correct

      DECLARE FUNCTION BitBlt_QTBtn LIB "gdi32" _
       ALIAS "BitBlt" ( _
       hDC AS INTEGER, _
       nXDest AS INTEGER, nYDest AS INTEGER, _
       nWidth AS INTEGER, nHeight AS INTEGER, _
       hdcSrc AS INTEGER, _
       nXSrc AS INTEGER, nYSrc AS INTEGER, _
       dwRop AS INTEGER) AS INTEGER

' Pour Win98 et supérieur
      DECLARE FUNCTION TransparentBlt_QTBtn LIB "msimg32" _
       ALIAS "TransparentBlt" ( _
       BYVAL hdcDest AS LONG, _
       BYVAL nXOriginDest AS LONG, BYVAL nYOriginDest AS LONG, _
       BYVAL nWidthDest AS LONG, BYVAL nHeightDest AS LONG, _
       BYVAL hdcSrc AS LONG, _
       BYVAL nXOriginSrc AS LONG, BYVAL nYOriginSrc AS LONG, _
       BYVAL nWidthSrc AS LONG, BYVAL nHeightSrc AS LONG, _
       BYVAL crTransparent AS LONG) AS LONG
     $ENDIF ' __QTBTNSHARED

     $IFNDEF __RQOBJDRAWING
      $DEFINE __RQOBJDRAWING
      DECLARE FUNCTION SetCapture_QTBtn LIB "user32" ALIAS "SetCapture" _
       (BYVAL hwnd AS LONG) AS LONG
      DECLARE FUNCTION ReleaseCapture_QTBtn LIB "user32" ALIAS "ReleaseCapture" () AS LONG
      DECLARE FUNCTION GetCapture_QTBtn LIB "user32" ALIAS "GetCapture" () AS LONG

      TYPE RECT_QTBtn
       Left	AS LONG
       Top		AS LONG
       Right	AS LONG
       Bottom	AS LONG
      END TYPE

      CONST DT_SINGLELINE_QTBtn AS LONG = &H20
      CONST DT_CENTER_QTBtn = &H1
      CONST DT_VCENTER_QTBtn AS LONG = &H4

      DECLARE FUNCTION DrawText_QTBtn LIB "user32" ALIAS "DrawTextA" ( _
       BYVAL hdc AS LONG, _
       BYVAL lpStr AS STRING, _
       BYVAL nCount AS LONG, _
       lpRect AS RECT_QTBtn, _
       BYVAL wFormat AS LONG) AS LONG

' Ajouté 6fév
'Declare Function GetDC_QTBtn Lib "user32" _
'		Alias "GetDC" _
'		(ByVal hwnd As Long) As Long
'Declare Function DeleteDC_QTBtn Lib "gdi32" _
'		Alias "DeleteDC" (ByVal hdc As Long) As Long
'Declare Function ReleaseDC_QTBtn Lib "user32" _
'		Alias "ReleaseDC" ( _
'		ByVal hwnd As Long, _
'		ByVal hdc As Long) As Long
      DECLARE FUNCTION SetBkMode_QTBtn LIB "gdi32" _
       ALIAS "SetBkMode" ( _
       BYVAL hdc AS LONG, _
       BYVAL nBkMode AS LONG) AS LONG
'Declare Function SetBkColor_QTBtn Lib "gdi32.dll" Alias "SetBkColor" _
'		(ByVal hdc As Long, ByVal crColor As Long) As Long
'Declare Function SetTextColor_QTBtn Lib "gdi32" Alias "SetTextColor" _
'		(ByVal hdc As Long, ByVal crColor As Long) As Long

' -- (Ajouté 11janv) Les Nouveaux API pour le suport des Thèmes de Bureau XP
      DECLARE FUNCTION OpenThemeData_QTBtn LIB "uxtheme.dll" ALIAS "OpenThemeData" ( _
       BYVAL hwnd AS LONG, _
       BYVAL pszClassList AS LONG) AS LONG

      DECLARE FUNCTION CloseThemeData_QTBtn LIB "uxtheme.dll" ALIAS "CloseThemeData" ( _
       BYVAL hTheme AS LONG) AS LONG

      DECLARE FUNCTION DrawThemeBackground_QTBtn LIB "uxtheme.dll" ALIAS "DrawThemeBackground" ( _
       BYVAL hTheme AS LONG, _
       BYVAL hdc AS LONG, _
       BYVAL iPartID AS LONG, _
       BYVAL iStateID AS LONG, _
       pRect AS RECT_QTBtn, _
       pClipRect AS RECT_QTBtn) AS LONG
'Declare Function DrawThemeText_QTBtn Lib "uxtheme.dll" Alias "DrawThemeText" ( _
'		ByVal hTheme As Long, _
'		ByVal hdc As Long, _
'		ByVal iPartID As Long, _
'		ByVal iStateID As Long, _
'		ByVal pszText As Long, _
'		ByVal iCharCount As Long, _
'		ByVal dwTextFlags As Long, _
'		ByVal dwTextFlags2 As Long, _
'		pRect As RECT_QTBtn) As Long

      CONST xpt_PushBtn		= "Button"
      CONST xpt_ToolBarBtn	= "Toolbar"
      CONST xpt_TabBtn		= "Tab"
' //--
     $ENDIF ' __RQOBJDRAWING

     CONST xpt_ReBar		= "ReBar" ' Seulement pour coolbarxp


     $IFNDEF __RQGETVERSION
      $DEFINE __RQGETVERSION
      DIM isXP_QTBtn AS INTEGER
      isXP_QTBtn = False

      TYPE OSVERSIONINFO_QTBtn
       dwOSVersionInfoSize AS LONG
       dwMajorVersion AS LONG
       dwMinorVersion AS LONG
       dwBuildNumber AS LONG
       dwPlatformId AS LONG
       szCSDVersion AS STRING *128
      END TYPE
'Const PLATFORM_WIN32_WINDOWS = 1
'Const PLATFORM_WIN32_NT = 2
      DECLARE FUNCTION GetVersionEx_QTBtn LIB "kernel32.dll" ALIAS "GetVersionExA" _
       (BYVAL lpVersionInformation AS LONG) AS LONG

      DIM rtn_QTBtn AS LONG
      DIM OSV_QTBtn AS OSVERSIONINFO_QTBtn, Mem_QTBtn AS QMEMORYSTREAM

      DIM PixelFormatFix_QTBtn AS INTEGER
      PixelFormatFix_QTBtn = pf15bit

      SUB GetVersion_QTBtn
       OSV_QTBtn.dwOSVersionInfoSize = SIZEOF(OSV_QTBtn)
       Mem_QTBtn.WriteUDT(OSV_QTBtn)
       rtn_QTBtn = GetVersionEx_QTBtn(Mem_QTBtn.Pointer)
       IF rtn_QTBtn <> False THEN
        Mem_QTBtn.Position = False
        Mem_QTBtn.ReadUDT(OSV_QTBtn)
        IF OSV_QTBtn.dwPlatformId = True THEN
         isXP_QTBtn = False
        ELSEIF OSV_QTBtn.dwPlatformId = 2 THEN
         IF OSV_QTBtn.dwMajorVersion = 5 THEN _
          IF OSV_QTBtn.dwMinorVersion = True THEN _
          isXP_QTBtn = True
        END IF
       END IF
       Mem_QTBtn.CLOSE
      END SUB
      CALL GetVersion_QTBtn
     $ENDIF ' __RQGETVERSION

     DIM maxNumBMPs_CBar AS INTEGER
     maxNumBMPs_CBar = 5

' //--

'Extrait de QTButton_AddOns

'DrawEdge Constants
'Const BDR_RAISEDOUTER_CBar	= &H1
     CONST BDR_SUNKENOUTER_CBar	= &H2
     CONST BDR_RAISEDINNER_CBar	= &H4
'Const BDR_SUNKENINNER_CBar	= &H8

'Const BDR_OUTER		= &H3
'Const BDR_INNER		= &HC
'Const BDR_RAISED		= &H5
'Const BDR_SUNKEN		= &HA

     CONST BF_LEFT_CBar		= &H1
     CONST BF_TOP_CBar		= &H2
     CONST BF_RIGHT_CBar		= &H4
     CONST BF_BOTTOM_CBar	= &H8

     CONST BF_RECT_CBar = (BF_LEFT_CBar OR BF_TOP_CBar OR BF_RIGHT_CBar OR BF_BOTTOM_CBar)

'Const BF_MIDDLE	= &H800		' Fill in the middle.
'Const BF_SOFT		= &H1000	' Use for softer buttons.
'Const BF_ADJUST	= &H2000	' Calculate the space left over.
     CONST BF_FLAT_CBar	= &H4000	' For flat rather than 3-D borders.
'Const BF_MONO		= &H8000	' For monochrome borders.

'Const DC_ACTIVE	= &H1
'Const DC_NOTACTIVE	= &H2
'Const DC_ICON		= &H4
'Const DC_TEXT		= &H8
'Const DFC_BUTTON	= 4
'Const DFC_POPUPMENU = 5			'Only Win98/2000 !!
'Const DFCS_BUTTON3STATE = &H10
'Const DT_CENTER	= &H1
'Const DC_GRADIENT	= &H20			'Only Win98/2000 !!
     DECLARE FUNCTION DrawEdge_CBar LIB "user32" ALIAS "DrawEdge" ( _
      BYVAL hdc AS LONG, _
      qrc AS RECT_QTBtn, _
      BYVAL edge AS LONG, _
      BYVAL grfFlags AS LONG) _
      AS LONG
     DECLARE FUNCTION SetRect_CBar LIB "user32" ALIAS "SetRect" ( _
      lpRect AS RECT_QTBtn, _
      BYVAL X1 AS LONG, BYVAL Y1 AS LONG, _
      BYVAL X2 AS LONG, BYVAL Y2 AS LONG) _
      AS LONG

     SUB Fast_CBar( _
       BtnType AS STRING, _
       PartID AS INTEGER, _
       StateID AS INTEGER, _
       Me AS QBITMAP, _
       CAPTION AS STRING, _
       IcoWidth AS INTEGER, _
       FontName AS INTEGER, _
       wMenu AS INTEGER, _
       Grouped AS INTEGER, _
       Style AS INTEGER, _
       DisableXPTheme AS INTEGER, _
       Hwnd AS LONG)
      DIM Dest AS QRECT, Source AS QRECT
      DIM tR AS RECT_QTBtn

      DIM fixTab AS INTEGER
      fixTab = False

      IF isXP_QTBtn AND DisableXPTheme = False THEN
       IF BtnType = xpt_TabBtn THEN _
        fixTab = True
       IF BtnType = xpt_pushbtn OR BtnType = xpt_toolbarbtn OR BtnType = xpt_TabBtn THEN _
        PartID = True
      END IF

      Me.FillRect(False, False, Me.Width, Me.Height, clBtnFace)'==(mod) (13janv remplacé clPurple par clBtnFace)

      IF FontName <> "" THEN _
       SWAP (Me.Font.Name, FontName)' == (add)

      IF isXP_QTBtn = False OR DisableXPTheme = True THEN
		' Temporairement indisponible

		'
       IF StateID > False THEN
        IF Style THEN
				' Bon c'est pour la survole
         Me.Rectangle( True, _
          True, _
          Me.Width, _
          Me.Height, _
          -2147483632) 'clBtnShadow
         Me.FillRect( 2, _
          2, _
          Me.Width -True, _
          Me.Height -True, _
          -2147483638) 'clActiveBorder
        ELSE
         SetRect_CBar ( tR, _
          True, _
          True, _
          Me.Width, _
          Me.Height)
         IF StateID = True THEN
          DrawEdge_CBar (Me.Handle, tR, BDR_RAISEDINNER_CBar, BF_RECT_CBar)
         ELSE
          DrawEdge_CBar (Me.Handle, tR, BDR_SUNKENOUTER_CBar, BF_RECT_CBar)
         END IF
        END IF
        IF StateID = 2 OR StateID = 4 THEN
         Me.FillRect( 2, _
          2, _
          Me.Width -True, _
          Me.Height -True, _
          -2147483628)
         Me.Pixel(3, 3) = Me.Pixel(3, 3) -RGB(8, 11, 28)
         Me.FillRect( 2, _
          2, _
          Me.Width -True, _
          Me.Height -True, _
          Me.Pixel(3, 3)) 'clActiveBorder
        END IF
       END IF
       IF wMenu > False THEN
        DIM bFont AS STRING
        bFont	= "Marlett"

        IF Style THEN
         Me.FillRect(Me.Width -11, _
          2, _
          Me.Width -True, _
          Me.Height -True, _
          IIF(StateID = False, clBtnFace, &HFFFFFF))
        ELSE
         IF StateID +True >= 3 AND wMenu < 2 THEN
          SetRect_CBar ( tR, _
           Me.Width -11, 2, _
           Me.Width -11, Me.Height)
         ELSE
          SetRect_CBar ( tR, _
           Me.Width -12, True, _
           Me.Width -12, Me.Height)
         END IF
         DrawEdge_CBar (Me.Handle, tR, BDR_RAISEDINNER_CBar, BF_RECT_CBar)
        END IF

        SWAP (Me.Font.Name, bFont)

        tR.Left		= Me.Width -11 +IIF(StateID +True >= 3 AND wMenu < 2, True, False)
        tR.Top		= False +IIF(StateID +True >= 3 AND wMenu < 2, True, False)
        tR.Right	= Me.Width +IIF(StateID +True >= 3 AND wMenu < 2, True, False)
        tR.Bottom	= Me.Height

        SetBkMode_QTBtn Me.Handle, True
        IF StateID = 3 THEN
         Me.Font.COLOR	= -2147483628 '-2147483626
         tR.Left			= tR.Left +True
         tR.Top			= tR.Top +True
         DrawText_QTBtn (Me.Handle, "6", True, _
          tR, DT_CENTER_QTBtn OR DT_SINGLELINE_QTBtn OR DT_VCENTER_QTBtn)
         tR.Left			= tR.Left -True
         tR.Top			= tR.Top -True
         Me.Font.COLOR	= clGrayText
        END IF

        DrawText_QTBtn (Me.Handle, "6", True, _
         tR, DT_CENTER_QTBtn OR DT_SINGLELINE_QTBtn OR DT_VCENTER_QTBtn)
        SWAP (Me.Font.Name, bFont)
       END IF
      ELSE
		' Thème activé (Windows XP)
		' --
       DIM hTheme AS LONG

		' Ouverture du thème
       DIM rtButton AS STRING ', _
       rtButton = ""

       DIM lR AS LONG
       DIM m_hDC AS LONG
       DIM m_lPartId AS LONG, m_lStateId AS LONG
		'Dim tR As RECT_QTBtn

		' Format unicode ?!?
       DIM I AS INTEGER
       FOR I = True TO LEN(BtnType)
        rtButton = rtButton +MID$(BtnType, I, True) +rqNullChr_CBar
       NEXT I
       rtButton = rtButton +rqNullChr_CBar ' Un dernier pour la route

       hTheme = OpenThemeData_QTBtn(Hwnd, VARPTR(rtButton))
       IF hTheme <> False THEN
			' Styles XP disponible

			' m_hDC est le DC pour dessiner
			' m_lPartId et m_lStateId sont la class + l'état à dessiner
			' tR est un RECT spécifiant la zone dans laquelle dessiner
        m_hDC = Me.Handle
        DIM mLeft AS INTEGER
        mLeft = False
        IF wMenu > False THEN
         m_lPartId = 3
         mLeft = 11
        ELSEIF PartID > True THEN
         m_lPartId = PartID
        ELSE
         m_lPartId = True 'BP_PUSHBUTTON
        END IF

        m_lStateId	= StateID +True	'PBS_NORMAL
        IF wMenu = 2 THEN _
         m_lStateId --
        tR.Left		= False '+iif(StateID <> 2, True, False)
        tR.Top		= True 'True -iif(StateID <> 2, False, True) +fixTab
        tR.Right	= Me.Width -mLeft
        tR.Bottom	= Me.Height

        lR = DrawThemeBackground_QTBtn(hTheme, _
         m_hDC, _
         m_lPartId, _
         m_lStateId, _
         tR, tR)

        IF wMenu > False THEN
         m_lPartId	= 4
         IF wMenu = 2 THEN _
          m_lStateId ++

         tR.Left		= Me.Width -11
         tR.Top		= True
         tR.Right	= Me.Width
         tR.Bottom	= Me.Height

         lR = DrawThemeBackground_QTBtn(hTheme, _
          m_hDC, _
          m_lPartId, _
          m_lStateId, _
          tR, tR)
        END IF
       END IF

		' Session de dessin terminée
       CloseThemeData_QTBtn hTheme
       CloseThemeData_QTBtn hTheme
		'//--
      END IF

      IF CAPTION <> "" THEN
       IF IcoWidth > False THEN IcoWidth = IcoWidth +4
       SetBkMode_QTBtn Me.Handle, True
       tR.Left		= False +IIF(StateID +True >= 3 AND wMenu < 2, True, False) +IcoWidth
       tR.Top		= False +IIF(StateID +True >= 3 AND wMenu < 2, 2, False) +fixTab
		'tR.Top		= tR.Top +iif(StateID +True = 3, 4, False)
       tR.Right	= Me.Width +tR.Left -IcoWidth
       tR.Bottom	= Me.Height

       IF StateID = 3 THEN
        Me.Font.COLOR = -2147483628 '-2147483626
        tR.Left	= tR.Left +True
        tR.Top	= tR.Top +True
        DrawText_QTBtn (Me.Handle, CAPTION, LEN(CAPTION), _
         tR, IIF(IcoWidth > False, False, DT_CENTER_QTBtn) OR DT_SINGLELINE_QTBtn OR DT_VCENTER_QTBtn)
        tR.Left	= tR.Left -True
        tR.Top	= tR.Top -True
        Me.Font.COLOR = clGrayText
       END IF

       DrawText_QTBtn (Me.Handle, CAPTION, LEN(CAPTION), _
        tR, IIF(IcoWidth > False, False, DT_CENTER_QTBtn) OR DT_SINGLELINE_QTBtn OR DT_VCENTER_QTBtn)
      END IF
	'Me.PixelFormat = DefPixelFormat_CBar

      IF FontName <> "" THEN _
       SWAP (Me.Font.Name, FontName)' == (add)

      IF PartID <> True THEN _
       PartID = True
     END SUB


     SUB XPPart ( _
       BtnType AS STRING, _
       PartID AS INTEGER, _
       Orientation AS INTEGER, _
       DisableXPThemeBG AS INTEGER, _
       COLOR, _
       Me AS QBITMAP, _
       hWnd AS LONG)
      IF isXP_QTBtn THEN
		' Thème activé (Windows XP)
		' --
       IF DisableXPThemeBG OR PartID <> 6 THEN _
        Me.FillRect(False, False, Me.Width, Me.Height, COLOR)

       DIM hTheme AS LONG

		' Ouverture du thème
       DIM rtButton AS STRING
       rtButton = ""
		' Format unicode ?!?
       DIM I AS INTEGER
       FOR I = True TO LEN(BtnType)
        rtButton = rtButton +MID$(BtnType, I, True) +rqNullChr_CBar
       NEXT I
       rtButton = rtButton +rqNullChr_CBar ' Et un dernier pour la route

       hTheme = OpenThemeData_QTBtn(hWnd, VARPTR(rtButton))
       IF hTheme <> False THEN
			' Styles XP disponible

        DIM lR AS LONG
        DIM m_hDC AS LONG
        DIM m_lPartId AS LONG, m_lStateId AS LONG
        DIM tR AS RECT_QTBtn

			' m_hDC est le DC pour dessiner
			' m_lPartId et m_lStateId sont la classe + l'état à dessiner
			' tR est une structure RECT spécifiant la zone dans laquelle dessiner
        m_hDC = Me.Handle
        IF PartID > True THEN _
         m_lPartId = PartID _
        ELSE _
         m_lPartId = True 'BP_PUSHBUTTON

        m_lStateId = True 'PBS_NORMAL
        IF PartID =< 2 THEN
         IF Orientation THEN _
          SetRect_CBar (tR, True, False, Me.Width -True, 8) _
         ELSE _
          SetRect_CBar (tR, False, True, 5, Me.Height -True)
        ELSE
         SetRect_CBar (tR, False, False, Me.Width, Me.Height)
        END IF

        lR = DrawThemeBackground_QTBtn(hTheme, _
         m_hDC, _
         m_lPartId, _
         m_lStateId, _
         tR, tR)

       END IF

		' Session de dessin terminée
       CloseThemeData_QTBtn hTheme
       CloseThemeData_QTBtn hTheme
		'//--
      END IF
     END SUB
' //==


     CONST AC_SRC_OVER_CBar = &H00

     TYPE BLENDFUNCTION_CBar
      BlendOp		AS BYTE
      BlendFlags	AS BYTE
      SourceConstantAlpha AS BYTE
      AlphaFormat	AS BYTE
     END TYPE

     DECLARE FUNCTION AlphaBlend_CBar LIB "msimg32" ALIAS "AlphaBlend" ( _
      BYVAL hdcDest AS LONG, _
      BYVAL xDest AS LONG, _
      BYVAL yDest AS LONG, _
      BYVAL WidthDest AS LONG, _
      BYVAL HeightDest AS LONG, _
      BYVAL hdcSrc AS LONG, _
      BYVAL xSrc AS LONG, _
      BYVAL ySrc AS LONG, _
      BYVAL WidthSrc AS LONG, _
      BYVAL HeightSrc AS LONG, _
      ByRef Blendfunc AS BLENDFUNCTION_CBar) AS LONG

     DECLARE SUB RtlMoveMemory_CBar LIB "kernel32.dll" ALIAS "RtlMoveMemory" ( _
      byref Destination AS LONG, _
      byref Source AS BLENDFUNCTION_CBar, _
      Length AS LONG)

     DIM BF_CBar	AS BLENDFUNCTION_CBar, _
      lBF_CBar	AS LONG


     DECLARE FUNCTION GetWindowRect_CBar LIB "user32" ALIAS "GetWindowRect" ( _
      BYVAL hwnd AS LONG, _
      ByRef lpRect AS RECT_QTBtn ) AS LONG

     DECLARE FUNCTION PtInRect_CBar LIB "user32" ALIAS "PtInRect" ( _
      ByRef lpRect AS RECT_QTBtn, _
      BYVAL x AS LONG, BYVAL y AS LONG ) AS LONG


' Gère les menus popup
'Const TPM_HORIZONTAL		As Long = &H0&
'Const TPM_LEFTALIGN			As Long = &H0&
     CONST TPM_LEFTBUTTON_CBar			= &H0				'&H0&
'Const TPM_TOPALIGN			As Long = &H0&
'Const TPM_RECURSE					= &H1				'&H1&
     CONST TPM_RIGHTBUTTON_CBar			= &H2				'&H2&
'Const TPM_CENTERALIGN		As Long = &H4&
'Const TPM_RIGHTALIGN		As Long = &H8&
'Const TPM_VCENTERALIGN		As Long = &H10&
'Const TPM_BOTTOMALIGN		As Long = &H20&
'Const TPM_VERTICAL			As Long = &H40&
'Const TPM_NONOTIFY			As Long = &H80&
     CONST TPM_RETURNCMD_CBar	AS LONG = &H100&
'Const TPM_HORPOSANIMATION	As Long = &H400&
'Const TPM_HORNEGANIMATION	As Long = &H800&
'Const TPM_VERPOSANIMATION	As Long = &H1000&
'Const TPM_VERNEGANIMATION	As Long = &H2000&
     CONST TPM_NOANIMATION_CBar	AS LONG = &H4000&

     DECLARE FUNCTION TrackPopupMenuEx_CBar LIB "user32" ALIAS "TrackPopupMenuEx" ( _
      BYVAL hMenu AS LONG, _
      BYVAL wFlags AS LONG, _
      BYVAL x AS LONG, BYVAL y AS LONG, _
      BYVAL hWnd AS LONG, _
      BYVAL lptpm AS LONG) AS LONG
' // Fin - Gère les menus popup

' Gère les boîtes de texte et les comboboxes
'Const HWND_TOPMOST			= -1
'Const HWND_NOTOPMOST		= -2
     CONST SWP_NOSIZE_CBar		= &H1
'Const SWP_NOMOVE			= &H2
     CONST SWP_NOACTIVATE_CBar	= &H10
'Const SWP_SHOWWINDOW		= &H40
     CONST SWP_NOZORDER_CBar		= &H4

     DECLARE SUB SetWindowPos_CBar LIB "user32" ALIAS "SetWindowPos" ( _
      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)
' // Fin - Gère les boîtes de texte et les comboboxes

' Méthode pour ajouter une icône à l'item d'un menu
' //Fin


'Const HTCLIENT_CBar		= 1
     CONST HTCAPTION_CBar		= 2
     CONST WM_NCLBUTTONDOWN_CBar = &HA1
'Const WM_NCLBUTTONUP_CBar	= &HA2
'Const WM_LBUTTONDOWN_CBar	= &H201
'Const WM_LBUTTONUP_CBar	= &H202
     DECLARE FUNCTION SendMessage_CBar LIB "user32" ALIAS "SendMessageA" ( _
      BYVAL hwnd AS LONG, _
      BYVAL wMsg AS LONG, _
      BYVAL wParam AS LONG, _
      lParam AS LONG) AS LONG

     CONST VK_LBUTTON_CBar AS LONG = &H1
'Const VK_RBUTTON_CBar As Long = &H2

     DECLARE FUNCTION GetAsyncKeyState_CBar LIB "user32" _
      ALIAS "GetAsyncKeyState" ( _
      BYVAL vKey AS LONG) _
      AS INTEGER

     DIM BMPCache	AS QBITMAP
'	BMPCache.BMPHandle = BG_BMP

     DIM mnuItemExceed(False)	AS QMENUITEM

     DIM CB_ItemCount AS INTEGER
     CB_ItemCount = False

     SUB RedimCBItems
	' Redimensionne les objets
	' cette méthode devrait permettre de réduire les reources utilisées
	' par la barre d'outil et augmenter le nombre de btns possibles...
      REDIM mnuItemExceed(CB_ItemCount)		AS QMENUITEM
     END SUB

'Declare Sub GetInfo (iIndex As String) 'Integer)

' Event Template pour les nouveaux événements MouseLeave et MouseEnter
     DECLARE SUB CBarOnMouseEnter_EventTemplate (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER, ItemIndex AS INTEGER, Me AS QPANEL)
     DECLARE SUB CBarOnMouseLeave_EventTemplate (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER, Me AS QPANEL)
     DECLARE SUB CBarOnChange_EventTemplate (ItemIndex AS INTEGER, Me AS QPANEL)


     TYPE QCoolBarXP EXTENDS QPANEL
PUBLIC:
      ItemCount			AS INTEGER		' Nombre d'item
      ItemsWidth			AS INTEGER
	'ItemsHeight		As Integer
      Item(29)			AS STRING		' Titre de chaque item
	'CustBG			As QBitmap			' Image de fond
	'CustGrip		As QBitmap			' Image de la "Grippe"
	'CustSkin		As QBitmap			' Image de l'enjolivure

      imgLA			AS QIMAGELIST		' ImgLst des btns Actifs
	'imgLD			AS QImageList		' ImgLst des btns Inactifs
	'imgLS			AS QImageList		' ImgLst des btns Sélectionnés
	'imgLH			AS QImageList		' ImgLst des btns Survollés
	'CollectionBMP	AS QBitmap			' Une collection d'image de tous les btns

PRIVATE:
      DragTimer			AS QTIMER
      FreePanelL			AS QPANEL		' Paneau sur lequel repose l'image de la barre d'outil
      FreePanelM			AS QPANEL		' ...
      FreePanelR			AS QPANEL		' Paneau sur lequel repose l'image du menu lorsque la taille est réduite
      BtnCache			AS QBITMAP		' Garde en mémoire l'image de la barre pour un affichage plus rapide
      CanvasL				AS QCANVAS		' Gestion de de l'événement OnPaint
      CanvasR				AS QCANVAS		' Gestion de de l'événement OnPaint
      CanvasLMsg			AS INTEGER
      ImageL				AS QIMAGE		' Image sur laquelle est dessiné la barre d'outil
      ImageR				AS QIMAGE		' Image sur laquelle est dessiné le menu lorsque la taille est réduite
      ImageLH				AS QIMAGE		' Image affichée lorsqu'un item est survolé ou sélectionné
      ImageRH				AS QIMAGE		' Image affichée lorsque le menu est survolé ou sélectionné
	'Fond				As QImage
      CoolBtnBMP			AS QBITMAP
      CoolBtnBMPE			AS QBITMAP
      ItemLeft(6)			AS INTEGER
      ItemWidth(6)		AS INTEGER
      ShowBtnCapt(6)		AS INTEGER
      ShowBtnCaptAll		AS INTEGER
      LastItemLeft		AS INTEGER
      LastItemTop			AS INTEGER
      ItemGroup(6)		AS INTEGER
      GroupAllowAllUp(6)	AS INTEGER		' Ici ce n'est pas l'item, mais l'index du group qui est passé comme argument
      ItemEnabled(6)		AS INTEGER
      ItemDown(6)			AS INTEGER
      wasHideGrip			AS INTEGER		' Je crois que c'est complètement obselèt maintenant
      wasHideCaption		AS INTEGER		' Je crois que c'est complètement obselèt maintenant
      GripWidth			AS INTEGER		' Largeur de la "Grippe"
      GripHeight			AS INTEGER		' Hauteur de la "Grippe"
      CaptionWidth		AS INTEGER		' Largeur du titre de la barre
      CaptionHeight		AS INTEGER		' Hauteur du titre de la barre (En réalité il sagit de la position suppérieur)
      isExceedWidth		AS INTEGER
      isExceedHeight		AS INTEGER
      isPaintReady		AS INTEGER
      ForceRePaint		AS INTEGER
      ForceEvalPos		AS INTEGER
      BMPCache2			AS QBITMAP
      ItemPopupHnd(6)		AS LONG
      mnuExceed			AS QPOPUPMENU	' ...
      mnuItemExceedIndex(6) AS INTEGER
      mnuItemCount		AS INTEGER		' ...
      ED_Count			AS INTEGER		' Nombre de contrôle Edit
      ED_Ctrl(6)			AS LONG
      ED_AfterIndex(6)	AS INTEGER
      ED_Left(6)			AS INTEGER
      ED_Width(6)			AS INTEGER
      ED_Height(6)		AS INTEGER
	'ED_BG(6)			As QImage
      CB_Count			AS INTEGER		' Nombre de contrôle ComboBox
      CB_Ctrl(6)			AS LONG
      CB_AfterIndex(6)	AS INTEGER
      CB_Left(6)			AS INTEGER
      CB_Width(6)			AS INTEGER
      CB_Height(6)		AS INTEGER
	'CB_BG(6)			As QImage

PUBLIC:
	'Height				As Integer	PROPERTY SET SetHeight
	'Width				As Integer	PROPERTY SET SetWidth
      DisableXPTheme		AS INTEGER	' Propriété					' Désactive le Thème XP
      DisableXPThemeBG	AS INTEGER	' Propriété					' Désactive le fond XP
      DisableBG			AS INTEGER	' Propriété					' Désactive le fond si custBG.Empty = False
      Style				AS INTEGER	' Propriété
	'BtnsSpacing		As Integer								' Espace entre les items
      HideGrip			AS INTEGER	PROPERTY SET SetHideGrip	' Affiche/Masque la "Grippe"
      HideCaption			AS INTEGER	PROPERTY SET SetHideCaption	' Affiche/Masque le titre de la barre
      CAPTION				AS STRING	PROPERTY SET SetCaption
	'ItemsWidth			As Integer	PROPERTY SET SetItemsWidth	' Dimension des items de la barre
      Orientation			AS INTEGER	PROPERTY SET SetOrientation	' Orientation de la barre (False. Horz, True. Vert)

	'BevelWidth			As Integer PROPERTY SET SetBevelWidth	' ...
      BorderStyle			AS INTEGER PROPERTY SET SetBorderStyle	' ...

	'OnMouseLeave	AS EVENT(CBarOnMouseLeave_EventTemplate)	' La souris quitte la barre
	'OnMouseEnter	AS EVENT(CBarOnMouseEnter_EventTemplate)	' La souris entre et se déplace sur la barre
      OnChange		AS EVENT(CBarOnChange_EventTemplate)		' Un btn est cliqué
	'Nouvelles propriétés
	'qqchose as qqchose Property Set SetQqChose

      WITH This
PRIVATE:
       FUNCTION TextWidth(text AS STRING) AS INTEGER:	Result = .BtnCache.TextWidth(text)
       END FUNCTION
       FUNCTION TextHeight(text AS STRING) AS INTEGER:	Result = .BtnCache.TextHeight(text)
       END FUNCTION

       SUB pShowPopup (iPopup AS LONG, X AS INTEGER, Y AS INTEGER)
        DIM sMenu AS LONG
        DIM sStyle AS LONG
        sStyle = TPM_RETURNCMD_CBar
		' Si ODMenuXP est détecté
        $IFNDEF __RQGETVERSION2
			'If isXP_QTBtn = False Then _
         sStyle = sStyle OR TPM_LEFTBUTTON_CBar OR TPM_RIGHTBUTTON_CBar
        $ELSE
			'If isXP_QTBtn = False Then _
         sStyle = sStyle OR TPM_LEFTBUTTON_CBar OR TPM_RIGHTBUTTON_CBar OR TPM_NOANIMATION_CBar
        $ENDIF
        sMenu = TrackPopupMenuEx_CBar( _
         .ItemPopupHnd(iPopup), _
         sStyle, _
         X, Y, _
         This.Handle, 0&)
       END SUB
       SUB EvalBtnPos
        IF ((.wasHideGrip <> .HideGrip) OR (.wasHideCaption <> .HideCaption) OR .ForceEvalPos) AND _
         .ItemCount > False THEN

         .ItemLeft(False) = False
         .ItemWidth(False) = False

         DIM I AS INTEGER
         DIM SepBefore AS INTEGER
         FOR I = False TO .ItemCount -True
          IF .Item(I) = "-" THEN
           .ItemWidth(I) = 5
           SepBefore ++
          ELSE
           .ItemWidth(I) = .ItemsWidth
           IF .imgLA.Count > False AND (I -SepBefore < .imgLA.Count) THEN
            .ItemWidth(I) = .imgLA.Width +8 +_
             IIF(.Orientation = False AND (.ShowBtnCapt(I) = True OR .ShowBtnCaptAll = True), _
             .TextWidth(.Item(I)) +4, _
             False) +_
             IIF(.ItemPopupHnd(I), 12, False)
           END IF
          END IF
         NEXT I
         SepBefore = False
         IF .HideGrip = False  THEN _
          .ItemLeft(False) = .ItemLeft(False) +8
         IF .HideCaption = False AND .CAPTION <> "" THEN _
          .ItemLeft(False) = .ItemLeft(False) +.CaptionWidth +4

         .wasHideGrip = .HideGrip
         .wasHideCaption = .HideCaption

         DIM J AS INTEGER
         IF .ED_Count > False THEN
          FOR J = False TO .ED_Count -True
           IF .ED_AfterIndex(J) = -True THEN
            .ED_Left(J) = .ItemLeft(False)
            .ItemLeft(False) = .ItemLeft(False) +.ED_Width(J) +6
            EXIT FOR
           END IF
          NEXT J
         END IF
         IF .CB_Count > False THEN
          FOR J = False TO .CB_Count -True
           IF .CB_AfterIndex(J) = -True THEN
            .CB_Left(J) = .ItemLeft(False)
            .ItemLeft(False) = .ItemLeft(False) +.CB_Width(J) +6
            EXIT FOR
           END IF
          NEXT J
         END IF

         FOR I = False TO .ItemCount -True
          .ItemLeft(I +True) = .ItemLeft(I) +.ItemWidth(I)
          IF .ED_Count > False THEN
           FOR J = False TO .ED_Count -True
            IF .ED_AfterIndex(J) = I THEN
             .ED_Left(J) = .ItemLeft(I +True)
             .ItemLeft(I +True) = .ItemLeft(I +True) +.ED_Width(J) +6
             SetWindowPos_CBar (.ED_Ctrl(J), False, _
              .ED_Left(J), (.FreePanelL.Height -.ED_Height(J)) \2, _
              False, False, _
              SWP_NOACTIVATE_CBar OR SWP_NOSIZE_CBar OR SWP_NOZORDER_CBar)
             EXIT FOR
            END IF
           NEXT J
          END IF
          IF .CB_Count > False THEN
           FOR J = False TO .CB_Count -True
            IF .CB_AfterIndex(J) = I THEN
             .CB_Left(J) = .ItemLeft(I +True)
             .ItemLeft(I +True) = .ItemLeft(I +True) +.CB_Width(J) +6
             SetWindowPos_CBar (.CB_Ctrl(J), False, _
              .CB_Left(J), (.FreePanelL.Height -.CB_Height(J)) \2, _
              False, False, _
              SWP_NOACTIVATE_CBar OR SWP_NOSIZE_CBar OR SWP_NOZORDER_CBar)
             EXIT FOR
            END IF
           NEXT J
          END IF
         NEXT I
        END IF
        IF .Orientation THEN
         .LastItemLeft	= False
         .LastItemTop	= .ItemLeft(.ItemCount -True) +(.ItemWidth(.ItemCount -True) \.66)
        ELSE
         .LastItemLeft	= .ItemLeft(.ItemCount -True) +(.ItemWidth(.ItemCount -True) \.66)
         .LastItemTop	= False
        END IF
       END SUB
PUBLIC:

       SUB RePaint
        DIM I AS INTEGER, J AS INTEGER
        DIM R AS RECT_QTBtn

        IF .isPaintReady = True OR .ForceRePaint = True THEN
         .isPaintReady = 2
         IF .Orientation THEN
          .LastItemLeft	= False
          .LastItemTop	= .ItemLeft(.ItemCount -True) +(.ItemWidth(.ItemCount -True) \.66)
         ELSE
          .LastItemLeft	= .ItemLeft(.ItemCount -True) +(.ItemWidth(.ItemCount -True) \.66)
          .LastItemTop	= False
         END IF


         IF .Orientation THEN
          .BMPCache2.Width	= .FreePanelL.Width
          .BMPCache2.Height	= .ItemLeft(.ItemCount -True) +.ItemWidth(.ItemCount -True)
         ELSE
          .BMPCache2.Width	= .ItemLeft(.ItemCount -True) +.ItemWidth(.ItemCount -True)
          .BMPCache2.Height	= .FreePanelL.Height
         END IF
			'GetInfo (.Caption +"::Paint  " +STR$(.BMPCache2.Width) +", " +STR$(.BMPCache2.Height))
			'.BMPCache2.FillRect (False, False, .BMPCache2.Width, .BMPCache2.Height, This.Color)
			'.BMPCache2.Transparent = True
			'.BMPCache2.TransparentColor = This.Color
         DIM sepBefore AS INTEGER
         sepBefore = False

         IF isXP_QTBtn = False OR .DisableXPTheme = True THEN _
          .BMPCache2.FillRect (False, False, .BMPCache2.Width, .BMPCache2.Height, This.COLOR)


         IF .HideGrip = False THEN

          IF isXP_QTBtn AND .DisableXPTheme = False THEN
           XPPart ( xpt_ReBar, True, _
            This.Orientation, _
            True, _
            This.COLOR, _
            This.BMPCache2, This.Handle)
          ELSEIF .DisableBG = False AND custGrip.Empty = False THEN
           DIM oldGripH AS INTEGER
           custGrip.TransparentColor	= custGrip.Pixel(False, False)
           custGrip.Transparent		= True
					'custGrip.Height = 5
           .BMPCache2.Draw(False, 5, _
            custGrip.BMP)
           oldGripH		= custGrip.Height
					'For I = False To (.BMPCache2.Height -custGrip.Height) \custGrip.Height
           custGrip.Height = .BMPCache2.Height -custGrip.Height -10
           .BMPCache2.Draw(False, oldGripH +5, _
            custGrip.BMP)
           custGrip.Height	= oldGripH
					'Next I
          ELSE
           IF .Orientation THEN
            IF .Style = False THEN
             SetRect_CBar ( R, _
              2, _
              2, _
              .BMPCache2.Width -3, _
              5)
             DrawEdge_CBar (.BMPCache2.Handle, R, BDR_RAISEDINNER_CBar, BF_RECT_CBar)
            ELSE
             FOR I = 3 TO (.ClientWidth -5) STEP 3
              .BMPCache2.Line	 ( I, 2, I, 4, -2147483632 ) 'clBtnShadow
             NEXT I
            END IF
           ELSE
            IF .Style = False THEN
             SetRect_CBar ( R, _
              2, _
              2, _
              5, _
              .BMPCache2.Height -3)
             DrawEdge_CBar (.BMPCache2.Handle, R, BDR_RAISEDINNER_CBar, BF_RECT_CBar)
            ELSE
             FOR I = 3 TO (.ClientHeight -5) STEP 3
              .BMPCache2.Line	 ( 2, I, 4, I, -2147483632 ) 'clBtnShadow
             NEXT I
            END IF
           END IF
          END IF
         END IF
         IF .HideCaption = False AND .CAPTION <> "" THEN
          IF .Orientation THEN
           .CaptionHeight = (.ClientWidth -.TextHeight(.CAPTION)) \2
					'.CaptionWidth = .TextWidth(.Caption) +4

           DIM RotCapCache AS QBITMAP
           RotCapCache.Height		= .TextWidth(.CAPTION) +4 '.TextHeight(.Caption) +4
           RotCapCache.Width		= .TextWidth(.CAPTION) +4
           RotCapCache.FillRect	(False, False, RotCapCache.Height, RotCapCache.Width, This.COLOR)
           RotCapCache.TextOut		(False, False, .CAPTION, .Font.COLOR, -True)
           RotCapCache.Rotate		(25, 25, 90)
           RotCapCache.Width		= .TextHeight(.CAPTION) +4
           RotCapCache.TransparentColor = RotCapCache.Pixel(False, False)
           RotCapCache.Transparent	= True
           This.BMPCache2.Draw		((.ClientWidth -RotCapCache.Width) \2, 8, RotCapCache.BMP)
          ELSE
           .CaptionHeight		= (.ClientHeight -.TextHeight(.CAPTION)) \2
					'.CaptionWidth		= .TextWidth(.Caption) +4
           .BMPCache2.TextOut	(.GripWidth +2, .CaptionHeight, .CAPTION, .Font.COLOR, -True)
          END IF
         END IF

         IF .ItemCount > False THEN
          DIM imgLBK AS QBITMAP
          FOR I = False TO .ItemCount -True

           IF .Item(I) <> "-" THEN
						'If .Orientation Then
						'Else
						'End If
            .CoolBtnBMP.Width = .ItemWidth(I)
            .CoolBtnBMP.Height = .ItemsWidth

						'CoolBtnI
            IF .imgLA.Count > False AND (I -SepBefore) < .imgLA.Count THEN _
             imgLBK.BMP	= .imgLA.GetBMP(I -sepBefore)

            .CoolBtnBMP.Font.COLOR = IIF (.ItemEnabled(I), This.Font.COLOR, clGrayText)

            Fast_CBar( xpt_ToolBarBtn, _
             True, _
             IIF(.ItemDown(I), 4, IIF(.ItemEnabled(I), False, 3)), _
             This.CoolBtnBMP, _
             IIF(.Orientation = False AND (.ShowBtnCapt(I) = True OR .ShowBtnCaptAll = True), _
             .Item(I), ""), _
             IIF(.imgLA.Count > False AND (I -SepBefore) < .imgLA.Count, imgLBK.Width +2, False), _
             This.CoolBtnBMP.Font.Name, _
             IIF(.ItemPopupHnd(I), True, False), _
             False, _
             .Style, _
             .DisableXPTheme, _
             This.Handle)

            IF .imgLA.Count > False AND (I -sepBefore) < .imgLA.Count THEN
             DIM decal AS INTEGER
             decal = IIF(.ItemDown(I), True, False)

             imgLBK.BMP				= .imgLA.GetBMP(I -sepBefore)
             imgLBK.TransparentColor	= imgLBK.Pixel(False, False) 'clWhite
             imgLBK.Transparent		= True

             IF .ItemEnabled(I) = False THEN 'and (.imgLD.Count = False or (I +True > .imgLD.Count)) Then
              DIM alBMP AS QBITMAP
              alBMP.Width		= imgLBK.Width
              alBMP.Height	= imgLBK.Width
              alBMP.FillRect	(False, False, imgLBK.Width, imgLBK.Height, This.COLOR)

              BF_CBar.BlendOp				= AC_SRC_OVER_CBar
              BF_CBar.BlendFlags			= False
              BF_CBar.SourceConstantAlpha	= 84
              BF_CBar.AlphaFormat			= False

								' Copie la structure BLENDFUNCTION dans un Long
              RtlMoveMemory_CBar lBF_CBar, BF_CBar, 4
              AlphaBlend_CBar (alBMP.Handle, _
               False, False, _
               imgLBK.Width, imgLBK.Height, _
               imgLBK.handle, _
               False, False, _
               imgLBK.Width, imgLBK.Height, _
               lBF_CBar)
              imgLBK.BMP				= alBMP.BMP
              imgLBK.TransparentColor	= imgLBK.Pixel(False, False) 'clWhite
              imgLBK.Transparent		= True
             END IF

             IF .Orientation = False AND (.ShowBtnCapt(I) = True OR .ShowBtnCaptAll = True) THEN
              .CoolBtnBMP.Draw ( 4 +decal, _
               ((This.CoolBtnBMP.Height -imgLBK.Height) \2) +decal, _
               imgLBK.BMP)
             ELSE
              .CoolBtnBMP.Draw ( ((This.CoolBtnBMP.Width -imgLBK.Width) \2) +decal, _
               ((This.CoolBtnBMP.Height -imgLBK.Height) \2) +decal, _
               imgLBK.BMP)
             END IF
            END IF

            .BMPCache2.Draw (IIF(.Orientation, False, .ItemLeft(I)), _
             IIF(.Orientation, .ItemLeft(I), False), _
             .CoolBtnBMP.BMP)

           ELSE
            IF .Orientation THEN
             SetRect_CBar ( R, _
              False +IIF(.BevelWidth = False, 2, False), _
              .ItemLeft(I) +True, _
              This.FreePanelL.Width -3, _
              .ItemLeft(I) +IIF(.Style < 2 OR isXP_QTBtn = False, 3, 2))
            ELSE
             SetRect_CBar ( R, _
              .ItemLeft(I) +True, _
              2, _
              .ItemLeft(I) +IIF(.Style < 2 OR isXP_QTBtn = False, 3, 2), _
              This.FreePanelL.Height -3)
            END IF
            DrawEdge_CBar (.BMPCache2.Handle, R, BDR_SUNKENOUTER_CBar, BF_RECT_CBar)
            sepBefore ++

           END IF
          NEXT I
         END IF
        END IF
       END SUB
PRIVATE:
       SUB CanvasPaint (Me AS QCANVAS)
        STATIC fixHotUp AS INTEGER
		' Corrige l'optimisation d'oh!
		' et voilà aucun scintillement et le redimensionnment est constant
        IF .isPaintReady = False THEN _
         .isPaintReady = True
        IF .CanvasL.Width = 2 THEN
         fixHotUp = True
        ELSEIF fixHotUp = True THEN
         fixHotUp = False
        ELSE
         .ImageLH.Visible = False
         fixHotUp = False
        END IF
		'wasBtn = -True ' devra être une propriété de la barre pour résoudre le problème d'apparission
						' lorsque la fenêtre a perdue le focus et que l'ont tente de sélectionner le même
						' item
		' Dessine le fond de la barre
		'BMPCache.Transparent = False
        BMPCache.Width	= This.ClientWidth	'This.Width
        BMPCache.Height	= This.ClientHeight	'This.Height
        IF .DisableXPThemeBG = False THEN
         XPPart (xpt_ReBar, 6, _
          False, _
          True, _
          This.COLOR, _
          BMPCache, This.Handle)
        ELSEIF custBG.Empty OR .DisableBG = True THEN
         BMPCache.FillRect ( _
          False, False, _
          BMPCache.Width, BMPCache.Height, _
          This.COLOR)
        ELSE
         DIM sR AS QRECT
         sR.Left		= False
         sR.Top		= False
         sR.Right	= BMPCache.Width
         sR.Bottom	= BMPCache.Height
         BMPCache.StretchDraw ( _
          sR, _
          custBG.BMP)
        END IF

        IF .BorderStyle THEN
         DIM R AS RECT_QTBtn
         SetRect_CBar ( R, _
          False, _
          False, _
          BMPCache.Width, _
          BMPCache.Height)
         DrawEdge_CBar (BMPCache.Handle, R, BDR_RAISEDINNER_CBar, BF_RECT_CBar)
        END IF

        IF .Orientation = False THEN
         IF .FreePanelR.Visible = False AND .Width < .LastItemLeft THEN
          .FreePanelR.Height	= .FreePanelL.Height
          .FreePanelR.Visible	= True
          .isExceedWidth		= 12
         ELSEIF .FreePanelR.Visible = True AND .Width > .LastItemLeft THEN
          .FreePanelR.Visible	= False
          .isExceedWidth		= False
          .isExceedHeight		= False
         END IF
        ELSEIF .Orientation THEN
         IF .FreePanelR.Visible = False AND .Height < .LastItemTop THEN
          .FreePanelR.Width	= .FreePanelL.Width
          .FreePanelR.Visible	= True
          .isExceedHeight		= 12
         ELSEIF .FreePanelR.Visible = True AND .Height > .LastItemTop THEN
          .FreePanelR.Visible	= False
          .isExceedWidth		= False
          .isExceedHeight		= False
         END IF
        END IF
        IF .FreePanelR.Visible THEN
         IF .Orientation THEN
          IF .ClientHeight > 12 THEN _
           .FreePanelR.Top = .ClientHeight -12
         ELSE
          IF .ClientWidth > 12 THEN _
           .FreePanelR.Left = .ClientWidth -12
         END IF
        END IF
        IF .Orientation THEN
         .FreePanelL.Width = .ClientWidth -.isExceedWidth
			'.FreePanelL.Height = .ClientHeight -.isExceedHeight -2
        ELSE
         .FreePanelL.Width = .ClientWidth -.isExceedWidth -2
			'.FreePanelL.Height = .ClientHeight -.isExceedHeight
        END IF
        .FreePanelL.Height = .ClientHeight -.isExceedHeight
        IF .FreePanelL.Width <> False AND .FreePanelL.Height <> False THEN
         .BtnCache.Width		= This.FreePanelL.Width
         .BtnCache.Height	= This.FreePanelL.Height
         .ImageL.BMP			= This.BtnCache.BMP
			' // Dessine le fond de la barre
         BitBlt_QTBtn ( Me.Handle, _
          False, False, _
          Me.Width, Me.Height, _
          BMPCache.Handle, _
          False, False, _
          SrcCopy_QTBtn)
         IF .Orientation THEN
          BitBlt_QTBtn ( This.ImageL.Handle, _
           False, False, _
           This.ImageL.Width, This.ImageL.Height, _
           BMPCache.Handle, _
           False, True, _
           SrcCopy_QTBtn)
         ELSE
          BitBlt_QTBtn ( This.ImageL.Handle, _
           False, False, _
           This.ImageL.Width, This.ImageL.Height, _
           BMPCache.Handle, _
           True, False, _
           SrcCopy_QTBtn)
         END IF
			' // Dessine les boutons sur le fond de la barre
         IF .isPaintReady < 2 THEN _
          CALL This.RePaint
         IF .isPaintReady = 2 THEN
          IF .DisableXPThemeBG = False OR custBG.Empty = False THEN
           TransparentBlt_QTBtn ( .ImageL.Handle, _
            False, False, _
            .BMPCache2.Width, .BMPCache2.Height, _
            .BMPCache2.Handle, _
            False, False, _
            .BMPCache2.Width, .BMPCache2.Height, _
            .BMPCache2.Pixel(False, False))
          ELSE
           BitBlt_QTBtn ( .ImageL.Handle, _
            False, False, _
            .BMPCache2.Width, .BMPCache2.Height, _
            .BMPCache2.Handle, _
            False, False, _
            SrcCopy_QTBtn)
          END IF
         END IF
			'GetInfo (.Caption +"::Paint  " +STR$(.isPaintReady) +", " +STR$(.ForceRePaint))
         .BtnCache.BMP = 0&
        END IF
        IF .FreePanelR.Visible THEN
         .CoolBtnBMPE.Width	= This.FreePanelR.Width
         .CoolBtnBMPE.Height	= This.FreePanelR.Height

			' Exceed Btn
         Fast_CBar( xpt_ToolBarBtn, _
          IIF(.Orientation, 5, 4), _
          False, _
          This.CoolBtnBMPE, _
          "", _
          False, _
          "", _
          False, _
          False, _
          .Style, _
          .DisableXPTheme, _
          This.Handle)
         .CoolBtnBMPE.TextOut(((12 -.CoolBtnBMPE.TextWidth("»")) \2) +True, _
          -6, _
          "»", _
          .Font.COLOR, _
          -True)

         IF .Orientation THEN
          BitBlt_QTBtn ( This.ImageR.Handle, _
           False, False, _
           This.FreePanelR.Width, This.FreePanelR.Height, _
           BMPCache.Handle, _
           False, This.FreePanelR.Top, _
           SrcCopy_QTBtn)
         ELSE
          BitBlt_QTBtn ( This.ImageR.Handle, _
           False, False, _
           This.FreePanelR.Width, This.FreePanelR.Height, _
           BMPCache.Handle, _
           This.FreePanelR.Left, False, _
           SrcCopy_QTBtn)
         END IF
			' //
         TransparentBlt_QTBtn ( .ImageR.Handle, _
          False, False, _
          .ImageR.Width, .ImageR.Height, _
          .CoolBtnBMPE.Handle, _
          False, False, _
          .CoolBtnBMPE.Width, .CoolBtnBMPE.Height, _
          .CoolBtnBMPE.Pixel(False, False))
        END IF
        IF .BorderStyle THEN
			'Dim R As RECT_QTBtn
         IF .Orientation THEN
          SetRect_CBar ( R, _
           False, _
           -True, _
           .Width, _
           .Height)
         ELSE
          SetRect_CBar ( R, _
           -True, _
           False, _
           .Width, _
           .ImageL.Height)
         END IF
         DrawEdge_CBar (.ImageL.Handle, R, BDR_RAISEDINNER_CBar, BF_RECT_CBar)
        END IF
        .BtnCache.Width		= True
        .BtnCache.Height	= True
		'BMPCache.BMP		= "" '0&
       END SUB

       SUB mnuItem_Click(Me AS QMENUITEM)
        IF Me.CAPTION <> "-" THEN
         IF .ItemGroup(Me.Tag) <> False THEN
          .ItemDown(Me.Tag) = IIF(.ItemDown(Me.Tag), False, True)
          .isPaintReady = False
          This.CanvasPaint (This.CanvasL)
         END IF
         CALLFUNC(This.OnChange, Me.Tag, This)
        END IF
       END SUB

PUBLIC:
	' == Ajout d'items à la barre ==
       SUBI AddItems (...)
        IF PARAMSTRCOUNT > False THEN
         DIM I AS INTEGER
         .ItemCount = .ItemCount +PARAMSTRCOUNT	' Devrait être .ItemCount +ParamStrCount
         IF .ItemsWidth = False THEN
          IF .Orientation THEN
           .ItemsWidth = .FreePanelL.Width -2
           ELSE: .ItemsWidth = .FreePanelL.Height -2
          END IF
         END IF

         REDIM .ItemLeft(.ItemCount -True)			AS INTEGER
         REDIM .ItemWidth(.ItemCount -True)			AS INTEGER
			'ReDim .Item(.ItemCount -True)				As String	' Plantage du compilateur
         REDIM .ShowBtnCapt(.ItemCount -True)		AS INTEGER
         REDIM .ItemGroup(.ItemCount -True)			AS INTEGER
         REDIM .ItemEnabled(.ItemCount -True)		AS INTEGER
         REDIM .ItemDown(.ItemCount -True)			AS INTEGER
			'ReDim .ItemPopup(.ItemCount -True)			As QPopupMenu
         REDIM .ItemPopupHnd(.ItemCount -True)		AS LONG
			'ReDim .mnuItemExceed(.ItemCount -True)		As QMenuItem
         REDIM .mnuItemExceedIndex(.ItemCount -True)	AS INTEGER

         .ItemLeft(False)	= False	' Devrait être .ItemLeft(.ItemCount -ParamStrCount)
         .ItemWidth(False)	= False	' Devrait être .ItemWidth(.ItemCount -ParamStrCount)
         FOR I = True TO PARAMSTRCOUNT
          .mnuItemExceedIndex(I -True)		= CB_ItemCount
          mnuItemExceed(CB_ItemCount).CAPTION	= IIF(PARAMSTR$(I) = "", "...", PARAMSTR$(I))
          mnuItemExceed(CB_ItemCount).Tag		= I -True
          mnuItemExceed(CB_ItemCount).OnClick = This.mnuItem_Click
          .mnuExceed.AddItems (mnuItemExceed(CB_ItemCount))
				' Corrige les valeurs incorrrects
          .Item(I -True)			= PARAMSTR$(I)
          .ItemGroup(I -True)		= False
          .ItemEnabled(I -True)	= True
          .ItemDown(I -True)		= False
          .ItemPopupHnd(I -True)	= False
          .ShowBtnCapt(I -True)	= IIF(.ShowBtnCaptAll, True, False)
          IF PARAMSTR$(I) = "-" THEN
           .ItemWidth(I -True) = 5
          ELSE
           .ItemWidth(I -True) = .ItemsWidth +_
            IIF(.Orientation = False AND .ShowBtnCapt(I -True), _
            .TextWidth(PARAMSTR$(I)) +3, _
            False)
					'CoolBtnI
          END IF
          CB_ItemCount ++
          CALL RedimCBItems
         NEXT I
         IF .HideGrip = False THEN _
          .ItemLeft(False) = .ItemLeft(False) +8
         IF .HideCaption = False AND .CAPTION <> "" THEN _
          .ItemLeft(False) = .ItemLeft(False) +.CaptionWidth +4
         I = False
         FOR I = False TO .ItemCount -True
          .ItemLeft(I +True) = .ItemLeft(I) +.ItemWidth(I)
         NEXT I
         IF .isPaintReady = 2 THEN _
          CALL This.RePaint
			'.isPaintReady = False
        END IF
       END SUBI
	'SUBI DelItems (...)
	'END SUBI
       SUB AsignPopupToItem (Me AS QPOPUPMENU, iIndex AS INTEGER)
        IF .ItemCount = False THEN _
         EXIT SUB
        IF .Item(iIndex) <> "-" THEN
         .ItemPopupHnd(iIndex) = Me.Handle
        ELSE
         SHOWMESSAGE "Avertissement: vous tentez d'asigner un menu popup " +CHR$(10) +_
          "               à un item..."
        END IF
        .ForceEvalPos = True
        CALL This.EvalBtnPos
        .ForceEvalPos = False
        IF .isPaintReady = 2 THEN
         .ForceRePaint = True
         CALL This.RePaint
         .ForceRePaint = False
        END IF
       END SUB

       SUB InsertED_Ctrl (iAfter AS INTEGER, Me AS QEDIT)

        IF .Orientation = True THEN
         SHOWMESSAGE "Orientation = True n'est pas supporté !"
         EXIT SUB
        END IF

        REDIM .ED_Ctrl(.ED_Count)		AS LONG
        REDIM .ED_AfterIndex(.ED_Count)	AS INTEGER
        REDIM .ED_Left(.ED_Count)		AS INTEGER
        REDIM .ED_Width(.ED_Count)		AS INTEGER
        REDIM .ED_Height(.ED_Count)		AS INTEGER

        .ED_Count ++

        Me.Visible						= False
        Me.PARENT						= This.FreePanelL
        .ED_Ctrl(.ED_Count -True)		= Me.Handle
        .ED_Width(.ED_Count -True)		= Me.Width
        .ED_Height(.ED_Count -True)		= Me.Height
        .ED_AfterIndex(.ED_Count -True)	= iAfter
		' Appelle EvalPos
        .ForceEvalPos = True
        CALL This.EvalBtnPos
        .ForceEvalPos = False
        IF iAfter = -True OR (iAfter > -True AND iAfter < (.ItemCount -True)) THEN
         Me.Left	= .ED_Left(.ED_Count -True)
        ELSE
         Me.Left	= .ItemLeft(.ItemCount -True) +6
        END IF
        Me.Top		= (This.FreePanelL.Height -Me.Height) \2 '-True
		'.ED_Ctrl(.ED_Count -True) = Me.Handle
		'.ED_Left(.ED_Count -True) = Me.Left
        Me.PARENT	= This.FreePanelL
        Me.Visible	= True

        IF .isPaintReady = 2 THEN _
         CALL This.RePaint
       END SUB
       SUB InsertCB_Ctrl (iAfter AS INTEGER, Me AS QCOMBOBOX)

        IF .Orientation = True THEN
         SHOWMESSAGE "Orientation = True n'est pas supporté !"
         EXIT SUB
        END IF
        REDIM .CB_Ctrl(.CB_Count)		AS LONG
        REDIM .CB_AfterIndex(.ED_Count)	AS INTEGER
        REDIM .CB_Left(.CB_Count)		AS INTEGER
        REDIM .CB_Width(.CB_Count)		AS INTEGER
        REDIM .CB_Height(.CB_Count)		AS INTEGER

        .CB_Count ++

        .CB_Ctrl(.CB_Count -True) = Me.Handle
        .CB_Width(.CB_Count -True) = Me.Width
        .CB_Height(.CB_Count -True) = Me.Height
        .CB_AfterIndex(.CB_Count -True) = iAfter
		' Appelle EvalPos
        CALL This.EvalBtnPos
        IF iAfter = -True OR (iAfter > -True AND iAfter < (.ItemCount -True)) THEN
         Me.Left		= .CB_Left(.ED_Count -True)
        ELSE
         Me.Left		= .ItemLeft(.ItemCount -True) +6
        END IF
        Me.Top		= (This.FreePanelL.Height -Me.Height) \2 '-True
        Me.PARENT	= This.FreePanelL
		'.CB_Ctrl(.CB_Count -True) = Me.Handle
		'.CB_Left(.CB_Count -True) = Me.Left

        IF .isPaintReady = 2 THEN _
         CALL This.RePaint
       END SUB

       SUBI ItemsGroup (...)
		'... = ParamValCount
        DIM I AS INTEGER
        DIM modSepState AS INTEGER
        modSepState = False
        DIM Index AS INTEGER
        Index = IIF(PARAMVAL(True) <= False, False, PARAMVAL(True))

        IF PARAMVALCOUNT = True THEN
         FOR I = False TO .ItemCount -True
          IF .Item(I) <> "-" THEN
           .ItemGroup(I) = Index
           .GroupAllowAllUp(Index) = True
          END IF
         NEXT I
        ELSEIF PARAMVALCOUNT > True THEN
         FOR I = 2 TO PARAMVALCOUNT
          IF .Item(PARAMVAL(I)) <> "-" THEN
           .ItemGroup(PARAMVAL(I)) = Index
           .GroupAllowAllUp(Index) = True 'False
          ELSE
           modSepState ++
          END IF
         NEXT I
        ELSE
         SHOWMESSAGE "Erreur: paramètre(s) manquant(s) ou incorrect(s)"
        END IF
        IF modSepState THEN _
         SHOWMESSAGE "Avertissement: vous tentez de redéfinir le " +CHR$(10) +_
         "               groupe d'un séparateur..."
        IF .isPaintReady = 2 THEN _
         CALL This.RePaint
       END SUBI
       SUBI DefineGroupAllowAllUp (...)
        IF .isPaintReady = 2 THEN _
         CALL This.RePaint
       END SUBI
       SUBI ItemsDown (...)
		'... = ParamValCount
        DIM I AS INTEGER
        DIM modSepState AS INTEGER
        modSepState = False
        DIM Index AS INTEGER
        Index = IIF(PARAMVAL(True) <> False, True, False)

        IF PARAMVALCOUNT = True THEN
         FOR I = False TO .ItemCount -True
          IF .Item(I) <> "-" AND .ItemGroup(I) > False THEN _
           .ItemDown(I) = Index
         NEXT I
        ELSEIF PARAMVALCOUNT > True THEN
         FOR I = 2 TO PARAMVALCOUNT
          IF .Item(PARAMVAL(I)) <> "-" THEN
           IF .ItemGroup(PARAMVAL(I)) > False THEN _
            .ItemDown(PARAMVAL(I)) = Index
          ELSE
           modSepState ++
          END IF
         NEXT I
        ELSE
         SHOWMESSAGE "Erreur: paramètre(s) manquant(s) ou incorrect(s)"
        END IF
        IF modSepState THEN _
         SHOWMESSAGE "Avertissement: vous tentez de modifier l'état " +CHR$(10) +_
         "               enfoncé d'un séparateur..."
        IF .isPaintReady = 2 THEN _
         CALL This.RePaint
       END SUBI
       SUBI ItemsEnabled (...)
		'... = ParamValCount
        DIM I AS INTEGER
        DIM modSepState AS INTEGER
        modSepState = False

        IF PARAMVALCOUNT = True THEN
         FOR I = False TO .ItemCount -True
          IF .Item(I) <> "-" THEN _
           .ItemEnabled(I) = PARAMVAL(True)
         NEXT I
        ELSEIF PARAMVALCOUNT > True THEN
         FOR I = 2 TO PARAMVALCOUNT
          IF .Item(PARAMVAL(I)) <> "-" THEN
           .ItemEnabled(PARAMVAL(I)) = PARAMVAL(True)
					'GetInfo (.Caption +"::Enabled " +STR$(ParamVal(True)) +" Item " +STR$(ParamVal(I)))
          ELSE
           modSepState ++
          END IF
         NEXT I
        ELSE
         SHOWMESSAGE "Erreur: paramètre(s) manquant(s) ou incorrect(s)"
        END IF
        IF modSepState THEN _
         SHOWMESSAGE "Avertissement: vous tentez de modifier l'état " +CHR$(10) +_
         "               enfoncé d'un séparateur..."
        IF .isPaintReady = 2 THEN _
         CALL This.RePaint
       END SUBI
PRIVATE:
       EVENT CanvasL.OnPaint
        .CanvasLMsg = True
        This.CanvasPaint (This.CanvasL)
		'.CanvasLMsg = False
       END EVENT
       EVENT CanvasR.OnPaint
        DIM R AS RECT_QTBtn
        GetWindowRect_CBar (This.Handle, R)

		'CALLFUNC(.OnChange, .canvaslmsg, This)
        IF .CanvasLMsg = False OR R.Left < False THEN
         .CanvasLMsg = False
         This.CanvasPaint (This.CanvasL)
        END IF

        IF .Orientation THEN
         BitBlt_QTBtn ( .CanvasR.Handle, _
          False, False, _
          .CanvasR.Width, .CanvasR.Height, _
          BMPCache.Handle, _
          False, .FreePanelM.Top, _
          SrcCopy_QTBtn)
        ELSE
         BitBlt_QTBtn ( .CanvasR.Handle, _
          False, False, _
          .CanvasR.Width, .CanvasR.Height, _
          BMPCache.Handle, _
          .FreePanelM.Left, False, _
          SrcCopy_QTBtn)
        END IF

		'SetRect_CBar ( R, _
		'	-True, _
		'	False, _
		'	2, _
		'	.CanvasR.Height)
		'DrawEdge_CBar (.ImageL.Handle, R, BDR_RAISEDINNER_CBar, BF_RECT_CBar)

       END EVENT
       EVENT ImageL.OnMouseMove (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
        SetCapture_QTBtn This.Handle
       END EVENT
       EVENT ImageR.OnMouseMove (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
        SetCapture_QTBtn This.Handle
       END EVENT
       EVENT ImageLH.OnMouseMove (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
        SetCapture_QTBtn This.Handle
       END EVENT
       EVENT ImageRH.OnMouseMove (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
        SetCapture_QTBtn This.Handle
       END EVENT
       SUB DrawHotItemState (iIndex AS INTEGER, iState AS INTEGER, iMenuDown AS INTEGER)
        DIM SepBefore AS INTEGER
        sepBefore = False
        .ImageLH.Visible = False

        IF iIndex = -True THEN
			'.CoolBtnBMPE.Width		= .FreePanelL.Width		' Devrait être FreePanelR.Width n'est pas dimensionné correctement
			'.CoolBtnBMPE.Height	= .FreePanelL.Height	' Devrait être FreePanelR.Height n'est pas dimensionné correctement

			' Exceed Btn
         Fast_CBar( xpt_ToolBarBtn, _
          IIF(.Orientation, 5, 4), _
          iState, _
          This.CoolBtnBMPE, _
          "", _
          False, _
          "", _
          False, _
          False, _
          .Style, _
          .DisableXPTheme, _
          This.Handle)
         .CoolBtnBMPE.TextOut(((12 -.CoolBtnBMPE.TextWidth("»")) \2) +True, _
          -6, _
          "»", _
          .Font.COLOR, _
          -True)

         .ImageRH.BMP = .CoolBtnBMPE.BMP
         .ImageRH.Visible = True
        ELSEIF .ItemEnabled(iIndex) THEN
         DIM I AS INTEGER
         FOR I = False TO iIndex
          IF .Item(I) <> "-" THEN
          ELSE
           sepBefore ++
          END IF
         NEXT I

         DIM imgLBK AS QBITMAP
         .CoolBtnBMP.Width = .ItemWidth(iIndex)
         .CoolBtnBMP.Height = .ItemsWidth

			'CoolBtnI
         IF .imgLA.Count > False AND (iIndex -SepBefore) < .imgLA.Count THEN _
          imgLBK.BMP	= .imgLA.GetBMP(iIndex -sepBefore)


         .CoolBtnBMP.Font.COLOR = IIF (.ItemEnabled(I), This.Font.COLOR, clGrayText)

         Fast_CBar( xpt_ToolBarBtn, _
          True, _
          IIF(.ItemDown(iIndex) AND iState = True, 5, iState), _
          This.CoolBtnBMP, _
          IIF(.Orientation = False AND (.ShowBtnCapt(iIndex) = True OR .ShowBtnCaptAll = True), _
          This.Item(iIndex), ""), _
          IIF(.imgLA.Count > False AND (iIndex -SepBefore) < .imgLA.Count, imgLBK.Width +2, False), _
          This.CoolBtnBMP.Font.Name, _
          IIF(.ItemPopupHnd(iIndex), True +iMenuDown, False), _
          False, _
          .Style, _
          .DisableXPTheme, _
          This.Handle)

         DIM decal AS INTEGER
         decal = False
         IF (iState = 2 AND iMenuDown = False) OR .ItemDown(iIndex) THEN _
          decal = True
         IF .imgLA.Count > False AND (iIndex -sepBefore) < .imgLA.Count THEN
          imgLBK.BMP				= .imgLA.GetBMP(iIndex -sepBefore)
          imgLBK.TransparentColor	= imgLBK.Pixel(False, False) 'clWhite
          imgLBK.Transparent		= True
          IF .Orientation = False AND (.ShowBtnCapt(iIndex) = True OR .ShowBtnCaptAll = True) THEN
           .CoolBtnBMP.Draw( 4 +decal, _
            ((This.CoolBtnBMP.Height -imgLBK.Height) \2) +decal, _
            imgLBK.BMP)
          ELSE
           .CoolBtnBMP.Draw( ((This.CoolBtnBMP.Width -imgLBK.Width) \2) +decal, _
            ((This.CoolBtnBMP.Height -imgLBK.Height) \2) +decal, _
            imgLBK.BMP)
          END IF
         END IF

         IF .Orientation THEN
          .ImageLH.Left	= False
          .ImageLH.Top	= .ItemLeft(iIndex)
         ELSE
          .ImageLH.Left	= .ItemLeft(iIndex)
          .ImageLH.Top	= False
         END IF
         .CoolBtnBMP.TransparentColor	= .CoolBtnBMP.Pixel(False, False) ' Couleur par défaut  48163823
         .CoolBtnBMP.Transparent			= True
         .ImageLH.BMP					= .CoolBtnBMP.BMP
         .ImageLH.Transparent			= True
         .ImageLH.Visible				= True
        END IF
       END SUB
       EVENT OnMouseMove (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
        DIM curBtn AS INTEGER
        DIM ItemWidth AS INTEGER
        DIM I AS INTEGER
        DIM R AS RECT_QTBtn
        STATIC firstAction AS INTEGER
        STATIC wasBtn AS INTEGER
        STATIC PosX AS INTEGER, PosY AS INTEGER
        STATIC isHoverInsCtrl AS INTEGER
        DIM sepBefore AS INTEGER


        GetWindowRect_CBar (This.Handle, R)

        IF (GetCapture_QTBtn() = This.Handle AND PtInRect_CBar (R, Screen.MOUSEX, Screen.MOUSEY) = False) OR _
         isHoverInsCtrl = True THEN
         ReleaseCapture_QTBtn

         wasBtn = -True
         isHoverInsCtrl = False

         .ImageLH.Visible = False
         .ImageRH.Visible = False
			' le pseudo-evénement MOUSELEAVE
			'CALLFUNC(.OnMouseLeave, X, Y, Shift, This)
        ELSEIF (GetCapture_QTBtn() <> This.Handle) AND _
          (PosX <> X AND PosY <> Y) THEN
			' Verifie si la requete de relâcher la capture d'un QCBar est False
			'
			' Ce qui va aussi empêcher le btn de reprendre son état initial
			' lors d'une action...
          PosX = X
          PosY = Y

			' le pseudo-evénement MOUSEENTER
          SetCapture_QTBtn This.Handle
         ELSEIF .FreePanelR.Visible AND .Orientation AND _
           (Y => .ClientHeight -12 AND Y =< .ClientHeight) THEN
           .DrawHotItemState (-True, True, False)
           curBtn = -True
           wasBtn = -True
          ELSEIF .FreePanelR.Visible AND .Orientation = False AND _
            (X => .ClientWidth -12 AND X =< .ClientWidth) THEN
            .DrawHotItemState (-True, True, False)
            curBtn = -True
            wasBtn = -True
           ELSE
            .ImageRH.Visible = False
            DIM J AS INTEGER
            FOR I = False TO .ItemCount -True
             IF .Orientation THEN
              IF Y >= .ItemLeft(I) AND Y <= .ItemLeft(I) +.ItemWidth(I) THEN '.ItemLeft(I +True) Then
               curBtn = I
               IF .ED_Count > False THEN
                FOR J = False TO .ED_Count -True
                 IF Y >= .ED_Left(J) AND Y <= .ED_Left(J) THEN
                  curBtn = -True
                  wasBtn = -True
                  isHoverInsCtrl = True
                  EXIT FOR
                 END IF
                NEXT J
               END IF
               IF .CB_Count > False THEN
                FOR J = False TO .CB_Count -True
                 IF Y >= .CB_Left(J) AND Y <= .CB_Left(J) THEN
                  curBtn = -True
                  wasBtn = -True
                  isHoverInsCtrl = True
                  EXIT FOR
                 END IF
                NEXT J
               END IF
               EXIT FOR
              ELSE
               curBtn = -True
              END IF
             ELSE
              IF X >= .ItemLeft(I) AND X <= .ItemLeft(I) +.ItemWidth(I) THEN '.ItemLeft(I +True) Then
               curBtn = I
               IF .ED_Count > False THEN
                FOR J = False TO .ED_Count -True
                 IF X >= .ED_Left(J) AND X <= .ED_Left(J) THEN
                  curBtn = -True
                  wasBtn = -True
                  isHoverInsCtrl = True
                  EXIT FOR
                 END IF
                NEXT J
               END IF
               IF .CB_Count > False THEN
                FOR J = False TO .CB_Count -True
                 IF X >= .CB_Left(J) AND X <= .CB_Left(J) THEN
                  curBtn = -True
                  wasBtn = -True
                  isHoverInsCtrl = True
                  EXIT FOR
                 END IF
                NEXT J
               END IF
               EXIT FOR
              ELSE
               curBtn = -True
              END IF
             END IF
            NEXT I
            IF (curBtn > -True AND curBtn < .ItemCount) THEN
             IF firstAction = False OR (wasBtn <> curBtn OR wasBtn = -True) THEN
              firstAction = True
					'Application.ShowHint = False
					'If .Item(curBtn) = "-" Then .Hint = "" Else .Hint = .Item(curBtn)
					'Application.ShowHint = True

              IF .Orientation THEN
               IF (Y > .ItemLeft(curBtn) OR Y < .ItemLeft(curBtn) +.ItemWidth(curBtn)) _
                AND .Item(curBtn) <> "-" THEN
                .DrawHotItemState (curBtn, True, False)
               ELSE
                .ImageLH.Visible = False
               END IF
              ELSE
               IF (X > .ItemLeft(curBtn) OR X < .ItemLeft(curBtn) +.ItemWidth(curBtn)) _
                AND .Item(curBtn) <> "-" THEN
                .DrawHotItemState (curBtn, True, False)
               ELSE
                .ImageLH.Visible = False
               END IF
              END IF
             END IF
             wasBtn = curBtn
				'CALLFUNC(.OnMouseEnter, X, Y, Shift, curBtn, This)

				'GetInfo(CurBtn)
            ELSE
             .ImageLH.Visible = False
				'curBtn = -1
             IF .Orientation THEN
              IF (Y > .ItemLeft(.ItemCount -True) +.ItemWidth(.ItemCount -True) OR _
               Y < .ItemLeft(False)) AND wasBtn <> -True THEN
						'.Hint = ""
						'CALLFUNC(.OnMouseEnter, X, Y, Shift, curBtn, This)
               wasBtn = -True
              END IF
             ELSE
              IF (X > .ItemLeft(.ItemCount -True) +.ItemWidth(.ItemCount -True) OR _
               X < .ItemLeft(False)) AND wasBtn <> -True THEN
						'.Hint = ""
						'CALLFUNC(.OnMouseEnter, X, Y, Shift, curBtn, This)
               wasBtn = -True
              END IF

             END IF
				'GetInfo(CurBtn)
            END IF
           END IF
		'GetInfo (curBtn)
          END EVENT
          EVENT OnMouseDown (btn AS INTEGER, X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
           IF btn = False THEN
            IF .FreePanelR.Visible AND _
             ((.Orientation AND _
             (Y => .ClientHeight -12 AND Y =< .ClientHeight)) OR _
             (.Orientation = False AND _
             (X => .ClientWidth -12 AND X =< .ClientWidth))) THEN
             .DrawHotItemState (-True, 2, False)
             .mnuExceed.Popup(Screen.MOUSEX +(.FreePanelR.Left -X), _
              Screen.MOUSEY +(.ClientHeight -Y))
             .ImageRH.Visible = False
            ELSE
             DIM I AS INTEGER
             DIM curBtn AS INTEGER
             DIM R AS RECT_QTBtn
				'curBtn = -1
             FOR I = False TO .ItemCount -True
              IF .Orientation = False AND (X >= .ItemLeft(I) AND X <= .ItemLeft(I) +.ItemWidth(I)) THEN '.ItemLeft(I +True)) Then
               curBtn = I
               EXIT FOR
              ELSEIF .Orientation AND (Y >= .ItemLeft(I) AND Y <= .ItemLeft(I) +.ItemWidth(I)) THEN '.ItemLeft(I +True)) Then
               curBtn = I
               EXIT FOR
              ELSE
               curBtn = -True
              END IF
             NEXT I
             IF curBtn > -True THEN
              IF .ItemEnabled(curBtn) THEN
               IF (X > .ItemLeft(curBtn) OR X < .ItemLeft(curBtn) +.ItemWidth(curBtn)) _
                AND .Item(curBtn) <> "-" THEN
                IF .ItemPopupHnd(curBtn) THEN
                 IF X < .ItemLeft(curBtn) +.ItemWidth(curBtn) -11 THEN
                  .DrawHotItemState (curBtn, 2, False)
                 ELSE
                  .DrawHotItemState (curBtn, 2, True)
                  .pShowPopup(curBtn, _
                   Screen.MOUSEX +(.ItemLeft(curBtn) -X), _
                   Screen.MOUSEY +(This.Height -True -Y))
                  .ImageLH.Visible = False
                 END IF
                ELSE
                 .DrawHotItemState (curBtn, 2, False)
                END IF
               END IF
              END IF
             ELSEIF .HideGrip = False THEN
              IF .Orientation = False AND (X >= False AND X <= 7) AND _
               .Width > 29 THEN
               ReleaseCapture_QTBtn
               .DragTimer.Interval	= 50
               .DragTimer.Enabled	= True
               SendMessage_CBar(This.Handle, WM_NCLBUTTONDOWN_CBar, HTCAPTION_CBar, False)
              ELSEIF .Orientation AND (Y >= False AND Y <= 7) AND _
                .Height > 29 THEN
                ReleaseCapture_QTBtn
                .DragTimer.Interval	= 50
                .DragTimer.Enabled	= True
                SendMessage_CBar(This.Handle, WM_NCLBUTTONDOWN_CBar, HTCAPTION_CBar, False)
               END IF
              END IF
             END IF
            END IF
           END EVENT
           EVENT OnMouseUp (btn AS INTEGER, X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
            IF btn = False THEN
             IF .FreePanelR.Visible AND _
              ((.Orientation AND _
              (Y => .ClientHeight -12 AND Y =< .ClientHeight)) OR _
              (.Orientation = False AND _
              (X => .ClientWidth -12 AND X =< .ClientWidth))) THEN
              .DrawHotItemState (-True, True, False)
             ELSE
              DIM I AS INTEGER
              DIM curBtn AS INTEGER
              DIM R AS RECT_QTBtn
				'curBtn = -1
              FOR I = False TO .ItemCount -True
               IF .Orientation = False AND (X >= .ItemLeft(I) AND X <= .ItemLeft(I) +.ItemWidth(I)) THEN '.ItemLeft(I +True)) Then
                curBtn = I
                EXIT FOR
               ELSEIF .Orientation AND (Y >= .ItemLeft(I) AND Y <= .ItemLeft(I) +.ItemWidth(I)) THEN '.ItemLeft(I +True)) Then
                curBtn = I
                EXIT FOR
               ELSE
                curBtn = -True
               END IF
              NEXT I
              IF curBtn > -True THEN
					'GetInfo = 1003
               IF .ItemEnabled(curBtn) THEN
                DIM oldX AS INTEGER, _
                 oldY AS INTEGER
                oldX = Screen.MOUSEX
                oldY = Screen.MOUSEY
                IF (X > .ItemLeft(curBtn) OR X < .ItemLeft(curBtn) +.ItemWidth(curBtn)) _
                 AND .Item(curBtn) <> "-" THEN
                 IF .ItemGroup(curBtn) <> False THEN
                  .ItemDown(curBtn) = IIF(.ItemDown(curBtn), False, True)
                  .isPaintReady = False
                  This.CanvasPaint (This.CanvasL)
                 END IF
                 .DrawHotItemState (curBtn, True, False)
                END IF
                CALLFUNC(.OnChange, curBtn, This)
						' Si la position du curseur n'est pas celle mémorisée,
						' on suppose que la fenêtre a perdu son focus et on
						' masque l'item sélectionné
                IF oldX <> Screen.MOUSEX AND oldY <> Screen.MOUSEY THEN _
                 .ImageLH.Visible = False
               END IF
              END IF
             END IF
            END IF
           END EVENT
           EVENT mnuExceed.OnPopup
            IF .ItemCount THEN
             DIM I AS INTEGER
             FOR I = False TO .ItemCount -True
              IF .Orientation THEN
               IF .Height < (.ItemLeft(I) +(.ItemWidth(I) \.66)) THEN
                mnuItemExceed(This.mnuItemExceedIndex(I)).Visible = True
						'GetInfo (1009)
               ELSE
                mnuItemExceed(This.mnuItemExceedIndex(I)).Visible = False
						'GetInfo (1010)
               END IF
              ELSE
               IF .Width < (.ItemLeft(I) +(.ItemWidth(I) \.66)) THEN
                mnuItemExceed(This.mnuItemExceedIndex(I)).Visible = True
						'GetInfo (1009)
               ELSE
                mnuItemExceed(This.mnuItemExceedIndex(I)).Visible = False
						'GetInfo (1010)
               END IF
              END IF
              IF I = .ItemCount -True AND mnuItemExceed(This.mnuItemExceedIndex(I)).CAPTION = "-" THEN _
               mnuItemExceed(This.mnuItemExceedIndex(I)).Visible = False
             NEXT I
             $IFDEF _AMIB
              DIM sepBefore AS INTEGER
              sepBefore = False
              FOR I = False TO .ItemCount -True
               IF .Item(I) = "-" THEN
                sepBefore ++
               ELSE
                IF mnuItemExceed(This.mnuItemExceedIndex(I)).Visible = True THEN
                 BMPMenu.Width	= .imgLA.Width
                 BMPMenu.Height	= .imgLA.Height
                 BMPMenu.BMP		= .imgLA.GetBMP(I -sepBefore)
						'ClearMenuBitmap(This.mnuExceed, _
						'	mnuItemExceed(This.mnuItemExceedIndex(I)).Command, _
						'	False)
                 CreateMenuBitmap(This.mnuExceed, _
                  mnuItemExceed(This.mnuItemExceedIndex(I)).Command, _
                  False, _
                  BMPMenu)
                END IF
               END IF
              NEXT I
             $ENDIF
            END IF
           END EVENT
           EVENT DragTimer.OnTimer
            IF GetAsyncKeyState_CBar(VK_LBUTTON_CBar) = False THEN
             .Align				= .Align
             .DragTimer.Enabled	= False
            END IF
           END EVENT

PUBLIC:
           PROPERTY SET SetHideGrip(nState AS INTEGER)
            .HideGrip = nState
            IF .ItemCount > False THEN
             CALL This.EvalBtnPos
             IF .isPaintReady > False THEN
              .ForceRePaint = True
              CALL This.RePaint
              .ForceRePaint = False
             END IF
            END IF
           END PROPERTY
           PROPERTY SET SetHideCaption(nState AS INTEGER)
            .HideCaption = nState
            IF .ItemCount > False THEN
             CALL This.EvalBtnPos
             IF .isPaintReady > False THEN
              .ForceRePaint = True
              CALL This.RePaint
              .ForceRePaint = False
             END IF
            END IF
           END PROPERTY
           PROPERTY SET SetCaption(nCaption AS STRING)
            Super.CAPTION = ""
            .CAPTION = nCaption
            .CaptionWidth = .TextWidth (nCaption) +4
            .CaptionHeight = .TextHeight (nCaption)
            IF .ItemCount > False THEN
             .ForceEvalPos = True
             CALL This.EvalBtnPos
             .ForceEvalPos = False
             IF .isPaintReady > False THEN
              .ForceRePaint = True
              CALL This.RePaint
              .ForceRePaint = False
             END IF
            END IF
           END PROPERTY
	'PROPERTY SET SetItemsWidth(width as integer)
	'END PROPERTY
           PROPERTY SET SetOrientation(orientation AS INTEGER)
            .Orientation = orientation
            IF .Orientation THEN
             .FreePanelL.Align = True
             .FreePanelR.Align = 2
             .FreePanelR.Left = False
             .FreePanelR.Height = 12
             .FreePanelR.Width = .FreePanelL.Width
             .isExceedWidth = False
             .isExceedHeight = False
		'	.CanvasR.Visible = False
             .FreePanelM.Align = 2
            ELSE
             .FreePanelL.Align = 3
             .FreePanelR.Align = 4
             .FreePanelR.Top = False
             .FreePanelR.Height = .FreePanelL.Height
             .FreePanelR.Width = 12
             .isExceedWidth = False
             .isExceedHeight = False
		'	.CanvasR.Visible = True
             .FreePanelM.Align = 4
            END IF

            .CanvasL.Align = IIF(.Orientation, True, 3)
		'.CanvasR.Align = IIf(.Orientation, 2, 4)
            .GripWidth = IIF(.Orientation, 8, 5)

            .CoolBtnBMPE.Width = This.FreePanelR.Width
            .CoolBtnBMPE.Height = This.FreePanelR.Height
           END PROPERTY
	'PROPERTY SET SetBevelWidth(bw as integer)
	'	.BevelWidth = 0
	'	Super.BevelWidth = 0
	'END PROPERTY
           PROPERTY SET SetBorderStyle(bs AS INTEGER)
            .BorderStyle = bs
            Super.BorderStyle = 0
           END PROPERTY

           SUBI ItemsCaptionVisible (...)
		'... = ParamValCount
            DIM I AS INTEGER
            DIM modSepState AS INTEGER
            modSepState = False
            IF PARAMVALCOUNT = True AND (PARAMVAL(True) = False OR PARAMVAL(True) = True) THEN
             .ShowBtnCaptAll = True
             FOR I = False TO .ItemCount -True
              IF .Item(I) <> "-" THEN _
               .ShowBtnCapt(I) = PARAMVAL(True)
             NEXT I
            ELSEIF PARAMVALCOUNT > True THEN
             FOR I = 2 TO PARAMVALCOUNT
              IF .Item(PARAMVAL(I)) <> "-" THEN
               .ShowBtnCapt(PARAMVAL(I)) = PARAMVAL(True)
              ELSE
               modSepState ++
              END IF
             NEXT I
            ELSE
             SHOWMESSAGE "Erreur: paramètre(s) manquant(s) ou incorrect(s)"
            END IF
            IF modSepState THEN _
             SHOWMESSAGE "Avertissement: vous tentez de modifier " +CHR$(10) +_
             "               un séparateur..."
            IF .ItemCount > False THEN
             .ForceEvalPos = True
             CALL This.EvalBtnPos
             .ForceEvalPos = False
            END IF
            IF .isPaintReady > False THEN
             .ForceRePaint = True
             CALL This.RePaint
             .ForceRePaint = False
            END IF
           END SUBI

           CONSTRUCTOR
            BevelWidth				= False
            BorderStyle				= True
		'Align					= True 'False
		'FreePanelL.Caption		= "L"
            FreePanelL.Align		= 3
            FreePanelL.BevelWidth	= False
            FreePanelL.PARENT		= This
		'FreePanelL.Visible		= False
            FreePanelM.Align		= 4
            FreePanelM.Width		= 1
		'FreePanelM.Height		= 39
            FreePanelM.BevelWidth	= False
		'FreePanelM.Visible		= False
            FreePanelM.PARENT		= This
		'FreePanelR.Caption		= "R"
            FreePanelR.Align		= 4
            FreePanelR.Width		= 12
		'FreePanelR.Height		= 39
            FreePanelR.BevelWidth	= False
		'FreePanelR.Visible		= False
            FreePanelR.PARENT		= This
            CanvasL.Align			= 3
            CanvasL.Width			= True
            CanvasL.Height			= True
            CanvasL.PARENT			= This
            CanvasR.Align			= 5 '4
            CanvasR.Width			= True
            CanvasR.Height			= True
		'CanvasR.Parent			= This
            CanvasR.PARENT			= This.FreePanelM
            ImageL.Align			= 5
            ImageL.PARENT			= This.FreePanelL
            ImageR.Align			= 5
            ImageR.PARENT			= This.FreePanelR
            ImageLH.Visible			= False
            ImageLH.PARENT			= This.FreePanelL
            ImageRH.Align			= 5
            ImageRH.Visible			= False
            ImageRH.PARENT			= This.FreePanelR
            CoolBtnBMPE.Font.Name	= "MS Sans Serif"
            CoolBtnBMPE.Font.Bold	= True
            CoolBtnBMPE.Font.Size	= 12
            ItemsWidth				= 39 ' .ClientWidth -2
            GripWidth				= 5
		'mnuExceed.Alignment	= True
            DragTimer.Enabled		= False
            OnChange				= CBarOnChange_EventTemplate	' Définie temporairement l'adresse, sinon il y
																' a risque de complications... !
																' Ex: L'appelle de OnChange pourrait une autre
																' Function... j'ai déjà vu ça qqpart !!!
            CanvasLMsg				= False
           END CONSTRUCTOR
          END WITH
         END TYPE
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Fri 2024-4-19  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2013-06-19 07:50:26