_graphutils.pas

East make Tray Icon in delphi

    Result := NullRect;
end;

function RectWidth(const R: TRect): Integer;
begin
  Result := Abs(R.Right - R.Left);
end;

//=== Color ==================================================================

const
  MaxBytePercent = High(Byte) * 0.01;

procedure GetRGBValue(const Color: TColor; out Red, Green, Blue: Byte);
var
  Temp: TColorRec;
begin
  Temp.Value := ColorToRGB(Color);
  Red := Temp.R;
  Green := Temp.G;
  Blue := Temp.B;
end;

function SetRGBValue(const Red, Green, Blue: Byte): TColor;
begin
  TColorRec(Result).Red := Red;
  TColorRec(Result).Green := Green;
  TColorRec(Result).Blue := Blue;
  TColorRec(Result).Flag := 0;
end;

function SetColorFlag(const Color: TColor; const Flag: Byte): TColor;
begin
  Result := Color;
  TColorRec(Result).Flag := Flag;
end;

function GetColorFlag(const Color: TColor): Byte;
begin
  Result := TColorRec(Color).Flag;
end;

function SetColorRed(const Color: TColor; const Red: Byte): TColor;
begin
  Result := ColorToRGB(Color);
  TColorRec(Result).Red := Red;
end;

function GetColorRed(const Color: TColor): Byte;
var
  Temp: TColorRec;
begin
  Temp.Value := ColorToRGB(Color);
  Result := Temp.Red;
end;

function SetColorGreen(const Color: TColor; const Green: Byte): TColor;
begin
  Result := ColorToRGB(Color);
  TColorRec(Result).Green := Green;
end;

function GetColorGreen(const Color: TColor): Byte;
var
  Temp: TColorRec;
begin
  Temp.Value := ColorToRGB(Color);
  Result := Temp.Green;
end;

function SetColorBlue(const Color: TColor; const Blue: Byte): TColor;
begin
  Result := ColorToRGB(Color);
  TColorRec(Result).Blue := Blue;
end;

function GetColorBlue(const Color: TColor): Byte;
var
  Temp: TColorRec;
begin
  Temp.Value := ColorToRGB(Color);
  Result := Temp.Blue;
end;

function BrightColor(const Color: TColor; const Pct: Single): TColor;
var
  Temp: TColorRec;
begin
  Temp.Value := ColorToRGB(Color);
  Temp.R := BrightColorChannel(Temp.R, Pct);
  Temp.G := BrightColorChannel(Temp.G, Pct);
  Temp.B := BrightColorChannel(Temp.B, Pct);
  Result := Temp.Value;
end;

function BrightColorChannel(const Channel: Byte; const Pct: Single): Byte;
var
  Temp: Integer;
begin
  if Pct < 0 then
    Result := DarkColorChannel(Channel, -Pct)
  else
  begin
    Temp := Round(Channel + Pct * MaxBytePercent);
    if Temp > High(Result) then
      Result := High(Result)
    else
      Result := Temp;
  end;
end;

function DarkColor(const Color: TColor; const Pct: Single): TColor;
var
  Temp: TColorRec;
begin
  Temp.Value := ColorToRGB(Color);
  Temp.R := DarkColorChannel(Temp.R, Pct);
  Temp.G := DarkColorChannel(Temp.G, Pct);
  Temp.B := DarkColorChannel(Temp.B, Pct);
  Result := Temp.Value;
end;

function DarkColorChannel(const Channel: Byte; const Pct: Single): Byte;
var
  Temp: Integer;
begin
  if Pct < 0 then
    Result := BrightColorChannel(Channel, -Pct)
  else
  begin
    Temp := Round(Channel - Pct * MaxBytePercent);
    if Temp < Low(Result) then
      Result := Low(Result)
    else
      Result := Temp;
  end;
end;

// Converts values of the XYZ color space using the D65 white point to D50 white point.
// The values were taken from www.srgb.com/hpsrgbprof/sld005.htm

procedure CIED65ToCIED50(var X, Y, Z: Extended);
var
  Xn, Yn, Zn: Extended;
begin
  Xn :=  1.0479 * X + 0.0299 * Y - 0.0502 * Z;
  Yn :=  0.0296 * X + 0.9904 * Y - 0.0171 * Z;
  Zn := -0.0092 * X + 0.0151 * Y + 0.7519 * Z;
  X := Xn;
  Y := Yn;
  Z := Zn;
end;

// converts each color component from a 16bits per sample to 8 bit used in Windows DIBs
// Count is the number of entries in Source and Target

procedure Gray16(const Source, Target: Pointer; Count: Cardinal);
var
  SourceRun: PWord;
  TargetRun: PByte;
begin
  SourceRun := Source;
  TargetRun := Target;
  while Count > 0 do
  begin
    TargetRun^ := SourceRun^ shr 8;
    Inc(SourceRun);
    Inc(TargetRun);
    Dec(Count);
  end;
end;

