Delphi里实现彩色图片转为黑白图像的功能

5bug 2018-01-04 48人围观 ,发现0个评论 TRGBTripleArrayTPngImage

像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.


请扫码加入QQ群
微信二维码
不容错过
Powered By Z-BlogPHP