2013-06-19 07:54

'================= New QColorDialog =======================

'This new implementation of QColorDialog improves some issues...

'The dialog now centers on your screen.

'You can set a caption for the dialog.

'A Style property has been added...
'cdNormal (default)
'cdFullOpen (custom color palette visible)
'cdNoFullOpen (custom color button disabled)

'Parent property is no longer necessary, it uses
'Application.Handle to remove the TaskBar Icon


     CONST CC_RGBINIT = &H1
     CONST CC_FULLOPEN = &H2
     CONST CC_ENABLEHOOK = &H10
     CONST CC_PREVENTFULLOPEN = &H4
     CONST WM_INITDIALOG = &H110
     CONST SM_CXSCREEN = 0
     CONST SM_CYSCREEN = 1
     CONST SWP_NOSIZE = &H1
     CONST SWP_NOACTIVATE = &H10
     CONST cdNormal = 0          ' copy these into RapidQ.inc
     CONST cdFullOpen = 1        ' but don't delete
     CONST cdNoFullOpen = 2      ' (they're used here too)

     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 GetWindowRect LIB "user32" ALIAS "GetWindowRect"_
      (hwnd AS LONG, lpRect AS QRECT) AS LONG
     DECLARE FUNCTION MoveWindow 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 SetWindowText 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    ' remember, 1-based array!
      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
         GetWindowRect(hWnd, R)    ' this if-then statement
         MoveWindow (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
          SetWindowText(hWnd, .CAPTION)
         END IF
         Result = 1
        ELSE
         Result = 0
        END IF
       END FUNCTION

       FUNCTION EXECUTE AS LONG
        DIM L AS LONG
        .CC.lStructSize = SIZEOF(QCOLORDIALOG.CC)
        .CC.hWndOwner = Application.Handle
        .CC.RGBResult = .COLOR
        FOR L = 1 TO 16
         .CC.CustColors(L) = .Colors(L)
        NEXT L
        .CC.Flags = CC_RGBINIT 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
        .CC.lpfnHook = CODEPTR(QCOLORDIALOG.HookProc)
        IF ChooseColorDlg(.CC) <> 0 THEN
         FOR L = 1 TO 16
          .Colors(L) = .CC.CustColors(L)
         NEXT L
         .COLOR = .CC.RGBResult
         Result = 1
        ELSE
         Result = 0
        END IF
       END FUNCTION

       CONSTRUCTOR
        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

'================== Sample Program =======================

     DECLARE SUB Show

     CREATE CD AS QCOLORDIALOG
      Colors(1) = &HF0F0F0
      CAPTION = "Choose form color:"
     END CREATE

     CREATE Form AS QFORM
      OnShow = Show
     END CREATE

     Form.SHOWMODAL

     SUB Show
      CD.Style = cdNoFullOpen
      IF CD.EXECUTE THEN
       Form.COLOR = CD.COLOR
        'Form.Color = CD.Colors(3)
      END IF
     END SUB

2013-06-19 07:54