zskin.inc

Powerbasic 对GDI 的操作 很漂亮的代码!

    IF GetVersionEx(os) THEN

       SELECT CASE LONG os.dwPlatformId
       CASE 1
            FUNCTION = os.dwPlatformId
            IF os.dwMinorVersion = 0 THEN
               FUNCTION = 95  ' "Windows 95"
            ELSEIF os.dwMinorVersion = 10 THEN
               FUNCTION = 98  ' "Windows 98"
            ELSEIF os.dwMinorVersion = 90 THEN
               FUNCTION = 100 ' "Windows ME"
            END IF
       CASE 2
            FUNCTION = os.dwPlatformId
            IF os.dwMajorVersion = 3 THEN
               FUNCTION = 351 ' "Windows NT 3.51"
            ELSEIF os.dwMajorVersion = 4 THEN
               FUNCTION = 400 ' "Windows NT 4.0"
            ELSEIF os.dwMajorVersion = 5 THEN
               FUNCTION = 500 ' "Windows 2000"
               IF os.dwMinorVersion = 1 THEN
                  FUNCTION = 501 ' "Windows XP"
               END IF
            ELSEIF os.dwMajorVersion = 6 THEN
               FUNCTION = 600 ' "Windows VISTA"
            END IF
       CASE ELSE
            FUNCTION = -1     ' "Unknown"
       END SELECT
    ELSE
       FUNCTION = 0           ' "Failed"
    END IF

END FUNCTION

'// VISTA detection
FUNCTION Vista() AS LONG
    Static Done, nRet AS LONG
    IF Done = 0 THEN Done = -1: IF zOsVersion > 599 THEN nRet = -1
    FUNCTION = nRet
END FUNCTION

'// Static function to save the main window handle.
FUNCTION zMainWindow(BYVAL hMain AS LONG) AS LONG
    STATIC WasMain AS LONG
    IF hMain THEN
       WasMain = hMain
    END IF
    FUNCTION = WasMain
END FUNCTION

'// START VISTA SECTION --------------------------------------------
%S_OK = 0
%WM_DWMCOMPOSITIONCHANGED     = &H031E
%DWM_BB_ENABLE                = &H00000001
%DWM_BB_BLURREGION            = &H00000002
%DWM_BB_TRANSITIONONMAXIMIZED = &H00000004
%DWM_EC_ENABLECOMPOSITION     = 1
%DWM_EC_DISABLECOMPOSITION    = 0

TYPE DWM_BLURBEHIND
    dwFlags  AS DWORD
    fEnable  AS LONG
    hRgnBlur AS DWORD
    fTransitionOnMaximized AS LONG
END TYPE

TYPE MARGINS
    cxLeftWidth    AS LONG
    cxRightWidth   AS LONG
    cyTopHeight    AS LONG
    cyBottomHeight AS LONG
END TYPE

FUNCTION LoadDWM () AS LONG
    STATIC hLib AS DWORD, nChecked AS LONG
    IF nChecked = 0 THEN nChecked = -1: hLib = LoadLibrary ("dwmapi.dll")
    FUNCTION = hLib
END FUNCTION

DECLARE FUNCTION DwmEnableComposition (BYVAL uCompositionAction AS LONG) AS LONG
SUB zDwmEnableComposition (BYVAL uCompositionAction AS LONG)
    LOCAL nRet AS LONG, hLib AS DWORD
    STATIC hProc AS DWORD
    hLib = LoadDWM()
    IF hLib THEN
       IF hProc = 0 THEN hProc = GetProcAddress(hLib, "DwmEnableComposition")
       IF hProc THEN
          CALL DWORD hProc USING DwmEnableComposition(uCompositionAction) TO nRet
       END IF
    END IF
END SUB

DECLARE FUNCTION DwmIsCompositionEnabled () AS LONG
FUNCTION zDwmIsCompositionEnabled () AS LONG
    LOCAL nRet AS LONG, hLib AS DWORD
    STATIC hProc AS DWORD
    hLib = LoadDWM()
    IF hLib THEN
       IF hProc = 0 THEN hProc = GetProcAddress(hLib, "DwmIsCompositionEnabled")
       IF hProc THEN
          CALL DWORD hProc USING DwmIsCompositionEnabled() TO nRet
          IF nRet THEN FUNCTION = -1
       END IF
    END IF
