reflect.bas

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

'------------------------------------------------------------------------------------------
#INCLUDE "gdimage.inc"

'------------------------------------------------------------------------------------------
$Times_New_Roman = "Times New Roman" ' Must be a valid TTF
$Background = "Background"

%ID_STATUSBAR     = 100
%ID_CTRL          = 101
%ID_STA_Help      = 102
%ID_BTN_LOAD      = 103
%ID_BTN_CHECK     = 104

' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' Warning each overlay object must have a UNIQUE IDENTIFIER
%ID_OBJECT_TEXT   = 9
%ID_FIRST         = %ID_OBJECT_TEXT
%ID_OBJECT_SPRITE = 10
%ID_SPRITE1       = 11
%ID_SPRITE2       = 12
%ID_SPRITE3       = 13
%ID_SPRITE4       = 14
%ID_LAST          = %ID_SPRITE4

%UseWidth         = 700
%UseHeight        = 550

' WinXP Theme support declares (if applicable)
DECLARE FUNCTION EnableDialogTheme(BYVAL hDlg AS DWORD, BYVAL dwStyle AS DWORD) AS LONG
DECLARE FUNCTION IsThemeActive() AS LONG

GLOBAL hBitmap() AS LONG, hMain AS LONG, ChangeItem AS LONG

FUNCTION zExeName () AS STRING
    LOCAL zTmp AS ASCIIZ * %MAX_PATH
    LenExeName& = GetModuleFileName(BYVAL %NULL, zTmp, SIZEOF(zTmp))
    IF LenExeName& THEN
       LenExeName& = MIN&(LenExeName&, SIZEOF(zTmp))
       FUNCTION = LEFT$(zTmp, LenExeName&)
    END IF
END FUNCTION

FUNCTION zDefaultFont() AS LONG
    STATIC hDefault&
    IF hDefault& = 0 THEN hDefault& = GetStockObject(%ANSI_VAR_FONT)
    FUNCTION = hDefault&
END FUNCTION

SUB zSetCTLFont(BYVAL hC&, BYVAL hFont&)
    CALL SendMessage(hC&, %WM_SETFONT, hFont&, 0)
END SUB

FUNCTION zCaptionFont() AS LONG
    DIM LF AS LogFont
    STATIC CaptionFont&
    IF CaptionFont& = 0 THEN
       LF.lfHeight = 8 ' -FontHeight&
       LF.lfWidth = 0
       LF.lfCharSet = %DEFAULT_CHARSET
       LF.lfOutPrecision = %OUT_DEFAULT_PRECIS
       LF.lfClipPrecision = %OUT_DEFAULT_PRECIS
       LF.lfQuality = %DEFAULT_QUALITY
       LF.lfPitchAndFamily = %DEFAULT_PITCH OR %FF_DONTCARE
       LF.lfWeight = 700
       LF.lfFaceName = "MS Sans Serif"
       CaptionFont& = CreateFontIndirect(LF)
    END IF
    FUNCTION = CaptionFont&
END FUNCTION

SUB zDeleteObject(hObject AS LONG)
    IF hObject THEN CALL DeleteObject(hObject): hObject = 0
END SUB

