Создайте специальный инструмент визуального выделения для изображения.

Я решил проблему. Отвечаю на вопрос для протокола:

1- WMEraseBkgnd должен возвращать значение True, чтобы предотвратить закрашивание фона. Я ошибочно вернул False.

2- Я унаследовал неправильный метод WMPaint. Я также копирую обновленный Rect в новое растровое изображение, а затем рисую растровое изображение на холсте, что замедляет процесс рисования. Вот полный исправленный исходный код:

unit ScreenEmul;

interface

uses Classes, Types, Windows, Messages, Graphics, Controls, SysUtils, Dialogs, ExtCtrls;

const
   PixelCountMax = 32768;

type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..PixelCountMax-1] of TRGBTriple;
  TScreenEmul = class(TCustomControl)
  private
    LastRect, DrawRect: TRect;
    DrawStart: TPoint;
    MouseDown: Boolean;

    Backup, Darken: TBitmap;
    FBitmap: TBitmap;

    procedure BitmapChange(Sender: TObject);

    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;

    procedure DarkenBitmap(B: TBitmap);
    procedure RestoreImage;

    procedure CalculateDrawRect(X, Y: Integer);
    procedure SetBitmap(const Value: TBitmap);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Bitmap: TBitmap read FBitmap write SetBitmap;
  end;

implementation

{ TScreenEmul }

function  AlphaBlend(Color1, Color2: TRGBTriple; Alpha: Byte): TRGBTriple; overload;
var
  rPrimary : Real; // Primary (Color1) Intensity
  rSecondary: Real;// Secondary (Color2) Intensity
begin
  rPrimary:=((Alpha+1)/$100);
  rSecondary:=(($100-Alpha)/$100);

  with Result do
  begin
    rgbtBlue := Trunc(Color1.rgbtBlue * rPrimary + Color2.rgbtBlue * rSecondary);
    rgbtGreen := Trunc(Color1.rgbtGreen * rPrimary + Color2.rgbtGreen * rSecondary);
    rgbtRed := Trunc(Color1.rgbtRed * rPrimary + Color2.rgbtRed * rSecondary);
  end;
end;

procedure TScreenEmul.BitmapChange(Sender: TObject);
begin
  FreeAndNil(Backup);
  Backup := TBitmap.Create;
  Backup.Assign(FBitmap);

  DarkenBitmap(FBitmap);

  Darken := TBitmap.Create;
  Darken.Assign(FBitmap);
end;

procedure TScreenEmul.CalculateDrawRect(X, Y: Integer);
begin
  if X >= DrawStart.X then
  begin
    if DrawRect.Left <> DrawStart.X then DrawRect.Left := DrawStart.X;
    DrawRect.Right := X
  end
  else
  begin
    if DrawRect.Right <> DrawStart.X then DrawRect.Right := DrawStart.X;
    DrawRect.Left := X;
  end;
  if Y >= DrawStart.Y then
  begin
    if DrawRect.Top <> DrawStart.Y then DrawRect.Top := DrawStart.Y;
    DrawRect.Bottom := Y;
  end
  else
  begin
    if DrawRect.Bottom <> DrawStart.Y then DrawRect.Bottom := DrawStart.Y;
    DrawRect.Top := Y;
  end;
end;

constructor TScreenEmul.Create(AOwner: TComponent);
begin
  inherited;
  MouseDown := False;
  FBitmap := TBitmap.Create;
  FBitmap.OnChange := BitmapChange;

  DoubleBuffered := True;
end;

procedure TScreenEmul.DarkenBitmap(B: TBitmap);
var
  I, J: Integer;
  Row: PRGBTripleArray;
  rgbBlack: tagRGBTRIPLE;
begin
  rgbBlack.rgbtBlue := 0; rgbBlack.rgbtGreen := 0; rgbBlack.rgbtRed := 0;

  for I := 0 to B.Height - 1 do
  begin
    Row := B.ScanLine[I];

    for J := 0 to B.Width - 1 do
      Row[J] := AlphaBlend(Row[J], rgbBlack, 150);
  end;
end;

destructor TScreenEmul.Destroy;
begin
  FBitmap.Free;
  inherited;
end;

