test1main.pas

ImageMagick library of image with Visual C++6

      try
        // Very imporant: we must set the magick property, so ImageMagick knows
        // what *kind* of file to save
        FImage.MagickFormat := ExtractFileExt(AFileName);
        // now save it to the stream
        FImage.SaveToStream(AStream);
      finally
        AStream.Free;
      end;
      {$ELSE}
      // Save image
      FImage.SaveToFile(AFileName);
     {$ENDIF}
      FImage.Filename := AFileName;
    end;
  end;
  UpdateImageInformation;
end;

procedure TfrmMain.mnuResizeClick(Sender: TObject);
// Resize the image
begin
  if not CheckImagePresent then exit;
  // Create resize form
  with TfrmResize.Create(nil) do begin
    try
      // Fill in form
      edNewWidth.Text  := IntToStr(FImage.Width);
      edNewHeight.Text := IntToStr(FImage.Height);
      cbbFilter.ItemIndex := FResizeFilterIndex;
      edBlurRadius.Text := Format('%3.1f', [FResizeBlurRadius]);
      FAspectRatio := FImage.Width / FImage.Height;
      if ShowModal = mrOK then begin

        // Get form data
        FResizeFilterIndex := cbbFilter.ItemIndex;
        FResizeBlurRadius := StrToFloatDef(edBlurRadius.Text, FResizeBlurRadius);
        if rbResizeImage.Checked    then FResizeMethod := imResizeImage;
        if rbSampleImage.Checked    then FResizeMethod := imSampleImage;
        if rbScaleImage.Checked     then FResizeMethod := imScaleImage;
        if rbThumbnailImage.Checked then FResizeMethod := imThumbnailImage;

        // Start the resize
        FImage.ResizeFrame(
          StrToIntDef(edNewWidth.Text, FImage.Width),
          StrToIntDef(edNewHeight.Text, FImage.Height),
          FResizeMethod,
          TImFilterType(FResizeFilterIndex + 1),
          FResizeBlurRadius);

        // Reassign image
        imMagick.Picture.Bitmap.Assign(FImage);
        // Update info
        UpdateImageInformation;
      end;
    finally
      Free;
    end;
  end;
end;

procedure TfrmMain.mnuPrevFrameClick(Sender: TObject);
begin
  if assigned(FImage) then with FImage do begin
    FrameIndex := FrameIndex - 1;
    // Reassign image
    imMagick.Picture.Bitmap.Assign(FImage);
    // Update info
    UpdateImageInformation;
  end;
end;

procedure TfrmMain.mnuNextFrameClick(Sender: TObject);
begin
  if assigned(FImage) then with FImage do begin
    FrameIndex := FrameIndex + 1;
    // Reassign image
    imMagick.Picture.Bitmap.Assign(FImage);
    // Update info
    UpdateImageInformation;
  end;
end;

procedure TfrmMain.mnuHalfSizeClick(Sender: TObject);
begin
  if not CheckImagePresent then exit;
  // Make image halfsize
  FImage.ResizeFrame(0, 0, imMinifyImage);
  // Reassign image
  imMagick.Picture.Bitmap.Assign(FImage);
  // Update info
  UpdateImageInformation;
end;

procedure TfrmMain.mnuDoubleSizeClick(Sender: TObject);
begin
  if not CheckImagePresent then exit;
  // Make image double size
  FImage.ResizeFrame(0, 0, imMagnifyImage);
  // Reassign image
  imMagick.Picture.Bitmap.Assign(FImage);
  // Update info
  UpdateImageInformation;
end;

procedure TfrmMain.mnuAboutClick(Sender: TObject);
// Show the about box
begin
  with TfrmAbout.Create(nil) do begin
    try
      ShowModal;
    finally
      Free;
    end;
  end;
end;

procedure TfrmMain.mnuBlurClick(Sender: TObject);
begin
  if not CheckImagePresent then exit;
  // ask user for sigma
  FBlurSigma := StrToFloatDef(
    InputBox('Determine Blur Region', 'Sigma [pixels]', Format('%3.1f', [FBlurSigma])),
    FBlurSigma);
  SetStatusText('Blurring Image...');
  // And blur the image
  FImage.BlurFrame(FBlurSigma);
  // Reassign image
  imMagick.Picture.Bitmap.Assign(FImage);
  // Update info
  UpdateImageInformation;
end;

procedure TfrmMain.mnuDespecleClick(Sender: TObject);
begin
  if not CheckImagePresent then exit;
  SetStatusText('Despeckling...');
  // Despecle the image
  FImage.DespeckleFrame;
  // Reassign image
  imMagick.Picture.Bitmap.Assign(FImage);
  // Update info
  UpdateImageInformation;
