TEXTUR-CONTEST: ZeichneTextur()

Xaby · Beitrag von **Xaby** » 16.02.2008 17:22

Ich hab ja auch nicht gesagt, dass Stargates Textur schlecht ist, sie gefällt mir auch prima. Aber nicht drauf ausruhen.

Code: Alles auswählen

Procedure ZeichneTextur()

;/ Optional 
Protected i, i2, ix,k, R, G, B

ix=ImageWidth(0)


  StartDrawing(ImageOutput(0))

  

     ;/ QUELLCODE: Beispiel
       For k=0 To 3
       For i=0 To ix/5
        For i2=0 To i
          If k%2=1
            B=4*i+i2 
            G=k*i2-k*i         
          Else
            R=4*i+i2
            G=i2
          EndIf          
          Circle(ix-i*4-30+14*(k+k)+Sin(i),ix-i*4+20-10*k-Sin(i2),k*8-i2-i/4,RGB(R,G,B))
        Next 
       Next   
       Next
       

     ;/

  StopDrawing()
EndProcedure

Mal ein Beispiel für Abstrackte Kunst.

Für die Möglichkeit, die Kanten an einander zu fügen, kann man folgendes machen:

- Das #Image nehmen, einmal Spiegel und daneben setzen
- und beide zusammen noch mal horizontal spiegeln und drunter setzen

>>> Wäre cool, wenn da jemand einen schnellen Code für hat
Irgendwas mit *Buffer vielleicht

Kaeru Gaman · Beitrag von **Kaeru Gaman** » 16.02.2008 17:23

so, hier is mein beitrag...

Code: Alles auswählen

EnableExplicit


#TextureWidth=128 ; Möglich 32, 64, 128, 256, 512


