slide.bas

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

             WHILE PeekMessage(Msg, %NULL, %NULL, %NULL, %PM_REMOVE): WEND
          LOOP
          IF IsIconic(hFound) THEN CALL ShowWindow(hFound, %SW_RESTORE)
          CALL SetForeGroundWindow(hFound)
          FUNCTION = 0
          EXIT FUNCTION
       END IF
    END IF
'
    IsInitialized& = GetClassInfoEx(zInstance, zClass, wc)
    IF IsInitialized&   = 0 THEN
       wc.cbSize        = SIZEOF(wc)
       wc.style         = %CS_HREDRAW OR %CS_VREDRAW
       wc.lpfnWndProc   = CODEPTR(WndProc)
       wc.cbClsExtra    = 0
       wc.cbWndExtra    = 0
       wc.hInstance     = zInstance
       wc.hIcon         = LoadIcon(wc.hInstance, "PROGRAM")
       wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
       wc.hbrBackground = %NULL ' GetStockObject(%BLACK_BRUSH)
       wc.lpszMenuName  = %NULL
       wc.lpszClassName = VARPTR(zClass)
       wc.hIconSm       = wc.hIcon
       IF RegisterClassEx(wc) THEN IsInitialized& = %TRUE
    END IF
'
    IF IsInitialized& THEN

     ' ************************************************************************************
     ' Load the GDImage.dll
       IF RegisterGDImageClass() = 0 THEN
          FUNCTION = 99:  EXIT FUNCTION ' If it fails to register then return ERROR = 99
       END IF
     ' ************************************************************************************

     ' Load the WinXP Theme support (if applicable)
       hWinXP_Lib = LoadLibrary("UxTheme.dll")
       IF hWinXP_Lib THEN
          hWinXP_IsThemeActive = GetProcAddress(hWinXP_Lib, "IsThemeActive")
       END IF
'
       CALL InitCommonControls
'
     ' Window Extended Style
       dwExStyle = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE
     ' Windows Style
       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, 550)
       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 + " Slide show 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 - (10 + 150 + 6), 10, 152, 22, hMain, %ID_START_SHOW, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_START_SHOW), zDefaultFont)

        ' Create button "DECR"
          CALL CreateWindowEx(0, "BUTTON", "<<", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_DISABLED, _
                           740 - (10 + 150 + 6), 10 + (22 + 5) * 1, 24, 22, hMain, %ID_DECR, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_DECR), zDefaultFont)

        ' Create button "PLAY"
          CALL CreateWindowEx(0, "BUTTON", "PLAY", %WS_CHILD OR %WS_TABSTOP OR %WS_DISABLED, _
                           740 - (10 + 150 + 6) + 28, 10 + (22 + 5) * 1, 96, 22, hMain, %ID_PLAY, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_PLAY), zDefaultFont)

        ' Create button "PAUSE"
          CALL CreateWindowEx(0, "BUTTON", "PAUSE", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_DISABLED, _
                           740 - (10 + 150 + 6) + 28, 10 + (22 + 5) * 1, 96, 22, hMain, %ID_PAUSE, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_PAUSE), zDefaultFont)

        ' Create button "INCR"
          CALL CreateWindowEx(0, "BUTTON", ">>", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_DISABLED, _
                           740 - (10 + 150 + 6) + 128, 10 + (22 + 5) * 1, 24, 22, hMain, %ID_INCR, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_INCR), zDefaultFont)

        ' Create button "STOP"
          CALL CreateWindowEx(0, "BUTTON", "STOP", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           740 - (10 + 150 + 6), 10 + (22 + 5) * 2, 152, 22, hMain, %ID_STOP_SHOW, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_STOP_SHOW), zDefaultFont)
       ' ******************************************************************************
        ' Helper function to create A GDImage control (with automatic scrollbar support)
        ' ------------------------------------------------------------------------------
          CALL ZI_CreateWindow(hMain, 10, 10, 740 - (10 + 10 + 150 + 10 + 10), 550 - (10 * 2), %ID_CTRL)
