Crear una herramienta de selección para la imagen visual especial

StackOverflow https://stackoverflow.com/questions/4131719

Pregunta

Quiero crear un tipo especial de selección, en el que la imagen se oscureció y, en parte, que el usuario está seleccionando, se muestra la imagen real. Se puede ver un ejemplo:

Ejemplo

He encontrado dos enfoques para implementar esto:

  1. La implementación de un control que muestra la imagen oscurecida. Cuando el usuario arrastre una elipse sobre este control, copiar una elipse la verdadera imagen (imagen que no se oscurece) en el lienzo de control. En este escenario cuando él / ella intenta cambiar el tamaño de la elipse a un tamaño más pequeño, primero toda el área rectangular de la elipse a oscuras y luego dibujar la imagen real en la nueva elipse más pequeña.

  2. Igual que el Método 1, pero en lugar de dibujar en el lienzo del control, se crea un nuevo control que muestran la imagen real. En este caso, todos los mensajes a enviar al nuevo control, debe pasar al control primario. Porque si el usuario intenta cambiar el tamaño de la elipse a un tamaño más pequeño, los mensajes enviados a WM_MOVE este control, en lugar del control de los padres.

Puede favor, que alguien me muestre la dirección correcta para la aplicación de este. Creo que el enfoque 1 es muy difícil de implementar, ya que causa mucho de la de parpadeo. A menos que poner en práctica una manera de volver a pintar solamente la parte cambiada por la función InvalidateRect.

Este es el código de la clase TScreenEmul que se implementa por mí, hasta ahora. Funciona pero tiene el parpadeo. 

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(False);
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
  B: TBitmap;
  Rct: TRect;
  X, Y: Integer;
  FullRepaint: Boolean;
begin
  inherited;

  FullRepaint := GetUpdateRect(Self.Handle, Rct, False);
  if not FullRepaint then
  begin
    Canvas.Draw(0, 0, FBitmap);
  end
  else
  begin
    B := TBitmap.Create;
    B.SetSize(RectWidth(Rct), RectHeight(Rct));
    FBitmap.Canvas.CopyRect(Rect(0, 0, B.Width, B.Height), B.Canvas, Rct);

    Canvas.Draw(0, 0, B);
    FreeAndNil(B);
  end;
end;

end.

Para poder utilizar esta clase: 

var
  ScreenEmul: TScreenEmul;
begin
  ScreenEmul := TScreenEmul.Create(Self);
  ScreenEmul.Parent := Self;
  ScreenEmul.Align := alClient;
  ScreenEmul.Bitmap.LoadFromFile('C:\img13.bmp');
¿Fue útil?

Solución

Me solucionó el problema. Contesto la pregunta para el registro:

1- WMEraseBkgnd debe devolver True para evitar que la pintura de fondo. Por error me ha devuelto false.

2- I heredó el método WMPaint que no es correcto. También copio el Rect actualizado en el nuevo mapa de bits y luego dibujar el mapa de bits en la lona que era lento el proceso de pintura. Aquí está el código fuente completo fijo: 

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.

Otros consejos

he hecho calle detrás similares ... aquí son extractos de mi código (sólo un mapa de bits en la memoria):

  1. Screen Grab ...

    Tipo       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. falta de definición de mapa de bits que una vez que la selección se inicia por abajo del ratón (código sugerido) 

    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. * Seleccionar zona en el mapa de bits borrosa en la pantalla (Ejemplo:)

    GrabSelectedArea procedimiento (Sender: TObject); comenzará

    Grab (image1.Picture.Bitmap, GTSCREEN);    bmp: = Image1.Picture.Bitmap;    image1.Width: = image1.Picture.Bitmap.Width;    image1.Height: = image1.Picture.Bitmap.Height;    DoSelect: = true;    terminar;

  4. Si lo hace, revertir (offset) el efecto de desenfoque para el área seleccionada en el mapa de bits.

* Aquí el código que tengo para la selección 

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;

Lo primero que necesita tener un mapa de bits en la memoria (oculto), que permite manipular por lo que no aparecerá el efecto de "parpadeo". En segundo lugar es necesario aplicar algún algoritmo se oscurecen en el mapa de bits al visualizar y copiar la selección de mapa de bits original al mapa de bits visible.

En otras palabras:

  1. OffsetBitmap (mapa de bits original) copiar a Bitmap visible.
  2. cuando se produce la selección:
    1. Aplicar efecto del oscurecimiento de mapa de bits visible
    2. copiar el rectángulo seleccionado de OFFSETBITMAP al mapa de bits visibles por lo que tendrá la selección con la intensidad de luz original.

Espero que esto ayude en algún grado -. Implementar esta toma un poco de tiempo que no tengo en este momento

Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow
scroll top