splash.bas

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

    LOCAL rc          AS RECT
    LOCAL x           AS LONG
    LOCAL y           AS LONG
    LOCAL hMutex      AS DWORD
    LOCAL hFound      AS DWORD
    LOCAL hMain       AS LONG
    LOCAL imgW        AS LONG
    LOCAL imgH        AS LONG
    LOCAL BtnW        AS LONG
    LOCAL BtnH        AS LONG
    LOCAL zImage      AS ASCIIZ * %MAX_PATH
    LOCAL zMask       AS ASCIIZ * %MAX_PATH
    LOCAL hDCDesktop  AS LONG
    LOCAL hSplash     AS LONG
'
    LOCAl hWinXP_Lib           AS LONG ' Handle to WinXP Theme DLL
    LOCAL hWinXP_IsThemeActive AS LONG ' Handle to WinXP's IsThemeActive function
'
    zClass = "ZMAIN"
'
    hMutex = CreateMutex(BYVAL %Null, 0, zClass)
    IF hMutex THEN
       IF GetLastError = %ERROR_ALREADY_EXISTS THEN
          DO
             hFound = FindWindow(zClass, ""): IF hFound THEN EXIT DO
             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
'
       BtnW = 154: BtnH = 24  ' Button size
       zImage = "p_image.png" ' Full image path name 
       zMask  = "p_mask.png"  ' Full mask path name

       CALL ZI_GetImageSizeFromFile(zMask, imgW, imgH)
       CALL GetWindowRect(GetDesktopWindow(), rc)
       x = (rc.nRight - rc.nLeft - imgW) \ 2 + 285
       y = (rc.nBottom - rc.nTop - imgH) \ 2 + 301
     ' Create The Window
       MyTitle$ = "GDImage control " + ZI_Version
       hMain = CreateWindowEx(0, _                       ' Extended Style For The Window
                             zClass, _                   ' Class Name
                             (MyTitle$), _               ' Window Title
                             %WS_POPUP OR %WS_VISIBLE, _ ' Defined Window Style
                             x, y, _                     ' Window Position
                             BtnW, _                     ' Calculate Window Width
                             BtnH, _                     ' 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 "Load Image"
          CALL CreateWindowEx(0, "BUTTON", "Close Splash Screen", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           0, 0, btnW, btnH, hMain, %ID_SPLASH, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_SPLASH), zDefaultFont)
'
        ' ******************************************************************************
        ' Create a GImage "Child window popup Region"
        ' ******************************************************************************
          CALL GetWindowRect(GetDesktopWindow(), rc)
          x = (rc.nRight - rc.nLeft - imgW) \ 2: y = (rc.nBottom - rc.nTop - imgH) \ 2
          dwStyle = %WS_POPUP OR %WS_VISIBLE
          dwExStyle = 0
          hSplash = ZI_CreateWindowFromImage (dwStyle, _        ' Window style
                                               zMask, _          ' Full path name to either mask or picture
                                               x, _              ' initial x position
                                               y, _              ' initial y position
                                               hMain, _          ' Parent window handle
                                               0, _ ' <----------- Must be %NULL when using %WS_POPUP style
                                               dwExStyle, _      ' Window extended style
                                               %ZD_TOPLEFTCOLOR) ' Use pixel color at location 0,0 as transparent color
        ' Copie desktop to hSplash memory DC
          hDCDesktop = GetWindowDC(GetDesktopWindow())
          CALL BitBlt(ZI_GetDC(hSplash), 0, 0, imgW, imgH, hDCDesktop, x, y, %SRCCOPY)
          CALL ReleaseDC(GetDesktopWindow(), hDCDesktop)
'
        ' ******************************************************************************
        ' Draw the alphablend Splash Screen  
        ' ******************************************************************************
          CALL ZI_DrawAlphaBlend(ZI_GetDC(hSplash), 0, 0, zImage, zMask)
        ' ******************************************************************************
'
        ' Show main window
          CALL ShowWindow(hMain, iCmdShow)
          CALL SetForegroundWindow(hMain)                  ' Slightly Higher Priority
          CALL SetFocus(GetDlgItem(hMain, %ID_SPLASH))   ' 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
    SELECT CASE Msg&
    CASE %WM_COMMAND
         wP& = LOWRD(wParam&)
         SELECT CASE LONG wP&
         CASE %ID_SPLASH
              CALL PostMessage(hWin&, %WM_SYSCOMMAND, %SC_CLOSE, 0)
         END SELECT

    CASE %WM_DESTROY
         CALL PostQuitMessage(0)
         FUNCTION = 0: EXIT FUNCTION
    END SELECT
    FUNCTION = DefWindowProc(hWin&, Msg&, wParam&, lParam&)
END FUNCTION