GDI+ Star Wars Intro build 2018-07-07 [Windows and x86 only]

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
UEZ
Posts: 210
Joined: May 05, 2017 19:59
Location: Germany

GDI+ Star Wars Intro build 2018-07-07 [Windows and x86 only]

Postby UEZ » Jul 03, 2018 22:01

Nothing more to say:

Image Image Image



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)


To do:
* format scroller text to have same width
* I don't know what else ^^

Have fun -> may the force be with you.
Last edited by UEZ on Jul 08, 2018 11:00, edited 6 times in total.
nimdays
Posts: 209
Joined: May 29, 2014 22:01
Location: ID

Re: GDI+ Star Wars Intro [Windows and x86 only]

Postby nimdays » Jul 03, 2018 22:32

Nice one, This can be used for rolling credits.
counting_pine
Site Admin
Posts: 5996
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: GDI+ Star Wars Intro build 2018-07-04 [Windows and x86 only]

Postby counting_pine » Jul 04, 2018 13:13

Cool :) Still sends a small shiver down the spine..
I decided to try without the download, pasting in the code and commenting out the BASS bits. It mostly worked, but crashed on exit. I don't know if that was due to the missing files.
UEZ
Posts: 210
Joined: May 05, 2017 19:59
Location: Germany

Re: GDI+ Star Wars Intro build 2018-07-04 [Windows and x86 only]

Postby UEZ » Jul 04, 2018 13:21

counting_pine wrote:Cool :) Still sends a small shiver down the spine..
I decided to try without the download, pasting in the code and commenting out the BASS bits. It mostly worked, but crashed on exit. I don't know if that was due to the missing files.


Probably yes, because a font will be loaded, too. I would suggest to download the Zip archive with the font and mp3 sound. ;-)
The source code and the compiled version is also included.
counting_pine
Site Admin
Posts: 5996
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: GDI+ Star Wars Intro build 2018-07-04 [Windows and x86 only]

Postby counting_pine » Jul 04, 2018 13:42

In truth, if I have to do more than paste a file (or possibly two) into FBIde, I don't tend to make the effort.. If I have to start downloading files, and deciding where to put them, etc, I tend to get put off.

Still, it was nice that it at least approximately worked without any downloads.
UEZ
Posts: 210
Joined: May 05, 2017 19:59
Location: Germany

Re: GDI+ Star Wars Intro build 2018-07-04 [Windows and x86 only]

Postby UEZ » Jul 04, 2018 14:03

counting_pine wrote:In truth, if I have to do more than paste a file (or possibly two) into FBIde, I don't tend to make the effort.. If I have to start downloading files, and deciding where to put them, etc, I tend to get put off.

Still, it was nice that it at least approximately worked without any downloads.


I understand but the space here to post a complete code which includes also the additional files e.g. as base64 encoded strings is impossible because of the limited available space (chars).

Anyhow, the zip archive contains a folder with the files. Just unpack and execute the exe or open the code in your editor and compile and run it.

Another option is to paste the code which include the additional file to another website e.g. pastebin.com where you can copy / paste the code to your editor but I don't know how many users are willing do it.
counting_pine
Site Admin
Posts: 5996
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: GDI+ Star Wars Intro build 2018-07-04 [Windows and x86 only]

Postby counting_pine » Jul 04, 2018 14:09

Well, it's not your fault, just a personal preference really. I'm just disorganised.
It'd be nice if the pasted version could gracefully handle the missing files, but it's no big deal for a quick demo.
UEZ
Posts: 210
Joined: May 05, 2017 19:59
Location: Germany

Re: GDI+ Star Wars Intro build 2018-07-04 [Windows and x86 only]

Postby UEZ » Jul 04, 2018 18:15

counting_pine wrote:Well, it's not your fault, just a personal preference really. I'm just disorganised.
It'd be nice if the pasted version could gracefully handle the missing files, but it's no big deal for a quick demo.


