Bitmap Tone RGB

Diese Funktion ist in der Lage, alle RGB-Werte eines Bildes einzufärben. Beim Start wird das Image in den Speicher geladen und von dort aus bearbeitet.

Es werden 3 ScrollBars benötigt, deren Max-Werte auf 255 gesetzt werden müssen, um alle Farbwerte zu erreichen.

var
  bmp : TBitmap;
  
//

procedure Tone(Bit: TBitmap; r, g, b: Integer);
type
  PixArray = array[1..4] of Byte;

var
  p: ^PixArray;
  h, w: Integer;
begin
  Bit.Pixelformat := pf32bit;
  for h := 0 to Bit.Height - 1 do
  begin
    p := Bit.ScanLine[h];
    for w := 0 to Bit.Width - 1 do
    begin
      if (round(p^[1] * (1 + b / 100)) < 0) then p^[1] := 0
        else
        if (round(p^[1] * (1 + b / 100)) > 255) then p^[1] := 255
        else
        p^[1] := round(p^[1] * (1 + b / 100));

      if (round(p^[2] * (1 + g / 100)) < 0) then p^[2] := 0
        else
        if (round(p^[2] * (1 + g / 100)) > 255) then p^[2] := 255
        else
        p^[2] := round(p^[2] * (1 + g / 100));

      if (round(p^[3] * (1 + r / 100)) < 0) then p^[3] := 0
        else
        if (round(p^[3] * (1 + r / 100)) > 255) then p^[3] := 255
        else
        p^[3] := round(p^[3] * (1 + r / 100));
        p^[4]:=0;
      Inc(p);
    end;
  end;
end;

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

Beispiel ScrollBars :

procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
  Image1.Picture.Bitmap.Assign(bmp);
  Tone(Image1.Picture.Bitmap,
  Scrollbar1.Position,
  Scrollbar2.Position,
  Scrollbar3.Position);
  Image1.Repaint;
end;

procedure TForm1.ScrollBar2Change(Sender: TObject);
begin
  Image1.Picture.Bitmap.Assign(bmp);
  Tone(Image1.Picture.Bitmap,
  Scrollbar1.Position,
  Scrollbar2.Position,
  Scrollbar3.Position);
  Image1.Repaint;
end;

procedure TForm1.ScrollBar3Change(Sender: TObject);
begin
  Image1.Picture.Bitmap.Assign(bmp);
  Tone(Image1.Picture.Bitmap,
  Scrollbar1.Position,
  Scrollbar2.Position,
  Scrollbar3.Position);
  Image1.Repaint;
end;

Oder für ein Button :

procedure TForm1.Button2Click(Sender: TObject);
begin
  Tone(Image1.Picture.Bitmap,40,80,20)
end;