BlitzBasic
>
Codearchiv
> Komplettprogramme/Spiele
Aktuallisiert 30.05.2009
Isometriekonverter
- von Triton
Folgendes Programm wandelt ein normales 2D-Bild 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.
;** normal2iso Konverter ;** 2004 by Triton ;** http://www.silizium-net.de 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") ;<---------------Bild-Adresse 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 ;Bildchen für Auswahl erstellen 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) ;Normaltextur einlesen 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 ;rauf End If If auswahl < 7 Then If KeyHit(208) Then auswahl=auswahl+1 ;runter 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