Mamouri
asked on
Preventing flicker in fancy selection tool
I want to create a special kind of selection, in which the image darkened and in part which user is selecting, the real Image is shown. You can see an Example:
http://i.imgur.com/VDh2r.jpg
Here is the code of the class TScreenEmul which is implemented by me, until now. It works but it has flicker. How can I prevent the flicker effect:
http://i.imgur.com/VDh2r.jpg
Here is the code of the class TScreenEmul which is implemented by me, until now. It works but it has flicker. How can I prevent the flicker effect:
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.
There are several ways actually but mostly that depends on your hardware specifications (video card). High specifications = high performance = less or no flicker.
You can check the following link from About.com intereducing some ways to prevent flicker:
http://delphi.about.com/library/bluc/text/uc052102g.htm
You can check the following link from About.com intereducing some ways to prevent flicker:
http://delphi.about.com/library/bluc/text/uc052102g.htm
I will not tell you the exact commands as I am not using Delphi. Basically, you have to create a bitmap in memory with the wanted features. Then you have to create the memory device context compatible with the one related to the window (CreateCompatibleDC()). Then you have to select that memory bitmap to the memory context and use that memory dc for the draw operations. and draw the content via that dc (which is fast). You have to suppress automatic erasing of the canvas when the paint operation is to be done. Finally, you have implement the WM_PAINT handler to copy the bitmap drawn via the memory DC to the window via BitBlt() operation.
Or you find some support for "double buffering" directly in Delphi.
Or you find some support for "double buffering" directly in Delphi.
You can use LockWindowUpdate to disable painting:
LockWindowUpdate(Handle); // the handle of the window to lock
Send the Handle of the form as a parameter to it before affecting the appearance then right after the change is completed use use LockWindowUpdate(0); to unlock the window.
LockWindowUpdate(Handle); // the handle of the window to lock
Send the Handle of the form as a parameter to it before affecting the appearance then right after the change is completed use use LockWindowUpdate(0); to unlock the window.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Rllibby? Sorry for this pluggin.
https://www.experts-exchange.com/questions/26612300/A-question-for-Rllibby-maybe-some-delphi-experts-can-answer.html
Thanks
https://www.experts-exchange.com/questions/26612300/A-question-for-Rllibby-maybe-some-delphi-experts-can-answer.html
Thanks
ASKER