anchor.bas

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

'
    zClass = "ZANCHOR"
'
    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_OVERLAPPEDWINDOW
'
       CALL SetRect(rc, 0, 0, 562, 350)
       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 Anchor control " + ZI_Version
       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 "%ANCHOR_RIGHT"
          CALL CreateWindowEx(0, "BUTTON", ("This button uses" + $cr + "%ANCHOR_RIGHT"), %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_MULTILINE, _
                           562 - (10 + 150 + 6), 10, 152, 40, hMain, %ID_BUTTON1, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_BUTTON1), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_BUTTON1), %ANCHOR_RIGHT)

        ' Create button "%ANCHOR_RIGHT"
          CALL CreateWindowEx(0, "BUTTON", ("This button uses" + $cr + "%ANCHOR_BOTTOM_RIGHT"), %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_MULTILINE, _
                           562 - (10 + 150 + 6), 350 - (40 + 10), 152, 40, hMain, %ID_BUTTON2, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_BUTTON2), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_BUTTON2), %ANCHOR_BOTTOM_RIGHT)


        ' ******************************************************************************
        ' Helper function to create A GDImage control (with automatic scrollbar support)
        ' ------------------------------------------------------------------------------
          CALL ZI_CreateWindow(hMain, 10, 10, 562 - (10 + 10 + 150 + 10 + 10), 350 - (10 * 2), %ID_CTRL)
          CALL ZI_SetProperty(GetDlgItem(hMain, %ID_CTRL), %ZI_GradientTop, RGB(64,32,64))
          CALL ZI_SetProperty(GetDlgItem(hMain, %ID_CTRL), %ZI_GradientBottom, RGB(200,128,0))
          CALL ZI_SetFromFile(GetDlgItem(hMain, %ID_CTRL), "anchor.gif")

        ' Anchor property                                     ANCHOR FLAGS
        '                                                     ------------
         'CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_CTRL), %ANCHOR_WIDTH)
         'CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_CTRL), %ANCHOR_RIGHT)
         'CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_CTRL), %ANCHOR_CENTER_HORZ)
         'CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_CTRL), %ANCHOR_HEIGHT)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_CTRL), %ANCHOR_HEIGHT_WIDTH)
         'CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_CTRL), %ANCHOR_HEIGHT_RIGHT)
         'CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_CTRL), %ANCHOR_BOTTOM)
         'CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_CTRL), %ANCHOR_BOTTOM_WIDTH)
         'CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_CTRL), %ANCHOR_BOTTOM_RIGHT)
         'CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_CTRL), %ANCHOR_CENTER_HORZ_BOTTOM)
         'CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_CTRL), %ANCHOR_CENTER_VERT)
         'CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_CTRL), %ANCHOR_CENTER_VERT_RIGHT)
         'CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_CTRL), %ANCHOR_CENTER)

        ' ******************************************************************************

          CALL ZD_DrawTextToCtrl(GetDlgItem(hMain, %ID_CTRL), _       ' The GDImage control handle
                                 "Resize the window", _               ' The text to be displayed
                                 178, _                               ' X coordinate
                                 266, _                               ' Y coordinate
                                 ZD_ColorARGB(255,RGB(0,64,128)), _   ' The ARGB color to use
                                 $Times_New_Roman, _                  ' The True Type Font to use
                                 20, _                                ' The font size in pixel
                                 %ID_TEXT_RESIZE, _                   ' The unique object ID
                                 %ZS_VISIBLE)                         ' Overlay visible at startup


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

    SELECT CASE Msg&

    CASE %WM_COMMAND
         wP& = LOWRD(wParam&)

         SELECT CASE LONG wP&

         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