FUNCTION zStaticCenter(BYVAL Label$, BYVAL x&, BYVAL y&, BYVAL w&, BYVAL h&, BYVAL hParent&, BYVAL ID&) AS LONG
    hCtl& = CreateWindowEx(0, "STATIC", (Label$), %WS_CHILD OR %WS_VISIBLE OR %SS_SUNKEN OR %SS_CENTER, _
                           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

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 hCtrl       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_DBLCLKS OR %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 = GetStockObject(%NULL_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, %UseWidth, %UseHeight)
       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 version " + ZI_Version + " Reflection 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

        ' ******************************************************************************
        ' Helper function to create A GDImage control (with automatic scrollbar support)
        ' ------------------------------------------------------------------------------
          hCtrl = ZI_CreateWindow(hMain, 10, 10, %UseWidth - 160, %useHeight - 43, %ID_CTRL)
        ' Use gradient for background
          CALL ZI_SetProperty(hCtrl, %ZI_GradientTop, RGB(0,9,33))
          CALL ZI_SetProperty(hCtrl, %ZI_GradientBottom, RGB(0,0,0))
        ' Set the correct anchor property
          CALL ZI_SetAnchorMode(hCtrl, %ANCHOR_HEIGHT_WIDTH)
        ' We use a callback to monitor the GDImage control messages
        ' Create a %WM_LBUTTONDOWN event
          CALL ZI_EventMessage(CODEPTR(MyCallBack), %WM_LBUTTONDOWN, %TRUE)
        ' Create a %WM_RBUTTONDOWN event
          CALL ZI_EventMessage(CODEPTR(MyCallBack), %WM_RBUTTONDOWN, %TRUE)
        ' Create a %WM_KEYDOWN event
          CALL ZI_EventMessage(CODEPTR(MyCallBack), %WM_KEYDOWN, %TRUE)
        ' Create a %WM_MOUSEMOVE event
          CALL ZI_EventMessage(CODEPTR(MyCallBack), %WM_MOUSEMOVE, %TRUE)

        ' Add sprites
          CALL GetSpriteFromFile(hCtrl)

        ' 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
        ' Note: because this is the last object it is drawn on top of z-order
          CALL ZD_DrawTextToCtrl(hCtrl, _                              ' The GDImage control handle
                                 "GDImage Reflection", _               ' The text to be displayed
                                 20, _                                 ' X coordinate
                                 20, _                                 ' Y coordinate
                                 ZD_ColorARGB(200,RGB(250,250,255)), _ ' The ARGB color to use
                                 $Times_New_Roman, _                   ' The True Type Font to use
                                 40, _                                 ' The font size in pixel
                                 %ID_OBJECT_TEXT, _                    ' The unique object ID
                                 %ZS_VISIBLE, _                        ' Show overlay
                                 1)                                    ' Optional shadow effect (offset in pixel)
          CALL ZI_GetBitmapSize(ZI_GetBMP(hCtrl), useWidth&, useHeight&)
          IF useWidth& THEN CALL ZD_SetObjectScroll(%ID_OBJECT_TEXT, %TRUE)
'
        ' ******************************************************************************
        ' Create static help comment
        ' ------------------------------------------------------------------------------
          Label$ = $CR + $CR + "Mouse use:" + $CR + $CR + "Left button" + $CR + "to drag the sprite." + $CR + $CR + _
                   "Right button" + $CR + "cusor coordinates." + $CR + $CR + "You can create events to monitor the message flow." + $CR + _
                   "___________" + $CR + $CR + _
                   "Keyboard input:" + $CR + $CR + "You can use all navigation keys." + $CR + $CR + _
                   "Altogether with SHIFT or CTRL or CTRL+SHIFT for faster move."

          CALL CreateWindowEx(0, "STATIC", (Label$), %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, _
                           %UseWidth - (7 + 120 + 8), 10, 120, 340, hMain, %ID_STA_Help, zInstance, BYVAL 0)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_STA_Help), zCaptionFont)
        ' Set the correct anchor property
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_STA_Help), %ANCHOR_RIGHT)

        ' ******************************************************************************
        ' Create buttons
        ' ------------------------------------------------------------------------------
          CALL CreateWindowEx(0, "BUTTON", "Load sprite image", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           %UseWidth - (7 + 120 + 8), %UseHeight - 55, 120, 22, hMain, %ID_BTN_LOAD, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_BTN_LOAD), zDefaultFont)
        ' Set the correct anchor property
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_BTN_LOAD), %ANCHOR_BOTTOM_RIGHT)

          CALL CreateWindowEx(0, "Button", "Glue sprites together", _
                                 %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _         ' window styles
                                 %BS_AUTOCHECKBOX OR %BS_LEFT OR %BS_VCENTER, _       ' class styles
                                 %UseWidth - (7 + 120 + 8), %UseHeight - 79, _        ' left, top
                                 120, 22, _                                           ' width, height
                                 hMain, %ID_BTN_CHECK, _                              ' handle of parent, control ID
                                 zInstance, BYVAL %NULL)                              ' handle of instance, creation parameters
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_BTN_CHECK), zDefaultFont)
        ' Set the correct anchor property
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_BTN_CHECK), %ANCHOR_BOTTOM_RIGHT)

        ' ******************************************************************************
        ' Create the status bar
        ' ------------------------------------------------------------------------------
          hStatus& = CreateWindowEx(0, _                               ' extended styles
                                 "msctls_statusbar32", _               ' class name
                                 "", _                                 ' caption
                                 %WS_CHILD OR %WS_VISIBLE OR _         ' window styles
                                 %SBARS_TOOLTIPS OR %SBARS_SIZEGRIP, _ ' class styles
                                 0, 423, _                             ' left, top
                                 %UseWidth, 23, _                      ' width, height
                                 hMain, %ID_STATUSBAR, _               ' handle of parent, control ID
                                 zInstance, BYVAL %NULL)               ' handle of instance, creation parameters