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

📄 drawing.bas

📁 Powerbasic 对GDI 的操作 很漂亮的代码!
💻 BAS
📖 第 1 页 / 共 3 页
字号:
    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_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 + " Image annotation"
       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_NEWIMAGE, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_NEWIMAGE), zDefaultFont)

        ' Create button "Draft/Antialias"
          CALL CreateWindowEx(0, "BUTTON", "DRAFT / ANTIALIAS", %WS_CHILD OR %WS_VISIBLE, _
                           740 - (10 + 150 + 6), 10 + (22 + 5)* 1, 152, 22, hMain, %ID_ANTIALIAS, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_ANTIALIAS), zDefaultFont)

        ' Create button "Show/Hide 3DIN rectangle"
          CALL CreateWindowEx(0, "BUTTON", "Change rectangle Z-ORDER", %WS_CHILD OR %WS_VISIBLE, _
                           740 - (10 + 150 + 6), 10 + (22 + 5)* 2, 152, 22, hMain, %ID_RECTANGLE, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_RECTANGLE), zDefaultFont)

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

        ' Create button "Color count"
          CALL CreateWindowEx(0, "BUTTON", "Unique color COUNT", %WS_CHILD OR %WS_VISIBLE, _
                           740 - (10 + 150 + 6), 10 + (22 + 5)* 4, 152, 22, hMain, %ID_COLORCOUNT, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_COLORCOUNT), zDefaultFont)

        ' Create button "Convert to GRAY"
          CALL CreateWindowEx(0, "BUTTON", "Shade of GRAY", %WS_CHILD OR %WS_VISIBLE, _
                           740 - (10 + 150 + 6), 10 + (22 + 5)* 5, 152, 22, hMain, %ID_GRAYSHADE, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_GRAYSHADE), zDefaultFont)

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

        ' Create button "Print Image + Annotation"
          CALL CreateWindowEx(0, "BUTTON", "Print Image + Annotation", %WS_CHILD OR %WS_VISIBLE, _
                           740 - (10 + 150 + 6), 10 + (22 + 5)* 7, 152, 22, hMain, %ID_PRINTFULL, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_PRINTFULL), zDefaultFont)

        ' Create button "Load from Text STREAM"
          CALL CreateWindowEx(0, "BUTTON", "Load from Text STREAM", %WS_CHILD OR %WS_VISIBLE, _
                           740 - (10 + 150 + 6), 10 + (22 + 5)* 8, 152, 22, hMain, %ID_FROMSTREAM, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_FROMSTREAM), 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)
          CALL ZI_SetProperty(GetDlgItem(hMain, %ID_CTRL), %ZI_GradientTop, RGB(0,32,64))
          CALL ZI_SetProperty(GetDlgItem(hMain, %ID_CTRL), %ZI_GradientBottom, RGB(0,128,200))
          CALL ZI_SetFromFile(GetDlgItem(hMain, %ID_CTRL), "avalon.jpg")
        ' ******************************************************************************

        ' ------------------------------------------------------------------------------
        ' Draw Rectangle overlay object.
          CALL ZD_DrawRectangleToCtrl(GetDlgItem(hMain, %ID_CTRL), _   ' The GDImage control handle
                                 50, _                                 ' X coordinate
                                 50, _                                 ' Y coordinate
                                 450, _                                ' The width
                                 300, _                                ' The height
                                 ZD_ColorARGB(255,RGB(250,250,255)), _ ' The ARGB color to use
                                 10, _                                 ' The border size
                                 %ID_RECT_1, _                         ' The unique object ID
                                 %ZS_VISIBLE, _                        ' Overlay visible at startup
                                 %ZD_DRAW_OUTLINE, _                   ' Drawing mode
                                 0)                                    ' Optional shadow effect (offset in pixel)

        ' 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,0,0)), _    ' 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)

        ' ------------------------------------------------------------------------------
        ' Draw Arrow overlay object in DRAFT mode.
        ' Note: Remove the %ZS_DRAFT drawing mode to use Antialias.
          CALL ZD_DrawArrowToCtrl(GetDlgItem(hMain, %ID_CTRL), _       ' The GDImage control handle
                                 50, _                                 ' SeedX coordinate
                                 50 + 300, _                           ' SeedY coordinate
                                 50 + 20 + 450 - (10 * 2), _           ' TargetX coordinate
                                 50, _                                 ' TargetY coordinate
                                 ZD_ColorARGB(255,RGB(0,200,0)), _     ' The ARGB color to use
                                 10, _                                 ' Arrow width
                                 %ID_ARROW_1, _                        ' The unique object ID
                                 %ZS_VISIBLE OR %ZS_SCROLL OR %ZS_DRAFT, _          ' Overlay visible at startup
                                 %ZD_DRAW_FILLED, _                    ' Arrow supports only FILLED mode
                                 0)                                    ' Optional shadow effect (offset in pixel)

        ' ------------------------------------------------------------------------------
        ' Draw Ellipse overlay object in DRAFT mode (use SQUARE coordinates for circle).
        ' Note: Remove the %ZS_DRAFT drawing mode to use Antialias.
          CALL ZD_DrawEllipseToCtrl(GetDlgItem(hMain, %ID_CTRL), _     ' The GDImage control handle
                                 50, _                                 ' TopLeftX coordinate
                                 50, _                                 ' TopLeftY coordinate
                                 50 + 20 + 450 - (10 * 2), _           ' BottomRightX coordinate
                                 50 + 300, _                           ' BottomRightY coordinate
                                 ZD_ColorARGB(255,RGB(100,150,250)), _ ' The ARGB color to use
                                 11, _                                 ' Outline width
                                 %ID_ELLIPSE_1, _                      ' The unique object ID
                                 %ZS_VISIBLE OR %ZS_SCROLL OR %ZS_DRAFT, _ ' Overlay visible at startup
                                 %ZD_DRAW_OUTLINE, _                   ' Drawing mode
                                 0)                                    ' Optional shadow effect (offset in pixel)


        ' ------------------------------------------------------------------------------
        ' Draw Curve (star) overlay in DRAFT mode.
        ' Create a POINTS array for each of the vertice.
        ' Note: Remove the %ZS_DRAFT drawing mode to use Antialias.
          DIM xy(0 TO 9) AS POINTS
          xy(0).x = 80:   xy(0).y = 135
          xy(1).x = 140:  xy(1).y = 130
          xy(2).x = 160:  xy(2).y = 80
          xy(3).x = 180:  xy(3).y = 130
          xy(4).X = 240:  xy(4).y = 135
          xy(5).X = 192:  xy(5).y = 165
          xy(6).X = 210:  xy(6).y = 220
          xy(7).X = 160:  xy(7).y = 190
          xy(8).X = 110:  xy(8).y = 220
          xy(9).X = 128:  xy(9).y = 165
          CALL ZD_DrawCurveToCtrl(GetDlgItem(hMain, %ID_CTRL), _     ' The GDImage control handle
                                  BYVAL VARPTR(xy(0)), _
                                  UBOUND(xy) - LBOUND(xy) + 1, _
                                  ZD_ColorARGB(255,RGB(250,150,100)), _
                                  15, _
                                  %ID_CURVE_1, _
                                  %ZS_VISIBLE OR %ZS_DRAFT, _
                                  %ZD_DRAW_OUTLINE, _
                                  0)

        ' ------------------------------------------------------------------------------
        ' Draw PolyLine (star) overlay in DRAFT mode.
        ' Create a POINTS array for each of the vertice.
        ' Note: Remove the %ZS_DRAFT drawing mode to use Antialias.
        ' Note: Remove %ZD_DRAW_OPEN if you want to close the drawing.

⌨️ 快捷键说明

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