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

Question

Je souhaite créer un type de sélection spécial, dans lequel l'image est assombrie et en partie sélectionnée par l'utilisateur, l'image réelle est affichée. Vous pouvez voir un 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 l'utilisateur fait glisser une ellipse sur ce contrôle, une ellipse copie l'image réelle (Image qui n'est PAS assombrie) dans la zone de contrôle. Dans ce scénario Lorsque vous essayez de redimensionner l'ellipse sur TAILLE INFERIEURE, commencez par assombrir toute la zone rectangulaire de l'ellipse, puis dessinez l'image réelle dans la nouvelle ellipse plus petite. Identique à l'approche 1, mais au lieu de dessiner 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 DEVRAIENT passer au contrôle parent. Parce que si l'utilisateur essaie de redimensionner l'ellipse à une taille plus petite, les messages WM_MOVE envoyés à ce contrôle, à la place du contrôle parent.

S'il vous plaît, quelqu'un me montre la bonne direction pour la mise en œuvre de cette. Je pense que cette approche est très difficile à mettre en œuvre car elle cause beaucoup de Flicker. À moins que j'implémente un moyen de repeindre seulement la partie modifiée par la fonction InvalidateRect.

Voici le code de la classe TScreenEmul qui est implémentée par moi, jusqu'à maintenant. Ca marche mais ça scintille.

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'); 

Answer 1

Je résolu le problème. Je réponds à la question pour l'enregistrement:

1- WMEraseBkgnd devrait renvoyer True pour éviter de peindre l'arrière-plan. J'ai par erreur retourné False.

2- J'ai hérité de la méthode WMPaint qui n'est pas correcte. J'ai également copié le Rect mis à jour dans le nouveau Bitmap et puis dessine l'image bitmap dans le canevas qui était lent le processus de peinture. Voici le code source fixe complet:

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. 

Answer 2

vous devez d'abord avoir une Bitmap dans la mémoire (cachée) que vous manipuler si l'effet « scintillement » n'apparaît pas. Deuxièmement, vous devez appliquer un algorithme darken sur l'image bitmap que vous affichez et copier la sélection de Bitmap d'origine vers le bitmap visible.

En d'autres termes:

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

Hope this helps dans une certaine mesure - mettre en œuvre cela prend un peu de temps que je n'ai pas en ce moment.

Answer 3

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

1. écran Grab ...

   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. Blur que bitmap une fois sélection est initiée par 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électionnez la zone * sur le bitmap floue à l'écran (:) exemple

   procédure GrabSelectedArea (Expéditeur: TObject); commencer

   Grab (image1.Picture.Bitmap, GTSCREEN); bmp: = Image1.Picture.Bitmap; image1.Width: = image1.Picture.Bitmap.Width; image1.Hauteur: = image1.Picture.Bitmap.Hauteur; DoSelect: = true; fin; Pour ce faire, inversez (déport) l'effet de flou de la zone 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;