Well, I don't know why this doesn't work properly - the files will not be generated when I add the intro code.

Source with intro code: https://www.pastiebin.com/5b3d0d7e94fd7


When I remove the intro code then the files will be created: https://www.pastiebin.com/5b3d0e8851efd

Did I miss something?
nimdays
Posts: 209
Joined: May 29, 2014 22:01
Location: ID

Re: GDI+ Star Wars Intro build 2018-07-04 [Windows and x86 only]

Postby nimdays » Jul 04, 2018 23:08

counting_pine wrote:Cool :) Still sends a small shiver down the spine..
I decided to try without the download, pasting in the code and commenting out the BASS bits. It mostly worked, but crashed on exit. I don't know if that was due to the missing files.

I did that too, but It didn't crash.
UEZ
Posts: 210
Joined: May 05, 2017 19:59
Location: Germany

Re: GDI+ Star Wars Intro build 2018-07-04 [Windows and x86 only]

Postby UEZ » Jul 07, 2018 15:51

UEZ wrote:
counting_pine wrote:Well, it's not your fault, just a personal preference really. I'm just disorganised.
It'd be nice if the pasted version could gracefully handle the missing files, but it's no big deal for a quick demo.


Well, I don't know why this doesn't work properly - the files will not be generated when I add the intro code.

Source with intro code: https://www.pastiebin.com/5b3d0d7e94fd7


When I remove the intro code then the files will be created: https://www.pastiebin.com/5b3d0e8851efd

Did I miss something?


Has nobody an idea why this doesn't work?
dafhi
Posts: 1222
Joined: Jun 04, 2005 9:51

Re: GDI+ Star Wars Intro build 2018-07-05 [Windows and x86 only]

Postby dafhi » Jul 07, 2018 20:20

no crash

Code: Select all

GdipDeletePath(hPath_Temp)
sleep
GdipDeletePrivateFontCollection(hCollection)

crash

Code: Select all

GdipDeletePath(hPath_Temp)
GdipDeletePrivateFontCollection(hCollection)
sleep
UEZ
Posts: 210
Joined: May 05, 2017 19:59
Location: Germany

Re: GDI+ Star Wars Intro build 2018-07-05 [Windows and x86 only]

Postby UEZ » Jul 07, 2018 20:29

dafhi wrote:no crash

Code: Select all

GdipDeletePath(hPath_Temp)
sleep
GdipDeletePrivateFontCollection(hCollection)

crash

Code: Select all

GdipDeletePath(hPath_Temp)
GdipDeletePrivateFontCollection(hCollection)
sleep


Did you download the zip archive and run the code or just the code from post #1 without music and font? If you run the code from post#1 only then I forgot to add a check for the hCollection handle. It will be disposed although hCollection = 0.

Should be fixed now -> check out the code from post#1 again.
dafhi
Posts: 1222
Joined: Jun 04, 2005 9:51

Re: GDI+ Star Wars Intro build 2018-07-05 [Windows and x86 only]

Postby dafhi » Jul 07, 2018 21:04

still crashes

Code: Select all

If bFont = 1 Then GdipDeletePrivateFontCollection(hCollection)
sleep
UEZ
Posts: 210
Joined: May 05, 2017 19:59
Location: Germany

Re: GDI+ Star Wars Intro build 2018-07-05 [Windows and x86 only]

Postby UEZ » Jul 07, 2018 21:09

dafhi wrote:still crashes

Code: Select all

If bFont = 1 Then GdipDeletePrivateFontCollection(hCollection)
sleep


Hmmm, I cannot reproduce the crash...
dafhi
Posts: 1222
Joined: Jun 04, 2005 9:51

Re: GDI+ Star Wars Intro build 2018-07-05 [Windows and x86 only]

Postby dafhi » Jul 07, 2018 21:13

try

Code: Select all

Using FB

chdir exepath

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests