resource.bas

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

FUNCTION zReportError(BYVAL Message$) AS LONG
    REPLACE $zLim WITH $CR IN Message$
    FUNCTION = MessageBox(0, (Message$), ("GDImage version " + ZI_Version), %MB_ICONHAND)
END FUNCTION

FUNCTION WinMain (BYVAL hInstance     AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  BYVAL lpCmdLine     AS ASCIIZ PTR, _
                  BYVAL iCmdShow      AS LONG) AS LONG

    LOCAL Msg         AS tagMsg
    LOCAL wc          AS WndClassEx
    LOCAL zClass      AS ASCIIZ * 80
    LOCAL dwExStyle   AS DWORD
    LOCAL dwStyle     AS DWORD
    LOCAL rc          AS RECT
    LOCAL x           AS LONG
    LOCAL y           AS LONG
    LOCAL Done        AS LONG
    LOCAL hMutex      AS DWORD
    LOCAL hFound      AS DWORD
    LOCAL hMain       AS LONG
    LOCAL hBitmap     AS LONG
    LOCAL hImage      AS LONG
    LOCAL bmW         AS LONG
    LOCAL bmH         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
'
     ' 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 + " Load from resource + Image / Bitmap overlay (sprite)"
       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 "Load Image"
          CALL CreateWindowEx(0, "BUTTON", "New background Image", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           740 - (10 + 150 + 6), 10, 152, 22, hMain, %ID_NEW_IMAGE, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_NEW_IMAGE), zDefaultFont)

        ' Create button "Show Bitmap Overlay"
          CALL CreateWindowEx(0, "BUTTON", "Show Bitmap Overlay", %WS_CHILD OR %WS_VISIBLE, _
                           740 - (10 + 150 + 6), 10 + (22 + 5)* 1, 152, 22, hMain, %ID_MOVE_ZMAGIC, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_MOVE_ZMAGIC), zDefaultFont)

        ' Create button "Animate Text"
          CALL CreateWindowEx(0, "BUTTON", "Animate Text", %WS_CHILD OR %WS_VISIBLE, _
                           740 - (10 + 150 + 6), 10 + (22 + 5)* 2, 152, 22, hMain, %ID_ANIMATE_TEXT, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_ANIMATE_TEXT), zDefaultFont)

        ' Create button "Image rotation"
          CALL CreateWindowEx(0, "BUTTON", "Animated image rotation", %WS_CHILD OR %WS_VISIBLE, _
                           740 - (10 + 150 + 6), 10 + (22 + 5)* 3, 152, 22, hMain, %ID_IMAGE_ROTATE, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_IMAGE_ROTATE), zDefaultFont)

        ' Create button "Tiled background"
          CALL CreateWindowEx(0, "BUTTON", "Tiled background ON/OFF", %WS_CHILD OR %WS_VISIBLE, _
                           740 - (10 + 150 + 6), 10 + (22 + 5)* 4, 152, 22, hMain, %ID_BACKGROUND, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_BACKGROUND), 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))


        ' LOAD IMAGE From RESOURCE ("REDMASK" is embedded within the current EXE file)
          CALL ZI_LoadFromResource(GetDlgItem(hMain, %ID_CTRL), "REDMASK")
        
        ' ******************************************************************************

        ' Draw overlayed text in a GDImage Control
        ' ******************************************************************************
        ' Require the use of True Type Font name (TTF).
        ' This type of overlay doesn't alter the image shown in the background.
        ' ------------------------------------------------------------------------------
        ' Draw Text overlay
          CALL ZD_DrawTextToCtrl(GetDlgItem(hMain, %ID_CTRL), _        ' The GDImage control handle
                                 "Floating Text", _                    ' The text to be displayed
                                 150, _                                ' X coordinate
                                 400, _                                ' Y coordinate
                                 ZD_ColorARGB(255,RGB(255,255,255)), _ ' The ARGB color to use
                                 $Times_New_Roman, _                   ' The True Type Font to use
                                 40, _                                 ' The font size in pixel
                                 %ID_TEXT_FLOATING, _                  ' The unique object ID
                                 %ZS_VISIBLE, _                        ' Show overlay
                                 0)                                    ' Optional shadow effect (offset in pixel)
        ' ------------------------------------------------------------------------------
        ' Draw Text overlay.
        ' Note:
        ' Using %ZS_SCROLL in ZS_STYLE allows you to link the object to the image.
        ' It seems to be part of the image when you scroll it.
          CALL ZD_DrawTextToCtrl(GetDlgItem(hMain, %ID_CTRL), _        ' The GDImage control handle
                                 "Scroll with parent", _               ' The text to be displayed
                                 150, _                                ' X coordinate
                                 450, _                                ' Y coordinate
                                 ZD_ColorARGB(255,RGB(255,164,0)), _   ' The ARGB color to use
                                 $Times_New_Roman, _                   ' The True Type Font to use
                                 40, _                                 ' The font size in pixel
                                 %ID_TEXT_SCROLLING, _                 ' The unique object ID
                                 %ZS_VISIBLE OR %ZS_SCROLL, _          ' Overlay visible at startup + scroll with parent
                                 0)                                    ' Optional shadow effect (offset in pixel)


        ' 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

    STATIC InProgress&, hBitmapFromResource&, hBitmapFromFile&

    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