//Advanced Delphi Systems Code: ads_ColorConv
unit ads_ColorConv;
{Copyright(c)2016 Advanced Delphi Systems

 Richard Maley
 Advanced Delphi Systems
 12613 Maidens Bower Drive
 Potomac, MD 20854 USA
 phone 301-840-1554
 dickmaley@advdelphisys.com

 The code herein can be used or modified by anyone.  Please retain references
 to Richard Maley at Advanced Delphi Systems.  If you make improvements to the
 code please send your improvements to dickmaley@advdelphisys.com so that the
 entire Delphi community can benefit.  All comments are welcome.
}
(*
UnitIndex Master Index Implementation Section Download Units
Description: ads_ColorConv.pas
This unit contains the following routines.

BitmapSimilarity_1   BitmapSimilarity_2   BitmapSimilarity2   BitmapsSimilar   ColorToHSV   ColorToHue   ColorToInternet   ColorToRGB   ColorToSaturation   ColorToValue   HSVToColor   HSVtoRGB   JpegFileRenameToSimilarity  JpegFileToBitmap   JpegSimilarity   JpegsSimilar   RGBToColor   RGBtoHSV   

*)
interface
Uses
  Windows,SysUtils,Graphics,Classes,Math,Dialogs,ads_File,Jpeg;

  Function  JpegFileToBitmap(JpegFile: String;Bitmap: TBitmap): Boolean;
  Function  JpegSimilarity(JpegFile1,JpegFile2: String): Double;OverLoad;
  Function  JpegsSimilar(JpegFile1,JpegFile2: String;PercentDif:Double): Boolean;
  Function  JpegFileRenameToSimilarity(JpegFileBaseLine,JpegFileCompare,TimeStamp: String;var FileName: String;DeletionLevel: Integer): Boolean;

  function  BitmapSimilarity2(Bitmap1, Bitmap2: TBitmap): Double;
  Function  BitmapSimilarity(Bitmap1,Bitmap2: TBitmap): Double; OverLoad;
  Function  BitmapSimilarity(BitmapFile1,BitmapFile2: String): Double; OverLoad;
  Function  BitmapsSimilar(BitmapFile1,BitmapFile2: String;PercentDif:Double): Boolean;
  Function  ColorToValue(c:TColor): Double;
  Function  ColorToSaturation(c:TColor): Double;
  Function  ColorToHue(c:TColor): Double;
  Function  ColorToInternet(c:TColor): String;
  procedure ColorToRGB(c:TColor;out r,g,b: Double;maxr,maxg,maxb: Double);
  procedure ColorToHSV(c:TColor;out h,s,v: Double;maxs,maxv: Double);
  Function  RGBToColor(R,G,B:Double): TColor;
  Function  HSVToColor(H,S,V:Double): TColor;
  procedure RGBtoHSV(r,g,b: Double;out h,s,v: Double;maxr,maxg,maxb,maxs,maxv: Double);
  procedure HSVtoRGB(out r,g,b:Double;h,s,v: Double;maxr,maxg,maxb,maxs,maxv: Double);

implementation


// r,g,b values are from 0 to 1
// h = [0,360], s = [0,1], v = [0,1]
//		if s == 0, then h = -1 (undefined)
//
Unit Description UnitIndex Master Index
procedure RGBtoHSV(r,g,b: Double;out h,s,v: Double;maxr,maxg,maxb,maxs,maxv: Double);
Var
  Vmin  : Double;
  Vmax  : Double;
  delta : Double;
