创建一个特殊的视觉选择工具图像

我想创建一个特殊的选择，其中图像变暗，部分用户正在选择，真实图像显示。你可以看到一个例子：创建一个特殊的视觉选择工具图像

Example

我发现两种方法实现这一点：

实现其显示变暗图像的控制。当用户在该控件上拖动一个椭圆时，椭圆将实际图像（不是变暗的图像）复制到控制画布中。在这种情况下，当他/她尝试将椭圆大小调整为较小尺寸时，首先将椭圆的整个矩形区域变暗，然后在新的较小椭圆中绘制实际图像。
与方法1相同，但不是在控件的画布上绘图，而是创建一个显示真实图像的新控件。在这种情况下，所有发送到新控件的消息都应该传递给父控件。因为如果用户尝试将椭圆的大小调整为较小的大小，WM_MOVE消息发送给此控件而不是父控件。

可以请，有人告诉我实现这一目标的正确方向。我认为方法1很难实现，因为它导致很多闪变。除非我实现了一种仅通过InvalidateRect函数重新绘制已更改零件的方法。

下面是我迄今为止实施的TScreenEmul类的代码。它可以工作，但闪烁。

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.

对于使用这个类：

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

来源

2010-11-09 bman

我解决了这个问题。我的回答备案的问题：

1- WMEraseBkgnd应返回true，防止画背景。我错误地回了假。

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.

来源

2010-11-11 20:17:39 bman

首先你需要有一个位图到内存中（隐藏），你操纵所以“闪烁”的效果将不会出现。其次，您需要在显示的位图上应用一些加深算法，并将选区从原始位图复制到可见位图。

换句话说：

OffsetBitmap（原始位）复制到可见的位图。当选择发生
：
1. 应用变暗效果可见位图
2. 从OFFSETBITMAP复制选定矩形可见位图有那么你将与原有的光强度选择。

希望这有助于在一定程度上 - 实施这需要一点时间，我没有现在。

来源

2010-11-09 08:48:13 ComputerSaysNo

这将会变慢。他应该在内存中保留三个位图：一个黑暗的版本，原始版本和一个“工作场所”。当用户更新选择时，他应该：1）将黑暗的位图复制到工作场所。 2）将所选部分从原始位图复制到工作场所。 3）将工作场所复制到画布上。 – 2010-11-09 09:12:25

我的图像可以是1440 x 900像素，甚至可以是1920 x 1940（屏幕分辨率）。也许我应该使用InvalidateRect并仅绘制图像的更新部分。但我不知道这完全可能。 – bman 2010-11-09 09:19:32

也许我应该计算图像的更新部分，并每次调用InvalidateRect，用户更改选择。 – bman 2010-11-09 09:20:51

我已经做了类似的成才...这里是我的代码提取物（只在内存中的一个位图）：

抓取屏幕...

类型 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;

模糊该位图，一旦选择是通过鼠标开始下降（建议代码）

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;

选择区域*在屏幕上模糊的位图（:)为例

程序GrabSelectedArea （发信人：TObject）; 开始

抓斗（image1.Picture.Bitmap，GTSCREEN）; bmp：= Image1.Picture.Bitmap; image1.Width：= image1.Picture.Bitmap.Width; image1.Height：= image1.Picture.Bitmap.Height; DoSelect：= true; 结束;
否则，反向（偏移）为位图上的所选择的区域中的模糊效果。

*这里的代码我有选择

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;

来源

2010-11-09 15:48:28 volvox

这是很好的，但请记住，他需要在伪算法不是整个解决方案的帮助...... – ComputerSaysNo 2010-11-09 17:59:09

谢谢你分享你的代码。但这不是我想要实现的。我想让背景图像变暗（这很容易），并显示用户选择的真实图像（不会变暗）。请看看我发送的示例图片。在用户调整选择大小时，应显示实际图像并调整大小。我执行这个mysel，但它闪烁。我将发送我的代码作为答案，这样的人可以指导我如何优化我的算法。 – bman 2010-11-10 05:01:57

这就是我所做的。一旦鼠标关闭以选择区域，屏幕图像（获取屏幕过程）就会模糊（或变暗）。这样做后，图像上的选定区域将恢复正常。 – volvox 2010-11-10 06:53:13

创建一个特殊的视觉选择工具图像

回答

相关问题