PaintImage()

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
User avatar
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

PaintImage()

Post by MaGetzUb » Sun Oct 25, 2009 5:45 pm

Tein tällaisen funktion ihan vain huvikseni. Tämän funktion tarkoituksena on paintata toinen kuva toisen kuvan väreillä.
EDIT:

Lisäsin ominaisuuden, että kun funktiossa ollaan käyty vaakasuora rivi läpi niin kasvatetaan lukemis paikkaa image2:a, josta otetaan ns. korvaava pikseli.

Code: Select all

SCREEN 400,300
map = LoadImage("Media\Map.BMP")
gradient = LoadImage("Media\Grass.BMP") 'vaihda media\grass.bmp tilalle media\life.jpg
ni = PaintImage(map,gradient)
Repeat 
DrawImage ni,0,0
DrawScreen
Forever 

SCREEN 400,300
map = LoadImage("Media\Map.BMP")
gradient = LoadImage("Media\Grass.BMP") 'vaihda media\grass.bmp tilalle media\life.jpg
ni = PaintImage(map,gradient)
Repeat
DrawImage ni,0,0
DrawScreen
Forever

Function PaintImage(image1,image2,riviscroll = 1)
iw# = ImageWidth(image1)
ih# = ImageHeight(image1)

iw2# = ImageWidth(image2)
img = MakeImage(Int(iw),Int(ih))

Lock Image(image1)
    DrawToImage img
        For i = 0 To iw-1
            For j = 0 To ih-1
            PickImageColor2 image1,i,j
            keskiarvo = (getRGB(1) + getRGB(2) + getRGB(3))/3
            DrawImageBox image2,i,j,Int(iw2/255*keskiarvo),rivi,1,1
            Next j
            If riviscroll Then 
                rivi = rivi + 1
                If rivi => ImageHeight(image2) Then rivi = 0
            EndIf     
        Next i
    DrawToScreen
Unlock Image(image1)
Return img
EndFunction 
Last edited by MaGetzUb on Sun Nov 01, 2009 1:08 am, edited 6 times in total.
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
Valtzu
Active Member
Posts: 115
Joined: Sun Aug 26, 2007 2:40 pm
Location: Sauvo
Contact:

Re: PaintImage()

Post by Valtzu » Sun Oct 25, 2009 5:55 pm

Mavia pukkaa. Muista ne iw-1 ja ih-1.

User avatar
otto90x
Advanced Member
Posts: 349
Joined: Mon Aug 27, 2007 9:00 pm
Location: Lapinjärvi, Finland
Contact:

Re: PaintImage()

Post by otto90x » Sun Oct 25, 2009 8:12 pm

Aika jännä funktio, mutta esimerkin kuvat oli auttamatta huonot. Teinpä esimerkin jossa funktiota käytetään korkeuskarttojen värittämisessä.

Code: Select all

iteraatioita = 8
taulukoko = 2^iteraatioita

SCREEN Int(taulukoko*3),Int(taulukoko*3)

Dim taulu(0, 0) As Float

cslide = Colorslideimage("10;0,0,30 0,0,80 0,80,150 0,115,255 252,248,82 80,230,30 50,157,13 35,100,03 80,114,20 111,84,57 73,67,65 120,124,122 166,164,164 255,255,255")

SetWindow "Korkeuskartan luonti, piirto ja väritys -ohjelma. Paina Enteriä luodaksesi uuden korkeuskartan."

Repeat

    If KeyDown(cbkeyreturn) Then 
    
        ds2(Rnd(70.0),Rnd(70.0),Rnd(70.0),Rnd(70.0), iteraatioita, 255.0, 0.60)
        
        If img Then DeleteImage img : img = 0

        Img = MakeImage(taulukoko,taulukoko)
    
        DrawToImage img
            For y = 0 To taulukoko-1
                For x = 0 To taulukoko-1
                    c = Min(Max(taulu(x, y),0),255)
        
                    Color c,c,c
                    Dot x,y
                Next x
            Next y
        
        DrawToScreen
        
        tempimg = PaintImage(img,cslide)
        
        If img Then DeleteImage img : img = 0
        
        img = scaleimage(tempimg,ScreenWidth(),ScreenHeight())
       
    EndIf
    
    If img Then DrawImage img,0,0
    
    DrawScreen
    
Until KeyHit(cbkeyexit)

//DiamondSquare3d by m1c
Function ds2(s1#, s2#, s3#, s4#, it, roughness#, multiplier#)
    side = 2 ^ it                  //koko höskän sivun pituus

    ReDim taulu(side, side)        //muutetaan taulun koko (ja tyhjennetään)

    taulu(0, 0)      = s1#        //asetetaan nurkat
    taulu(side, 0)    = s2#
    taulu(0, side)    = s3#
    taulu(side, side) = s4#

    block = side                  //osan koko joka prosessoidaan
    For i = 1 To it
        y = 0
        While(y < side)
            x = 0
            While(x < side)
                //TIMANGI
                taulu(x + block / 2, y + block / 2) = (taulu(x, y) + taulu(x, y + block) + taulu(x + block, y) + taulu(x + block, y + block)) / 4

                //NELIÖ
                taulu(x + block / 2, y)        = (taulu(x, y) +  (y - block / 2 >= 0) * taulu(x + block / 2, Int(Max(0, y - block / 2))) + taulu(x + block, y) +  taulu(x + block / 2, y + block / 2))                            / (3 + (y - block / 2 >= 0))      + Rnd(-roughness#, roughness#)
                taulu(x + block, y + block / 2) = (taulu(x + block / 2, y + block / 2) +  taulu(x + block, y) +  (x + 1.5 * block <= side) * taulu(Int(Min(side, x + 1.5 * block)), y + block / 2) + taulu(x + block, y + block))  / (3 + (x + 1.5 * block <= side)) + Rnd(-roughness#, roughness#)
                taulu(x + block / 2, y + block) = (taulu(x, y + block) +  taulu(x + block / 2, y + block / 2) +  taulu(x + block, y + block) +  (y + 1.5 * block <= side) * taulu(x + block / 2, Int(Min(side, y + 1.5 * block))))  / (3 + (y + 1.5 * block <= side)) + Rnd(-roughness#, roughness#)
                taulu(x, y + block / 2)        = ((x - block / 2 >= 0) * taulu(Int(Max(0, x - block / 2)), y + block / 2) + taulu(x, y) +  taulu(x + block / 2, y + block / 2) +  taulu(x, y + block))                            / (3 + (x - block / 2 >= 0))      + Rnd(-roughness#, roughness#)

                x = x + block      //siirrytään osasen verran äksällä
            Wend

            y = y + block          //siirrytään osasen verran yyllä
        Wend

        roughness# = roughness# * multiplier#  //vähennetään terävyyttä iteraation mukaan
        block = block / 2          //osa on puolet edellisen iteraation vastaavasta

    Next i

    Return 1                      //miks ei voi olla palauttamatta mitää? :(

End Function


Function ScaleImage(_image, _width, _height)

   gScaledImage = MakeImage(_width, _height)
   
   _image_width = ImageWidth(_image)
   _image_height= ImageHeight(_image)
   
   // Tehdään temppikuva johon skaalataan ensin vain leveys
   lTempImage = MakeImage(_width, ImageHeight(_image))
   DrawToImage lTempImage
   For x = 0 To _width - 1
      sx# = Float(_image_width) / Float(_width) * Float(x)
      DrawImageBox _image, x, 0, sx, 0, 1, _image_height, OFF,OFF
   Next x
   lTempImage_width = ImageWidth(lTempImage)
   DrawToScreen
   
   // Skaalataan myös pystysuunnassa
   DrawToImage gScaledImage
   For y = 0 To _height - 1
      sy# = Float(_image_height) / Float(_height) * Float(y)
      DrawImageBox lTempImage, 0, y, 0, sy, lTempImage_width, 1, OFF,OFF
   Next y
   DrawToScreen
   DeleteImage lTempImage
   
   DeleteImage _image
   
   Return gScaledImage
End Function


Function PaintImage(image1,image2)
    iw# = ImageWidth(image1)
    ih# = ImageHeight(image1)
    
    iw2# = ImageWidth(image2)
    img = MakeImage(Int(iw),Int(ih))
    
    Lock Image(image1)
        DrawToImage img
            For i = 0 To iw-1
                For j = 0 To ih-1
                PickImageColor2 image1,i,j
                keskiarvo# = Float(getRGB(1) + getRGB(2) + getRGB(3))/3.0
                DrawImageBox image2,i,j,Int(( Float(iw2-1)*keskiarvo#)/255.0),0,1,1
                Next j
            Next i
        DrawToScreen
    Unlock Image(image1)
    Return img
EndFunction 


Function ColorslideImage(dat$="10;255,255,255 0,0,0")
    
    dotspercolor#=Float(GetWord(dat$,1,";"))
    
    colors = Int(CountWords(dat$))
    
    IMG = MakeImage(int((colors-1)*dotspercolor),1)
    
    DrawToImage img
    
    colordat$ = GetWord(GetWord(dat$,2,";"),(i+1)," ")
        
    r# = Float(GetWord(colordat$,1,","))
    g# = Float(GetWord(colordat$,2,","))
    b# = Float(GetWord(colordat$,3,","))

    For i=0 To colors-2
    
        nextcolordat$ = GetWord(GetWord(dat$,2,";"),(i+2)," ")
        
        newr# = Float(GetWord(nextcolordat$,1,","))
        newg# = Float(GetWord(nextcolordat$,2,","))
        newb# = Float(GetWord(nextcolordat$,3,","))
        
        For o=0 To Int(dotspercolor)-1
            
            cr = Int(r#*(dotspercolor#-1.0-Float(o))/dotspercolor#+newr#*Float(o)/dotspercolor)
            cg = Int(g#*(dotspercolor#-1.0-Float(o))/dotspercolor#+newg#*Float(o)/dotspercolor)
            cb = Int(b#*(dotspercolor#-1.0-Float(o))/dotspercolor#+newb#*Float(o)/dotspercolor)
            
            Color cr,cg,cb
            
            Dot o+i*dotspercolor,0
        
        Next o

        colordat$ = nextcolordat$
        r# = newr#
        g# = newg#
        b# = newb#
    
    Next i 

    DrawToScreen
    
    Return img

End Function 
Vuoristojen juurilla on ehkä vähän huono väritys, mutta en oikein löytänyt sopivaa sävyä.
Last edited by otto90x on Sun Oct 25, 2009 8:59 pm, edited 1 time in total.
Otto Martikainen a.k.a. MetalRain, otto90x, kAATOSade.
Runoblogi, vuodatusta ja sekoiluja.

User avatar
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: PaintImage()

Post by MaGetzUb » Sun Oct 25, 2009 8:20 pm

otto90x wrote:Aika jännä funktio, mutta esimerkin kuvat oli auttamatta huonot. Teinpä esimerkin jossa funktiota käytetään korkeuskarttojen värittämisessä.

Code: Select all

SCREEN Int((2^8)*3),Int((2^8)*3)

Dim taulu(0, 0) As Float

taulukoko# = 256.0

boxsize = 4

cslide = Colorslideimage("10;0,0,30 0,0,80 0,80,150 0,115,255 252,248,82 80,230,30 50,157,13 35,100,03 80,114,20 111,84,57 73,67,65 120,124,122 166,164,164 255,255,255")

SetWindow "Korkeuskartan luonti, piirto ja väritys- ohjelma. Paina Enteriä luodaksesi uuden korkeuskartan."

Repeat

    If KeyDown(cbkeyreturn) Then 
    
        ds2(Rnd(70.0),Rnd(70.0),Rnd(70.0),Rnd(70.0), 8, 255.0, 0.60)
        
        If img Then DeleteImage img : img = 0

        Img = MakeImage(int(taulukoko#),int(taulukoko#))
    
        DrawToImage img
            For y = 0 To Int(taulukoko#)
                For x = 0 To Int(taulukoko#)
                    c = Min(Max(taulu(x, y),0),255)
        
                    Color c,c,c
                    Dot x,y
                Next x
            Next y
        
        DrawToScreen
        
        tempimg = PaintImage(img,cslide)
        
        If img Then DeleteImage img : img = 0
        
        img = tempimg
        
        img = scaleimage(tempimg,ScreenWidth(),ScreenHeight())
       
    EndIf
    
    If img Then DrawImage img,0,0
    
    DrawScreen
    
Until KeyHit(cbkeyexit)

//DiamondSquare3d by m1c
Function ds2(s1#, s2#, s3#, s4#, it, roughness#, multiplier#)
    side = 2 ^ it                  //koko höskän sivun pituus

    ReDim taulu(side, side)        //muutetaan taulun koko (ja tyhjennetään)

    taulu(0, 0)      = s1#        //asetetaan nurkat
    taulu(side, 0)    = s2#
    taulu(0, side)    = s3#
    taulu(side, side) = s4#

    block = side                  //osan koko joka prosessoidaan
    For i = 1 To it
        y = 0
        While(y < side)
            x = 0
            While(x < side)
                //TIMANGI
                taulu(x + block / 2, y + block / 2) = (taulu(x, y) + taulu(x, y + block) + taulu(x + block, y) + taulu(x + block, y + block)) / 4

                //NELIÖ
                taulu(x + block / 2, y)        = (taulu(x, y) +  (y - block / 2 >= 0) * taulu(x + block / 2, Int(Max(0, y - block / 2))) + taulu(x + block, y) +  taulu(x + block / 2, y + block / 2))                            / (3 + (y - block / 2 >= 0))      + Rnd(-roughness#, roughness#)
                taulu(x + block, y + block / 2) = (taulu(x + block / 2, y + block / 2) +  taulu(x + block, y) +  (x + 1.5 * block <= side) * taulu(Int(Min(side, x + 1.5 * block)), y + block / 2) + taulu(x + block, y + block))  / (3 + (x + 1.5 * block <= side)) + Rnd(-roughness#, roughness#)
                taulu(x + block / 2, y + block) = (taulu(x, y + block) +  taulu(x + block / 2, y + block / 2) +  taulu(x + block, y + block) +  (y + 1.5 * block <= side) * taulu(x + block / 2, Int(Min(side, y + 1.5 * block))))  / (3 + (y + 1.5 * block <= side)) + Rnd(-roughness#, roughness#)
                taulu(x, y + block / 2)        = ((x - block / 2 >= 0) * taulu(Int(Max(0, x - block / 2)), y + block / 2) + taulu(x, y) +  taulu(x + block / 2, y + block / 2) +  taulu(x, y + block))                            / (3 + (x - block / 2 >= 0))      + Rnd(-roughness#, roughness#)

                x = x + block      //siirrytään osasen verran äksällä
            Wend

            y = y + block          //siirrytään osasen verran yyllä
        Wend

        roughness# = roughness# * multiplier#  //vähennetään terävyyttä iteraation mukaan
        block = block / 2          //osa on puolet edellisen iteraation vastaavasta

    Next i

    Return 1                      //miks ei voi olla palauttamatta mitää? :(

End Function


Function ScaleImage(_image, _width, _height)

   gScaledImage = MakeImage(_width, _height)
   
   _image_width = ImageWidth(_image)
   _image_height= ImageHeight(_image)
   
   // Tehdään temppikuva johon skaalataan ensin vain leveys
   lTempImage = MakeImage(_width, ImageHeight(_image))
   DrawToImage lTempImage
   For x = 0 To _width - 1
      sx# = Float(_image_width) / Float(_width) * Float(x)
      DrawImageBox _image, x, 0, sx, 0, 1, _image_height, OFF,OFF
   Next x
   lTempImage_width = ImageWidth(lTempImage)
   DrawToScreen
   
   // Skaalataan myös pystysuunnassa
   DrawToImage gScaledImage
   For y = 0 To _height - 1
      sy# = Float(_image_height) / Float(_height) * Float(y)
      DrawImageBox lTempImage, 0, y, 0, sy, lTempImage_width, 1, OFF,OFF
   Next y
   DrawToScreen
   DeleteImage lTempImage
   
   DeleteImage _image
   
   Return gScaledImage
End Function


Function PaintImage(image1,image2)
    iw# = ImageWidth(image1)
    ih# = ImageHeight(image1)
    
    iw2# = ImageWidth(image2)
    img = MakeImage(Int(iw),Int(ih))
    
    Lock Image(image1)
        DrawToImage img
            For i = 0 To iw-1
                For j = 0 To ih-1
                PickImageColor2 image1,i,j
                keskiarvo# = Float(getRGB(1) + getRGB(2) + getRGB(3))/3.0
                DrawImageBox image2,i,j,Int(( Float(iw2-1)*keskiarvo#)/255.0),0,1,1
                Next j
            Next i
        DrawToScreen
    Unlock Image(image1)
    Return img
EndFunction 


Function ColorslideImage(dat$="10;255,255,255 0,0,0")
    
    dotspercolor#=Float(GetWord(dat$,1,";"))
    
    colors = Int(CountWords(dat$))
    
    IMG = MakeImage(int((colors-1)*dotspercolor),1)
    
    DrawToImage img
    
    colordat$ = GetWord(GetWord(dat$,2,";"),(i+1)," ")
        
    r# = Float(GetWord(colordat$,1,","))
    g# = Float(GetWord(colordat$,2,","))
    b# = Float(GetWord(colordat$,3,","))

    For i=0 To colors-2
    
        nextcolordat$ = GetWord(GetWord(dat$,2,";"),(i+2)," ")
        
        newr# = Float(GetWord(nextcolordat$,1,","))
        newg# = Float(GetWord(nextcolordat$,2,","))
        newb# = Float(GetWord(nextcolordat$,3,","))
        
        For o=0 To Int(dotspercolor)-1
            
            cr = Int(r#*(dotspercolor#-1.0-Float(o))/dotspercolor#+newr#*Float(o)/dotspercolor)
            cg = Int(g#*(dotspercolor#-1.0-Float(o))/dotspercolor#+newg#*Float(o)/dotspercolor)
            cb = Int(b#*(dotspercolor#-1.0-Float(o))/dotspercolor#+newb#*Float(o)/dotspercolor)
            
            Color cr,cg,cb
            
            Dot o+i*dotspercolor,0
        
        Next o

        colordat$ = nextcolordat$
        r# = newr#
        g# = newg#
        b# = newb#
    
    Next i 

    DrawToScreen
    
    Return img

End Function 
Vuoristojen juurilla on ehkä vähän huono väritys, mutta en oikein löytänyt sopivaa sävyä.
Tällaisiin tarkoituksiin juuri tein tuo PaintImage():n. ;) Tuollahan voidaan päällystää esimerkiksi räjähdykset tai tulen, kun olet tehnyt ensin pohjan sen jälkeen päällystät sen väriliu'ulla. (musta->tummanpunainen->punainen->oranssi->keltainen->vaalean keltainen ja valkoinen)
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
kaneli2000
Guru
Posts: 1059
Joined: Mon Mar 17, 2008 3:40 pm
Location: Lempäälä

Re: PaintImage()

Post by kaneli2000 » Sun Oct 25, 2009 8:40 pm

Ihan hemmetin hieno, varsinkin tuo oton. Pitää käyttää jossain.
I see the rainbow rising

Jee

Re: PaintImage() Uusi versio.

Post by Jee » Mon Oct 26, 2009 5:05 pm

Toi mavaa mikä vikana?
Musta tuntuu jo että mun koneessa on vika ku joka ohjelma mavaa??

Post Reply