// Eine Bitmap wird und Verwendung der Konturen in zwei Farben unter Angabe
// eines Grenzwertes verfremdet.


// Getestet mit RS 10.4 unter Win11

Beispiel 1

Beispiel 2

procedure ContourColor(bmp: TBitmap; Kontur, Farbe: TColor; 
  Grenze: Integer = 398); 
var 
  x, y, b3, grz: Integer; 
  p1, p2: PByteArray; 
  r, g, b, rk, gk, bk: Byte; 
begin 
  bmp.pixelformat := pf24bit; 
  b3 := bmp.width * 3; 
  Farbe := ColorToRGB(Farbe); 
  Kontur := ColorToRGB(Kontur); 
  r := GetRValue(Farbe); 
  g := GetGValue(Farbe); 
  b := GetBValue(Farbe); 
  rk := GetRValue(Kontur); 
  gk := GetGValue(Kontur); 
  bk := GetBValue(Kontur); 
  for y := 0 to bmp.Height - 2 do 
  begin 
    p1 := bmp.scanline[y]; 
    p2 := bmp.scanline[y + 1]; 
    x := 0; 
    while x < b3 do 
    begin 
      p1[x] := (p1[x] + (p2[x] xor $FF)) shr 1; 
      p1[x + 1] := (p1[x + 1] + (p2[x + 1] xor $FF)) shr 1; 
      p1[x + 2] := (p1[x + 2] + (p2[x + 2] xor $FF)) shr 1; 
      grz := p1[x] + p1[x + 1] + p1[x + 2]; 
      if grz > Grenze then 
      begin 
        p1[x] := bk; 
        p1[x + 1] := gk; 
        p1[x + 2] := rk; 
      end 
      else 
      begin 
        p1[x] := b; 
        p1[x + 1] := g; 
        p1[x + 2] := r; 
      end; 
      inc(x, 3); 
    end; 
  end; 
  y := bmp.Height - 1; 
  p1 := bmp.scanline[y]; 
  p2 := bmp.scanline[y - 1]; 
  x := 0; 
  while x < b3 do 
  begin 
    p1[x] := p2[x]; 
    p1[x + 1] := p2[x + 1]; 
    p1[x + 2] := p2[x + 2]; 
    inc(x, 3); 
  end; 
end; 
 
// Beispiel 1 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  ContourColor(Image1.Picture.Bitmap, clwhite, clblue, 380); 
end; 
 
// Beispiel 2 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  ContourColor(Image1.Picture.Bitmap, clLime, clGreen, 396); 
end; 

Zugriffe seit 6.9.2001 auf Delphi-Ecke