END FUNCTION

DECLARE FUNCTION DwmEnableBlurBehindWindow (BYVAL LONG, pBlurBehind AS DWM_BLURBEHIND) AS LONG
SUB zSetBlurBehindMode(BYVAl hWnd AS LONG, BYVAL nBOOL AS LONG, BYVAL hRgnBlur AS LONG)
    LOCAL bb AS DWM_BLURBEHIND
    LOCAL hLib AS DWORD, nRet AS LONG
    STATIC hProc AS DWORD
    hLib = LoadDWM ()
    IF hLIB THEN
       IF zDwmIsCompositionEnabled() THEN
          IF hProc = 0 THEN hProc = GetProcAddress(hLib, "DwmEnableBlurBehindWindow")
          IF hProc THEN
             nRet = %S_OK
'            // Create and populate the BlurBehind structure.
'            // Set Blur Behind and Blur Region.
             bb.fEnable = nBOOL
             bb.dwFlags = %DWM_BB_ENABLE OR %DWM_BB_BLURREGION
             bb.hRgnBlur = hRgnBlur
'            // Set Blur Behind mode.
             CALL DWORD hProc USING DwmEnableBlurBehindWindow(hWnd, bb) TO nRet
          END IF
       END IF
    END IF
END SUB

SUB zSetCrystalBehindMode(BYVAl hWnd AS LONG, BYVAL nBOOL AS LONG)
    LOCAL bb AS DWM_BLURBEHIND
    LOCAL hLib AS DWORD, nRet, hRgnBlur AS LONG
    STATIC hProc AS DWORD
    hLib = LoadDWM ()
    IF hLIB THEN
       IF zDwmIsCompositionEnabled() THEN
          IF hProc = 0 THEN hProc = GetProcAddress(hLib, "DwmEnableBlurBehindWindow")
          IF hProc THEN
             nRet = %S_OK
'            // Create and populate the BlurBehind structure.
'            // Set Blur Behind and Blur Region.
             bb.dwFlags = %DWM_BB_ENABLE OR %DWM_BB_BLURREGION
             bb.fEnable = nBOOL
             bb.fTransitionOnMaximized = 0
'            // Fool VISTA with a fake region
             hRgnBlur = CreateRectRgn(-1, -1, 0, 0)
             bb.hRgnBlur = hRgnBlur
'            // Set Blur Behind mode.
             CALL DWORD hProc USING DwmEnableBlurBehindWindow(hWnd, bb) TO nRet
          END IF
       END IF
    END IF
END SUB
'// END VISTA SECTION --------------------------------------------

FUNCTION zCharLower(zTmp AS ASCIIZ) AS STRING
    CALL CharLower(zTmp)
    FUNCTION = zTmp
END FUNCTION

FUNCTION zCursorWait () AS LONG
    FUNCTION = SetCursor(LoadCursor(%NULL, BYVAL %IDC_WAIT))
END FUNCTION

FUNCTION zCursorStd () AS LONG
    FUNCTION = SetCursor(LoadCursor(%NULL, BYVAL %IDC_ARROW))
END FUNCTION

'// SKIN PROPERTIES
FUNCTION zSkinAuthor(BYVAL sAuthor AS STRING) AS STRING
    STATIC sWasAuthor AS STRING
    IF LEN(sAuthor) THEN sWasAuthor = sAuthor
    FUNCTION = sWasAuthor
END FUNCTION
'// Return the SKIN Author's name
FUNCTION SK_AUTHOR() AS STRING
    FUNCTION = zSkinAuthor("")
END FUNCTION

FUNCTION zCXSYSICON(BYVAL N AS LONG, BYVAL RW AS LONG) AS LONG
    STATIC WasN AS LONG
    IF RW THEN WasN = N
    FUNCTION = WasN
END FUNCTION
FUNCTION zCYSYSICON(BYVAL N AS LONG, BYVAL RW AS LONG) AS LONG
    STATIC WasN AS LONG
    IF RW THEN WasN = N
    FUNCTION = WasN
