animate.bas

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

'
    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
'
    IsInitialized& = GetClassInfoEx(zInstance, zClass, wc)
    IF IsInitialized&   = 0 THEN
       wc.cbSize        = SIZEOF(wc)
       wc.style         = %CS_HREDRAW OR %CS_VREDRAW
       wc.lpfnWndProc   = CODEPTR(WndProc)
       wc.cbClsExtra    = 0
       wc.cbWndExtra    = 0
       wc.hInstance     = zInstance
       wc.hIcon         = LoadIcon(wc.hInstance, "PROGRAM")
       wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
       wc.hbrBackground = %NULL ' GetStockObject(%BLACK_BRUSH)
       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
'
     ' Window Extended Style
       dwExStyle = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE
     ' Windows Style
       dwStyle = %WS_VISIBLE OR %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN OR %WS_CAPTION OR _
                 %WS_SYSMENU ' OR %WS_MAXIMIZEBOX OR %WS_MINIMIZEBOX
'
       CALL SetRect(rc, 0, 0, 640, 480)
       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$ = "GDImage control Animation template " + ZI_Version + " - CPU Speed" + STR$(zGetCpuSpeed) + " Mhz"
       hMain = CreateWindowEx(dwExStyle, _            ' Extended Style For The Window
                             zClass, _                ' Class Name
                             (MyTitle$), _            ' Window Title
                             dwStyle OR _             ' Defined Window Style
                             %WS_CLIPSIBLINGS OR _    ' Required Window Style
                             %WS_CLIPCHILDREN, _      ' Required 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

        ' Create button "Load Image"
          CALL CreateWindowEx(0, "BUTTON", "Slower", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           640 - (10 + 50 + 6), 10, 52, 22, hMain, %ID_SLOW, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_SLOW), zDefaultFont)

        ' Create button "Save Image AS"
          CALL CreateWindowEx(0, "BUTTON", "Faster", %WS_CHILD OR %WS_VISIBLE, _
                           640 - (10 + 50 + 6), 10 + (22 + 5)* 1, 52, 22, hMain, %ID_FAST, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_FAST), zDefaultFont)

        ' Create Static 
          CALL zStaticCenter("Fps ", 640 - (10 + 50 + 6), 470 - 18, 52, 18, hMain, %ID_STATIC)

        ' ******************************************************************************
        ' Helper function to create A GDImage control (with automatic scrollbar support)
        ' ------------------------------------------------------------------------------
          CALL ZI_CreateWindow(hMain, 10, 10, 740 - (10 + 10 + 150 + 10 + 10), 480 - (10 * 2), %ID_CTRL)
          CALL ZI_SetProperty(GetDlgItem(hMain, %ID_CTRL), %ZI_GradientTop, RGB(0,32,64))
          CALL ZI_SetProperty(GetDlgItem(hMain, %ID_CTRL), %ZI_GradientBottom, RGB(0,128,200))
          CALL ZI_SetFromFile(GetDlgItem(hMain, %ID_CTRL), "avalon.jpg")
        ' ******************************************************************************

        ' Draw overlayed text in a GDImage Control
        ' ******************************************************************************
        ' Require the use of True Type Font name (TTF)
        ' This type of overlay doesn't alter the image shown in the background
        ' ------------------------------------------------------------------------------
          ShadowOffset& = 0
          CALL ZD_DrawTextToCtrl(GetDlgItem(hMain, %ID_CTRL), _       ' The GDImage control handle
                                 "KARAOKE marquee effect", _          ' The text to be displayed
                                 150, _                               ' X coordinate
                                 350, _                               ' Y coordinate
                                 ZD_ColorARGB(255,RGB(255,255,255)), _ ' The ARGB color to use
                                 $Times_New_Roman, _                  ' The True Type Font to use
                                 40, _                                ' The font size in pixel
                                 %ID_TEXT_KARAOKE, _                  ' The unique object ID
                                 %ZS_VISIBLE, _                       ' Overlay visible at startup
                                 ShadowOffset&)                       ' Optional shadow effect (offset in pixel)



        ' Show the main window
          CALL ShowWindow(hMain, iCmdShow)

        
        ' Get the %ID_TEXT_KARAOKE properties
          CALL GetClientRect (ZD_GetObjectParent(%ID_TEXT_KARAOKE), rc): xRight& = rc.nRight
          CALL ZD_GetObjectBound(%ID_TEXT_KARAOKE, xBoundWidth&, xBoundHeight&)
          CALL ZD_GetOBjectXY(%ID_TEXT_KARAOKE, xX&, Xy&)
          X1& = xX&
          UseStep = 2
          Alpha? = 255: Red? = 255: Green? = 255: Blue? = 255

          ImageList$ = "avalon.jpg,genus.jpg" ' <-- Edit this to add more pictures
          ImageCount& = PARSECOUNT(ImageList$)
          UseImage& = 1: fps& = 0
          T??? = TimeGetTime(): C??? = T??? + 500


        ' Are we running on a fast computer ?
          IF zGetCpuSpeed > 2000 THEN ' YES
             GoodSpeed& = -1
          ELSE ' Try to BOOST the priority (other process may not be responding well)
             lBoost& = SetPriorityClass (GetCurrentProcess, %HIGH_PRIORITY_CLASS)
          END IF

        ' Animation loop 
        ' Note: Use it only when you want to perform fast animation, because it is very CPU intensive)
          Done& = -1: LoopCount& = 0
          WHILE Done& 
            ' Process all pending messages 
              WHILE PeekMessage(Msg, 0, 0, 0, 0) = %TRUE 
                  IF GetMessage(Msg, 0, 0, 0) THEN 
                     CALL TranslateMessage(Msg)
                     CALL DispatchMessage(Msg)
                  ELSE 
                      Done& = 0: EXIT LOOP
                  END IF
              WEND

            ' Perform Animations THERE
            ' ------------------------
              IF Done& THEN 
                 INCR fps&
 
                 IF GoodSpeed& THEN ' If computer is fast enough
                  ' Change image background each 2 seconds 
                    IF T??? < TimeGetTime() THEN
                       INCR UseImage&: IF UseImage& > ImageCount& THEN UseImage& = 1
                       CALL ZI_SetFromFile(GetDlgItem(hMain, %ID_CTRL), PARSE$(ImageList$, UseImage&))
                       T??? = TimeGetTime() + 2000
                    END IF
                 END IF

               ' Perform horizontal marquee effect
                 IF C??? < TimeGetTime() THEN ' Change color randomly
                    Alpha? = 255
                    Red?   = RND(64,255)
                    Green? = RND(64,255)
                    Blue?  = RND(255,32)
                    CALL ZD_SetObjectARGB(%ID_TEXT_KARAOKE, Alpha?, Red?, Green?, Blue?)
                    C??? = TimeGetTime() + 500
                    IF fpsDone& < 5 THEN
                       CALL SetWindowText(GetDlgItem(hMain, %ID_STATIC), _
                                          EXTRACT$(zGetCTLText(GetDlgItem(hMain, %ID_STATIC)), " ") + STR$(fps& * 2))
                       INCR fpsDone&
                    END IF
                    fps& = 0
                 END IF
                 X1& = X1& - UseStep
                 CALL ZD_SetObjectXY(%ID_TEXT_KARAOKE, X1&, Xy&, %ZD_DRAW_REDRAW)' %ZD_DRAW_DEFERRED)
                 IF X1& < -xBoundWidth& THEN X1& = xRight& + xBoundWith&

               ' UnRem ZI_UpdateWindow if you use %ZD_DRAW_DEFERRED
                 'CALL ZI_UpdateWindow(GetDlgItem(hMain, %ID_CTRL), %FALSE)
                 
              END IF 
            ' ------------------------

          WEND 
          
          FUNCTION = msg.wParam
       END IF

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

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

