unit mdhGraphics;

{
[mdhGraphics] [1.1]
Delphi 2005
May 2006

LICENSE

The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
"http://www.mozilla.org/MPL/"

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is "[mdhGraphics.pas]".

The Initial Developer of the Original Code is Martin Holmes (Victoria,
BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2005 Martin Holmes 
and the University of Victoria Computing and Media Centre. The code was 
co-developed for university and personal projects, and rights are shared
by Martin Holmes and the University of Victoria. All Rights Reserved.
}

{
 Written by Martin Holmes, October 2005.

 This is a utility library containing functions relating to graphics,
 especially the conversion of HTML colours to Windows colours and vice-versa.

 Most functions here were abstracted from older libraries developed for the
 Hot Potatoes, Quandary, TexToys and Markin programs.

 Others are utility functions based on the Graphics32 libraries.

 Dependencies:

 Graphics32 (<http://www.graphics32.org>)

}

interface

uses Windows, Classes, Graphics, SysUtils, Controls, Forms, GR32, GR32_Image,
  FileCtrl, GR32_Layers, GR32_RangeBars, GR32_Filters, GR32_Transforms,
  GR32_Resamplers, jpeg;

function WebColorToWinColor(InColor: string): TColor;
function WebColorToWinColorDef(InColor: string; DefColor: TColor): TColor;
function ColorToHTML(InColor: TColor; AddHash: Boolean): string;
function NormalizeWebColor(InColor: string; MakeHex: Boolean): string;


{This function loads an image from disk, scales it to match the target width,
then saves it to FilePath, returning the ScaleFactor used and the OutputDimensions
to the calling function. Its primary use is to create a smaller version of
an image suitable for use on a Web page.}
function SaveScaledImage(TargetWidth: integer;  InputFile, OutputFile: WideString;
              var ScaleFactor: Double; var OutputDimensions: TPoint): Boolean;

{This function loads an image from disk, scales the specified region of it
to match the target width, then saves it to FilePath, returning the ScaleFactor
used and the OutputDimensions to the calling function. Its primary use is to
create a smaller version of part of an image suitable for use on a Web page,
perhaps as a thumbnail.}
function SaveScaledImageRegion(TargetWidth: integer;  InputFile, OutputFile: WideString;
              RegionX, RegionY, RegionW, RegionH: integer;
              var ScaleFactor: Double; var OutputDimensions: TPoint): Boolean;

function SaveResizedImageRegion(TargetWidth, TargetHeight: integer;  InputFile, OutputFile: WideString;
              RegionX, RegionY, RegionW, RegionH: integer): Boolean;

const ImageExtensions: WideString = '.gif.cur.pcx.ani.jpg.jpeg.bmp.ico.emf.wmf.tif.tiff';

var
NSC: TStringList;

implementation

function NormalizeWebColor(InColor: string; MakeHex: Boolean): string;
var
i: integer;
const
HexDigits = ['0'..'9','a'..'f','A'..'F'];

begin
  Result := InColor; //default
	InColor := Trim(InColor);
  if Length(InColor) < 1 then
    Exit;
//Check it against the named Colors table
	if NSC.Values[InColor] <> '' then
  	begin
     	if MakeHex = True then
        	Result := NSC.Values[InColor]
        else
        	Result := InColor;
        Exit;
     end;
  
//Add a hash if there isn't one
	if InColor[1] <> '#' then
  	InColor := '#' + InColor;

//Make it the right length
	if Length(InColor) > 7 then
  	InColor := Copy(InColor, 1, 7);
  while Length(InColor) < 7 do
  	InColor := InColor + '9';

//Make each relevant digit correct
	for i := 2 to 7 do
  	if not (InColor[i] in HexDigits) then
     	InColor[i] := '9';

  Result := InColor;
end;

function WebColorToWinColor(InColor: string): TColor;
begin
//First set default
	Result := clGray;

//Normalize to a hex Color
	InColor := NormalizeWebColor(InColor, True);

//Discard the initial hash
	InColor := Copy(InColor, 2, 6);

//Reorder the components
	InColor := '$' + Copy(InColor, 5, 2) + Copy(InColor, 3, 2) + Copy(InColor, 1, 2);

//Convert to Color
	Result := StrToIntDef(InColor, $00CCCCCC);

end;

function WebColorToWinColorDef(InColor: string; DefColor: TColor): TColor;
begin
//First set default
	Result := DefColor;

//Normalize to a hex Color
	InColor := NormalizeWebColor(InColor, True);

//Discard the initial hash
	InColor := Copy(InColor, 2, 6);

//Reorder the components
	InColor := '$' + Copy(InColor, 5, 2) + Copy(InColor, 3, 2) + Copy(InColor, 1, 2);

//Convert to Color
	Result := StrToIntDef(InColor, DefColor);

end;

function ColorToHTML(InColor: TColor; AddHash: Boolean): string;
var
  TheRgbValue: TColorRef;
begin
	TheRgbValue := ColorToRGB(InColor);
  Result := Format('%.2x%.2x%.2x',
                       [GetRValue(TheRGBValue),
                        GetGValue(TheRGBValue),
                        GetBValue(TheRGBValue)]);
	if AddHash = True then
  	Result := '#' + LowerCase(Result);
end;

function SaveScaledImage(TargetWidth: integer; InputFile, OutputFile: WideString;
  var ScaleFactor: Double; var OutputDimensions: TPoint): Boolean;
var
OrigBitmap: TBitmap32;
ScaledBitmap: TBitmap32;
BmpOut: TBitmap;
JPGOut: TJPEGImage;
OrigCursor: TCursor;

begin
  ScaleFactor := 1; //default
  Result := False; //default
  OrigCursor := Screen.Cursor;
  try
    Screen.Cursor := crHourglass;
    try
      JPGOut := TJPEGImage.Create;
      try
        BmpOut := TBitmap.Create;
        try
          OrigBitmap := TBitmap32.Create;
          try
//New for 1.6: specify a higher quality resampler.
            OrigBitmap.ResamplerClassName := 'TKernelResampler';
//Load the current image file into the new bitmap
            OrigBitmap.LoadFromFile(InputFile);

//Figure out the correct scaling: don't expand, just reduce
            if OrigBitmap.Width > TargetWidth then
              begin
                ScaleFactor := TargetWidth / OrigBitmap.Width;

//Scale the image
                ScaledBitmap := TBitmap32.Create;
                try
                  ScaledBitmap.SetSize(TargetWidth, Round(OrigBitmap.Height * ScaleFactor));

//Return the resulting width and height for the convenience of the calling function
                  OutputDimensions.X := ScaledBitmap.Width;
                  OutputDimensions.Y := ScaledBitmap.Height;

                  StretchTransfer(ScaledBitmap,
                                    Rect(0, 0, ScaledBitmap.Width, ScaledBitmap.Height),
                                    Rect(0, 0, ScaledBitmap.Width, ScaledBitmap.Height),
                                    OrigBitmap,
                                    Rect(0, 0, OrigBitmap.Width, OrigBitmap.Height),
                                    OrigBitmap.Resampler, dmOpaque, nil);
                    {OrigBitmap.DrawMode := dmOpaque;
                    OrigBitmap.DrawTo(ScaledBitmap, Rect(0, 0, ScaledBitmap.Width, ScaledBitmap.Height)); }

                  BmpOut.Assign(ScaledBitmap);
                finally
                  FreeAndNil(ScaledBitmap);
                end;
              end
            else
              begin
                BmpOut.Assign(OrigBitmap);
                ScaleFactor := 1;
                OutputDimensions.X := OrigBitmap.Width;
                OutputDimensions.Y := OrigBitmap.Height;
              end;
    //Save it to the right location
            JPGOut.CompressionQuality := 100;
            JPGOut.ProgressiveEncoding := True;
            JPGOut.Assign(BmpOut);
    //Enforce extension just in case
            JPGOut.SaveToFile(ChangeFileExt(OutputFile, '.jpg'));
            Result := True;
          finally
            FreeAndNil(OrigBitmap);
          end;
        finally
          FreeAndNil(BmpOut);
        end;
      finally
        FreeAndNil(JPGOut);
      end;
    finally
      Screen.Cursor := OrigCursor;
    end;
  except
//Returning false is enough
  end;
end;

function SaveScaledImageRegion(TargetWidth: integer;  InputFile, OutputFile: WideString;
              RegionX, RegionY, RegionW, RegionH: integer;
              var ScaleFactor: Double; var OutputDimensions: TPoint): Boolean;

var
OrigBitmap: TBitmap32;
TransformedBitmap: TBitmap32;
BmpOut: TBitmap;
JPGOut: TJPEGImage;
OrigCursor: TCursor;

begin
  ScaleFactor := 1; //default
  Result := False; //default

  //Sanity check
  if (TargetWidth < 1) then
    Exit;
  if (RegionW < 1) or (RegionH < 1) then
    Exit;
  OrigCursor := Screen.Cursor;
  try
    Screen.Cursor := crHourglass;
    try
      JPGOut := TJPEGImage.Create;
      try
        BmpOut := TBitmap.Create;
        try
          OrigBitmap := TBitmap32.Create;
          try
            TransformedBitmap := TBitmap32.Create;
            try
              OrigBitmap.ResamplerClassName := 'TKernelResampler';
//Load the current image file into the new bitmap
              OrigBitmap.LoadFromFile(InputFile);

              //More sanity checks
              if ((RegionX + RegionW) > OrigBitmap.Width) or
                 ((RegionY + RegionH) > OrigBitmap.Height) then
                  Exit;
//Figure out the correct scaling: don't expand, just reduce
              if RegionW > TargetWidth then
                begin
                  ScaleFactor := TargetWidth / RegionW;

//Scale the image

                  TransformedBitmap.SetSize(TargetWidth, Round(RegionH * ScaleFactor));


                  StretchTransfer(TransformedBitmap,
                                    Rect(0, 0, TransformedBitmap.Width, TransformedBitmap.Height),
                                    Rect(0, 0, TransformedBitmap.Width, TransformedBitmap.Height),
                                    OrigBitmap,
                                    Rect(RegionX, RegionY, (RegionW+RegionX), (RegionH+RegionY)),
                                    OrigBitmap.Resampler, dmOpaque, nil);
                end
              else
//The target width is the same as the original, or more
                begin
                  ScaleFactor := 1;
                  TransformedBitmap.SetSize(RegionW, RegionH);
                  BlockTransfer(TransformedBitmap,
                                0, 0,
                                Rect(0, 0, TransformedBitmap.Width, TransformedBitmap.Height),
                                OrigBitmap,
                                Rect(RegionX, RegionY, (RegionW+RegionX), (RegionH+RegionY)),
                                dmOpaque);
                end;

//Return the resulting width and height for the convenience of the calling function
              OutputDimensions.X := TransformedBitmap.Width;
              OutputDimensions.Y := TransformedBitmap.Height;
              BmpOut.Assign(TransformedBitmap);
            finally
              FreeAndNil(TransformedBitmap);
            end;
    //Save it to the right location
            JPGOut.CompressionQuality := 100;
            JPGOut.ProgressiveEncoding := True;
            JPGOut.Assign(BmpOut);
    //Enforce extension just in case
            JPGOut.SaveToFile(ChangeFileExt(OutputFile, '.jpg'));
            Result := True;
          finally
            FreeAndNil(OrigBitmap);
          end;
        finally
          FreeAndNil(BmpOut);
        end;
      finally
        FreeAndNil(JPGOut);
      end;
    finally
      Screen.Cursor := OrigCursor;
    end;
  except
//Returning false is enough
  end;
end;

function SaveResizedImageRegion(TargetWidth, TargetHeight: integer;  InputFile, OutputFile: WideString;
              RegionX, RegionY, RegionW, RegionH: integer): Boolean;

var
OrigBitmap: TBitmap32;
TransformedBitmap: TBitmap32;
BmpOut: TBitmap;
JPGOut: TJPEGImage;
OrigCursor: TCursor;

begin
  Result := False; //default

  //Sanity check
  if (TargetWidth < 1) then
    Exit;
  if (RegionW < 1) or (RegionH < 1) then
    Exit;
  OrigCursor := Screen.Cursor;
  try
    Screen.Cursor := crHourglass;
    try
      JPGOut := TJPEGImage.Create;
      try
        BmpOut := TBitmap.Create;
        try
          OrigBitmap := TBitmap32.Create;
          try
            TransformedBitmap := TBitmap32.Create;
            try
              OrigBitmap.ResamplerClassName := 'TKernelResampler';
//Load the current image file into the new bitmap
              OrigBitmap.LoadFromFile(InputFile);

              //More sanity checks
              if ((RegionX + RegionW) > OrigBitmap.Width) or
                 ((RegionY + RegionH) > OrigBitmap.Height) then
                  Exit;

//Scale the image

              TransformedBitmap.SetSize(TargetWidth, TargetHeight);


              StretchTransfer(TransformedBitmap,
                                    Rect(0, 0, TransformedBitmap.Width, TransformedBitmap.Height),
                                    Rect(0, 0, TransformedBitmap.Width, TransformedBitmap.Height),
                                    OrigBitmap,
                                    Rect(RegionX, RegionY, (RegionW+RegionX), (RegionH+RegionY)),
                                    OrigBitmap.Resampler, dmOpaque, nil);


              BmpOut.Assign(TransformedBitmap);
            finally
              FreeAndNil(TransformedBitmap);
            end;
    //Save it to the right location
            JPGOut.CompressionQuality := 100;
            JPGOut.ProgressiveEncoding := True;
            JPGOut.Assign(BmpOut);
    //Enforce extension just in case
            JPGOut.SaveToFile(ChangeFileExt(OutputFile, '.jpg'));
            Result := True;
          finally
            FreeAndNil(OrigBitmap);
          end;
        finally
          FreeAndNil(BmpOut);
        end;
      finally
        FreeAndNil(JPGOut);
      end;
    finally
      Screen.Cursor := OrigCursor;
    end;
  except
//Returning false is enough
  end;
end;

initialization

   NSC := TStringList.Create;
   NSC.Add('aliceblue=#F0F8FF');
   NSC.Add('antiquewhite=#FAEBD7');
   NSC.Add('aqua=#00FFFF');
   NSC.Add('aquamarine=#7FFFD4');
   NSC.Add('azure=#F0FFFF');
   NSC.Add('beige=#F5F5DC');
   NSC.Add('bisque=#FFE4C4');
   NSC.Add('black=#000000');
   NSC.Add('blanchedalmond=#FFEBCD');
   NSC.Add('blue=#0000FF');
   NSC.Add('blueviolet=#8A2BE2');
   NSC.Add('brown=#A52A2A');
   NSC.Add('burlywood=#DEB887');
   NSC.Add('cadetblue=#5F9EA0');
   NSC.Add('chartreuse=#7FFF00');
   NSC.Add('chocolate=#D2691E');
   NSC.Add('coral=#FF7F50');
   NSC.Add('cornflowerblue=#6495ED');
   NSC.Add('cornsilk=#FFF8DC');
   NSC.Add('crimson=#DC1436');
   NSC.Add('cyan=#00FFFF');
   NSC.Add('darkblue=#00008B');
   NSC.Add('darkcyan=#008B8B');
   NSC.Add('darkgoldenrod=#B8860B');
   NSC.Add('darkgrey=#A9A9A9');
   NSC.Add('darkgreen=#006400');
   NSC.Add('darkkhaki=#BDB76B');
   NSC.Add('darkmagenta=#8B008B');
   NSC.Add('darkolivegreen=#556B2F');
   NSC.Add('darkorange=#FF8C00');
   NSC.Add('darkorchid=#9932CC');
   NSC.Add('darkred=#8B0000');
   NSC.Add('darksalmon=#E9967A');
   NSC.Add('darkseagreen=#8FBC8F');
   NSC.Add('darkslateblue=#483D8B');
   NSC.Add('darkslategray=#2F4F4F');
   NSC.Add('darkturquoise=#00CED1');
   NSC.Add('darkviolet=#9400D3');
   NSC.Add('deeppink=#FF1493');
   NSC.Add('deepskyblue=#00BFFF');
   NSC.Add('dimgray=#696969');
   NSC.Add('dodgerblue=#1E90FF');
   NSC.Add('firebrick=#B22222');
   NSC.Add('floralwhite=#FFFAF0');
   NSC.Add('forestgreen=#228B22');
   NSC.Add('fuchsia=#FF00FF');
   NSC.Add('gainsboro=#DCDCDC');
   NSC.Add('ghostwhite=#F8F8FF');
   NSC.Add('gold=#FFD700');
   NSC.Add('goldenrod=#DAA520');
   NSC.Add('gray=#808080');
   NSC.Add('green=#008000');
   NSC.Add('greenyellow=#ADFF2F');
   NSC.Add('honeydew=#F0FFF0');
   NSC.Add('hotpink=#FF69B4');
   NSC.Add('indianred=#CD5C5C');
   NSC.Add('indigo=#4B0082');
   NSC.Add('ivory=#FFFFF0');
   NSC.Add('khaki=#F0E68C');
   NSC.Add('lavender=#E6E6FA');
   NSC.Add('lavenderblush=#FFF0F5');
   NSC.Add('lawngreen=#7CFC00');
   NSC.Add('lemonchiffon=#FFFACD');
   NSC.Add('lightblue=#ADD8E6');
   NSC.Add('lightcoral=#F08080');
   NSC.Add('lightcyan=#E0FFFF');
   NSC.Add('lightgoldenrodyellow=#FAFAD2');
   NSC.Add('lightgreen=#90EE90');
   NSC.Add('lightgrey=#D3D3D3');
   NSC.Add('lightpink=#FFB6C1');
   NSC.Add('lightsalmon=#FFA07A');
   NSC.Add('lightseagreen=#20B2AA');
   NSC.Add('lightskyblue=#87CEFA');
   NSC.Add('lightslategray=#778899');
   NSC.Add('lightsteelblue=#B0C4DE');
   NSC.Add('lightyellow=#FFFFE0');
   NSC.Add('lime=#00FF00');
   NSC.Add('limegreen=#32CD32');
   NSC.Add('linen=#FAF0E6');
   NSC.Add('magenta=#FF00FF');
   NSC.Add('maroon=#800000');
   NSC.Add('mediumaquamarine=#66CDAA');
   NSC.Add('mediumblue=#0000CD');
   NSC.Add('mediumorchid=#BA55D3');
   NSC.Add('mediumpurple=#9370DB');
   NSC.Add('mediumseagreen=#3CB371');
   NSC.Add('mediumslateblue=#7B68EE');
   NSC.Add('mediumspringgreen=#00FA9A');
   NSC.Add('mediumturquoise=#48D1CC');
   NSC.Add('mediumvioletred=#C71585');
   NSC.Add('midnightblue=#191970');
   NSC.Add('mintcream=#F5FFFA');
   NSC.Add('mistyrose=#FFE4E1');
   NSC.Add('moccasin=#FFE4B5');
   NSC.Add('navajowhite=#FFDEAD');
   NSC.Add('navy=#000080');
   NSC.Add('oldlace=#FDF5E6');
   NSC.Add('olive=#808000');
   NSC.Add('olivedrab=#6B8E23');
   NSC.Add('orange=#FFA500');
   NSC.Add('orangered=#FF4500');
   NSC.Add('orchid=#DA70D6');
   NSC.Add('palegoldenrod=#EEE8AA');
   NSC.Add('palegreen=#98FB98');
   NSC.Add('paleturquoise=#AFEEEE');
   NSC.Add('palevioletred=#DB7093');
   NSC.Add('papayawhip=#FFEFD5');
   NSC.Add('peachpuff=#FFDAB9');
   NSC.Add('peru=#CD853F');
   NSC.Add('pink=#FFC0CB');
   NSC.Add('plum=#DDA0DD');
   NSC.Add('powderblue=#B0E0E6');
   NSC.Add('purple=#800080');
   NSC.Add('red=#FF0000');
   NSC.Add('rosybrown=#BC8F8F');
   NSC.Add('royalblue=#4169E1');
   NSC.Add('saddlebrown=#8B4513');
   NSC.Add('salmon=#FA8072');
   NSC.Add('sandybrown=#F4A460');
   NSC.Add('seagreen=#2E8B57');
   NSC.Add('seashell=#FFF5EE');
   NSC.Add('sienna=#A0522D');
   NSC.Add('silver=#C0C0C0');
   NSC.Add('skyblue=#87CEEB');
   NSC.Add('slateblue=#6A5ACD');
   NSC.Add('slategray=#708090');
   NSC.Add('snow=#FFFAFA');
   NSC.Add('springgreen=#00FF7F');
   NSC.Add('steelblue=#4682B4');
   NSC.Add('tan=#D2B48C');
   NSC.Add('teal=#008080');
   NSC.Add('thistle=#D8BFD8');
   NSC.Add('tomato=#FF6347');
   NSC.Add('turquoise=#40E0D0');
   NSC.Add('violet=#EE82EE');
   NSC.Add('wheat=#F5DEB3');
   NSC.Add('white=#FFFFFF');
   NSC.Add('whitesmoke=#F5F5F5');
   NSC.Add('yellow=#FFFF00');
   NSC.Add('yellowgreen=#9ACD32');


finalization
	NSC.Free;

end.