carousel.bas

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

'+--------------------------------------------------------------------------+
'|                                Carousel                                  |
'|                                                                          |
'|                      Skin Engine for VISTA and XP                        |
'|           with full crystal and blur effect in composited mode           |
'|                                                                          |
'|                Example of what is going on behind the hood.              |
'|                                                                          |
'+--------------------------------------------------------------------------+
'|                                                                          |
'|                         Author Patrice TERRIER                           |
'|                            copyright(c) 2007                             |
'|                           www.zapsolution.com                            |
'|                         [e-mail]                          |
'|                                                                          |
'+--------------------------------------------------------------------------+
'|                  Project started on : 08-04-2007 (MM-DD-YYYY)            |
'|                        Last revised : 09-30-2007 (MM-DD-YYYY)            |
'+--------------------------------------------------------------------------+

#COMPILE EXE "carousel.exe"

'//DECLARE SUB skDebug LIB "SKENGINE.DLL" (BYVAL Msg$)

#RESOURCE "control.pbr"

'// Return the SKIN Author's name
DECLARE FUNCTION SK_AUTHOR() AS STRING
'// Return SKIN color set
DECLARE FUNCTION SK_ACTIVECAPTION() AS LONG       '// COLOR ACTIVE CAPTION
DECLARE FUNCTION SK_INACTIVECAPTION() AS LONG     '// COLOR INACTIVE CAPTION
DECLARE FUNCTION SK_TEXTCOLOR() AS LONG           '// COLOR TEXT
DECLARE FUNCTION SK_BTNTEXTCOLOR() AS LONG        '// COLOR BUTTON TEXT
DECLARE FUNCTION SK_POPMENUTEXT() AS LONG         '// COLOR POPUP MENU TEXT
DECLARE FUNCTION SK_POPMENUHILITE() AS LONG       '// COLOR POPUP MENU HILIGHTED TEXT
DECLARE FUNCTION SK_ACTIVEMENUBAR() AS LONG       '// COLOR MENU BAR HILIGHTED ITEM
DECLARE FUNCTION SK_INACTIVEMENUBAR() AS LONG     '// COLOR MENU BAR DEFAULT COLOR
DECLARE FUNCTION SK_CAPTIONFONT() AS STRING       '// CAPTION FONT TO USE
DECLARE FUNCTION SK_CAPTIONFONTHEIGHT() AS LONG   '// CAPTION FONT SIZE
DECLARE FUNCTION SK_PUSHBUTFONTSIZE() AS LONG     '// PUSH BUTTON FONT SIZE
DECLARE FUNCTION SK_TRACKHICOLOR() AS LONG        '// TRACK BAR HIGHLIGHTED VALUE
DECLARE FUNCTION SK_TEXTFONT() AS STRING          '// TEXT FONT TO USE
DECLARE FUNCTION SK_AEROEMULATE() AS LONG         '// CHECK IF AERO EMULATION IS ON
DECLARE FUNCTION SK_AEROBLURLEVEL() AS LONG       '// AERO BLURING LEVEL
DECLARE FUNCTION SK_AEROCOLOR() AS LONG           '// AERO GLASS COLOR
DECLARE FUNCTION SK_AEROTIMERDELAY() AS LONG      '// AERO TIMER REFRESH DELAY
DECLARE FUNCTION SK_COLORLABEL() AS STRING        '// GDIPLUS COLOR LIST FOR COLORPICKER COMBO

#INCLUDE "ZSKIN.INC"
'#INCLUDE "ZCOLORPICK.INC"

TYPE POINTS
  x AS INTEGER
  y AS INTEGER
END TYPE

#INCLUDE "GDIMAGE.INC"
'------------------------------------------------------------------------------------------
' LOCAL section
'------------------------------------------------------------------------------------------

TYPE SpriteDataStruct
    ImageName AS ASCIIZ * 128
    hBitmap   AS LONG
    ID        AS LONG
    xPos      AS LONG
    yPos      AS LONG
    nWidth    AS LONG
    nHeight   AS LONG
    rAngle    AS SINGLE
END TYPE

%XMIN_SIZE = 801
%YMIN_SIZE = 480

%ID_CTRL                = -1
%ID_OBJECT_TEXT         = -2
                        
%ID_BTN_PLAY            = 1
%ID_BTN_PAUSE           = 2
%ID_LEFTBUTTON          = 3
%ID_RIGHTBUTTON         = 4
%ID_BTN_RESET           = 5
%ID_LABEL_SPEED         = 6
%ID_TRACK_SPEED         = 7
%ID_LABEL_FOCAL         = 8
%ID_TRACK_FOCAL         = 9
%ID_MARQUEE             = 10
%ID_OPACITY             = 11
%ID_BACKGROUND          = 12
%ID_USE3D               = 13
%ID_SELFROTATION        = 14
%ID_TRACK_Y             = 15
%ID_LABEL_Y             = 16

