Auf den 1.Blick ganz nett, aber irgendwas stimmt noch nicht. Wenn die Werte für trapez und tiefe zu klein sind, sieht es sch... aus. Scheint mit den z Werten nicht so ganz richtig zu sein. Habe halt von Geometrie keine Ahnung.
Die Hilfe von PB zu diesem Thema ist leider unter aller Würde !!!
Mußt mal Stargate oder andere 3D Spezies fragen.
Der Code entspricht dem Vorigen, habe nur die 3D Befehle eingefügt.
Code: Alles auswählen
Declare myTexturTextImage(pbnr,br,hh,txt$,font)
#window_height = 600
#window_width = 900
#screen_height = 570
#screen_width = 870
Enumeration
#win_nr
#textur1
#textur2
#hgimage1
#hgimage2
#screenhg
#textur_img
#masken_img
#imagenr1
#sprite1
#sprite3D
#dummy1
#dummy2
#dummy3
EndEnumeration
InitSprite()
InitSprite3D()
fontsize = 35
fontidnr = FontID(LoadFont(#PB_Any,"Verdana",fontsize,#PB_Font_Bold))
UseJPEGImageDecoder()
;Texturen zum füllen
LoadImage(#textur1, #PB_Compiler_Home+"examples\sources\Data\clouds.jpg")
LoadImage(#textur2, "C:\WINDOWS\Web\Wallpaper\windkanal.jpg")
;Hintergrundbild
LoadImage(#hgimage1, "C:\WINDOWS\Web\Wallpaper\mondkrater.jpg")
LoadImage(#hgimage2, "C:\WINDOWS\Web\Wallpaper\mondaufgang.jpg")
hwnd = OpenWindow(#win_nr, #PB_Ignore, #PB_Ignore, #window_width, #window_height, "DisplaySprite3D", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CreateGadgetList(hwnd)
OpenWindowedScreen(hwnd,15,15,#screen_width,#screen_height,0,15,15)
Restore datatext1
Read lines: For j=1 To lines: Read a$: txt$+a$:Next: txt$+#CRLF$ ;#CRLF$=Leerzeile am Ende
myimageID = myTexturTextImage(#imagenr1,800,1000,txt$,fontidnr)
;=====================================================
CreateSprite(#screenhg, #screen_width, #screen_height)
StartDrawing(SpriteOutput(#screenhg))
DrawImage(ImageID(#hgimage1),0,0,#screen_width,#screen_height)
;DrawImage(ImageID(#hgimage2),0,0,#screen_width,#screen_height)
StopDrawing()
;=====================================================
sprite_width = ImageWidth(#Imagenr1): ;Debug sprite_width
sprite_height = ImageHeight(#Imagenr1): ;Debug sprite_height
flag=#PB_Sprite_Texture
CreateSprite(#sprite1, sprite_width, sprite_height, flag)
StartDrawing(SpriteOutput(#sprite1))
DrawImage(myimageID,0,0)
StopDrawing()
;=======================================
CreateSprite3D(#Sprite3D, #Sprite1)
trapez=200
tiefe=200
;x1 bis x4 siehe PB Hilfe
x1sp=trapez: x1ze=0
x2sp=sprite_width-trapez: x2ze=0
x3sp=sprite_width: x3ze=sprite_height
x4sp=0: x4ze=sprite_height
z1=sprite_width+tiefe
z2=sprite_width+tiefe
z3=sprite_height-tiefe
z4=sprite_height-tiefe
TransformSprite3D(#Sprite3D, x1sp,x1ze,z1, x2sp,x2ze,z2, x3sp,x3ze,z3, x4sp,x4ze,z4)
;=======================================
y = sprite_height
Repeat
EventID = WindowEvent()
ClearScreen(RGB(0, 0, 0))
DisplaySprite(#screenhg,0,0)
Start3D()
For spritecounter = 1 To (Round(#screen_height/sprite_height,1) + 1)
;DisplayTransparentSprite(#sprite1,(#screen_width - sprite_width)/2, (spritecounter -2) * sprite_height + y)
DisplaySprite3D(#sprite3d, (#screen_width - sprite_width)/2, (spritecounter -2) * sprite_height + y,250)
Next spritecounter
Stop3D()
y - 1
If y < 0
y = sprite_height
EndIf
FlipBuffers()
Until EventID = #PB_Event_CloseWindow
End
Procedure myTexturTextImage(pbnr,br,hh,txt$,fontidnr)
;die br+hh gilt hier nur für die Maske, damit Text komplett hineinpaßt
maskenID = CreateImage(#masken_img, br, hh,1)
dc = StartDrawing(ImageOutput(#masken_img))
;Textfont
SelectObject_(dc,FontIDnr) ;oder DrawingFont(FontIDnr)
;Text
SetBkMode_(dc,#TRANSPARENT) ;oder DrawingMode()
SetTextColor_(dc,#White) ;#white = ganz wichtig
SetTextAlign_(dc,#TA_TOP) ;ohne geht es nicht
SetRect_(r.RECT,0,0,br,hh) ;Basiswerte für rect; left,top,right,bottom
;berechne via Api die Größe von r.rect für den Text !!!
DrawText_(dc,txt$,-1,r,#DT_CALCRECT|#DT_WORDBREAK)
;zeichne Text
DrawText_(dc,txt$,-1,r,#DT_CENTER|#DT_WORDBREAK)
StopDrawing()
;nur zur Demo wie Maske aussieht
;ImageGadget(#dummy1, 400, 10, 0, 0, maskenID)
;=======================================
;Source(Quelle)=Textur braucht nur so groß sein wie der Text
sourcebr = r\right ;r wird bei Maske berechnet
sourcehh = r\bottom
sourceID = CreateImage(#textur_img, sourcebr, sourcehh)
dc = StartDrawing(ImageOutput(#textur_img))
;Textur malen
DrawImage(ImageID(#textur1),0,0,sourcebr,sourcehh)
;DrawImage(ImageID(#textur2),0,0,sourcebr,sourcehh)
StopDrawing()
;nur zur Demo wie Source aussieht
;ImageGadget(#dummy2, 400, 310, 0, 0, sourceID)
;=======================================
;Target(Ziel)
maskbltflag=$AACC0020 ;Billys Geheimnis, http://support.microsoft.com/kb/89375/de
targetbr = r\right
targethh = r\bottom: ;Debug r\bottom
target_img=pbnr ;pbnr ist die Nummer des erstellten Images, zum weiterarbeiten damit
targetID = CreateImage(target_img, targetbr, targethh)
targetDC = StartDrawing(ImageOutput(target_img))
;wir müssen eine Kopie anlegen, dieses dc dient als Source für MaskBlt
dc = CreateCompatibleDC_(targetDC)
;füllen Kopie mit Bild von source, also dem Farbverlauf oder was auch immer
SelectObject_(dc, sourceID)
MaskBlt_(targetDC, 0, 0, br, hh, dc, 0, 0, maskenID, 0, 0, maskbltflag)
;Kopie löschen
DeleteDC_(dc)
StopDrawing()
;nur zur Demo wie Source aussieht
;ImageGadget(#dummy3, 400, 610, 0, 0, targetID)
ProcedureReturn targetID
EndProcedure
DataSection
datatext1:
Data.l 4
Data.s "Ich will ja nur mal testen ob ich das hinbekomme und für Geschwindigkeit muß am "
Data.s "'Y-Wert' gedreht werden und als nächstes probier ich dann endlosscrollen und dann "
Data.s "zu zentrieren und danach eine Textur statt Textfarbe und dann versuch ich, daß es oben "
Data.s "schmaler wird (STAR WARS) und dann.............." 