iconmenu.bas

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

    ARGB& = ZD_ColorARGB(255, RGB(255,255,255))
    CALL ZD_DrawTextToCtrl(gCtrl, _
                           "", _               ' The text to be displayed
                           rc.nRight, _        ' X coordinate
                           10, _               ' Y coordinate
                           ARGB&, _            ' ARGB color to use
                           (FontToUse$), _     ' The True Type Font to use (must be a valid one)
                           40, _               ' The font size in pixel
                           %ID_OBJECT_LABEL, _ ' The unique object ID
                           %ZS_VISIBLE, _      ' Overlay visible at startup
                           0, _                ' Optional shadow effect (offset in pixel)
                           0)                  ' Optional string format

 
END SUB

SUB DrawMarquee()
    LOCAL x, y AS LONG
    LOCAL rc AS RECt
    CALL GetClientRect(gCtrl, rc)
    CALL ZD_GetObjectXY(%ID_OBJECT_TEXT, x, y)
    x = x - 2	
    IF x < -gnMarqueeWidth THEN x = rc.nRight 
    CALL ZD_SetObjectXY(%ID_OBJECT_TEXT, x, y, %ZD_DRAW_DEFERRED)
END SUB

SUB DrawSprites(BYVAL hWnd AS LONG)

    REGISTER K AS LONG
    LOCAL Angle AS SINGLE
    LOCAL Alpha, Red, Green, Blue AS BYTE
   
    IF gbAnimate THEN

       FOR K = UBOUND(gSpriteArray) TO LBOUND(gSpriteArray) STEP -1
           IF gnInflateID = gSpriteArray(K).ID THEN
              IF gSpriteArray(K).scale < 1 THEN gSpriteArray(K).scale = gSpriteArray(K).scale + grScaleStep
              CALL ZD_GetObjectARGB(%ID_OBJECT_LABEL, Alpha, Red, Green, Blue)
              IF Alpha < 255 THEN 
                 Alpha = alpha + 3: CALL ZD_SetObjectAlpha(%ID_OBJECT_LABEL, (Alpha), %FALSE)
                 IF Alpha = 255 THEN
                    CALL ZD_SetObjectARGBcolor(%ID_OBJECT_LABEL, ZD_ColorARGB(Alpha, RGB(233,233,75)))
                    CALL ZD_SetObjectUse3Dshadow(%ID_OBJECT_LABEL, 1) '// Enable shadow
                 END IF
              END IF
           ELSE
              IF gSpriteArray(K).scale > grScaleDefault THEN gSpriteArray(K).scale = gSpriteArray(K).scale - grScaleStep
           END IF
           CALL ZD_SetObjectScale(gSpriteArray(K).ID, gSpriteArray(K).scale)
           Angle = ZD_GetObjectAngle(%ID_OBJECT_SPRITE + K)
           IF Angle > 0 THEN
              Angle = Angle - 8
              CALL ZD_SetObjectAngle(%ID_OBJECT_SPRITE + K, Angle, %FALSE)
           END IF
       NEXT
    
       IF SendMessage(GetDlgItem(hWnd, %ID_BTN_MARQUEE), %BM_GETCHECK, 0, 0) THEN
          CALL DrawMarquee()
       END IF

     ' Update the control display
       CALL ZI_UpdateWindow(gCtrl, 0)

    END IF
END SUB

