Guidance
指路人
g.yi.org
software / rapidq / Examples / QObject / QTButton / QTButton94.inc

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

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

' Pour plus de détail sur l'utilisation de ce composant reportez vous
' à la documentation fournise... (QTButton.html)
' For more details on using this component please refer to the doc
' (QTButton.html)

'$REsource btn_BMP As "_RES\Boutons.bmp"
     $OPTION EXPLICIT

' Vous pouvez tricher ce composante par la même astuce utilisé ici


     $IFNDEF __RQINC' ==(corrigé! doh!)
      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 ' __RQINC

     CONST rqNullChr = CHR$(0)
     CONST rqSL		= CHR$(10)

     CONST DefPixelFormat = 4

'Liste de tous les btns de type QTButton créés lors du chargement
     DIM AllQTBtnsHandle AS QSTRINGLIST, AllQTBtnsGrouped AS QSTRINGLIST
'
     DIM AllQTBtnsRequester AS LONG, AllQTBtnsRequesterParent AS LONG
     AllQTBtnsRequester			= False	' Btn appelant
     AllQTBtnsRequesterParent	= False	' Parent du btn appelant

'Accélère l'affichage des btns à l'écran maintenant jusqu'à 97% avec un affichage
'parfait de 60% dans le cas où certains btns ont des dimensions différentes sinon
'ça grimpe jusqu'à 100%
'Dans l'événement OnShow de votre fenêtre ajoutez ShowMessage STR$(DrawCount)
'pour afficher le nombre de fois où les btns ont eus à être RePaint
'Note :  certains btns auront toute fois besoin d'être redessinés...
     DIM QTBtnOptimize AS INTEGER
     QTBtnOptimize = False

'Si vous voulez, vous pouver remplacer la resource par un objet bitmap
'mais n'oubliez pas de remplacer QTBtnBMP.BMPHandle = btn_BMP par
'QTBtnBMP.BMP = btn_BMP.BMP
     DIM QTBtnBMP AS QBITMAP
     QTBtnBMP.BMPHandle = btn_BMP' REsource bitmap
	'QTBtnBMP.BMP = btn_BMP.BMP'  Image bitmap


' -- Retiré 31déc
'Const BM_SETSTATE_QTBtn = &HF3
'Const WM_LBUTTONDOWN_QTBtn = &H201
' //--
     CONST WM_LBUTTONUP_QTBtn = &H202
     CONST WM_MOUSELAST_QTBtn = &H209


     DECLARE FUNCTION SendMessage_QTBtn LIB "user32" ALIAS "SendMessageA" ( _
      BYVAL hwnd AS LONG, _
      BYVAL wMsg AS LONG, _
      BYVAL wParam AS LONG, _
      lParam AS LONG) AS LONG

     DECLARE FUNCTION IsWindowEnabled_QTBtn LIB "user32" ALIAS "IsWindowEnabled" _
      (BYVAL hwnd AS LONG) AS LONG

'Declare Function LockWindowUpdate_QTBtn Lib "user32" Alias "LockWindowUpdate" _
'		(ByVal hwndLock As Long) As Long

     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

     DECLARE FUNCTION GetNextDlgTabItem_QTBtn LIB "user32" ALIAS "GetNextDlgTabItem" ( _
      BYVAL hDlg AS LONG, _
      BYVAL hCtl AS LONG, BYVAL bPrevious AS LONG) AS LONG
     DECLARE FUNCTION SetFocus_QTBtn LIB "user32" ALIAS "SetFocus" _
      (BYVAL hwnd AS LONG) AS LONG
     DECLARE FUNCTION GetParent_QTBtn LIB "user32" ALIAS "GetParent" _
      (BYVAL hwnd AS LONG) AS LONG
     DECLARE FUNCTION GetFocus_QTBtn LIB "user32" ALIAS "GetFocus" () AS LONG

     SUB NextDlg_QTBtn(NextPrevTab AS LONG)'(CtrlHwnd As Long)
      DIM hwnd5 AS LONG, hwnd6 AS LONG
      ReleaseCapture_QTBtn
      hwnd6 = GetFocus_QTBtn()
      hwnd5 = GetNextDlgTabItem_QTBtn(GetParent_QTBtn(hwnd6),hwnd6, NextPrevTab)

      CALL SetFocus_QTBtn(hwnd5)
     END SUB


'Declare Function GetDC Lib "user32" Alias "GetDC" _
'		(ByVal hwnd As Long) As Long
'Declare Function DrawFocusRect Lib "user32" Alias "DrawFocusRect" _
'		(ByVal hdc As Long, lpRect As RECTAPI) As Long
'Declare Function GetWindowRect Lib "user32" Alias "GetWindowRect" _
'		(ByVal hwnd As Long, lpRect As RECTAPI) As Long

     $IFNDEF __RQOBJDRAWING
      $DEFINE __RQOBJDRAWING
      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

      DECLARE FUNCTION SetBkMode_QTBtn LIB "gdi32" ALIAS "SetBkMode" _
       (BYVAL hdc AS LONG, BYVAL nBkMode AS LONG) AS LONG
'Declare Function SetTextColor 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

'Class = "Button"
'  Part ="BP_PUSHBUTTON" id="1"
'	State ="PBS_NORMAL" id="1"
'	State ="PBS_HOT" id="2"
'	State ="PBS_PRESSED" id="3"
'	State ="PBS_DISABLED" id="4"
'	State ="PBS_DEFAULTED" id="5"
'Class = "Toolbar"
'  Part ="TP_BUTTON" id = "1"
'    State ="TS_NORMAL" id="1"
'    State ="TS_HOT" id="2"
'    State ="TS_PRESSED" id="3"
'    State ="TS_DISABLED" id="4"
'    State ="TS_CHECKED" id="5"
'    State ="TS_HOTCHECKED" id="6"
'Class = "Tab"
'  Part = "TABP_TABITEM" id = "1"
'    State = "TIS_NORMAL" id="1"
'    State = "TIS_HOT" id="2"
'    State = "TIS_SELECTED" id="3"
'    State = "TIS_DISABLED" id="4"
'    State = "TIS_FOCUSED" id="5"

'Const BST_PUSHED = &H4
'Const BST_FOCUS = &H8

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

     DECLARE FUNCTION GetSystemMetrics LIB "user32" ALIAS "GetSystemMetrics" _
      (BYVAL nIndex AS LONG) AS LONG


