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