?
Solved

Preventing flicker in fancy selection tool

Posted on 2010-11-09
7
Medium Priority
?
915 Views
Last Modified: 2012-05-10
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:

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.

Open in new window

0
Comment
Question by:Mamouri
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
7 Comments
 
LVL 3

Author Comment

by:Mamouri
ID: 34099471
I ask the same question (but with more detail in stackoverflow) and there is some discussion about this issue which may be useful: http://stackoverflow.com/questions/4131719/create-a-special-visual-selection-tool-for-image
0
 
LVL 24

Expert Comment

by:jimyX
ID: 34099755
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
0
 
LVL 29

Expert Comment

by:pepr
ID: 34099806
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.
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 24

Expert Comment

by:jimyX
ID: 34100299
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.
0
 
LVL 2

Assisted Solution

by:kambiz
kambiz earned 800 total points
ID: 34103528
To prevent erasing the control's background, you should return 1 instead of 0 in WM_ERASEBKGND message handler.

procedure TScreenEmul.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;
0
 
LVL 26

Accepted Solution

by:
Russell Libby earned 1200 total points
ID: 34112490
The biggest thing is getting rid of the inherited call in the paint handler, and the create/free of the temporary bitmap. Your code should boil down to:

procedure TScreenEmul.WMPaint(var Message: TWMPaint);
var  Rct:           TRect;
     bHaveRect:     Boolean;
begin

  // Get the update rect
  bHaveRect:=GetUpdateRect(Self.Handle, Rct, False);

  if not(bHaveRect) then
     // Blit entire image
     BitBlt(Canvas.Handle, 0, 0, FBitmap.Width, FBitmap.Height, FBitmap.Canvas.Handle, 0, 0, SRCCOPY)
  else
     // Blit the rect
     BitBlt(Canvas.Handle, Rct.Left, Rct.Top, RectWidth(Rct), RectHeight(Rct), FBitmap.Canvas.Handle, Rct.Left, Rct.Top, SRCCOPY);
end;
0
 
LVL 14

Expert Comment

by:systan
ID: 34126010
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will show you some of the more useful Standard Template Library (STL) algorithms through the use of working examples.  You will learn about how these algorithms fit into the STL architecture, how they work with STL containers, and why t…
Basic understanding on "OO- Object Orientation" is needed for designing a logical solution to solve a problem. Basic OOAD is a prerequisite for a coder to ensure that they follow the basic design of OO. This would help developers to understand the b…
The goal of the tutorial is to teach the user how to use functions in C++. The video will cover how to define functions, how to call functions and how to create functions prototypes. Microsoft Visual C++ 2010 Express will be used as a text editor an…
The viewer will learn how to pass data into a function in C++. This is one step further in using functions. Instead of only printing text onto the console, the function will be able to perform calculations with argumentents given by the user.
Suggested Courses
Course of the Month13 days, 13 hours left to enroll

801 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question