Graphics 500,200,16,2

kugel=LoadImage("d:/eigene dateien/blitz/"+"Krot.bmp")
MaskImage kugel,192,192,192

While Not KeyHit(1)
   Cls
   
   Color 0,0,0
   Rect 0,0,100,200,1
   
   Color 000,200,0
   Rect 100,0,100,200,1
   
   Color 200,0,0
   Rect 200,0,100,200,1

   Color 0,0,200
   Rect 300,0,100,200,1
   
   Color 255,255,255
   Rect 400,0,100,200,1
         
   For x=0 To 4
      DrawImage kugel,30+x*100,50
   Next
   Flip
Wend

Graphics 600,300,32,2
 Const c_mx = 3

 skip = 4
; maskcolor = $FF00FF
; maskcolor = $F800F8 ;Grafikkartenbug?

 maskcolor = $000000

 Dim Col(c_mx)

 file$ = CommandLine$()
 If Not FileType (file$) Then
    file$ = Input$("Datei: ")
 Else 
    Print "Verarbeite Datei: " + file$
 EndIf

 start = LoadImage(file$)
 If Not start Then RuntimeError "Datei nicht gefunden!"

 ausgabe = CreateImage(ImageWidth(start)/2,ImageHeight(start)/2)
 If Not ausgabe Then RuntimeError "Fehler!"

 skip = Input("Skipwert(0-3): ")

 LockBuffer ImageBuffer(start)
 LockBuffer ImageBuffer(ausgabe)

 For x = 0 To ImageWidth(ausgabe)-1
   For y = 0 To ImageHeight(ausgabe)-1
     hx = x Shl 1
     hy = y Shl 1
     maskcnt = 0

     For u = 0 To c_mx   
       Col(u) = ReadPixelFast(hx+(u Shr 1),hy+(u And 1),ImageBuffer(start)) And $FFFFFF;kein Alphakanal
       If col(u) = maskcolor Then maskcnt = maskcnt + 1
     Next     

     If maskcnt > skip Then
        WritePixelFast x, y, maskcolor, ImageBuffer(ausgabe) 
     Else
        writecol = 0
        For u = 0 To c_mx
          If Col(u) <> Maskcolor
             Select maskcnt
               Case 0
                 writecol = writecol + ((Col(u) And $FCFCFC) Shr 2)
               Case 1
                 writecol = writecol + (((Col(u) Shr 16) And $FF) / 3) Shl 16 ;R
                 writecol = writecol + (((Col(u) Shr 8) And $FF) / 3) Shl 8   ;G
                 writecol = writecol + (Col(u)  And $FF) / 3                  ;B

               Case 2
                 writecol = writecol + ((Col(u) And $FEFEFE) Shr 1)
               Case 3
                 writecol = Col(u)
             End Select             
           EndIf
         Next
         WritePixelFast x, y, writecol, ImageBuffer(ausgabe)
      EndIf


   Next
 Next

 UnlockBuffer ImageBuffer(start)
 UnlockBuffer ImageBuffer(ausgabe)


 datei$ = Left (File$,Instr (File$,".")-1) + "_A.bmp"
 SaveImage (ausgabe, datei$)
 Print datei$ + " erzeugt!"

 FreeImage start
 FreeImage ausgabe


 WaitKey()