Page 1 of 1

Flickering in BGRABitmap Project

Posted: Mon Feb 09, 2015 5:52 am
by trayres
Hi everyone,

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

Code: Select all

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?