magickimage.pas

ImageMagick library of image with Visual C++6

{ Unit MagickImage

  This is a wrapper unit that implements an ImageMagick image class in Delphi.
  See http://studio.imagemagick.org/ for information about ImageMagick library.

  TMagickImage descends from TGraphic and can be assigned to and from TBitmap.

  TMagickImage supports loading and saving of a multitude of file formats.
  A complete list can be found here:
  http://studio.imagemagick.org/www/formats.html

  TMagickImage supports a multiple of resizing routines.

  TMagickImage supports a subset of image effects. This list still lacks a lot
  of the functionality from ImageMagick but can hopefully be completed over
  time.

  In order for TMagickImage to work, the default Windows binary distribution
  of ImageMagick must be installed. This is a list of some 13 DLL files.
  More info can be found in the readme file and on the information web page.

  Example project code is available.

  Please check this website for most recent updates:
  http://www.simdesign.nl/components/imagemagick.html

  Author:  Nils Haeck M.Sc. (www.simdesign.nl) (c) 2003 Simdesign
  Created: 25 March 2003
  Version: 1.32

  Changelog:
  28 Mar 2003: Changed initialisation method (NH)
  31 Mar 2003: Added "LoadFromStream" and "SaveToStream" (NH)
               Added Assign method, and clipboard support (NH)
  01 Apr 2003: Added AssignTo method, Quality property, Draw
               method, added registring of types for preview (NH)
  20 Jun 2003: Exposed "ImageInfo", Added "Resolution" (NH)
  06 Aug 2003: Implemented updates to ProcessExceptions and
               ReplaceFrame, based on input from Salsa (NH)
  12 Aug 2003: Additions by Abbas Tabibi: Emboss, MedianFilterFrame,
               AdaptiveThresholdFrame, ThresholdFrame, Quantize, ImagePixels
  02 Sep 2003: Another change of ReplaceFrame, based on input from
               Petar, fixing introduced memory leak (NH)
  20 Sep 2003: Addition of SetWidth and SetHeight in order to avoid the
               abstract warning, makes it compatible with BCB (NH)              

  Contributors:
  Ian Stuart, Salsa, Abbas Tabibi, Petar

  Please change version number and add a change log whenever updates are made
  to this file.

  ****************************************************************
  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.
}
unit MagickImage;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ImageMagickAPI, ImError, Clipbrd;

type

  TImResizeMethod = (
    imMagnifyImage,    // Scale up to twice the size
    imMinifyImage,     // Scale down to half the size
    imResizeImage,     // Highquality resize using one of the filters
    imSampleImage,     // Scale using pixel sampling (no additional colors)
    imScaleImage,      // Lowquality resize
    imThumbnailImage); // Lowquality downsize only

  TMagickImage = class(TGraphic)
  private
    FFrameIndex: integer;       // Current frame
    FFrames: PImrImage;         // Pointer to the Magick image list (can be multiframe)
    FImageInfo: PImrImageInfo;  // Pointer to the Magick TImrImageInfo structure
    FMinExceptionLevel:integer; // Exceptions below this level are ignored
    FResolution: integer;       // Resolution at which to load an image
    // Check if the library is loaded. If not, raise an exception
    procedure CheckLibrary;
    function GetCurrentFrame: PImrImage;
    function GetFileName: string;
    function GetMagickFormat: string;
    function GetQuality: integer;
    procedure ProcessExceptions(const ExceptionInfo: TImrExceptionInfo);
    procedure SetFrameIndex(const Value: integer);
    procedure ReplaceFrame(NewFrame: PImrImage);
    procedure SetFileName(const Value: string);
    procedure SetMagickFormat(const Value: string);
    procedure SetQuality(const Value: integer);
  protected
    procedure AssignTo(Dest: TPersistent); override;
    function GetEmpty: Boolean; override;
    function GetFrameCount: integer; virtual;
    function GetFramePtr(Index: integer): PImrImage; virtual;
    function GetHeight: Integer; override;
    function GetWidth: Integer; override;
    procedure SetHeight(Value: Integer); override;
    procedure SetWidth(Value: Integer); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Clear;
    // Effects
    procedure BlurFrame(Sigma: double; Radius: double = 0); virtual;
    procedure DespeckleFrame; virtual;
    procedure EdgeFrame(Radius: double = 0); virtual;
    procedure ResizeFrame(NewWidth, NewHeight: integer; Method: TImResizeMethod = imResizeImage;
      Filter: TImFilterType = imLanczosFilter; BlurRadius: double = 1.0); virtual;
    // TGraphic abstract functions
    procedure Assign(Source: TPersistent); override;
    procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
      APalette: HPALETTE); override;
    procedure LoadFromFile(const Filename: string); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
      var APalette: HPALETTE); override;
    procedure SaveToFile(const Filename: string); override;
    procedure SaveToStream(Stream: TStream); override;
    //By Tabibi
    procedure Emboss(const Radius, Sigma: Double);
    procedure MedianFilterFrame(Radius: Double=1);
    procedure AdaptiveThresholdFrame(Width, height: Cardinal; Offset: Integer);
    procedure ThresholdFrame(const Threshold: Double);
    procedure Quantize(DitherSize, NumberColors, TreeDepth: Cardinal);
    // Properties
    property CurrentFrame: PImrImage read GetCurrentFrame;
    property FrameCount: integer read GetFrameCount;
    property FrameIndex: integer read FFrameIndex write SetFrameIndex;
    property FileName: string read GetFileName write SetFileName;
    property ImageInfo: PImrImageInfo read FImageInfo;
    property MagickFormat: string read GetMagickFormat write SetMagickFormat;
    property MinExceptionLevel: integer read FMinExceptionLevel write FMinExceptionLevel;
    property Quality: integer read GetQuality write SetQuality;
    property Resolution: integer read FResolution write FResolution;
  end;

