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

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

  
'$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 clPurple = &HFF00FF
     $ENDIF ' __RQINC

     CONST DefPixelFormat = 4
     CONST CharAnd	= "&"
     CONST ChardAnd	= "&&"

'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


     CONST BM_SETSTATE_QTBtn = &HF3
     CONST WM_LBUTTONDOWN_QTBtn = &H201
     CONST WM_LBUTTONUP_QTBtn = &H202
     CONST WM_MOUSELAST_QTBtn = &H209

'Type RECTAPI
'	Left As Long
'	Top As Long
'	Right As Long
'	Bottom As Long
'End Type
'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

     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

' Vérifie la version de Windows puisque certains problèmes sont identifiés
' sur l'un ou l'autre
     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, maxnumbmp AS INTEGER
     maxnumbmp = 4
     PixelFormatFix_QTBtn = maxnumbmp
     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 _
        PixelFormatFix_QTBtn = 4 ' 6 ' /-- Peut génèrer un msg OutOfResource sous Win9x
      END IF
      Mem_QTBtn.CLOSE
     END SUB
     CALL GetVersion_QTBtn

     DECLARE SUB BMPStretch_Property (Sender AS QBUTTON)
     SUB FixKind (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)

' When Group = 0 it should be clean if present
     SUB SetIndex (Index AS INTEGER, Hwnd AS LONG)
      AllQTBtnsHandle.AddItems STR$(Hwnd)
      AllQTBtnsGrouped.AddItems STR$(Index)

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

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


     TYPE QTButton EXTENDS QBUTTON
  'YRESTE/TODO
	'!Remplacé certains CopyRect par StretchDraw c'est le cas pour l'effet Survole
	'!Corriger un problème lorsqu'un 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 l'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
	'Ajouter: 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é: Souslignage de la lettre dans BMPBtn; ex: "Dé&faut"
	'!ReCorrigé: & et && dans le caption; 1 souligne, 2 donnent & sans souligner
	'?Utiliser: TextRect plutot que TextOut (n'aime pas les bounds) utiliser une API
	'!Corrigé: Effet de Souslignage appuyer sur Alt+ChrSouligné = clique
	'!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)
	'!Ajouté: Lignes Multiples basique (insèrez chr$(10) 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
	'!Corrigé: lorsque la souris pointe le btn, le clavier de répond plus
	'!Corrigé: Petit problème de positinement du texte
	'!Corrigé: Problème avec Enabled et la police en live
	'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é)
	'Indentifié: 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 et de taille.
	'				(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.
	'				(Un API sera 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.
	'			 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

      WITH QTButton
       Dest AS QRECT
       Source AS QRECT
       BMPBtn AS QBITMAP
       BMPtmp AS QBITMAP' Devrait reflété un seul btn, celui à réintégrer (normal, survole)
       ICOBMP AS QBITMAP' la petite icône à afficher sur le btn
       ActAsToolBar AS INTEGER
       PrevFocus AS LONG
       Align AS INTEGER PROPERTY SET SetAlign
       CAPTION AS STRING PROPERTY SET SetCaption
       Enabled AS INTEGER PROPERTY SET SetEnabled
       Height AS INTEGER PROPERTY SET SetHeight
       Width AS INTEGER PROPERTY SET SetWidth
       Layout AS INTEGER PROPERTY SET SetLayout
       Spacing AS INTEGER PROPERTY SET SetSpacing
       NumBMPs AS INTEGER PROPERTY SET SetNumBMPs
       NumICOBMPs AS INTEGER PROPERTY SET SetNumICOBMPs
       Kind AS INTEGER PROPERTY SET SetKind
       Down AS INTEGER PROPERTY SET SetDown
       GroupIndex AS INTEGER PROPERTY SET SetGroupIndex
       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 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
        DIM COLOR AS INTEGER, left AS INTEGER, top AS INTEGER, _
         ampandpos AS INTEGER, ampandposwidth AS INTEGER, dampand AS INTEGER, _
         capwidth AS INTEGER', noico as integer
        DIM supCaption AS STRING

        .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)
        top		= ((.Height -.TextHeight(.CAPTION)) \2) +True
        dampand = TALLY(super.CAPTION, "&&")
        supCaption = Super.CAPTION
        IF dampand = False THEN _
         ampandpos = INSTR(SupCaption, CharAnd): _
         ampandposwidth = .TextWidth(LEFT$(SupCaption -CharAnd, ampandpos)) _
        ELSE ampandposwidth	= False

        capwidth	= (.Width -( .TextWidth( FIELD$( .CAPTION _
         -IIF(dampand = False, CharAnd, ""), CHR$(10), 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 J AS INTEGER
        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

          left = capwidth +(I *(.Width +3)) +True
          IF .ICOBMP.Empty = False THEN
           IF .Layout = False THEN
            left = left +(.ICOBMP.Width \.NumICOBMPs) \2 _
             +IIF(.Layout < 2, -(.Spacing \2), False) +.Spacing +Down
           ELSEIF .Layout = True THEN
            left = left -(((.ICOBMP.Width \.NumICOBMPs) \2) _
             +IIF(.Layout < 2, -(.Spacing \2), False) +.Spacing) +Down
					'ElseIf .Layout = 2 Then
					'ElseIf .Layout = 3 Then
           END IF
          END IF

          LineCount = TALLY(.CAPTION, CHR$(10)) +True
          IF LineCount > True THEN
           FOR J = True TO LineCount
            .BMPBtn.TextOut( left +Down, _
             top +(.TextHeight(.CAPTION) *((LineCount -True) /2)) _
             +(.TextHeight(.CAPTION) *-(LineCount -J)) +Down, _
             FIELD$(.CAPTION, CHR$(10), J), _
             COLOR, -True)
           NEXT J
          ELSE
           .BMPBtn.TextOut( left +Down, _
            top +IIF(.Layout > True AND .ICOBMP.Empty = False, _
            IIF(.Layout = 2, .ICOBMP.Height, -.ICOBMP.Height) \2, _
            False ) +Down, _
            .CAPTION, _
            COLOR, -True)
					'.BMPBtn.TextRect( QTButton.Dest, 3, 3, QTButton.Caption -CharAnd, color, -True)
          END IF

          IF dampand = False AND TALLY(SupCaption, CharAnd) = True THEN
           DIM LineTop AS INTEGER
           LineTop = top +.TextHeight(.CAPTION) -True _
            -IIF(.Layout > True, _
            IIF(.Layout = 2, -.ICOBMP.Height +True, .ICOBMP.Height) \2 -True,_
            False) +Down
           .BMPBtn.Line( left +ampandposwidth -.TextWidth( MID$(SupCaption -CharAnd, ampandpos, True) ) _
            +Down, _
            LineTop, _
            left +ampandposwidth -True +Down, _
            LineTop, _
            COLOR)
          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)

				'Dim ICOtmp As QBitmap
				'If .NumICOBMPs > True Then
'					ShowMessage STR$(.ICOBMP.Width) +chr$(10) +_
'									STR$(.NumICOBMPs)
					'ICOtmp.Width = .ICOBMP.Width \.NumICOBMPs
					'ICOtmp.Height = .ICOBMP.Height
					' ==(add)
					'WITH Dest: .Left = False: .Right = ICOtmp.Width
					'		    .Top = False: .Bottom = ICOtmp.Height
					'END WITH
          WITH Source: .Left = I *(QTButton.ICOBMP.Width \QTButton.NumICOBMPs)
           .Right = .Left +(QTButton.ICOBMP.Width \QTButton.NumICOBMPs)
           .Top = False: .Bottom = ICOtmp.Height
          END WITH
          ICOtmp.CopyRect(QTButton.Dest, QTButton.ICOBMP, QTButton.Source)

				'Else
					'ICOtmp.BMP = .ICOBMP.BMP ' /-- Génère un msg OutOfResource sous Win9x
				'End If
          ICOtmp.Transparent = True ' Corrige un problème de transparence sous 9x
				' le problème de dessin mal positionné est ici
          .BMPBtn.Draw ( left, _
           (.Height +3 -.ICOBMP.Height) \2 _
           +IIF(.Layout > True AND .CAPTION <> "", _
           IIF(.Layout = 2, -.ICOBMP.Height, .ICOBMP.Height) \2, _
           False), _
           ICOtmp.BMP)
         NEXT I
			'static dummyInt As integer
			'dummyInt ++
			'if dummyint = 3 then _
			'ICOtmp.SaveToFile("C:\Test.bmp")
        END IF

        .BMP = .BMPBtn.BMP
       END SUB
       SUB ReDraw
        rWidth = .Width
        rHeight = .Height
        IF .Width = False OR .Height = False THEN .FixBtnSize
		'LockWindowUpdate_QTBtn(GetParent_QTBtn(QTButton.Handle))

        STATIC checkICO AS INTEGER
        IF checkICO = False AND .kind = False THEN
         .ICOBMP.BMP = .BMP
         checkICO = True
        END IF
        IF .NumBMPs > maxnumbmp THEN .NumBMPs = maxnumbmp
        BMPStretch_Property (QTButton)
        .BMPBtn.BMP = .BMP
        .BMPBtn.PixelFormat = DefPixelFormat' == (add)

        IF .CAPTION = "" THEN
         Super.Layout = 0 '1
         ELSE: .BMPBtn.Height = .BMPBtn.Height +.TextHeight(.CAPTION) +2
         .BMPBtn.Paint (True, .BMPBtn.Height -True, clPurple, clPurple)
         Super.Layout = 3
        END IF

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

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

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

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

        .DrawCaption
		'LockWindowUpdate_QTBtn(False)
       END SUB
	'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(QTButton.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(QTButton.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(QTButton.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(QTButton.Handle, rc3)
		'rc3.right = rc3.right -10
		'Call DrawFocusRect(GetDC(QTButton.Handle), rc3)
        END EVENT
        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 = (QTButton.BMPBtn.Width -True) \QTButton.NumBMPs
          .Top = False: .Bottom = QTButton.BMPBtn.Height
         END WITH
         IF (X < False) OR (Y < False) OR (X > .Width) _
          OR (Y > .Height) THEN
          .ReleaseHotTrack
          CALLFUNC(.OnMouseLeave, X, Y, Shift, QTButton)
         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

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

           .DrawCaption
           CALLFUNC(.OnMouseEnter, X, Y, Shift, QTButton)
          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
         EVENT OnKeyDown(Key AS WORD, Shift AS INTEGER)
'		.ReleaseHotTrack
          IF RequestRelease = False THEN
           SELECT CASE Key
           CASE 40, 39, 9: CALL NextDlg_QTBtn(True)
           CASE 38, 37: CALL NextDlg_QTBtn(False)
           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
          .DrawCaption
         END PROPERTY
         PROPERTY SET SetSpacing (lpspacing AS INTEGER)
          .Spacing = lpspacing': Super.Layout = lplayout
          .ReDraw
         END PROPERTY
         PROPERTY SET SetCaption (lpcaption AS STRING)
          IF TALLY(lpcaption, ChardAnd) = True THEN _
           .CAPTION = REPLACESUBSTR$(lpcaption, ChardAnd, CharAnd) _
          ELSE _
           .CAPTION = lpcaption -CharAnd
          Super.CAPTION = lpcaption -CHR$(10) -CHR$(13)
          .ReDraw
         END PROPERTY
         PROPERTY SET SetEnabled (lpenabled AS INTEGER)
          Super.Enabled = lpenabled: .Enabled = lpenabled
          .DrawCaption
         END PROPERTY
         PROPERTY SET SetHeight (lpheight AS INTEGER)
		'.ReleaseHotTrack
          .Height = lpheight: Super.Height = lpheight
          .ReDraw
         END PROPERTY
         PROPERTY SET SetWidth (lpwidth AS INTEGER)
          .Width = lpwidth: Super.Width = lpwidth
          .ReDraw
         END PROPERTY
         PROPERTY SET SetNumBMPs (lpnumbmps AS INTEGER)
          .NumBMPs = lpnumbmps: Super.NumBMPs = lpnumbmps
          .ReDraw
         END PROPERTY
         PROPERTY SET SetNumICOBMPs (lpnumicobmps AS INTEGER)
          .NumICOBMPs = lpnumicobmps
          .DrawCaption'ReDraw'==(mod)
         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 (numbmps, QTButton)
          .ReDraw
         END PROPERTY
         PROPERTY SET SetGroupIndex (lpIndex AS INTEGER)
          .GroupIndex = lpIndex
          CALL SetIndex(lpIndex, .Handle)
         END PROPERTY
         PROPERTY SET SetDown (lpDown AS INTEGER)
          .Down = lpDown
          .DrawDownUp
         END PROPERTY

         CONSTRUCTOR
          BMPtmp.PixelFormat = DefPixelFormat
          BMPBtn.PixelFormat = DefPixelFormat
          Spacing = maxnumbmp
          Enabled = True
          NumBMPs = True
          NumICOBMPs = True
          Layout = False'3'False
          Down = False
		'FixBtnSize
         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
        DIM Width1 AS INTEGER, Height1 AS INTEGER
        DIM Width2 AS INTEGER, Height2 AS INTEGER
        DIM btnCount AS INTEGER

        btnCount = Sender.NumBMPs
        IF btnCount > maxnumbmp THEN
         btnCount = maxnumbmp
         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 _
         ((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, Bitmap1.Width, Bitmap1.Height, clPurple)'==(mod)
          .PixelFormat = DefPixelFormat
         END WITH
         Width1 = Sender.Width *btnCount
         Height1 = Sender.Height

         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 -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 -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

		'QTBtnBMP.BMP =
         Bitmap1.PixelFormat = DefPixelFormat
        END IF
        Width2 = ((Sender.Width +3) *btnCount) +True
        Height2 = Sender.Height +3

        Sender.BMP = Bitmap1.BMP
       END SUB

'Public:
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Thu 2023-2-2  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2013-06-19 07:50:37