Begin
  If maxr<>1.0 Then r:=(r/maxr);
  If maxg<>1.0 Then g:=(g/maxg);
  If maxb<>1.0 Then b:=(b/maxb);
  Vmin  := Min(r,Min(g,b));
  Vmax  := Max(r,Max(g,b));
  v     := Vmax;
  delta:=Vmax-Vmin;
  If Vmax<> 0 Then
  Begin
    s:=delta/Vmax;
  End
  Else
  Begin
    s:=0;
    h:=0;
    Exit;
  End;
  If r=Vmax Then
  Begin
    If delta=0 Then
      h:=0
      Else
      h:=(g-b)/delta;
  End
  Else
  Begin
    If g=Vmax Then
    Begin
      h:=2+((b-r)/delta);//between cyan & yellow
    End
    Else
    Begin
      h:=4+((r-g)/delta);//between magenta & cyan
    End;
  End;
  h:=h*60;//degrees
  If h<0 Then h:=h+360;
  If maxs<>1.0 Then s:=(s*maxs);
  If maxv<>1.0 Then v:=(v*maxv);
End;

//
Unit Description UnitIndex Master Index
procedure HSVtoRGB(out r,g,b:Double;h,s,v: Double;maxr,maxg,maxb,maxs,maxv: Double);
Var
  i      : Integer;
  f,p,q,t: Double;
Begin
  If maxs<>  1.0 Then s:=(s/maxs);
  If maxv<>  1.0 Then v:=(v/maxv);
  If s=0 Then
  Begin
    //achromatic (grey)
    r:=v;
    g:=v;
    b:=v;
    If maxr<>1.0 Then r:=(r*maxr);
    If maxg<>1.0 Then g:=(g*maxg);
    If maxb<>1.0 Then b:=(b*maxb);
    Exit;
  End;
  h:=h/60;
  i:=floor(h);
  f:=h-i;			// factorial part of h
  p:=v*(1-s);
  q:=v*(1-(s*f));
  t:=v*(1-(s*(1-f)));
  case i Of
  0:
  Begin
    r:=v;
    g:=t;
    b:=p;
  End;
  1:
  Begin
    r:=q;
    g:=v;
    b:=p;
  End;
  2:
  Begin
    r:=p;
    g:=v;
    b:=t;
  End;
  3:
  Begin
    r:=p;
    g:=q;
    b:=v;
  End;
  4:
  Begin
    r:=t;
    g:=p;
    b:=v;
  End;
  Else
  Begin
    r:=v;
    g:=p;
    b:=q;
  End;
  End;
  If maxr<>1.0 Then r:=(r*maxr);
  If maxg<>1.0 Then g:=(g*maxg);
  If maxb<>1.0 Then b:=(b*maxb);
End;

//
Unit Description UnitIndex Master Index
procedure ColorToRGB(c:TColor;out r,g,b: Double;maxr,maxg,maxb: Double);
Begin
  with TRGBQuad(Graphics.ColorToRGB(c)) Do
  Begin
    r:=rgbRed;
    g:=rgbGreen;
    b:=rgbBlue;
    If maxr<>255 Then r:=(r*maxr)/255;
    If maxg<>255 Then g:=(g*maxg)/255;
    If maxb<>255 Then b:=(b*maxb)/255;
  End;
End;

//
Unit Description UnitIndex Master Index
Function RGBToColor(R,G,B:Double): TColor;
Begin
  Result:=TColor((Floor(R)*65536)+(Floor(G)*256)+Floor(B));
End;

//
Unit Description UnitIndex Master Index
procedure ColorToHSV(c:TColor;out h,s,v: Double;maxs,maxv: Double);
Var
  r,g,b: Double;
Begin
  ColorToRGB(c,r,g,b,255,255,255);
  RGBtoHSV(r,g,b,h,s,v,255,255,255,maxs,maxv);
End;

//
Unit Description UnitIndex Master Index
Function  HSVToColor(H,S,V:Double): TColor;
Var
  r,g,b: Double;
Begin
  HSVtoRGB(r,g,b,h,s,v,255,255,255,255,255);
  Result:=RGBToColor(r,g,b);
End;

//
Unit Description UnitIndex Master Index
Function  ColorToInternet(c:TColor): String;
Var
  r,g,b: Double;
Begin
  ColorToRGB(c,r,g,b,255,255,255);
  Result:=IntToHex(Floor(b),2)+IntToHex(Floor(g),2)+IntToHex(Floor(r),2);