var
  // Global variable - indicates if the ImageMagick library is available
  // (aka dynamically loaded)
  FImageMagickAvail: boolean = False;

implementation

uses
  Math, MagickGeneral;

{ TMagickImage }

procedure TMagickImage.AdaptiveThresholdFrame(Width, Height: Cardinal;
  Offset: Integer);
//By Tabibi
var
  ExceptionInfo: TImrExceptionInfo;
  AFrame, NewFrame: PImrImage;
begin
  // Create new Exception Info
  GetExceptionInfo(@ExceptionInfo);
  try
    AFrame := GetFramePtr(FFrameIndex);
    NewFrame := nil;
    if assigned(AFrame) then begin
      NewFrame :=AdaptiveThresholdImage(AFrame, Width, Height, Offset, @ExceptionInfo);
      // Any errors?
      ProcessExceptions(ExceptionInfo);
    end;
    // Now copy the image back to the original position
    ReplaceFrame(NewFrame);
  finally
    DestroyExceptionInfo(@ExceptionInfo);
  end;
end;

procedure TMagickImage.Assign(Source: TPersistent);
var
  AStream: TStream;
  ABitmap: TBitmap;
begin
  if Source is TBitmap then begin
    // Copy from the bitmap in Source
    Clear; // cleanup first
    // Use a memory stream to add the image
    AStream := TMemoryStream.Create;
    try
      // Save to the stream
      (Source as TBitmap).SaveToStream(AStream);
      // Reset stream
      AStream.Position := 0;
      // And load it
      LoadFromStream(AStream);
    finally
      AStream.Free;
    end;
    exit;
  end;
  if Source is TClipboard then begin
    ABitmap := TBitmap.Create;
    try
      ABitmap.Assign(Source);
      Assign(ABitmap);
    finally
      ABitmap.Free;
    end;
    exit;
  end;
  inherited;
end;

procedure TMagickImage.AssignTo(Dest: TPersistent);
var
  r, AWidth: integer;
  AImage: PImrImage;
  ABitmap: TBitmap;
  ExceptionInfo: TImrExceptionInfo;
begin
  if Dest is TBitmap then begin
    ABitmap := TBitmap(Dest);
    // We copy ourself to the bitmap in Dest
    AImage := GetFramePtr(FFrameIndex);

    if not assigned(AImage) then begin
      ABitmap.Width  := 0;
      ABitmap.Height := 0;
      exit;
    end;

    // Copy our properties to Dest
    ABitmap.PixelFormat := pf24bit; // always use 24-bit
    ABitmap.Width       := Width;
    ABitmap.Height      := Height;

    // Copy image data
    AWidth := Width;
    GetExceptionInfo(@ExceptionInfo);
    try
      for r := 0 to ABitmap.Height - 1 do begin
        DispatchImage(AImage, 0, r, AWidth, 1, 'BGR', imCharPixel, ABitmap.Scanline[r], @ExceptionInfo);
        ProcessExceptions(ExceptionInfo);
      end;
    finally
      DestroyExceptionInfo(@ExceptionInfo);
    end;
    exit;
  end;
  inherited;
end;

procedure TMagickImage.BlurFrame(Sigma, Radius: double);
// Blur the current frame. Radius must normally be bigger than Sigma to produce
// valid results. Radius = 0 will let ImageMagick select a suitable Radius.
var
  ExceptionInfo: TImrExceptionInfo;
  AFrame, NewFrame: PImrImage;
