Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Gfx Spielereien
Gehe zu Seite Zurück  1, 2, 3
 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Projektvorstellungen
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 830
Wohnort: Ruhrpott

BeitragVerfasst am: 20.03.2017, 20:58    Titel: Antworten mit Zitat

Kein Problem bei mir (WinXP SP3 / fbc 1.05.0 / 32bit). Programm compiliert und läuft einwandfrei. (Und die Enterprise finde ich echt witzig! lächeln )

Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4189
Wohnort: ~/

BeitragVerfasst am: 20.03.2017, 22:34    Titel: Antworten mit Zitat

Mal sicherheitshalber dazu gesagt, dass man mit
Code:
fbc "Rotating Earth Res v1.7.bas" "Rotating Earth Res v1.7.rc"

compilieren muss. Wenn es Fehler bei der Ausführung der .rc gibt, sollte der Compiliervorgang eigentlich fehlschlagen.
_________________
Meine Großeltern waren als junge Menschen sehr modern - sie hatten schon damals in der Badewanne Email.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Elor



Anmeldungsdatum: 12.07.2013
Beiträge: 205
Wohnort: Konstanz

BeitragVerfasst am: 21.03.2017, 12:00    Titel: Antworten mit Zitat

Oh man, nemored, du hast recht, ich hab die Resourcen vergessen peinlich
Ich hab's einfach so mit Geany Kompiliert, also, falscher alarm.

@UEZ:
Sieht gut aus, hast eigentlich was größeres vor oder ist das mit der Enterprise nur Zufall lächeln
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 72
Wohnort: Opel Stadt

BeitragVerfasst am: 21.03.2017, 17:30    Titel: Antworten mit Zitat

Elor hat Folgendes geschrieben:
Oh man, nemored, du hast recht, ich hab die Resourcen vergessen peinlich
Ich hab's einfach so mit Geany Kompiliert, also, falscher alarm.

@UEZ:
Sieht gut aus, hast eigentlich was größeres vor oder ist das mit der Enterprise nur Zufall lächeln


Was größeres habe ich eigentlich nicht vor, da die FPS ja sehr limitiert sind - da geht nicht viel mehr. Wenn ich noch die Drehung vom Mond hinzufügen würde, dann hatte man eine Slideshow. zwinkern

Das mit der Enterprise war nur als Gag gedacht, da ein User Raumschiffe und / oder Meteoriten sehen wollte, aber wie gesagt, das Ende der Fahnenstange mit GDI+ erreicht ist.
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 72
Wohnort: Opel Stadt

BeitragVerfasst am: 14.09.2017, 23:10    Titel: 3D Starfield Rotating Flight Antworten mit Zitat

Nächstes Beispiel "3D Sternen Flug":

Code:
'coded by UEZ build 2017-11-07, faster Sin / Cos ASM code by eukalyptus
#Include "fbgfx.bi"
#Include "string.bi"

Using FB

Declare Function _Sin6th(fX As Double) As Double
Declare Function _Cos6th(fX As Double) As Double


Dim as ulong iW, iH
ScreenControl GET_DESKTOP_SIZE, iW, iH
Dim as ulong iW2 = iW \ 2, iH2 = iH \ 2, iW3 = iW \ 3, iH3 = iH \ 3
screenres iW, iH, 32, 2, GFX_FULLSCREEN or GFX_HIGH_PRIORITY
ScreenSet 1, 0

Type tStar
   as Double v, x, y, z, colour
End Type

Dim as Ulong i, iPhase, iMaxStars = 25000
Dim as Double fNewX, fNewY, fRot = 0, c = -2^32 + 850, fRad = ACos(-1) / 180
Dim as UShort iLimes = 100, iFPS = 0 , iFPS_current = 0
Dim as UByte iColor, iLen
Dim as tStar Stars(iMaxStars)
Dim As Double fTime, fTimer
Dim As String sDrivername, sNumber
ScreenControl FB.GET_DRIVER_NAME, sDrivername

sNumber = Format(iMaxStars, "###,")
iLen = Len(Str(iMaxStars))
iPhase = 10^(iLen - 2)

Randomize

For i = 1 to iMaxStars
   Stars(i).v = 0.00001 + Rnd / 5000
   Stars(i).x = Rnd * (iW + iW2) - iW2
   Stars(i).y = Rnd * (iH + iH2) - iH2
   Stars(i).z = Rnd * 0.02
   Stars(i).colour = CUbyte(Rnd * 255)
Next

fTimer = Timer

do

   Cls
   For i = 1 to iMaxStars
      Stars(i).colour *=  1.0125 + Stars(i).z
      iColor = Iif(Stars(i).colour > 255, 255, Iif(Stars(i).colour < 8, 8, CUbyte(Stars(i).colour)))
     
      Stars(i).x += Stars(i).x * Stars(i).z
      Stars(i).y += Stars(i).y * Stars(i).z
     
      fNewX = Stars(i).x * _Cos6th(fRot * fRad) - Stars(i).y * _Sin6th(fRot * fRad) + iW2
      fNewY = Stars(i).y * _Cos6th(fRot * fRad) + Stars(i).x * _Sin6th(fRot * fRad) + iH2
     
      Stars(i).z += Stars(i).v
     
      circle (fNewX, fNewY), 0.5 + Stars(i).z * 50, Rgb(iColor, iColor, iColor), , , , F
     
      If (fNewX < -iLimes) or (fNewX > iW + iLimes) or (fNewY < -iLimes) or (fNewY > iH + iLimes) Then
         Stars(i).v = 0.00001 + Rnd / 5000
         Stars(i).x = Rnd * (iW + iW3) - iW2
         Stars(i).y = Rnd * (iH + iH3) - iH2
         Stars(i).z = Rnd * 0.000003333
         Stars(i).colour = CUbyte(8 + Rnd * 8)
      End If
      fRot += _Cos6th(c / iPhase) / (2 * iMaxStars)
      c += 0.000125
   Next

   Draw String(0, 0), sDrivername & ": " & sNumber & " stars @ " & iFPS_current & " fps", RGB(&hA0, &hA0, &hA0)
   Draw String(iW - 100, 0), "Coded by UEZ", RGB(&h50, &h50, &h50)
   Draw String(0, iH - 10), iW & " x " & iH, RGB(&h80, &h80, &h80)
   
   If Timer - fTimer > 0.99 Then
      iFPS_current = iFPS
      iFPS = 0
      fTimer = Timer
   End If
   iFPS += 1
   
   ScreenCopy
   
   'Sleep(10)
loop until Inkey = Chr(27)

Function _Sin6th(fX As Double) As Double
   Asm
      jmp _Sin6th_Start
         _Sin6th_Mul: .double 683565275.57643158
         _Sin6th_Div: .double -0.0000000061763971109087229
         _Sin6th_Rnd: .double 6755399441055744.0
       
      _Sin6th_Start:
         movq xmm0, [fX]
         mulsd xmm0, [_Sin6th_Mul]
         addsd xmm0, [_Sin6th_Rnd]
         movd ebx, xmm0
   
         lea  eax, [ebx*2+0x80000000]
         sar  eax, 2
         imul eax
         sar  ebx, 31
         lea  eax, [edx*2-0x70000000]
         lea  ecx, [edx*8+edx-0x24000000]
         imul edx
         xor  ecx, ebx
         lea  eax, [edx*8+edx+0x44A00000]
         imul ecx
         
         cvtsi2sd xmm0, edx
         mulsd xmm0, [_Sin6th_Div]
         movq [Function], xmm0
   End Asm
End Function

Function _Cos6th(fX As Double) As Double
   Asm
      jmp _Cos6th_Start
         _Cos6th_Mul: .double 683565275.57643158
         _Cos6th_Div: .double -0.0000000061763971109087229
         _Cos6th_Rnd: .double 6755399441055744.0
       
      _Cos6th_Start:
         movq xmm0, [fX]
         mulsd xmm0, [_Cos6th_Mul]
         addsd xmm0, [_Cos6th_Rnd]
         movd ebx, xmm0
         
         add ebx, 0x40000000 'SinToCos
   
         lea  eax, [ebx*2+0x80000000]
         sar  eax, 2
         imul eax
         sar  ebx, 31
         lea  eax, [edx*2-0x70000000]
         lea  ecx, [edx*8+edx-0x24000000]
         imul edx
         xor  ecx, ebx
         lea  eax, [edx*8+edx+0x44A00000]
         imul ecx
         
         cvtsi2sd xmm0, edx
         mulsd xmm0, [_Cos6th_Div]
         movq [Function], xmm0
   End Asm
End Function


Keine Ahnung, ob der Code unter Linux läuft.
_________________
Gruß,
UEZ


Zuletzt bearbeitet von UEZ am 29.12.2017, 15:15, insgesamt 2-mal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Marc Bonus



Anmeldungsdatum: 19.11.2016
Beiträge: 43

BeitragVerfasst am: 15.09.2017, 11:34    Titel: Re: 3D Starfield Rotating Flight Antworten mit Zitat

UEZ hat Folgendes geschrieben:
Keine Ahnung, ob der Code unter Linux läuft.


Läuft anstandslos unter Kubuntu 17.04 mit Geany.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 72
Wohnort: Opel Stadt

BeitragVerfasst am: 15.09.2017, 12:09    Titel: Re: 3D Starfield Rotating Flight Antworten mit Zitat

Marc Bonus hat Folgendes geschrieben:
UEZ hat Folgendes geschrieben:
Keine Ahnung, ob der Code unter Linux läuft.


Läuft anstandslos unter Kubuntu 17.04 mit Geany.


Cool. lächeln

Was wird unter Linux als Driver_Name angezeigt? Was ist deine FPS?
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Marc Bonus



Anmeldungsdatum: 19.11.2016
Beiträge: 43

BeitragVerfasst am: 15.09.2017, 12:30    Titel: Antworten mit Zitat

Links oben in der Ecke steht "X11: 50,000 stars @ 25 fps"

Die fps schwanken von 17 - 26. Habe hier allerdings nur einen 3 GHz Dual Core mit Onboard Grafik.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 72
Wohnort: Opel Stadt

BeitragVerfasst am: 15.09.2017, 12:36    Titel: Antworten mit Zitat

Unter Windows wird anscheinend für x86 DirectX / x64 GDI benutzt.
Ich arbeite zwar nicht direkt mit Linux, aber X11 sagt mir was.

Bei mir sind es ca. 30 FPS bei 1600x900, wobei die FPS steigen würde, wenn man Sleep(10) auskommentiert.
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4189
Wohnort: ~/

BeitragVerfasst am: 15.09.2017, 13:01    Titel: Antworten mit Zitat

Zum verwendeten Treiber steht hier noch was:
https://www.freebasic-portal.de/befehlsreferenz/interne-treiber-463.html
_________________
Meine Großeltern waren als junge Menschen sehr modern - sie hatten schon damals in der Badewanne Email.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 830
Wohnort: Ruhrpott

BeitragVerfasst am: 15.09.2017, 13:47    Titel: Antworten mit Zitat

Auf meinem Pentium IV 3,2GHz mit NVIDIA GeForce4 MX440 bei 1280 x 1024 unter WinXP SP3 (32 Bit) läuft das Programm mit stabilen 17 FPS.

Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 72
Wohnort: Opel Stadt

BeitragVerfasst am: 25.10.2017, 15:43    Titel: Antworten mit Zitat

