Question

I’m trying to make a cropping tool that will look as follow:

Original Image:

Crop tool – This is what I want:

Notice that the cropping area is showing the original colors, and around the colors are dim.

---

What I did is to place a TShape over my TImage with properties:

object Shape1: TShape
  Brush.Color = clSilver
  Pen.Mode = pmMask
  Pen.Style = psDot
end

I plan to use the TShape to make the re-sizing/coping control.
This is how it looks in Delphi:

As you can see, it does not looks good (colors palette looks dithered), but the main problem that I need the dim area to be around the crop area, not in the center. I have tried to cover the whole TImage with another TShpae, tried different Pen.Mode combinations but there are no good results, and I think my method/approach is bad.

Do you have any ideas on how to achieve the desired behavior?

Answer 1

a little part is missing here, but should not be a problem to add…

unit Unit3;
// 20121108 by Thomas Wassermann
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, jpeg;

type
  TForm3 = class(TForm)
    Image1: TImage;
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  private
    { Private-Deklarationen }
    FDownPoint, FCurrentPoint: TPoint;
  public
    { Public-Deklarationen }
  end;

var
  Form3: TForm3;

implementation

uses Math;
{$R *.dfm}

procedure TForm3.FormCreate(Sender: TObject);
begin
  PaintBox1.BringToFront;
end;

type
  pRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = ARRAY [0 .. $EFFFFFF] OF TRGBQuad;

Procedure SetAlpha(bmp: TBitMap; Alpha: Byte; R: TRect);
var
  pscanLine32: pRGBQuadArray;
  i, j: Integer;
begin
  bmp.PixelFormat := pf32Bit;
  bmp.HandleType := bmDIB;
  bmp.ignorepalette := true;
  bmp.alphaformat := afDefined;
  for i := 0 to bmp.Height - 1 do
  begin
    pscanLine32 := bmp.Scanline[i];
    for j := 0 to bmp.Width - 1 do
    begin
      if (j >= R.Left) and (j <= R.Right) and (i >= R.Top) and (i <= R.Bottom) then
      begin
        pscanLine32[j].rgbReserved := 0;
        pscanLine32[j].rgbBlue := 0;
        pscanLine32[j].rgbRed := 0;
        pscanLine32[j].rgbGreen := 0;
      end
      else
      begin
        pscanLine32[j].rgbReserved := Alpha;
        pscanLine32[j].rgbBlue := Alpha;
        pscanLine32[j].rgbRed := Alpha;
        pscanLine32[j].rgbGreen := Alpha;
      end;
    end;
  end;
end;

procedure TForm3.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FDownPoint.X := X;
  FDownPoint.Y := Y;
  FCurrentPoint := FDownPoint;
  PaintBox1.Invalidate;
end;

procedure TForm3.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in Shift then
  begin
    FCurrentPoint.X := X;
    FCurrentPoint.Y := Y;
    PaintBox1.Invalidate;
  end;
end;

procedure TForm3.PaintBox1Paint(Sender: TObject);
var
  bmp: TBitMap;
  SelRect: TRect;
begin
  bmp := TBitMap.Create;
  try
    bmp.Width := PaintBox1.Width;
    bmp.Height := PaintBox1.Height;
    if (FCurrentPoint.X = FDownPoint.X) and (FCurrentPoint.Y = FDownPoint.Y) then
      SelRect := PaintBox1.BoundsRect
    else
    begin
      SelRect.Left := Min(FCurrentPoint.X, FDownPoint.X);
      SelRect.Top := Min(FCurrentPoint.Y, FDownPoint.Y);
      SelRect.Right := Max(FCurrentPoint.X, FDownPoint.X);
      SelRect.Bottom := Max(FCurrentPoint.Y, FDownPoint.Y);
    end;
    SetAlpha(bmp, 140, SelRect);
    PaintBox1.Canvas.Draw(0, 0, bmp);
  finally
    bmp.Free;
  end;
end;

end.

The attempt on this solution is to use a overlying paintbox, same clientrect as the image, for all the drawing and selection. By using the coordinates generated by mouse/down/move a semitransparent bitmap is created, which is full transparent in the selected rect. After generation it’s painted on the paintbox. Further paintings could be done there e.g. frames, anchors, crosshair. Any user action would have to be caught in mousedown, depending of the selected part ,e.g. an anchor a sizing of the rect could be done.
Usually I’d prefer GDI+ for requests like this, but as shown, no additional units are required. Source: http://www.bummisoft.de/download/transparenteauswahl.zip