BW Film Source

[freeway]

Vielleicht kann es der eine oder andere verwenden

Anhand der vorgegebenen "Farbe" wird ein graues Bild erzeugt

Delphi-Quellcode:

function BW_Film(Bild : TBitmap; hell,farbe : integer):boolean;
type  TRGBArray = array[0..0] of TRGBTriple;
      PRGBArray = ^TRGBArray;

var x,y,r,g,b,summe,grau : integer;
    row : PRGBArray;
begin
  result := false; 
  Bild.Pixelformat := pf32bit;
  r := GetRValue(farbe);                                                                                                //RGB Farben zuweisen
  g := GetGValue(farbe);
  b := GetBValue(farbe);

  summe := r + g + b;                                                                                                   //Gesamtsumme bilden
  if summe = 0 then summe := 1;                                                                                         //Divide zero vermeiden

  for y := 0 to Bild.Height-1 do
    begin
      Row := Bild.Scanline[y];
      for x := 0 to Bild.Width - 1 do
        with row[x] do
          begin
            //grau anteilig ermitteln
            //farbwert / gesamtsumme = Anteil der einzelnen Farbe * tatsächlichen wert

            grau := round(r / summe * rgbtRed + g / summe * rgbtGreen + b / summe * rgbtBlue + hell);                  
            if grau > 255 then grau := 255;                                                                             //Bereichscheck
            if grau < 0 then grau := 0;

            rgbtRed   := grau;                                                                                          //neue Farbe zuweisen
            rgbtGreen := grau;
            rgbtBlue  := grau;
          end;
    end;
  result := true;
end;