Und weiter geht's: GDI+ Kaleidoscope v0.9 build 2017-10-25 (nur Windows!)

Gibt es eine bessere Möglichkeit das Mausrad abzufragen? Z.B. über WM_MOUSEWHEEL?

Kann ich die Maus auch außerhalb der GUI abfragen?
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 830
Wohnort: Ruhrpott

BeitragVerfasst am: 25.10.2017, 18:36    Titel: Antworten mit Zitat

Sehr beeindruckend! lächeln

Zitat:
Kann ich die Maus auch außerhalb der GUI abfragen?
Natürlich. Die Abfrage mit GetMouse ist doch außerhalb der GUI. Oder habe ich deine Frage falsch verstanden?

Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 72
Wohnort: Opel Stadt

BeitragVerfasst am: 25.10.2017, 19:28    Titel: Antworten mit Zitat

Wenn die Maus außerhalb der GUI ist, "schläft" die GUI, d.h. die Rotationen setzten aus, weil die Variablen dx und dy den Wert -1 bekommen.

Aus dem Help File:
"...0 on success, or 1 on error (for example because the mouse is outside the graphic window) or on failure."
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Jojo
alter Rang


Anmeldungsdatum: 12.02.2005
Beiträge: 9732
Wohnort: Neben der Festplatte

BeitragVerfasst am: 26.10.2017, 00:47    Titel: Antworten mit Zitat

Die Mausposition auf dem Bildschirm (statt nur im Grafikfenster) kannst du unter Windows mit GetCursorPos abfragen: https://msdn.microsoft.com/de-de/library/windows/desktop/ms648390(v=vs.85).aspx
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 72
Wohnort: Opel Stadt

BeitragVerfasst am: 26.10.2017, 09:56    Titel: Antworten mit Zitat

Danke Jojo.

Habe den Code aktualisiert.
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 72
Wohnort: Opel Stadt

BeitragVerfasst am: 15.01.2018, 23:02    Titel: Antworten mit Zitat

Hier eine Portierung eines meiner AutoIt Skripte Zwecks FB Übung: zwinkern

Simple Flame Simulation [Windows only] build 2018-01-15
Code:
'coded by UEZ build 2018-01-15
'thanks to Eukalyptus for the ASM Blur function and the procedural generated AU3 logo

#Define WIN_INCLUDEALL
#Include "fbgfx.bi"
#Include "windows.bi"
#Include "win/gdiplus.bi"

Using FB
Using GDIPLUS

Declare Sub GenFlameParticle(aFlameCoords() as Single, iPos as ushort, iWidth as UShort = 100)
Declare Function RandomRange(fStart as Single, fEnd as Single) as Single
Declare Sub ImageContrast(pImage as any Pointer, contrast as Byte, brightness as Byte = 0)
Declare function ImageBlur(pImage As Any Ptr, iRadius As Long, iExpandEdge As Long = 0) As Any Ptr
Declare Function _GDIPlus_Startup() As Byte
Declare Sub _GDIPlus_Shutdown()
Declare Function _GDIPlus_BitmapCreateFromMemory(aBinImage() As UByte, bBitmap_GDI As Bool = FALSE) As Any Ptr
Declare Function Convert2FBImage(aMemGDIpBitmap() as UByte) as any Ptr

