reflect.bas

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

          CALL zSetCTLFont(hStatus&, zDefaultFont)

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

          WHILE GetMessage(Msg, %NULL, 0, 0)
              IF IsDialogMessage(hMain, Msg) = %FALSE THEN
                 CALL TranslateMessage(msg)                ' Translate The Message
                 CALL DispatchMessage(msg)                 ' Dispatch The Message
              END IF
          WEND

          CALL zDeleteObject(zCaptionFont) ' Delete the caption font

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

    CALL ZI_GetBitmapSize(ZI_GetBMP(hCtrl), useWidth&, useHeight&)

    DIM hBitmap(1 TO 4)

    hBitmap(1) = ZI_CreateMirrorBitmapFromFile("tophat.png", bmW&, bmH&)
    CALL ZD_DrawBitmapToCtrl(hCtrl, 120, 54, hBitmap(1), &HFFFFFFFF, %ID_OBJECT_SPRITE + 1, %ZS_VISIBLE)
    CALL ZD_SetObjectImageLabel(%ID_SPRITE1, ("tophat.png"))
    IF useWidth& THEN CALL ZD_SetObjectScroll(%ID_SPRITE1, %TRUE)
    CALL ZD_UsePngOpacity(%ID_SPRITE1, %TRUE)

    hBitmap(2) = ZI_CreateMirrorBitmapFromFile("tube.png", bmW&, bmH&)
    CALL ZD_DrawBitmapToCtrl(hCtrl, 12, 247, hBitmap(2), &HFFFFFFFF, %ID_OBJECT_SPRITE + 2, %ZS_VISIBLE)
    CALL ZD_SetObjectImageLabel(%ID_SPRITE2, ("tube.png"))
    IF useWidth& THEN CALL ZD_SetObjectScroll(%ID_SPRITE2, %TRUE)
    CALL ZD_UsePngOpacity(%ID_SPRITE2, %TRUE)

    hBitmap(3) = ZI_CreateMirrorBitmapFromFile("mirror.png", bmW&, bmH&)
    CALL ZD_DrawBitmapToCtrl(hCtrl, 136, 300, hBitmap(3), &HFFFFFFFF, %ID_OBJECT_SPRITE + 3, %ZS_VISIBLE)
    CALL ZD_SetObjectImageLabel(%ID_SPRITE3, ("mirror.png"))
    IF useWidth& THEN CALL ZD_SetObjectScroll(%ID_SPRITE3, %TRUE)
    CALL ZD_UsePngOpacity(%ID_SPRITE3, %TRUE)

    hBitmap(4) = ZI_CreateMirrorBitmapFromFile("goodwine.png", bmW&, bmH&)
    CALL ZD_DrawBitmapToCtrl(hCtrl, 270, 247, hBitmap(4), &HFFFFFFFF, %ID_OBJECT_SPRITE + 4, %ZS_VISIBLE)
    CALL ZD_SetObjectImageLabel(%ID_SPRITE4, ("goodwine.png"))
    IF useWidth& THEN CALL ZD_SetObjectScroll(%ID_SPRITE4, %TRUE)
    CALL ZD_UsePngOpacity(%ID_SPRITE4, %TRUE)

END SUB

SUB GDImageLoadFile(BYVAL hWnd AS LONG, BYVAL sFileName AS STRING)
    IF LEN(sFileName) THEN
       LOCAL hCtrl AS LONG, x AS LONG, y AS LONG, Item AS LONG
       LOCAL Path AS STRING, FilName AS STRING

       INCR ChangeItem: IF ChangeItem > UBOUND(hBitmap) THEN ChangeItem = LBOUND(hBitmap)
       Item = %ID_OBJECT_SPRITE + ChangeItem

       hCtrl = GetDlgItem(hWnd, %ID_CTRL)
       CALL ZI_GetBitmapSize(ZI_GetBMP(hCtrl), useWidth&, useHeight&)

       CALL ZD_GetObjectXY(Item, x, y)
       CALL zDeleteObject(hBitmap(ChangeItem))
       hBitmap(ChangeItem) = ZI_CreateMirrorBitmapFromFile((sFileName), bmW&, bmH&)
       CALL ZD_DrawBitmapToCtrl(hCtrl, x, y, hBitmap(ChangeItem), &HFFFFFFFF, Item, %ZS_VISIBLE)

       CALL zSplitN(sFileName, Path, FilName)
       CALL ZD_SetObjectZorder(Item, %ZD_ORDER_BOTTOM)
       CALL ZD_SetObjectImageLabel(Item, (FilName))
       IF useWidth& THEN CALL ZD_SetObjectScroll(Item, %TRUE)
       CALL ZD_UsePngOpacity(Item, %TRUE)

       CALL ZI_UpdateWindow(hCtrl, 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 rc AS RECT, ps AS PAINTSTRUCT
    LOCAL ObjectID AS LONG , x AS LONG, y AS LONG, hCtrl AS LONG
    STATIC StartFromExePath 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, %UseWidth, %UseHeight)
         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_LOAD
              ' Start from the EXE path folder only once per session
              IF StartFromExePath = 0 THEN
                 StartFromExePath = -1: CALL zSplitN(zExename, Path$, FilName$)
                 CALL ZI_LoadSavePath((Path$), 1)
              END IF
              CALL GDImageLoadFile(hWnd, ZI_LoadDialog(hWnd))
         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

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