End;

//
Unit Description UnitIndex Master Index
Function  ColorToHue(c:TColor): Double;
Var
  h,s,v: Double;
Begin
  ColorToHSV(c,h,s,v,255,255);
  Result:=h;
End;

//
Unit Description UnitIndex Master Index
Function  ColorToSaturation(c:TColor): Double;
Var
  h,s,v: Double;
Begin
  ColorToHSV(c,h,s,v,255,255);
  Result:=s;
End;

//
Unit Description UnitIndex Master Index
Function  ColorToValue(c:TColor): Double;
Var
  h,s,v: Double;
Begin
  ColorToHSV(c,h,s,v,255,255);
  Result:=v;
End;

//
Unit Description UnitIndex Master Index
function BitmapSimilarity(Bitmap1, Bitmap2: TBitmap): Double;
Var
  P1 : PByteArray;
  P2 : PByteArray;
  t  : Integer;
  x  : Integer;
  y  : Integer;
begin
  Result:=0.0;
  t:=0;
  If (BitMap1.Height<>BitMap2.Height) Or (BitMap1.Width<>BitMap2.Width) Then Exit;
  for y := 0 to BitMap1.Height -1 do
  begin
    P1 := BitMap1.ScanLine[y];
    P2 := BitMap2.ScanLine[y];
    for x := 0 to BitMap1.Width -1 do
    Begin
      If (ColorToValue(P1[x])-ColorToValue(P2[x]))>25 Then t:=t+1;
    End;
  end;
  Result:=(1-(t/(Bitmap1.Width*Bitmap1.Height)))*100;
end;

//
Unit Description UnitIndex Master Index
function BitmapSimilarity2(Bitmap1, Bitmap2: TBitmap): Double;
Var
  FBitmap1 : TBitmap;
  FBitmap2 : TBitmap;
  P1       : PByteArray;
  P2       : PByteArray;
  t        : Integer;
  x        : Integer;
  y        : Integer;
  inMaxX   : Integer;
  inMaxY   : Integer;
begin
  Result:=0.0;
  t:=0;
  If (BitMap1.Height<>BitMap2.Height) Or (BitMap1.Width<>BitMap2.Width) Then Exit;
  FBitmap1 := TBitmap.Create();
  FBitmap2 := TBitmap.Create();
  Try
    FBitmap1.Assign(Bitmap1);
    FBitmap2.Assign(Bitmap2);
    If FBitmap1.PixelFormat<>pf16bit Then FBitmap1.PixelFormat:=pf16bit;
    If FBitmap2.PixelFormat<>pf16bit Then FBitmap2.PixelFormat:=pf16bit;
    inMaxX   := FBitMap1.Width -1;
    inMaxY   := FBitMap1.Height -1;
    for y := 0 to inMaxY do
    begin
      P1 := FBitMap1.ScanLine[y];
      P2 := FBitMap2.ScanLine[y];
      If P1=P2 Then Continue;
      for x := 0 to inMaxX do
      Begin
        Try
          If P1[x] <> P2[x] Then t:=t+1;
        Except
        End;
      End;
    end;
    Result:=(1-(t/((inMaxX+1)*(inMaxY+1))))*100;
  Finally
    FBitmap1.Free;
    FBitmap2.Free;
  End;
end;

//
Unit Description UnitIndex Master Index
Function  BitmapSimilarity(BitmapFile1,BitmapFile2: String): Double;OverLoad;
Var
  Bitmap1 : TBitmap;
  Bitmap2 : TBitmap;
begin
  Result:=0.0;
  Bitmap1 := TBitmap.Create();
  Bitmap2 := TBitmap.Create();
  Try
    If Not FileExists(BitmapFile1) Then Exit;
    If Not FileExists(BitmapFile2) Then Exit;
    Bitmap1.LoadFromFile(BitmapFile1);
    Bitmap2.LoadFromFile(BitmapFile2);
    Result:=BitmapSimilarity(Bitmap1, Bitmap2);
  Finally
    Bitmap1.Free;
    Bitmap2.Free;
  End;
