Hatte ich schon fast vergessen, dass ich das veröffentlichen wollte ^^
Also folgendes Programm wandelt ein normales 2D Bildchen egal welcher Größe in eine von 7 möglichen isometrischen Ansichten um (die, die man allgemein braucht, z.B für Terrains). Habs hoffentlich übersichtlich gehalten.
Nichts besonderes - aber vieleicht nützlich.
BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]
AppTitle "2D2Iso Konverter" Graphics 800,600,32,2 font1 = LoadFont("verdana", 14,1,0,0) font2 = LoadFont("verdana", 14,0,0,0) SetFont font1 Global tex1=LoadImage("1.bmp") Global tex2 Dim pic(31,31,2) Dim pic2(ImageWidth(tex1),ImageHeight(tex1),2) screen = CreateImage(GraphicsWidth(),GraphicsHeight()) SeedRnd MilliSecs()
For x = 0 To 31 For y = 0 To 31 r=Rand(0,255) g=Rand(0,255) b=Rand(0,255) If x < 16 Then pic(x,y,0)=r pic(x,y,1)=g pic(x,y,2)=b End If If x => 16 Then pic(x,y,0)=130 pic(x,y,1)=140 pic(x,y,2)=160 End If Next Next
SetBuffer ImageBuffer(tex1) DrawBlock tex1,0,0 For x = 0 To ImageWidth(tex1) For y = 0 To ImageHeight(tex1) GetColor x,y r=ColorRed() g=ColorGreen() b=ColorBlue() pic2(x,y,0) = r pic2(x,y,1) = g pic2(x,y,2) = b Next Next
SetBuffer ImageBuffer(screen) Color 0,60,120 Rect 0,0,GraphicsWidth(),GraphicsHeight()
Color 255,255,255 Text GraphicsWidth()/2,10, "::[ Normal2Isometrie-Konverter ]:: by Triton, 2004",1 SetFont font2
Text 100,50,"flach" Text 480,50,"->" For x = 0 To 31 For y = 0 To 31 Color pic(x,y,0),pic(x,y,1),pic(x,y,2) Plot x+400,y+50 Next Next Color 255,255,255 normal(1,550,50)
Color 255,255,255 Text 100,125,"vertikal, nach westen" Text 480,125,"->" For x = 0 To 31 For y = 0 To 31 Color pic(x,y,0),pic(x,y,1),pic(x,y,2) Plot x+400,y+125 Next Next vertikalwest(1,550,122)
Color 255,255,255 Text 100,200,"vertikal, nach osten" Text 480,200,"->" For x = 0 To 31 For y = 0 To 31 Color pic(x,y,0),pic(x,y,1),pic(x,y,2) Plot x+400,y+200 Next Next vertikalost(1,582,212)
Color 255,255,255 Text 100,275,"1/2 aufsteigend, nach osten" Text 480,275,"->" For x = 0 To 31 For y = 0 To 31 Color pic(x,y,0),pic(x,y,1),pic(x,y,2) Plot x+400,y+275 Next Next bergost(1,550,270)
Color 255,255,255 Text 100,350,"1/2 aufsteigend, nach westen" Text 480,350,"->" For x = 0 To 31 For y = 0 To 31 Color pic(x,y,0),pic(x,y,1),pic(x,y,2) Plot x+400,y+350 Next Next bergwest(1,550,346)
Color 255,255,255 Text 100,425,"1/2 absteigend, nach osten" Text 480,425,"->" For x = 0 To 31 For y = 0 To 31 Color pic(x,y,0),pic(x,y,1),pic(x,y,2) Plot x+400,y+425 Next Next talost(1,550,425)
Color 255,255,255 Text 100,500,"1/2 absteigend, nach westen" Text 480,500,"->" For x = 0 To 31 For y = 0 To 31 Color pic(x,y,0),pic(x,y,1),pic(x,y,2) Plot x+400,y+500 Next Next talwest(1,550,500)
auswahl=1 SetBuffer BackBuffer() While Not KeyDown(1) Or ende=1 If auswahl > 1 Then If KeyHit(200) Then auswahl=auswahl-1 End If If auswahl < 7 Then If KeyHit(208) Then auswahl=auswahl+1 End If If KeyDown(28) And auswahl = 1 Then tex2 = CreateImage(ImageWidth(tex1)+ImageHeight(tex1),(ImageWidth(tex1)+ImageHeight(tex1))/2) normal(2,0,0) End If If KeyDown(28) And auswahl = 2 Then tex2 = CreateImage(ImageWidth(tex1),ImageHeight(tex1)+ImageWidth(tex1)/2) vertikalwest(2,0,0) End If If KeyDown(28) And auswahl = 3 Then tex2 = CreateImage(ImageWidth(tex1),ImageHeight(tex1)+ImageWidth(tex1)/2) vertikalost(2,0,0) End If If KeyDown(28) And auswahl = 4 Then tex2 = CreateImage(ImageWidth(tex1)+ImageHeight(tex1),ImageWidth(tex1)+ImageHeight(tex1)/2) bergost(2,0,0) End If If KeyDown(28) And auswahl = 5 Then tex2 = CreateImage(ImageWidth(tex1)+ImageHeight(tex1),ImageWidth(tex1)+ImageHeight(tex1)/2) bergwest(2,0,0) End If If KeyDown(28) And auswahl = 6 Then tex2 = CreateImage(ImageWidth(tex1)+ImageHeight(tex1),ImageHeight(tex1)/2) talost(2,0,0) End If If KeyDown(28) And auswahl = 7 Then tex2 = CreateImage(ImageWidth(tex1)+ImageHeight(tex1),ImageHeight(tex1)/2) talwest(2,0,0) End If DrawBlock screen, 0,0 Color 255,255,255 Rect 75,auswahl*75-30,GraphicsWidth()-210,50,0 Flip Cls Wend
End
Function speichern() SetBuffer FrontBuffer() DrawBlock tex2,GraphicsWidth()/2-ImageWidth(tex2)/2,GraphicsHeight()/2-ImageHeight(tex2)/2
save=SaveImage (tex2,"isotex.bmp") If save=1 Then Color 128,255,128 Text 10,10, "Bild erfolgreich als isotex.bmp gespeichert!" Else Color 255,128,128 Text 10,10, "Bild konnte nicht gespeichert werden!" End If Color 255,255,255 Text 10,30, "Beliebige Taste zum Fortsetzen drücken" Text 10,580, "Visit http://www.silizium-net.de/ :)" FlushKeys WaitKey End End Function
Function normal(mode,originx,originy) If mode = 1 Then For x = 0 To 31 For y = 0 To 31 xneu = x+y yneu = (y-x)/2 Color pic(x,y,0),pic(x,y,1),pic(x,y,2) Plot xneu+originx,yneu+originy+16 Next Next End If If mode = 2 Then SetBuffer ImageBuffer(tex2) For x = 0 To ImageWidth(tex1)-1 For y = 0 To ImageHeight(tex1)-1 xneu = x+y yneu = (y-x+ImageWidth(tex1)-ImageHeight(tex1))/2 Color pic2(x,y,0),pic2(x,y,1),pic2(x,y,2) Plot xneu+originx,yneu+originy+ImageHeight(tex1)/2 Next Next speichern End If End Function
Function vertikalwest(mode,originx,originy) If mode = 1 Then For x = 0 To 31 For y = 0 To 31 xneu = x yneu = y+(x/2) Color pic(x,y,0),pic(x,y,1),pic(x,y,2) Plot xneu+originx,yneu+originy Next Next End If If mode = 2 Then SetBuffer ImageBuffer(tex2) For x = 0 To ImageWidth(tex1)-1 For y = 0 To ImageHeight(tex1)-1 xneu = x yneu = y+(x/2) Color pic2(x,y,0),pic2(x,y,1),pic2(x,y,2) Plot xneu+originx,yneu+originy Next Next speichern End If End Function
Function vertikalost(mode,originx,originy) If mode = 1 Then For x = 0 To 31 For y = 0 To 31 xneu = x yneu = y-(x/2) Color pic(x,y,0),pic(x,y,1),pic(x,y,2) Plot xneu+originx,yneu+originy Next Next End If If mode = 2 Then SetBuffer ImageBuffer(tex2) For x = 0 To ImageWidth(tex1)-1 For y = 0 To ImageHeight(tex1)-1 xneu = x yneu = y-(x/2)+(ImageWidth(tex1)-1)/2 Color pic2(x,y,0),pic2(x,y,1),pic2(x,y,2) Plot xneu+originx,yneu+originy Next Next speichern End If End Function
Function bergost(mode,originx,originy) If mode = 1 Then For x = 0 To 31 For y = 0 To 31 xneu = x+y yneu = (y-2*x)/2 Color pic(x,y,0),pic(x,y,1),pic(x,y,2) Plot xneu+originx,yneu+originy+32 If y Mod 2 Then Plot xneu+originx,yneu+originy+33 Next Next End If If mode = 2 Then SetBuffer ImageBuffer(tex2) For x = 0 To ImageWidth(tex1) For y = 0 To ImageHeight(tex1) xneu = x+y yneu = (y-2*x)/2+ImageWidth(tex1)-1 Color pic2(x,y,0),pic2(x,y,1),pic2(x,y,2) If y < ImageHeight(tex1)-1 Then Plot xneu+originx,yneu+originy If y < ImageHeight(tex1)-2 And y Mod 2 Then Plot xneu+originx,yneu+originy+1 Next Next speichern End If End Function
Function bergwest(mode,originx,originy) If mode = 1 Then For x = 0 To 31 For y = 0 To 31 xneu = x+y yneu = (2*y-x)/2 Color pic(x,y,0),pic(x,y,1),pic(x,y,2) Plot xneu+originx,yneu+originy+16 If x Mod 2 Then Plot xneu+originx,yneu+originy+17 Next Next End If If mode = 2 Then SetBuffer ImageBuffer(tex2) For x = 0 To ImageWidth(tex1) For y = 0 To ImageHeight(tex1) xneu = x+y yneu = (2*y-x)/2 Color pic2(x,y,0),pic2(x,y,1),pic2(x,y,2) Plot xneu+originx,yneu+originy+ImageHeight(tex1)/2 If x Mod 2 Then Plot xneu+originx,yneu+originy+ImageHeight(tex1)/2+1 Next Next speichern End If End Function
Function talost(mode,originx,originy) If mode = 1 Then For x = 0 To 31 For y = 0 To 31 xneu = x+y yneu = y/2 Color pic(x,y,0),pic(x,y,1),pic(x,y,2) Plot xneu+originx,yneu+originy Next Next End If If mode = 2 Then SetBuffer ImageBuffer(tex2) For x = 0 To ImageWidth(tex1)-1 For y = 0 To ImageHeight(tex1)-1 xneu = x+y yneu = (y-ImageWidth(tex1))/2 Color pic2(x,y,0),pic2(x,y,1),pic2(x,y,2) Plot xneu+originx,yneu+originy+ImageHeight(tex1)/2 Next Next speichern End If End Function
Function talwest(mode,originx,originy) If mode = 1 Then For x = 0 To 31 For y = 0 To 31 xneu = x+y yneu = (32-x)/2 Color pic(x,y,0),pic(x,y,1),pic(x,y,2) Plot xneu+originx,yneu+originy Next Next End If If mode = 2 Then SetBuffer ImageBuffer(tex2) For x = 0 To ImageWidth(tex1)-1 For y = 0 To ImageHeight(tex1)-1 xneu = x+y yneu = (x-ImageWidth(tex1))/2 Color pic2(x,y,0),pic2(x,y,1),pic2(x,y,2) Plot xneu+originx,yneu+originy+ImageHeight(tex1)/2 Next Next speichern End If End Function
|