暗淡或者灰度一个图片:
function NewColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
var
r, g, b: integer;
begin
if Value > 100 then Value := 100;
clr := ColorToRGB(clr);
r := Clr and $000000FF;
g := (Clr and $0000FF00) shr 8;
b := (Clr and $00FF0000) shr 16;
r := r + Round((255 - r) * (value / 100));
g := g + Round((255 - g) * (value / 100));
b := b + Round((255 - b) * (value / 100));
Result := Windows.GetNearestColor(ACanvas.Handle, RGB(r, g, b));
end;
procedure DimBitmap(ABitmap: TBitmap; Value: integer);
var
x, y: integer;
LastColor1, LastColor2, Color: TColor;
begin
if Value > 100 then Value := 100;
LastColor1 := -1;
LastColor2 := -1;
for y := 0 to ABitmap.Height - 1 do
for x := 0 to ABitmap.Width - 1 do
begin
Color := ABitmap.Canvas.Pixels[x, y];
if Color = LastColor1 then
ABitmap.Canvas.Pixels[x, y] := LastColor2
else
begin
LastColor2 := NewColor(ABitmap.Canvas, Color, Value);
ABitmap.Canvas.Pixels[x, y] := LastColor2;
LastColor1 := Color;
end;
end;
end;
function GrayColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
var
r, g, b, avg: integer;
begin
if Value > 100 then Value := 100;
clr := ColorToRGB(clr);
r := Clr and $000000FF;
g := (Clr and $0000FF00) shr 8;
b := (Clr and $00FF0000) shr 16;
Avg := (r + g + b) div 3;
Avg := Avg + Value;
if Avg > 240 then Avg := 240;
Result := Windows.GetNearestColor(ACanvas.Handle, RGB(Avg, avg, avg));
end;
procedure GrayBitmap(ABitmap: TBitmap; Value: integer);
var
x, y: integer;
LastColor1, LastColor2, Color: TColor;
begin
LastColor1 := 0;
LastColor2 := 0;
for y := 0 to ABitmap.Height do
for x := 0 to ABitmap.Width do
begin
Color := ABitmap.Canvas.Pixels[x, y];
if Color = LastColor1 then
ABitmap.Canvas.Pixels[x, y] := LastColor2
else
begin
LastColor2 := GrayColor(ABitmap.Canvas, Color, Value);
ABitmap.Canvas.Pixels[x, y] := LastColor2;
LastColor1 := Color;
end;
end;
end;
Window API 里面有这些东东。
可以打开 Delphi 5 的 Windows SDK 帮助,然后查找
COLORADJUSTMENT
调整亮度:需要同时增加或减少像素点的R,G,B值,增加或减少的R,G,B值应该相等!比如均增加
或减少10;
调整对比度:首先设定一个阀值,通常是128;然后判断像素点的R,G,B值,凡是大于128的,
增加一个值,小于128的,减少一个值!
有很多控件的,如fxtool(http://go1.163.com/~easyvc/dl/fxgold5.zip)
http://my.szptt.net.cn/pb/tools/fxtools/fxcrack.zip(破解文件)
或者XpressPE(http://www.vckbase.com/ocx/ocx_image/XpressPE.EXE)
简单的调节,试试SetPalette API 吧
我找回以前的程序,试了一下,仅仅对于有调色板的图像,例如256色图像
才能用Window API处理。若对于16位或24位真彩色图像只能自己处理。
建议先识别图像的颜色深度,然后再处理。
不要使用TBitmap的Pixel属性,应使用ScanLine。若不是使用TBitmap,
也是类似,要直接获得象素的内存指针来操作。
处理方法就如【卷起千堆雪tyn】所说的那样。
给你段代码参考一下吧:
procedure TForm1.Button1Click(Sender: TObject);
var
x,y,i: integer;
BitMap : TBitMap;
ptr : PByteArray;
begin
BitMap := TBitMap.Create;
try
BitMap.LoadFromFile('lanmannt.bmp');
BitMap.PixelFormat := pf24bit;
for i := 0 to 255 do begin
for y := 0 to BitMap.Height - 1 do begin
ptr := BitMap.ScanLine[y];
for x := 0 to ((BitMap.Width * 3) - 1) do
if ptr[x] > 0 then ptr[x] := (ptr[x] - 1);
end;
Image1.Canvas.Draw(0,0,BitMap);
Application.ProcessMessages;
end;
finally
BitMap.free;
end;
end;