'Generated by *FB File2Bas Code Generator v0.50 build 2017-03-15 beta*
Dim Shared As UByte __Logojpg(0 To ...) = _
   {&hFF, &hD8, &hFF, &hE0, &h00, &h10, &h4A, &h46, &h49, &h46, &h00, &h01, &h01, &h01, &h00, &h48, &h00, &h48, &h00, &h00, &hFF, &hDB, &h00, &h43, &h00, &hFF, &hB7, &hC8, &hE9, &hC8, &hA7, &hFF, &hE9, &hD9, &hE9, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hDB, &h00, &h43, &h01, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hC2, &h00, &h11, &h08, &h01, &h8B, &h01, &h8C, &h03, &h01, &h22, &h00, &h02, &h11, &h01, &h03, &h11, &h01, &hFF, &hC4, &h00, &h16, &h00, &h01, &h01, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &h02, &hFF, &hC4, &h00, &h14, &h01, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &hFF, &hDA, &h00, &h0C, &h03, &h01, &h00, &h02, &h10, &h03, &h10, &h00, &h00, &h01, &hC8, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &h6D, &h25, &h04, &hA2, &h67, &h63, &h0B, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &hA3, &h2D, &h8C, &hDA, &h00, &h00, &h04, &hA2, &h4D, &h0C, &h37, &h0C, &hAC, &h00, &h6E, &h50, &h00, &h00, &h01, &h28, &hC2, &hC0, &h00, &h00, &h00, &h01, &hA3, &h3A, &hA0, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h32, &hD0, &h01, &h60, &hA8, &h2A, &h0B, &h28, &h80, &h63, &h78, &h00, &h00, &h00, &h0B, &hA0, &h00, &h00, &h10, &hA9, &h0D, &h30, &h34, &hC8, &hD5, &hC0, &hDB, &h03, &h6C, &hD2, &h80, &h00, &h00, &h00, &h52, &h28, &h02, &h01, &h9D, &h64, &h80, &h00, &h05, &h68, &h00, &h01, &h0B, &h24, &h2C, &h00, &h00, &h00, &h00, &h00, &h58, &h36, &hC6, &h8A, &h00, &h00, &h28, &h8A, &h25, &h40, &h06, &h37, &h80, &h00, &h16, &h6C, &h00, &h01, &h92, &hE4, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &hAC, &h8D, &hA5, &h00, &h00, &h00, &h04, &h24, &h00, &h06, &h8A, &h00, &h06, &h44, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h06, &hB2, &h36, &h94, &h00, &h02, &h42, &hE4, &h00, &h01, &hB9, &h40, &h00, &h99, &h00, &h00, &h00, &h00, &h15, &hA0, &h00, &h33, &h37, &h92, &h00, &h00, &h00, &h01, &hBC, &h53, &h40, &h03, &h33, &h78, &h00, &h00, &h53, &h40, &h01, &h9B, &h90, &h00, &h00, &h00, &h01, &hB0, &h00, &h00, &h03, &h0D, &h64, &h00, &h00, &h00, &h03, &h57, &h3A, &h00, &h67, &h43, &h00, &h01, &hAC, &hEC, &h00, &h0C, &hC0, &h00, &h00, &h00, &h14, &hB4, &h00, &h00, &h00, &h19, &hD0, &hC0, &h00, &h00, &h00, &h1B, &hC6, &h8A, &h00, &h33, &h35, &h90, &h0B, &hAC, &hE8, &h01, &h2E, _
    &h48, &h00, &h00, &h00, &h06, &hE5, &h00, &h01, &h19, &h36, &hCE, &h80, &h00, &h99, &hDE, &h48, &h00, &h00, &h00, &h0D, &h80, &h09, &h9D, &hE0, &h03, &h56, &h50, &h06, &h75, &h80, &h00, &h00, &h01, &h66, &hC0, &h00, &h19, &h10, &h1A, &hC8, &hDA, &h50, &h00, &h30, &hDE, &h00, &h00, &h00, &h0D, &h59, &h40, &h18, &hDE, &h48, &h0D, &h59, &h40, &h18, &hDE, &h00, &h00, &h00, &h68, &hA0, &h00, &h41, &h90, &h00, &h06, &hF1, &h4D, &h00, &h04, &hA3, &h0B, &h00, &h00, &h02, &hEB, &h3A, &h00, &h67, &h59, &h20, &h35, &h65, &h00, &h63, &h78, &h00, &h00, &h0B, &hA4, &h2A, &h50, &h06, &h50, &h14, &h8A, &h22, &h88, &hA2, &hDC, &hE8, &h00, &h06, &h37, &h0C, &h80, &h00, &h2E, &hA5, &h00, &h67, &h58, &h00, &hBA, &hCD, &h2A, &h0B, &h8D, &h42, &h00, &h06, &hA5, &h00, &h00, &h64, &h02, &hE9, &h0A, &h82, &hA0, &hA9, &h40, &h00, &h00, &h0C, &hCD, &hE0, &h00, &h0D, &h59, &h40, &h18, &hDE, &h00, &h1A, &hCE, &h80, &h12, &h8C, &h81, &h66, &h8B, &h00, &h01, &h04, &h06, &h80, &h00, &h16, &h0A, &h82, &hA0, &hA8, &h2A, &h0A, &h82, &hC5, &h30, &hB0, &h14, &hD0, &h00, &h99, &hB0, &h01, &h65, &h28, &h00, &hCB, &h59, &h00, &h00, &h00, &h00, &hA8, &h2A, &h0A, &h82, &hA0, &hA8, &h2A, &h0A, &h82, &hA0, &hA8, &h2A, &h0B, &h01, &hAC, &hEC, &h00, &h43, &h20, &h00, &h0D, &h25, &h00, &h67, &h43, &h20, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &h4B, &h40, &h06, &h6E, &h40, &h00, &h01, &hAC, &hD2, &h80, &h09, &h35, &h90, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h1A, &h94, &h58, &h2A, &h09, &h00, &h00, &h00, &h03, &h4C, &hE8, &h00, &h0C, &hB5, &h90, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &h54, &h00, &h06, &h6C, &h00, &h00, &h00, &h00, &h58, &h35, &h73, &h4A, &h80, &h09, &h35, &h08, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h1A, &h00, &h00, &h4B, &h90, &h00, &h00, &h00, &h00, &h00, &h58, &h35, &h73, &h4A, &h00, &h24, &hD0, &hC3, &h50, &h8B, &h00, &h00, &h00, &h01, &h48, &hD0, &h00, &h00, &h11, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &hD3, &h34, &hD2, &h50, &h00, &h12, &h88, &hA3, &h2D, &h0C, &hB5, &h00, &h00, &h00, &h00, &h12, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h05, &h83, &h4C, &hD2, &hD8, &h2A, &h0A, &h82, &hA0, &hA8, &h2A, &h0A, &h82, &hA4, &h2A, &h42, &hC0, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &hA8, &h34, &hC8, &hD3, &h23, &h4C, &h8D, &h48, &h2C, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &hFF, &hC4, &h00, &h1D, &h10, &h00, &h02, &h03, &h00, &h02, &h03, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &h50, &h11, &h20, &h60, &h00, &h30, &h70, &h80, &hA0, &hFF, &hDA, &h00, &h08, &h01, &h01, &h00, &h01, &h05, &h02, &h51, &h14, &h8C, &h54, &h72, &h3A, &h61, &h2C, &h61, &h63, &hDA, &h31, &hA3, &h19, &hD3, &h61, &hE0, &hC1, &h52, &hD8, &h54, &hAD, &h19, &hC0, &hC8, &h32, &h0C, &h83, &h21, &hF0, &hA9, &hFF, &hC4, &h00, &h14, &h11, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h90, &hFF, &hDA, &h00, &h08, _
    &h01, &h03, &h01, &h01, &h3F, &h01, &h1C, &h7F, &hFF, &hC4, &h00, &h14, &h11, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h90, &hFF, &hDA, &h00, &h08, &h01, &h02, &h01, &h01, &h3F, &h01, &h1C, &h7F, &hFF, &hC4, &h00, &h14, &h10, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &hB0, &hFF, &hDA, &h00, &h08, &h01, &h01, &h00, &h06, &h3F, &h02, &h1C, &h4F, &hFF, &hC4, &h00, &h1E, &h10, &h00, &h02, &h02, &h03, &h01, &h01, &h01, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &h11, &h00, &h20, &h30, &h31, &h40, &h10, &h50, &h21, &h60, &hFF, &hDA, &h00, &h08, &h01, &h01, &h00, &h01, &h3F, &h21, &hF8, &hEB, &hC2, &h13, &hF2, &h21, &hF3, &h40, &h60, &h23, &h95, &h7A, &h21, &h64, &h22, &h1E, &h11, &hE2, &h23, &hE1, &h14, &h54, &h19, &h0E, &h65, &h17, &h29, &h81, &hBC, &hA7, &h28, &h1F, &h18, &hEF, &h10, &h0E, &h6B, &h23, &h8E, &h3E, &h93, &hBC, &h20, &h62, &h71, &hE0, &h71, &hC7, &hC8, &h70, &h01, &h81, &hC7, &h9D, &hF1, &h1D, &hDC, &h0C, &h0F, &h8C, &h1E, &h60, &h2E, &h4F, &h30, &h39, &h8D, &h80, &h77, &h27, &hA4, &h1C, &h66, &hE3, &hF2, &hC4, &hF5, &h83, &h84, &h9B, &h85, &h89, &hED, &h16, &h71, &hE5, &h27, &h28, &h14, &h50, &h85, &h90, &h58, &hF5, &h00, &hB9, &h0B, &h20, &hE2, &h39, &h00, &h7C, &hA3, &h80, &h39, &h75, &h84, &h8C, &h83, &h18, &hD5, &h4E, &h40, &h31, &h91, &hC2, &h77, &hCA, &h06, &h53, &hC8, &h0D, &hD4, &hEB, &h88, &h9B, &h9F, &hDC, &h63, &h75, &h3A, &hE4, &h07, &hE6, &h01, &h72, &h3A, &h07, &h78, &h80, &hB9, &hF4, &h5C, &h85, &h88, &h6A, &hA7, &hD1, &hAC, &hC0, &h3B, &h9C, &h7B, &hCE, &h3B, &hF4, &h6B, &h36, &hAC, &h6C, &h2E, &h46, &h61, &hDF, &hA3, &h59, &h40, &hCC, &h2E, &h46, &h51, &hF4, &h6B, &h20, &h17, &h38, &h47, &h18, &hEF, &hD1, &hC4, &h4F, &hA8, &hC4, &h62, &h31, &h18, &h8C, &h46, &h23, &h11, &hB9, &hC8, &h3E, &h8A, &h9D, &hD8, &h7E, &h61, &h03, &h80, &h8B, &h0D, &h54, &hFA, &h2A, &h6A, &h05, &hCF, &h83, &hF7, &h9C, &h60, &h15, &h34, &h02, &hE7, &h94, &hFE, &hE1, &h3C, &h67, &hD1, &hC8, &h7D, &h15, &h35, &h15, &h39, &h1C, &h71, &hC7, &h1C, &h71, &hC7, &h1C, &h71, &hC7, &h1C, &h71, &hC7, &h1C, &h71, &hC7, &h1F, &hA2, &hA6, &hA2, &hA7, &hE1, &h0F, &hA4, &h2A, &h6E, &h2A, &h7E, &h00, &hE3, &h3F, &h10, &hE1, &h16, &h3D, &hA3, &h80, &h7C, &h10, &h2C, &h7E, &h58, &h16, &h39, &h45, &hC8, &hE7, &h02, &hC7, &h38, &h37, &h5C, &h8A, &hE7, &h84, &h1C, &h0B, &h81, &h45, &hD4, &hF0, &hA8, &hB1, &hA8, &hBE, &h42, &h8A, &h28, &hA2, &h8A, &h2C, &h6F, &hA1, &hFD, &h47, &hC8, &hE3, &hEF, &h71, &hE7, &h71, &hFC, &h47, &h1C, &h76, &h71, &hC7, &h1F, &hF0, &hFF, &h00, &hFF, &hDA, &h00, &h0C, &h03, &h01, &h00, &h02, &h00, &h03, &h00, &h00, &h00, &h10, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &h0C, &hB1, &hC7, &h08, &h00, &h00, &h00, &h00, &h00, &h00, &h21, &h4B, &h0C, &hF3, &hC7, &h0C, &h30, &h00, &h2C, &hF3, &hCF, &h3C, &hB0, &h00, &h00, &h00, &h00, &h00, &hE2, &h00, &h00, &hC3, &h0C, &h30, &hC3, _
    &hCB, &h2C, &hF2, &hC3, &h0C, &h43, &hC3, &h00, &h00, &h00, &h10, &h00, &h00, &h04, &h00, &h8C, &h20, &h10, &hC0, &h10, &hC3, &h0C, &h38, &hC0, &h0F, &h2C, &h00, &h00, &h1C, &h00, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h30, &h00, &h00, &h14, &hC3, &h09, &h38, &hC0, &h00, &h1C, &hF3, &hC3, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h0D, &h08, &h00, &h00, &h00, &h12, &h00, &h00, &h73, &hCF, &h20, &h00, &h00, &h00, &h00, &h42, &h00, &h00, &h00, &h00, &h00, &h80, &h00, &h21, &h00, &h00, &hD3, &hCE, &h28, &h00, &h00, &h00, &h00, &hC7, &h28, &h20, &h00, &h00, &h00, &h09, &h00, &h02, &h40, &h00, &h10, &h8C, &h28, &h00, &h00, &h00, &h01, &h08, &h00, &h00, &h0A, &h00, &h00, &h00, &h00, &h90, &h84, &h00, &h01, &h00, &h00, &h80, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h10, &h20, &h00, &h00, &h00, &h0F, &h3C, &h00, &h02, &h00, &h10, &h00, &h00, &h00, &h0A, &h00, &h00, &hC0, &h00, &h02, &h40, &h00, &h00, &h04, &h34, &hF2, &h00, &h00, &h00, &h40, &h00, &h00, &h06, &h00, &h00, &h40, &h00, &h20, &h00, &h20, &h00, &h00, &h00, &hD3, &hCE, &h00, &hA0, &h00, &h00, &h00, &h00, &h00, &h00, &h42, &h00, &h02, &h40, &h00, &h00, &h00, &h00, &h02, &hC3, &h28, &h00, &h00, &h00, &h00, &h01, &h04, &h20, &h02, &h00, &h00, &h00, &h08, &h00, &h04, &h00, &h00, &h08, &h00, &h10, &h09, &h0C, &h60, &h00, &h1C, &hF3, &hCB, &h04, &h90, &hC3, &h08, &h00, &h00, &h00, &h90, &h00, &h08, &h01, &h00, &h34, &hF3, &hC0, &h04, &h73, &hCF, &h00, &h53, &hCF, &h2C, &h30, &hC3, &h0C, &h31, &h82, &h10, &h00, &h0A, &h00, &h43, &hCF, &h20, &hC3, &h0C, &h20, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h60, &h01, &h20, &h00, &h0F, &h3C, &hE0, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h1C, &h00, &h00, &h10, &hF3, &hC3, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &hCB, &h08, &h80, &h00, &h00, &h01, &hCF, &h3C, &hB0, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &hCF, &h3C, &hC0, &h00, &h00, &h00, &h00, &h24, &h33, &hC3, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h10, &hCF, &h3C, &hC0, &h00, &h00, &h00, &h00, &h00, &h02, &h40, &h00, &hC0, &hC0, &h00, &h00, &h00, &h08, &h51, &hCF, &h3C, &hE2, &h00, &h00, &h00, &h00, &h00, &h00, &h04, &h14, &h20, &h00, &h10, &h83, &h0D, &h1C, &hF3, &hCF, &h38, &hA0, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h03, &h0E, &h24, &h30, &hC3, &h0C, &h30, &hC3, &h20, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h41, &h00, &h14, &h21, &h04, &h20, &h00, &h00, &h00, &h00, &h00, &h00, &h03, &hFF, &hC4, &h00, &h14, &h11, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h90, &hFF, &hDA, &h00, &h08, &h01, &h03, &h01, &h01, &h3F, &h10, &h1C, &h7F, &hFF, &hC4, &h00, &h14, &h11, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h90, &hFF, &hDA, &h00, &h08, &h01, &h02, &h01, &h01, &h3F, &h10, &h1C, &h7F, &hFF, &hC4, &h00, &h28, &h10, &h01, &h00, &h02, &h01, &h03, &h04, &h01, _
    &h05, &h01, &h01, &h01, &h01, &h00, &h00, &h00, &h00, &h01, &h00, &h11, &h20, &h30, &h31, &h41, &h21, &h40, &h51, &h61, &h10, &h50, &h71, &h81, &h91, &hA1, &hB1, &hF0, &hC1, &hD1, &hFF, &hDA, &h00, &h08, &h01, &h01, &h00, &h01, &h3F, &h10, &hFA, &h38, &hDF, &h50, &h1C, &hCF, &h44, &hAF, &h08, &hB4, &h7C, &h18, &h89, &hBF, &hD2, &h81, &h5E, &h90, &h0F, &h6E, &h7B, &hEF, &h29, &hDB, &hB5, &h13, &hC4, &h17, &h32, &h9E, &h67, &hA2, &h51, &hE2, &h7E, &h3E, &h7A, &h78, &h9E, &h8F, &h89, &hF0, &h62, &h51, &h13, &h7C, &h82, &hDA, &h80, &h05, &h1A, &h5C, &hC7, &h62, &h0B, &hB1, &h0F, &h26, &h00, &h6C, &h4B, &hD5, &hDF, &h78, &h97, &hD4, &h59, &hEF, &h03, &h47, &hB7, &h50, &hD3, &hAC, &h27, &h68, &h13, &h7E, &hBD, &hA2, &h0E, &hE4, &hF0, &h75, &h82, &hFE, &hCD, &h51, &h66, &hA6, &hF3, &hCB, &hFA, &h9F, &h6E, &hF2, &hE5, &hCB, &h97, &h90, &hA5, &hA4, &h90, &h06, &hCF, &hDE, &h9D, &hCA, &h79, &h94, &hF3, &h29, &hE6, &h59, &hE7, &hB0, &hA9, &h52, &hB5, &hEB, &h7A, &hBB, &h4D, &hBA, &h1A, &h0A, &h11, &h3C, &h45, &hCB, &h7C, &hE5, &h70, &h47, &h30, &hF3, &h20, &h1E, &hD1, &hF5, &hD0, &hE7, &h74, &h10, &h45, &h3E, &hB5, &h85, &h36, &h61, &hE7, &h06, &hF3, &hA9, &h52, &hA5, &h4A, &hCB, &hAB, &h37, &h33, &h9A, &h84, &h53, &hD9, &h0D, &h6D, &h3C, &hB9, &h1A, &h2B, &h46, &h77, &h75, &h76, &hCE, &h9D, &hA6, &hFD, &hAA, &h10, &h47, &h6D, &h57, &hC6, &h56, &h26, &hC5, &h19, &h70, &h1D, &hC0, &hD4, &hB3, &h4D, &h51, &h98, &hA6, &h57, &h74, &h36, &hEE, &hB6, &h96, &h7D, &hF4, &h68, &h8B, &h79, &h72, &h7E, &hB2, &hE2, &h35, &hA9, &h78, &h7F, &h51, &h13, &h71, &hD5, &h1A, &h62, &hB3, &h24, &h11, &hF1, &hCC, &h2D, &hA9, &hB1, &h58, &hD4, &h57, &h3A, &hAA, &hF5, &hD8, &h80, &h1B, &h12, &hE5, &hC4, &h3C, &h7E, &hA2, &h7D, &h9E, &h75, &h15, &h30, &hEB, &h89, &hE7, &h40, &h74, &hBC, &h56, &h8B, &h8B, &h6D, &hEA, &h5D, &hD5, &hDB, &hFD, &hCB, &hEF, &h2E, &h7A, &hD4, &h7C, &h63, &h56, &h54, &h4A, &h72, &h3A, &hB3, &h62, &hB1, &h76, &hD6, &hA5, &h8F, &hF7, &h41, &h2C, &hA6, &h25, &h34, &hEA, &h2B, &h31, &h1C, &hE4, &h3A, &hDF, &h8C, &h55, &h1A, &h87, &h58, &h14, &hAF, &hDE, &h8D, &hC5, &h9B, &h9A, &h8E, &h9A, &hF3, &h8A, &h59, &h91, &hAC, &h4F, &hAD, &h6A, &h54, &h5B, &hF8, &hD3, &hA9, &hB3, &h67, &h50, &h6C, &h1C, &h4D, &h60, &h37, &h9C, &h62, &hB6, &hE9, &hDC, &hDB, &hB1, &hA9, &hB9, &h4C, &h14, &hD6, &h9A, &hE3, &h11, &hCE, &h06, &hF1, &h3D, &h30, &h5B, &h52, &hA8, &hA3, &h2A, &h20, &hDE, &h42, &h9E, &hCD, &hB4, &hD5, &h0C, &h45, &hE0, &hDD, &h8A, &hEA, &h1A, &h62, &h9E, &hDC, &h96, &h88, &hB6, &hC7, &h4D, &h67, &hCC, &h7E, &h74, &hCE, &hA6, &h0E, &hD8, &h6C, &h75, &hEE, &h67, &hF1, &h9A, &hB7, &hE5, &hDE, &h76, &h3F, &hCD, &h7B, &h73, &hA1, &h3B, &hBA, &h36, &h3F, &hDC, &hDF, &h18, &h0D, &h30, &h6C, &hC9, &h29, &h5F, &hAD, &h2D, &h8F, &h6B, &h47, &h56, &h05, &h2B, &hF7, &h92, &hA3, &h25, &h4E, &h77, &h16, &h7E, &h74, &h79, &h68, &h5B, &h18, &h3B, &h68, &hD4, &h5B, &hBB, &h92, &hD4, &h5B, &h73, &h7C, &h67, &h53, &hE9, &hD0, &hE5, &h8E, &hFD, &h7A, &hE6, &hDD, &h8C, &hD5, &hF4, _
    &hD1, &h56, &h64, &h96, &h53, &h12, &h9A, &h73, &hE5, &hA1, &h6D, &hC5, &hDF, &h20, &hB6, &hA6, &hC5, &h1A, &h27, &hAB, &hFC, &h9E, &hAF, &hE9, &h3D, &h5F, &hD2, &h7A, &hBF, &hA4, &hF5, &h7F, &h49, &hEA, &hFE, &h93, &hD5, &hFD, &h20, &h0E, &hDF, &hD3, &h33, &h65, &hF2, &h67, &hB1, &hC7, &h77, &hCF, &h3C, &h77, &h32, &h14, &hF6, &hEF, &h92, &hD1, &h1E, &hBF, &h1C, &hCF, &hE3, &hFE, &hFF, &h00, &hBA, &hF6, &h15, &h36, &h6C, &hFF, &h00, &hBA, &h76, &hEF, &h9D, &hF8, &hEF, &hC7, &h99, &hFC, &h7F, &hF7, &h35, &h6F, &hC0, &hB7, &hAE, &h7B, &h1D, &hCA, &h62, &h53, &h58, &hF4, &h06, &h0E, &hD1, &hDF, &hE7, &hA1, &hC7, &h6E, &h16, &h3E, &hB9, &hCD, &h71, &hF0, &h16, &hF4, &h81, &h45, &h7E, &hFB, &h21, &h4F, &h66, &h07, &h57, &h15, &hD3, &h13, &hA9, &h82, &h59, &hF2, &h16, &hC0, &hA2, &h8F, &hCE, &h4B, &hE4, &h51, &h6E, &hFF, &h00, &hF9, &hDA, &h1E, &h4F, &hCF, &hC9, &hEB, &h78, &hBC, &h5F, &h4C, &h45, &h3F, &h03, &h52, &hD9, &h6C, &hB9, &h72, &hE5, &hFC, &h9D, &h1F, &h32, &hD2, &hD2, &hD2, &hD2, &hD2, &hD2, &hDD, &h88, &h00, &h02, &h8C, &h57, &h5C, &h55, &h38, &h8B, &h3E, &hDF, &h42, &h16, &hE2, &hBD, &h33, &h1B, &h31, &h4A, &h7E, &h82, &h68, &hC5, &hE6, &hF8, &hC4, &h59, &hF4, &h01, &h6E, &h2B, &h16, &hDC, &hCE, &h8C, &h1B, &h31, &h1C, &hF7, &hDB, &hC0, &hA3, &h15, &hA2, &hB8, &hC8, &h53, &hDE, &h8A, &hEB, &hCE, &h2B, &h51, &hEB, &hA4, &hAC, &hC5, &h2C, &h89, &h4F, &h77, &hC8, &hE2, &hC5, &h7A, &h63, &h4C, &h1C, &h52, &hE2, &h57, &h73, &hC8, &hE4, &hB5, &h55, &h64, &h97, &h28, &hDB, &h6E, &hDB, &h79, &h46, &hFB, &hE4, &hBB, &h61, &hB6, &hD1, &h2B, &h7E, &hCC, &h4C, &h00, &hC9, &h47, &hAF, &h6E, &h25, &hEF, &h1F, &h19, &h55, &hAE, &h26, &h00, &hF7, &h9A, &hC5, &hBE, &hC8, &h81, &hCF, &h78, &h9E, &h22, &hA5, &h68, &h82, &hF1, &h0F, &h38, &h03, &h41, &h63, &hD7, &hB4, &h1A, &h83, &hA5, &h4F, &h12, &hB3, &hEF, &h9F, &h7C, &hFB, &hE5, &h65, &h3C, &h4A, &h3C, &h68, &hAC, &h7B, &h70, &hD4, &h22, &hFB, &h75, &h8B, &hDD, &h0D, &h42, &h2F, &hB2, &hB8, &hC3, &hDF, &h06, &h10, &h45, &hEA, &hDC, &h61, &hFA, &h1A, &hDC, &h05, &hCB, &h97, &h2E, &h5E, &h21, &h7F, &h4A, &hB9, &h6C, &hB7, &hBA, &hFF, &hD9}


Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput

