Delphi 显示部分模糊的图像

我正在尝试制作一个裁剪工具，如下所示：

原始图像：

裁剪工具-这就是我想要的：

请注意，裁剪区域显示的是原始颜色，而周围的颜色是暗淡的

---

我所做的是在我的

TImage

上放置一个

t形状

，带有属性：

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

我计划使用TShape进行重新调整尺寸/应对策略控制。 这是Delphi中的外观：

如您所见，它看起来不太好（调色板看起来抖动），但主要问题是我需要暗淡区域位于裁剪区域周围，而不是中间。我尝试用另一台TShpae覆盖整个图像，尝试了不同的

Pen.Mode

组合，但没有好结果，我认为我的方法/方法不好

---

您对如何实现所需的行为有什么想法吗？

这里缺少一小部分，但添加起来应该不是问题

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.

单元3；
//20121108作者：托马斯·沃瑟曼
接口
使用
窗口、消息、系统工具、变体、类、图形、控件、窗体、，
对话框、ExtCtrls、jpeg；
类型
TForm3=类别（TForm）
图1:TImage；
PaintBox1:tPaintbox1；
过程表单创建（发送方：ToObject）；
程序喷漆箱1喷漆（发送方：TObject）；
程序PaintBox1MouseDown（发送器：ToObject；按钮：TMouseButton；移位：tShift状态；X，Y：整数）；
程序PaintBox1MouseMove（发送方：TObject；Shift:TShiftState；X，Y：整数）；
私有的
{私营部门}
FDownPoint，fccurrentpoint:TPoint；
公众的
{公共部门}
结束；
变量
表3:TForm3；
实施
使用数学；
{$R*.dfm}
程序TForm3.FormCreate（发送方：TObject）；
开始
油漆箱1.BringToFront；
结束；
类型
pRGBQuadArray=^TRGBQuadArray；
TRGBQuadArray=TRGBQuad的数组[0..$efffff]；
过程SetAlpha（bmp:TBitMap；Alpha:Byte；R:TRect）；
变量
pscanLine32:prgbquadrarray；
i、 j：整数；
开始
bmp.PixelFormat:=pf32位；
bmp.HandleType:=bmDIB；
bmp.ignorepalette:=真；
bmp.alphaformat:=afDefined；
对于i:=0到bmp.Height-1 do
开始
pscanLine32:=bmp.Scanline[i]；
对于j:=0到bmp.Width-1do
开始
如果（j>=R.Left）和（j=R.Top）和（我认为，如果您添加一些文本来解释代码为什么要这样做以及如何实现OP的目标，您的答案会更好。这使您更容易理解…我完全同意Marjan的观点。只有代码的答案才有帮助，但通过一些阐述和解释，答案会有很大的改进。这是一个复杂的主题，我我同意，一个allready输入了更长的信息，因为windows认为它必须重新启动（他死了jim（谷歌））.我会再做一次的.谢谢bummi，显然他复活了？也许是使用了运输缓冲？还是在Jean Luc的时代？谢谢你.你的代码和方法为如何解决我的问题蒙上了阴影。