画像用の特別な視覚選択ツールを作成します
-
29-09-2019 - |
質問
私は特別な種類の選択を作成したいと思います。そこでは、画像が暗くなり、一部にユーザーが選択している場合、実際の画像が表示されます。あなたは例を見ることができます:
これを実装するための2つのアプローチを見つけました。
暗くなった画像を示すコントロールを実装します。ユーザーがこのコントロールに楕円をドラッグすると、楕円が実際の画像(暗くなっていない画像)をコントロールキャンバスにコピーします。このシナリオでは、彼/彼女が楕円をより小さなサイズにサイズ変更しようとするとき、まず楕円の長方形の領域全体が暗くなり、次に新しい小さな楕円に実際の画像が描かれました。
アプローチ1と同じですが、コントロールのキャンバスを描く代わりに、実際の画像を示す新しいコントロールを作成します。この場合、すべてのメッセージが新しいコントロールに送信され、親のコントロールに渡す必要があります。ユーザーが楕円をより小さなサイズにサイズ変更しようとすると、親制御の代わりにこのコントロールに送信されるwm_moveメッセージが送信されるためです。
誰かがこれを実装するための正しい方向を私に示してください。そのアプローチ1は、ロットがちらつきを引き起こすため、実装するのが非常に難しいと思います。変化した部分を無効な関数によってのみ塗り直す方法を実装しない限り。
これは、今まで私によって実装されているクラス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');
解決
私は問題を解決しました。私は記録のために質問に答えます:
1- wmerasebkgndは、絵画の背景を防ぐために真で返す必要があります。私は誤って虚偽を返しました。
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.
他のヒント
私は同じようなことをしました...ここに私のコードの抽出があります(メモリにビットマップが1つだけ):
画面をつかむ...
タイプ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;
画面上のぼやけたビットマップ上の領域*を選択します(exemple :)
手順Grabselectedarea(送信者:tobject);始める
grab(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;
まず、「フリッカー」効果が表示されないように操作するメモリ(非表示)にビットマップを使用する必要があります。次に、表示するビットマップに暗いアルゴリズムを適用し、オリジナルビットマップから表示可能なビットマップに選択をコピーする必要があります。
言い換えると:
- OffsetBitMap(元のBitMap)が表示されるビットマップにコピー。
- 選択が発生した場合:
- 目に見えるビットマップに暗い効果を適用します
- 選択した長方形をOffSetBitMapから可視ビットマップにコピーして、元の光強度で選択を行うようにします。
これがある程度役立つことを願っています - これを実装するには、私が今持っていない少し時間がかかります。