Const As UShort iW = 700, iH = 700, iW2 = iW \ 2
Const as Ulong iFlameParticles = 200

Screenres(iW, iH, 32, 1, GFX_ALPHA_PRIMITIVES or GFX_HIGH_PRIORITY)
Dim memImage As Any Ptr = ScreenPtr()
WindowTitle("Simple Flame Simulation v2.0")

'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, (tWorkingArea.Right - iW) \ 2, (tWorkingArea.Bottom - iH) \ 2

Dim Shared As Integer w, h, bpp, scanline
ScreenInfo w, h, , bpp, scanline
Color 0, &hFFFFFF
Dim As Any Ptr pImageBlurred, pImage = ImageCreate(iW, iH), pImageBack = ImageCreate(iW, iH, &hFF000000), _
               pImageLogo = Convert2FBImage(__Logojpg())

Dim As Integer wl, hl
Imageinfo(pImageLogo, wl, hl)
   
Put pImageBack, ((iW - wl) / 2, 100), pImageLogo, Alpha

Dim AS Single aFlameCoords(0 to iFlameParticles, 8)

Randomize , 2
Dim as ulong i, iFPS = 0, iFPS_current = 0
For i = 0 to Ubound(aFlameCoords) - 1
   GenFlameParticle(aFlameCoords(), i)
Next

Dim evt As EVENT
Dim As Double fTimer = Timer

Do
   screenlock
   Put pImage, (0, 0), pImageBack, PSet
   
   For i = 0 To iFlameParticles - 1
      If aFlameCoords(i, 1) > -aFlameCoords(i, 4) Then
         Circle pImage, (aFlameCoords(i, 0), aFlameCoords(i, 1)), aFlameCoords(i, 4), aFlameCoords(i, 6), , , 2.5, F
      EndIf
      aFlameCoords(i, 0) -= aFlameCoords(i, 2)
      aFlameCoords(i, 1) -= aFlameCoords(i, 3)
      aFlameCoords(i, 4) -= aFlameCoords(i, 7)
      If aFlameCoords(i, 4) < aFlameCoords(i, 7) Then GenFlameParticle(aFlameCoords(), i)
   Next
   
   pImageBlurred = ImageBlur(pImage, 28)
   ImageContrast(pImageBlurred, 120, 0)
   
   Put (0, 0), pImageBlurred, Pset
   Draw String(0, 0), iFPS_current & " fps", RGB(&hA0, &hA0, &hA0)
   
   screenunlock
   ImageDestroy(pImageBlurred)

   If Timer - fTimer > 0.99 Then
      iFPS_current = iFPS
      iFPS = 0
      fTimer = Timer
   Else
      iFPS += 1
   EndIf
   
   Sleep(1, 1)
Loop Until ((InKey = Chr(27)) Or (evt.Type = EVENT_WINDOW_CLOSE))

ImageDestroy(pImageBack)
ImageDestroy(pImage)
ImageDestroy(pImageLogo)

Sub GenFlameParticle(aFlameCoords() as Single, iPos as ushort, iWidth as UShort = 100)
   aFlameCoords(iPos, 4) = RandomRange(3, iWidth) 'size
   aFlameCoords(iPos, 0) = RandomRange(iW2 - iWidth, iW2 + iWidth)
   aFlameCoords(iPos, 1) = iH
   aFlameCoords(iPos, 2) = RandomRange(-8, 8) 'vx
   aFlameCoords(iPos, 3) = RandomRange(10, 25) 'vy (power of flame)
   aFlameCoords(iPos, 5) = CUbyte(RandomRange(&h60, &hFF))
   Dim as Ubyte iYellow = CUbyte(aFlameCoords(iPos, 5) - &hFF * Abs(aFlameCoords(iPos, 0) - iW2) / (2 * iW2))
   aFlameCoords(iPos, 6) = &hE8FF0000 + iYellow Shl 8 + Cubyte(iYellow * 0.6666)
   aFlameCoords(iPos, 7) = RandomRange(2.5, 5) 'min size of flame particle
End Sub

Function RandomRange(fStart as Single, fEnd as Single) as Single
   Return Rnd() * (fEnd - fStart) + fStart
End Function

