aeroglass.bas

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

       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 GetSpriteFromFile(BYVAL hCtrl AS LONG)
    LOCAL rc AS RECT
    LOCAL k AS LONG, x AS LONG, y AS LONG

    DIM hBitmap(1 TO 4)
    hBitmap(1) = ZI_CreateBitmapFromFile("aero.png", bmW&, bmH&)
    hBitmap(2) = ZI_CreateBitmapFromFile("light.png", bmW&, bmH&)
    hBitmap(3) = ZI_CreateBitmapFromFile("twin.png", bmW&, bmH&)
    hBitmap(4) = ZI_CreateBitmapFromFile("paintbrush.png", bmW&, bmH&)

    CALL GetClientRect(hCtrl, rc)
  ' Use random location to draw the sprites  
    RANDOMIZE TIMER
    FOR k = 1 TO 4
        x = RND(0, rc.nRight): y = RND(0, rc.nBottom)
        CALL ZD_DrawBitmapToCtrl(hCtrl, x, y, hBitmap(k), &HFFFFFFFF, %ID_OBJECT_SPRITE + k, %ZS_VISIBLE)
    NEXT
    
  ' Add a label for each of the sprite that will be shown on the status bar,
  ' and anchor them to scroll together with the background.
  ' Note: ZD_SetObjectLocked is meant to enable/disable user interaction on sprite.
  ' Set ZD_UsePngOpacity to TRUE% if you want to use the PNG variable opacity feature.
    CALL ZD_SetObjectImageLabel(%ID_AERO_GLASS, ("Aero glass"))
    CALL ZD_SetObjectScroll(%ID_AERO_GLASS, %TRUE)
    CALL ZD_UsePngOpacity(%ID_AERO_GLASS, %TRUE)

    CALL ZD_SetObjectImageLabel(%ID_LIGHT, ("Light"))
    CALL ZD_SetObjectScroll(%ID_LIGHT, %TRUE)
    CALL ZD_UsePngOpacity(%ID_LIGHT, %TRUE)
    
    CALL ZD_SetObjectImageLabel(%ID_TWIN, ("Twin"))
    CALL ZD_SetObjectScroll(%ID_TWIN, %TRUE)
    CALL ZD_UsePngOpacity(%ID_TWIN, %TRUE)
    
    CALL ZD_SetObjectImageLabel(%ID_BRUSH, ("Paint brush"))
    CALL ZD_SetObjectScroll(%ID_BRUSH, %TRUE)
    CALL ZD_UsePngOpacity(%ID_BRUSH, %TRUE)

END SUB