' --	Redessine la région d'un contrôle (ComboBox)
     CONST RGN_AND	= 1
     CONST RGN_OR	= 2
     CONST RGN_XOR	= 3
     CONST RGN_DIFF	= 4

     DECLARE FUNCTION CreateRectRgn_QTBtn LIB "gdi32" ALIAS "CreateRectRgn" ( _
      BYVAL X1 AS LONG, _
      BYVAL Y1 AS LONG, _
      BYVAL X2 AS LONG, _
      BYVAL Y2 AS LONG) AS LONG
     DECLARE FUNCTION SetWindowRgn_QTBtn LIB "user32" ALIAS "SetWindowRgn" ( _
      BYVAL hWnd AS LONG, _
      BYVAL hRgn AS LONG, _
      BYVAL bRedraw AS INTEGER) AS LONG
     DECLARE FUNCTION DeleteObject_QTBtn LIB "gdi32" ALIAS "DeleteObject" ( _
      BYVAL hObject AS LONG) AS LONG

     SUB HideBevelTrick_QTBtn(Sender AS QBUTTON, BevelWidth AS INTEGER)
	' Ajouter RndRgn
      DIM rectRgn AS LONG

    ' Création des régions temporaires
      rectRgn	= CreateRectRgn_QTBtn(	BevelWidth, _
       BevelWidth, _
       Sender.Width -BevelWidth, _
       Sender.Height -BevelWidth )
      DeleteObject_QTBtn SetWindowRgn_QTBtn( Sender.Handle, rectRgn, True )

    ' nettoyage de nos ressources
      DeleteObject_QTBtn rectRgn
     END SUB
' //--


' -- Restauré 11janv (Retiré 31déc)
' Vérifie la version de Windows puisque certains problèmes sont identifiés
' sur l'un ou l'autre
     $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 maxnumbmp_QTBtn AS INTEGER
     maxnumbmp_QTBtn = 4
' //--

     DECLARE SUB BMPStretch_Property( _
      XPThemeEnabled AS INTEGER, _
      XPThemeWasEnabled AS INTEGER, _
      BtnType AS STRING, _
      BtnTypeWas AS STRING, _
      HideBevelSize AS INTEGER, _
      Sender AS QBUTTON)
'Declare Sub Fast_QBtnToQTBtn( _
'							 BtnType As String, _
'							 Sender As QButton)
'Declare Sub Fast_QCBtnToQTBtn( _
'							 BtnType As String, _
'							 Sender As QCoolBtn)

     SUB FixKind_QTBtn (oldvalue AS INTEGER, Sender AS QBUTTON)
      Sender.NumBMPs = oldvalue
     END SUB

     DIM RequestRelease AS INTEGER

' Event Template pour les nouveaux événements MouseLeave et MouseEnter
     DECLARE SUB OnMouseEnterLeave_EventTemplate (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER, Sender AS QBUTTON)

' Lorsque GroupIndex = 0 il doit être nettoyé s'il est présent dans la liste
     SUB SetIndex_QTBtn (Index AS INTEGER, Hwnd AS LONG)
      AllQTBtnsHandle.AddItems STR$(Hwnd)
      AllQTBtnsGrouped.AddItems STR$(Index)

'	If AllQTBtnsGrouped.ItemCount <> AllQTBtnsHandle.ItemCount Then ShowMessage "Erreur"
     END SUB

' Déplacé 12janv afin de réduire le code
     SUB	QTButton_KeyDown (Key AS WORD, Shift AS INTEGER)
     IF RequestRelease = False THEN
      SELECT CASE Key
      CASE 40, 39, 9: CALL NextDlg_QTBtn(True)	' Avance
      CASE 38, 37: CALL NextDlg_QTBtn(False)		' Recule
      CASE ELSE
				'ShowMessage STR$(Key)
      END SELECT
     END IF

     RequestRelease = True
     END SUB
' //

     DIM rWidth AS INTEGER, _
      rHeight AS INTEGER
     rWidth = 75
     rHeight = 25


     TYPE QTButton EXTENDS QBUTTON
  'YRESTE/TODO
	'-Fonction spécial transforme QButton en QTButton appelle un SUB qui applique les mêmes
	' propriétés que QTButton à QButton, utile pour les tableaux
	'-Corriger: Lorsque Kind n'est pas Faux et que Caption = "" le btn est mal dessiné
	'!Ajouté: Propriété de XPThemeBtnType (Sélectionnez entre 3 type de bouton; classic, barre d'outil, onglet)
	'!Corrigé: problèmes positionnement et de transparence pour certains thèmes de bureau
	'!Ajouté/Corrigé: Propriété de XPThemeEnabled (Active et désactive le theme)
	'!Ajouté/Amélioré: support des thèmes de bureau XP (Passé de Resource à l'API OpenThemeData)
	'!Remplacé certains CopyRect par StretchDraw c'est le cas pour l'effet Survole
	'!Corrigé: problème lorsque l'option Down d'un btn est vrai, l'icône est dessinée deux fois
	'Ajouter annuler l'effet enfoncé de l'icône
	'Ajouter réagit en tant que btn de barre d'outil (le focus est restauré à son ancien propriétaire)
	'!-Corriger: Effet de rafraîchissement causé par GroupIndex
	'!Ajouté: Icon/BMP
	'!Ajouté: Propriété de NumBMPs
	'!Ajouté: Propriété de NumICOBMPs (indique le nombre d'image dans l'icone)
	'!Ajouté: Propriété de Layout
	'!Ajouté: Propriété de Spacing
	'Ajouter: Evénement Default (onshow la souris pointe le btn... setfocus)
	'	Peut-être ajouter une méthode pour automatiser le procèssuce
	'!Réparé: Caption
	'!Ajouté: Sous-lignage de la lettre dans BMPBtn; ex: "Dé&faut"
	'!Amélioré/ReCorrigé: & et && dans le caption; 1 souligne, 2 donnent & sans souligner
	'!Corrigé: Un API vient corriger le problème avec TextRect et TextOut _
	'   (TextRect n'aime pas les bounds)
	'!Corrigé: Effet de Sous-lignage appuyer sur Alt+ChrSouligné = clic
	'!Corrigé: Propriété de Height et Width
	'!Corrigé: Survole lorsque le nombre de btn est inférieur à 4
	'!Corrigé: Survole lors d'un clique
	'-Inverser: Enfoncé et Désactivé dans le fichier BMP
	'!Corrigé: Lorsque le nombre de btns excède 4 (NumBMPs)
	'!Amélioré/Ajouté: Lignes Multiples basique (insèrez chr$(10) ou "\n" pour créer une nouvelle ligne)
	'-Ajouter: HideCaption, pour afficher une icône et masquer le texte (coolbtn like)
	'Corriger/Ajouter: propriété de police (comment?)
	'	pour l'instant vous devrez utiliser ReDraw après avoir changé la police
	'	sinon je pourrais faire en sorte que QTBtn vérifie l'état de la police
	'	à chque action...
	'!Corrigé: lorsque la souris pointe le btn, le clavier ne répond plus
	'!Corrigé: Petit problème de positionement du texte
	'!Corrigé: Problème avec Enabled et la police lors de l'exécution
	'Corriger/Ajouter: Propriété de Visible (éviter de trop dessiner lorsqu'invisible)
	'Ajouter: AutoSize lorsque la taille du texte en pixel excède celle du bouton
	'Ajouter: Propriété de Parent pour être sure que l'enjolivure sera dessinée
	'Corriger: Propriété d'Align
	'!Ajouté: Groupe de bouton
	'Ajouter: AllowAllUp (si on clique sur un btn enfoncé du groupe, ils seront tous rétablis à la normal)
	'Ajouter: AllowDown (permet a un btn de garder son état enfoncé)
	'Ajouter: Lorsque GroupIndex > Faux et qu'on appuie sur une touche QTBtn tente de rejoindre
	'	le btn suivant (comme TabControl)
	'
	'Quelques problèmes identifiés :
	'		 1) Problème introduit... lorsque la souris quitte le contrôle, il est mal redessiné... arrrg!
	'			Le problème vient de l'ordre dans lequel NumBMPs est introduit.
	'			Résolution: l'insèrer après les	paramètres de positionnement.
	'			(Semble être corrigé)
	'		 2) Lorsque le titre du btn est trop long, le reste du texte apparaît sur les divers
	'			effets, à savoir désactivé ,enfoncé, survollé. 	Ce problème vient du fait que je
	'			n'arrive toujours pas à utiliser TextRect.
	'			Résolution: un API est utilisé pour corrigé ce problème
	'		 3) Parfois le btn n'est pas dessiné lorsque NumBMPs n'est pas spécifié, donc ne pas
	'			oublier de l'ajouter.
	'			Résolution: Left et Top devrait toujours être les premiers champs déclarés ensuit
	'						vient NumBMPs si le nombre est supérieur à 1, puis vient Height et Width
	'						etc...
	'		 4) Plus d'une fenêtre alors qu'un btn n'est toujours pas visible, aura d'étranges
	'			résultats d'affichage pour ce btn, surtout en utilisant ShapeForm.
	'			Résolution: Dim DummyBtn As QTButton juste après la fenêtre
	'						DummyBtn.ReDraw durant le chargement de la form peut aussi aider
	'		 5) Problème de mémoire reliré à l'image du btn, il semble que l'image se pert en mémoire
	'			et peut se retrouver n'import où, les contrôles utilisant le mode OwnerDraw en
	'			seront grandement irrités...
	'			(J'essaie d'identifier le problème...)
	'						DummyBtn.ReDraw durant le chargement de la form peut aussi aider
	'		 6) Lorsque l'on définie Height ou Width sur le premier bouton il est mal dessiné
	'			Résolution: Placer temporairement btn.Redraw avant ou pendant l'affichage de la fenêtre

      WITH This 'QTButton