'        ' Use gradient for background
'          CALL ZI_SetProperty(GetDlgItem(hMain, %ID_CTRL), %ZI_GradientTop, RGB(93,3,28))
'          CALL ZI_SetProperty(GetDlgItem(hMain, %ID_CTRL), %ZI_GradientBottom, RGB(146,3,40))
          CALL ZI_SetTiledBackground(GetDlgItem(hMain, %ID_CTRL), ZI_CreateBitmapFromFile("038.jpg", 0,0))

        ' Show the main window
          CALL ShowWindow(hMain, iCmdShow)
          CALL SetForegroundWindow(hMain)                  ' Slightly Higher Priority
          CALL SetFocus(GetDlgItem(hMain, %ID_CTRL))       ' 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

          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

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

    SELECT CASE Msg&

    CASE %WM_SETCURSOR
         'IF wParam& = GetDlgItem(hWin&, %ID_CTRL) THEN
         '   CALL SetCursor(LoadCursor(zInstance, "STAR"))
         '   FUNCTION = 1: EXIT FUNCTION
         'END IF

    CASE %WM_COMMAND
         wP& = LOWRD(wParam&)

         SELECT CASE LONG wP&
         CASE %ID_START_SHOW
              IF IsWindowEnabled(GetDlgItem(hWin&, %ID_DECR)) = 0 THEN
                 CALL EnableWindow(GetDlgItem(hWin&, %ID_DECR), %TRUE)
                 CALL EnableWindow(GetDlgItem(hWin&, %ID_PLAY), %TRUE)
                 CALL EnableWindow(GetDlgItem(hWin&, %ID_PAUSE), %TRUE)
                 CALL EnableWindow(GetDlgItem(hWin&, %ID_INCR), %TRUE)
              END IF

              hCtrl& = GetDlgItem(hWin&, %ID_CTRL)
              DIM ImageList(1 TO 3 * (%ZE_EFFECT_MAX + 1)) AS ZSLIDESHOW
              K& = 0
              FOR Effect& = %ZE_EFFECT_MIN TO %ZE_EFFECT_MAX
                  INCR K&
                  ImageList(K&).FilName   = "avalon.jpg"
                  ImageList(K&).Delay     = 2000
                  ImageList(K&).Grain     = 1         ' <-- Use a larger grain on slow computer.
                  ImageList(K&).Effect    = Effect&

                  INCR K&
                  ImageList(K&).FilName   = "genus.jpg"
                  ImageList(K&).Delay     = 2000
                  ImageList(K&).Grain     = 2
                  ImageList(K&).Effect    = Effect&   ' <-- Use a larger grain on slow computer.
                  ImageList(K&).Legend    = "GDImage Slide Show"
                  ImageList(K&).FontName  = "Times New Roman"
                  ImageList(K&).FontSize  = 40
                  ImageList(K&).FontColor = ZD_ColorARGB(32, RGB(255,255,255))
                  ImageList(K&).Shadow    = 0        ' <-- Font shadow offset
                  ImageList(K&).Location  = RND(%ZE_TXT_TOP_LEFT, %ZE_TXT_BOTTOM_RIGHT)

                  INCR K&
                  ImageList(K&).FilName   = "mask.png"
                  ImageList(K&).Delay     = 2000
                  ImageList(K&).Grain     = 1         ' <-- Use a larger grain on slow computer.
                  ImageList(K&).Effect    = Effect&

              NEXT
              PlayInLoopMode& = -1
              CALL ZI_SlideAnimate(hCtrl&, BYVAL VARPTR(ImageList(1)), UBOUND(ImageList) - LBOUND(ImageList) + 1, PlayInLoopMode&)
  
         CASE %ID_DECR
              CALL ZI_SlidePlayDecrOrder
         CASE %ID_PAUSE
              IF IsWindowEnabled(GetDlgItem(hWin&, %ID_DECR)) THEN
                 CALL EnableWindow(GetDlgItem(hWin&, %ID_DECR), %FALSE)
                 CALL EnableWindow(GetDlgItem(hWin&, %ID_INCR), %FALSE)
              END IF
              CALL ShowWindow(GetDlgItem(hWin&, %ID_PAUSE), %SW_HIDE)
              CALL ShowWindow(GetDlgItem(hWin&, %ID_PLAY), %SW_SHOW)
              CALL ZI_SlidePause
         CASE %ID_PLAY
              IF IsWindowEnabled(GetDlgItem(hWin&, %ID_DECR)) = 0 THEN
                 CALL EnableWindow(GetDlgItem(hWin&, %ID_DECR), %TRUE)
                 CALL EnableWindow(GetDlgItem(hWin&, %ID_INCR), %TRUE)
              END IF
              CALL ShowWindow(GetDlgItem(hWin&, %ID_PLAY), %SW_HIDE)
              CALL ShowWindow(GetDlgItem(hWin&, %ID_PAUSE), %SW_SHOW)
              CALL ZI_SlidePlay
         CASE %ID_INCR
              ZI_SlidePlayIncrOrder
              
         CASE %ID_STOP_SHOW
              CALL ZI_SlideStop()
              IF IsWindowEnabled(GetDlgItem(hWin&, %ID_DECR)) THEN
                 CALL EnableWindow(GetDlgItem(hWin&, %ID_DECR), %FALSE)
                 CALL EnableWindow(GetDlgItem(hWin&, %ID_PLAY), %FALSE)
                 CALL EnableWindow(GetDlgItem(hWin&, %ID_PAUSE), %FALSE)
                 CALL EnableWindow(GetDlgItem(hWin&, %ID_INCR), %FALSE)
              END IF
         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