begin
  // Create new Exception Info
  GetExceptionInfo(@ExceptionInfo);
  try
    AFrame := GetFramePtr(FFrameIndex);
    NewFrame := nil;
    if assigned(AFrame) then begin
      NewFrame := BlurImage(AFrame, Radius, Sigma, @ExceptionInfo);
      // Any errors?
      ProcessExceptions(ExceptionInfo);
    end;
    // Now copy the image back to the original position
    ReplaceFrame(NewFrame);
  finally
    DestroyExceptionInfo(@ExceptionInfo);
  end;
end;

procedure TMagickImage.CheckLibrary;
begin
  if not FImageMagickAvail then
    raise EInvalidGraphic.Create('ImageMagick library not loaded');
end;

procedure TMagickImage.Clear;
// Free all resources and reset pointers to nil
begin
  if assigned(FFrames) then DestroyImageList(FFrames);
  // Throw away old image info
  if assigned(FImageInfo) then
    DestroyImageInfo(FImageInfo);
  FImageInfo := nil;
  // And recreate a new one
  FImageInfo := CloneImageInfo(nil);
  // Defaults
  FFrames := nil;
  FFrameIndex := 0;
  FMinExceptionLevel := imUndefinedException + 1;
end;

constructor TMagickImage.Create;
begin
  inherited;
  // Check to see if the library is present, if not it raises
  // an EInvalidGraphic exception
  CheckLibrary;
  // Clear the image - which will also set some defaults
  Clear;
end;

procedure TMagickImage.DespeckleFrame;
// Despeckle the current frame (remove noise, but preserve edges)
var
  ExceptionInfo: TImrExceptionInfo;
  AFrame, NewFrame: PImrImage;
begin
  // Create new Exception Info
  GetExceptionInfo(@ExceptionInfo);
  try
    AFrame := GetFramePtr(FFrameIndex);
    NewFrame := nil;
    if assigned(AFrame) then begin
      NewFrame := DespeckleImage(AFrame, @ExceptionInfo);
      // Any errors?
      ProcessExceptions(ExceptionInfo);
    end;
    // Now copy the image back to the original position
    ReplaceFrame(NewFrame);
  finally
    DestroyExceptionInfo(@ExceptionInfo);
  end;
end;

destructor TMagickImage.Destroy;
begin
  Clear;
  // Throw away old image info
  if assigned(FImageInfo) then
    DestroyImageInfo(FImageInfo);
  inherited;
end;

procedure TMagickImage.Draw(ACanvas: TCanvas; const Rect: TRect);
var
  ABitmap: TBitmap;
begin
  ABitmap := TBitmap.Create;
  try
    ABitmap.Assign(Self);
    ACanvas.StretchDraw(Rect, ABitmap);
  finally
    ABitmap.Free;
  end;
end;

procedure TMagickImage.EdgeFrame(Radius: double);
// Find edges in frame. Radius = 0 will let ImageMagick find a suitable radius
// for the filter, or specify any radius yourself
var
  ExceptionInfo: TImrExceptionInfo;
  AFrame, NewFrame: PImrImage;
begin
  // Create new Exception Info
  GetExceptionInfo(@ExceptionInfo);
  try
    AFrame := GetFramePtr(FFrameIndex);
    NewFrame := nil;
    if assigned(AFrame) then begin
      NewFrame := EdgeImage(AFrame, Radius, @ExceptionInfo);
      // Any errors?
      ProcessExceptions(ExceptionInfo);
    end;
    // Now copy the image back to the original position
    ReplaceFrame(NewFrame);
  finally
    DestroyExceptionInfo(@ExceptionInfo);
  end;
end;

procedure TMagickImage.Emboss(const Radius, Sigma: Double);
//By Tabibi
var
  ExceptionInfo: TImrExceptionInfo;
  AFrame, NewFrame: PImrImage;
begin
  // Create new Exception Info
  GetExceptionInfo(@exceptionInfo);

  try
    AFrame := GetFramePtr(FFrameIndex);
    NewFrame := nil;
    if assigned(AFrame) then
    begin
      NewFrame:=EmbossImage(AFrame,Radius,Sigma,@ExceptionInfo);
    end;
    // Now copy the image back to the original position
    ReplaceFrame(NewFrame);

      // Any errors?
    ProcessExceptions(ExceptionInfo);
  finally
    DestroyExceptionInfo(@ExceptionInfo);
  end;
end;

function TMagickImage.GetCurrentFrame: PImrImage;
begin
  Result := GetFramePtr(FFrameIndex);
end;

function TMagickImage.GetEmpty: Boolean;
var
  AFrame: PImrImage;
begin
  AFrame := GetFramePtr(FFrameIndex);
  Result := (AFrame = nil) or (Width * Height = 0);
end;

function TMagickImage.GetFileName: string;
begin
  Result := '';
  if assigned(FImageInfo) then
    Result := FImageInfo.filename;
end;

function TMagickImage.GetFrameCount: integer;