[Solved] Flickering in BGRABitmap

[trayres]

Hi everyone,

I have a project that is flickering! Attached is my main code:

Code: [Select]

unit Unit1;

{$mode delphi}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics,
  Dialogs, ComCtrls, StdCtrls, LCLType, ExtCtrls, Menus,
  BGRABitmap, BGRABitmapTypes,
  schematicsymbol;

{ TMainForm }

type
  TMainForm = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    MainMenu: TMainMenu;
    menuFile_LoadSchematic: TMenuItem;
    mnuFile_NewSchematic: TMenuItem;
    mnuEdit: TMenuItem;
    mnuFile: TMenuItem;
    mnuFile_NewComponent: TMenuItem;
    Panel1: TPanel;
    procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure menuFile_LoadSchematicClick(Sender: TObject);
    procedure mnuFile_NewComponentClick(Sender: TObject);
    //procedure FormResize(Sender: TObject);

  private
    { private declarations }


  public
    { public declarations }
  end;

var
      MainForm: TMainForm;
      CursorBmp : TBGRABitmap;
      GridBmp : TBGRABitmap;
      SchBmp : TBGRABitmap;
      CursorX, CursorY : Integer;
      Vxmin, Vxmax : Integer;
      Vymin, Vymax : Integer;
      Wxmin, Wxmax : Integer;
      Wymin, Wymax : Integer;
      SchIsDirty : Boolean = True;
      CursorFollowMouse : Boolean = True;

implementation
{$R *.lfm}

{ TMainForm }
 procedure ParseCommand(const Command : string );
begin
     {if(Command='a') then
     begin
     writeln(Command);
     end}
     if (Command = 'cls') then
        begin
        writeln(Command);
        end
     else if (Command[1]='l') then
        begin
        writeln('Fukity');
        end
     else if (Command[1]='z') then
        begin
        writeln('Zoom in!');
        end;
end;

procedure DrawCursor;//Expect the variable to already be created
begin
  CursorBmp.Draw(MainForm.Canvas,CursorX-48,CursorY-48,False ); //Why do I set Opaque to False here, and it works as I would expect?
end;

procedure DrawGrid;
begin
   GridBmp.Draw(MainForm.Canvas,0,0,False);
end;

procedure CreateCursor;
begin
  CursorBmp := TBGRABitmap.Create(96,96,BGRAPixelTransparent);
  CursorBmp.DrawLineAntialias(40,48,56,48,BGRA(0,0,0,128),2);
  CursorBmp.DrawLineAntialias(48,40,48,56,BGRA(0,0,0,128),2);
end;

procedure CreateGrid;
var Count : Integer;
begin
  GridBmp := TBGRABitmap.Create(2048,2048,BGRAPixelTransparent);
  for Count := 1 to 256 do
      begin
         GridBmp.DrawLineAntialias(0, 16*Count,2048,16*Count,BGRA(0,0,0,128),1);
         GridBmp.DrawLineAntialias(16*Count,0, 16*Count,2048, BGRA(0,0,0,128),1);
      end
end;

{procedure LoadSchematic(const SchematicFileName : string);
begin

end; }

{function WorldCoordinatesFromViewportCoordinates

}

type TZoom = (ZOOM_IN,ZOOM_OUT);
procedure ZoomCommand(ZCMD : TZoom);begin
     if (ZCMD=ZOOM_IN) then
        begin
        writeln('Zoom In!!');
        end
     else if (ZCMD=ZOOM_OUT) then
        writeln('Zoom Out!');
end;



procedure DrawScene;
begin
     //Clear the Screen
     MainForm.Canvas.Clear();
     //Draw the Cursor
     DrawCursor(); //
     //Draw the Grid
     DrawGrid();
     //Draw the Schematic
     //DrawSchematic();
end;

procedure TMainForm.FormPaint(Sender: TObject);
begin
    DrawScene();
end;

procedure TMainForm.menuFile_LoadSchematicClick(Sender: TObject);
begin

end;

procedure TMainForm.mnuFile_NewComponentClick(Sender: TObject);
begin
  SchematicSymbolForm.Show;
end;