Sub ImageContrast(pImage as any Pointer, contrast as Byte, brightness as Byte = 0)
   #Define Blue(colour) ((colors Shr 16) And 255)
   #Define Green(colour) ((colors Shr 8) And 255)
   #Define Red(colour) (colors And 255)
   #Define Truncate(colour) (Iif(colour < 0, 0, Iif(colour > 255, 255, CUbyte(colour))))
   Dim as Ulong colors
   Dim As Integer w, h, pitch
   Dim As Any Pointer pixdata
   Imageinfo(pImage, w, h, , pitch, pixdata)
   
   Dim as Single factor, contrastLevel = ((100.0 + contrast) / 100.0) * ((100.0 + contrast) / 100.0)
   
   For y as UShort = 0 to iH - 1
      For x as Ushort = 0 to iW - 1
         colors = *CPtr(ulong ptr, pixdata + y * pitch + x Shl 2)
         *CPtr(ulong ptr, pixdata + y * pitch + x Shl 2) = RGB(Truncate(((((Blue(colour) / 255.0) - 0.5) * contrastLevel) + 0.5) * 255.0 + brightness), _
                                                               Truncate(((((Green(colour) / 255.0) - 0.5) * contrastLevel) + 0.5) * 255.0 + brightness), _
                                                               Truncate(((((Red(colour) / 255.0) - 0.5) * contrastLevel) + 0.5) * 255.0) + brightness)
      Next
   Next
End Sub

Function ImageBlur(pImage As Any Ptr, iRadius As Long, iExpandEdge As Long = 0) As Any Ptr
   'By Eukalyptus
   Dim As Integer iWidth, iHeight, iPX, iPitch, iPitchBlur
   Dim As Any Ptr pData, pDataBlur, pDataTmp
   
   If ImageInfo(pImage, iWidth, iHeight, iPX, iPitch, pData) <> 0 Then Return 0
   If iPX <> 4 Then Return 0
   
   If iRadius < 0 Then
      iRadius = 0
   ElseIf iRadius > 127 Then
      iRadius = 127
   EndIf
   
   Dim As Any Ptr pImgBlur, pImgTmp
   If iExpandEdge <> 0 Then
      iWidth += iRadius * 2
      iHeight += iRadius * 2
   EndIf
   
   pImgBlur = ImageCreate(iWidth, iHeight, 0, 32)
   pImgTmp = ImageCreate(iWidth, iHeight, 0, 32)
   
   ImageInfo(pImgBlur, , , , iPitchBlur, pDataBlur)
   ImageInfo(pImgTmp, , , , , pDataTmp)
   If pImgBlur = 0 Or pImgTmp = 0 Then
      ImageDestroy(pImgBlur)
      ImageDestroy(pImgTmp)
      Return 0
   EndIf
   
   If iExpandEdge <> 0 Then
      Put pImgBlur, (iRadius, iRadius), pImage, Alpha
   Else
      Put pImgBlur, (0, 0), pImage, Alpha
   EndIf
   

   Asm
      mov ecx, [iWidth]
      mov ebx, [iHeight]
      mov edx, [iPitchBlur]

      mov edi, [pDataTmp]
      mov esi, [pDataBlur]
       
      mov eax, [iRadius]
      inc eax
      push ebp
      mov ebp, eax
       
      sub esp, 64

      mov [esp+8], ecx
      mov [esp+12], ebx
      mov [esp+16], edx
      mov [esp+20], ebp
      mov [esp+24], edi
      mov [esp+32], edi
      mov [esp+28], esi
      mov [esp+36], esi

      '       0   4   8   12  16       20  24     28     32      36
      'esp = [X] [Y] [W] [H] [Stride] [R] [pDst] [pSrc] [pDstO] [pSrcO]

      mov eax, 0x47000000 'ByteToFloat MSK
      movd xmm7, eax
      pshufd xmm7, xmm7, 0

      ' ####################################################
      ' # W-Loop
      ' ####################################################

      mov ebx, [esp+12]
      mov [esp+4], ebx
      _Blur_LoopW:
         mov edi, [esp+24]
         mov esi, [esp+28]
         mov edx, [esp+16] 'Stride
         add dword ptr[esp+24], 4 'next RowCol(Transform vertical<->horizontal)
         add [esp+28], edx 'next Row

         mov edx, [esp+12] 'Y-Stride
         shl edx, 2

         pxor xmm6, xmm6 'Reset In-Out
         pxor xmm5, xmm5 'Reset Sum
         /'
         xmm7 = Msk
         xmm6 = [AO][RO][GO][BO][AI][RI][GI][BI]
         xmm5 = [AS][RS][GS][BS]

         eax = (SumDiv)
         ebx = (DivInc)
         ecx = X
         edx = Stride
         esi = Src
         edi = Dst
         ebp = R
         '/

         pxor xmm4, xmm4 'UnPack

         mov eax, 0 'Reset SumDiv
         mov ebx, 0 'Reset DivInc

         ' ----------------------------------------------------
         ' | X-In += Next
         ' ----------------------------------------------------
         mov ebp, 0 'Offset
         mov ecx, [esp+20] 'iR
         _Blur_LoopX_In:
            movd xmm0, [esi+ebp]
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next
            paddw xmm6, xmm0 'IN+=Next
            movdqa xmm0, xmm6
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
            paddd xmm5, xmm0 'Stack += IN

            add ebx, 1 'SumDivInc += 1
            add eax, ebx 'SumDiv += Inc

            add ebp, 4
            sub ecx, 1
            jg _Blur_LoopX_In


         ' ----------------------------------------------------
         ' | XIn += Next / XIn -= Mid / XOut += Mid
         ' ----------------------------------------------------
         mov ecx, [esp+20] 'iR
         _Blur_LoopX_InOut:
            cvtsi2ss xmm3, eax
            rcpss xmm3, xmm3
            pshufd xmm3, xmm3, 0 'SumDiv

            movdqa xmm0, xmm5
            paddd xmm0, xmm7 ' UByte -> Float
            subps xmm0, xmm7 '/
            mulps xmm0, xmm3
            addps xmm0, xmm7 ' Float -> UByte
            psubd xmm0, xmm7 '/
            packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B]
            packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB]
            movd [edi], xmm0

            movd xmm0, [esi+ebp]
            movd xmm1, [esi]
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next
            punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid
            movlhps xmm0, xmm1 '[Am][Rm][Gm][Bm][An][Rn][Gn][Bn] = [Mid][Next]
            paddw xmm6, xmm0 'OUT+=Mid / IN+=Next
            psubw xmm6, xmm1 '(OUT-=Last) / IN-=Mid
            movdqa xmm1, xmm6
            movdqa xmm0, xmm6
            punpckhwd xmm1, xmm4 '[AO][RO][GO][BO]
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
            psubd xmm5, xmm1 'Stack -= OUT
            paddd xmm5, xmm0 'Stack += IN

            sub ebx, 1 'SumDivInc += 1
            add eax, ebx 'SumDiv += Inc

            add esi, 4
            add edi, edx
            sub ecx, 1
            jg _Blur_LoopX_InOut


         cvtsi2ss xmm3, eax
         rcpss xmm3, xmm3
         pshufd xmm3, xmm3, 0 'SumDiv

         mov ebx, ebp
         neg ebx 'Last Index


         ' ----------------------------------------------------
         ' | XIn += Next / XIn -= Mid / XOut += Mid / XOut -= Last
         ' ----------------------------------------------------
         mov ecx, [esp+8] 'iWidth
         sub ecx, [esp+20]
         sub ecx, [esp+20]
         _Blur_LoopX:
            movdqa xmm0, xmm5
            paddd xmm0, xmm7 ' UByte -> Float
            subps xmm0, xmm7 '/
            mulps xmm0, xmm3
            addps xmm0, xmm7 ' Float -> UByte
            psubd xmm0, xmm7 '/
            packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B]
            packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB]
            movd [edi], xmm0

            movd xmm0, [esi+ebp]
            movd xmm1, [esi]
            movd xmm2, [esi+ebx]
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next
            punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid
            punpcklbw xmm2, xmm4 '[ ][ ][ ][ ][Al][Rl][Gl][Bl] Last
            movlhps xmm0, xmm1 '[Am][Rm][Gm][Bm][An][Rn][Gn][Bn] = [Mid][Next]
            movlhps xmm1, xmm2 '[Al][Rl][Gl][Bl][Ao][Ro][Go][Bo] = [Last][Mid]
            paddw xmm6, xmm0 'OUT+=Mid / IN+=Next
            psubw xmm6, xmm1 'OUT-=Last / IN-=Mid
            movdqa xmm1, xmm6
            movdqa xmm0, xmm6
            punpckhwd xmm1, xmm4 '[AO][RO][GO][BO]
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
            psubd xmm5, xmm1 'Stack -= OUT
            paddd xmm5, xmm0 'Stack += IN

            add esi, 4
            add edi, edx
            sub ecx, 1
            jg _Blur_LoopX


         ' ----------------------------------------------------
         ' | XIn -= Mid / XOut += Mid / XOut -= Last
         ' ----------------------------------------------------
         mov ebp, 0 'DivInc
         mov ecx, [esp+20] 'iR
         _Blur_LoopX_Out:
            cvtsi2ss xmm3, eax
            rcpss xmm3, xmm3
            pshufd xmm3, xmm3, 0 'SumDiv

            movdqa xmm0, xmm5
            paddd xmm0, xmm7 ' UByte -> Float
            subps xmm0, xmm7 '/
            mulps xmm0, xmm3
            addps xmm0, xmm7 ' Float -> UByte
            psubd xmm0, xmm7 '/
            packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B]
            packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB]
            movd [edi], xmm0

            movd xmm0, [esi]
            movd xmm1, [esi+ebx]
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid
            punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Al][Rl][Gl][Bl] Last
            movlhps xmm0, xmm1 '[Al][Rl][Gl][Bl][Am][Rm][Gm][Bm] = [Last][Mid]
            psubw xmm6, xmm0 'OUT-=Last / IN-=Mid
            pslldq xmm0, 8
            paddw xmm6, xmm0 'OUT+=Mid / (IN+=Next)
            movdqa xmm1, xmm6
            movdqa xmm0, xmm6
            punpckhwd xmm1, xmm4 '[AO][RO][GO][BO]
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
            psubd xmm5, xmm1 'Stack -= OUT
            paddd xmm5, xmm0 'Stack += IN

            add ebp, 1
            sub eax, ebp

            add esi, 4
            add edi, edx
            sub ecx, 1
            jg _Blur_LoopX_Out

         sub dword ptr[esp+4], 1
         jg _Blur_LoopW



      ' ####################################################
      ' # H-Loop
      ' ####################################################


      mov edi, [esp+36]
      mov esi, [esp+32]
      mov [esp+24], edi
      mov [esp+28], esi

      mov ebx, [esp+8]
      mov [esp], ebx
      _Blur_LoopH:
         mov edi, [esp+24]
         mov esi, [esp+28]
         mov edx, [esp+12]
         Shl edx, 2
         Add dword ptr[esp+24], 4 'next Col
         Add [esp+28], edx 'next ColRow

         mov edx, [esp+16] 'Stride

         pxor xmm6, xmm6 'Reset In-Out
         pxor xmm5, xmm5 'Reset Sum

         /'
         xmm7 = Msk
         xmm6 = [AO][RO][GO][BO][AI][RI][GI][BI]
         xmm5 = [AS][RS][GS][BS]

         eax = (SumDiv)
         ebx = (DivInc)
         ecx = X
         edx = Stride
         esi = Src
         edi = Dst
         ebp = R
         '/

         pxor xmm4, xmm4 'UnPack

         mov eax, 0 'Reset SumDiv
         mov ebx, 0 'Reset DivInc

         ' ----------------------------------------------------
         ' | X-In += Next
         ' ----------------------------------------------------
         mov ebp, 0 'Offset
         mov ecx, [esp+20] 'iR
         _Blur_LoopY_In:
            movd xmm0, [esi+ebp]
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next
            paddw xmm6, xmm0 'IN+=Next
            movdqa xmm0, xmm6
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
            paddd xmm5, xmm0 'Stack += IN

            Add ebx, 1 'SumDivInc += 1
            Add eax, ebx 'SumDiv += Inc

            Add ebp, 4
            Sub ecx, 1
            jg _Blur_LoopY_In


         ' ----------------------------------------------------
         ' | XIn += Next / XIn -= Mid / XOut += Mid
         ' ----------------------------------------------------
         mov ecx, [esp+20] 'iR
         _Blur_LoopY_InOut:
            cvtsi2ss xmm3, eax
            rcpss xmm3, xmm3
            pshufd xmm3, xmm3, 0 'SumDiv

            movdqa xmm0, xmm5
            paddd xmm0, xmm7 ' UByte -> Float
            subps xmm0, xmm7 '/
            mulps xmm0, xmm3
            addps xmm0, xmm7 ' Float -> UByte
            psubd xmm0, xmm7 '/
            packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B]
            packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB]
            movd [edi], xmm0

            movd xmm0, [esi+ebp]
            movd xmm1, [esi]
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next
            punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid
            movlhps xmm0, xmm1 '[Am][Rm][Gm][Bm][An][Rn][Gn][Bn] = [Mid][Next]
            paddw xmm6, xmm0 'OUT+=Mid / IN+=Next
            psubw xmm6, xmm1 '(OUT-=Last) / IN-=Mid
            movdqa xmm1, xmm6
            movdqa xmm0, xmm6
            punpckhwd xmm1, xmm4 '[AO][RO][GO][BO]
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
            psubd xmm5, xmm1 'Stack -= OUT
            paddd xmm5, xmm0 'Stack += IN

            Sub ebx, 1 'SumDivInc += 1
            Add eax, ebx 'SumDiv += Inc

            Add esi, 4
            Add edi, edx
            Sub ecx, 1
            jg _Blur_LoopY_InOut


         cvtsi2ss xmm3, eax
         rcpss xmm3, xmm3
         pshufd xmm3, xmm3, 0 'SumDiv

         mov ebx, ebp
         neg ebx 'Last Index


         ' ----------------------------------------------------
         ' | XIn += Next / XIn -= Mid / XOut += Mid / XOut -= Last
         ' ----------------------------------------------------
         mov ecx, [esp+12] 'iHeight
         Sub ecx, [esp+20]
         Sub ecx, [esp+20]
         _Blur_LoopY:
            movdqa xmm0, xmm5
            paddd xmm0, xmm7 ' UByte -> Float
            subps xmm0, xmm7 '/
            mulps xmm0, xmm3
            addps xmm0, xmm7 ' Float -> UByte
            psubd xmm0, xmm7 '/
            packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B]
            packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB]
            movd [edi], xmm0

            movd xmm0, [esi+ebp]
            movd xmm1, [esi]
            movd xmm2, [esi+ebx]
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next
            punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid
            punpcklbw xmm2, xmm4 '[ ][ ][ ][ ][Al][Rl][Gl][Bl] Last
            movlhps xmm0, xmm1 '[Am][Rm][Gm][Bm][An][Rn][Gn][Bn] = [Mid][Next]
            movlhps xmm1, xmm2 '[Al][Rl][Gl][Bl][Ao][Ro][Go][Bo] = [Last][Mid]
            paddw xmm6, xmm0 'OUT+=Mid / IN+=Next
            psubw xmm6, xmm1 'OUT-=Last / IN-=Mid
            movdqa xmm1, xmm6
            movdqa xmm0, xmm6
            punpckhwd xmm1, xmm4 '[AO][RO][GO][BO]
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
            psubd xmm5, xmm1 'Stack -= OUT
            paddd xmm5, xmm0 'Stack += IN

            Add esi, 4
            Add edi, edx
            Sub ecx, 1
            jg _Blur_LoopY


         ' ----------------------------------------------------
         ' | XIn -= Mid / XOut += Mid / XOut -= Last
         ' ----------------------------------------------------
         mov ebp, 0 'DivInc
         mov ecx, [esp+20] 'iR
         _Blur_LoopY_Out:
            cvtsi2ss xmm3, eax
            rcpss xmm3, xmm3
            pshufd xmm3, xmm3, 0 'SumDiv

            movdqa xmm0, xmm5
            paddd xmm0, xmm7 ' UByte -> Float
            subps xmm0, xmm7 '/
            mulps xmm0, xmm3
            addps xmm0, xmm7 ' Float -> UByte
            psubd xmm0, xmm7 '/
            packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B]
            packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB]
            movd [edi], xmm0

            movd xmm0, [esi]
            movd xmm1, [esi+ebx]
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid
            punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Al][Rl][Gl][Bl] Last
            movlhps xmm0, xmm1 '[Al][Rl][Gl][Bl][Am][Rm][Gm][Bm] = [Last][Mid]
            psubw xmm6, xmm0 'OUT-=Last / IN-=Mid
            pslldq xmm0, 8
            paddw xmm6, xmm0 'OUT+=Mid / (IN+=Next)
            movdqa xmm1, xmm6
            movdqa xmm0, xmm6
            punpckhwd xmm1, xmm4 '[AO][RO][GO][BO]
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
            psubd xmm5, xmm1 'Stack -= OUT
            paddd xmm5, xmm0 'Stack += IN

            Add ebp, 1
            Sub eax, ebp

            Add esi, 4
            Add edi, edx
            Sub ecx, 1
            jg _Blur_LoopY_Out


         Sub dword Ptr[esp], 1
         jg _Blur_LoopH

      add esp, 64
       
      pop ebp
   End Asm
   

   ImageDestroy(pImgTmp)
   Return pImgBlur