PRIVATE:
       cRect AS RECT_QTBtn

       Dest	AS QRECT
       Source	AS QRECT
       BMPBtnClean AS QBITMAP	' Copie de l'image du bouton sans aucune modification
							' BMPtmp pourrait être ramplacé par BMPBtnClean
       BMPBtn	AS QBITMAP
       BMPtmp	AS QBITMAP		' Devrait reflété un seul btn, celui à réintégrer (normal, survole)
PUBLIC:
       ICOBMP	AS QBITMAP		' la petite icône à afficher sur le btn

PRIVATE:
       PropID		AS INTEGER	' Qui appelle ReDraw
       BtnNeedDraw	AS INTEGER	' Détermine si le btn doit être totallement redessiné
							' ou dans les cas de Caption, Layout, Spacing seule
							' la partie text doit être mise à jour...
       ActAsToolBar AS INTEGER
       PrevFocus	AS LONG

       HideBevelSize AS INTEGER

       XPThemeBtnTypeWas AS STRING
       XPThemeWasEnabled AS INTEGER
	' Property Set
PUBLIC:
       XPThemeBtnType	AS STRING PROPERTY SET SetXPThemeBtnType
       XPThemeEnabled	AS INTEGER PROPERTY SET SetXPThemeEnabled

       Align		AS INTEGER	PROPERTY SET SetAlign
       CAPTION 	AS STRING	PROPERTY SET SetCaption
       Enabled 	AS INTEGER	PROPERTY SET SetEnabled
       Down		AS INTEGER	PROPERTY SET SetDown
       GroupIndex	AS INTEGER	PROPERTY SET SetGroupIndex
       Kind		AS INTEGER	PROPERTY SET SetKind
       Layout		AS INTEGER	PROPERTY SET SetLayout
       Spacing		AS INTEGER	PROPERTY SET SetSpacing
       Height		AS INTEGER	PROPERTY SET SetHeight
       Width		AS INTEGER	PROPERTY SET SetWidth
       NumBMPs		AS INTEGER	PROPERTY SET SetNumBMPs
       NumICOBMPs	AS INTEGER	PROPERTY SET SetNumICOBMPs

	' 14/15 déc
       FlickeringTrick AS INTEGER	PROPERTY SET SetNewBtnRegion
       HideFocusRect AS INTEGER PROPERTY SET SetHideFocusRect

	' EventTemplate
       OnMouseLeave AS EVENT(OnMouseEnterLeave_EventTemplate)
       OnMouseEnter AS EVENT(OnMouseEnterLeave_EventTemplate)

	'Nouvelles propriétés
	'qqchose as qqchose Property Set SetQqChose

       FUNCTION TextWidth(text AS STRING) AS INTEGER:	Result = .BMPBtn.TextWidth(text)
       END FUNCTION
       FUNCTION TextHeight(text AS STRING) AS INTEGER:	Result = .BMPBtn.TextHeight(text)
       END FUNCTION

	'Sub ResizeTo(Height As Integer, Width As Integer)
	'End Sub