procedure TScreenEmul.RestoreImage;
begin
  BitBlt(FBitmap.Canvas.Handle,
    LastRect.Left, LastRect.Top, RectWidth(LastRect), RectHeight(LastRect),
    Darken.Canvas.Handle, LastRect.Left, LastRect.Top, SRCCOPY);
end;

procedure TScreenEmul.SetBitmap(const Value: TBitmap);
begin
  FBitmap := Value;
  FBitmap.OnChange := BitmapChange;
end;

procedure TScreenEmul.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := LResult(True);
end;

procedure TScreenEmul.WMLButtonDown(var Message: TWMLButtonDown);
begin
  MouseDown := True;

  with DrawRect do
  begin
    Left := Message.XPos;
    Top := Message.YPos;
    Right := Left;
    Bottom := Top;
  end;

  DrawStart.X := DrawRect.Top;
  DrawStart.Y := DrawRect.Left;
end;

procedure TScreenEmul.WMLButtonUp(var Message: TWMLButtonUp);
begin
  MouseDown := False;
  RestoreImage;
  InvalidateRect(Self.Handle, DrawRect, False);
end;

procedure TScreenEmul.WMMouseMove(var Message: TWMMouseMove);
begin
  if not MouseDown then Exit;
  CalculateDrawRect(Message.XPos, Message.YPos);

  RestoreImage;

  BitBlt(
    FBitmap.Canvas.Handle,
    DrawRect.Left, DrawRect.Top, RectWidth(DrawRect), RectHeight(DrawRect),
    Backup.Canvas.Handle,
    DrawRect.Left, DrawRect.Top,
    SRCCOPY);

  InvalidateRect(Self.Handle, DrawRect, False);

  LastRect := DrawRect;
end;

procedure TScreenEmul.WMPaint(var Message: TWMPaint);
var
  Rct: TRect;
  FullRepaint: Boolean;
begin
  FullRepaint := GetUpdateRect(Self.Handle, Rct, False);
  if not FullRepaint then
    Canvas.Draw(0, 0, FBitmap)
  else
    BitBlt(Canvas.Handle, Rct.Left, Rct.Top, RectWidth(Rct), RectHeight(Rct), FBitmap.Canvas.Handle, Rct.Left, Rct.Top, SRCCOPY);
end;

end.

Я сделал что-то подобное... вот выдержки из моего кода (только одно растровое изображение в памяти):

1. Захватить экран...

   Введите GrabScreen = (GTSCREEN); [...]

   procedure PGrabScreen(bm: TBitMap; gt : GrabScreen);
   var
     DestRect, SourceRect: TRect;
     h: THandle;
     hdcSrc : THandle;
     pt : TPoint;
   begin
     case(gt) of
      //...  
       GTSCREEN : h := GetDesktopWindow;
     end;
     if h <> 0 then
     begin
       try
         begin
             hdcSrc := GetWindowDC(h);
             GetWindowRect(h, SourceRect);
         end;
           bm.Width  := SourceRect.Right - SourceRect.Left;
           bm.Height := SourceRect.Bottom - SourceRect.Top;
           DestRect := Rect(0, 0, SourceRect.Right - SourceRect.Left, SourceRect.Bottom - SourceRect.Top);
             StretchBlt(bm.Canvas.Handle, 0, 0, bm.Width,
               bm.Height, hdcSrc,
               0,0,SourceRect.Right - SourceRect.Left,
               SourceRect.Bottom - SourceRect.Top,
               SRCCOPY);
             DrawCursor(bm,SourceRect.Left, SourceRect.Top);
       finally
         ReleaseDC(0, hdcSrc);
       end;
     end;
   end;
   