procedure TMainForm.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
     if (Key = VK_RETURN) then
        begin
        ParseCommand(Edit1.Text);
        Edit1.Text := '';
        end
end;

procedure TMainForm.FormClick(Sender: TObject);
begin
  MainForm.SetFocus;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
     //Create Cursor
     Self.DoubleBuffered := True;
     CreateCursor;
     CursorX := 150;
     CursorY := 150;
     CreateGrid;

end;

procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_Z) then
     begin
     ZoomCommand(ZOOM_IN);
     end;
end;

procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var   CursorXPrev : Integer;
      CursorYPrev : Integer;
begin
  CursorXPrev := CursorX;
  CursorYPrev := CursorY;
  Label1.Caption := 'Viewport Coordinates:'+IntToStr(X)+','+IntToStr(Y);
  if (X mod 16 = 0) then begin
     CursorX := X;
     WriteLn('New CursorY:'+IntToStr(CursorY));
     WriteLn('New CursorX:'+IntToStr(CursorX));
  end;
  if (Y mod 16 = 0) then begin
     CursorY := Y;
     WriteLn('New CursorY:'+IntToStr(CursorY));
     WriteLn('New CursorX:'+IntToStr(CursorX));
  end;

  If ((CursorXPrev <> CursorX) or (CursorYPrev <> CursorY)) then
     begin
     DrawScene();
     WriteLn();
     end;

end;

end.

I'm thinking the problem is where I clear the form, then build both the grid and the cursor location; it is flickering even though I haven't added the schematic component.

The project files are copied to dropbox: https://www.dropbox.com/s/h5m4v48j0c8rvcq/FlickeringLazarusProject.7z?dl=0

It is still extremely rough, but if someone has an idea of how to tame this flickering I'd really appreciate it. Any thoughts?

[balazsszekely]

Each time the cursor moves, you clear the canvas, redraw the grid...Since the bitmap is big it flickers.
Draw the grid once, on mouse move delete the old cursor(redraw a small part of the grid, where the cursor was) then draw the cursor at the new position.

Code: [Select]

procedure DrawScene;
begin
   DeleteOldCursor;
   DrawNewCursor;
end;   


PS: Another idea, draw the line directly to canvas, skip the Bitmap part. Something like this:

Code: [Select]

procedure DrawGrid1;
var
  Count : Integer;
begin
  for Count := 1 to 256 do
  begin
    MainForm.Canvas.Line(0, 16*Count, 2048, 16*Count);
    MainForm.Canvas.Line(16*Count, 0, 16*Count, 2048)
  end
end;


procedure DrawScene;
begin
  MainForm.Canvas.Clear(); //<-- this is still wrong though(unnecessary step)
  DrawGrid1();
  DrawCursor();
end;

 

[Syndrome]

This patch fixes the flickering:

Code: [Select]

var
      MainForm: TMainForm;
      CursorBmp : TBGRABitmap;
      GridBmp : TBGRABitmap;
      SchBmp : TBGRABitmap;
      CursorX, CursorY : Integer;
      Vxmin, Vxmax : Integer;
      Vymin, Vymax : Integer;
      Wxmin, Wxmax : Integer;
      Wymin, Wymax : Integer;
      SchIsDirty : Boolean = True;
      CursorFollowMouse : Boolean = True;

      Surface:TBGRABitmap; // <<<<<<<<< NEW

implementation


procedure DrawCursor;//Expect the variable to already be created
begin
  Surface.PutImage(CursorX-48,CursorY-48,CursorBmp,dmLinearBlend);
end;

procedure DrawGrid;
begin
  Surface.PutImage(0,0,GridBmp,dmLinearBlend);
end; 

procedure DrawScene;
begin
     //Clear the Screen
     Surface.Fill(BGRAWhite);
     //Draw the Cursor
     DrawCursor();
     //Draw the Grid
     DrawGrid();
     //Draw the Schematic
     //DrawSchematic();
     Surface.Draw(MainForm.Canvas,0,0,true);
end;

procedure TMainForm.FormResize(Sender:TObject);
begin
   Surface.SetSize(Width,Height);
end; 

