⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 pano.bas

📁 Powerbasic 对GDI 的操作 很漂亮的代码!
💻 BAS
📖 第 1 页 / 共 3 页
字号:
                           x&, y&, w&, h&, hParent&, ID&, zInstance, BYVAL %NULL)
    CALL zSetCTLFont(hCtl&, zDefaultFont)
    FUNCTION = hCtl&
END FUNCTION

FUNCTION zGetCTLText(BYVAL hC&) AS STRING
    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

    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)
            vIncr = 0.0: hIncr = 0.0
            CALL apiSleep(20)
         END IF
    CASE GetDlgItem(hMain, %ID_ZOOM_OUT)
         ZoomIs = ZI_GetGLzoom(glWnd)
         IF ZoomIs < 58 THEN
            CALL ZI_SetGLzoom(glWnd, ZoomIs + 1): CALL ZI_ResizeGLWindow(glWnd)
            vIncr = 0.0: hIncr = 0.0
            CALL apiSleep(20)
         END IF   
    CASE GetDlgItem(hMain, %ID_STOP)
         vIncr = 0.0: hIncr = 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 LONG
    LOCAL hBitmap     AS LONG
    LOCAL hImage      AS LONG
    LOCAL bmW         AS LONG
    LOCAL bmH         AS LONG
    LOCAL zTexture    AS ASCIIZ * 260
'
    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 = "ZPANO"
'
    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, 404)
       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 + " - ""360 Panorama"" 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 + "Use either buttons" + $CR + "or arrow keys" + $CR + "to rotate the panorama.", _
                           672 - (7 + 120 + 8), 10 + 385 - 74, 120, 74, hMain, %ID_STATIC)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_STATIC), %ANCHOR_BOTTOM_RIGHT)

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -