AppTitle \"Bleistiftzeichnung\"

Graphics(800,600,32,2)

bild=LoadImage(\"bild.png\")
DrawBlock(bild,0,0)

For x=1 To ImageWidth(bild)
For y=1 To ImageHeight(bild)
	
GetColor x,y
	
rot=ColorRed()
gruen=ColorGreen()
blau=ColorBlue()
	
altefarbe=farbe
	
farbe=rot+gruen+blau+1
farbe=farbe/3
Color(255-Abs(farbe-altefarbe),255-Abs(farbe-altefarbe),255-Abs(farbe-altefarbe))

Plot(x,y)
	
Next
Next

WaitKey

End 

;2005 XuKiNi-ware
;bleistiftzeichnungsapparat v2


AppTitle \"bleistiftzeichnung\"

Graphics(800,600,32,2)

bild=LoadImage(\"bild.png\")
Dim colour(ImageWidth(bild),ImageHeight(bild))
DrawBlock(bild,0,0)

For x=0 To ImageWidth(bild)
For y=0 To ImageHeight(bild)
	
GetColor x,y
	
rot=ColorRed()
gruen=ColorGreen()
blau=ColorBlue()
	
altefarbe=farbe
	
farbe=rot+gruen+blau+1
farbe=farbe/3
colour(x,y)=Abs(farbe-altefarbe)
	
Next
Next

For y=0 To ImageHeight(bild)
For x=0 To ImageWidth(bild)
	
GetColor x,y
	
rot=ColorRed()
gruen=ColorGreen()
blau=ColorBlue()
	
altefarbe=farbe
	
farbe=rot+gruen+blau+1
farbe=farbe/3
colour(x,y)=Abs(farbe-altefarbe)+colour(x,y)
If colour(x,y)>255 colour(x,y)=255
	
Next
Next

For x=0 To ImageWidth(bild)
For y=0 To ImageHeight(bild)
Color(255-colour(x,y),255-colour(x,y),255-colour(x,y))
Plot(x,y)
Next
Next
WaitKey

End

;2005 XuKiNi-ware
;bleistiftzeichnungsapparat v2
;Modified by Apocalyptic

Dim Colour(-1,-1)

;Funktionsbeispiel:
;--------------------------------------------

AppTitle \"Bleistiftzeichnung\"

Graphics 800,600,32,2

Bild=LoadImage(\"C:\Windows\Angler.bmp\")


t1=MilliSecs()

BleistiftEffekt(Bild)

t2=MilliSecs()


SetBuffer FrontBuffer()


DrawImage Bild,5,25

Text 5,5,\"Zeit: \"+(t2-t1)+\" ms\"


WaitKey()

;--------------------------------------------

Function BleistiftEffekt(Img)

	Width=ImageWidth(Img)
	Height=ImageHeight(Img)

	Dim Colour(Width-1,Height-1)

	SetBuffer ImageBuffer(Img)

	LockBuffer

	For x=0 To Width-1
		For y=0 To Height-1
			rgb=ReadPixelFast(x,y)
			r=(rgb Shr 16) And $FF
			g=(rgb Shr  8) And $FF
			b=(rgb       ) And $FF

			AlteFarbe=Farbe

			Farbe=r+g+b+1
			Farbe=Farbe/3
			Colour(x,y)=Abs(Farbe-AlteFarbe)

		Next
	Next

	For y=0 To Height-1
		For x=0 To Width-1
			rgb=ReadPixelFast(x,y)
			r=(rgb Shr 16) And $FF
			g=(rgb Shr  8) And $FF
			b=(rgb       ) And $FF

			AlteFarbe=Farbe

			Farbe=r+g+b+1
			Farbe=Farbe/3
			Colour(x,y)=Abs(Farbe-AlteFarbe)+Colour(x,y)
			If Colour(x,y)>255 Then Colour(x,y)=255

			c=255-Colour(x,y)

			WritePixelFast x,y,(c Shl 16)+(c Shl 8)+c
		Next
	Next

	UnlockBuffer

End Function

Const strenght=1
Const intensity=1

Graphics 800,600,32,1
SetBuffer BackBuffer()
ClsColor 255,255,255

image=LoadImage(\"C:\Windows\Web\Wallpaper\Grüne Idylle.bmp\")
If ImageHeight(image)>600 Or ImageWidth(image)>800 Then ResizeImage image,ImageWidth(image)/2,600

Dim pixel(ImageWidth(image),ImageHeight(image))
Global new_image=CreateImage(ImageWidth(image),ImageHeight(image))


.start

DrawImage image,0,0
Flip
timer=MilliSecs()
kanten(image,strenght,intensity)
Text 10,10,(MilliSecs()-timer)+\" ms\"
Flip

WaitKey()
If KeyHit(57) Then Goto start
End



Function kanten(image,strenght,intensity)
  
  SetBuffer ImageBuffer(new_image)
  DrawImage image,0,0

  LockBuffer(ImageBuffer(new_image))
  For x=0 To ImageWidth(image)-1
    For y=0 To ImageHeight(image)-1
      pixel(x,y)=ReadPixelFast(x,y)
    Next
  Next
  UnlockBuffer(ImageBuffer(new_image))

  SetBuffer BackBuffer()
  Color 200,0,0
  Text 400,300,\"Bitte warten...\",1,1
  Text 400,320,\"Kantenerkennung läuft...\",1,1
  Flip
 


  SetBuffer ImageBuffer(new_image)

  LockBuffer(ImageBuffer(new_image))
  For x=1 To ImageWidth(image)-1
    For y=1 To ImageHeight(image)-1
      r1=(pixel(x,y) And $FF0000)/$10000
      g1=(pixel(x,y) And $FF00)/$100
      b1=pixel(x,y) And $FF

      r2=(pixel(x-1,y-1) And $FF0000)/$10000
      g2=(pixel(x-1,y-1) And $FF00)/$100
      b2=pixel(x-1,y-1) And $FF

      color1=r1+g1+b1
      color2=r2+g2+b2

      diff=(255*strenght-Abs(color2-color1)/strenght)*intensity

      rgb=diff*$10000 + diff*$100 + diff

      WritePixelFast x,y,rgb
    Next
  Next
  UnlockBuffer(ImageBuffer(new_image))
  SetBuffer BackBuffer()
  DrawImage new_image,0,0

End Function

  For x=0 To ImageWidth(image)-1
    For y=0 To ImageHeight(image)-1
      pixel(x,y)=ReadPixelFast(x,y)
    Next
  Next

Const strenght=1
Const intensity=1

Graphics 800,600,32,2
SetBuffer BackBuffer()
ClsColor 255,255,255

image=LoadImage(\"C:\dos\grafiken\galerie_coopers_bild1_1024x768.jpg\")
MaskImage image, 255,0,255

If ImageHeight(image)>600 Or ImageWidth(image)>800 Then
   h# = Float(ImageWidth(image)) / ImageHeight(image)
   h# = 800 / h#
   ResizeImage image,800,h#
EndIf

Dim pixel(ImageWidth(image),ImageHeight(image))
Global new_image=CreateImage(ImageWidth(image),ImageHeight(image))

.start

DrawImage image,0,0
Flip
timer=MilliSecs()
kanten(image,strenght,intensity)
Text 10,10,(MilliSecs()-timer)+\" ms\"
Flip

WaitKey()
If KeyHit(57) Then Goto start
End 


Function kanten(image,strenght,intensity)
  buffer = ImageBuffer(new_image)
  width = ImageWidth(image)-1
  height = ImageHeight(image)-1

  SetBuffer BackBuffer()
  Color 200,0,0
  Text 400,300,\"Bitte warten...\",1,1
  Text 400,320,\"Kantenerkennung läuft...\",1,1
  Flip

  SetBuffer buffer
  DrawImage image,0,0

  LockBuffer(buffer)
  For x=0 To width
    For y=0 To height
      pixel(x,y)=ReadPixelFast(x,y)
    Next
  Next
  For x=1 To width
    For y=1 To height
      r1=(pixel(x,y) And $FF0000) Shr 16
      g1=(pixel(x,y) And $FF00) Shr 8
      b1=pixel(x,y) And $FF
      r2=(pixel(x-1,y-1) And $FF0000) Shr 16
      g2=(pixel(x-1,y-1) And $FF00) Shr 8
      b2=pixel(x-1,y-1) And $FF

      color1=r1+g1+b1
      color2=r2+g2+b2

      diff=(255-(Abs(color2-color1)/strenght))*intensity

      rgb=(diff Shl 16) + (diff Shl 8) + diff

      WritePixelFast x,y,rgb
    Next
  Next
  UnlockBuffer(buffer)
  SetBuffer BackBuffer()
  DrawImage new_image,0,0
End Function 

AppTitle \"Bleistiftzeichnung\"

Graphics 1280, 1024, 32, 3
SetBuffer BackBuffer()

Dim Col(1280, 1024)

ms = MilliSecs()
Img = PencilImage(\"Image.bmp\")
;RuntimeError MilliSecs() - ms + \" millisecs token.\"
DrawBlock Img, 0, 0
Flip
WaitKey()
End

Function PencilImage(path$)
Image = LoadImage(path$)
If Image = 0 Then RuntimeError \"Image does not exist.\"
imgWidth = ImageWidth(Image)
imgHeight = ImageHeight(Image)
If imgWidth > 1280 Or imgHeight > 1024 Then RuntimeError \"Illegal image size\"
LockBuffer BackBuffer()
LockBuffer ImageBuffer(Image)
For x = 0 To imgWidth
  For y = 0 To imgHeight
    Pix = ReadPixelFast(x, y, ImageBuffer(Image))
    r = Red(Pix)
    g = Green(Pix)
    b = Blue(Pix)
    oldc = c
    c = r / 3 + g / 3 + b / 3
    Col(x, y) = Abs(c - oldc)
    Col(x, y) = Col(x, y) + Abs(c - oldc)
    If Col(x, y) > 255 Col(x, y) = 255
	Next
	AppTitle \"Go1::\" + x + \"/\" + imgWidth
Next
;New Image
ImgNew = CreateImage(imgWidth, imgHeight)
LockBuffer ImageBuffer(ImgNew)
For x = 0 To imgWidth
  For y = 0 To imgHeight
    WritePixelFast x, y, RGB(255 - Col(x, y), 255 - Col(x, y), 255 - Col(x, y)), ImageBuffer(ImgNew)
  Next
  AppTitle \"Go3::\" + x + \"/\" + imgWidth
Next
UnlockBuffer ImageBuffer(ImgNew)
UnlockBuffer BackBuffer()
FreeImage Image
Return ImgNew
End Function

Function Red(rgb)
Return (rgb And $FF0000) / $10000
End Function

Function Green(rgb)
Return (rgb And $FF00)/$100
End Function

Function Blue(rgb)
Return rgb And $FF
End Function

Function RGB(r, g, b)
Return r * $10000 + g * $100 + b
End Function