Flickering in BGRABitmap Project

This forum is to discuss Lazarus, components, and your projects.
trayres
Posts: 18
Joined: Sun Feb 08, 2015 9:12 pm

Flickering in BGRABitmap Project

Postby trayres » Mon Feb 09, 2015 5:52 am

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?

Return to “Lazarus”

Who is online

Users browsing this forum: No registered users and 1 guest

cron