PRIVATE:
       SUB FixBtnSize
        IF .Align <> False THEN EXIT SUB'!-- 22/08
        DIM height AS INTEGER, width AS INTEGER
        height = super.height: width = super.width

        .height = height: .width = width
       END SUB

       SUB DrawCaption: DIM I AS INTEGER
        .propID = False
        DIM COLOR AS INTEGER, left AS INTEGER, top AS INTEGER ', _
        DIM capwidth AS INTEGER', noico as integer

        .BMPBtn.Font.Name = .Font.Name' == (add)
        .BMPBtn.Font.Size = .Font.Size' == (add)
        .BMPBtn.Font.COLOR = .Font.COLOR' == (add)
        .BMPBtn.Font.Bold = .Font.Bold
        .BMPBtn.Font.Italic = .Font.Italic
        .BMPBtn.Font.Underline = .Font.Underline

		'noico	= .ICOBMP.Empty
        COLOR	= IIF(super.enabled = 1, .font.COLOR, -2147483631) 'clGrayText

        capwidth	= (.Width -( .TextWidth( FIELD$( .CAPTION, rqSL, True) ) )) \2

        IF .ICOBMP.Empty = False THEN
         .ICOBMP.PixelFormat = PixelFormatFix_QTBtn '.PixelFormat'when kind no prob, when icobmp big prob
         .ICOBMP.Transparent = 1	'True
        END IF

        DIM startFrom AS INTEGER, endTo AS INTEGER
        IF .Enabled = True THEN
         startFrom = False
         endTo = .NumBMPs -True
        ELSE
         startFrom = True
         endTo = True
        END IF

        DIM LineCount AS INTEGER
        DIM Down AS INTEGER
        IF .CAPTION <> "" THEN
         FOR I = startFrom TO endTo STEP 2
          IF I = False AND .Down = True THEN _
           Down = True _
          ELSE Down = False

          .cRect.Left = (I *(.Width +3)) +True +Down
          .cRect.Top = True + Down	'iif(.Layout > True and .ICOBMP.Empty = False, _
											'	 iif(.Layout = 2, .ICOBMP.Height, -.ICOBMP.Height), _
											'	 False ) +True +Down
          .cRect.Right = .Width +.cRect.Left
          .cRect.Bottom = .Height +True
          IF .ICOBMP.Empty = False THEN
           SELECT CASE .Layout
           CASE True
            .cRect.Left = .cRect.Left -((.ICOBMP.Width \.NumICOBMPs) _
             +.Spacing) +Down
           CASE 2
            .cRect.Top = .cRect.Top +((.ICOBMP.Height +.TextHeight(.CAPTION)) \2) _
             +.Spacing +Down
           CASE 3
            .cRect.Top = .cRect.Top -((.ICOBMP.Height +.TextHeight(.CAPTION)) \2) _
             +.Spacing +Down
           CASE ELSE
            .cRect.Left = .cRect.Left +(.ICOBMP.Width \.NumICOBMPs) _
             +.Spacing +Down
           END SELECT
          END IF

          LineCount = TALLY(.CAPTION, rqSL) +TALLY(.CAPTION, "\n") +True
				'SetTextColor This.BMPBtn.Handle, clGrayText
          .BMPBtn.Font.COLOR = COLOR
          SetBkMode_QTBtn This.BMPBtn.Handle, True
          IF LineCount > True THEN
           .cRect.Top = .cRect.Top +(((.Height -3 -True) -(.TextHeight(.CAPTION) *(LineCount -True))) /3)
           DrawText_QTBtn (This.BMPBtn.Handle, This.CAPTION, LEN(This.CAPTION), _
            This.cRect, DT_CENTER_QTBtn)
          ELSE
           DrawText_QTBtn (This.BMPBtn.Handle, This.CAPTION, LEN(This.CAPTION), _
            This.cRect, DT_CENTER_QTBtn OR DT_SINGLELINE_QTBtn OR DT_VCENTER_QTBtn)
          END IF

         NEXT I
        END IF
		' Fix Bug in Win9x where caption are draw in white color
        IF .ICOBMP.Empty = False THEN
			' -- déplacé
         DIM ICOtmp AS QBITMAP
         ICOtmp.Width = .ICOBMP.Width \.NumICOBMPs
         ICOtmp.Height = .ICOBMP.Height
         WITH Dest: .Left = False: .Right = ICOtmp.Width
          .Top = False: .Bottom = ICOtmp.Height
         END WITH
			' //-- déplacé
         FOR I = startFrom TO endTo STEP 2
          left = IIF(.Layout > True, .Width \2, capwidth)
          left = left +(I *(.Width +3)) +True _
           +IIF(.Layout < 2 AND .CAPTION <> "", _
           IIF(.Layout = False, -((.ICOBMP.Width \.NumICOBMPs) +.Spacing) \2, _
           (.ICOBMP.Width \.NumICOBMPs) \2), _
           -(.ICOBMP.Width \.NumICOBMPs) \2 -True)
          top = ((.Height +3) -.ICOBMP.Height) \2
          SELECT CASE .Layout
          CASE 2
           top = top -((.TextHeight(.CAPTION) +.Spacing) \2) +Down
          CASE 3
           top = top +((.TextHeight(.CAPTION) +.Spacing) \2) +Down
          CASE ELSE
          END SELECT

          WITH Source: .Left = I *(This.ICOBMP.Width \This.NumICOBMPs)
           .Right = .Left +(This.ICOBMP.Width \This.NumICOBMPs)
           .Top = False: .Bottom = ICOtmp.Height
          END WITH
          ICOtmp.CopyRect(This.Dest, This.ICOBMP, This.Source)

          ICOtmp.Transparent = True	' Corrige un problème de transparence sous 9x
											' le problème de dessin mal positionné est ici
          .BMPBtn.Draw ( left, _
           top, _
           ICOtmp.BMP)
         NEXT I
        END IF

        .BMP = .BMPBtn.BMP
       END SUB
