function IntToByte(i:Integer): Byte; begin if i > 255 then Result := 255 else if i < 0 then Result := 0 else Result := i; end;
procedure Lightness1(var clip: tbitmap; Amount: Integer); var p0: pbytearray; r, g, b, p, x, y: Integer; begin for y := 0 to clip.Height - 1 do begin p0 := clip.scanline[y]; for x := 0 to clip.Width - 1 do begin r := p0[x * 3]; g := p0[x * 3 + 1]; b := p0[x * 3 + 2]; p0[x * 3] := IntToByte(r + ((255 - r) * Amount) div 255); p0[x * 3 + 1] := IntToByte(g + ((255 - g) * Amount) div 255); p0[x * 3 + 2] := IntToByte(b + ((255 - b) * Amount)div 255); end; end; end;
procedure Lightness(var clip: tbitmap; Amount: Integer); var p0: pbytearray; r, g, b, p, x, y: Integer; n: array[0..255] of Integer; begin for y := 0 to 255 do n[y] := IntToByte(y + ((255 - y) * Amount) div 255); for y := 0 to clip.Height - 1 do begin p0 := clip.scanline[y]; for x := 0 to clip.Width - 1 do begin b := p0[x * 3]; g := p0[x * 3 + 1]; r := p0[x * 3 + 2]; p0[x * 3] := n[b]; p0[x * 3 + 1] := n[g]; p0[x * 3 + 2] := n[r]; end; end;
end;
procedure TForm1.TrackBar1Change(Sender: TObject); var vBitmap:TBitmap; begin vBitmap:=TBitmap.Create; try vBitmap.Assign(Image1.Picture.Graphic); vBitmap.PixelFormat:=pf8bit; Image1.Picture.SaveToFile('c:\test1.bmp'); Lightness(vBitmap,TrackBar1.Position); vBitmap.SaveToFile('c:\test2.bmp'); Image2.Picture.Bitmap.Assign(vBitmap); finally vBitmap.Free; end; end;