創建一個特殊的視覺選擇工具圖像

我想創建一個特殊的選擇，其中圖像變暗，部分用戶正在選擇，真實圖像顯示。你可以看到一個例子：創建一個特殊的視覺選擇工具圖像

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

創建一個特殊的視覺選擇工具圖像

回答

相關問題