PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

TEXTUR-CONTEST: ZeichneTextur()

https://www.purebasic.fr/german/viewtopic.php?t=15743

Seite 2 von 4

Verfasst: 16.02.2008 17:22
von Xaby
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. :mrgreen:

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 :oops:

Verfasst: 16.02.2008 17:23
von Kaeru Gaman
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

Verfasst: 16.02.2008 17:32
von STARGÅTE
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

Verfasst: 16.02.2008 17:36
von dllfreak2001
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

Verfasst: 16.02.2008 17:39
von Xaby

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 :o

Verfasst: 16.02.2008 17:56
von Xaby
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 :?

Verfasst: 16.02.2008 18:59
von dllfreak2001
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

Verfasst: 16.02.2008 19:05
von dllfreak2001
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

Verfasst: 16.02.2008 19:46
von Xaby
Jetzt hab ich auch eins, was ein bisschen Zeit braucht :shock:

Aber ich erzeuge auch gleich 256 verschiedene Texturen

Der Codel ist etwas abgeändert. Ist kein Regelverstoß :roll:
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

Verfasst: 16.02.2008 20:21
von Xaby
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
Alle Zeiten sind UTC+02:00
Seite 2 von 4

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de