2013-06-19 07:49

'=======================================================
' Type Objet
' Classe QColorDialog version 1.1
'=======================================================
     $IFNDEF TRUE
      $DEFINE True 1
     $ENDIF

     $IFNDEF FALSE
      $DEFINE False 0
     $ENDIF

     CONST CC_RGBINIT=&H1
     CONST CC_FULLOPEN=&H2
     CONST CC_ENABLEHOOK=&H10
     CONST CC_PREVENTFULLOPEN=&H4
     CONST WM_INITDIALOG=&H110
     CONST SWP_NOSIZE=&H1
     CONST SWP_NOACTIVATE=&H10
     CONST cdNormal=0
     CONST cdFullOpen=1
     CONST cdNoFullOpen=2

     TYPE TCHOOSECOLOR
      lStructSize AS LONG
      hWndOwner AS LONG
      hInstance AS LONG
      rgbResult AS LONG
      CustColors(1 TO 16) AS LONG
      Flags AS DWORD
      lCustData AS LONG
      lpfnHook AS LONG
      lpTemplateName AS LONG
     END TYPE

     DECLARE FUNCTION ChooseColorDlg LIB "COMDLG32" ALIAS "ChooseColorA" (CC AS TCHOOSECOLOR) AS LONG
     DECLARE FUNCTION GetCdRect LIB "user32" ALIAS "GetWindowRect" (hwnd AS LONG, lpRect AS QRECT) AS LONG
     DECLARE FUNCTION MoveCd LIB "user32" ALIAS "MoveWindow" (hwnd AS LONG,x AS LONG,y AS LONG,nWidth AS LONG,nHeight AS LONG,bRepaint AS LONG) AS LONG
     DECLARE FUNCTION SetCdText LIB "user32" ALIAS "SetWindowTextA" (hWnd AS LONG,ByRef lpString AS STRING) AS LONG

     TYPE QCOLORDIALOG EXTENDS QOBJECT
PRIVATE:
      CC AS TCHOOSECOLOR
PUBLIC:
      CAPTION AS STRING
      COLOR AS LONG
      Colors(1 TO 16) AS LONG
      Style AS LONG

      WITH QCOLORDIALOG

       FUNCTION HookProc(hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
        DIM R AS QRECT

        IF uMsg=WM_INITDIALOG THEN  ' all initializing is done inside
         GetCdRect(hWnd,R)    ' this if-then statement
         MoveCd(hWnd,((Screen.Width-(R.Right-R.Left))/2),((Screen.Height-(R.Bottom-R.Top))/2),(R.Right-R.Left),(R.Bottom-R.Top),0)
         IF LEN(.CAPTION) THEN
          SetCdText(hWnd,.CAPTION)
         END IF
         Result=true
        ELSE
         Result=false
        END IF
       END FUNCTION

      '==========================================
      ' Méthode affichage boite dialogue couleur
      '==========================================
       FUNCTION EXECUTE AS LONG
        DIM i AS LONG

        .CC.lStructSize=SIZEOF(QCOLORDIALOG.CC)
        .CC.hWndOwner=Application.Handle
        .CC.RGBResult=.COLOR
        FOR i=1 TO 16
         .CC.CustColors(i)=.Colors(i)
        NEXT i
        .CC.Flags=CC_RGBINIT
        IF .CAPTION<>"" THEN .CC.Flags=.CC.Flags OR CC_ENABLEHOOK
        SELECT CASE .Style
        CASE cdFullOpen
         .CC.Flags =.CC.Flags OR CC_FULLOPEN
        CASE cdNoFullOpen
         .CC.Flags =.CC.Flags OR CC_PREVENTFULLOPEN
        END SELECT
        IF .CAPTION<>"" THEN .CC.lpfnHook=CODEPTR(QCOLORDIALOG.HookProc)
        IF ChooseColorDlg(.CC) <> 0 THEN
         FOR i=1 TO 16
          .Colors(i)=.CC.CustColors(i)
         NEXT i
         .COLOR=.CC.RGBResult
         Result=true
        ELSE
         Result=false
        END IF
       END FUNCTION

       CONSTRUCTOR
        CAPTION=""
        Colors(1)=&H0
        Colors(2)=&H808080
        Colors(3)=&H000080
        Colors(4)=&H008080
        Colors(5)=&H008000
        Colors(6)=&H808000
        Colors(7)=&H800000
        Colors(8)=&H800080
        Colors(9)=&HFFFFFF
        Colors(10)=&HC0C0C0
        Colors(11)=&H0000FF
        Colors(12)=&H00FFFF
        Colors(13)=&H00FF00
        Colors(14)=&HFFFF00
        Colors(15)=&HFF0000
        Colors(16)=&HFF00FF
       END CONSTRUCTOR

      END WITH
     END TYPE

2013-06-19 07:49