PUBLIC:
       SUB ReDraw
		' Liste propID
		' 1. Align
		' 2. Caption
		' 3. Down
		' 4. Enabled
		' 5. GroupIndex
		' 6./7. Height/Width
		' 8. Kind
		' 9. Layout
		' 10./11. Left/Top
		'12./13 NumBMPs/NumICOBMPs
		'14. Spacing
		'15./16. XPThemeEnabled/XPThemeBtnType
        DIM FastDraw AS INTEGER
        FastDraw = False
        IF .BtnNeedDraw = False AND (_
         .propID = 2 OR _
         .propID = 4 OR _
         .propID = 5 OR _
         .propID = 8 OR _
         .propID = 9 OR _
         .propID = 10 OR _
         .propID = 11 OR _
         .propID = 13 OR _
         .propID = 14) THEN
         .BMPBtn.BMP = .BMPBtnClean.BMP
         FastDraw = True
        END IF
        .BtnNeedDraw = False
        .propID = False
        rWidth = Super.Width '.Width
        rHeight = Super.Height '.Height
        IF .Width = False OR .Height = False THEN .FixBtnSize
		'LockWindowUpdate_QTBtn(This.Handle)

        STATIC checkICO AS INTEGER
        IF checkICO = False AND .kind = False THEN
         .ICOBMP.BMP = .BMP
         checkICO = True
        END IF
        IF .NumBMPs > maxnumbmp_QTBtn THEN .NumBMPs = maxnumbmp_QTBtn
        IF FastDraw = False THEN
         BMPStretch_Property(This.XPThemeEnabled, This.XPThemeWasEnabled, _
          This.XPThemeBtnType, This.XPThemeBtnTypeWas, _
          This.HideBevelSize, _
          This)
         .BMPBtn.BMP = .BMP
         .BMPBtnClean.BMP = .BMPBtn.BMP
         .BMPBtn.PixelFormat = DefPixelFormat' == (add)
         .BMPBtn.TransparentColor = .BMPBtn.Pixel(True, True)
        END IF
        .BMPBtn.PixelFormat = DefPixelFormat' == (add)
        .BMPBtn.TransparentColor = .BMPBtn.Pixel(True, True)' Ajouté 13janv (résou un problème de tranparence
															'				 avec certains thème de bureau
        IF .CAPTION = "" THEN
         Super.Layout = 0 '1
         ELSE: .BMPBtn.Height = .BMPBtn.Height +.TextHeight(.CAPTION) +2
         Super.Layout = 3
        END IF

        .BMPtmp.Height = .BMPBtn.Height
        IF FastDraw = False THEN _
         .BMPBtnClean.Height = .BMPBtn.Height
        .DrawCaption ' // -- déplacé
        IF .NumBMPs >= maxnumbmp_QTBtn THEN
         WITH Dest: .Left = False: .Right = (This.BMPBtn.Width -True) \This.NumBMPs
          .Top = False: .Bottom = This.BMPBtn.Height
         END WITH
         WITH Source: .Left = False: .Right = This.Dest.Right
          .Top = False: .Bottom = This.BMPBtn.Height
         END WITH
         .BMPtmp.Width = .Dest.Right: .BMPtmp.Height = .BMPBtn.Height '.Dest.Bottom
         .BMPtmp.CopyRect(This.Dest, This.BMPBtn, This.Source)
        END IF

		'.DrawCaption
		'LockWindowUpdate_QTBtn(False)
       END SUB
PRIVATE:
       SUB DrawDownUp
        IF .BtnNeedDraw THEN .ReDraw
        IF .NumBMPs >= 3 THEN
         WITH Dest: .Left = This.Down: .Right = .Left +(This.BMPBtn.Width -True) \This.NumBMPs
          .Top = This.Down: .Bottom = .Top +This.BMPBtn.Height
         END WITH
			'WITH Source: .Top = False: .Bottom = This.BMPBtn.Height
			'END WITH
         IF .Down = True THEN
				' Btn enfoncé
          WITH Source: .Left = (This.Dest.Right -True) *2
           .Right = .Left +This.Dest.Right -True
           .Top = False: .Bottom = This.BMPBtn.Height  ' // -- Stretché lorsque Groupé
          END WITH
          .BMPBtn.CopyRect(This.Dest, This.BMPBtn, This.Source)
         ELSE
				' Btn normal
				'WITH Source: .Left = False: .Right = This.Dest.Right
				'END WITH
				'.BMPBtn.CopyRect(This.Dest, This.BMPtmp, This.Source)
          .BMPBtn.StretchDraw(This.Dest, This.BMPtmp.BMP)
         END IF

         .BMP = .BMPBtn.BMP
         .DrawCaption
        END IF
       END SUB

       SUB ReleaseHotTrack
		' le pseudo-evénement MOUSELEAVE
        ReleaseCapture_QTBtn
		' on retourne le caption à la normal
		'.Font.Bold = False
        .Font.COLOR = clBtnText
		'.caption = "Dehors..."
		'LockWindowUpdate_QTBtn(This.Handle)
        IF .NumBMPs => maxnumbmp_QTBtn AND .Down = False THEN
         WITH Dest: .Left = False: .Right = (This.BMPBtn.Width -True) \This.NumBMPs
          .Top = False: .Bottom = This.BMPBtn.Height
         END WITH
			'WITH Source: .Left = False: .Right = This.Dest.Right
			'			  .Top = False: .Bottom = This.BMPtmp.Height
			'END WITH
			'.BMPBtn.CopyRect(This.Dest, This.BMPtmp, This.Source)
         .BMPBtn.StretchDraw(This.Dest, This.BMPtmp.BMP)
			'.BMPBtn.Draw( False, False, This.BMPtmp)
        END IF

        .DrawCaption
		'LockWindowUpdate_QTBtn(False)
       END SUB