%ID_FRAMEBUTTON         = 17
%ID_GLASS_OPACITY_LABEL = 18
%ID_TRACK_OPACITY       = 19
%ID_AEROCRYSTAL         = 20
%ID_AEROBLUR            = 21
%ID_AERODISABLE         = 22

%AERO_TIMER             = 1
%CAROUSEL_TIMER         = 2
%BLINK_TIMER            = 3

%ID_MAX_SPRITE          = 10

%Speed_default = 4
%Focus_default = 15000
%Y_default     = 50

GLOBAL gMoveToLeft, gAnimate, gnBoundWidth, gnBoundHeight, gBlinkCount AS LONG
GLOBAL gSpriteData() AS SpriteDataStruct

'// Main entry point
FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  BYVAL lpCmdLine     AS ASCIIZ PTR, _
                  BYVAL iCmdShow      AS LONG) AS LONG

    LOCAL Msg         AS tagMsg
    LOCAL wc          AS WndClassEx
    LOCAL zClass      AS ASCIIZ * 80
    LOCAL dwExStyle   AS DWORD
    LOCAL dwStyle     AS DWORD
    LOCAL rc          AS RECT
    LOCAL x           AS LONG
    LOCAL y           AS LONG
    LOCAL hMutex      AS DWORD
    LOCAL hFound      AS DWORD
    LOCAL hMain       AS LONG
'
    LOCAL hWinXP_Lib           AS LONG ' Handle to WinXP Theme DLL
    LOCAL hWinXP_IsThemeActive AS LONG ' Handle to WinXP's IsThemeActive function
    LOCAL IsInitialized        AS LONG
    LOCAL hGDIplus             AS LONG ' GDIPLUS

    zClass = "ZCAROUSEL"
'
    hMutex = CreateMutex(BYVAL %Null, 0, zClass)
    IF hMutex THEN
       IF GetLastError = %ERROR_ALREADY_EXISTS THEN
          DO
             hFound = FindWindow(zClass, ""): IF hFound THEN EXIT DO
             WHILE PeekMessage(Msg, %NULL, %NULL, %NULL, %PM_REMOVE): WEND
          LOOP
          IF IsIconic(hFound) THEN CALL ShowWindow(hFound, %SW_RESTORE)
          CALL SetForeGroundWindow(hFound)
          FUNCTION = 0
          EXIT FUNCTION
       END IF
    END IF

    CALL zSplitN(zExeName(), "", MyTitle$)
    MyTitle$ = PARSE$(MyTitle$, ".", 1)
'   // Check first for a valid OS version (at least XP)
    IF zOsVersion < 501 THEN
       MsgBox zSysErrorMessage(197),,MyTitle$
       EXIT FUNCTION
    END IF

    wc.cbSize = SIZEOF(wc)
    IsInitialized = GetClassInfoEx(zInstance, zClass, wc)
    IF IsInitialized    = 0 THEN
       wc.cbSize        = SIZEOF(wc)
       wc.style         = %CS_HREDRAW OR %CS_VREDRAW OR %CS_DBLCLKS ' OR %CS_DROPSHADOW
       wc.lpfnWndProc   = CODEPTR(WndProc)
       wc.cbClsExtra    = 0
       wc.cbWndExtra    = %EXTEND_EXTRA * 4
       wc.hInstance     = zInstance
       wc.hIcon         = %NULL ' LoadIcon(wc.hInstance, "PROGRAM")
       wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
       wc.hbrBackground = %NULL ' Don't paint the class window background
       wc.lpszMenuName  = %NULL
       wc.lpszClassName = VARPTR(zClass)
       wc.hIconSm       = wc.hIcon
       IF RegisterClassEx(wc) THEN IsInitialized = %TRUE
    END IF
'
    IF IsInitialized THEN
'
     '************************************************************************************
     ' Load the GDImage.dll
       IF RegisterGDImageClass() = 0 THEN
          FUNCTION = 99:  EXIT FUNCTION ' If it fails to register then return ERROR = 99
       END IF
     '************************************************************************************

     ' Load the WinXP Theme support (if applicable)
       hWinXP_Lib = LoadLibrary("UxTheme.dll")
       IF hWinXP_Lib THEN
          hWinXP_IsThemeActive = GetProcAddress(hWinXP_Lib, "IsThemeActive")
       END IF
'
       CALL InitCommonControls
