Créer un outil de sélection visuelle spéciale pour l'image

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

Question

Je veux créer un type particulier de sélection, dans laquelle l'image assombrie et en partie quel utilisateur sélectionne, l'image réelle est affichée. Vous pouvez voir un exemple:

Exemple

J'ai trouvé deux approches pour la mise en œuvre ceci:

  1. La mise en œuvre d'un contrôle qui montre l'image assombrie. Lorsque utilisateur de faire glisser une ellipse sur ce contrôle, une ellipse copie l'image réelle (image qui obscurcissent) dans la toile de commande. Dans ce scénario Quand il / elle essaie de Redimensionner l'ellipse à taille réduite, d'abord l'ensemble de la zone rectangulaire de l'ellipse sombre puis tirage d'image réelle dans le nouveau petit Ellipse.

  2. Identique à l'approche 1, mais au lieu de tirer sur la toile du contrôle, nous créons un nouveau contrôle qui montre l'image réelle. Dans ce cas, tous les messages envoyés au nouveau contrôle, doit passer au contrôle des parents. Parce que si essayer d'utilisateur de redimensionner l'ellipse plus petite taille, les messages envoyés WM_MOVE à ce contrôle, au lieu du contrôle parent.

Peut plaire, quelqu'un me montrer la bonne direction pour la mise en œuvre cela. Je pense que l'approche 1 est très difficile à mettre en œuvre parce qu'il cause de plein de Flicker. À moins que je mets en œuvre un moyen de seulement repeindre la partie modifiée par la fonction InvalidateRect.

Voici le code de la classe TScreenEmul qui est mis en œuvre par moi, jusqu'à présent. Il fonctionne, mais il a scintillement. 

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.

Pour utiliser cette classe: 

var
  ScreenEmul: TScreenEmul;
begin
  ScreenEmul := TScreenEmul.Create(Self);
  ScreenEmul.Parent := Self;
  ScreenEmul.Align := alClient;
  ScreenEmul.Bitmap.LoadFromFile('C:\img13.bmp');
Était-ce utile?

La solution

Je résolu le problème. Répondre à la question de l'enregistrement:

1- WMEraseBkgnd doit retourner vrai pour empêcher la peinture de fond. Je retourne faux par erreur.

2- I a hérité de la méthode de WMPaint qui est incorrect. Je copie aussi le Rect mis à jour dans une nouvelle Bitmap puis dessine la bitmap en toile qui était lent le processus de peinture. Voici le code source complet fixe: 

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.

Autres conseils

J'ai fait someting similaires ... voici des extraits de mon code (un seul bitmap en mémoire):

  1. écran masq ...

    Type       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. Flou que bitmap, une fois la sélection est initiée par le bas de la souris (code suggéré) 

    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. * Sélectionner la zone sur l'image bitmap floue à l'écran (exemple:)

    procédure

    de GrabSelectedArea (Sender: TObject); commencer

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

  4. Ce faisant, la marche arrière (offset) l'effet de flou pour la région sélectionnée sur l'image bitmap.

* Voici le code que j'ai pour la sélection 

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;

vous devez d'abord avoir une bitmap en mémoire (caché) que vous manipuler si l'effet « scintillement » n'apparaît pas. Deuxièmement, vous devez appliquer un algorithme assombrir le bitmap et vous affichez la copie la sélection de Bitmap originale Bitmap visible.

En d'autres termes:

  1. OffsetBitmap (bitmap d'origine) à copier Bitmap visible.
  2. lorsque la sélection se produit:
    1. Appliquer un effet à obscurcir Bitmap visible
    2. copier le rectangle sélectionné de OFFSETBITMAP au bitmap visible de sorte que vous aurez votre sélection avec une intensité lumineuse originale.

Espérons que cela aide à un certain degré -. La mise en œuvre cela prend un peu de temps que je n'ai pas en ce moment

Licencié sous: CC-BY-SA avec attribution
Non affilié à StackOverflow
scroll top