Additional files which are needed to run it properly (font and mp3) in the Zip archive which can be downloaded here: http://www.mediafire.com/file/nncqb4e7u ... 7.zip/file
Source Code (no audio and no ext. font needed version):
Code: Select all
'coded by UEZ build 2018-07-07
'
'WINDOWS and x86 ONLY!!!
#Include "fbgfx.bi"
#include "file.bi"
#Include "win/gdiplus.bi"
Using gdiplus
Using FB
#Define CRLF Chr(13) + Chr(10)
'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 = 854, iH = iW / 2, 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+ Star Wars Scroller v0.6 / 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))
'Create canvas
Dim Shared As Any Ptr hCanvas, hPen, hBrush, hBrush_Warp, hBitmap, hGfx, hTexture, hFamily, hFamily_Logo, hFamily_Warp, _
hStringFormat, hStringFormat_Logo, hStringFormat_Warp, hFont, hFont2, hCollection, hPath_Logo, hPath_Warp, hPath_Temp
Dim As Any Ptr hDC = GetDC(hHWND), _
hHBitmap = CreateCompatibleBitmap(hDC, iW, iH), _
hDC_backbuffer = CreateCompatibleDC(hDC), hObjOld
hObjOld = SelectObject(hDC_backbuffer, hHBitmap)
GdipCreateFromHDC(hDC_backbuffer, @hCanvas)
GdipSetSmoothingMode(hCanvas, SmoothingModeAntiAlias)
GdipSetPixelOffsetMode(hCanvas, PixelOffsetModeHalf)
GdipSetTextRenderingHint(hCanvas, TextRenderingHintAntiAliasGridFit)
Dim As GpPointF StartPoint, EndPoint
StartPoint.x = iWh
StartPoint.y = -iHh * 0.25
EndPoint.x = iWh
EndPoint.y = iH
Dim As ULong iColorTxt1_RGB = &h001367FD, iColorTxt2_RGB = &hF8DA37, i
GdipCreateSolidFill(iColorTxt1_RGB, @hBrush)
GdipCreateSolidFill(&hFFD7A501, @hBrush_Warp)
GdipCreateLineBrush(@StartPoint, @EndPoint, &h00D7A501, &hFFD7A501, 0, @hBrush_Warp)
GdipSetLineGammaCorrection(hBrush_Warp, True)
GdipCreatePen1(iColorTxt2_RGB, 4, UnitPixel, @hPen)
GdipSetPenLineJoin(hPen, LineJoinRound)
'create font
Dim As GpRectF tLayout, tLayout_Logo, tLayout_Warp
tLayout.x = iW * 0.12
tLayout.y = 0
tLayout.Width = iW
tLayout.height = iH
GdipCreateFontFamilyFromName("Times New Roman", Null, @hFamily)
GdipCreateStringFormat(0, 0, @hStringFormat)
GdipCreateFont(hFamily, iH / 12.5, FontStyleBold, UnitPoint, @hFont)
GdipSetStringFormatLineAlign(hStringFormat, StringAlignmentCenter)
'GdipSetStringFormatAlign(hStringFormat, StringAlignmentFar)
'Create 2nd gfx buffer
GdipCreateBitmapFromScan0(iW, iH, 0, PixelFormat32bppARGB, 0, @hBitmap)
GdipGetImageGraphicsContext(hBitmap, @hGfx)
GdipSetPixelOffsetMode(hGfx, PixelOffsetModeHalf)
GdipSetSmoothingMode(hGfx, SmoothingModeAntiAlias)
GdipSetTextRenderingHint(hGfx, TextRenderingHintAntiAliasGridFit)
'create some Random stars
Dim As Ulong aColor(0 To 6) = {&hFFFFFFFF, &hFFDDDDDD, &hFFBBBBBB, &hFF999999, &hFF777777, &hFF555555, &hFF333333}
For i As Ulong = 1 To 2000
GdipBitmapSetPixel(hBitmap, Rnd() * iW, Rnd() * iH, aColor(Int(Rnd() * 6)))
Next
'create STAR WARS logo
tLayout_Logo.x = -iWh
tLayout_Logo.y = -iHh
tLayout_Logo.Width = iW * 2
tLayout_Logo.height = iH * 2
Dim As Ubyte bFont = 1
If Fileexists(Curdir & "\Death Star.otf") = 0 Then
GdipCreateFontFamilyFromName("Impact", Null, @hFamily_Logo)
bFont = 0
Else
GdipNewPrivateFontCollection(@hCollection)
GdipPrivateAddFontFile(hCollection, Curdir & "\Death Star.otf")
GdipCreateFontFamilyFromName("Death Star", hCollection, @hFamily_Logo)
EndIf
GdipCreatePath(FillModeAlternate, @hPath_Logo)
GdipCreateStringFormat(0, 0, @hStringFormat_Logo)
GdipSetStringFormatAlign(hStringFormat_Logo, StringAlignmentCenter)
GdipSetStringFormatLineAlign(hStringFormat_Logo, StringAlignmentCenter)
'create warp
Dim As String aWarpText(26) = { _
"It is a period of civil war.", _
"Rebel spaceships, striking", _
"from a hidden base, have", _
"won their first victory", _
"against the evil Galactic", _
"Empire.", _
" ", _
"During the battle, rebel", _
"spies managed to steal", _
"secret plans to the Empire's", _
"ultimate weapon, the", _
"Death Star, an armored space", _
"station with enough", _
"power to destroy an entire", _
"planet.", _
" ", _
"Pursued by the Empire's", _
"sinister agents, Princess", _
"Leia races home aboard her", _
"starship, custodian of the", _
"stolen plans that can save", _
"her people and restore", _
"freedom to the galaxy....", _
" ", _
" ", _
"Intro coded by UEZ :-)"}
GdipCreatePath(FillModeAlternate, @hPath_Warp)
GdipCreatePath(FillModeAlternate, @hPath_Temp)
GdipCreateStringFormat(0, 0, @hStringFormat_Warp)
GdipSetStringFormatAlign(hStringFormat_Warp, 0)
GdipSetStringFormatLineAlign(hStringFormat_Warp, 0)
GdipCreateFontFamilyFromName("Verdana", 0, @hFamily_Warp)
Dim As GpRectF tRECTF_Bound
Dim As Single fFontSize = iH / 6.6875
For i = 0 To Ubound(aWarpText)
tLayout_Warp.y = i * (fFontSize + 5)
GdipAddPathString(hPath_Warp, aWarpText(i), -1, hFamily_Warp, FontStyleRegular, (fFontSize + 5), @tLayout_Warp, hStringFormat_Warp)
Next
GdipGetPathWorldBounds(hPath_Warp, @tRECTF_Bound, Null, Null)
tLayout_Warp.X = 0
tLayout_Warp.Y = 0
tLayout_Warp.Width = tRECTF_Bound.Width
tLayout_Warp.Height = tRECTF_Bound.Height
Dim aPoints(3) AS GpPointF
aPoints(0).x = iW * 0.4
aPoints(0).y = iH * 0.33
aPoints(1).x = iW - iW * 0.4
aPoints(1).y = iH * 0.33
aPoints(2).x = -60
aPoints(2).y = iH
aPoints(3).x = iW
aPoints(3).y = iH
Sleep(250)
Dim As Ushort iFPS = 0, iStage = 1
Dim As Single fTimer, fAlpha = 0, fWait, fSize = iH * 1.168, y = iH * 1.45
Do
GdipGraphicsClear(hCanvas, &hFF000000)
Select Case iStage
Case 1
If fAlpha < 255 Then
fAlpha += 1
GdipSetSolidFillColor(hBrush, fAlpha Shl 24 + iColorTxt1_RGB)
Else
fAlpha = 255
fWait = Timer
iStage += 1
End If
GdipDrawString(hCanvas, "A long time ago in a galaxy far," & CrLf & "far away....", -1, hFont, @tLayout, hStringFormat, hBrush)
Case 2
If Timer - fWait > 2.0 Then
If fAlpha > 0 Then
fAlpha -= 1
GdipSetSolidFillColor(hBrush, fAlpha Shl 24 + iColorTxt1_RGB)
GdipDrawString(hCanvas, "A long time ago in a galaxy far," & CrLf & "far away....", -1, hFont, @tLayout, hStringFormat, hBrush)
Else
iStage += 1
GdipSetSolidFillColor(hBrush, &hFF000000)
fAlpha = 255
End If
Else
GdipDrawString(hCanvas, "A long time ago in a galaxy far," & CrLf & "far away....", -1, hFont, @tLayout, hStringFormat, hBrush)
End If
Case 3
GdipDrawImageRect(hCanvas, hBitmap, 0, 0, iW, iH)
If fSize > 1 And fAlpha > 0 Then
GdipAddPathString(hPath_Logo, "STAR" & CrLf & "WARS", -1, hFamily_Logo, FontStyleRegular, fSize, @tLayout_Logo, hStringFormat_Logo)
GdipFillPath(hCanvas, hBrush, hPath_Logo)
GdipDrawPath(hCanvas, hPen, hPath_Logo)
GdipResetPath(hPath_Logo)
'GdipSetSolidFillColor(hBrush, fAlpha Shl 24)
GdipSetPenColor(hPen, fAlpha Shl 24 + iColorTxt2_RGB)
fSize -= 1.0
fAlpha -= 0.475
EndIf
GdipResetPath(hPath_Warp)
For i = 0 To Ubound(aWarpText)
GdipResetPath(hPath_Temp)
tLayout_Warp.Y = i * fFontSize + y
GdipAddPathString(hPath_Temp, aWarpText(i), -1, hFamily_Warp, FontStyleRegular, fFontSize, @tLayout_Warp, hStringFormat_Warp)
GdipGetPathWorldBounds(hPath_Temp, @tRECTF_Bound, Null, Null)
If tRECTF_Bound.Y > -iH And tRECTF_Bound.Y <= iH + 30 Then
GdipAddPathString(hPath_Warp, aWarpText(i), -1, hFamily_Warp, FontStyleRegular, fFontSize, @tLayout_Warp, hStringFormat_Warp)
EndIf
Next
GdipWarpPath(hPath_Warp, Null, @aPoints(0), 4, 0, 0, iW, iH, WarpModePerspective, FlatnessDefault)
GdipFillPath(hCanvas, hBrush_Warp, hPath_Warp)
y -= 0.55
If y < -2100 Then Exit Do
End Select
BitBlt(hDC, 0, 0, iW, iH, hDC_backbuffer, 0, 0, SRCCOPY)
If Timer - fTimer > 0.99 Then
WindowTitle sTitle & iFPS
iFPS = 0
fTimer = Timer
Else
iFPS += 1
EndIf
Sleep(1, 1)
Loop Until Len(Inkey())
'release resources
GdipDeletePath(hPath_Logo)
GdipDeletePath(hPath_Warp)
GdipDeletePath(hPath_Temp)
If bFont = 1 Then GdipDeletePrivateFontCollection(hCollection)
GdipDeleteFont(hFont)
GdipDeleteFontFamily(hFamily)
GdipDeleteFontFamily(hFamily_Logo)
GdipDeleteFontFamily(hFamily_Warp)
GdipDeleteStringFormat(hStringFormat)
GdipDeleteStringFormat(hStringFormat_Logo)
GdipDeleteStringFormat(hStringFormat_Warp)
GdipDeleteGraphics(hGfx)
GdipDisposeImage(hBitmap)
SelectObject(hDC_backbuffer, hObjOld)
DeleteDC(hDC_backbuffer)
ReleaseDC(hHWND, hDC)
DeleteObject(hHBitmap)
GdipDeleteGraphics(hCanvas)
GdipDeletePen(hPen)
GdipDeleteBrush(hBrush)
GdipDeleteBrush(hBrush_Warp)
GdiplusShutdown(gdipToken)
* format scroller text to have same width
* I don't know what else ^^
Have fun -> may the force be with you.