FUNCTION WndProc(BYVAL hWnd AS LONG, BYVAL Msg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG

    LOCAL rc AS RECT, ps AS PAINTSTRUCT
    LOCAL ObjectID AS LONG , x AS LONG, y AS LONG, hCtrl AS LONG

    SELECT CASE Msg

    CASE %WM_GETMINMAXINFO 'Set minimum and naximum dialog size
         LOCAL MinMax AS MINMAXINFO PTR
         MinMax = lParam
       ' Window Extended Style
         dwExStyle& = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE
       ' Windows Style
         dwStyle& = %WS_OVERLAPPEDWINDOW
         CALL SetRect(rc, 0, 0, 740, 443)
         CALL AdjustWindowRectEx(rc, dwStyle&, %FALSE, dwExStyle&) ' Adjust Window To True Requested Size
         @MinMax.ptMinTrackSize.x = rc.nRight - rc.nLeft
         @MinMax.ptMinTrackSize.y = rc.nBottom - rc.nTop
         FUNCTION = 0: EXIT FUNCTION

    CASE %WM_CTLCOLORSTATIC
         SELECT CASE LONG GetDlgCtrlID(lParam)
         CASE %ID_STA_Help
            CALL SetTextColor(wParam, RGB(2,77,220))
            CALL SetBkMode(wParam, %TRANSPARENT)

          ' Use a custom background for the help control
            CALL GetClientRect(GetDlgItem(hWnd, %ID_STA_Help), rc)
            CALL ZI_GradientPaintDC(wParam, 0, 0, rc.nRight, rc.nBottom, RGB(228,227,255), RGB(188,187,211))
            hPen& = CreatePen(0, 1, RGB(128,128,192))
            OldPen& = SelectObject(wParam, hPen&)
            CALL SelectObject(wParam, GetStockObject(%NULL_BRUSH))
            CALL RoundRect(wParam, 0, 0, rc.nRight, rc.nBottom, 8, 8)
            CALL SelectObject(wParam, OldPen&)
            CALL zDeleteObject(hPen&)

            EXIT FUNCTION
         CASE %ID_BTN_CHECK
            CALL SetBkMode(wParam, %TRANSPARENT)

          ' Use a custom background for the Check control
            CALL GetClientRect(GetDlgItem(hWnd, %ID_BTN_CHECK), rc)
            CALL ZI_GradientPaintDC(wParam, 0, 0, rc.nRight, rc.nBottom, RGB(179,178,198), RGB(176,175,196))
            CALL SelectObject(wParam, GetStockObject(%NULL_BRUSH))

            EXIT FUNCTION
         END SELECT

    CASE %WM_SIZE
         IF wParam <> %SIZE_MINIMIZED THEN
          ' Move Status bar
            hStatus& = GetDlgItem(hWnd, %ID_STATUSBAR)
            IF hStatus& THEN CALL SendMessage(hStatus&, Msg, wParam, lParam)
         END IF

    CASE %WM_COMMAND
         SELECT CASE LONG LOWRD(wParam)
         CASE %ID_BTN_CHECK

         CASE %ID_BTN_FIT2GLASS
              hCtrl = GetDlgItem(hWnd, %ID_CTRL)
              CALL GetClientRect(hCtrl, rc)
              xCurrentScroll& = ZI_GetProperty(hCtrl, %ZI_Horizontal)
              yCurrentScroll& = ZI_GetProperty(hCtrl, %ZI_Vertical)

            ' %ID_AERO_GLASS
              CALL ZD_GetObjectBound(%ID_AERO_GLASS, BoundWidthGlass&, BoundHeightGlass&)
              xGlass& = MAX&((rc.nRight - BoundWidthGlass&) \ 2 + xCurrentScroll&, 0)
              yGlass& = MAX&((rc.nBottom - BoundHeightGlass&) \ 2 + yCurrentScroll&, 0)
              CALL ZD_SetObjectXY(%ID_AERO_GLASS, xGlass&, yGlass&, %ZD_DRAW_DEFERRED) ' Move, without immediate redraw

            ' %ID_OBJECT_TEXT
              CALL ZD_GetObjectBound(%ID_OBJECT_TEXT, BoundWidth&, BoundHeight&)
              x = xGlass& + MAX&((BoundWidthGlass& - BoundWidth&) \ 2, 0)
              y = yGlass& + 10 ' MAX&((BoundHeightGlass& - BoundHeight&) \ 2, 0)
              CALL ZD_SetObjectXY(%ID_OBJECT_TEXT, x, y, %ZD_DRAW_DEFERRED) ' Move, without immediate redraw

            ' %ID_LIGHT
              CALL ZD_GetObjectBound(%ID_LIGHT, BoundWidth&, BoundHeight&)
              x = xGlass& + BoundWidthGlass& - (BoundWidth& * 0.56)
              y = yGlass& - (BoundHeight& / 3)
              CALL ZD_SetObjectXY(%ID_LIGHT, x, y, %ZD_DRAW_DEFERRED) ' Move, without immediate redraw

            ' %ID_TWIN
              CALL ZD_GetObjectBound(%ID_TWIN, BoundWidth&, BoundHeight&)
              x = xGlass& - 20
              y = yGlass& + BoundHeightGlass& - (BoundHeight& * 0.95)
              CALL ZD_SetObjectXY(%ID_TWIN, x, y, %ZD_DRAW_DEFERRED) ' Move, without immediate redraw

            ' %ID_BRUSH
              CALL ZD_GetObjectBound(%ID_BRUSH, BoundWidth&, BoundHeight&)
              x = xGlass& + MAX&((BoundWidthGlass& - BoundWidth& * 0.95) \ 2, 0)
              y = yGlass& + MAX&((BoundHeightGlass& - BoundHeight& * 1.10) \ 2, 0)
              CALL ZD_SetObjectXY(%ID_BRUSH, x, y, %ZD_DRAW_DEFERRED) ' Move, without immediate redraw

            ' Request GDImage to update the control display to show the changes
              CALL ZI_UpdateWindow(hCtrl, 0)

         END SELECT

    CASE %WM_ERASEBKGND
         CALL GetClientRect (hWnd, rc)
         CALL ZI_GradientPaintDC(wParam, 0, 0, rc.nRight, rc.nBottom, RGB(228,227,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(hBitmap)> 0 THEN
            FOR K& = LBOUND(hBitmap) TO UBOUND(hBitmap): CALL zDeleteObject(hBitmap(K&)): NEXT
         END IF
         CALL PostQuitMessage(0)
         FUNCTION = 0: EXIT FUNCTION
    END SELECT
    FUNCTION = DefWindowProc(hWnd, Msg&, wParam&, lParam&)
END FUNCTION

SUB ScreenCaptureToBackground()
    LOCAL SysXRes AS LONG, SysYRes AS LONG, gCtrl AS LONG, hDeskTop AS LONG, hDCSrce AS LONG
    SysXRes = GetSystemMetrics(%SM_CXSCREEN)
    SysYRes = GetSystemMetrics(%SM_CYSCREEN)
    gCtrl = GetDlgItem(hMain, %ID_CTRL)
    CALL ZI_CreateImageBackground(gCtrl, SysXRes, SysYRes)
    hDeskTop = GetDesktopWindow(): hDCSrce = GetWindowDC(hDeskTop)
    CALL BitBlt(ZI_GetDC(gCtrl), 0, 0, SysXRes, SysYRes, hDCSrce, 0, 0, %SRCCOPY)
    CALL ReleaseDC(hDeskTop, hDCSrce)
END SUB

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, ObjectID 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.
       SELECT CASE LONG Msg                 

       CASE %WM_LBUTTONDOWN
            ObjectID = ZI_MouseOverObjectID()
            IF ObjectID = GetDlgCtrlID(hWnd) THEN LabelIs$ = $Background ELSE LabelIs$ = ZD_GetObjectImageLabel(ObjectID)
            sMessage = "WM_LBUTTONDOWN on object" + str$(ObjectID) + " >" + LabelIs$ + "<"
            CALL SetWindowText(GetDlgItem(hMain, %ID_STATUSBAR), (sMessage))

       CASE %WM_RBUTTONDOWN
            ObjectID = ZI_MouseOverObjectID()
            IF ObjectID = GetDlgCtrlID(hWnd) THEN LabelIs$ = $Background ELSE LabelIs$ = ZD_GetObjectImageLabel(ObjectID)
            sMessage = "WM_RBUTTONDOWN on object" + str$(ObjectID) + " >" + LabelIs$ + "< at location" + str$(LOWRD(lParam))+","+str$(HIWRD(lParam))
            CALL SetWindowText(GetDlgItem(hMain, %ID_STATUSBAR), (sMessage))

       CASE %WM_MOUSEMOVE
            ObjectID = ZI_GetMovingSpriteID()
            IF ObjectID THEN
             ' Does %ID_BTN_CHECK is checked ?
               IF SendMessage(GetDlgItem(GetParent(hWnd), %ID_BTN_CHECK), %BM_GETCHECK, 0, 0) THEN
                  x = LOWRD(lParam): y = HIWRD(lParam)
                  xCurrentScroll& = ZI_GetProperty(hWnd, %ZI_Horizontal)
                  yCurrentScroll& = ZI_GetProperty(hWnd, %ZI_Vertical)
                  ZD_GetObjectXY(ObjectID, x1&, y1&)
                  ZD_GetObjectXYcapture(ObjectID, xCapture&, yCapture&)
                  DX& = (x - xCapture& +  xCurrentScroll&) - x1&
                  DY& = (y - yCapture& +  yCurrentScroll&) - y1&
                  FOR ID& = %ID_FIRST TO %ID_LAST
                      IF ID& <> ObjectID THEN
                         CALL ZD_GetObjectXY(ID&, x, y)
                       ' Add the DX,DY offset
                         CALL ZD_SetObjectXY(ID&, x + DX&, y + DY&, %ZD_DRAW_DEFERRED) ' Move, without immediate redraw
                      END IF
                  NEXT
                ' Note: The display's refresh is yeld by the default GDImage WM_MOUSE event
               END IF
            END IF

       CASE %WM_KEYDOWN
            ObjectID = ZI_GetObjectFocusID()
            IF ObjectID THEN
               CALL ZD_GetObjectXY(ObjectID, 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(ObjectID) 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(ObjectID, 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(ObjectID, x1&, y1&, %TRUE)
               END IF
               sMessage = "Object" + str$(ObjectID) + " coordinates" + str$(x&)+","+str$(y&)
               CALL SetWindowText(GetDlgItem(hMain, %ID_STATUSBAR), (sMessage))
               
            END IF
       END SELECT
    END IF

    FUNCTION = nRet
END FUNCTION