procedure TMainForm.FormCreate(Sender: TObject);
begin
     //Create Cursor
     Self.DoubleBuffered := True;
     CreateCursor;
     CursorX := 150;
     CursorY := 150;
     CreateGrid;

     Surface:= TBGRABitmap.Create(Width,Height);

end;

This fixes your mouse:

Code: [Select]

procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var   CursorXPrev : Integer;
      CursorYPrev : Integer;
      NearestX,NearestY:integer;
begin
  CursorXPrev := CursorX;
  CursorYPrev := CursorY;
  Label1.Caption := 'Viewport Coordinates:'+IntToStr(X)+','+IntToStr(Y);
  if (X mod 16) < 8 then NearestX:= X - (X mod 16) else NearestX:= X + 16 - (X mod 16);
  if (Y mod 16) < 8 then NearestY:= Y - (Y mod 16) else NearestY:= Y + 16 - (Y mod 16);
  if (NearestX <> CursorX) or (NearestY <> CursorY) then begin
     CursorX := NearestX;
     CursorY := NearestY;
     WriteLn('New CursorY:'+IntToStr(CursorY));
     WriteLn('New CursorX:'+IntToStr(CursorX));
  end;

  If ((CursorXPrev <> CursorX) or (CursorYPrev <> CursorY)) then
     begin
     DrawScene();
     WriteLn();
     end;

end;

[trayres]

This patch fixes the flickering:

Code: [Select]

var
      MainForm: TMainForm;
      CursorBmp : TBGRABitmap;
      GridBmp : TBGRABitmap;
      SchBmp : TBGRABitmap;
      CursorX, CursorY : Integer;
      Vxmin, Vxmax : Integer;
      Vymin, Vymax : Integer;
      Wxmin, Wxmax : Integer;
      Wymin, Wymax : Integer;
      SchIsDirty : Boolean = True;
      CursorFollowMouse : Boolean = True;

      Surface:TBGRABitmap; // <<<<<<<<< NEW

implementation


procedure DrawCursor;//Expect the variable to already be created
begin
  Surface.PutImage(CursorX-48,CursorY-48,CursorBmp,dmLinearBlend);
end;

procedure DrawGrid;
begin
  Surface.PutImage(0,0,GridBmp,dmLinearBlend);
end; 

procedure DrawScene;
begin
     //Clear the Screen
     Surface.Fill(BGRAWhite);
     //Draw the Cursor
     DrawCursor();
     //Draw the Grid
     DrawGrid();
     //Draw the Schematic
     //DrawSchematic();
     Surface.Draw(MainForm.Canvas,0,0,true);
end;

procedure TMainForm.FormResize(Sender:TObject);
begin
   Surface.SetSize(Width,Height);
end; 

procedure TMainForm.FormCreate(Sender: TObject);
begin
     //Create Cursor
     Self.DoubleBuffered := True;
     CreateCursor;
     CursorX := 150;
     CursorY := 150;
     CreateGrid;

     Surface:= TBGRABitmap.Create(Width,Height);

end;

This fixes your mouse:

Code: [Select]

procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var   CursorXPrev : Integer;
      CursorYPrev : Integer;
      NearestX,NearestY:integer;
begin
  CursorXPrev := CursorX;
  CursorYPrev := CursorY;
  Label1.Caption := 'Viewport Coordinates:'+IntToStr(X)+','+IntToStr(Y);
  if (X mod 16) < 8 then NearestX:= X - (X mod 16) else NearestX:= X + 16 - (X mod 16);
  if (Y mod 16) < 8 then NearestY:= Y - (Y mod 16) else NearestY:= Y + 16 - (Y mod 16);
  if (NearestX <> CursorX) or (NearestY <> CursorY) then begin
     CursorX := NearestX;
     CursorY := NearestY;
     WriteLn('New CursorY:'+IntToStr(CursorY));
     WriteLn('New CursorX:'+IntToStr(CursorX));
  end;

  If ((CursorXPrev <> CursorX) or (CursorYPrev <> CursorY)) then
     begin
     DrawScene();
     WriteLn();
     end;

end;

That's 1000x better! Thank you so much!