image.bas

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

    LOCAL szText AS ASCIIZ * 4096
    Length& = GetWindowText(hC&, szText, SIZEOF(szText))
    IF Length& THEN FUNCTION = LEFT$(szText, Length&)
END FUNCTION

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

' We need this to share UseFont among procedures 
SUB GlobalFont(UseFont AS ZGLFONT, BYVAL RW AS LONG)
    STATIC WasFont AS ZGLFONT
    IF RW THEN WasFont = UseFont
    UseFont = WasFont
END SUB

' Perform smooth zoom while they hold down the "zoom" buttons
SUB MessageButton(BYVAL hMain AS LONG, Msg AS tagMsg)
    LOCAL ZoomIs AS LONG, pt AS POINTAPI
    STATIC wasX AS LONG, wasY AS LONG, bMousing AS LONG
    static ptLastMousePosit AS POINTAPI
    static ptCurrentMousePosit AS POINTAPI

  ' Detect mouse activity to compute new Image coordinates
    WindowIs& = WindowFromPoint(Msg.pt.X, Msg.pt.Y)
    IF WindowIs& = glWnd THEN
       IF Msg.message = %WM_LBUTTONDOWN THEN
          IF bMousing = %FALSE THEN
             pt.x = Msg.pt.X: pt.y = Msg.pt.Y
             CALL ScreenToClient(glWnd, pt)
             ptLastMousePosit.x = pt.x
             ptCurrentMousePosit.x = pt.x
             ptLastMousePosit.y = pt.y
             ptCurrentMousePosit.y = pt.y
             bMousing = 1
          END IF
       ELSEIF Msg.message = %WM_LBUTTONUP THEN
          bMousing = 0
       ELSEIF Msg.message = %WM_MOUSEMOVE THEN
        ' Make sure left mouse button is still down, if not bail out.
          IF ZI_IsLButtonDown = 0 THEN
             bMousing = 0
          ELSE
             pt.x = Msg.pt.X: pt.y = Msg.pt.Y
             CALL ScreenToClient(glWnd, pt)
             IF wasX <> pt.x OR wasY <> pt.y THEN
                ptCurrentMousePosit.x = pt.x
                ptCurrentMousePosit.y = pt.y
                IF bMousing THEN
                   gSpinX = gSpinX - (ptCurrentMousePosit.x - ptLastMousePosit.x)
                   gSpinY = gSpinY - (ptCurrentMousePosit.y - ptLastMousePosit.y)
                END IF
                ptLastMousePosit.x = ptCurrentMousePosit.x
                ptLastMousePosit.y = ptCurrentMousePosit.y
             END IF 
             wasX = pt.x: wasY = pt.y
          END IF
       END IF
       EXIT SUB
    END IF

    SELECT CASE LONG GetFocus
    CASE GetDlgItem(hMain, %ID_ZOOM_IN)
         ZoomIs = ZI_GetGLzoom(glWnd)
         IF ZoomIs > 1 THEN
            CALL ZI_SetGLzoom(glWnd, ZoomIs - 1): CALL ZI_ResizeGLWindow(glWnd)
            gYincr = 0.0: gXincr = 0.0
            CALL apiSleep(20)
         END IF
    CASE GetDlgItem(hMain, %ID_ZOOM_OUT)
         ZoomIs = ZI_GetGLzoom(glWnd)
         IF ZoomIs < 180 THEN
            CALL ZI_SetGLzoom(glWnd, ZoomIs + 1): CALL ZI_ResizeGLWindow(glWnd)
            gYincr = 0.0: gXincr = 0.0
            CALL apiSleep(20)
         END IF   
    CASE GetDlgItem(hMain, %ID_STOP)
         gYincr = 0.0: gXincr = 0.0
    END SELECT

END SUB

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 DWORD
    LOCAL hBitmap     AS LONG
    LOCAL hImage      AS LONG
    LOCAL bmW         AS LONG
    LOCAL bmH         AS LONG
    LOCAL hMMTimer    AS DWORD
'
    LOCAL hWinXP_Lib           AS LONG ' Handle to WinXP Theme DLL
    LOCAL hWinXP_IsThemeActive AS LONG ' Handle to WinXP's IsThemeActive function   
'
    DIM UseFont AS ZGLFONT 
'    
    zClass = "ZGLIMAGE"
'
    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
       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_OVERLAPPEDWINDOW
       CALL SetRect(rc, 0, 0, 668, 532)
       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 + " - ""Image"" OpenGL 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, _
                           672 - (7 + 120 + 8), 10, 120, 22, hMain, %ID_START, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_START), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_START), %ANCHOR_RIGHT)

        ' Create button "Up"
          CALL CreateWindowEx(0, "BUTTON", "U", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8) + 48, 10 + (22 + 5) * 1, 24, 22, hMain, %ID_UP, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_UP), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_UP), %ANCHOR_RIGHT)

        ' Create button "Left"
          CALL CreateWindowEx(0, "BUTTON", "L", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8) + 14, 10 + (22 + 5) * 2 + 2, 24, 22, hMain, %ID_LEFT, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_LEFT), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_LEFT), %ANCHOR_RIGHT)

        ' Create button "Reset"
          CALL CreateWindowEx(0, "BUTTON", "Stop", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8) + 41, 10 + (22 + 5) * 2 - 2, 38, 30, hMain, %ID_STOP, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_STOP), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_STOP), %ANCHOR_RIGHT)

        ' Create button "Right"
          CALL CreateWindowEx(0, "BUTTON", "R", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8) + 82, 10 + (22 + 5) * 2 + 2, 24, 22, hMain, %ID_RIGHT, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_RIGHT), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_RIGHT), %ANCHOR_RIGHT)

        ' Create button "Down"
          CALL CreateWindowEx(0, "BUTTON", "D", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8) + 48, 10 + (22 + 5) * 3 + 4, 24, 22, hMain, %ID_DOWN, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_DOWN), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_DOWN), %ANCHOR_RIGHT)

        ' Create button "In"
          CALL CreateWindowEx(0, "BUTTON", "Zoom In", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8), 10 + (22 + 5) * 4 + 5, 58, 22, hMain, %ID_ZOOM_IN, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_ZOOM_IN), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_ZOOM_IN), %ANCHOR_RIGHT)

        ' Create button "Out"
          CALL CreateWindowEx(0, "BUTTON", "Zoom Out", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8) + 62, 10 + (22 + 5) * 4 + 5, 58, 22, hMain, %ID_ZOOM_OUT, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_ZOOM_OUT), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_ZOOM_OUT), %ANCHOR_RIGHT)

        ' Create button "RESET"
          CALL CreateWindowEx(0, "BUTTON", "RESET", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8), 10 + (22 + 5) * 5 + 5, 120, 22, hMain, %ID_RESET, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_RESET), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_RESET), %ANCHOR_RIGHT)

        ' Create button "LOAD Image"
          CALL CreateWindowEx(0, "BUTTON", "LOAD Image", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8), 10 + (22 + 5) * 6 + 5, 120, 22, hMain, %ID_NEW_IMAGE, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_NEW_IMAGE), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_NEW_IMAGE), %ANCHOR_RIGHT)

        ' Create Static 
          CALL zStaticCenter($CR + "You can drag the image holding down the" + $CR + """Left Mouse Button""" + $CR+ "while in the image control.", _
                           672 - (7 + 120 + 8), 10 + (22 + 5) * 7 + 5, 120, 88, hMain, %ID_STATIC)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_STATIC), %ANCHOR_RIGHT)