CreateImage(0,#TextureWidth,#TextureWidth) 
CreateImage(1,1024,1024) 


Procedure ZeichneTextur()

  Protected n, col

  StartDrawing(ImageOutput(0))

    For n=0 To 63
      col = RGB(0, 128-2*n, 255-3*n)
      Line(     0,     n, 64-n, 64-n, col)
      Line(     n,     0, 64-n, 64-n, col)
      Line(     0, 127-n, 64-n,-64+n, col)
      Line(     n, 127  , 64-n,-64+n, col)
      Line( 127  ,     n,-64+n, 64-n, col)
      Line( 127-n,     0,-64+n, 64-n, col)
      Line( 127  , 127-n,-64+n,-64+n, col)
      Line( 127-n, 127  ,-64+n,-64+n, col)
    Next
       
  StopDrawing()
EndProcedure

Procedure ZeichneTexturen()
Protected i, i2
  StartDrawing(ImageOutput(1))
    For i2=0 To ImageHeight(1)/ImageHeight(0)-1
      For i=0 To ImageWidth(1)/ImageWidth(0)-1
        DrawImage(ImageID(0),ImageWidth(0)*i,ImageHeight(0)*i2)
      Next
    Next
  StopDrawing()
EndProcedure

Procedure createGadgets()
  ImageGadget(0,5,5,ImageWidth(0),ImageHeight(0),ImageID(0),#PB_Image_Border)
  ScrollAreaGadget(1,GadgetX(0)+GadgetWidth(0)+5,5,WindowWidth(0)-GadgetWidth(0)-15,650,1124,1124,10)
    ImageGadget(2,5,5,ImageWidth(1),ImageHeight(1),ImageID(1),#PB_Image_Border)
  CloseGadgetList()
EndProcedure

If OpenWindow(0,0,0,1000,700,"FL Bild",#PB_Window_ScreenCentered | #PB_Window_SystemMenu) And CreateGadgetList(WindowID(0))
  createGadgets()
  ZeichneTextur()
  ZeichneTexturen()
  SetGadgetState(0,ImageID(0))
  SetGadgetState(2,ImageID(1))
  Define Event.l, Quit, GadgetNr
 
  Repeat
    Event=WaitWindowEvent()
    If Event=16
      Quit=1
    ElseIf Event=#PB_Event_Gadget
      GadgetNr=EventGadget()   
    EndIf   
  Until Quit 
EndIf

STARGÅTE · Beitrag von **STARGÅTE** » 16.02.2008 17:32

ja gut dann halt das hier ohne Random

Code: Alles auswählen

;/ Folker Linstedt 
;/ 2008-02-16 
;/ PureBaic Textur-Contest 

EnableExplicit 


#TextureWidth=128 ; Möglich 32, 64, 128, 256, 512 


CreateImage(0,#TextureWidth,#TextureWidth)  
CreateImage(1,1024,1024)  

Macro Wisch()
 F(0) = Point(x,y)
 If x > 0 : F(1) = Point(x-1,y) : Else : F(1)=F(0) : EndIf
 If y > 0 : F(2) = Point(x,y-1) : Else : F(2)=F(0) : EndIf
 If x < xx-1 : F(3) = Point(x+1,y) : Else : F(3)=F(0) : EndIf
 If y < yy-1 : F(4) = Point(x,y+1) : Else : F(4)=F(0) : EndIf
 FarbeR=0:FarbeG=0:FarbeB=0
 For i2 = 0 To 4
  FarbeR + Red(F(i2))
  FarbeG + Green(F(i2))
  FarbeB + Blue(F(i2))
 Next
 Plot(x,y, RGB(FarbeR/5, FarbeG/5, FarbeB/5))
EndMacro

Procedure ZeichneTextur() 
 Protected i, i2, xx, yy, grau, x, y,FarbeR,FarbeG,FarbeB, ix,iy,q
 Dim F(4)
  xx = ImageWidth(0)
  yy = ImageHeight(0)

  StartDrawing(ImageOutput(0)) 
  
   DrawingMode(4)
   For iy = 0 To xx
    For ix = 0 To yy
     q = Cos(ix*iy)*5+6 
     i = Pow(ix*ix-iy*iy,2)/q
     FarbeR = 80+Sin(i/10)*80
     FarbeG = 120+Sin(i/10)*120
     FarbeB = 192+Sin(i/10)*32
     Box(ix-1, iy-1, ix%32, iy%32, RGB(FarbeR, FarbeG,FarbeB))
    Next ix
   Next iy
   For y = 1 To xx-1
    For x = 1 To yy-1
     Wisch()
    Next x
   Next y

  StopDrawing() 
EndProcedure 

Procedure ZeichneTexturen() 
Protected i, i2 
  StartDrawing(ImageOutput(1)) 
    For i2=0 To ImageHeight(1)/ImageHeight(0)-1 
      For i=0 To ImageWidth(1)/ImageWidth(0)-1 
        DrawImage(ImageID(0),ImageWidth(0)*i,ImageHeight(0)*i2) 
      Next 
    Next 
  StopDrawing() 
EndProcedure 




Procedure createGadgets() 
  ImageGadget(0,5,5,ImageWidth(0),ImageHeight(0),ImageID(0),#PB_Image_Border) 
  ScrollAreaGadget(1,GadgetX(0)+GadgetWidth(0)+5,5,WindowWidth(0)-GadgetWidth(0)-15,650,1124,1124,10) 
    ImageGadget(2,5,5,ImageWidth(1),ImageHeight(1),ImageID(1),#PB_Image_Border) 
  
  CloseGadgetList() 
EndProcedure 


If OpenWindow(0,0,0,1000,700,"FL Bild",#PB_Window_ScreenCentered | #PB_Window_SystemMenu) And CreateGadgetList(WindowID(0)) 
  
  createGadgets() 
  ZeichneTextur() 
  ZeichneTexturen() 
  
  SetGadgetState(0,ImageID(0)) 
  SetGadgetState(2,ImageID(1)) 
  
  
  Define Event.l, Quit, GadgetNr 
  
  
  Repeat 
    
    Event=WaitWindowEvent() 
    
    If Event=16 
      Quit=1 
      
    ElseIf Event=#PB_Event_Gadget 
      GadgetNr=EventGadget()    
      
      
    EndIf    
    
    
  Until Quit  
  
  
EndIf

PS: an dieser stelle hier:

Code: Alles auswählen

     q = Cos(ix*iy)*5+6 
     i = Pow(ix*ix-iy*iy,2)/q

könnte ihr selber mal spielen, da entstehe coole sachen

Oder mal das hier einsetzten:

Code: Alles auswählen

Procedure ZeichneTextur() 
 Protected i, i2, xx, yy, grau, x, y,FarbeR,FarbeG,FarbeB, ix,iy,q
 Dim F(4)
  xx = ImageWidth(0)
  yy = ImageHeight(0)

  StartDrawing(ImageOutput(0)) 
  
   DrawingMode(4)
   For iy = 0 To xx
    For ix = 0 To yy
     i = ix*iy/q
     FarbeR = 80+Sin(i*#PI/xx*4)*80
     FarbeG = 120+Sin(i*#PI/xx*4)*120
     FarbeB = 192+Sin(i*#PI/xx*4)*32
     Box(ix-1, iy-1, ix%32, iy%32, RGB(FarbeR, FarbeG,FarbeB))
    Next ix
   Next iy
   For y = 1 To xx-1
    For x = 1 To yy-1
     Wisch()
    Next x
   Next y

  StopDrawing() 
EndProcedure

dllfreak2001 · Beitrag von **dllfreak2001** » 16.02.2008 17:36

Jetzt mal nen bißchen Moire

Code: Alles auswählen

EnableExplicit 


#TextureWidth=128 ; Möglich 32, 64, 128, 256, 512 


CreateImage(0,#TextureWidth,#TextureWidth) 
CreateImage(1,1024,1024) 


Procedure ZeichneTextur() 

Protected x,y 

  StartDrawing(ImageOutput(0)) 

    For x = 0 To 127 : For y = 0 To 127
      Plot(x,y,RGB(128+Sin(x*y/20)*(127-y),128+Sin(x*y/20)*(127-x),128+Sin(x*y/20)*127))
      
    Next:Next
    
    

        
  StopDrawing() 
EndProcedure 

Procedure ZeichneTexturen() 
Protected i, i2 
  StartDrawing(ImageOutput(1)) 
    For i2=0 To ImageHeight(1)/ImageHeight(0)-1 
      For i=0 To ImageWidth(1)/ImageWidth(0)-1 
        DrawImage(ImageID(0),ImageWidth(0)*i,ImageHeight(0)*i2) 
      Next 
    Next 
  StopDrawing() 
EndProcedure 




Procedure createGadgets() 
  ImageGadget(0,5,5,ImageWidth(0),ImageHeight(0),ImageID(0),#PB_Image_Border) 
  ScrollAreaGadget(1,GadgetX(0)+GadgetWidth(0)+5,5,WindowWidth(0)-GadgetWidth(0)-15,650,1124,1124,10) 
    ImageGadget(2,5,5,ImageWidth(1),ImageHeight(1),ImageID(1),#PB_Image_Border) 
  
  CloseGadgetList() 
EndProcedure 


If OpenWindow(0,0,0,1000,700,"FL Bild",#PB_Window_ScreenCentered | #PB_Window_SystemMenu) And CreateGadgetList(WindowID(0)) 
  
  createGadgets() 
  ZeichneTextur() 
  ZeichneTexturen() 
  
  SetGadgetState(0,ImageID(0)) 
  SetGadgetState(2,ImageID(1)) 
  
  
  Define Event.l, Quit, GadgetNr 
  
  
  Repeat 
    
    Event=WaitWindowEvent() 
    
    If Event=16 
      Quit=1 
      
    ElseIf Event=#PB_Event_Gadget 
      GadgetNr=EventGadget()    
      
      
    EndIf    
    
    
  Until Quit 
  
  
EndIf

Xaby · Beitrag von **Xaby** » 16.02.2008 17:39

Code: Alles auswählen

Procedure ZeichneTextur()

;/ Optional 
Protected i, i2, ix,k,f, R, G, B, x, y,u

ix=ImageWidth(0)


  StartDrawing(ImageOutput(0))

  

     ;/ QUELLCODE: Beispiel
     For y=0 To ix
        For x=0 To ix
          R=Round(Cos(y/(5*x+y))*100,0)
          G=Round(Sin(x/(5*y+x))*200,0)
          B=x
          F=RGB(G,G,G)
            
          Plot(x,y,f)                   
        Next        
     Next
     
     u=5
     
     For y=0 To 18
       For x=0 To 18
         For i=0 To 5           
           B=15*(i+1)
           F=RGB(B,B,B)
           Circle(u+x*9,u+y*9,6-i,F)
         Next     
       Next     
     Next
       

     ;/

  StopDrawing()
EndProcedure

Könnt ja mal mit Kugelgröße und Abstand ein bisschen rumspielen

Xaby · Beitrag von **Xaby** » 16.02.2008 17:56

Drops

Code: Alles auswählen

Procedure ZeichneTextur()

;/ Optional 
Protected i, i2, ix,k,f, R, G, B, x, y,u

ix=ImageWidth(0)


  StartDrawing(ImageOutput(0))

  

     ;/ QUELLCODE: Beispiel
     
  For i=0 To 40
    R=i
    F=RGB(R,R,R)
    Circle(64,64,80-i,F)  
  Next   
     
  
  While i<1300
     i+1     
    
       x+1
       y+1
       If y>ix
         y=0
         i2+1
         x=i2*4
       EndIf
       R=255-x
       F=RGB(R,G,B)
       Plot(x,y,F)         
  Wend   
  
  For i=0 To 20
    R=2*i
    F=RGB(R,R,R)
    Circle(64,64,40-i,F)  
  Next   
       

     ;/

  StopDrawing()
EndProcedure

Schon keine Lust mehr, oder werkelt ihr an einem van Gogh?

Was ist mit Stahlnieten? Holzmaserung? Plüsch? Kochender Lava ...
Nebelwolken. Oder Backsteine

dllfreak2001 · Beitrag von **dllfreak2001** » 16.02.2008 18:59

Ado Goldkante

Code: Alles auswählen


Procedure ZeichneTextur() 


Protected imw.l, x.l, y.l

imw=ImageWidth(0) 


  StartDrawing(ImageOutput(0)) 
  For x = 0 To imw-1:For y = 0 To imw-1
    Plot(x,y,RGB(128+Sin(y/(y+1))*63 + Sin(y/(x+1))*63 ,128+Sin(x/(y+1))*127,0))
  Next:Next

  StopDrawing() 
EndProcedure

dllfreak2001 · Beitrag von **dllfreak2001** » 16.02.2008 19:05

Der Vorhang

Code: Alles auswählen

Procedure ZeichneTextur() 


Protected imw.l, x.l, y.l

imw=ImageWidth(0) 


  StartDrawing(ImageOutput(0)) 
  For x = 0 To imw-1:For y = 0 To imw-1
    Plot(x,y,RGB(ATan(x/y/3)*122,0,20))
  Next:Next
  
  For x = 0 To imw-1:For y = 0 To imw-1
    Plot(x,y,Point(x,y)+Abs(Sin(x/2/#PI)*22))
    
  Next:Next


  StopDrawing() 
EndProcedure

Xaby · Beitrag von **Xaby** » 16.02.2008 19:46

Jetzt hab ich auch eins, was ein bisschen Zeit braucht

Aber ich erzeuge auch gleich 256 verschiedene Texturen

Der Codel ist etwas abgeändert. Ist kein Regelverstoß

Denn man könnte den Parameter ja auch festsetzen, ich konnte mich einfach nicht entscheiden, welches ich Präsentieren wollte.
Im Code könnt ihr auch einen Drobs/Klecks hinzufügen, dadurch bekommt man eine bessere Vorstellung, wie meine Textur vielleicht an einer Tür mit Knopf, einer Schachtel aus Holz, etc. Verwendung finden kann.

Code: Alles auswählen

;/ Folker Linstedt
;/ 2008-02-16
;/ PureBaic Textur-Contest

EnableExplicit


#TextureWidth=128 ; Möglich 32, 64, 128, 256, 512


CreateImage(0,#TextureWidth,#TextureWidth)  
CreateImage(1,1024,1024)  


Procedure ZeichneTextur(u)

;/ Optional 
Protected i, i2, ix,k,f, R, G, B, x.f, y.f, RichtungX.f=1.2, RichtungY.f=1.8

ix=ImageWidth(0)


  StartDrawing(ImageOutput(0))

  

     ;/ QUELLCODE: Beispiel
     
  For i=0 To 40
    R=i
    F=RGB(R,R,R)
    Circle(64,64,80-i,F)  
  Next   
     
  
  x=10
  y=40
    
  While i<14000
     i+1     
    
    x+RichtungX
    y+RichtungY
    

     
    If y>(ix-1) Or y<1
      RichtungY*(-1)         
    EndIf   
    If x>(ix-1) Or x<1
      RichtungX*(-1)         
    EndIf       
    
       
       R=255-x
       R+(i%56) ;/ Ausfranselfaktor
       
       If R>255 ;/ OHNE Überprüfung franselt das rot links aus und es sieht aus wie FLAMMEN ;-)
         R-2*(i%56)
       EndIf
       
       F=RGB(R,0,0) ; Rot wie blut
       F=RGB(0,R/2,0) ;/ geht als GRAS durch ;-)
       
       F=RGB(R*0.8,R/2.5,20) ;/ FARBE der Struktur, hier das Beispiel für KASTANIE ;-)
       
       ; 
              ;F=RGB(40,128-R/2,R) ; Versuch mit blau/lila
       
       
   If i%U=3  
     Circle(x,y,2,F)
   EndIf
    
    If i%U=0  ;/ relevant für die ersten 3 Texturen, danach leichter blauer Schimmer
     Box(x,y,1,2,RGB(i/255,128-R/2,255-R))
    EndIf 
     
  Wend   
  
  For i=0 To 20
    R=4*i
    F=RGB(R,R,R)
   ; Circle(64,64+i,22-i,F)  ;/ Macht KLECKS in die Mitte
  Next   
       

     ;/

  StopDrawing()
EndProcedure



Procedure ZeichneTexturen()
Protected i, i2, u=1 
    For i2=0 To ImageHeight(1)/ImageHeight(0)-1
      For i=0 To ImageWidth(1)/ImageWidth(0)-1
         ZeichneTextur(u)
         StartDrawing(ImageOutput(1))
           DrawImage(ImageID(0),ImageWidth(0)*i,ImageHeight(0)*i2)
         StopDrawing()
         u+1
      Next
    Next  
EndProcedure


Procedure createGadgets()
  ImageGadget(0,5,5,ImageWidth(0),ImageHeight(0),ImageID(0),#PB_Image_Border)
  ScrollAreaGadget(1,GadgetX(0)+GadgetWidth(0)+5,5,WindowWidth(0)-GadgetWidth(0)-15,650,1124,1124,10)
    ImageGadget(2,5,5,ImageWidth(1),ImageHeight(1),ImageID(1),#PB_Image_Border)
  
  CloseGadgetList()
EndProcedure


If OpenWindow(0,0,0,1000,700,"FL Bild",#PB_Window_ScreenCentered | #PB_Window_SystemMenu) And CreateGadgetList(WindowID(0))
  
  createGadgets() 
  ZeichneTextur(1)
  ZeichneTexturen()
  
  SetGadgetState(0,ImageID(0))
  SetGadgetState(2,ImageID(1))
  
  
  Define Event.l, Quit, GadgetNr
  
  
  Repeat
    
    Event=WaitWindowEvent()
    
    If Event=16
      Quit=1
      
    ElseIf Event=#PB_Event_Gadget
      GadgetNr=EventGadget()    
      
      
    EndIf   
    
    
  Until Quit  
  
  
EndIf

Xaby · Beitrag von **Xaby** » 16.02.2008 20:21

Jeder zweite hat einen Drops und das Holz wurde noch mal verfeinert

Code: Alles auswählen

;/ Folker Linstedt
;/ 2008-02-16
;/ PureBaic Textur-Contest

EnableExplicit


#TextureWidth=128 ; Möglich 32, 64, 128, 256, 512


CreateImage(0,#TextureWidth,#TextureWidth)  
CreateImage(1,1024,1024)  


Procedure ZeichneTextur(u,Drops=1)

;/ Optional 
Protected i, i2, ix,k,f, R, G, B, x.f, y.f, RichtungX.f=1.2, RichtungY.f=0.7







ix=ImageWidth(0)


  StartDrawing(ImageOutput(0))

  ;Box(0,0,128,128,RGB(255,128,0)) ;/ OHNE BOX gibt es in den hinteren Texturen abgerundete ECKEN, die durch den anschließenden Kreis herrühren

     ;/ QUELLCODE: Beispiel
     
  For i=0 To 40
    R=i
    F=RGB(R,R/2,R/4)
    Circle(64,64,80-i,F)  ;/ Macht runde Ecke und löscht das Bild, wenn BOX fehlt
  Next   
     
  
  x=10
  y=40
    
  While i<10000
     i+1     
    
    x+RichtungX
    y+RichtungY
    
   ; RichtungX-0.02

     
    If y>(ix-1) Or y<1
      RichtungY*(-1)         
    EndIf   
    If x>(ix-1) Or x<1
      RichtungX*(-1)         
    EndIf       
    
       
       R=255-x
       R+(i%56) ;/ Ausfranselfaktor
       
       If R>255 ;/ OHNE Überprüfung franselt das rot links aus und es sieht aus wie FLAMMEN ;-)
         R-2*(i%56)
       EndIf
       
       F=RGB(R,0,0) ; Rot wie blut
       F=RGB(0,R/2,0) ;/ geht als GRAS durch ;-)
       
       F=RGB(R*0.8,R/2.5,20) ;/ FARBE der Struktur, hier das Beispiel für KASTANIE ;-)
       
       ; 
              ;F=RGB(40,128-R/2,R) ; Versuch mit blau/lila
       
     
    If i%(U+1)=0  
     Circle(x,y,2,F)
     Box(x,y,1,2,RGB(R/1.2,R/2,R/3.5))
    EndIf 
     
  Wend   
  
  
  If Drops
  For i=0 To 20
    R=4*i
    F=RGB(R,R,R)
    Circle(64,64+i,22-i,F)  ;/ Macht KLECKS in die Mitte
  Next   
  EndIf
       

     ;/

  StopDrawing()
EndProcedure



Procedure ZeichneTexturen()
Protected i, i2, a=1, k=0 
    For i2=0 To ImageHeight(1)/ImageHeight(0)-1
      For i=0 To ImageWidth(1)/ImageWidth(0)-1
         ZeichneTextur(a,i%2)
         StartDrawing(ImageOutput(1))
           DrawImage(ImageID(0),ImageWidth(0)*i,ImageHeight(0)*i2)
         StopDrawing()
         If k=1 
          a+1
          k=-1        
         EndIf
         k+1 
      Next
    Next  
EndProcedure


Procedure createGadgets()
  ImageGadget(0,5,5,ImageWidth(0),ImageHeight(0),ImageID(0),#PB_Image_Border)
  ScrollAreaGadget(1,GadgetX(0)+GadgetWidth(0)+5,5,WindowWidth(0)-GadgetWidth(0)-15,650,1124,1124,10)
    ImageGadget(2,5,5,ImageWidth(1),ImageHeight(1),ImageID(1),#PB_Image_Border)
  
  CloseGadgetList()
EndProcedure


If OpenWindow(0,0,0,1000,700,"FL Bild",#PB_Window_ScreenCentered | #PB_Window_SystemMenu) And CreateGadgetList(WindowID(0))
  
  createGadgets() 
  ZeichneTextur(1)
  ZeichneTexturen()
  
  SetGadgetState(0,ImageID(0))
  SetGadgetState(2,ImageID(1))
  
  
  Define Event.l, Quit, GadgetNr
  
  
  Repeat
    
    Event=WaitWindowEvent()
    
    If Event=16
      Quit=1
      
    ElseIf Event=#PB_Event_Gadget
      GadgetNr=EventGadget()    
      
      
    EndIf   
    
    
  Until Quit  
  
  
EndIf