This sample creates a simple Direct2D application that draws shapes, images, and text. It produces the output shown in the attached picture.
Code:
' ######################################################################################## ' Microsoft Windows ' File: SimpleD2DApp.bas ' Compilers: PBWIN 10.02+, PBCC 6.02+ ' Headers: Windows API headers 2.03+ ' This sample creates a simple Direct2D application that draws shapes, images, and text. ' It is an adaptation of the C++ program available at: ' http://msdn.microsoft.com/en-us/subscriptions/dd940321%28v=vs.85%29.aspx ' Portions (c) Microsoft Corporation. ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk. ' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER ' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF ' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. ' ######################################################################################## '// THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF '// ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO '// THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A '// PARTICULAR PURPOSE. '// '// Copyright (c) Microsoft Corporation. All rights reserved #COMPILE EXE #DIM ALL #INCLUDE ONCE "CWindow.inc" #INCLUDE ONCE "d2d1Helper.inc" #INCLUDE ONCE "D2DUtils.inc" #RESOURCE RES, "SimpleD2DApp.res" GLOBAL g_pID2D1Helper AS ID2D1Helper GLOBAL g_pD2DFactory AS ID2D1Factory GLOBAL g_pPathGeometry AS ID2D1PathGeometry GLOBAL g_pTextFormat AS IDWriteTextFormat GLOBAL g_pIWICFactory AS IWICImagingFactory GLOBAL g_pDWriteFactory AS IDWriteFactory GLOBAL g_pWICFactory AS IWICImagingFactory GLOBAL g_pRenderTarget AS ID2D1HwndRenderTarget GLOBAL g_pBlackBrush AS ID2D1SolidColorBrush GLOBAL g_pLinearGradientBrush AS ID2D1LinearGradientBrush GLOBAL g_pGridPatternBitmapBrush AS ID2D1BitmapBrush GLOBAL g_pBitmap AS ID2D1Bitmap GLOBAL g_pAnotherBitmap AS ID2D1Bitmap ' ======================================================================================== ' Main ' ======================================================================================== FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG ' // Set process DPI aware IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware ' // Create an instance of the CWindow class LOCAL pWindow AS IWindow pWindow = CLASS "CWindow" IF ISNOTHING(pWindow) THEN EXIT FUNCTION ' // Create an instance of the CD2D1Helper class g_pID2D1Helper = CLASS "CD2D1Helper" IF ISNOTHING(g_pID2D1Helper) THEN EXIT FUNCTION IF ISFALSE CreateDeviceIndependentResources THEN EXIT FUNCTION ' // Create the application window. pWindow.CreateWindow(%NULL, "Direct2D Demo App", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc)) ' // Set the client size pWindow.SetClientSize 600, 450 ' // Center the window pWindow.CenterWindow ' // Default message pump (you can replace it with your own) pWindow.DoEvents(nCmdShow) END FUNCTION ' ======================================================================================== ' ======================================================================================== ' Create resources which are not bound to any device. Their lifetime effectively extends ' for the duration of the app. These resources include the Direct2D, DirectWrite, and ' WIC factories; and a DirectWrite Text Format object (used for identifying particular ' font characteristics) and a Direct2D geometry. ' ======================================================================================== FUNCTION CreateDeviceIndependentResources () AS LONG LOCAL hr AS LONG LOCAL pSink AS ID2D1GeometrySink '// Create a Direct2D factory. hr = D2D1CreateFactory2(%D2D1_FACTORY_TYPE_SINGLE_THREADED, g_pD2DFactory) IF hr <> %S_OK THEN EXIT FUNCTION '// Create WIC factory. g_pWICFactory = NEWCOM CLSID $CLSID_WICImagingFactory IF ISNOTHING(g_pWICFactory) THEN EXIT FUNCTION '// Create a DirectWrite factory. hr = DWriteCreateFactory(%DWRITE_FACTORY_TYPE_SHARED, $IID_IDWriteFactory, g_pDWriteFactory) IF hr <> %S_OK THEN EXIT FUNCTION ' // We need to use an string here because using "" will pass a null pointer ' // instead of a pointer to an empty string. LOCAL wszLocaleName AS WSTRINGZ * 260 '// Create a DirectWrite text format object. hr = g_pDWriteFactory.CreateTextFormat("Verdana", NOTHING, %DWRITE_FONT_WEIGHT_NORMAL, _ %DWRITE_FONT_STYLE_NORMAL, %DWRITE_FONT_STRETCH_NORMAL, 50, wszLocaleName, g_pTextFormat) IF hr <> %S_OK THEN EXIT FUNCTION ' // Center the text horizontally and vertically. g_pTextFormat.SetTextAlignment(%DWRITE_TEXT_ALIGNMENT_CENTER) g_pTextFormat.SetParagraphAlignment(%DWRITE_PARAGRAPH_ALIGNMENT_CENTER) ' // Create a path geometry. hr = g_pD2DFactory.CreatePathGeometry(g_pPathGeometry) IF hr <> %S_OK THEN EXIT FUNCTION ' // Use the geometry sink to write to the path geometry. hr = g_pPathGeometry.Open(pSink) IF hr <> %S_OK THEN EXIT FUNCTION pSink.SetFillMode(%D2D1_FILL_MODE_ALTERNATE) LOCAL currentLocation AS D2D1_POINT_2F currentLocation.x = 0 currentLocation.y = 0 pSink.BeginFigure(currentLocation, %D2D1_FIGURE_BEGIN_FILLED) currentLocation.x = 200 currentLocation.y = 0 pSink.AddLine(currentLocation) pSink.AddBezier(g_pID2D1Helper.BezierSegment(g_pID2D1Helper.Point2F(150, 50), _ g_pID2D1Helper.Point2F(150, 150), g_pID2D1Helper.Point2F(200, 200))) currentLocation.x = 0 currentLocation.y = 200 pSink.AddLine(currentLocation) pSink.AddBezier(g_pID2D1Helper.BezierSegment(g_pID2D1Helper.Point2F(50, 150), _ g_pID2D1Helper.Point2F(50, 50), g_pID2D1Helper.Point2F(0, 0))) pSink.EndFigure(%D2D1_FIGURE_END_CLOSED) hr = pSink.Close FUNCTION = %TRUE END FUNCTION ' ======================================================================================== ' ======================================================================================== ' This method creates resources which are bound to a particular Direct3D device. It's all ' centralized here, in case the resources need to be recreated in case of Direct3D device ' loss (eg. display change, remoting, removal of video card, etc). ' ======================================================================================== FUNCTION CreateDeviceResources (BYVAL hWnd AS LONG) AS LONG LOCAL hr AS LONG, nType AS DWORD, pixelFormat AS D2D1_PIXEL_FORMAT, dpiX, dpiY AS SINGLE LOCAL usage, minlevel AS DWORD, dxgiFormat, alphaMode AS DWORD LOCAL brushProperties AS D2D1_BRUSH_PROPERTIES, rc AS RECT IF ISNOTHING(g_pRenderTarget) THEN GetClientRect(hWnd, rc) hr = g_pD2DFactory.CreateHwndRenderTarget(g_pID2D1Helper.RenderTargetProperties, _ g_pID2D1Helper.HwndRenderTargetProperties(hWnd, _ g_pID2D1Helper.SizeU(rc.Right - rc.Left, rc.Bottom - rc.Top)), _ g_pRenderTarget) ' // Create a black brush. IF hr = %S_OK THEN brushProperties.opacity = 1.0 brushProperties.transform = g_pID2D1Helper.IdentityMatrix() hr = g_pRenderTarget.CreateSolidColorBrush(g_pID2D1Helper.ColorF_2(%D2D1_Black), _ brushProperties, g_pBlackBrush) END IF IF hr = %S_OK THEN LOCAL pGradientStops AS ID2D1GradientStopCollection '// Create a linear gradient. DIM stops(1) AS D2D1_GRADIENT_STOP stops(0).position = 0.0 : stops(0).color = g_pID2D1Helper.ColorF(0.0, 1.0, 1.0, 0.25) stops(1).position = 1.0 : stops(1).color = g_pID2D1Helper.ColorF(0.0, 0.0, 1.0, 1.0) hr = g_pRenderTarget.CreateGradientStopCollection(stops(0), 2, 0, 0, pGradientStops) IF hr = %S_OK THEN hr = g_pRenderTarget.CreateLinearGradientBrush( _ g_pID2D1Helper.LinearGradientBrushProperties(g_pID2D1Helper.Point2F(100, 0), _ g_pID2D1Helper.Point2F(100, 200)), _ g_pID2D1Helper.BrushProperties, _ pGradientStops, _ g_pLinearGradientBrush _ ) pGradientStops = NOTHING END IF END IF '// Create a bitmap from an application resource. hr = D2D_LoadBitmapFromResource(g_pRenderTarget, g_pWICFactory, %NULL, _ "SampleImage", "Image", 100, 0, g_pBitmap) IF hr = %S_OK THEN '// Create a bitmap by loading it from a file. hr = D2D_LoadBitmapFromFile(g_pRenderTarget, g_pWICFactory, _ EXE.Path$ & "sampleImage.jpg", 100, 0, g_pAnotherBitmap) END IF IF hr = %S_OK THEN hr = CreateGridPatternBrush(g_pRenderTarget, g_pGridPatternBitmapBrush) END IF FUNCTION = hr END FUNCTION ' ======================================================================================== ' ======================================================================================== ' Creates a pattern brush. ' ======================================================================================== FUNCTION CreateGridPatternBrush(pRenderTarget AS ID2D1RenderTarget, ppBitmapBrush AS ID2D1BitmapBrush) AS LONG LOCAL hr AS LONG LOCAL pCompatibleRenderTarget AS ID2D1BitmapRenderTarget '// Create a compatible render target. hr = pRenderTarget.CreateCompatibleRenderTarget( _ g_pID2D1Helper.SizeF(10.0, 10.0), _ BYVAL %NULL, _ 'desiredPixelSize, _ BYVAL %NULL, _ 'desiredFormat, _ %D2D1_COMPATIBLE_RENDER_TARGET_OPTIONS_NONE, _ pCompatibleRenderTarget _ ) IF hr = %S_OK THEN '// Draw a pattern. LOCAL pGridBrush AS ID2D1SolidColorBrush LOCAL brushProperties AS D2D1_BRUSH_PROPERTIES brushProperties.opacity = 1.0 brushProperties.transform = g_pID2D1Helper.IdentityMatrix() hr = pCompatibleRenderTarget.CreateSolidColorBrush( _ g_pID2D1Helper.ColorF(0.93, 0.94, 0.96, 1.0), _ brushProperties, _ pGridBrush _ ) IF hr = %S_OK THEN pCompatibleRenderTarget.BeginDraw() pCompatibleRenderTarget.FillRectangle(g_pID2D1Helper.RectF(0.0, 0.0, 10.0, 1.0), pGridBrush) pCompatibleRenderTarget.FillRectangle(g_pID2D1Helper.RectF(0.0, 0.1, 1.0, 10.0), pGridBrush) pCompatibleRenderTarget.EndDraw() '// Retrieve the bitmap from the render target. LOCAL pGridBitmap AS ID2D1Bitmap hr = pCompatibleRenderTarget.GetBitmap(pGridBitmap) IF hr = %S_OK THEN '// Choose the tiling mode for the bitmap brush. LOCAL bitmapbrushProperties AS D2D1_BITMAP_BRUSH_PROPERTIES bitmapbrushProperties = g_pID2D1Helper.BitmapBrushProperties(%D2D1_EXTEND_MODE_WRAP, %D2D1_EXTEND_MODE_WRAP) '// Create the bitmap brush. hr = g_pRenderTarget.CreateBitmapBrush(pGridBitmap, bitmapbrushProperties, brushProperties, ppBitmapBrush) pGridBitmap = NOTHING END IF pGridBrush = NOTHING END IF pCompatibleRenderTarget = NOTHING END IF FUNCTION = hr END FUNCTION ' ======================================================================================== ' ======================================================================================== ' Discard device-specific resources which need to be recreated when a Direct3D device is lost ' ======================================================================================== SUB DiscardDeviceResources g_pRenderTarget = NOTHING g_pBitmap = NOTHING g_pBlackBrush = NOTHING g_pLinearGradientBrush = NOTHING g_pAnotherBitmap = NOTHING g_pGridPatternBitmapBrush = NOTHING END SUB ' ======================================================================================== ' ======================================================================================== ' Called whenever the application needs to display the client window. This method draws a ' bitmap a couple times, draws some geometries, and writes "Hello, World" ' ' Note that this function will not render anything if the window is occluded (e.g. when ' the screen is locked). Also, this function will automatically discard device-specific ' resources if the Direct3D device disappears during function invocation, and will recreate ' the resources the next time it's invoked. ' ======================================================================================== FUNCTION OnRender(BYVAL hWnd AS LONG) AS LONG LOCAL hr AS LONG hr = CreateDeviceResources(hWnd) IF hr = %S_OK THEN IF (g_pRenderTarget.CheckWindowState AND %D2D1_WINDOW_STATE_OCCLUDED) = 0 THEN LOCAL renderTargetSize, BitmapSize AS D2D1_SIZE_F ' // Retrieve the size of the render target. renderTargetSize = g_pRenderTarget.GetSize() g_pRenderTarget.BeginDraw() g_pRenderTarget.SetTransform(g_pID2D1Helper.IdentityMatrix()) g_pRenderTarget.Clear(g_pID2D1Helper.ColorF_2(%D2D1_White)) ' // Paint a grid background. g_pRenderTarget.FillRectangle(g_pID2D1Helper.RectF(0.0, 0.0, renderTargetSize.width, _ renderTargetSize.height), g_pGridPatternBitmapBrush) IF ISOBJECT(g_pBitmap) THEN BitmapSize = g_pBitmap.GetSize() '// Draw a bitmap in the upper-left corner of the window. g_pRenderTarget.DrawBitmap(g_pBitmap, _ g_pID2D1Helper.RectF(0.0, 0.0, BitmapSize.width, BitmapSize.height), _ 1.0, %D2D1_BITMAP_INTERPOLATION_MODE_LINEAR) END IF ' // Draw a bitmap at the lower-right corner of the window. BitmapSize = g_pAnotherBitmap.GetSize() g_pRenderTarget.DrawBitmap( _ g_pAnotherBitmap, _ g_pID2D1Helper.RectF(renderTargetSize.width - BitmapSize.width, renderTargetSize.height - BitmapSize.height, renderTargetSize.width, renderTargetSize.height), _ 1.0, _ '// opacity %D2D1_BITMAP_INTERPOLATION_MODE_LINEAR) ' // Set the world transform to a 45 degree rotation at the center of the render target ' // and write "Hello, World". g_pRenderTarget.SetTransform(g_pID2D1Helper.MatrixRotation(45, _ g_pID2D1Helper.Point2F(renderTargetSize.width \ 2, renderTargetSize.height \ 2))) LOCAL wszHelloWorld AS WSTRINGZ * 260 wszHelloWorld = "Hello, World!" g_pRenderTarget.DrawText(wszHelloWorld, LEN(wszHelloWorld), g_pTextFormat, _ g_pID2D1Helper.RectF(0, 0, renderTargetSize.width, renderTargetSize.height), _ g_pBlackBrush, %D2D1_DRAW_TEXT_OPTIONS_NONE, %DWRITE_MEASURING_MODE_NATURAL) '// Reset back to the identity transform g_pRenderTarget.SetTransform(g_pID2D1Helper.MatrixTranslation(0, renderTargetSize.height - 200)) '// Fill the hour glass geometry with a gradient. g_pRenderTarget.FillGeometry(g_pPathGeometry, g_pLinearGradientBrush) g_pRenderTarget.SetTransform(g_pID2D1Helper.MatrixTranslation(renderTargetSize.width - 200, 0)) ' // Fill the hour glass geometry with a gradient. g_pRenderTarget.FillGeometry(g_pPathGeometry, g_pLinearGradientBrush) hr = g_pRenderTarget.EndDraw() IF hr = %D2DERR_RECREATE_TARGET THEN hr = %S_OK DiscardDeviceResources END IF END IF END IF FUNCTION = hr END FUNCTION ' ======================================================================================== ' ======================================================================================== ' If the application receives a WM_SIZE message, this method resize the render target appropriately. ' ======================================================================================== SUB OnResize(BYVAL nWidth AS LONG, BYVAL nHeight AS LONG) IF ISOBJECT(g_pRenderTarget) THEN LOCAL su AS D2D1_SIZE_U su.width = nWidth su.height = nHeight '// Note: This method can fail, but it's okay to ignore the '// error here -- it will be repeated on the next call to '// EndDraw. g_pRenderTarget.Resize(su) END IF END SUB ' ======================================================================================== ' ======================================================================================== ' Main callback function. ' ======================================================================================== FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG ' // Process window mesages SELECT CASE uMsg CASE %WM_COMMAND SELECT CASE LO(WORD, wParam) CASE %IDCANCEL ' // If the Escape key has been pressed... IF HI(WORD, wParam) = %BN_CLICKED THEN ' // ... close the application by sending a WM_CLOSE message SendMessage hwnd, %WM_CLOSE, 0, 0 EXIT FUNCTION END IF END SELECT CASE %WM_SIZE OnResize(LO(INTEGER, lParam), HI(INTEGER, lParam)) CASE %WM_PAINT ', %WM_DISPLAYCHANGE LOCAL ps AS PAINTSTRUCT BeginPaint(hWnd, ps) OnRender(hWnd) EndPaint(hWnd, ps) EXIT FUNCTION CASE %WM_DESTROY ' // End the application PostQuitMessage 0 EXIT FUNCTION END SELECT ' // Pass unprocessed messages to Windows FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam) END FUNCTION ' ========================================================================================