Showing a TImage partially Dim - delphi

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