end;

//
Unit Description UnitIndex Master Index
Function  BitmapsSimilar(BitmapFile1,BitmapFile2: String;PercentDif:Double): Boolean;
Begin
  Result:=((100-BitmapSimilarity(BitmapFile1,BitmapFile2))Unit Description UnitIndex Master Index
Function  JpegSimilarity(JpegFile1,JpegFile2: String): Double;OverLoad;
Var
  Bitmap1 : TBitmap;
  Bitmap2 : TBitmap;
begin
  Result  :=0.0;
  If Not FileExists(JpegFile1) Then Exit;
  If Not FileExists(JpegFile2) Then Exit;
  Bitmap1 := TBitmap.Create();
  Bitmap2 := TBitmap.Create();
  Try
    If JpegFileToBitmap(JpegFile1,Bitmap1) Then
    Begin
      If JpegFileToBitmap(JpegFile2,Bitmap2) Then
      Begin
        Result:=BitmapSimilarity2(Bitmap1, Bitmap2);
      End;
    End;
  Finally
    Bitmap1.Free;
    Bitmap2.Free;
  End;
end;

//
Unit Description UnitIndex Master Index
Function  JpegsSimilar(JpegFile1,JpegFile2: String;PercentDif:Double): Boolean;
Var
  r : Double;
Begin
  r:= JpegSimilarity(JpegFile1,JpegFile2);
  Result:=((100-r)Unit Description UnitIndex Master Index
Function JpegFileToBitmap(JpegFile: String;Bitmap: TBitmap): Boolean;
Var
  Jpeg   : TJpegImage;
Begin
  Result := False;
  If Not FileExists(JpegFile) Then Exit;
  Jpeg   := TJpegImage.Create();
  Try
    Try
      Jpeg.LoadFromFile(JpegFile);
      Bitmap.Assign(JPeg);
      Result:=True;
    Except
      Result := False;
    End;
  Finally
    Jpeg  .Free;
  End;
End;

//
Unit Description UnitIndex Master Index
Function  JpegFileRenameToSimilarity(JpegFileBaseLine,JpegFileCompare,TimeStamp: String;var FileName: String;DeletionLevel: Integer): Boolean;
Var
  Similarity : Double;
  FilePath   : String;
  FilePrefix : String;
  sgTempNum  : String;
  i          : Integer;
Begin
  Result := False;
  If Not FileExists(JpegFileBaseLine) Then Exit;
  If Not FileExists(JpegFileCompare)  Then Exit;
  If LowerCase(JpegFileBaseLine)=LowerCase(JpegFileCompare) Then Exit;
  TimeStamp:=Trim(TimeStamp);
  If TimeStamp<>'' Then TimeStamp:=TimeStamp+'_';
  Try
    Similarity:= JpegSimilarity(JpegFileBaseLine,JpegFileCompare);
    If Similarity>=DeletionLevel Then
    Begin
      Exit;
    End;
    If Similarity>=100.0 Then Similarity:= 99.99999;
    FilePath  := ExtractFilePath(JpegFileCompare);
    FilePrefix:= FormatFloat('00.00000',Similarity);
    FilePrefix:= StringReplace(FilePrefix,'.','_',[]);
    FilePrefix:= TimeStamp+FilePrefix;
    For i:=0 To 9999 Do
    Begin
      sgTempNum:='0000'+IntToStr(i);
      sgTempNum:=Copy(sgTempNum,Length(sgTempNum)-3,4);
      If FileExists(FilePath+FilePrefix+sgTempNum+'.jpg') Then Continue;
      RenameFile(JpegFileCompare,FilePath+FilePrefix+sgTempNum+'.jpg');
      FileName:=FilePath+FilePrefix+sgTempNum+'.jpg';
      Result:=True;
      Break;
    End;
  Except
  End;
End;

end.
//