END FUNCTION
'// Return ICON's location
SUB zGetSysIconXY(BYREF x AS LONG, BYREF y AS LONG)
    x = zCXSYSICON(0, 0)
    y = zCYSYSICON(0, 0)
END SUB

FUNCTION zCXCAPTEXT(BYVAL N AS LONG, BYVAL RW AS LONG) AS LONG
    STATIC WasN AS LONG
    IF RW THEN WasN = N
    FUNCTION = WasN
END FUNCTION
FUNCTION zCYCAPTEXT(BYVAL N AS LONG, BYVAL RW AS LONG) AS LONG
    STATIC WasN AS LONG
    IF RW THEN WasN = N
    FUNCTION = WasN
END FUNCTION
'// Return CAPTION's location
SUB zGetCaptionXY(BYREF x AS LONG, BYREF y AS LONG)
    x = zCXCAPTEXT(0, 0)
    y = zCYCAPTEXT(0, 0)
END SUB

FUNCTION zBTNFIXX(BYVAL N AS LONG, BYVAL RW AS LONG) AS LONG
    STATIC WasN AS LONG
    IF RW THEN WasN = N
    FUNCTION = WasN
END FUNCTION
FUNCTION zBTNFIXY(BYVAL N AS LONG, BYVAL RW AS LONG) AS LONG
    STATIC WasN AS LONG
    IF RW THEN WasN = N
    FUNCTION = WasN
END FUNCTION
'// Return BUTTON's fixed border X,Y size
SUB zGetButtonFixXY(BYREF x AS LONG, BYREF y AS LONG)
    x = zBTNFIXX(0, 0)
    y = zBTNFIXY(0, 0)
END SUB

FUNCTION zFOLDER(BYVAL sPath AS STRING, BYVAL RW AS LONG) AS STRING
    STATIC sWasPath AS STRING
    IF RW THEN sWasPath = sPath
    FUNCTION = sWasPath
END FUNCTION
FUNCTION SK_FOLDER() AS STRING
    FUNCTION = zFOLDER("", 0)
END FUNCTION

FUNCTION zSkinPath(BYVAL sBF AS STRING, BYVAL sExePath AS STRING) AS STRING
    sBF = PARSE$(sBF, 2): REPLACE "@PATH@" WITH sExePath IN sBF
    FUNCTION = sBF
END FUNCTION

FUNCTION zACTIVECAPTION(BYVAL nColor AS LONG, BYVAL RW AS LONG) AS LONG
    STATIC WasColor AS LONG
    IF RW THEN WasColor = nColor
    FUNCTION = WasColor
END FUNCTION
FUNCTION SK_ACTIVECAPTION() AS LONG
    FUNCTION = zACTIVECAPTION(0, 0)
END FUNCTION

FUNCTION zINACTIVECAPTION(BYVAL nColor AS LONG, BYVAL RW AS LONG) AS LONG
    STATIC WasColor AS LONG
    IF RW THEN WasColor = nColor
    FUNCTION = WasColor
END FUNCTION
FUNCTION SK_INACTIVECAPTION() AS LONG
    FUNCTION = zINACTIVECAPTION(0,0)
END FUNCTION

FUNCTION zTEXTCOLOR(BYVAL nColor AS LONG, BYVAL RW AS LONG) AS LONG
    STATIC WasColor AS LONG
    IF RW THEN WasColor = nColor
    FUNCTION = WasColor
END FUNCTION
FUNCTION SK_TEXTCOLOR() AS LONG
    FUNCTION = zTEXTCOLOR(0,0)
END FUNCTION

FUNCTION zBTNTEXTCOLOR(BYVAL nColor AS LONG, BYVAL RW AS LONG) AS LONG
    STATIC WasColor AS LONG
    IF RW THEN WasColor = nColor
    FUNCTION = WasColor
END FUNCTION
FUNCTION SK_BTNTEXTCOLOR() AS LONG
    FUNCTION = zBTNTEXTCOLOR(0,0)
END FUNCTION

FUNCTION zPOPMENUTEXT(BYVAL nColor AS LONG, BYVAL RW AS LONG) AS LONG
    STATIC WasColor AS LONG
    IF RW THEN WasColor = nColor
    FUNCTION = WasColor
END FUNCTION