'
'      // Init GDIPLUS
       hGDIplus = zGdipStart()

     ' Window Extended Style
       dwExStyle = 0
     ' Windows Style, avoid using %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN with the Skin Engine
       dwStyle = %WS_POPUP ' OR %WS_CLIPCHILDREN OR %WS_CLIPSIBLINGS
'
       CALL SetRect(rc, 0, 0, %XMIN_SIZE, %YMIN_SIZE)
'      // Note: indeed we don't need AdjustWindowRectEx, because we use do not use a non-client area
'      // but it won't hurt anything to keep it, in case we change our mind ;)
       CALL AdjustWindowRectEx(rc, dwStyle, %FALSE, dwExStyle)  ' Adjust Window To True Requested Size
'
       x = MAX&((GetSystemMetrics(%SM_CXSCREEN) - rc.nRight - rc.nLeft) \ 2, 0)
       y = MAX&((GetSystemMetrics(%SM_CYSCREEN) - rc.nBottom - rc.nTop) \ 2, 0)
'
     ' Create The Window
       MyTitle$ = "Carousel"
       hMain = CreateWindowEx(dwExStyle, _           ' Extended Style For The Window
                             zClass, _               ' Class Name
                             (MyTitle$), _           ' Window Title
                             dwStyle, _              ' Defined Window Style
                             x, y, _                 ' Window Position
                             rc.nRight - rc.nLeft, _ ' Calculate Window Width
                             rc.nBottom - rc.nTop, _ ' Calculate Window Height
                             %NULL, _                ' No Parent Window
                             %NULL, _                ' No Menu
                             wc.hInstance, _         ' Instance
                             BYVAL %NULL)            ' Dont Pass Anything To WM_CREATE
'
       IF hMain THEN

        ' Apply WinXP Theme support
          LOCAL lRes AS LONG, pProc AS DWORD
          IF hWinXP_IsThemeActive THEN
             CALL DWORD hWinXP_IsThemeActive USING IsThemeActive TO lRes
             IF lRes  THEN pProc = GetProcAddress(lRes, "EnableThemeDialogTexture")
             IF pProc THEN CALL DWORD pProc USING EnableDialogTheme(hMain, &H01 OR &H02 OR &H04 OR &H06)
          END IF

'         // Load SKIN components and create SYS buttons
          CALL zInitSkin(hMain, "Blueplayer.zsk")

'         // Add the child controls being used by the application
          CALL AddChildControls(hMain)

'         // *************************************************
'         // Show main window
'         // Create region and paint controls to double buffer
'         // *************************************************
          CALL zShowMainWindow(5) ' 5 = UseStep for composited window on XP


'         // To let the user know that he should click this button to play the carousel
          CALL SetFocus(GetDlgItem(hMain, %ID_BTN_Play))
          CALL SetTimer(hMain, %BLINK_TIMER, 333, %NULL)

          CALL SetTimer(hMain, %CAROUSEL_TIMER, 0, %NULL)
          WHILE GetMessage(Msg, %NULL, 0, 0)  ' SK_MILLISECOND
             IF IsDialogMessage(hMain, Msg) = %FALSE THEN
                CALL TranslateMessage(Msg)
                CALL DispatchMessage(Msg)
             END IF
          WEND
          CALL KillTimer(hMain, %CAROUSEL_TIMER)

          FUNCTION = msg.wParam
       END IF

'      // UNLOAD the WinXP Theme DLL (if necessary)
       IF hWinXP_Lib THEN CALL FreeLibrary(hWinXP_Lib)

'      // UNLOAD GDIPLUS
       CALL zGdipEnd(hGDIplus)

    END IF
'
    IF hMutex THEN CALL CloseHandle(hMutex)
'
END FUNCTION

'// Add child controls to main window
SUB AddChildControls(BYVAL hMain AS LONG)

    LOCAL hBut, imgW, imgH AS LONG
    LOCAL Alpha, Red, Green, Blue AS BYTE
    
'   Use the same font for both Aero and Standard mode    
    CALL zTEXTRENDERING(%TextRenderingHintAntiAlias, 1)

'   Create the GDImage graphic control
    Style& = %WS_CHILD OR %WS_VISIBLE 'OR %WS_HSCROLL OR %WS_VSCROLL
    StyleEx& = 0'%WS_EX_STATICEDGE
    gCtrl& = CreateWindowEx(StyleEx&, _
                           "ZIMAGECTRL", _            ' GDImage class name
                           "", _                      ' Optional full path name to picture
                           Style&, _                  ' window style
                           17, _                      ' initial x position
                           42, _                      ' initial y position
                           588, _                     ' Calculate Window Width
                           420, _                     ' Calculate Window Height
                           hMain, _                   ' parent window handle
                           %ID_CTRL, _                ' ControlID