end;

procedure TfrmMain.mnuFindEdgesClick(Sender: TObject);
begin
  if not CheckImagePresent then exit;
  SetStatusText('Finding Edges...');
  // Find edges
  FImage.EdgeFrame;
  // Reassign image
  imMagick.Picture.Bitmap.Assign(FImage);
  // Update info
  UpdateImageInformation;
end;

procedure TfrmMain.SetStatusText(AText: string);
begin
  sbMain.SimpleText := AText;
  Application.ProcessMessages;
end;

procedure TfrmMain.mnuCopyClick(Sender: TObject);
// Copy an image to the clipboard
begin
  Clipboard.Assign(FImage);
end;

procedure TfrmMain.mnuPasteClick(Sender: TObject);
// Paste an image from the clipboard
begin
  if not assigned(FImage) then
    FImage := TMagickImage.Create;
  FImage.Assign(Clipboard);
  // Reassign image
  imMagick.Picture.Bitmap.Assign(FImage);
  // Update info
  UpdateImageInformation;
end;

procedure TfrmMain.mnuEditClick(Sender: TObject);
begin
  UpdateImageInformation;
end;

procedure TfrmMain.mnuOptionsClick(Sender: TObject);
// Show options dialog
begin
  with TfrmOptions.Create(nil) do begin
    try
      // Options to form
      edQuality.Text := IntToStr(FQuality);
      edResolution.text := IntToStr(FResolution);
      // Show form
      if ShowModal = mrOK then begin
        // Form to options
        FQuality := Max(0, Min(100, StrToIntDef(edQuality.Text, 75)));
        FResolution := Max(0, StrToIntDef(edResolution.Text, 0));
      end;
    finally
      Free;
    end;
  end;
end;

procedure TfrmMain.EmbossClick(Sender: TObject);
//By Tabibi
begin
  if not CheckImagePresent then exit;
  SetStatusText('Embossing Image...');
  // Emboss the image
  FImage.Emboss(0, 1);
  // Reassign image
  imMagick.Picture.Bitmap.Assign(FImage);
  // Update info
  UpdateImageInformation;
end;

procedure TfrmMain.mnuQuantizeClick(Sender: TObject);
//By Tabibi
begin
  if not CheckImagePresent then exit;
  SetStatusText('Quantizeing Image...');
  // Quantize the image
  FImage.Quantize(2, 8, 0);
  // Reassign image
  imMagick.Picture.Bitmap.Assign(FImage);
  // Update info
  UpdateImageInformation;
end;

procedure TfrmMain.mnuMedianClick(Sender: TObject);
//By Tabibi
begin
  if not CheckImagePresent then exit;
  SetStatusText('Median Filtering Image...');
  // Median filter the image
  FImage.MedianFilterFrame(1);
  // Reassign image
  imMagick.Picture.Bitmap.Assign(FImage);
  // Update info
  UpdateImageInformation;
end;

procedure TfrmMain.mnuAddaptiveTresholdClick(Sender: TObject);
//By Tabibi
begin
  if not CheckImagePresent then exit;
  // NH: changed to dynamic form creation
  with TfrmAdaptiveThresholdOptions.Create(nil) do begin
    try
      // copy to form
      updWidth.Position  := FAdaptThreshWidth;
      updHeight.Position := FAdaptThreshHeight;
      updOffset.Position := FAdaptThreshOffset;

      if ShowModal = mrOK then begin

        // Copy from form
        FAdaptThreshWidth  := updWidth.Position;
        FAdaptThreshHeight := updHeight.Position;
        FAdaptThreshOffset := updOffset.Position;

        SetStatusText('Convert Image to Binary...');
        // Adaptive threshold the image
        FImage.AdaptiveThresholdFrame(FAdaptThreshWidth, FAdaptThreshHeight,
          FAdaptThreshOffset);
        // Reassign image
        imMagick.Picture.Bitmap.Assign(FImage);
        // Update info
        UpdateImageInformation;
      end;
    finally
      Free;
    end;
  end;
end;

procedure TfrmMain.mnuThresholdClick(Sender: TObject);
//By Tabibi
begin
  if not CheckImagePresent then exit;
  // NH: added this input box to set the threshold
  FThreshold := StrToFloatDef(InputBox('Threshold Value', 'Threshold',
    Format('%3.2f', [FThreshold])), FThreshold);
  SetStatusText('Convert Image to Binary...');
  // Threshold the image
  FImage.ThresholdFrame(FThreshold);
  // Reassign image
  imMagick.Picture.Bitmap.Assign(FImage);
  // Update info
  UpdateImageInformation;
end;

end.