FUNCTION WndProc(BYVAL hWin&, BYVAL Msg&, BYVAL wParam&, BYVAL lParam&) EXPORT AS LONG
    LOCAL ps AS PAINTSTRUCT
    LOCAL rc AS RECT

    STATIC InProgress&

    SELECT CASE Msg&

    CASE %WM_COMMAND
         wP& = LOWRD(wParam&)

         SELECT CASE LONG wP&
         CASE %ID_SLOW
              UseStep = MAX&(UseStep - 1, 1)
         CASE %ID_FAST
              UseStep = MIN&(UseStep + 1, 20)
         END SELECT

    CASE %WM_CREATE
    CASE %WM_TIMER
    CASE %WM_MOVING
    CASE %WM_SIZE
    CASE %WM_PAINT
         CALL GradientPaint(hWin&, RGB(228,227,227), RGB(168,167,191))
         FUNCTION = 0: EXIT FUNCTION
    CASE %WM_CLOSE
    CASE %WM_DESTROY
         CALL PostQuitMessage(0)
         FUNCTION = 0: EXIT FUNCTION
    END SELECT
    FUNCTION = DefWindowProc(hWin&, Msg&, wParam&, lParam&)
END FUNCTION

SUB GradientPaint(BYVAL hWin&, BYVAL TopRGB&, BYVAL BottomRGB&)
    LOCAL ps AS PAINTSTRUCT
    LOCAL rc AS RECT
  ' Tile the background
    CALL GetClientRect (hWin&, rc)
    hDC& = BeginPaint(hWin&, ps)
    CALL ZI_GradientPaintDC(hDC&, 0, 0, rc.nRight, rc.nBottom, TopRGB&, BottomRGB&)
    CALL EndPaint(hWin&, ps)
END SUB