End Function

Function _GDIPlus_Startup() As Byte
   GDIp.GdiplusVersion = 1
   If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then
      Return FALSE
   EndIf
   Return TRUE
End Function

Sub _GDIPlus_Shutdown()
   GdiplusShutdown(gdipToken)
End Sub

Function _GDIPlus_BitmapCreateFromMemory(aBinImage() As UByte, bBitmap_GDI As Bool = FALSE) As Any Ptr
   Dim As HGLOBAL hGlobal
   Dim As LPSTREAM hStream
   Dim As Any Ptr hBitmap
   Dim As ULong iLen = UBound(aBinImage) + 1
   Dim As Any Ptr hMemory = GlobalAlloc(GMEM_MOVEABLE, iLen)
   Dim As Any Ptr lpMemory = GlobalLock(hMemory)
   RtlCopyMemory(lpMemory, @aBinImage(0), iLen)
   GlobalUnlock(hMemory)
   
   CreateStreamOnHGlobal(hMemory, 0, @hStream)
   GdipCreateBitmapFromStream(hStream, @hBitmap)
   IUnknown_Release(hStream)
   
   If bBitmap_GDI = TRUE Then
      Dim hBitmap_GDI As Any Ptr
      GdipCreateHBITMAPFromBitmap(hBitmap, @hBitmap_GDI, &hFF000000)
      GdipDisposeImage(hBitmap)
      Return hBitmap_GDI
   EndIf
   Return hBitmap
End Function

Function Convert2FBImage(aMemGDIpBitmap() as UByte) as any Ptr
   _GDIPlus_Startup()
   Dim as any Ptr hImage = _GDIPlus_BitmapCreateFromMemory(aMemGDIpBitmap()), pImageMem
   Dim As Single iW_Img, iH_Img
   GdipGetImageDimension(hImage, @iW_Img, @iH_Img)
   
   pImageMem = ImageCreate(iW_Img, iH_Img)
     
   Dim As Integer w, h, pitchMem
   Dim As Any Pointer pixdataMem
   Imageinfo(pImageMem, w, h, , pitchMem, pixdataMem)
   
   Dim As Rect tRect = Type(0, 0, iW_Img - 1, iH_Img - 1)
   Dim As BitmapData tBitmapData
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   
   Dim as Ulong iX, iY, iRowOffset
   For iY = 0 To iH_Img - 1
      iRowOffset = iY * iW_Img
      For iX = 0 To iW_Img - 1
         *cptr(ulong ptr, pixdataMem + iY * pitchMem + iX shl 2) = Cast(ulong Ptr, tBitmapData.Scan0)[iRowOffset + iX]
      Next
   Next
   GdipBitmapUnlockBits(hImage, @tBitmapData)
   GdipDisposeImage(hImage)
   _GDIPlus_Shutdown()
   Return pImageMem
End Function


Schade, dass der Code nicht in einem kleinen Fenster angezeigt wird.
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 72
Wohnort: Opel Stadt

BeitragVerfasst am: 17.01.2018, 16:20    Titel: Antworten mit Zitat

The Zoomquilt [Windows only]:

Code:

'coded by UEZ build 2018-01-15
'inspired by http://zoomquilt.org - thanks to Nikolaus Baumgarten
'thanks to spudw2k for the mouse calculation

#define WIN_INCLUDEALL
#Include "fbgfx.bi"
#Include "file.bi"
#Include "windows.bi"
#Include "win/gdiplus.bi"

Using GDIPLUS
Using FB

#Ifndef Floor
   #Define Floor(x) (((x) * 2.0 - 0.5) Shr 1) '' http://www.freebasic.net/forum/viewtopic.php?p=118633
   #Define Ceiling(x) (-((-(x) * 2.0 - 0.5) Shr 1))
#EndIf
 
declare function RemoteGetFile(url as string, filePath as string) as HRESULT
declare Sub DownloadImages()

DownloadImages() 'download images if not exist, code will end if download fails

Dim as Boolean bMultimonitor = False 'set it to true if you want to extend to your other monitors

Dim GDIPlusStartupInput As GDIPLUSSTARTUPINPUT
Dim As ULONG_PTR GDIPlusToken

GDIPlusStartupInput.GdiplusVersion = 1
If (GdiplusStartup(@GDIPlusToken, @GDIPlusStartupInput, NULL) <> 0) Then
   End 'FAILED TO INIT GDI+!
EndIf

Dim as any Ptr aImages(0 to 46), hImage
Dim as UByte i

'load local images with GDIPlus and convert it to GDI
For i = 0 to Ubound(aImages) - 1
   GdipLoadImageFromFile(CurDir & "\Images\TheZoomquilt" & i & ".jpg", @hImage)
   GdipCreateHBITMAPFromBitmap(hImage, @aImages(i), &hFF000000)
   GdipDisposeImage(hImage)
Next

Dim As String sTitle = "GDI Infinite Image Zoom Flight v1.2"


'get desktop dimension
Dim As Integer iW_Dt, iH_Dt
Dim As RECT tDesktop

If bMultimonitor Then
   Dim As hwnd hHWND_Dt
   hHWND_Dt = FindWindow("Progman","Program Manager")
   GetWindowRect(hHWND_Dt, @tDesktop)
   iW_Dt = Abs(tDesktop.left) + tDesktop.right
   iH_Dt = Abs(tDesktop.top) + tDesktop.bottom
Else
   ScreenInfo iW_Dt, iH_Dt
End If


'get image dimension from GDI image
Dim tBitmap As tagBITMAP
GetObject(aImages(0), Sizeof(tBitmap), @tBitmap)
DIm As Long iW = tBitmap.bmWidth, iH = tBitmap.bmHeight


