Code: Select all
'coded by UEZ build 2018-01-22
#Include "fbgfx.bi"
#Ifdef __FB_64BIT__
#Inclib "gdiplus"
#Include once "win/gdiplus-c.bi"
#Else
#Include once "win/gdiplus.bi"
using gdiplus
#Endif
Using FB
'init GDIPlus
Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput
GDIp.GdiplusVersion = 1
If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then End
'--------------------------------------------------------
Const As UShort iW = 1000, iH = 800, iWh = iW \ 2, iHh = iH \ 2
ScreenControl SET_DRIVER_NAME, "GDI"
ScreenRes iW, iH, 32, 1, GFX_HIGH_PRIORITY Or GFX_NO_SWITCH
Dim As String sTitle = "GDI+ Streamer v1.0 / FPS: "
WindowTitle sTitle
'center windows by adding the taskbar to the calculation
Dim as Integer iDW, iDH
ScreenControl GET_DESKTOP_SIZE, iDW, iDH
Dim tWorkingArea As RECT
SystemParametersInfo(SPI_GETWORKAREA, null, @tWorkingArea, null)
ScreenControl SET_WINDOW_POS, (iDW - iW) \ 2, _
((tWorkingArea.Bottom - iH) - (iDH - tWorkingArea.Bottom)) \ 2
'init GDI / GDI+ canvas, pens, brushes, etc. for drawing
Dim as HWND hHWND
ScreenControl(FB.GET_WINDOW_HANDLE, Cast(Integer, hHWND))
Dim As Any Ptr hDC = GetDC(hHWND), _
hHBitmap = CreateCompatibleBitmap(hDC, iW, iH), _
hDC_backbuffer = CreateCompatibleDC(hDC), _
hCanvas, hPenOut, hBrushInner, hMatrix, hFamily, hStringFormat, hPath
Var hObjOld = SelectObject(hDC_backbuffer, hHBitmap)
GdipCreateFromHDC(hDC_backbuffer, @hCanvas)
GdipGraphicsClear(hCanvas, &hFFFFFFFF)
GdipSetSmoothingMode(hCanvas, SmoothingModeAntiAlias)
GdipSetPixelOffsetMode(hCanvas, PixelOffsetModeHalf)
GdipCreatePen1(&hB0000000, 1.66666, 2, @hPenOut)
GdipCreateSolidFill(&hFFFFFFFF, @hBrushInner)
GdipCreateFontFamilyFromName("Times New Roman", Null, @hFamily)
GdipCreateStringFormat(0, 0, @hStringFormat)
GdipSetStringFormatAlign(hStringFormat, StringAlignmentCenter)
GdipSetStringFormatLineAlign(hStringFormat, StringAlignmentCenter)
GdipSetTextRenderingHint(hCanvas, PixelOffsetModeHalf)
GdipSetTextRenderingHint(hCanvas, TextRenderingHintAntiAliasGridFit)
GdipCreateMatrix(@hMatrix)
DIm tLayout as RectF
tLayout.width = 99
tLayout.height = 99
'--------------------------------------------------------
Dim as Single j = 2^16, k = -2^16, fRadius = iHh * 0.8, fRadiusX, fRadiusY
Dim as UShort c, iCenterX = iWh - 50, iCenterY = iHh - 50
Dim As ULong iFPS = 0
Dim as String aText(0 to ...) = {"GDI+ Streamer", "coded", "by", "UEZ"}
Dim as UByte iUB = Ubound(aText) + 1
Dim as Single aTextConf(0 to Ubound(aText), 2) = {{10, 22}, {5, 24}, {4, 40}, {30, 35}}
Dim tPoints(0 to 3) as GpPointF
Dim As Double fTimer = Timer, fTimer2 = Timer
Do
fRadiusX = fRadius * Sin((j + k) / 150)
fRadiusY = fRadius * Cos((k - j) / 250)
tPoints(0).x = iCenterX + Sin(j / 100) * fRadiusX
tPoints(0).y = iCenterY + Cos(j / 100) * fRadiusY
tPoints(1).x = (iCenterX + 100) + Sin(j / 100) * fRadiusX
tPoints(1).y = iCenterY + Cos(j / 100) * fRadiusY
tPoints(2).x = (iCenterX + 100) + Sin(j / 100) * fRadiusX
tPoints(2).y = (iCenterY + 100) + Cos(j / 100) * fRadiusY
tPoints(3).x = iCenterX + Sin(j / 100) * fRadiusX
tPoints(3).y = (iCenterY + 100) + Cos(j / 100) * fRadiusY
j -= 0.025
k += 2.5
GdipCreatePath(0, @hPath)
'GdipSetPathFillMode(hPath, FillModeWinding)
GdipAddPathPolygon(hPath, @tPoints(0), 4)
tLayout.x = tPoints(0).x
tLayout.y = tPoints(0).y
If Timer - fTimer2 > aTextConf(c, 0) Then
c = (c + 1) Mod iUB
fTimer2 = Timer
End If
GdipAddPathString(hPath, aText(c), -1, hFamily, 0, aTextConf(c, 1), @tLayout, hStringFormat)
GdipTranslateMatrix(hMatrix, iWh, iHh, False)
GdipRotateMatrix(hMatrix, 0.5 + Cos((j - k) / 10) * 2.5, false)
GdipTranslateMatrix(hMatrix, -iWh, -iHh, False)
GdipSetLineTransform(hBrushInner, hMatrix)
GdipTransformPath(hPath, hMatrix)
GdipFillPath(hCanvas, hBrushInner, hPath)
GdipDrawPath(hCanvas, hPenOut, hPath)
GdipDeletePath(hPath)
BitBlt(hDC, 0, 0, iW, iH, hDC_backbuffer, 0, 0, SRCCOPY)
Sleep(10, 1)
If Timer - fTimer > 0.99 Then
WindowTitle sTitle & iFPS
iFPS = 0
fTimer = Timer
Else
iFPS += 1
EndIf
Loop Until InKey = Chr(27)
'release resources
SelectObject(hDC_backbuffer, hObjOld)
DeleteDC(hDC_backbuffer)
ReleaseDC(hHWND, hDC)
DeleteObject(hHBitmap)
GdipDeleteGraphics(hCanvas)
GdipDeletePen(hPenOut)
GdipDeleteBrush(hBrushInner)
GdipDeleteFontFamily(hFamily)
GdipDeleteStringFormat(hStringFormat)
GdipDeleteMatrix(hMatrix)
GdiplusShutdown(gdipToken)
Because it is fast enough I did not use faster Sin/Cos functions.
Thanks to Josep Roca for the header to compile also in 64-bit!