hal.bas

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

       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, 740, 420)
       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 " + ZI_Version + " - HAL ""Bouncing ball"" sprite demo"
       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 "START"
          CALL CreateWindowEx(0, "BUTTON", "START", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           740 - (7 + 120 + 8), 10, 120, 22, hMain, %ID_START_SHOW, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_START_SHOW), zDefaultFont)

        ' Create button "STOP"
          CALL CreateWindowEx(0, "BUTTON", "STOP", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           740 - (7 + 120 + 8), 10 + (22 + 5) * 1, 120, 22, hMain, %ID_STOP_SHOW, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_STOP_SHOW), zDefaultFont)

        ' ******************************************************************************
        ' Alternate methode to create a GDImage control
        ' We read first the size of the image to create
        ' window with client rectangle matching exactly
        ' the image size.
        ' ------------------------------------------------------------------------------
          FullPathName$ = "hal.jpg"
          CALL ZI_GetImageSizeFromFile((FullPathName$), imgWidth&, imgHeight&)
          UseW& = imgWidth&  ' Use this to preserve the size of the picture
          UseH& = imgHeight& ' Use this to preserve the size of the picture
          Style& = %WS_CHILD OR %WS_VISIBLE 'OR %WS_HSCROLL OR %WS_VSCROLL
          StyleEx& = %WS_EX_STATICEDGE
          CALL ZI_AdjustWindowRect(StyleEx&, UseW&, UseH&, Style&)
          hCtrl = CreateWindowEx(StyleEx&, _
                                 "ZIMAGECTRL", _            ' GDImage class name
                                 (FullPathName$), _         ' Optional full path name to picture
                                 Style&, _                  ' window style
                                 10, _                      ' initial x position
                                 10, _                      ' initial y position
                                 useW&, _                   ' Calculate Window Width
                                 useH&, _                   ' Calculate Window Height
                                 hMain, _                   ' parent window handle
                                 %ID_CTRL, _                ' ControlID
                                 zInstance, _               ' program instance handle
                                 BYVAL 0)                   ' creation parameters

          CALL ZD_DrawTextToCtrl(hCtrl, _                         ' The GDImage control handle
                                 "HAL is watching you!", _        ' The text to be displayed
                                 %CtrlW, _                        ' X coordinate
                                 174, _                           ' Y coordinate
                                 ZD_ColorARGB(128,RGB(0,0,0)), _ ' The ARGB color to use
                                 $Times_New_Roman, _              ' The True Type Font to use
                                 40, _                            ' The font size in pixel
                                 %ID_OBJECT_MARQUEE, _            ' The unique object ID
                                 %ZS_VISIBLE, _                   ' Overlay visible at startup
                                 0)                   ' Optional shadow effect (offset in pixel)
          CALL ZD_GetObjectBound(%ID_OBJECT_MARQUEE, xBoundWidth, xBoundHeight)


        ' Show the main window
          CALL ShowWindow(hMain, iCmdShow)
          CALL SetForegroundWindow(hMain)                ' Slightly Higher Priority
          CALL SetFocus(hCtrl)                           ' Sets Keyboard Focus To The Window

