control.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

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_NEWIMAGE
              FilName$ = ZI_LoadDialog(hWin&)
              CALL ZI_SetFromFile(GetDlgItem(hWin&, %ID_CTRL), (FilName$))
              CALL ZI_SetFromFile(GetDlgItem(hWin&, %ID_THUMBCTRL), (FilName$))
         CASE %ID_SAVE
              CALL ZI_SaveDialog(hWin&, GetDlgItem(hWin&, %ID_CTRL))
         CASE %ID_COPY
              CALL ZI_ClipboardCopy(GetDlgItem(hWin&, %ID_CTRL))
         CASE %ID_PASTE
              CALL ZI_ClipboardPaste(GetDlgItem(hWin&, %ID_CTRL))
         CASE %ID_REGION
              WasFocus& = GetFocus()
              IF IsWindowVisible(ghRegion) = %FALSE THEN
                 CALL ZI_SetLayeredAlpha(ghRegion, 0)
                 CALL ShowWindow(ghRegion, %SW_SHOW)
                 CALL SetFocus(WasFocus&)
                 FOR K& = 0 TO 255 STEP 2
                     CALL ZI_SetLayeredAlpha(ghRegion, K&)
                     'FOR kk& = 1 TO 5
                         CALL apiSleep(1): CALL ZD_DoEvents()
                     'NEXT
                     CALL ZI_UpdateWindow(ghRegion, 1)
                 NEXT
                 CALL ZI_SetLayeredAlpha(ghRegion, 255)
              ELSE
                 FOR K& = 255 TO 0 STEP -2
                     CALL ZI_SetLayeredAlpha(ghRegion, K&)
                     'FOR kk& = 1 TO 5
                         CALL apiSleep(1): CALL ZD_DoEvents()
                     'NEXT
                     CALL ZI_UpdateWindow(ghRegion, 1)
                 NEXT
                 CALL ShowWindow(ghRegion, %SW_HIDE)
              END IF
              CALL SetFocus(WasFocus&)
         CASE %ID_WATERMARK
              IF ZD_IsObjectVisible(%ID_TEXT_WATERMARK) THEN
                 CALL ZD_ShowObject(%ID_TEXT_WATERMARK, %ZD_HIDE)
              ELSE
                 CALL ZD_ShowObject(%ID_TEXT_WATERMARK, %ZD_SHOW)
              END IF
         CASE %ID_LAYERED
            ' In order to show/hide a layered window we must use negative X,Y window coordinates...
              CALL GetWindowRect(ghLayered&, rc)
              CALL ZI_GetImageSizeFromControl(ghLayered&, UseW&, UseH&)
              Style& = %WS_POPUP OR %WS_VISIBLE OR %WS_BORDER or %WS_CAPTION
              StyleEx& = %WS_EX_TOOLWINDOW
              CALL ZI_AdjustWindowRect(StyleEx&, UseW&, UseH&, Style&)
              IF rc.nLeft < -9000 THEN
                 CALL SetWindowPos(ghLayered&, %NULL, rc.nLeft + 10000, rc.nTop + 10000, UseW&, UseH&, %SWP_NOACTIVATE)
              ELSE
                 CALL SetWindowPos(ghLayered&, %NULL, rc.nLeft - 10000, rc.nTop - 10000, UseW&, UseH&, %SWP_NOACTIVATE)
              END IF
         CASE %ID_RECTANGLE
              IF InProgress& THEN ' If effect already in progress then bailout
                 CALL zFocusBeep()
                 FUNCTION = 0: EXIT FUNCTION
              ELSE
                 InProgress& = -1
              END IF
              UseStep& = 4
            ' Check visibility status
              IF ZD_IsObjectVisible(%ID_RECT_1) THEN
               ' Create fade OUT effect
                 FOR Alpha& = 200 TO 1 STEP - UseStep&
                     CALL ZD_SetObjectAlpha(%ID_RECT_1, Alpha&, %TRUE)
                     IF ZD_DoEvents() THEN EXIT FOR
                 NEXT
                 CALL ZD_ShowObject(%ID_RECT_1, %ZD_HIDE)
              ELSE
                 CALL ZD_SetObjectAlpha(%ID_RECT_1, 0, %TRUE)
                 CALL ZD_ShowObject(%ID_RECT_1, %ZD_SHOW)
               ' Create fade IN effect
                 FOR Alpha& = 1 to 200 STEP UseStep&
                     CALL ZD_SetObjectAlpha(%ID_RECT_1, Alpha&, %TRUE)
                     IF ZD_DoEvents() THEN EXIT FOR
                 NEXT
              END IF
              InProgress& = 0
         CASE %ID_ANIMATETEXT
            ' If effect already in progress then bailout
              IF InProgress& THEN
                 CALL zFocusBeep()
                 FUNCTION = 0: EXIT FUNCTION
              ELSE
                 InProgress& = -1
              END IF
            ' Get the %ID_TEXT_WATERMAK properties
              CALL GetClientRect (ZD_GetObjectParent(%ID_TEXT_WATERMARK), rc): xRight& = rc.nRight
              CALL ZD_GetObjectBound(%ID_TEXT_WATERMARK, xBoundWidth&, xBoundHeight&)
              CALL ZD_GetOBjectXY(%ID_TEXT_WATERMARK, xX&, Xy&)

            ' Get the %ID_TEXT_GREAT properties
              CALL GetClientRect (ZD_GetObjectParent(%ID_TEXT_GREAT), rc): yHeight& = rc.nBottom
              CALL ZD_GetObjectBound(%ID_TEXT_GREAT, yBoundWidth&, yBoundHeight&)
              CALL ZD_GetOBjectXY(%ID_TEXT_GREAT, yX&, yY&)

              DoneWithX& = 0: DoneWithY& = 0
              X1& = xX&: Y1& = yY&
              IF ZD_IsObjectVisible(%ID_RECT_1) THEN UseStep& = 4 ELSE UseStep& = 2
              DO UNTIL DoneWithX& and DoneWithY&

                 IF DoneWithX& = 0 THEN
                    IF X1& > -xBoundWidth& THEN
                       X1& = X1& - UseStep&
                       CALL ZD_SetObjectXY(%ID_TEXT_WATERMARK, X1&, Xy&, %ZD_DRAW_DEFERRED)
                    ELSEIF X2& = 0 THEN
                       X2& = xRight& + xBoundWith&
                    END IF
                 END IF

                 IF DoneWithY& = 0 THEN
                    IF Y1& > -yBoundHeight& THEN
                       Y1& = Y1& - UseStep&
                       CALL ZD_SetObjectXY(%ID_TEXT_GREAT, yX&, Y1&, %ZD_DRAW_DEFERRED)
                    ELSEIF Y2& = 0 THEN
                       Y2& = yHeight& + yBoundHeight&
                    END IF
                 END IF

                 IF DoneWithX& = 0 THEN
                    IF X2& > 0 THEN
                       X2& = X2& - UseStep&
                       IF X2& < xX& + 1 THEN X2& = xX&: DoneWithX& = -1
                       CALL ZD_SetObjectXY(%ID_TEXT_WATERMARK, X2&, Xy&, %ZD_DRAW_DEFERRED)
                     END IF
                 END IF

                 IF DoneWithY& = 0 THEN
                    IF Y2& > 0 THEN
                       Y2& = Y2& - UseStep&
                       IF Y2& < yY& + 1 THEN Y2& = yY&: DoneWithY& = -1
                       CALL ZD_SetObjectXY(%ID_TEXT_GREAT, yX&, Y2&, %ZD_DRAW_DEFERRED)
                    END IF
                 END IF

                 CALL ZI_UpdateWindow(ZD_GetObjectParent(%ID_TEXT_GREAT), %FALSE)
                 IF ZD_DoEvents() THEN EXIT DO

              LOOP
              InProgress& = 0

         END SELECT

    CASE %WM_CREATE
    CASE %WM_TIMER
    CASE %WM_MOVING
         DIM pRC AS RECT PTR
       ' Move also our "Child window Region" while user drags the main window
         prc = lParam&
         CALL ZI_GetImageSizeFromControl(ghRegion, imgWidth&, imgHeight&)
         x& = @prc.nLeft - (imgWidth& \ 2)
         y& = @prc.nTop + @prc.nBottom - @prc.nTop - imgHeight&
         CALL MoveWindow(ghRegion, x&, y&, imgWidth&, imgHeight&, %TRUE)
    CASE %WM_SIZE
         'sbh& = rc.nBottom - rc.nTop
         'caW& = LOWRD(lParam&)
         'caH& = HIWRD(lParam&)
         'CALL MoveWindow(ghRegion, 0, caH& - sbh&, caW&, caH&, %TRUE)
         'FUNCTION = 0: EXIT FUNCTION
    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