RSS订阅 | 匿名投稿
您的位置:网站首页 > 图像 > 正文

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

作者:admin 来源: 日期:2018/1/30 14:39:12 人气: 标签:

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