'        ' This is a special message loop to render fast animation
'          WHILE Done = %FALSE                             ' Loop That Runs While done = %FALSE
'             IF PeekMessage(Msg, %NULL, 0, 0, %PM_REMOVE) THEN ' Is There A Message Waiting?
'                IF msg.message = %WM_QUIT THEN            ' Have We Received A Quit Message?
'                   Done = %TRUE                           ' If So done = %TRUE
'                ELSE                                      ' If Not, Deal With Window Messages
'                   'IF TranslateAccelerator(ghWnd,hAccel, Msg) = 0 THEN
'                      CALL TranslateMessage(msg)          ' Translate The Message
'                      CALL DispatchMessage(msg)           ' Dispatch The Message
'                   'END IF
'                END IF
'             ELSE             ' If There Are No Messages
'              ' Draw The Scene.
'                IF Active THEN
'                   IF Animate THEN
'
'                      CALL DrawSprite                     ' Draw The Scene (Don't Draw When Inactive 1% CPU Use)
'
'                   ELSEIF Animate = 0 THEN
'                      CALL apisleep(10)
'                   END IF
'                ELSE          ' When minimized don't hog the CPU.
'                   CALL apiSleep(100)
'                END IF
'             END IF
'          WEND

'/////////////////////////////////
          CALL SetTimer(hMain, 1, 0, %NULL)
          CALL SetTimer(hMain, 2, 20, %NULL)
          WHILE GetMessage(Msg, %NULL, 0, 0)
                CALL TranslateMessage(Msg)
                CALL DispatchMessage(Msg)
          WEND
          CALL KillTimer(hMain, 1)
          CALL KillTimer(hMain, 2)
'/////////////////////////////////

          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

SUB DrawSprite()
    REGISTER k AS LONG
    LOCAL x AS LONG, y AS LONG
    DIM s AS SpriteDataStruct PTR
    
    IF Animate THEN
       FOR k = 4 TO 1 STEP -1
           
           s = VARPTR(SpriteData(k))

           IF @s.xDir > 0 THEN
              IF @s.xPos + @s.nWidth > %CtrlW THEN @s.xDir = [e-mail]
           ELSEIF @s.xPos < 0 THEN 
              @s.xDir = [e-mail]
           END IF

           IF @s.yDir > 0 THEN
              IF @s.yPos + @s.nHeight > %CtrlH THEN @s.yDir = [e-mail]
           ELSEIF @s.yPos < 0 THEN 
              @s.yDir = [e-mail]
           END IF
          
           @s.xPos = @s.xPos + @s.xDir
           @s.yPos = @s.yPos + @s.yDir
           CALL ZD_SetObjectXY(@s.ID, @s.xPos, @s.yPos, %FALSE)

       NEXT

       IF FastComputer THEN
        ' Perform marquee text animation
          CALL ZD_GetOBjectXY(%ID_OBJECT_MARQUEE, x, y)
          x = x - 2: IF x < -xBoundWidth THEN x = %CtrlW + xBoundWidth
          CALL ZD_SetObjectXY(%ID_OBJECT_MARQUEE, x, y, %ZD_DRAW_DEFERRED)
       END IF

     ' Here we update the control display
       CALL ZI_UpdateWindow(hCtrl, 0)

'CALL apiSleep(1)

    END IF
END SUB

SUB GetMyBitmap(BYVAL hWin AS LONG)

    DIM SpriteData(1 TO 4) AS SpriteDataStruct

    SpriteData(1).ImageName = "yellow.png"
    SpriteData(2).ImageName = "blue.png"
    SpriteData(3).ImageName = "green.png"
    SpriteData(4).ImageName = "red.png"

    FOR K& = LBOUND(SpriteData) TO UBOUND(SpriteData)
'        CALL ZI_GetBitmapSize(hBitmap&, bmW&, bmH&)
        SpriteData(K&).hBitmap = ZI_CreateBitmapFromFile(SpriteData(K&).ImageName, bmW&, bmH&)
        SpriteData(K&).ID      = %ID_OBJECT_SPRITE + K&
        SpriteData(K&).nWidth  = bmW&
        SpriteData(K&).nHeight = bmH&
        SpriteData(K&).xPos    = RND(0, 400)
        SpriteData(K&).yPos    = RND(0, 300)
        
        CALL ZD_DrawBitmapToCtrl(hCtrl, SpriteData(K&).xPos, SpriteData(K&).yPos, _
                                 SpriteData(K&).hBitmap, &HFFFFFFFF, SpriteData(K&).ID, %ZS_VISIBLE)
        
    NEXT
    
    SpeedStep& = 0
    FOR K& = UBOUND(SpriteData) TO LBOUND(SpriteData) STEP -1
        INCR SpeedStep&
        SpriteData(K&).xDir    = IIF&(RND(0, 1), SpeedStep& * 2, SpeedStep& * -2)
        SpriteData(K&).yDir    = IIF&(RND(0, 1), SpeedStep& * 2, SpeedStep& * -2)
    NEXT
    
  ' REM the code below if you want to see it at full speed '<<<<<<<<<
    IF zGetCpuSpeed > 2000 THEN ' YES, then we use alphablending for the 4 sprites
       FastComputer = -1
       FOR K& = LBOUND(SpriteData) TO UBOUND(SpriteData)
           CALL ZD_SetObjectAlpha(%ID_OBJECT_SPRITE + K&, 200, %FALSE)
       NEXT
    ELSE
       CALL ZD_SetObjectAlpha(%ID_OBJECT_SPRITE + UBOUND(SpriteData), 200, %FALSE)
    END IF

    CALL ZD_SetObjectImageLabel(%ID_OBJECT_SPRITE + 1, ("yellow"))
    CALL ZD_SetObjectImageLabel(%ID_OBJECT_SPRITE + 2, ("blue"))
    CALL ZD_SetObjectImageLabel(%ID_OBJECT_SPRITE + 3, ("green"))
    CALL ZD_SetObjectImageLabel(%ID_OBJECT_SPRITE + 4, ("red"))

END SUB

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

    STATIC wasX&, wasY&

    SELECT CASE Msg&

    CASE %WM_TIMER
         CALL DrawSprite

    CASE %WM_ACTIVATE                                'Watch For Window Activate Message
         IF HIWRD(wParam&) = 0 THEN                  'Check Minimization State
            Active = 1                               'Program Is Active
         ELSE                                        'Otherwise
            Active = 0                               'Program Is No Longer Active
         END IF

    CASE %WM_SETCURSOR

    CASE %WM_COMMAND
         wP& = LOWRD(wParam&)

         SELECT CASE LONG wP&
         CASE %ID_START_SHOW
              IF LBOUND(SpriteData) < 1 THEN
                 CALL GetMyBitmap(hWin&)
                 Animate = -1
              ELSE
                 Animate = -1
              END IF

         CASE %ID_STOP_SHOW
              Animate = 0

         END SELECT

    CASE %WM_CREATE
    CASE %WM_PAINT
         CALL GradientPaint(hWin&, RGB(64,64,64), 0)
         FUNCTION = 0: EXIT FUNCTION
    CASE %WM_CLOSE
    CASE %WM_DESTROY
         IF LBOUND(SpriteData)> 0 THEN
            FOR K& = LBOUND(SpriteData) TO UBOUND(SpriteData): CALL DeleteObject(SpriteData(K&).hBitmap): NEXT
         END IF
         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