2. Размыть это растровое изображение после того, как выделение инициировано нажатием мыши (предлагаемый код)

   procedure BitmapBlur(var theBitmap: TBitmap);
   var
     x, y: Integer;
     yLine,
     xLine: PByteArray;
   begin
     for y := 1 to theBitmap.Height -2 do begin
       yLine := theBitmap.ScanLine[y -1];
       xLine := theBitmap.ScanLine[y];
       for x := 1 to theBitmap.Width -2 do begin
         xLine^[x * 3] := (
           xLine^[x * 3 -3] + xLine^[x * 3 +3] +
           yLine^[x * 3 -3] + yLine^[x * 3 +3] +
           yLine^[x * 3] + xLine^[x * 3 -3] +
           xLine^[x * 3 +3] + xLine^[x * 3]) div 8;
         xLine^[x * 3 +1] := (
           xLine^[x * 3 -2] + xLine^[x * 3 +4] +
           yLine^[x * 3 -2] + yLine^[x * 3 +4] +
           yLine^[x * 3 +1] + xLine^[x * 3 -2] +
           xLine^[x * 3 +4] + xLine^[x * 3 +1]) div 8;
         xLine^[x * 3 +2] := (
           xLine^[x * 3 -1] + xLine^[x * 3 +5] +
           yLine^[x * 3 -1] + yLine^[x * 3 +5] +
           yLine^[x * 3 +2] + xLine^[x * 3 -1] +
           xLine^[x * 3 +5] + xLine^[x * 3 +2]) div 8;
       end;
     end;
   end;
   

3. Выберите область* на размытом растровом изображении на экране (пример:)

   процедура GrabSelectedArea(Sender: TObject); начинать

   Grab(image1.Picture.Bitmap, GTSCREEN); bmp := Image1.Picture.Bitmap; image1.Width := image1.Picture.Bitmap.Width; image1.Height := image1.Picture.Bitmap.Height; Выбрать := истина; конец;

4. При этом инвертируйте (сместите) эффект размытия для выбранной области на растровом изображении.

*Вот код, который у меня есть для выбора

procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  DestRect, SourceRect : TRect;
begin

  if DoSelect then begin
    Image1.Canvas.Rectangle(SelX,SelY,SelX1,SelY1);   
    if X <= SelX then
    begin
      SelX1 := SelX;
      SelX := X;
    end
    else
      SelX1 := X;
    if Y <= SelY then
    begin
      SelY1 := SelY;
      SelY := Y;
    end
    else
      SelY1 := Y;
    Image1.Canvas.Pen.Mode := pmCopy;
    SourceRect := Rect(SelX,SelY,SelX1,SelY1);
    DestRect := Rect(0,0,SelX1-SelX,SelY1-SelY);
    Image1.Canvas.CopyRect(DestRect,Image1.Canvas,SourceRect);
    Image1.Picture.Bitmap.Height := SelY1-SelY;
    Image1.Picture.Bitmap.Width := SelX1-SelX;
    Image1.SetBounds(0,0,SelX1-SelX,SelY1-SelY);
    DoSelect := false;
    if FormIsFullScreen then
      RestoreForm;
  end;
end;


   procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if DoSelect then begin
     SelX := X;
     SelY := Y;
     SelX1 := X;
     SelY1 := Y;
     with Image1.Canvas do
     begin                    // Options shown in comments
        Pen.Width := 1;      // 2; // use with solid pen style
        Pen.Style := psDashDotDot; // psSolid;
        Pen.Mode := pmNotXOR; // pmXor;
        Brush.Style := bsClear;
        Pen.Color := clBlue; // clYellow;
     end;
   end;
end;


procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   if DoSelect then begin
     if ssLeft in Shift then
     begin
      Image1.Canvas.Rectangle(SelX,SelY,SelX1,SelY1);
      SelX1 := X;
      SelY1 := Y;
      Image1.Canvas.Rectangle(SelX,SelY,SelX1,SelY1);
     end;
   end;
end;

сначала вам нужно иметь растровое изображение в памяти (скрытое), которым вы манипулируете, чтобы эффект «мерцания» не появлялся. Во-вторых, вам нужно применить некоторый алгоритм затемнения к растровому изображению, которое вы отображаете, и скопировать выделение из исходного растрового изображения в видимое растровое изображение.

Другими словами:

1. OffsetBitmap (исходное растровое изображение) копируется в видимое растровое изображение.
2. when selection occurs:
   1. apply darken effect to visible Bitmap
   2. скопируйте выделенный прямоугольник из OFFSETBITMAP в видимое растровое изображение, чтобы у вас был выбор с исходной интенсивностью света.

Надеюсь, это поможет в какой-то степени - реализация этого требует немного времени, которого у меня сейчас нет.