FUNCTION WndProc(BYVAL hWnd AS LONG, BYVAL Msg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
    LOCAL ps AS PAINTSTRUCT
    LOCAL rc AS RECT, INT_REFLECTION, K, x, y, yOffset AS LONG

    SELECT CASE Msg&

    CASE %WM_TIMER
         CALL DrawSprites(hWnd)

    CASE %WM_COMMAND
         wP& = CINT(LOWRD(wParam&))

         SELECT CASE LONG wP&

         CASE %ID_BTN_REFLECTION
              INT_REFLECTION = SendMessage(GetDlgItem(hWnd, %ID_BTN_REFLECTION), %BM_GETCHECK, 0, 0)
              FOR K = LBOUND(gSpriteArray) TO UBOUND(gSpriteArray)
                  IF INT_REFLECTION THEN
                     gSpriteArray(K).hBitmap = ZI_CreateMirrorBitmapFromFile(gSpriteArray(K).ImageName, bmW&, bmH&)
                     yOffset = -8
                  ELSE
                     gSpriteArray(K).hBitmap = ZI_CreateBitmapFromFile(gSpriteArray(K).ImageName, bmW&, bmH&)
                     yOffset = 8
                  END IF
                  CALL ZD_GetObjectXY(%ID_OBJECT_SPRITE + K, x, y)
                  CALL ZD_DrawBitmapToCtrl(gCtrl, x, y + yOffset, _
                                           gSpriteArray(K).hBitmap, &HFFFFFFFF, gSpriteArray(K).ID, %ZS_VISIBLE)
              NEXT

         CASE %ID_BTN_WALLPAPER
              IF SendMessage(GetDlgItem(hWnd, %ID_BTN_WALLPAPER), %BM_GETCHECK, 0, 0) THEN
                  CALL ZI_SetFromFile(gCtrl, "vistaback.jpg")
              ELSE
                  CALL ZI_SetFromFile(gCtrl, "NoBackground.gif")
              END IF

         CASE %ID_BTN_MARQUEE              
              IF SendMessage(GetDlgItem(hWnd, %ID_BTN_MARQUEE), %BM_GETCHECK, 0, 0) THEN
                  CALL ZD_ShowObject(%ID_OBJECT_TEXT, %ZD_SHOW)
              ELSE
                  CALL ZD_ShowObject(%ID_OBJECT_TEXT, %ZD_HIDE)
              END IF             
              
         CASE %ID_BTN_RESET

              INT_REFLECTION = SendMessage(GetDlgItem(hWnd, %ID_BTN_REFLECTION), %BM_GETCHECK, 0, 0)
              IF INT_REFLECTION THEN
                 yOffset = 8
              ELSE
                 yOffset = 0
              END IF
              FOR K = LBOUND(gSpriteArray) TO UBOUND(gSpriteArray)
                  CALL ZD_SetObjectXY(%ID_OBJECT_SPRITE + K, gSpriteArray(K).xPos, gSpriteArray(K).yPos - yOffset, %FALSE)
                  CALL ZD_SetObjectAngle(%ID_OBJECT_SPRITE + K, 0, %FALSE)
              NEXT
              CALL ZI_UpdateWindow(gCtrl, %FALSE)
       
         END SELECT

    CASE %WM_ERASEBKGND
         CALL GetClientRect (hWnd, rc)
         CALL ZI_GradientPaintDC(wParam, 0, 0, rc.nRight, rc.nBottom, RGB(224,223,227), RGB(224,223,227))'RGB(168,167,191))
         FUNCTION = 1: EXIT FUNCTION

    CASE %WM_PAINT
         BeginPaint(hWnd, ps)
         CALL EndPaint(hWnd, ps)
         FUNCTION = 0: EXIT FUNCTION

    CASE %WM_DESTROY
         IF LBOUND(gSpriteArray)> 0 THEN
            FOR K& = LBOUND(gSpriteArray) TO UBOUND(gSpriteArray): CALL DeleteObject(gSpriteArray(K&).hBitmap): NEXT
         END IF
         CALL PostQuitMessage(0)
         FUNCTION = 0: EXIT FUNCTION
    END SELECT

    FUNCTION = DefWindowProc(hWnd, Msg&, wParam&, lParam&)

END FUNCTION

FUNCTION MyCallBack(BYVAL hWnd AS LONG, BYVAL Msg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
    LOCAL sMessage AS STRING, nObjectID AS LONG, rc AS RECT, nRet AS LONG
    LOCAL x AS LONG, y AS LONG

    nRet = %FALSE ' Do not stop the event processing in GDImage

    IF hWnd = GetDlgItem(hMain, %ID_CTRL) THEN ' In case we use the same callback for several GDImage control
                                               ' make sure that we handle the good one.
       nObjectID = ZI_MouseOverObjectID()
       
       SELECT CASE LONG Msg

       CASE %WM_LBUTTONDOWN

       CASE %WM_LBUTTONDBLCLK
            IF nObjectID > %ID_OBJECT_SPRITE THEN
               CALL ZD_SetObjectAngle(nObjectID, 360, %FALSE)
                        
               '////////////////////////////////////////////////
               '// Put you code there to perfom the selection //
               '////////////////////////////////////////////////
                                
            END IF

       CASE %WM_RBUTTONDOWN

       CASE %WM_MOUSEMOVE
            IF nObjectID THEN ' > ID_OBJECT_SPRITE THEN
                IF gnInflateID <> nObjectID THEN
                    gnInflateID = nObjectID
                    IF ZD_GetObjectZorder(nObjectID) <> %ZD_ORDER_TOP THEN
                        ZD_SetObjectZorder(nObjectID, %ZD_ORDER_TOP)

                        ' Show current label
                        LOCAL nBoundWidth, nBoundHeight AS LONG
                        CALL ZD_SetObjectARGBcolor(%ID_OBJECT_LABEL, ZD_ColorARGB(0, RGB(255,255,255)))
                        CALL ZD_SetObjectUse3Dshadow(%ID_OBJECT_LABEL, 0) ' Disable shadow if any
                        CALL ZD_SetObjectText(%ID_OBJECT_LABEL, ZD_GetObjectImageLabel(nObjectID)) 
                        CALL ZD_GetObjectBound(%ID_OBJECT_LABEL, nBoundWidth, nBoundHeight)
                        CALL GetClientRect(GetDlgItem(hMain, %ID_CTRL), rc)
                        CALL ZD_SetObjectXY(%ID_OBJECT_LABEL, (rc.nRight - nBoundWidth) / 2, rc.nBottom - (nBoundHeight * 2), %ZD_DRAW_DEFERRED)
                        CALL ZD_SetObjectVisibility(%ID_OBJECT_LABEL, %TRUE)
                        CALL ZD_SetObjectZorder(%ID_OBJECT_LABEL, %ZD_ORDER_BOTTOM)
                                                
                    END IF
                END IF
            ELSE ' Clear the label         
                CALL ZD_SetObjectAlpha(%ID_OBJECT_LABEL, 0, %FALSE)
                CALL ZD_SetObjectVisibility(%ID_OBJECT_LABEL, %FALSE)
            END IF

       CASE %WM_KEYDOWN
            IF nObjectID = %ID_CTRL THEN nObjectID = 0 ' Do not move the image background
            IF nObjectID THEN
               CALL ZD_GetObjectXY(nObjectID, x, y)
               x1& = x ' Make a copy to keep the orignal x location unchanged
               y1& = y ' Make a copy to keep the orignal y location unchanged

             ' Check accelerator keys to compute the step range
               IF ZI_IsCtrlKeyPressed THEN
                  UseStep& = 4
                  IF ZI_IsShiftKeyPressed THEN UseStep& = 16
               ELSEIF ZI_IsShiftKeyPressed THEN
                  UseStep& = 2
               ELSE
                  UseStep& = 1
               END IF

               IF ZD_GetObjectScroll(nObjectID) THEN ' If object scroll with the bitmap background
                ' Get the size of the bitmap background
                  CALL ZI_GetBitmapSize(ZI_GetBMP(GetDlgItem(hMain, %ID_CTRL)), useWidth&, useHeight&)
               ELSE
                ' Get the control client size
                  CALL GetClientRect(GetDlgItem(hMain, %ID_CTRL), rc)
                  useWidth& = rc.nRight: useHeight& = rc.nBottom
               END IF
             ' Get the sprite object size
               CALL ZD_GetObjectBound(nObjectID, BoundWidth&, BoundHeight&)

               x2Div2& = (BoundWidth& \ 2): y2Div2& = BoundHeight& \ 2

               SELECT CASE wParam
               CASE %VK_HOME
                    x1& = 0
               CASE %VK_END
                    x1& = MAX&(useWidth& - BoundWidth&, 0)
               CASE %VK_PRIOR
                    y1& = 0
               CASE %VK_NEXT
                    y1& = MAX&(useHeight& - BoundHeight&, 0)
               CASE %VK_LEFT, %VK_NUMPAD4
                    IF x1& > -x2Div2& THEN x1& = MAX&(x1& - UseStep&, -x2Div2&)
               CASE %VK_UP, %VK_NUMPAD8
                    IF y1& > -y2Div2& THEN y1& = MAX&(y1& - UseStep&, -y2Div2&)
               CASE %VK_RIGHT, %VK_NUMPAD6
                    IF x1& < useWidth& - x2Div2& THEN
                       x1& = MIN&(x1& + UseStep&, useWidth& - x2Div2&)
                    END IF
               CASE %VK_DOWN, %VK_NUMPAD2
                    IF y1& < useHeight& - y2Div2& THEN
                    y1& = MIN&(y1& + UseStep&, useHeight& - y2Div2&)
                    END IF
               END SELECT

               IF x <> x1& OR y <> y1& THEN
                  x = x1&: y = y1&
                  CALL ZD_SetObjectXY(nObjectID, x1&, y1&, %TRUE)
               END IF
            END IF
       END SELECT
    END IF

    FUNCTION = nRet
END FUNCTION