Про картинки
_____________________________________
Поторопился я, и кой чего нашёл уже. Правде еще не попробовал.
[COLOR=blue]
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Изменение контрастности изображения
Value - значение контрастности на отрезке [-100..100]
Local - если True, то применяется "местный контраст",
если False, то - "общий" (более красивый)
Зависимости: Windows
Автор: Fenik, [email]chook_nu@uraltc.ru[/email], Новоуральск
Copyright: Николай Федоровских
Дата: 14 июля 2003 г.
***************************************************** }
procedure Contrast(Bitmap: TBitmap; Value: Integer; Local: Boolean);
function BLimit(B: Integer): Byte;
begin
if B < 0 then
Result := 0
else if B > 255 then
Result := 255
else
Result := B;
end;
var
Dest: pRGBTriple;
x, y, mr, mg, mb,
W, H, tr, tg, tb: Integer;
vd: Double;
begin
if Value = 0 then
Exit;
W := Bitmap.Width - 1;
H := Bitmap.Height - 1;
if Local then
begin
mR := 128;
mG := 128;
mB := 128;
end
else
begin
tr := 0;
tg := 0;
tb := 0;
for y := 0 to H do
begin
Dest := Bitmap.ScanLine[y];
for x := 0 to W do
begin
with Dest^ do
begin
Inc(tb, rgbtBlue);
Inc(tg, rgbtGreen);
Inc(tr, rgbtRed);
end;
Inc(Dest);
end;
end;
mB := Trunc(tb / (W * H));
mG := Trunc(tg / (W * H));
mR := Trunc(tr / (W * H));
end;
if Value > 0 then
vd := 1 + (Value / 10)
else
vd := 1 - (Sqrt(-Value) / 10);
for y := 0 to H do
begin
Dest := Bitmap.ScanLine[y];
for x := 0 to W do
begin
with Dest^ do
begin
rgbtBlue := BLimit(mB + Trunc((rgbtBlue - mB) * vd));
rgbtGreen := BLimit(mG + Trunc((rgbtGreen - mG) * vd));
rgbtRed := BLimit(mR + Trunc((rgbtRed - mR) * vd));
end;
Inc(Dest);
end;
end;
end;
[/COLOR]
И вот про гамму
[COLOR=blue]
>> Изменение гаммы рисунка
Зависимости: Graphics
Автор: Fenik, [email]chook_nu@uraltc.ru[/email], Новоуральск
Copyright: Автор Федоровских Николай
Дата: 5 июня 2002 г.
***************************************************** }
procedure Gamma(Bitmap: TBitmap; L: Double);
{0.0 < L < 7.0}
function Power(Base, Exponent: Extended): Extended;
begin
Result := Exp(Exponent * Ln(Base));
end;
type
TRGB = record
B, G, R: Byte;
end;
pRGB = ^TRGB;
var
Dest: pRGB;
X, Y: Word;
GT: array[0..255] of Byte;
begin
Bitmap.PixelFormat := pf24Bit;
GT[0] := 0;
if L = 0 then
L := 0.01;
for X := 1 to 255 do
GT[X] := Round(255 * Power(X / 255, 1 / L));
for Y := 0 to Bitmap.Height - 1 do
begin
Dest := Bitmap.ScanLine[y];
for X := 0 to Bitmap.Width - 1 do
begin
with Dest^ do
begin
R := GT[R];
G := GT[G];
B := GT;
end;
Inc(Dest);
end;
end;
end;
[/COLOR]