[gelöst] Bild auf Zylinder legen und den drehen

[NicTheQuick]

Hab auch noch schnell was gebastelt:
File muss angepasst werden.#
Dann Steuerung über +, -, Rechts, Links, Hoch, Runter, 0, 1, 2, 3 und 4.
Die Zahlen geben an wie oft das Bild um den Zylinder gewickelt werden
soll. Mit + und - kann man das Bild zoomen, wenn man vorher 0 drückt.

Code: Alles auswählen

Procedure DrawArcSprite(SpriteID.l, x.l, y.l, Radius.l, RollAngle.d, yHeight.l, ZoomX.d = 1.0, CountX.l = 0)
  Protected Width.l, Height.l, Measure.d, rWidth.l, Px.l, cos.d, sin.d, a.d, Px3.l
  
  Width = SpriteWidth(SpriteID)   ;Breite des Sprites
  Height = SpriteHeight(SpriteID) ;Höhe des Sprites
  rWidth = Radius * 2             ;Sichtbare Breite
  Measure = Radius * 2 * #PI      ;Umfang des Zylinders
  
  If CountX > 0
    ZoomX = 2 * rWidth / (Width * CountX)
  Else
    ZoomX = ZoomX * Width / Measure
  EndIf
  
  For Px = 0 To rWidth
    cos = 2.0 * Px / rWidth - 1.0
    sin = Sqr(1 - cos * cos)
    a = ATan(sin / cos)
    If a <= 0.0 : a + #PI : EndIf
    a = #PI - a + RollAngle
    
    Px3 = Int(a * rWidth / (#PI * ZoomX))
    If Px3 < 0
      Px3 = Width - ((-Px3) % Width) - 1
    Else
      Px3 = Px3 % Width
    EndIf
    
    ClipSprite(SpriteID, Px3, 0, 1, Height)
    DisplaySprite(SpriteID, x + Px, y + sin * yHeight)
  Next
  
  ClipSprite(SpriteID, #PB_Default, #PB_Default, #PB_Default, #PB_Default)
EndProcedure

UseJPEGImageDecoder()
;UsePNGImageDecoder()
;UseTGAImageDecoder()
;UseTIFFImageDecoder()

File.s = "F:\AOL-CD-Mensch-Ärgere-Dich-Nicht.jpg"

Define.l Width, Height
Width = 800
Height = 600

Define Radius.l, RollAngle.d, ZoomX.d, ZoomY.d, yHeight.l, CountX.l

Radius = 80
RollAngle = 0.0
ZoomX = 1
yHeight = 20
CountX = 0



Global Error_out.l
Macro Error(Command, msg="Error")
  Error_out = Command
  If Error_out = #False : MessageRequester("Error", msg) : End : EndIf
EndMacro

Error(InitSprite() And InitKeyboard(), "Inits")

Error(OpenWindow(0, 0, 0, Width, Height, "Cylinder test", #PB_Window_ScreenCentered | #PB_Window_BorderLess), "OpenWindow")
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
  HideWindow(0, 1)
CompilerEndIf

Error(OpenWindowedScreen(WindowID(0), 0, 0, Width, Height, 0, 0, 0), "OpenWindowedScreen")

Error(LoadSprite(#PB_Any, File), "LoadSprite")
Sprite.l = Error_out

Repeat
  ClearScreen(0)
  ExamineKeyboard()
  
  If KeyboardPushed(#PB_Key_Up) : Radius + 1 : EndIf
  If KeyboardPushed(#PB_Key_Down) : Radius - 1 : EndIf
  If KeyboardPushed(#PB_Key_Left) : RollAngle - #PI / 90.0 : EndIf
  If KeyboardPushed(#PB_Key_Right) : RollAngle + #PI / 90.0 : EndIf
  If KeyboardPushed(#PB_Key_Add) : ZoomX * 1.01 : EndIf
  If KeyboardPushed(#PB_Key_Subtract) : ZoomX / 1.01 : EndIf
  If KeyboardPushed(#PB_Key_0) : CountX = 0 : EndIf
  If KeyboardPushed(#PB_Key_1) : CountX = 1 : EndIf
  If KeyboardPushed(#PB_Key_2) : CountX = 2 : EndIf
  If KeyboardPushed(#PB_Key_3) : CountX = 3 : EndIf
  If KeyboardPushed(#PB_Key_4) : CountX = 4 : EndIf
  If RollAngle > 2.0 * #PI : RollAngle - 2.0 * #PI : EndIf
  If RollAngle < 0.0 : RollAngle + 2.0 * #PI : EndIf
  
  DrawArcSprite(Sprite, 0, 0, Radius, RollAngle, Radius / 2, ZoomX, CountX)
  FlipBuffers()
  
  While WindowEvent() : Wend
Until KeyboardReleased(#PB_Key_Escape)

[Andreas_S]

*sprachlos*

...

[scholly]

Manchmal komm ich nach Hause und würd mich am liebsten sofort in die Poofe werfen - den ganzen Tag allerschönstes Wetter und dann hängt man die meiset Zeit im Stau oder Zähfluß drin

Zum Ausgleich dann hier die beiden schönene Überraschungen - das hebt die Stimmung

@NTQ
Toll. Klasse. An so einen Ansatz hab ich garnicht gedacht.
Da kann ich jede Menge Variationen von nehmen.

Selbst eine Kombination mit Andreas_s's Version hat was für sich.
(Mir schwebt da schon was konkretes vor )

Ich hab mit dem Code jetzt schon Bilder mit 1280 * 800 gedreht.
Geht jetzt schon sehr flüssig.

Hat der Prozessor da direkten Einfluß? Mein Sempron hat nur 1.6 GHz

Zu den Streifen... wie gesagt das ist gewollt das da schwarze Striche sind...

[Michael Mittermeier Modus]
I moags ned...
I wills ned...
Koanst ned wegmacha?
[/Michael Mittermeier Modus]

sich jetzt ersma 'n vernünftiges Baguette zum Abendessen bastelnd... scholly