PUBLIC:
	'Event OnMouseDown(btn As Integer, X As Integer, Y As Integer, Shift As Integer)
	'	' Doit être hérité si ActAsToolBar est vrai
	'	If .ActAsToolBar = True and .PrevFocus <> False and _
	'		.PrevFocus <> .Handle and GetFocus_QTBtn() <> .PrevFocus Then
	'		$TypeCheck Off
	'		Call SendMessage_QTBtn(.Handle, &H8, True, ByVal 0&)
	'		$TypeCheck On
	'		'Call SetFocus_QTBtn(.PrevFocus)
	'	End If
	'End Event
	'Event OnClick'(btn As Integer, X As Integer, Y As Integer, Shift As Integer)
	'	' Doit être hérité si ActAsToolBar est vrai
	'	If .ActAsToolBar = True and .PrevFocus <> False and _
	'		.PrevFocus <> .Handle and GetFocus_QTBtn() <> .PrevFocus Then
	'		$TypeCheck Off
	'		Call SendMessage_QTBtn(.Handle, &H8, True, ByVal 0&)
	'		$TypeCheck On
	'		'Call SetFocus_QTBtn(.PrevFocus)
	'	End If
	'End Event
       EVENT OnMouseUp(btn AS INTEGER, X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
        .ReleaseHotTrack
		'If .ActAsToolBar = True and .PrevFocus <> False and _
		'	.PrevFocus <> .Handle and GetFocus_QTBtn() <> .PrevFocus Then _
		'	Call SetFocus_QTBtn(.PrevFocus)

		' fait parti d'un groupe ?
        IF .GroupIndex > False THEN
         IF AllQTBtnsRequester = False AND btn = False THEN
          STATIC currHwnd AS LONG

          DIM I AS INTEGER
				' identifie le button qui appelle tous les autres
          AllQTBtnsRequester = .Handle
				' identifie le Parent du groupe appellé, comme ça si deux groupes ont le même
				' indentifiant mais pas le même parent, seul les btns du groupe ayant le parent
				' conrrespondant seront appelés.
          IF AllQTBtnsRequesterParent = False THEN _
           AllQTBtnsRequesterParent = GetParent_QTBtn(This.Handle)
				'ShowMessage STR$(AllQTBtnsRequesterParent)

          FOR I = False TO AllQTBtnsHandle.ItemCount -True
					'If AllQTBtnsGrouped.Item(AllQTBtnsHandle.IndexOf(STR$(.Handle))) > False and _
           IF	VAL(AllQTBtnsGrouped.Item(I)) = .GroupIndex AND _
            GetParent_QTBtn(VAL(AllQTBtnsHandle.Item(I))) = AllQTBtnsRequesterParent THEN
						' retrouve l'handle du btn
						' get the handle of that button
            currHwnd = VAL(AllQTBtnsHandle.Item(I))

            IF IsWindowEnabled_QTBtn(currHwnd) = True THEN
             IF currHwnd <> .Handle THEN

              $TYPECHECK Off
								' restaure le dernier état du btn à la normal
								' restore the last button state to normal
								'Call SendMessage_QTBtn(.Handle, WM_LBUTTONDOWN_QTBtn, False, ByVal 0&)
								' et envoit les msgs enfoncé/terminé de la souris pour lancer
								' l'événement clic du btn, et indique visiblement sont état enfoncé
								' and send mouse down and up messages to fire its click event,
								' and visibly indicate its pressed state.
								'Call SendMessage_QTBtn(currHwnd, WM_LBUTTONDOWN_QTBtn, False, ByVal 0&)
              CALL SendMessage_QTBtn(currHwnd, WM_LBUTTONUP_QTBtn, False, BYVAL 0&)
								'Call SendMessage_QTBtn(currHwnd, BM_SETSTATE_QTBtn, 1, ByVal 0&)
								'Call SendMessage_QTBtn(currHwnd, BM_SETSTATE_QTBtn, False, ByVal 0&)
              CALL SendMessage_QTBtn(currHwnd, WM_MOUSELAST_QTBtn, False, BYVAL 0&)
              $TYPECHECK ON

								'SetFocus_QTBtn(This.Handle)
             ELSEIF currHwnd = .Handle THEN
              .Down = True
             END IF
            END IF

           END IF
          NEXT I
				' redonne le focus au btn appellant
          IF .ActAsToolBar = False THEN _
           SetFocus_QTBtn(.Handle)

          currHwnd = False
          AllQTBtnsRequester = False
          AllQTBtnsRequesterParent = False
          .DrawDownUp
         ELSEIF (AllQTBtnsRequester <> False AND AllQTBtnsRequester <> .Handle) AND _
           GetParent_QTBtn(This.Handle) = AllQTBtnsRequesterParent THEN
           IF VAL(AllQTBtnsGrouped.Item(AllQTBtnsHandle.IndexOf(STR$(AllQTBtnsRequester)))) = .GroupIndex AND _
            .Down = True THEN
            .Down = False
            .DrawDownUp
           END IF
          END IF
         END IF
		'Dim rc3 As RECTAPI
		'Call GetWindowRect_QTBtn(This.Handle, rc3)
		'rc3.right = rc3.right -10
		'Call DrawFocusRect_QTBtn(GetDC_QTBtn(This.Handle), rc3)
        END EVENT
PRIVATE:
        EVENT OnMouseMove(X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
         STATIC PosX AS INTEGER, PosY AS INTEGER

         IF .ActAsToolBar = True AND GetFocus_QTBtn() <> .Handle THEN _
          .PrevFocus = GetFocus_QTBtn()

         WITH Dest: .Left = False: .Right = (This.BMPBtn.Width -True) \This.NumBMPs
          .Top = False: .Bottom = This.BMPBtn.Height
         END WITH

         IF (X < False) OR (Y < False) OR _
          (X > .Width) OR (Y > .Height) THEN
          .ReleaseHotTrack
          CALLFUNC(.OnMouseLeave, X, Y, Shift, This)
         ELSEIF (GetCapture_QTBtn() <> .Handle) AND (RequestRelease = False _
           AND PosX <> X AND PosY <> Y) THEN
			' Verifie si la requete de relâcher la capture d'un QTBtn est 0
			' Check if the release capture request for QTBtn is 0
			'
			' Ce qui va aussi empêcher le btn de reprendre son état initial
			' lors d'une action...
           PosX = X
           PosY = Y

			'LockWindowUpdate_QTBtn(This.Handle)
			' le pseudo-evénement MOUSEENTER
           SetCapture_QTBtn .Handle
			' on met le caption en gras
			'.Font.Bold = True
           .Font.COLOR = clHilight
			'.caption = "Dessus..."
           IF .NumBMPs => maxnumbmp_QTBtn AND .Down = False THEN
            WITH Source: .Left = This.Dest.Right *(This.NumBMPs -True)
             .Right = .Left +This.Dest.Right
             .Top = False: .Bottom = This.BMPBtn.Height
            END WITH
            .BMPBtn.CopyRect(This.Dest, This.BMPBtn, This.Source)
           END IF

           .DrawCaption
			'LockWindowUpdate_QTBtn(False)
           CALLFUNC(.OnMouseEnter, X, Y, Shift, This)
          ELSEIF RequestRelease = True THEN	' Corrige l'état survolle du btn
											' Fix Hot state of btn
           .ReleaseHotTrack
          END IF
          IF (PosX <> X AND PosY <> Y) THEN RequestRelease = False	' Restaure la requête à 0
							  										' Reset release request
         END EVENT
PUBLIC:
	' -- 12 janv (déplacé)
	'Event OnKeyDown(Key AS Word, Shift AS INTEGER)
	'	'.ReleaseHotTrack
	'	If RequestRelease = False Then
	'		Select Case Key
	'			Case 40, 39, 9: Call NextDlg_QTBtn(True)	' Avance
	'			Case 38, 37: Call NextDlg_QTBtn(False)		' Recule
	'			Case Else
	'		End Select
	'	End If

	'	RequestRelease = True
	'End Event
	' //--

	'Property Set SetAlign (lpalign as integer)
	'	.Align = lpalign: Super.Align = lpAlign
	'	.ReDraw
	'End Property
         PROPERTY SET SetLayout (lplayout AS INTEGER)
          .Layout = lplayout': Super.Layout = lplayout
          .propID = 14
          IF .BtnNeedDraw THEN
           .ReDraw
          ELSE
           .DrawCaption
          END IF
         END PROPERTY
         PROPERTY SET SetSpacing (lpspacing AS INTEGER)
          .Spacing = lpspacing': Super.Layout = lplayout
          .propID = 9
          IF .BtnNeedDraw THEN
           .ReDraw
          ELSE
           .DrawCaption
          END IF
		'.ReDraw '.DrawCaption '.ReDraw
         END PROPERTY
         PROPERTY SET SetCaption (lpcaption AS STRING)
          .CAPTION = lpCaption
          .CAPTION = REPLACESUBSTR$(.CAPTION, "\n", rqSL)
          Super.CAPTION = lpcaption -CHR$(10) -CHR$(13) -"\n"
          .propID = 2
          .ReDraw
         END PROPERTY
         PROPERTY SET SetEnabled (lpenabled AS INTEGER)
          Super.Enabled = lpenabled: .Enabled = lpenabled
          .propID = 4
          IF .BtnNeedDraw THEN
           .ReDraw
          ELSE
           .DrawCaption
          END IF
         END PROPERTY
         PROPERTY SET SetHeight (lpheight AS INTEGER)
		'.ReleaseHotTrack
          .Height = lpheight: Super.Height = lpheight
          .propID = 6
          .ReDraw
         END PROPERTY
         PROPERTY SET SetWidth (lpwidth AS INTEGER)
          .Width = lpwidth: Super.Width = lpwidth
          .propID = 7
          .ReDraw
         END PROPERTY
         PROPERTY SET SetNumBMPs (lpnumbmps AS INTEGER)
          .NumBMPs = lpnumbmps: Super.NumBMPs = lpnumbmps
          .propID = 12
          .ReDraw
         END PROPERTY
         PROPERTY SET SetNumICOBMPs (lpnumicobmps AS INTEGER)
          .NumICOBMPs = lpnumicobmps
          .propID = 13
          IF .BtnNeedDraw = False THEN
           .ReDraw
          ELSE
           .DrawCaption'ReDraw'==(mod)
          END IF
         END PROPERTY
         PROPERTY SET SetKind (lpkind AS INTEGER)
          DIM numbmps AS INTEGER
          numbmps = .NumBMPs
          IF lpKind > False THEN
           .Kind = lpkind: Super.Kind = lpkind
           .NumICOBMPs = 2
           .ICOBMP.BMP = .BMP
          END IF

          CALL FixKind_QTBtn (numbmps, This)
          .propID = 8
          .ReDraw
         END PROPERTY
         PROPERTY SET SetGroupIndex (lpIndex AS INTEGER)
          .GroupIndex = lpIndex
          CALL SetIndex_QTBtn(lpIndex, .Handle)
         END PROPERTY
         PROPERTY SET SetDown (lpDown AS INTEGER)
          .Down = lpDown
          .propID = 3
          .DrawDownUp
         END PROPERTY
         PROPERTY SET SetXPThemeEnabled(lpEnabled AS INTEGER)
          .XPThemeEnabled = lpEnabled
          .propID = 15
          IF .XPThemeEnabled <> .XPThemeWasEnabled THEN _
           .ReDraw
          .XPThemeWasEnabled = lpEnabled
         END PROPERTY
         PROPERTY SET SetXPThemeBtnType(lpBtnType AS STRING)
          .XPThemeBtnType = lpBtnType
          .propID = 16
          IF (.XPThemeBtnType <> .XPThemeBtnTypeWas) AND _
           .XPThemeEnabled = True THEN _
           .ReDraw
          .XPThemeBtnTypeWas = lpBtnType
         END PROPERTY
         PROPERTY SET SetNewBtnRegion(lpnewregion AS INTEGER)
          .FlickeringTrick = lpnewregion
          IF .FlickeringTrick > False THEN
           HideBevelTrick_QTBtn(This, 2)
           .HideBevelSize = 2 'True
          END IF
         END PROPERTY
         PROPERTY SET SetHideFocusRect(lpnewregion AS INTEGER)
          .HideFocusRect = lpnewregion
          IF .HideFocusRect > False THEN
           HideBevelTrick_QTBtn(This, 5)
           .HideBevelSize = 5
          END IF
         END PROPERTY

         CONSTRUCTOR
          BtnNeedDraw = True
          XPThemeEnabled = True
          XPThemeWasEnabled = True
          XPThemeBtnType = xpt_PushBtn
          XPThemeBtnTypeWas = xpt_PushBtn
          BMPtmp.PixelFormat = DefPixelFormat
          BMPBtn.PixelFormat = DefPixelFormat
          Spacing = maxnumbmp_QTBtn
          Enabled = True
          NumBMPs = True
          NumICOBMPs = True
          Layout = False
          Down = False

		'FixBtnSize
          OnKeyDown = QTButton_KeyDown
         END CONSTRUCTOR
        END WITH
       END TYPE


'Private:
' Reduit la taille du code dans l'application
       DIM DrawCount AS INTEGER
       SUB BMPStretch_Property

	' Pour corriger .Align
	'If Sender.Align <> False Then ...
	'	Call ClientRect API to Find parent width and height
	'End If

        DIM Dest AS QRECT, Source AS QRECT
        DIM Bitmap1 AS QBITMAP, _
         XPBitmap1 AS QBITMAP
        DIM XPBtnType AS STRING ' Ajouté 19jan corrige un problème où les types sont différents
        DIM Width1 AS INTEGER, Height1 AS INTEGER
        DIM Width2 AS INTEGER, Height2 AS INTEGER
        DIM btnCount AS INTEGER

        btnCount = Sender.NumBMPs
        IF btnCount > maxnumbmp_QTBtn THEN
         btnCount = maxnumbmp_QTBtn
         sender.numbmps = btncount
        END IF

        Width1 = ((Sender.Width +3) *btnCount) +True
        Height1 = Sender.Height +3
        DOEVENTS
	' Si l'image à déjà la même dimension elle ne sera pas redimensionnée
	'If QTBtnOptimize <> True or (Width2 <> Width1 and Height2 <> Height1) Then
        IF QTBtnOptimize <> True OR _
         (XPThemeEnabled <> XPThemeWasEnabled) OR _
         ((BtnType <> BtnTypeWas) AND XPThemeEnabled = True) OR _
         ((XPBtnType <> BtnType) AND XPThemeEnabled = True) OR _
         ((rWidth > False OR rHeight > False) AND _
         (Bitmap1.Width <> Width1 AND Bitmap1.Height <> Height1 AND _
         Width2 <> Bitmap1.Width AND Height2 <> Bitmap1.Width)) THEN
         DrawCount ++
         WITH Bitmap1
          .Width = Width1		'== (mod)
          .Height = Height1	'== (mod)
          .FillRect(False, False, .Width, .Height, clBtnFace)'==(mod) (13janv remplacé clPurple par clBtnFace)
			'.PixelFormat = DefPixelFormat
         END WITH
         WITH XPBitmap1
          .Width = Width1		'== (mod)
          .Height = Height1	'== (mod)
          .FillRect(False, False, .Width, .Height, clBtnFace)'==(mod) (13janv remplacé clPurple par clBtnFace)
			'.PixelFormat = DefPixelFormat
         END WITH
         Width1 = Sender.Width *btnCount
         Height1 = Sender.Height

         IF XPThemeEnabled = False OR isXP_QTBtn = False THEN
			' Thème non activé ou ce n'est pas Windows XP

          DIM J AS INTEGER, I AS INTEGER
          FOR J = False TO btnCount -True
				' Le centre ----------------------------------------------------------
           WITH Dest
            .Left = ((Width1 \btnCount) *J) +3 +(True *(J +True)) +(J *2) -IIF(J = 2, True, False)
            .Top = maxnumbmp_QTBtn -IIF(J=2, True, False)
            .Right = .Left +(Width1 \btnCount) -6
            .Bottom = Height1 -2 -IIF(J = 2, True, False)
           END WITH
           WITH Source: .Left = ((QTBtnBMP.Width \btnCount) *J) +3: .Top = 3: _
             .Right = .Left +(QTBtnBMP.Width \btnCount) -6
            .Bottom = QTBtnBMP.Height -3
           END WITH

           Bitmap1.CopyRect(Dest, QTBtnBMP, Source)

				' Les coins ----------------------------------------------------------
           FOR I = False TO 3
            WITH Dest
             .Left = ((Width1 \btnCount) *J) _
              +IIF(I = False OR I = 2, False, (Width1 \btnCount) -3) +(True *(J +True)) +(J *2) _
              -IIF(J = 2, True, False)
             .Top = IIF(I<2, True, Height1 -2) -IIF(J = 2, True, False)
             .Right = .Left +3
             .Bottom = .Top +3
            END WITH
            WITH Source
             .Left = ((QTBtnBMP.Width \btnCount) *J) _
              +IIF(I = False OR I = 2, False, (QTBtnBMP.Width \btnCount) -3)
             .Top = IIF(I < 2, False, QTBtnBMP.Height -3)
             .Right = .Left +3
             .Bottom = .Top +3
            END WITH
            Bitmap1.CopyRect(Dest, QTBtnBMP, Source)
           NEXT I
				' Les horizontaux ----------------------------------------------------
           FOR I = False TO True
            WITH Dest
             .Left = ((Width1 \btnCount) *J) +3 +(True *(J +True)) +(J *2) -IIF(J = 2, True, False)
             .Top = IIF(I = False, True, Height1 -2) -IIF(J = 2, True, False)
             .Right = .Left +(Width1 \btnCount) -6
             .Bottom = .Top +3
            END WITH
            WITH Source
             .Left = (QTBtnBMP.Width \btnCount) *J +3
             .Top = IIF(I = False, False, QTBtnBMP.Height -3)
             .Right = .Left +(QTBtnBMP.Width \btnCount) -6
             .Bottom = .Top +3
            END WITH
            Bitmap1.CopyRect(Dest, QTBtnBMP, Source)
           NEXT I
				' Les verticaux ------------------------------------------------------
           FOR I = False TO True
            WITH Dest
             .Left = ((Width1 \btnCount) *J) _
              +IIF(I = False, False, (Width1 \btnCount) -3) +(True *(J +True)) +(J *2) _
              -IIF(J = 2, True, False)
             .Top = maxnumbmp_QTBtn -IIF(J = 2, True, False)
             .Right = .Left +3
             .Bottom = Height1 -2 -IIF(J = 2, True, False)
            END WITH
            WITH Source
             .Left = ((QTBtnBMP.Width \btnCount) *J) +IIF(I = False, False, (QTBtnBMP.Width \btnCount) -3)
             .Top = 3
             .Right = .Left +3
             .Bottom = QTBtnBMP.Height -3
            END WITH
            Bitmap1.CopyRect(Dest, QTBtnBMP, Source)
           NEXT I
          NEXT J
          Bitmap1.PixelFormat = DefPixelFormat
         ELSE
			' Thème activé (Windows XP)
			' --
          DIM hTheme AS LONG
			'On Error Resume Next

			' Ouverture du thème
          DIM rtButton AS STRING
          rtButton = ""
			' Format unicode ?!?
          FOR I = True TO LEN(BtnType)
           rtButton = rtButton +MID$(BtnType, I, True) +rqNullChr
          NEXT I
          rtButton = rtButton +rqNullChr ' Un dernier pour finaliser

          DIM fixTab AS INTEGER
          fixTab = False
          IF BtnType = xpt_TabBtn THEN _
           fixTab = True

			'hTheme = False
          hTheme = OpenThemeData_QTBtn(Sender.Handle, VARPTR(rtButton))
          IF hTheme = False THEN _
           hTheme = OpenThemeData_QTBtn(Sender.Handle, 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 class + l'état à dessiner
				' tR est un RECT spécifiant la zone dans laquelle dessiner
           m_hDC = XPBitmap1.Handle
           m_lPartId = True 'BP_PUSHBUTTON
           FOR I = False TO 2 STEP 2
            m_lStateId = I +True 'PBS_NORMAL
            tR.Left = ((I *(Sender.Width +3)) +IIF(I <> 2, True, False)) +HideBevelSize
            tR.Top = True -IIF(I <> 2, False, True) +HideBevelSize 'False -iif(I <> 2, False, True)
            tR.Right = (tR.Left +Sender.Width) -(HideBevelSize *2) '+True
            tR.Bottom = (Sender.Height +True -IIF(I <> 2, False, True) +fixTab) -HideBevelSize '+iif(I <> 2, True, False)

            lR = DrawThemeBackground_QTBtn(hTheme, _
             m_hDC, _
             m_lPartId, _
             m_lStateId, _
             tR, tR)
           NEXT I
				' Inverse Survolle et Désactivé
           FOR I = True TO 3 STEP 2
            m_lStateId = I +True 'PBS_NORMAL
            tR.Left = (((I +IIF(I = True, 2, -2)) *(Sender.Width +3)) +True) +HideBevelSize
            tR.Top = True +HideBevelSize 'False
            tR.Right = (tR.Left +Sender.Width) -(HideBevelSize *2) '+True
            tR.Bottom = Sender.Height +True +fixTab -HideBevelSize'+2

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

			' Session de dessin terminée
          CloseThemeData_QTBtn hTheme
          CloseThemeData_QTBtn hTheme
			'//--
          XPBitmap1.PixelFormat = DefPixelFormat
         END IF

        END IF
        Width2 = ((Sender.Width +3) *btnCount) +True
        Height2 = Sender.Height +3

        XPBtnType = BtnType
        IF XPThemeEnabled = False OR isXP_QTBtn = False THEN
         Sender.BMP = Bitmap1.BMP
        ELSE
         Sender.BMP = XPBitmap1.BMP
        END IF
       END SUB

'Public:
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Fri 2024-3-29  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2013-06-19 07:50:36