ScreenControl(SET_DRIVER_NAME, "GDI")
ScreenRes(iW_Dt, iH_Dt, 32, 1, GFX_HIGH_PRIORITY or GFX_NO_FRAME or GFX_ALWAYS_ON_TOP)
WindowTitle(sTitle)

Dim as HWND hHWND
ScreenControl(GET_WINDOW_HANDLE, Cast(Integer, hHWND))

If bMultimonitor Then
   ScreenControl(SET_WINDOW_POS, tDesktop.left, tDesktop.top)
   MoveWindow(hHWND, tDesktop.left, tDesktop.top, iW_Dt, iH_Dt, 1)
End if
   

Dim As Any Ptr hDC = GetDC(hHWND), _
               hHBitmap = CreateCompatibleBitmap(hDC, iW_Dt, iH_Dt), _
               hDC_backbuffer = CreateCompatibleDC(hDC), _
               hMemDC = CreateCompatibleDC(hDC), hFont, DC_obj, hObjOld, hObjOld2

DC_obj = SelectObject(hDC_backbuffer, hHBitmap)

SetStretchBltMode(hDC_backbuffer, STRETCH_DELETESCANS)

hFont = CreateFontW(12, 0, 0, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, _
                    ANTIALIASED_QUALITY, DEFAULT_PITCH, "Arial")
hObjOld2 = SelectObject(hDC_backbuffer, hFont)
SetTextColor(hDC_backbuffer, &hFFFFFF)
SetBkMode(hDC_backbuffer, TRANSPARENT)


Dim evt As EVENT
Dim As ULong iFPS = 0
Dim as String sFPS = "0"
Dim As Double fTimer = Timer

'position FPS text
Dim tRECT as tagRECT
tRECT.Left = 4
tRECT.top = 4
tRECT.Right = 120
tRECT.Bottom = 20

Dim as UByte e, iDepth = 3
Dim as any Ptr a(0 to iDepth)
Dim as Single fPos_z = 1.0, fScale, x, y, w, h, fImg_w, fImg_h, fCenterX, fCenterY

fCenterX = iW_Dt / 2
fCenterY = iH_Dt / 2

If iW_Dt > 1.5 * iH_Dt Then
   fImg_w = iW_Dt
   fImg_h = 0.75 * iW_Dt
Else
   fImg_w = 1.5 * iH_Dt
   fImg_h = 0.75 * iH_Dt
EndIf

Dim as Single iStep = 0.025, iOutMin = 1.0, iOutMax = -1.0
Dim as UShort iInMin = 0, iInMax = iH_Dt
Dim As Integer iMPosX, iMPosY, iMPos

Do
   
   For e = 0 to iDepth - 1
      a(e) = aImages((Floor(fPos_z) + e) Mod Ubound(aImages))
   Next
   
   fScale = 2^(Frac(fPos_z))
 
   For e = 0 to iDepth - 1
      x = fCenterX - fImg_w / 2 * fScale
      y = fCenterY - fImg_h / 2 * fScale
      w = fImg_w * fScale
      h = fImg_h * fScale     
      hObjOld = SelectObject(hMemDC, a(e))
      StretchBlt(hDC_backbuffer, Floor(x), Floor(y), Ceiling(w), Ceiling(h), hMemDC, 0, 0, iW, iH, SRCCOPY)
      fScale *= 0.5
   Next
   
   iMPos = GetMouse (iMPosx, iMPosY)
   
   fPos_z += ((iMPosY - iInMin) * (iOutMax - iOutMin) / (iInMax - iInMin) + iOutMin) * iStep
   IF fPos_z < 0 Then fPos_z = UBound(aImages) - fPos_z
   
   DrawTextW(hDC_backbuffer, "FPS: " & sFPS & " @ " & iW_Dt & "x" & iH_Dt & " px", -1, @tRECT, 0)
   
   BitBlt(hDC, 0, 0, iW_Dt, iH_Dt, hDC_backbuffer, 0, 0, SRCCOPY)
   
   If Timer - fTimer > 0.99 Then
      sFPS = str(iFPS)
      iFPS = 0
      fTimer = Timer
   Else
      iFPS += 1
   EndIf
   
   'Sleep(1, 1)
Loop Until ((InKey = Chr(27)) Or (evt.Type = EVENT_WINDOW_CLOSE))

'Release resources
For i = 0 to Ubound(aImages) - 1
   DeleteObject(aImages(i))
Next
SelectObject(hDC_backbuffer, hObjOld2)
DeleteObject(hFont)
SelectObject(hMemDC, hObjOld)
DeleteDC(hMemDC)
SelectObject(hDC_backbuffer, DC_obj)
DeleteDC(hDC_backbuffer)
ReleaseDC(hHWND, hDC)
GdiplusShutdown(GDIPlusToken)



Sub DownloadImages()
   If FileExists(CurDir & "\Images") = 0 Then
      MkDir(CurDir & "\Images")
   End If
   Dim as String sURL, A(0 to ...) = {"FUjD9hf", "gbHhxTR", "8YyzJdR", "xP3aNkR", "2Qi4fQr", "E6pW5Ky", "zmtWIBF", "Af7LtYp", "TuXy30d", "3nKGLr2", "hNoWscB", "mSBvv3K", "f4wJ70e", "mIt9XmM", "M4TkAyh", "P4L4qhd", "hNM6bTv", "VoT8JXM", "jqcGH0B", "DYVoN8n", "bOPQkOI", "NeaTfJ1", "18ppMNr", "FZ3d8Jv", "HsoX2RP", "mjv4kzI", "6rpJbef", "pySKauq", "WjNQYRV", "Ffooo8y", "Xei5XfD", "T5A415r", "LiV0VNB", "nGcwiO4", "b1Gdjjy", "GE828iy", "eSQ7SLe", "1mPyGgL", "GNtwJIr", "KxBlU7E", "aKXhms5", "9Quu2wu", "Y07quDf", "r0yC5Qa", "273fCkD", "2wMyCUw", "FUjD9hf"}

   For i as UShort = 0 to UBound(A) - 1
      If FileExists(CurDir & "\Images\TheZoomquilt" & i & ".jpg") = 0 Then
         sURL = "http://imgur.com/" & A((20 + i) mod 46) & ".jpg"
         ? "Downloading " & i + 1 & " / " & UBound(A)
         If RemoteGetFile(sURL, CurDir & "\Images\TheZoomquilt" & i & ".jpg") < 0 Then End
      End If
   Next
End Sub

'https://www.freebasic.net/forum/viewtopic.php?f=6&t=24197&p=214027&hilit=URLDownloadToFile#p214324
function RemoteGetFile(url as string, filePath as string) as HRESULT '0 = success
   var hLib = Dylibload("urlmon.dll")
   if hLib = null then
      return -1
   end if

   dim pURLDownloadToFile as function _
       ( _
         byval as LPUNKNOWN, _
         byval as LPCSTR, _
         byval as LPCSTR, _
         byval as DWORD, _
         byval as LPBINDSTATUSCALLBACK _
       ) as HRESULT

   pURLDownloadToFile = Dylibsymbol( hLib, "URLDownloadToFileA" )
   if pURLDownloadToFile = null then
      dylibfree(hLib)
      return -2
   end if

   var result = pURLDownloadToFile(0, url, filePath, 0, 0)

   Dylibfree(hLib)
   return result
end function]


Die benötigten Bilder werden beim ersten Start heruntergeladen.
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 72
Wohnort: Opel Stadt

BeitragVerfasst am: 08.02.2018, 22:31    Titel: Antworten mit Zitat

GDI+ Polar Clock v1.3 [nur Windows]

Code:
'coded by UEZ v1.3 build 2018-02-08
'WINDOWS ONLY!!!

#include "fbgfx.bi"
#include "string.bi"
#include "vbcompat.bi"

#Ifdef __FB_64BIT__
    #inclib "gdiplus"
    #include once "win/gdiplus-c.bi"
#Else
    #include once "win/gdiplus.bi"
    using gdiplus
#Endif

Using FB

Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput
GDIp.GdiplusVersion = 1
If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then End

Const As Single iW = 600, iH = iW, iWh = iW \ 2, iHh = iH \ 2, iRadiusS = iWh * 0.8, iRadiusM = iWh * 0.65, iRadiusH = iWh * 0.5, _
                iPenWO = iW / 15, iPenWI = iW / 15 - 4, iHoleSize = iPenWI / 2, iHoleRadius = iHoleSize / 2
Const as Single fPi = Acos(-1), fRad = fPi / 180, fSize = iW / 75

ScreenControl SET_DRIVER_NAME, "GDI"
ScreenRes iW, iH, 32, 1, GFX_HIGH_PRIORITY Or GFX_NO_SWITCH

Dim As String sTitle = "GDI+ Polar Clock v1.3 / 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, hPen1, hPen2, hPen3, hPen4, hPen5, hPen6, hBrush, hBrushTxt, hPath, hPath2, hFamily, hStringFormat, hMatrix, hRegion
Var hObjOld = SelectObject(hDC_backbuffer, hHBitmap)

GdipCreateFromHDC(hDC_backbuffer, @hCanvas)
GdipSetSmoothingMode(hCanvas, SmoothingModeAntiAlias)
GdipSetPixelOffsetMode(hCanvas, PixelOffsetModeHalf)

GdipCreatePen1(&h40101010, iPenWO, 2, @hPen1)
GdipCreatePen1(&hC0F04040, iPenWI, 2, @hPen2)
GdipCreatePen1(&hC040F040, iPenWI, 2, @hPen3)
GdipCreatePen1(&hC04040F0, iPenWI, 2, @hPen4)
GdipCreatePen1(&h80101010, 3, 2, @hPen5)
GdipCreatePen1(&h18101010, 2, 2, @hPen6)

GdipSetPenLineCap197819(hPen1, 2, 2, 2)
GdipSetPenLineCap197819(hPen2, 2, 2, 2)
GdipSetPenLineCap197819(hPen3, 2, 2, 2)
GdipSetPenLineCap197819(hPen4, 2, 2, 2)
GdipSetPenLineCap197819(hPen5, 2, 2, 2)

Dim As GpPointF StartPoint, EndPoint
StartPoint.x = 0
StartPoint.y = 0
EndPoint.x = iW
EndPoint.y = iH
GdipCreateLineBrush(@StartPoint, @EndPoint, &hFF808080, &hFF282828, 0, @hBrush)
GdipSetLineSigmaBlend(hBrush, 0.5, 0.8)
GdipSetLineLinearBlend(hBrush, 0.4, 0.9)
GdipSetLineGammaCorrection(hBrush, True)
GdipCreateSolidFill(0, @hBrushTxt)

GdipCreatePath(0, @hPath)
GdipCreatePath(0, @hPath2)
GdipCreateMatrix(@hMatrix)


'init string to draw text
GdipCreateFontFamilyFromName("Impact", Null, @hFamily)
GdipCreateStringFormat(0, 0, @hStringFormat)
GdipSetStringFormatAlign(hStringFormat, StringAlignmentCenter)
GdipSetStringFormatLineAlign(hStringFormat, StringAlignmentCenter)
GdipSetTextRenderingHint(hCanvas, PixelOffsetModeHalf)
GdipSetTextRenderingHint(hCanvas, TextRenderingHintAntiAliasGridFit)

