本文整理自网络，侵删。
像PC端的QQ等聊天软件，都会显示用户在线状态，但离线用户显示的头像就是黑白的，Delphi里如何实现这种彩色头像转为黑白头像的功能呢？这里给大家分享下这个函数，该函数之前也是在网络上收集的资料的基础上进行修改完善的，具体代码如下：
unit uPictureGray;
interface
uses Winapi.Windows, Vcl.Graphics, System.SysUtils, System.Math, Vcl.Imaging.jpeg,
Vcl.Imaging.pngimage, Vcl.Imaging.pnglang;
function ColorfulToBlackWhite(ASrcFile, ADesFile: string): Boolean;
function MakePngToColor(SrcPng: TPngImage; DestColor: Tcolor; AlphaValue: Integer = 255): TPngImage;
implementation
uses uPubFuns;
type
PRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array [0 .. 65536 - 1] of TRGBTriple;
procedure RGBtoHSL(R, G, B: Integer; var H, S, L: Double);
var
Delta: Double;
CMax, CMin: Double;
Red, Green, Blue, Hue, Sat, Lum: Double;
begin
Red := R / 255;
Green := G / 255;
Blue := B / 255;
CMax := Max(Red, Max(Green, Blue));
CMin := Min(Red, Min(Green, Blue));
Lum := (CMax + CMin) / 2;
if CMax = CMin then
begin
Sat := 0;
Hue := 0;
end
else
begin
if Lum < 0.5 then
Sat := (CMax - CMin) / (CMax + CMin)
else
Sat := (CMax - CMin) / (2 - CMax - CMin);
Delta := CMax - CMin;
if Red = CMax then
Hue := (Green - Blue) / Delta
else if Green = CMax then
Hue := 2 + (Blue - Red) / Delta
else
Hue := 4.0 + (Red - Green) / Delta;
Hue := Hue / 6;
if Hue < 0 then
Hue := Hue + 1;
end;
H := (Hue * 360);
S := (Sat * 100);
L := (Lum * 100);
end;
procedure HSLtoRGB(H, S, L: Double; var R, G, B: Integer);
var
Sat, Lum: Double;
begin
R := 0;
G := 0;
B := 0;
if (H < 360) and (H >= 0) and (S <= 100) and (S >= 0) and (L <= 100) and (L >= 0) then
begin
if H <= 60 then
begin
R := 255;
G := Round((255 / 60) * H);
B := 0;
end
else if H <= 120 then
begin
R := Round(255 - (255 / 60) * (H - 60));
G := 255;
B := 0;
end
else if H <= 180 then
begin
R := 0;
G := 255;
B := Round((255 / 60) * (H - 120));
end
else if H <= 240 then
begin
R := 0;
G := Round(255 - (255 / 60) * (H - 180));
B := 255;
end
else if H <= 300 then
begin
R := Round((255 / 60) * (H - 240));
G := 0;
B := 255;
end
else if H < 360 then
begin
R := 255;
G := 0;
B := Round(255 - (255 / 60) * (H - 300));
end;
Sat := Abs((S - 100) / 100);
R := Round(R - ((R - 128) * Sat));
G := Round(G - ((G - 128) * Sat));
B := Round(B - ((B - 128) * Sat));
Lum := (L - 50) / 50;
if Lum > 0 then
begin
R := Round(R + ((255 - R) * Lum));
G := Round(G + ((255 - G) * Lum));
B := Round(B + ((255 - B) * Lum));
end
else if Lum < 0 then
begin
R := Round(R + (R * Lum));
G := Round(G + (G * Lum));
B := Round(B + (B * Lum));
end;
end;
end;
procedure ConvertPngDataColor(DstP1: PRGBTripleArray; index: Integer; DestColor: Tcolor);
var
L: Integer;
hexString: String;
RVALUE, bVALUE, GVALUE: Integer;
HVALUE, SVALUE, LVALUE: Double;
HNewVALUE, SNewVALUE, LNewVALUE: Double;
begin
hexString := IntToHex(DestColor, 6);
RGBtoHSL(StrToInt('$' + Copy(hexString, 5, 2)), StrToInt('$' + Copy(hexString, 3, 2)),
StrToInt('$' + Copy(hexString, 1, 2)), HNewVALUE, SNewVALUE, LNewVALUE);
L := 0;
RVALUE := DstP1[index].rgbtRed;
GVALUE := DstP1[index].rgbtGreen;
bVALUE := DstP1[index].rgbtBlue;
RGBtoHSL(RVALUE, GVALUE, bVALUE, HVALUE, SVALUE, LVALUE);
HSLtoRGB(HNewVALUE, SNewVALUE, LVALUE + L, RVALUE, GVALUE, bVALUE);
DstP1[index].rgbtRed := RVALUE;
DstP1[index].rgbtGreen := GVALUE;
DstP1[index].rgbtBlue := bVALUE;
end;
function MakePngToColor(SrcPng: TPngImage; DestColor: Tcolor; AlphaValue: Integer = 255): TPngImage;
// 转换图片颜色
Var
i, j: Integer;
w, H: Integer;
SrcP1, DstP1: PRGBTripleArray;
begin
Result := nil;
if SrcPng.Empty then
exit;
w := SrcPng.Width;
H := SrcPng.Height;
Result := TPngImage.CreateBlank(COLOR_RGBALPHA, 16, w, H);
for i := 0 to H - 1 do
begin
SrcP1 := SrcPng.Scanline[i];
DstP1 := Result.Scanline[i];
for j := 0 to w - 1 do
begin
if DestColor <> ClNone then
begin
if DstP1 <> nil then
begin
DstP1[j] := SrcP1[j];
ConvertPngDataColor(DstP1, j, DestColor);
end;
end;
if SrcPng.AlphaScanline[i] <> nil then
begin
if AlphaValue = 255 then
Result.AlphaScanline[i][j] := SrcPng.AlphaScanline[i][j];
Result.AlphaScanline[i][j] := SrcPng.AlphaScanline[i][j] * AlphaValue div 255;
end
else
Result.AlphaScanline[i][j] := DestColor;
end;
end;
end;
function PngFileToGray(ASrcFile: string; ADesFile: string): Boolean;
var
ASrcPng, ADesPng: TPngImage;
begin
Result := False;
if not FileExists(ASrcFile) then
exit;
try
ASrcPng := TPngImage.Create;
try
ASrcPng.LoadFromFile(ASrcFile);
ADesPng := MakePngToColor(ASrcPng, clGray, 225);
if ADesPng <> nil then
begin
try
ADesPng.SaveToFile(ADesFile);
finally
ADesPng.Free;
end;
end;
finally
ASrcPng.Free;
end;
except
end;
end;
function ColorfulToBlackWhite(ASrcFile, ADesFile: string): Boolean;
var
SrcBitMap, DesBitMap: TBitmap;
i, j: Integer;
K1: Longint;
R1, G1, B1, Res: Byte;
jpeg: TJPEGImage;
AExt: string;
begin
Result := False;
try
if not FileExists(ASrcFile) then
exit;
if not ReadPicFileExt(ASrcFile, AExt) then
exit;
if (LowerCase(AExt) = '.jpg') or (LowerCase(AExt) = '.jpeg') then
begin
try
jpeg := TJPEGImage.Create;
try
SrcBitMap := TBitmap.Create;
try
jpeg.LoadFromFile(ASrcFile);
SrcBitMap.Assign(jpeg);
DesBitMap := TBitmap.Create;
try
DesBitMap.Width := SrcBitMap.Width;
DesBitMap.Height := SrcBitMap.Height;
for i := 0 to SrcBitMap.Width + 1 do
for j := 0 to SrcBitMap.Height + 1 do
begin
K1 := ColorToRGB(SrcBitMap.Canvas.Pixels[i, j]);
R1 := Byte(K1);
G1 := Byte(K1 shr 8);
B1 := Byte(K1 shr 8);
Res := (R1 + G1 + B1) div 3;
DesBitMap.Canvas.Pixels[i, j] := RGB(Res, Res, Res);
end;
jpeg.Assign(DesBitMap);
jpeg.SaveToFile(ADesFile);
Result := True;
finally
DesBitMap.Free;
end;
finally
SrcBitMap.Free;
end;
finally
jpeg.Free;
end;
except
end;
end
else if LowerCase(AExt) = '.png' then
Result := PngFileToGray(ASrcFile, ADesFile);
except
end;
end;
end.
相关阅读 >>
Delphi tserversocket 发送消息之前检查客户端是否仍处于连接状态
Delphi colorbox不需要系统那么多颜色，只想自定义显示其中几个，怎么做？
Delphi 如何在程序中动态设置墙纸（使用iactivedesktop接口）
更多相关阅读请进入《Delphi》频道 >>
