Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
flagge.bas
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 12.05.2014 23:47:02 |
'Konstanten für die Berechnung
Const PI as Double = 3.14
Const PI180 as Double = 3.14 / 180
'Funktion, welche einen Sinus auf ein Bild rechnet (Flaggeneffekt)
'Hiermit wird NUR die Zeilenhöhe verändert! Es erfolgt keine Stauchung!
Function AddSinusToImg(ByRef V_ImageInput as Any Ptr, ByRef R_ImageOutput as Any Ptr, ByRef V_Radius as Integer, ByRef V_Grad as Integer, ByRef V_SinusWidth as Integer) as Integer
If V_ImageInput = 0 Then Return -1
If R_ImageOutput = 0 Then Return -1
If V_Radius < 0 Then Return -1
'Erfassen der Parameter vom Eingangsbildspeicher
Dim TInW as Integer 'Temporaer, Breite
Dim TInH as Integer 'Temporaer, Höhe
Dim TInP as Integer 'Temporaer, Pitch
Dim TInD as Any Ptr 'Temporaer, DatenPointer
If ImageInfo(V_ImageInput, TInW, TInH, , TInP, TInD) = 1 Then 'Wenn bei Bild-informationen einholen = 1, dann
Return -1 'fehlerhaft, und mit -1 beenden
End If
'Erfassen der Parameter vom Ausgangsbildspeicher
Dim TOutW as Integer 'Temporaer, Breite
Dim TOutH as Integer 'Temporaer, Höhe
Dim TOutP as Integer 'Temporaer, Pitch
Dim TOutD as Any Ptr 'Temporaer, DatenPointer
If ImageInfo(R_ImageOutput, TOutW, TOutH, , TOutP, TOutD) = 1 Then 'Wenn bei Bild-informationen einholen = 1, dann
Return -1 'fehlerhaft, und mit -1 beenden
End If
Line R_ImageOutput, (0, 0)-(TOutW - 1, TOutH - 1), &H00000000, BF 'Ausgabebild leeren (Alpha 0 / Transparenter Hintergrund)
Dim TAngel as Double = V_Grad mod 360 'Rest aus n / 360 ermitteln (macht aus werte gröser 360 den passenden im bereich von 360)
Dim TSinPixelVal as Integer
Dim X as Integer
Dim Y as Integer
'Bitte beachten, das das ausgabebild einen rahmen von "Radius" besitzen sollte, damit die Pixelsetzung erfolgreich verläuft
For X = 0 to TInW - 1 'Alle Pixel in der Breite durchgehen
If X >= TOutW Then Exit For 'Wenn Ende von Ausgabebildbreite erreicht, schleife verlassen (Sollte nie passieren)
TSinPixelVal = CInt(V_Radius * Sin(TAngel * PI180)) 'V_Position errechnen
TAngel += V_SinusWidth 'Zum Winkel die schrittweite addieren, für nächste Spalte
For Y = 0 To TInH 'Jede zeile durchgehen
'Ausgabebild wird Geclipt, sofern die Parameter dies erforderlich machen!
If (Y + TSinPixelVal) < 0 Then Continue For 'Wenn Pixel auserhalb vom Ausgabebildspeicher, dann nächste Zeile
If (Y + TSinPixelVal) >= TOutH Then Continue For '-||-
'Print #1, Y + TSinPixelVal
'Sleep 1000, 1
Cast(UInteger Ptr, TOutD + (Y + TSinPixelVal) * TOutP)[X] = Cast(UInteger Ptr, TInD + Y * TOutP)[X]
Next
Next
End Function
'App
Screenres 800, 600, 32 'Bildschirm erzeugen
'Ausgangsbildspeicher erzeugen
Dim TImgOut as Any Ptr 'Temporärer Speicher für das ausgabebild
TImgOut = ImageCreate(100, 100, &HFF000000, 32) 'Bilsspeicher mit 100x100pixel farbe Schwarz und 32bit erzeugen
If TImgOut = 0 Then 'Wenn Bild = 0 dann
Print "Bild konnte nicht erzeugt werden!"
End -1 'fehlerhaft, und mit -1 beenden
End If
'Eingangsbildspeicher erzeugen und bild erzeugen
Dim TImgIn as Any Ptr 'Speicher für das zu manipulierende Bild
TImgIn = ImageCreate(100, 100, &H00000000, 32) 'Bilsspeicher mit 100x100pixel Alpha 0 / Transparent und 32bit erzeugen
If TImgIn = 0 Then 'Wenn Bild = 0 dann
Print "Bild konnte nicht erzeugt werden!"
End -1 'fehlerhaft, und mit -1 beenden
End If
Line TImgIn, (0, 0)-(99, 99), &HFFFFFFFF, B 'Rahmen in Bild zeichen
Line TImgIn, (20, 20)-(80, 80), &HFFFF0000, BF 'RECT in Bild zeichen
Line TImgIn, (30, 30)-(70, 70), &HFF00FF00, BF 'RECT in Bild zeichen
Line TImgIn, (40, 40)-(60, 60), &HFF0000FF, BF 'RECT in Bild zeichen
Dim TAngle as Integer
Do Until InKey() = chr(27) 'Hauptschleife (solange bis ESC)
TAngle += 1 'Winkel (grad) +1
If TAngle >= 360 Then TAngle = 0 'Wenn Winkel >= 360, dann auf 0 zurück
'TImgIn = Eingangsbildspeicher
'TImgOut = Ausgabebildspeicher
'10 = Radius für sinus (In diesem falle die höhenveränderung)
'TAngle ist Anfangswinkel für die Sinuswelle
'2 = Ist Schrittweite (Frquenz) für die Sinuswelle (wie viele schwingungen auf dem Bild liegen)
AddSinusToImg(TImgIn, TImgOut, 10, TAngle, 2) 'Eingangsbild mit sinus auf ausgangsbild zeichnen
Put (20, 20), TImgIn, PSET 'Eingangsbild anzeigen
Put (220, 20), TImgOut, PSET 'Ausgangsbild anzeigen
Sleep 10, 1 'CPU schonung
Loop
End 0 'sauber beenden