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

terrain1 = LoadImage(\"Terrain1.bmp\")
terrain2 = LoadImage(\"Terrain2.bmp\")
Global r1,g1,b1,r2,g2,b2

For y = 0 To 255
	rgb1 = ReadPixel(255, y, ImageBuffer(terrain1))
	rgb2 = ReadPixel(0, y, ImageBuffer(terrain2))
	r1 = getred(rgb1)
	r2 = getred(rgb2)
	dr = (r1 + r2)/2
	g1 = getgreen(rgb1)
	g2 = getgreen(rgb2)
	dg = (g1 + g2)/2
	b1 = getblue(rgb1)
	b2 = getblue(rgb2)
	db = (b1 + b2)/2
	WritePixel 255,y, getrgb(dr,dg,db), ImageBuffer(terrain1)
	WritePixel 0,y, getrgb(dr,dg,db), ImageBuffer(terrain2)
	rgb1 = ReadPixel(255, y, ImageBuffer(terrain1))
	rgb2 = ReadPixel(0, y, ImageBuffer(terrain2))
	r1 = getred(rgb1)
	r2 = getred(rgb2)
	g1 = getgreen(rgb1)
	g2 = getgreen(rgb2)
	b1 = getblue(rgb1)
	b2 = getblue(rgb2)
Next

For x = 255 To 0 Step - 1
	For y = 0 To 256
		rgb1 = ReadPixel(x,y, ImageBuffer(terrain1))
		rgb2 = ReadPixel(x+1,y, ImageBuffer(terrain1))
		r1 = getred(rgb1)
		g1 = getgreen(rgb1)
		b1 = getblue(rgb1)
		r2 = getred(rgb2)
		g2 = getgreen(rgb2)
		b2 = getblue(rgb2)
		dr = (r1 + r2)/2
		dg = (g1 + g2)/2
		db = (b1 + b2)/2
		WritePixel x,y,getrgb(dr,dg,db) ImageBuffer(terrain1)
	Next
Next

For x = 0 To 255 Step 1
	For y = 0 To 255
		rgb1 = ReadPixel(x,y, ImageBuffer(terrain2))
		rgb2 = ReadPixel(x+1,y, ImageBuffer(terrain1))
		r1 = getred(rgb1)
		g1 = getgreen(rgb1)
		b1 = getblue(rgb1)
		r2 = getred(rgb2)
		g2 = getgreen(rgb2)
		b2 = getblue(rgb2)
		dr = (r1 + r2)/2
		dg = (g1 + g2)/2
		db = (b1 + b2)/2
		WritePixel x,y,getrgb(dr,dg,db) ImageBuffer(terrain2)
	Next
Next


SaveBuffer ImageBuffer(terrain1), \"Terrain1_NEW.bmp\"
SaveBuffer ImageBuffer(terrain2), \"Terrain2_NEW.bmp\"
End




Function GetRed% ( RGB% )
   Return RGB Shr 16 And 255
End Function

Function GetGreen% ( RGB% )
   Return RGB Shr 8 And 255
End Function

Function GetBlue% ( RGB% )
   Return RGB And 255
End Function

Function GetRGB% ( Red% , Green% , Blue% )
   Return Red Shl 16 + Green Shl 8 + Blue
End Function

Graphics 800,600,32,2
SeedRnd MilliSecs()

Const bbreite = 20 ;Muss eine Gerade Zahl sein Also 2;4;8;10 usw.

terrain1 = LoadImage(\"Terrain1.bmp\")
terrain2 = LoadImage(\"Terrain2.bmp\")

iw1 = ImageWidth(terrain1)
ih1 = ImageHeight(terrain1)

Dim pixelo1(bbreite,ih1+bbreite)
Dim pixelo2(bbreite,ih1+bbreite)

Dim ideal1(bbreite,ih1+bbreite)
Dim ideal2(bbreite,ih1+bbreite)

Dim ergebnis1(bbreite,ih1+bbreite)
Dim ergebnis2(bbreite,ih1+bbreite)

;Orginal1
SetBuffer ImageBuffer(terrain1)
For y = 0 To ih1
  For x = 1 To bbreite
    rgb = ReadPixel(iw1-x,y)
    h=(rgb And $FF00)/$100

    pixelo1(bbreite+1-x,y) = h
  Next
Next
;Orginal2
SetBuffer ImageBuffer(terrain2)
For y = 0 To ih1
  For x = 1 To bbreite
    rgb = ReadPixel(x-1,y)
    h=(rgb And $FF00)/$100

    pixelo2(x,y) = h
  Next
Next
SetBuffer FrontBuffer()

;\"Idiallinie\"
;1
For y = 0 To ih1
  start = pixelo1(1,y)
  ende = pixelo2(1,y)

  abstand = ((ende-start)/2)

  abstandp# = Float(abstand) / Float(bbreite/2)

  For x = 1 To bbreite
     ideal1(x,y) = start + (abstandp#*x)
  Next
Next
;2
For y = 0 To ih1
  start = pixelo1(bbreite,y)
  ende = pixelo2(bbreite,y)

  abstand = ((ende-start)/2)

  abstandp# = Float(abstand) / Float(bbreite/2)

  For x = 1 To bbreite
    ideal2(x,y) = start + (abstandp#*x)
  Next
Next

;ErgebinsLinie
;1
For y = 0 To ih1
   For x = 1 To bbreite
     min1 = min(pixelo1(x,y), ideal1(x,y))
     If min1 = pixelo1(x,y) Then
       ergebnis1(x,y) = min1+(Float(Abs(pixelo1(x,y) - ideal1(x,y)))/(Float(2+(Float(bbreite-x)*Float(Float(bbreite)/120.0)))))
					Else
       ergebnis1(x,y) = min1+(Float(Abs(pixelo1(x,y) - ideal1(x,y)))/(2.0-(Float(bbreite-x)/(Float(bbreite)))))
	    EndIf
  Next
Next
;2
For y = 0 To ih1
   For x = 1 To bbreite
     min1 = min(pixelo2(x,y), ideal2(x,y))
     If min1 = pixelo2(x,y) Then
       ergebnis2(x,y) = min1+(Float(Abs(pixelo2(x,y) - ideal2(x,y)))/(2+(Float(x))*Float(Float(bbreite)/120.0) ) )
					Else
       ergebnis2(x,y) = min1+(Float(Abs(pixelo2(x,y) - ideal2(x,y)))/(2.0-(Float(x)/(Float(bbreite)))))
					EndIf
  Next
Next

;Anzeigen und speichern
SetBuffer FrontBuffer()
DrawImage terrain1,100,50
DrawImage terrain2,100+iw1,50

SetBuffer ImageBuffer(terrain1)
For y = o To ih1
  For x = 1 To bbreite
    rgb=0*$1000000 + ergebnis1(x,y)*$10000 + ergebnis1(x,y)*$100 + ergebnis1(x,y)
    WritePixel ih1-bbreite+x-1,y,rgb
  Next
Next

SetBuffer ImageBuffer(terrain2)
For y = o To ih1
  For x = 1 To bbreite
    rgb=0*$1000000 + ergebnis2(x,y)*$10000 + ergebnis2(x,y)*$100 + ergebnis2(x,y)
    WritePixel x-1,y,rgb
  Next
Next

SetBuffer FrontBuffer()
DrawImage terrain1,100,100+ih1
DrawImage terrain2,100+iw1,100+ih1

SaveImage (terrain1,\"Terrain1_NEW.bmp\")
SaveImage (terrain2,\"Terrain2_NEW.bmp\")

;Tolles Diagramm
Rect 403,50,bbreite*5*2,257,0
Text 373,50,255
Text 388,290,0
Text 408,310,0
Text 383+bbreite*5+25,310,0
Text 383+bbreite*5*2,310,bbreite
Text 383+bbreite*5,310,bbreite

y = Rand(10,ih1-10)

Text 373,35,\"Übergangslinie von Reihe \"+ y
Color 60,60,60
Rect 403+(bbreite*5),50,1,255
For x = 1 To bbreite
  If x = 1 Then
    xx = 2
  Else
    xx = x - 1
  EndIf
  Color 255,255,255
  Line 403+(x*5) ,50+pixelo1(x,y),403+((xx)*5) ,50+pixelo1(xx,y)
  Line 398+(bbreite*5)+(x*5) ,50+pixelo2(x,y),398+(bbreite*5)+((xx)*5) ,50+pixelo2(xx,y)
  Color 0,0,255
  Line 403+(x*5) ,50+ideal1(x,y),403+((xx)*5) ,50+ideal1(xx,y)
  Line 398+(bbreite*5)+(x*5) ,50+ideal2(x,y),398+(bbreite*5)+((xx)*5) ,50+ideal2(xx,y)
  Color 255,0,0
  Line 403+(x*5) ,50+ergebnis1(x,y),403+((xx)*5) ,50+ergebnis1(xx,y)
  Line 398+(bbreite*5)+(x*5) ,50+ergebnis2(x,y),398+(bbreite*5)+((xx)*5) ,50+ergebnis2(xx,y)
  If x = bbreite Then Line 403+(x*5) ,50+ergebnis1(x,y),398+(bbreite*5)+(1*5) ,50+ergebnis2(1,y)
Next

WaitKey

Function min(z1,z2)
  If z1 < z2 Then
    Return z1
  Else
    Return z2
  EndIf
End Function

Function max(z1,z2)
  If z1 > z2 Then
    Return z1
  Else
    Return z2
  EndIf
End Function