test1main.pas

ImageMagick library of image with Visual C++6

{ Unit Test1Main

  This is the main unit of demoprogram "Test1".

  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
  Changed: 01 April 2003
  Version: 1.3

  Changelog:
  06 Aug 2003: Changed the "finally" section of LoadFromFile so it is
               more robust, based on input of Salsa (NH)
  10 Aug 2003: Additions by Abbas Tabibi (Emboss, Quantize, Median,
               Adaptive Threshold, Threshold)

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

{.$DEFINE USESTREAM} // Define this to test LoadFromStream and SaveToStream

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, ExtDlgs, MagickImage, ComCtrls, Clipbrd;

type
  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    mnuOpen: TMenuItem;
    mnuSaveAs: TMenuItem;
    N1: TMenuItem;
    mnuExit: TMenuItem;
    opdPicture: TOpenPictureDialog;
    sbMain: TStatusBar;
    spdPicture: TSavePictureDialog;
    scbMain: TScrollBox;
    imMagick: TImage;
    Image1: TMenuItem;
    Effect1: TMenuItem;
    About1: TMenuItem;
    mnuAbout: TMenuItem;
    mnuResize: TMenuItem;
    mnuPrevFrame: TMenuItem;
    mnuNextFrame: TMenuItem;
    N2: TMenuItem;
    mnuHalfSize: TMenuItem;
    mnuDoubleSize: TMenuItem;
    mnuBlur: TMenuItem;
    mnuDespecle: TMenuItem;
    mnuFindEdges: TMenuItem;
    mnuEdit: TMenuItem;
    mnuCopy: TMenuItem;
    mnuPaste: TMenuItem;
    mnuOptions: TMenuItem;
    N3: TMenuItem;
    Emboss: TMenuItem;
    mnuQuantize: TMenuItem;
    mnuMedian: TMenuItem;
    mnuAddaptiveTreshold: TMenuItem;
    mnuThreshold: TMenuItem;
    procedure mnuExitClick(Sender: TObject);
    procedure mnuOpenClick(Sender: TObject);
    procedure mnuSaveAsClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure mnuResizeClick(Sender: TObject);
    procedure mnuPrevFrameClick(Sender: TObject);
    procedure mnuNextFrameClick(Sender: TObject);
    procedure mnuHalfSizeClick(Sender: TObject);
    procedure mnuDoubleSizeClick(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure mnuBlurClick(Sender: TObject);
    procedure mnuDespecleClick(Sender: TObject);
    procedure mnuFindEdgesClick(Sender: TObject);
    procedure mnuCopyClick(Sender: TObject);
    procedure mnuPasteClick(Sender: TObject);
    procedure mnuEditClick(Sender: TObject);
    procedure mnuOptionsClick(Sender: TObject);
    procedure EmbossClick(Sender: TObject);
    procedure mnuQuantizeClick(Sender: TObject);
    procedure mnuMedianClick(Sender: TObject);
    procedure mnuAddaptiveTresholdClick(Sender: TObject);
    procedure mnuThresholdClick(Sender: TObject);
  private
    FImage: TMagickImage;           // Owned copy of the TMagickImage object (or nil if none)
    FResizeFilterIndex: integer;    // Selected Resize filter
    FResizeBlurRadius: double;      // Selected Resize blur radius
    FResizeMethod: TImResizeMethod; // Selected Resize method
    FBlurSigma: double;             // Selected Blur sigma
    FQuality: cardinal;             // Compression quality (different meaning for JPG, JP2000 etc)
    FResolution: integer;           // Resolution for loading an image, or 0 for default
    // Tabibi
    FAdaptThreshWidth: Cardinal;    // Adaptive threshold width
    FAdaptThreshHeight: Cardinal;   // Adaptive threshold height
    FAdaptThreshOffset: Cardinal;   // Adaptive threshold offset
    FThreshold: Double;             // Value used for thresholding
    function CheckImagePresent: boolean;
    procedure UpdateImageInformation;
  public
    procedure SetStatusText(AText: string);
  end;

var
  frmMain: TfrmMain;

const

  cAppName = 'Test Magick';

implementation

uses
  MagickGeneral, Test1frmResize, Test1frmAbout, Test1frmOptions,
  Test1frmAdaptiveThreshold, ImageMagickAPI, Math;

{$R *.DFM}

function StrToFloatDef(const Value: string; Def: double): double;
begin
  try
    Result := StrToFloat(Value);
  except
    Result := Def;
  end;
end;

function DottedStr(AInt: int64): string;
begin
  Result := '';
  repeat
    if AInt > 999 then
      Result := '.' + Format('%.3d', [AInt mod int64(1000)]) + Result
    else
      Result := IntToStr(AInt) + Result;
    AInt := AInt div int64(1000);  
  until AInt = 0;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  // Some defaults
  FResizeFilterIndex := 11; // Lanczos
  FResizeBlurRadius  := 1.0;
  FBlurSigma         := 1.0;
  FQuality           := 75; // JPG/MIFF/PNG compression level

  FAdaptThreshWidth  := 3;
  FAdaptThreshHeight := 3;
  FAdaptThreshOffset := 2;
  FThreshold         := 0.1;

  // This updates the status bar with info
  UpdateImageInformation;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  if assigned(FImage) then FreeAndNil(FImage);
end;

procedure TfrmMain.mnuExitClick(Sender: TObject);
begin
  Close;
end;

function TfrmMain.CheckImagePresent: boolean;
begin
  Result := True;
  if not assigned(FImage) or FImage.Empty then begin
    ShowMessage('Please open or create an image first!');
    Result := False;
  end;
end;

procedure TfrmMain.UpdateImageInformation;
var
  HasImage, MultiFrame: boolean;
  AMessage: string;
  S: TSearchRec;
begin
  HasImage   := False;
  MultiFrame := False;
  if assigned(FImage) then begin
    HasImage := True;
    MultiFrame := FImage.FrameCount > 1;
    frmMain.Caption :=  Format('%s [%s]', [cAppName, FImage.FileName]);
    // Some basic statistics
    with FImage do begin
      // Pixel size
      AMessage :=
        Format('%dx%d pixels', [Width, Height]);
      // Frame count
      if FrameCount > 1 then
        AMessage := AMessage + Format(' - Frame %d of %d', [FrameIndex + 1, FrameCount]);
      // File size
      if length(FImage.Filename) > 0 then begin
        if FindFirst(FImage.FileName, faAnyFile, S) = 0 then begin
          AMessage := AMessage + Format(' - Filesize: %s bytes', [DottedStr(S.Size)]);
          FindClose(S);
        end;
      end;
    end;
    SetStatusText(AMessage);
    // Invalidate image
    imMagick.Invalidate;
  end else begin
    frmMain.Caption :=  cAppName;
    SetStatusText('No file(s) loaded');
  end;

  // Visibility of menus
  mnuCopy.Enabled      := HasImage;
  mnuPaste.Enabled     := Clipboard.HasFormat(CF_BITMAP);
  mnuPrevFrame.Enabled := MultiFrame AND (FImage.FrameIndex > 0);
  mnuNextFrame.Enabled := MultiFrame AND (FImage.FrameIndex < FImage.FrameCount -1);
end;

procedure TfrmMain.mnuOpenClick(Sender: TObject);
// Open an image file using the Magick library
{$IFDEF USESTREAM}
var
  AStream: TStream;
{$ENDIF}
begin
  try
    with opdPicture do begin
      Filter := CreateDialogFilter('R');
      if Execute then begin
        // Remove old image
        if assigned(FImage) then FImage.Free;
        imMagick.Picture.Bitmap := nil;
        // Status bar
        SetStatusText('Loading image...');
        // Create + load image
        FImage := TMagickImage.Create;
        FImage.Resolution := FResolution;
        try
          {$IFDEF USESTREAM}
          AStream := TFileStream.Create(FileName, fmOpenRead);
          try
            FImage.LoadFromStream(AStream);
          finally
            AStream.Free;
          end;
          {$ELSE}
          FImage.LoadFromFile(FileName);
          {$ENDIF}
        finally
          if not FImage.Empty then
          // Assign the image to the form's imMagick
            imMagick.Picture.Bitmap.Assign(FImage);
        end;
      end;
    end;
  finally
    UpdateImageInformation;
  end;
end;

procedure TfrmMain.mnuSaveAsClick(Sender: TObject);
// Save an image in one of the many formats that Magick supports
var
  AFileName: string;
{$IFDEF USESTREAM}
  AStream: TStream;
{$ENDIF}
begin
  if not CheckImagePresent then exit;
  with spdPicture do begin
    Filter := CreateDialogFilter('W');
    if Execute then begin
      // Set quality factor
      FImage.Quality := FQuality;
      // Force correct extension
      AFileName := ChangeFileExt(FileName, '.' + GetSaveFilterExtension(FilterIndex - 1));
      SetStatusText(Format('Saving image %s...', [ExtractFileName(AFileName)]));
      {$IFDEF USESTREAM}
      AStream := TFileStream.Create(AFilename, fmCreate);