'string positions
Dim as GpRectF  tLayout,  tLayout2, tLayout3, tLayout4, tLayout5, tLayout6, tLayout0
tLayout.width = iRadiusM
tLayout.height = iRadiusM
tLayout.x = iWh - tLayout.width \ 2
tLayout.y = iHh - tLayout.height \ 2

tLayout2.width = iRadiusM shL 1
tLayout2.height = iRadiusM ShR 1
tLayout2.x = iWh - iRadiusM
tLayout2.y = iHh + iWh * 0.5 / 10

tLayout3.width = iRadiusM shL 1
tLayout3.height = iRadiusM ShR 1
tLayout3.x = iWh - iRadiusM
tLayout3.y = iHh - iWh / 2 * 0.75

tLayout4.width = fSize * Len("seconds") * 1.66666
tLayout4.height = fSize * 2
tLayout4.x = iWh - tLayout4.width / 2
tLayout4.y = iHh - tLayout4.height / 2

tLayout5.width = fSize * Len("minutes") * 1.66666
tLayout5.height = fSize * 2
tLayout5.x = iWh - tLayout5.width / 2
tLayout5.y = iHh - tLayout5.height / 2
   
tLayout6.width = fSize * Len("hours") * 1.66666
tLayout6.height = fSize * 2
tLayout6.x = iWh - tLayout6.width / 2
tLayout6.y = iHh - tLayout6.height / 2
   
tLayout0.x = 0
tLayout0.y = iH - 8
tLayout0.width = 34
tLayout0.height = 10

Dim As UByte iSec, iMin, iHr
Dim as SYSTEMTIME tTime

Dim As ULong iFPS = 0
Dim As Double fTimer = Timer, iMS, d
Dim As Single calc1, calc2, calc3, calc4

Do
   GdipFillRectangle(hCanvas, hBrush, 0, 0, iW, iH)
   
   GdipDrawEllipse(hCanvas, hPen6, iWh - iRadiusS, iHh - iRadiusS, 2 * iRadiusS, 2 * iRadiusS)
   GdipDrawEllipse(hCanvas, hPen6, iWh - iRadiusM, iHh - iRadiusM, 2 * iRadiusM, 2 * iRadiusM)
   GdipDrawEllipse(hCanvas, hPen6, iWh - iRadiusH, iHh - iRadiusH, 2 * iRadiusH, 2 * iRadiusH)

   d = Now()
   GetSystemTime(@tTime)
   iMS = tTime.wMilliseconds / 1000
   iSec = tTime.wSecond
   iMin = tTime.wMinute
   iHr = CUbyte(Format(d, "h")) 'tTime.wHour
   If iHr > 11.0 Then iHr -= 12.0   ' more efficient than mod
   
   'draw second
   calc1 = 6 * (iSec + iMS)
   calc2 = -90 + calc1
   calc3 = iWh + Cos(calc2 * fRad) * iRadiusS - iHoleRadius
   calc4 = iHh + Sin(calc2 * fRad) * iRadiusS - iHoleRadius
   GdipAddPathArc(hPath, iWh - iRadiusS, iHh - iRadiusS, iRadiusS Shl 1, iRadiusS Shl 1, -90, calc1)
   GdipAddPathEllipse(hPath2, calc3, calc4, iHoleSize, iHoleSize)
   GdipSetClipPath(hCanvas, hPath2, 4)
   GdipDrawPath(hCanvas, hPen1, hPath)
   GdipDrawPath(hCanvas, hPen2, hPath)
   GdipDrawEllipse(hCanvas, hPen5, calc3, calc4, iHoleSize, iHoleSize)
   GdipResetPath(hPath)
   GdipResetPath(hPath2)
   GdipResetClip(hCanvas)
   
   'draw minute
   calc1 = 6 * (iMin + iSec / 60)
   calc2 = -90 + calc1
   calc3 = iWh + Cos(calc2 * fRad) * iRadiusM - iHoleRadius
   calc4 = iHh + Sin(calc2 * fRad) * iRadiusM - iHoleRadius
   GdipAddPathArc(hPath, iWh - iRadiusM, iHh - iRadiusM, iRadiusM Shl 1, iRadiusM Shl 1, -90, calc1)
   GdipAddPathEllipse(hPath2, calc3, calc4, iHoleSize, iHoleSize)
   GdipSetClipPath(hCanvas, hPath2, 4)
   GdipDrawPath(hCanvas, hPen1, hPath)
   GdipDrawPath(hCanvas, hPen3, hPath)
   GdipDrawEllipse(hCanvas, hPen5, calc3, calc4, iHoleSize, iHoleSize)
   GdipResetPath(hPath)
   GdipResetPath(hPath2)
   GdipResetClip(hCanvas)

   'draw hour
   calc1 = 30 * (iHr + iMin / 60)
   calc2 = -90 + calc1
   calc3 = iWh + Cos(calc2 * fRad) * iRadiusH - iHoleRadius
   calc4 = iHh + Sin(calc2 * fRad) * iRadiusH - iHoleRadius
   GdipAddPathArc(hPath, iWh - iRadiusH, iHh - iRadiusH, iRadiusH Shl 1, iRadiusH Shl 1, -90, calc1)
   GdipAddPathEllipse(hPath2, calc3, calc4, iHoleSize, iHoleSize)
   GdipSetClipPath(hCanvas, hPath2, 4)
   GdipDrawPath(hCanvas, hPen1, hPath)
   GdipDrawPath(hCanvas, hPen4, hPath)
   GdipDrawEllipse(hCanvas, hPen5, calc3, calc4, iHoleSize, iHoleSize)
   GdipResetPath(hPath)
   GdipResetPath(hPath2)
   GdipResetClip(hCanvas)
   
   'display clock
   GdipSetSolidFillColor(hBrushTxt, &hF0F0F0F0)
   GdipAddPathString(hPath, Left(Format(d, "hh:mm a/p"), 5), -1, hFamily, 0, iWh / 2 * 0.45, @tLayout, hStringFormat)
   GdipFillPath(hCanvas, hBrushTxt, hPath)
   GdipResetPath(hPath)
   
   'display date
   GdipSetSolidFillColor(hBrushTxt, &h80F0F0F0)
   GdipAddPathString(hPath, Format(d, "mmm d") & "  " & WeekdayName(Weekday(d)), -1, hFamily, 0, iWh / 2 * 0.1, @tLayout2, hStringFormat)
   GdipFillPath(hCanvas, hBrushTxt, hPath)
   GdipResetPath(hPath)

   'display AM/PM
   GdipAddPathString(hPath, Format(d, "AM/PM"), -1, hFamily, 0, iWh / 2 * 0.2, @tLayout3, hStringFormat)
   GdipFillPath(hCanvas, hBrushTxt, hPath)
   GdipResetPath(hPath)
   
   'label seconds
   GdipSetSolidFillColor(hBrushTxt, &hFFF0F0F0)
   GdipAddPathString(hPath, "seconds", -1, hFamily, 0, fSize, @tLayout4, hStringFormat)
   GdipTranslateMatrix(hMatrix, iWh, iHh, False) 'rotate letter
   GdipRotateMatrix(hMatrix, 6 * (-1 + iSec + iMS), False)
   GdipTranslateMatrix(hMatrix, -iWh, -iHh, False)
   GdipTransformPath(hPath, hMatrix)
   GdipSetMatrixElements(hMatrix, 1, 0, 0, 1, 0, 0)
   calc1 = (-90 + 6 * (-1.25 + iSec + iMS)) * fRad
   GdipTranslateMatrix(hMatrix, Cos(calc1) * iRadiusS, Sin(calc1) * iRadiusS, False) 'position letter
   GdipTransformPath(hPath, hMatrix)
   GdipSetMatrixElements(hMatrix, 1, 0, 0, 1, 0, 0)
   GdipFillPath(hCanvas, hBrushTxt, hPath) 'draw letter
   GdipResetPath(hPath)
   
   'label minutes
   GdipSetSolidFillColor(hBrushTxt, &hFFF0F0F0)
   GdipAddPathString(hPath, "minutes", -1, hFamily, 0, fSize, @tLayout5, hStringFormat)
   GdipTranslateMatrix(hMatrix, iWh, iHh, False) 'rotate letter
   GdipRotateMatrix(hMatrix, 6 * (-1 + iMin + iSec / 60), False)
   GdipTranslateMatrix(hMatrix, -iWh, -iHh, False)
   GdipTransformPath(hPath, hMatrix)
   GdipSetMatrixElements(hMatrix, 1, 0, 0, 1, 0, 0)
   calc1 = (-90 + 6 * (-1.5 + iMin + iSec / 60)) * fRad
   GdipTranslateMatrix(hMatrix, Cos(calc1) * iRadiusM, Sin(calc1) * iRadiusM, False) 'position letter
   GdipTransformPath(hPath, hMatrix)
   GdipSetMatrixElements(hMatrix, 1, 0, 0, 1, 0, 0)
   GdipFillPath(hCanvas, hBrushTxt, hPath) 'draw letter
   GdipResetPath(hPath)   

   'label hours
   GdipSetSolidFillColor(hBrushTxt, &hFFF0F0F0)
   GdipAddPathString(hPath, "hours", -1, hFamily, 0, fSize, @tLayout6, hStringFormat)
   GdipTranslateMatrix(hMatrix, iWh, iHh, False) 'rotate letter
   GdipRotateMatrix(hMatrix, 30 * (-0.25 + iHr + iMin / 60), False)
   GdipTranslateMatrix(hMatrix, -iWh, -iHh, False)
   GdipTransformPath(hPath, hMatrix)
   GdipSetMatrixElements(hMatrix, 1, 0, 0, 1, 0, 0)
   calc1 = (-90 + 30 * (-0.35 + iHr + iMin / 60)) * fRad
   GdipTranslateMatrix(hMatrix, Cos(calc1) * iRadiusH, Sin(calc1) * iRadiusH, False) 'position letter
   GdipTransformPath(hPath, hMatrix)
   GdipSetMatrixElements(hMatrix, 1, 0, 0, 1, 0, 0)
   GdipFillPath(hCanvas, hBrushTxt, hPath) 'draw letter
   GdipResetPath(hPath)
   
   GdipAddPathString(hPath, "code by UEZ", -1, hFamily, 0, 6.5, @tLayout0, hStringFormat)
   GdipFillPath(hCanvas, hBrushTxt, hPath)
   GdipResetPath(hPath)
   BitBlt(hDC, 0, 0, iW, iH, hDC_backbuffer, 0, 0, SRCCOPY)
   Sleep(50, 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
GdipDeleteMatrix(hMatrix)
GdipDeleteFontFamily(hFamily)
GdipDeleteStringFormat(hStringFormat)
GdipDeletePath(hPath)
GdipDeletePath(hPath2)
GdipDeletePen(hPen1)
GdipDeletePen(hPen2)
GdipDeletePen(hPen3)
GdipDeletePen(hPen4)
GdipDeletePen(hPen5)
GdipDeletePen(hPen6)
GdipDeleteBrush(hBrush)
GdipDeleteBrush(hBrushTxt)
SelectObject(hDC_backbuffer, hObjOld)
DeleteDC(hDC_backbuffer)
ReleaseDC(hHWND, hDC)
DeleteObject(hHBitmap)
GdipDeleteGraphics(hCanvas)
GdiplusShutdown(gdipToken)




_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Projektvorstellungen Alle Zeiten sind GMT + 1 Stunde
Gehe zu Seite Zurück  1, 2, 3
Seite 3 von 3

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz