' gpSPHERE GDIPLUS Flat API example
'
' Most GDIPLUS examples and features have been translated to PB/WIN
' in the Patrice Terrier's "GDI+ helper" graphic toolkit.
'
' You can download a complete demo version of the GDIPLUS features at:
' [URL]http://www.zapsolution.com/preview/WinLIFT.exe[/URL]
' The name of the main demo is PICTURE.EXE
'
' Note: the "GDI+ helper" graphic toolkit do not require the use of WinLIFT
' however because WinLIFT is itself a graphic package some of its graphic's
' features are also explained in the PICTURE.EXE demo source code that is
' provided to registered users of the "GDI+ helper" graphic toolkit.
'
' This demo draws two spheres using the GDI+ AntiAlias mode.
' it is written in pure SDK code to reach the majority of the programming community.
' The GDIPLUS.INC could be find at:
' [URL]http://www.powerbasic.com/support/forums/Forum7/HTML/001616.html[/URL]
'
' The GDIPLUS.DLL could be find there:
' [URL]http://www.zapsolution.com/preview/gdiplus.exe[/URL]
'
#COMPILE EXE "gpSPHERE.exe"
#INCLUDE "win32api.inc"
#INCLUDE "gdiplus.inc"
' GDIPLUS Init (load the GDIPLUS.DLL)
FUNCTION gdihStart&()
' Load the GDI+ Dll
DIM GpInput AS GdiplusStartupInput
GpInput.GdiplusVersion = 1
IF GdiplusStartup(hGDIplus&, GpInput) = 0 THEN FUNCTION = hGDIplus&
END FUNCTION
' GDIPLUS unload (unload the GDIPLUS.DLL)
SUB gdihEnd(BYVAL hGDIplus&)
' Unload the GDI+ Dll
IF hGDIplus& THEN CALL GdiplusShutdown(hGDIplus&)
END SUB
' Helper function
' Use this in lieu of the Color class constructor
FUNCTION gdihColorSetAlpha(BYVAL lColor AS LONG, BYVAL Alpha AS BYTE) AS LONG
DIM bytestruct AS COLORBYTES
DIM result AS COLORLONG
result.longval = lColor
LSET bytestruct = result
bytestruct.AlphaByte = Alpha
LSET result = bytestruct
FUNCTION = result.longval
END FUNCTION
SUB DrawSphere(BYVAL hDC&)
' First Sphere coordinates
x& = 100: y& = 100: Size& = 200
CALL GdipCreateFromHDC(hDC&, graphics&)
' BRUSH EFFECT
' Create a GraphicsPath object
CALL GdipCreatePath(%FillModeAlternate, path1&)
' Add an ellipse to the path
CALL GdipAddPathEllipseI(path1&, x&, y&, Size&, Size&)
' Create a path gradient based on the ellipse
CALL GdipCreatePathGradientFromPath(path1&, brush1&)
' Set the middle color of the path
MiddleColorToOpaque& = gdihColorSetAlpha(%ColorsMediumAquamarine, 0)
CALL GdipSetPathGradientCenterColor(brush1&, MiddleColorToOpaque&)
' Set the entire path boundary to Alpha Black using 50% translucency
BlackFullTranslucent& = gdihColorSetAlpha(%ColorsBlack, 128)
CALL GdipSetPathGradientSurroundColorsWithCount(brush1&, BlackFullTranslucent&, 1)
' Draw the ellipse, keeping the exact coords we defined for the path
' I want to use AntiAlias drawing mode
CALL GdipSetSmoothingMode(graphics&, %SmoothingModeAntiAlias)
CALL GdipFillEllipseI(graphics&, brush1&, x& + 2, y& + 2, Size& - 4, Size& - 4)
' + 2 and - 4 are used to better achieve the AntiAlias
' Second Sphere coordinates
x& = 200: y& = 200: Size& = 150
' Create a GraphicsPath object
CALL GdipCreatePath(%FillModeAlternate, path2&)
' Add an ellipse to the path
CALL GdipAddPathEllipseI(path2&, x&, y&, Size&, Size&)
' Create a path gradient based on the ellipse
CALL GdipCreatePathGradientFromPath(path2&, brush2&)
' Set the middle color of the path
MiddleColorToOpaque& = gdihColorSetAlpha(%ColorsYellow, 64)
CALL GdipSetPathGradientCenterColor(brush2&, MiddleColorToOpaque&)
' Set the entire path boundary to Alpha Black using 50% translucency
BlackFullTranslucent& = gdihColorSetAlpha(%ColorsRed, 128)
CALL GdipSetPathGradientSurroundColorsWithCount(brush2&, BlackFullTranslucent&, 1)
' Draw the ellipse, keeping the exact coords we defined for the path
CALL GdipFillEllipseI(graphics&, brush2&, x& + 2, y& + 2, Size& - 4, Size& - 4)
' + 2 and - 4 are used to better achieve the AntiAlias
' Cleanup
CALL GdipDeletePath(path1&)
CALL GdipDeletePath(path2&)
CALL GdipDeleteBrush(brush1&)
CALL GdipDeleteBrush(brush2&)
CALL GdipDeleteGraphics(graphics&)
END SUB
FUNCTION WndProc(BYVAL hWnd& , BYVAL Msg&, BYVAL wParam&, BYVAL lParam&) AS LONG
LOCAL ps AS PAINTSTRUCT
SELECT CASE Msg&
CASE %WM_PAINT
hDC& = BeginPaint(hWnd&, ps)
CALL DrawSphere(hDC&)
CALL EndPaint(hWnd&, ps)
CASE %WM_DESTROY
CALL PostQuitMessage(0)
END SELECT
FUNCTION = DefWindowProc(hWnd&, Msg&, wParam&, lParam&)
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 szClassName AS ASCIIZ * 128
szClassName = "GDI+ demo"
' LOAD the GDI+ Engine
hGDIplus& = gdihStart
IF hGDIplus& THEN
IF ISFALSE(hPrevInstance&) THEN
wc.cbSize = SIZEOF(wc)
wc.style = %CS_HREDRAW OR %CS_VREDRAW
wc.lpfnWndProc = CODEPTR(WndProc)
wc.cbClsExtra = 0
wc.cbWndExtra = 0
wc.hInstance = hInstance&
wc.hIcon = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
wc.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wc.hbrBackground = GetStockObject(%WHITE_BRUSH)
wc.lpszMenuName = %NULL
wc.lpszClassName = VARPTR(szClassName)
wc.hIconSm = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
CALL RegisterClassEx(wc)
END IF
hWnd& = CreateWindowEx(0, _
szClassName, _ ' window class name
szClassName, _ ' window caption
%WS_OVERLAPPEDWINDOW, _ ' window style
%CW_USEDEFAULT, _ ' initial x position
%CW_USEDEFAULT, _ ' initial y position
%CW_USEDEFAULT, _ ' initial x size
%CW_USEDEFAULT, _ ' initial y size
%NULL, _ ' parent window handle
%NULL, _ ' window menu handle
hInstance&, _ ' program instance handle
BYVAL %NULL) ' creation parameters
IF hWnd& THEN
CALL ShowWindow(hWnd&, %SW_SHOW)
CALL UpdateWindow(hWnd&)
DO WHILE GetMessage(msg, %NULL, 0, 0)
TranslateMessage msg
DispatchMessage msg
LOOP
FUNCTION = msg.wParam
END IF
' UNLOAD the GDI+ Engine
CALL gdihEnd(hGDIplus&)
END IF
END FUNCTION