type
  PCMYK = ^TCMYK;
  TCMYK = packed record
    C: Byte;
    M: Byte;
    Y: Byte;
    K: Byte;
  end;

  PCMYK16 = ^TCMYK16;
  TCMYK16 = packed record
    C: Word;
    M: Word;
    Y: Word;
    K: Word;
  end;

// converts a stream of Count CMYK values to BGR
// BitsPerSample : 8 or 16
// CMYK is C,M,Y,K 4 byte record or 4 word record
// Target is always 3 byte record B, R, G

procedure CMYKToBGR(const Source, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload;
var
  R, G, B, K: Integer;
  I: Integer;
  SourcePtr: PCMYK;
  SourcePtr16: PCMYK16;
  TargetPtr: PByte;
begin
  case BitsPerSample of
    8:
      begin
        SourcePtr := Source;
        TargetPtr := Target;
        Count := Count div 4;
        for I := 0 to Count - 1 do
        begin
          K := SourcePtr.K;
          R := 255 - (SourcePtr.C - MulDiv(SourcePtr.C, K, 255) + K);
          G := 255 - (SourcePtr.M - MulDiv(SourcePtr.M, K, 255) + K);
          B := 255 - (SourcePtr.Y - MulDiv(SourcePtr.Y, K, 255) + K);
          TargetPtr^ := Max(0, Min(255, Byte(B)));
          Inc(TargetPtr);
          TargetPtr^ := Max(0, Min(255, Byte(G)));
          Inc(TargetPtr);
          TargetPtr^ := Max(0, Min(255, Byte(R)));
          Inc(TargetPtr);
          Inc(SourcePtr);
        end;
      end;
    16:
      begin
        SourcePtr16 := Source;
        TargetPtr := Target;
        Count := Count div 4;
        for I := 0 to Count - 1 do
        begin
          K := SourcePtr16.K;
          R := 255 - (SourcePtr16.C - MulDiv(SourcePtr16.C, K, 65535) + K) shr 8;
          G := 255 - (SourcePtr16.M - MulDiv(SourcePtr16.M, K, 65535) + K) shr 8;
          B := 255 - (SourcePtr16.Y - MulDiv(SourcePtr16.Y, K, 65535) + K) shr 8;
          TargetPtr^ := Max(0, Min(255, Byte(B)));
          Inc(TargetPtr);
          TargetPtr^ := Max(0, Min(255, Byte(G)));
          Inc(TargetPtr);
          TargetPtr^ := Max(0, Min(255, Byte(R)));
          Inc(TargetPtr);
          Inc(SourcePtr16);
        end;
      end;
    else
      raise EColorConversionError.CreateResFmt(@RsBitsPerSampleNotSupported, [BitsPerSample]);
  end;
end;

// converts a stream of Count CMYK values to BGR

procedure CMYKToBGR(const C, M, Y, K, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload;
var
  R, G, B: Integer;
  C8, M8, Y8, K8: PByte;
  C16, M16, Y16, K16: PWord;
  I: Integer;
  TargetPtr: PByte;
begin
  case BitsPerSample of
    8:
      begin
        C8 := C;
        M8 := M;
        Y8 := Y;
        K8 := K;
        TargetPtr := Target;
        Count := Count div 4;
        for I := 0 to Count - 1 do
        begin
          R := 255 - (C8^ - MulDiv(C8^, K8^, 255) + K8^);
          G := 255 - (M8^ - MulDiv(M8^, K8^, 255) + K8^);
          B := 255 - (Y8^ - MulDiv(Y8^, K8^, 255) + K8^);
          TargetPtr^ := Max(0, Min(255, Byte(B)));
          Inc(TargetPtr);
          TargetPtr^ := Max(0, Min(255, Byte(G)));
          Inc(TargetPtr);
          TargetPtr^ := Max(0, Min(255, Byte(R)));
          Inc(TargetPtr);
          Inc(C8);
          Inc(M8);
          Inc(Y8);
          Inc(K8);
        end;
      end;
    16:
      begin
        C16 := C;
        M16 := M;
        Y16 := Y;
        K16 := K;
        TargetPtr := Target;
        Count := Count div 4;
        for I := 0 to Count - 1 do
        begin
          R := 255 - (C16^ - MulDiv(C16^, K16^, 65535) + K16^) shr 8;
          G := 255 - (M16^ - MulDiv(M16^, K16^, 65535) + K16^) shr 8;
          B := 255 - (Y16^ - MulDiv(Y16^, K16^, 65535) + K16^) shr 8;
          TargetPtr^ := Max(0, Min(255, Byte(B)));
          Inc(TargetPtr);
          TargetPtr^ := Max(0, Min(255, Byte(G)));
          Inc(TargetPtr);
          TargetPtr^ := Max(0, Min(255, Byte(R)));
          Inc(TargetPtr);
          Inc(C16);
          Inc(M16);
          Inc(Y16);
          Inc(K16);
        end;
      end;
    else
      raise EColorConversionError.CreateResFmt(@RsBitsPerSampleNotSupported, [BitsPerSample]);
  end;
end;

// conversion of the CIE L*a*b color space to RGB using a two way approach assuming a D65 white point,
// first a conversion to CIE XYZ is performed and then from there to RGB

procedure CIELABToBGR(const Source, Target: Pointer; const Count: Cardinal); overload;
var
  FinalR,
  FinalG,
  FinalB: Integer;
  L, a, b,
  X, Y, Z, // color values in float format
  T, YYn3: Double;  // intermediate results
  SourcePtr,
  TargetPtr: PByte;
  PixelCount: Cardinal;
begin
  SourcePtr := Source;
  TargetPtr := Target;
  PixelCount := Count div 3;

  while PixelCount > 0 do
  begin
    // L should be in the range of 0..100 but at least Photoshop stores the luminance
    // in the range of 0..255
    L := SourcePtr^ / 2.55;
    Inc(SourcePtr);
    a := Shortint(SourcePtr^);
    Inc(SourcePtr);
    b := Shortint(SourcePtr^);
    Inc(SourcePtr);

    // CIE L*a*b can be calculated from CIE XYZ by:
    // L = 116 * ((Y / Yn)^1/3) - 16   if (Y / Yn) > 0.008856
    // L = 903.3 * Y / Yn              if (Y / Yn) <= 0.008856
    // a = 500 * (f(X / Xn) - f(Y / Yn))
    // b = 200 * (f(Y / Yn) - f(Z / Zn))
    //   where f(t) = t^(1/3) with (Y / Yn) > 0.008856
    //         f(t) = 7.787 * t + 16 / 116 with (Y / Yn) <= 0.008856
    //
    // by reordering the above equations we can calculate CIE L*a*b -> XYZ as follows:
    // L is in the range 0..100 and a as well as b in -127..127
    YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3
    if L < 7.9996 then
    begin
      Y := L / 903.3;
      X := a / 3893.5 + Y;
      Z := Y - b / 1557.4;
    end
    else
    begin
      T := YYn3 + a / 500;
      X := T * T * T;
      Y := YYn3 * YYn3 * YYn3;
      T := YYn3 - b / 200;
      Z := T * T * T;
    end;

    // once we have CIE XYZ it is easy (yet quite expensive) to calculate RGB values from this
    FinalR := Round(255.0 * ( 2.998 * X - 1.458 * Y - 0.541 * Z));
    FinalG := Round(255.0 * (-0.952 * X + 1.893 * Y + 0.059 * Z));
    FinalB := Round(255.0 * ( 0.099 * X - 0.198 * Y + 1.099 * Z));

    TargetPtr^ := Max(0, Min(255, Byte(FinalB)));
    Inc(TargetPtr);
    TargetPtr^ := Max(0, Min(255, Byte(FinalG)));
    Inc(TargetPtr);
    TargetPtr^ := Max(0, Min(255, Byte(FinalR)));
    Inc(TargetPtr);

    Dec(PixelCount);
  end;
end;

// conversion of the CIE L*a*b color space to RGB using a two way approach assuming a D65 white point,
// first a conversion to CIE XYZ is performed and then from there to RGB
// The BitsPerSample are not used so why leave it here.

procedure CIELABToBGR(LSource, aSource, bSource: PByte; const Target: Pointer; const Count: Cardinal); overload;
var
  FinalR,
  FinalG,
  FinalB: Integer;
  L, a, b,
  X, Y, Z, // color values in float format
  T, YYn3: Double;  // intermediate results
  TargetPtr: PByte;
  PixelCount: Cardinal;
begin
  TargetPtr := Target;
  PixelCount := Count div 3;

  while PixelCount > 0 do
  begin
    // L should be in the range of 0..100 but at least Photoshop stores the luminance
    // in the range of 0..256
    L := LSource^ / 2.55;
    Inc(LSource);
    a := Shortint(aSource^);
    Inc(aSource);
    b := Shortint(bSource^);
    Inc(bSource);

    // CIE L*a*b can be calculated from CIE XYZ by:
    // L = 116 * ((Y / Yn)^1/3) - 16   if (Y / Yn) > 0.008856
    // L = 903.3 * Y / Yn              if (Y / Yn) <= 0.008856
    // a = 500 * (f(X / Xn) - f(Y / Yn))
    // b = 200 * (f(Y / Yn) - f(Z / Zn))
    //   where f(t) = t^(1/3) with (Y / Yn) > 0.008856
    //         f(t) = 7.787 * t + 16 / 116 with (Y / Yn) <= 0.008856
    //
    // by reordering the above equations we can calculate CIE L*a*b -> XYZ as follows:
    // L is in the range 0..100 and a as well as b in -127..127
    YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3
    if L < 7.9996 then
    begin
      Y := L / 903.3;
      X := a / 3893.5 + Y;
      Z := Y - b / 1557.4;
    end
    else
    begin
      T := YYn3 + a / 500;
      X := T * T * T;
      Y := YYn3 * YYn3 * YYn3;
      T := YYn3 - b / 200;
      Z := T * T * T;
    end;

    // once we have CIE XYZ it is easy (yet quite expensive) to calculate RGB values from this