lazarus-ccr/applications/draw_test/unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, ComCtrls, Menus, FileCache, MyDrawingControl;

type

  { TForm1 }

  TForm1 = class(TForm)
    Image1: TImage;
    ListView1: TListView;
    MainMenu1: TMainMenu;
    MenuItem1: TMenuItem;
    mnuHD50: TMenuItem;
    mnuHD: TMenuItem;
    MenuItem2: TMenuItem;
    mnuTPaintBox: TMenuItem;
    mnuTImage: TMenuItem;
    MenuItem5: TMenuItem;
    mnuTGraphicControl: TMenuItem;
    MenuItem7: TMenuItem;
    MenuItem9: TMenuItem;
    PageControl1: TPageControl;
    PaintBox1: TPaintBox;
    ImageTabSheet: TTabSheet;
    PaintBoxTabSheet: TTabSheet;
    Splitter1: TSplitter;
    GraphicControlTabSheet: TTabSheet;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MenuItem5Click(Sender: TObject);
    procedure mnuHD50Click(Sender: TObject);
    procedure mnuHDClick(Sender: TObject);
    procedure mnuTGraphicControlClick(Sender: TObject);
    procedure mnuTImageClick(Sender: TObject);
    procedure mnuTPaintBoxClick(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { private declarations }
    FileCache50: TFileCache;
    FileCache100: TFileCache;

    img: TMyDrawingControl;
    procedure AddTestToListBox(AName: string; FPS: double);
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  png: TPortableNetworkGraphic;

implementation

{$R *.lfm}

uses
  GraphType;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  FileCache50 := TFileCache.Create('./images50.cache');
  FileCache100 := TFileCache.Create('./images100.cache');

  png := TPortableNetworkGraphic.Create;

  //load all images to the caches
  for i := 1 to 23 do
  begin
    png.LoadFromFile(Format('./images/%.4d.png', [i]));
    FileCache100.Add(i, png);
    png.LoadFromFile(Format('./images_50/%.4d.png', [i]));
    FileCache50.Add(i, png);
  end;

  //PaintBoxTabSheet.DoubleBuffered := True;
  //ImageTabSheet.DoubleBuffered := True;
  //GraphicControlTabSheet.DoubleBuffered := True;

  img := TMyDrawingControl.Create(nil);
  img.Parent := GraphicControlTabSheet;
  img.Align := alClient;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FileCache50.Free;
  FileCache100.Free;

  png.Free;
  img.Free;
end;

procedure TForm1.MenuItem5Click(Sender: TObject);
begin
  mnuTPaintBoxClick(nil);
  mnuTImageClick(nil);
  mnuTGraphicControlClick(nil);
end;

procedure TForm1.mnuHD50Click(Sender: TObject);
begin
  mnuHD50.Checked := True;
end;

procedure TForm1.mnuHDClick(Sender: TObject);
begin
  mnuHD.Checked := True;
end;

procedure TForm1.mnuTGraphicControlClick(Sender: TObject);
var
  s: TDateTime;
  i: integer;
  j: integer;
  f: boolean;
begin
  PageControl1.ActivePage := GraphicControlTabSheet;

  s := Now;
  for j := 1 to 10 do
    for i := 1 to 23 do
    begin
      if mnuHD50.Checked then
        f := FileCache50.GetData(i, png)
      else
        f := FileCache100.GetData(i, png);

      if f then
      begin
        img.Bitmap := png;
        img.Invalidate;
        Application.ProcessMessages;
      end;
    end;

  AddTestToListBox('TGraphicControl', 230 / ((Now - s) * 24 * 3600));
end;

procedure TForm1.mnuTImageClick(Sender: TObject);
var
  s: TDateTime;
  i: integer;
  j: integer;
  f: boolean;
begin
  PageControl1.ActivePage := ImageTabSheet;

  s := Now;
  for j := 1 to 10 do
    for i := 1 to 23 do
    begin
      if mnuHD50.Checked then
        f := FileCache50.GetData(i, png)
      else
        f := FileCache100.GetData(i, png);

      if f then
      begin
        Image1.Picture.Bitmap.LoadFromRawImage(png.RawImage, False);
        Application.ProcessMessages;
      end;
    end;

  AddTestToListBox('TImage', 230 / ((Now - s) * 24 * 3600));
end;

procedure TForm1.mnuTPaintBoxClick(Sender: TObject);
var
  s: TDateTime;
  i: integer;
  j: integer;
  f: Boolean;
begin
  PageControl1.ActivePage := PaintBoxTabSheet;

  s := Now;
  for j := 1 to 10 do
    for i := 1 to 23 do
    begin
      if mnuHD50.Checked then
        f := FileCache50.GetData(i, png)
      else
        f := FileCache100.GetData(i, png);

      if f then
      begin
        PaintBox1.Invalidate;
        Application.ProcessMessages;
      end;
    end;

  AddTestToListBox('TPaintBox', 230 / ((Now - s) * 24 * 3600));
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0, 0, png);
end;

procedure TForm1.AddTestToListBox(AName: string; FPS: double);
var
  i: integer;
  found: boolean = False;
begin
  //first check if test is already added earlier
  for i := 0 to ListView1.Items.Count - 1 do
  begin
    if ListView1.Items[i].Caption = AName then
    begin
      found := True;
      ListView1.Items[i].SubItems.Clear;
      ListView1.Items[i].SubItems.Add(FloatToStr(FPS));
    end;
  end;

  if not found then
    with ListView1.Items.Add do
    begin
      Caption := AName;
      SubItems.Add(FloatToStr(FPS));
    end;
end;

end.