this slowpoke moves

Bitmap Contrast

Der Kontrast wird über alle drei RGB-Kanäle berechnet. Um das Bitmap wieder in seinen Ursprung zu bringen, muss es vor der Berechnung neu geladen werden. Das geht entweder aus dem Speicher oder von einer Datei oder sie kann aus einer anderen Image kopiert werden. Es wird eine Scrollbar benötigt, deren Max-Wert auf 25 gesetzt werden muss.

var
  bmp : TBitmap;
  
type
  TRGBArray = array[0..0] of TRGBTriple;
  pRGBArray = ^TRGBArray;
  
//

function IntToByte(i : integer) : byte;
begin
  if (i>255) then Result := 255
    else
  if (i < 0) then Result := 0
    else
  Result := i;
end;

procedure Contrast(Src : TBitmap; Amount : integer);
var
  x, y : integer;
  r, g, b : integer;
  rr, gg, bb : integer;
  SrcLine : pRGBArray;
  SrcGap : integer;
begin
  Src.PixelFormat := pf24bit;
  SrcLine := Src.ScanLine[0];
  SrcGap := Integer(Src.ScanLine[1]) - Integer(SrcLine);
{$ifopt R+} {$define RangeCheck} {$endif} {$R-}
  for y := 0 to pred(Src.Height) do begin
    for x := 0 to pred(Src.Width) do begin
      r := SrcLine[x].rgbtRed;
      g := SrcLine[x].rgbtGreen;
      b := SrcLine[x].rgbtBlue;
      rr := MulDiv(abs(127-r), Amount, 100);
      gg := MulDiv(abs(127-g), Amount, 100);
      bb := MulDiv(abs(127-b), Amount, 100);
  if (r>127) then r := r+rr
    else
  r := r-rr;

  if (g>127) then g := g+gg
    else
  g := g-gg;

  if (b>127) then b := b+bb
    else
  b := b-bb;

  SrcLine[x].rgbtRed := IntToByte(r);
  SrcLine[x].rgbtGreen := IntToByte(g);
  SrcLine[x].rgbtBlue := IntToByte(b);
  end;
  SrcLine := pRGBArray(Integer(SrcLine) + SrcGap);
  end;
{$ifdef RangeCheck} {$R+} {$undef RangeCheck} {$endif}
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  bmp := TBitmap.Create;
  try
  bmp.Assign(Image1.Picture.Bitmap);
  except
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  bmp.Free;
end;
Beispiel :
procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
  Contrast(bmp, 20);   // HIER DIE KONTRAST STÄREK ANGEBEN
  Image1.Picture.Bitmap.Assign(bmp);
  Image1.Repaint;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate