added faster test app, based on custom memory bitmap format
added blend file to create test frames improve TFileCache.GetData speed, fixed bug (function result) git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2283 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blaszijk
parent
3aca3e7007
commit
8d83ea1a90
125
applications/draw_test/draw_test_fast/fastbitmap.pas
Normal file
125
applications/draw_test/draw_test_fast/fastbitmap.pas
Normal file
@ -0,0 +1,125 @@
|
||||
unit FastBitmap;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes;
|
||||
|
||||
type
|
||||
|
||||
TFastBitmapPixel = integer;
|
||||
(*TFastBitmapPixel = record
|
||||
Blue: Byte;
|
||||
Green: Byte;
|
||||
Red: Byte;
|
||||
end;*)
|
||||
PFastBitmapPixel = ^TFastBitmapPixel;
|
||||
|
||||
TFastBitmapPixelComponents = packed record
|
||||
B, G, R, A: byte;
|
||||
end;
|
||||
|
||||
const
|
||||
FastPixelSize = SizeOf(TFastBitmapPixel);
|
||||
|
||||
type
|
||||
{ TFastBitmap }
|
||||
|
||||
TFastBitmap = class
|
||||
private
|
||||
FPixelsData: PByte;
|
||||
FSize: TPoint;
|
||||
function GetPixel(X, Y: integer): TFastBitmapPixel; inline;
|
||||
procedure SetPixel(X, Y: integer; const AValue: TFastBitmapPixel); inline;
|
||||
procedure SetSize(const AValue: TPoint);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure RandomImage;
|
||||
property Size: TPoint read FSize write SetSize;
|
||||
property Pixels[X, Y: integer]: TFastBitmapPixel read GetPixel write SetPixel;
|
||||
property PixelsData: PByte read FPixelsData;
|
||||
end;
|
||||
|
||||
function RGBA(red, green, blue, alpha: byte): integer;
|
||||
function SwapBRComponent(Value: integer): integer; inline;
|
||||
function NoSwapBRComponent(Value: integer): integer; inline;
|
||||
|
||||
implementation
|
||||
|
||||
function RGBA(red, green, blue, alpha: byte): integer;
|
||||
var
|
||||
tmp: TFastBitmapPixelComponents;
|
||||
begin
|
||||
tmp.R := red;
|
||||
tmp.G := green;
|
||||
tmp.B := blue;
|
||||
tmp.A := alpha;
|
||||
Result := TFastBitmapPixel(tmp);
|
||||
end;
|
||||
|
||||
function SwapBRComponent(Value: integer): integer;
|
||||
begin
|
||||
// Result := (Value and $00ff00) or ((Value shr 16) and $ff) or ((Value and $ff) shl 16);
|
||||
Result := Value;
|
||||
TFastBitmapPixelComponents(Result).R := TFastBitmapPixelComponents(Value).B;
|
||||
TFastBitmapPixelComponents(Result).B := TFastBitmapPixelComponents(Value).R;
|
||||
end;
|
||||
|
||||
function NoSwapBRComponent(Value: integer): integer;
|
||||
begin
|
||||
// Result := (Value and $00ff00) or ((Value shr 16) and $ff) or ((Value and $ff) shl 16);
|
||||
Result := Value;
|
||||
TFastBitmapPixelComponents(Result).B := TFastBitmapPixelComponents(Value).B;
|
||||
TFastBitmapPixelComponents(Result).R := TFastBitmapPixelComponents(Value).R;
|
||||
end;
|
||||
|
||||
{ TFastBitmap }
|
||||
|
||||
function TFastBitmap.GetPixel(X, Y: integer): TFastBitmapPixel;
|
||||
begin
|
||||
Result := PFastBitmapPixel(FPixelsData + (Y * FSize.X + X) * FastPixelSize)^;
|
||||
end;
|
||||
|
||||
procedure TFastBitmap.SetPixel(X, Y: integer; const AValue: TFastBitmapPixel);
|
||||
begin
|
||||
PFastBitmapPixel(FPixelsData + (Y * FSize.X + X) * FastPixelSize)^ := AValue;
|
||||
end;
|
||||
|
||||
procedure TFastBitmap.SetSize(const AValue: TPoint);
|
||||
begin
|
||||
if (FSize.X = AValue.X) and (FSize.Y = AValue.X) then
|
||||
Exit;
|
||||
FSize := AValue;
|
||||
FPixelsData := ReAllocMem(FPixelsData, FSize.X * FSize.Y * FastPixelSize);
|
||||
end;
|
||||
|
||||
constructor TFastBitmap.Create;
|
||||
begin
|
||||
Size := Point(0, 0);
|
||||
end;
|
||||
|
||||
destructor TFastBitmap.Destroy;
|
||||
begin
|
||||
FreeMem(FPixelsData);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFastBitmap.RandomImage;
|
||||
var
|
||||
I, X, Y: integer;
|
||||
begin
|
||||
for I := 0 to 2 do
|
||||
for Y := 0 to (Size.Y div 2) - 1 do
|
||||
for X := 0 to (Size.X div 3) - 1 do
|
||||
Pixels[X + (I * (Size.X div 3)), Y] := 255 shl (I * 8);
|
||||
|
||||
for Y := (Size.Y div 2) to Size.Y - 1 do
|
||||
for X := 0 to Size.X - 1 do
|
||||
Pixels[X, Y] := Random(256) or (Random(256) shl 16) or (Random(256) shl 8);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
92
applications/draw_test/draw_test_fast/filecache.pas
Normal file
92
applications/draw_test/draw_test_fast/filecache.pas
Normal file
@ -0,0 +1,92 @@
|
||||
unit FileCache;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics, FastBitmap;
|
||||
|
||||
type
|
||||
TFileCacheItem = record
|
||||
start: longint;
|
||||
length: longint;
|
||||
number: integer;
|
||||
end;
|
||||
|
||||
{ TFileCache }
|
||||
|
||||
TFileCache = class
|
||||
private
|
||||
cache_stream: TFileStream;
|
||||
FCount: integer;
|
||||
FCacheList: array of TFileCacheItem;
|
||||
public
|
||||
constructor Create(AFileName: string);
|
||||
destructor Destroy; override;
|
||||
|
||||
property Count: integer read FCount;
|
||||
function GetData(Number: integer; var Bitmap: TFastBitmap): boolean;
|
||||
procedure Add(Number: integer; Bitmap: TFastBitmap);
|
||||
procedure Clear;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TFileCache }
|
||||
|
||||
constructor TFileCache.Create(AFileName: string);
|
||||
begin
|
||||
FCount := 0;
|
||||
cache_stream := TFileStream.Create(AFileName, fmCreate);
|
||||
end;
|
||||
|
||||
destructor TFileCache.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
cache_stream.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TFileCache.GetData(Number: integer; var Bitmap: TFastBitmap): boolean;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result := False;
|
||||
for i := 0 to FCount - 1 do
|
||||
if FCacheList[i].number = Number then
|
||||
begin
|
||||
cache_stream.Position := FCacheList[i].start;
|
||||
cache_stream.Read(Bitmap.PixelsData^, FCacheList[i].length);
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileCache.Add(Number: integer; Bitmap: TFastBitmap);
|
||||
begin
|
||||
if Bitmap = nil then
|
||||
exit;
|
||||
|
||||
Inc(FCount);
|
||||
SetLength(FCacheList, FCount);
|
||||
|
||||
FCacheList[FCount - 1].number := Number;
|
||||
|
||||
//move to the end of the stream
|
||||
cache_stream.Position := cache_stream.Size;
|
||||
|
||||
FCacheList[FCount - 1].start := cache_stream.Position;
|
||||
cache_stream.Write(Bitmap.PixelsData^, Bitmap.Size.x * Bitmap.Size.y * 4);
|
||||
FCacheList[FCount - 1].length := cache_stream.Position - FCacheList[FCount - 1].start;
|
||||
end;
|
||||
|
||||
procedure TFileCache.Clear;
|
||||
begin
|
||||
FCount := 0;
|
||||
SetLength(FCacheList, FCount);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
102
applications/draw_test/draw_test_fast/project1.lpi
Normal file
102
applications/draw_test/draw_test_fast/project1.lpi
Normal file
@ -0,0 +1,102 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="project1"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="4">
|
||||
<Unit0>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="project1"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="filecache.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="FileCache"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="fastbitmap.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="FastBitmap"/>
|
||||
</Unit3>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="project1"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseHeaptrc Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
21
applications/draw_test/draw_test_fast/project1.lpr
Normal file
21
applications/draw_test/draw_test_fast/project1.lpr
Normal file
@ -0,0 +1,21 @@
|
||||
program project1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, { this includes the LCL widgetset}
|
||||
Forms, Unit1, FileCache, FastBitmap
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource := True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
209
applications/draw_test/draw_test_fast/project1.lps
Normal file
209
applications/draw_test/draw_test_fast/project1.lps
Normal file
@ -0,0 +1,209 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectSession>
|
||||
<PathDelim Value="\"/>
|
||||
<Version Value="9"/>
|
||||
<BuildModes Active="Default"/>
|
||||
<Units Count="8">
|
||||
<Unit0>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="project1"/>
|
||||
<UsageCount Value="28"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="102"/>
|
||||
<CursorPos X="23" Y="110"/>
|
||||
<UsageCount Value="28"/>
|
||||
<Loaded Value="True"/>
|
||||
<LoadedDesigner Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="filecache.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="FileCache"/>
|
||||
<IsVisibleTab Value="True"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="41"/>
|
||||
<CursorPos X="16" Y="73"/>
|
||||
<UsageCount Value="28"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="fastbitmap.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="FastBitmap"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<UsageCount Value="27"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="mydrawingcontrol.pas"/>
|
||||
<UnitName Value="MyDrawingControl"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<UsageCount Value="27"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="C:\lazarus\lcl\graphics.pp"/>
|
||||
<UnitName Value="Graphics"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="43"/>
|
||||
<CursorPos X="3" Y="56"/>
|
||||
<UsageCount Value="13"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="C:\lazarus\lcl\graphtype.pp"/>
|
||||
<UnitName Value="GraphType"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="26"/>
|
||||
<CursorPos X="3" Y="39"/>
|
||||
<UsageCount Value="13"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="C:\lazarus\lcl\include\menuitem.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="70"/>
|
||||
<CursorPos X="1" Y="83"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit7>
|
||||
</Units>
|
||||
<General>
|
||||
<ActiveWindowIndexAtStart Value="0"/>
|
||||
</General>
|
||||
<JumpHistory Count="30" HistoryIndex="29">
|
||||
<Position1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="198" Column="1" TopLine="177"/>
|
||||
</Position1>
|
||||
<Position2>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="190" Column="5" TopLine="177"/>
|
||||
</Position2>
|
||||
<Position3>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="41" Column="1" TopLine="27"/>
|
||||
</Position3>
|
||||
<Position4>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="130" Column="1" TopLine="116"/>
|
||||
</Position4>
|
||||
<Position5>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="91" Column="10" TopLine="78"/>
|
||||
</Position5>
|
||||
<Position6>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="98" Column="1" TopLine="89"/>
|
||||
</Position6>
|
||||
<Position7>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="97" Column="1" TopLine="88"/>
|
||||
</Position7>
|
||||
<Position8>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="96" Column="1" TopLine="87"/>
|
||||
</Position8>
|
||||
<Position9>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="95" Column="1" TopLine="86"/>
|
||||
</Position9>
|
||||
<Position10>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="94" Column="1" TopLine="85"/>
|
||||
</Position10>
|
||||
<Position11>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="89" Column="9" TopLine="85"/>
|
||||
</Position11>
|
||||
<Position12>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="88" Column="9" TopLine="84"/>
|
||||
</Position12>
|
||||
<Position13>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="87" Column="9" TopLine="83"/>
|
||||
</Position13>
|
||||
<Position14>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="86" Column="9" TopLine="82"/>
|
||||
</Position14>
|
||||
<Position15>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="85" Column="9" TopLine="81"/>
|
||||
</Position15>
|
||||
<Position16>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="84" Column="9" TopLine="80"/>
|
||||
</Position16>
|
||||
<Position17>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="90" Column="1" TopLine="78"/>
|
||||
</Position17>
|
||||
<Position18>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="36" Column="1" TopLine="24"/>
|
||||
</Position18>
|
||||
<Position19>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="87" Column="7" TopLine="76"/>
|
||||
</Position19>
|
||||
<Position20>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="96" Column="1" TopLine="83"/>
|
||||
</Position20>
|
||||
<Position21>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="26" Column="30" TopLine="13"/>
|
||||
</Position21>
|
||||
<Position22>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="37" Column="2" TopLine="8"/>
|
||||
</Position22>
|
||||
<Position23>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="86" Column="1" TopLine="66"/>
|
||||
</Position23>
|
||||
<Position24>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="123" Column="2" TopLine="106"/>
|
||||
</Position24>
|
||||
<Position25>
|
||||
<Filename Value="fastbitmap.pas"/>
|
||||
<Caret Line="88" Column="3" TopLine="65"/>
|
||||
</Position25>
|
||||
<Position26>
|
||||
<Filename Value="fastbitmap.pas"/>
|
||||
<Caret Line="1" Column="1" TopLine="1"/>
|
||||
</Position26>
|
||||
<Position27>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="128" Column="48" TopLine="59"/>
|
||||
</Position27>
|
||||
<Position28>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="9" Column="30" TopLine="1"/>
|
||||
</Position28>
|
||||
<Position29>
|
||||
<Filename Value="filecache.pas"/>
|
||||
<Caret Line="62" Column="22" TopLine="1"/>
|
||||
</Position29>
|
||||
<Position30>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="79" Column="24" TopLine="60"/>
|
||||
</Position30>
|
||||
</JumpHistory>
|
||||
</ProjectSession>
|
||||
</CONFIG>
|
||||
BIN
applications/draw_test/draw_test_fast/project1.res
Normal file
BIN
applications/draw_test/draw_test_fast/project1.res
Normal file
Binary file not shown.
89
applications/draw_test/draw_test_fast/unit1.lfm
Normal file
89
applications/draw_test/draw_test_fast/unit1.lfm
Normal file
@ -0,0 +1,89 @@
|
||||
object Form1: TForm1
|
||||
Left = 342
|
||||
Height = 555
|
||||
Top = 135
|
||||
Width = 569
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 535
|
||||
ClientWidth = 569
|
||||
Menu = MainMenu1
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
LCLVersion = '0.9.31'
|
||||
object PageControl1: TPageControl
|
||||
Left = 0
|
||||
Height = 535
|
||||
Top = 0
|
||||
Width = 362
|
||||
ActivePage = ImageTabSheet
|
||||
Align = alClient
|
||||
TabIndex = 0
|
||||
TabOrder = 0
|
||||
object ImageTabSheet: TTabSheet
|
||||
Caption = 'TImage'
|
||||
ClientHeight = 509
|
||||
ClientWidth = 354
|
||||
object Image1: TImage
|
||||
Left = 0
|
||||
Height = 509
|
||||
Top = 0
|
||||
Width = 354
|
||||
Align = alClient
|
||||
end
|
||||
end
|
||||
end
|
||||
object ListView1: TListView
|
||||
Left = 367
|
||||
Height = 535
|
||||
Top = 0
|
||||
Width = 202
|
||||
Align = alRight
|
||||
Columns = <
|
||||
item
|
||||
Caption = 'Method'
|
||||
Width = 100
|
||||
end
|
||||
item
|
||||
Caption = 'FPS'
|
||||
Width = 100
|
||||
end>
|
||||
TabOrder = 1
|
||||
ViewStyle = vsReport
|
||||
end
|
||||
object Splitter1: TSplitter
|
||||
Left = 362
|
||||
Height = 535
|
||||
Top = 0
|
||||
Width = 5
|
||||
Align = alRight
|
||||
ResizeAnchor = akRight
|
||||
end
|
||||
object MainMenu1: TMainMenu
|
||||
left = 447
|
||||
top = 88
|
||||
object MenuItem1: TMenuItem
|
||||
Caption = 'Cache'
|
||||
object MenuItem9: TMenuItem
|
||||
Caption = 'Use cache'
|
||||
object mnuHD50: TMenuItem
|
||||
Caption = '50% HD (940x540)'
|
||||
Checked = True
|
||||
RadioItem = True
|
||||
OnClick = mnuHD50Click
|
||||
end
|
||||
object mnuHD: TMenuItem
|
||||
Caption = 'HD (1920x1050)'
|
||||
RadioItem = True
|
||||
OnClick = mnuHDClick
|
||||
end
|
||||
end
|
||||
end
|
||||
object MenuItem2: TMenuItem
|
||||
Caption = 'Run tests'
|
||||
object mnuTImage: TMenuItem
|
||||
Caption = 'TImage'
|
||||
OnClick = mnuTImageClick
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
168
applications/draw_test/draw_test_fast/unit1.pas
Normal file
168
applications/draw_test/draw_test_fast/unit1.pas
Normal file
@ -0,0 +1,168 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
|
||||
ExtCtrls, ComCtrls, Menus, FileCache, FastBitmap;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
ListView1: TListView;
|
||||
MainMenu1: TMainMenu;
|
||||
MenuItem1: TMenuItem;
|
||||
mnuHD50: TMenuItem;
|
||||
mnuHD: TMenuItem;
|
||||
MenuItem2: TMenuItem;
|
||||
mnuTImage: TMenuItem;
|
||||
MenuItem9: TMenuItem;
|
||||
PageControl1: TPageControl;
|
||||
Splitter1: TSplitter;
|
||||
ImageTabSheet: TTabSheet;
|
||||
Image1: TImage;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure MenuItem5Click(Sender: TObject);
|
||||
procedure mnuHD50Click(Sender: TObject);
|
||||
procedure mnuHDClick(Sender: TObject);
|
||||
procedure mnuTImageClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
FileCache50: TFileCache;
|
||||
|
||||
procedure AddTestToListBox(AName: string; FPS: double);
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
png: TPortableNetworkGraphic;
|
||||
bmp: TFastBitmap;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
uses
|
||||
GraphType;
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
var
|
||||
i: integer;
|
||||
RawImage: TRawImage;
|
||||
RowPtr: PInteger;
|
||||
BytePerRow: PtrUInt;
|
||||
begin
|
||||
FileCache50 := TFileCache.Create('./images50.cache');
|
||||
|
||||
png := TPortableNetworkGraphic.Create;
|
||||
|
||||
bmp := TFastBitmap.Create;
|
||||
bmp.Size := Point(1920, 1080);
|
||||
|
||||
//load all images to the caches
|
||||
for i := 1 to 23 do
|
||||
begin
|
||||
png.LoadFromFile(Format('../images/%.4d.png', [i]));
|
||||
RawImage := png.RawImage;
|
||||
RowPtr := PInteger(RawImage.Data);
|
||||
BytePerRow := RawImage.Description.BytesPerLine;
|
||||
Move(RowPtr^, bmp.PixelsData^, bmp.Size.Y * BytePerRow);
|
||||
FileCache50.Add(i, bmp);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FileCache50.Free;
|
||||
|
||||
png.Free;
|
||||
bmp.Free;
|
||||
end;
|
||||
|
||||
procedure TForm1.MenuItem5Click(Sender: TObject);
|
||||
begin
|
||||
mnuTImageClick(nil);
|
||||
end;
|
||||
|
||||
procedure TForm1.mnuHD50Click(Sender: TObject);
|
||||
begin
|
||||
mnuHD50.Checked := True;
|
||||
end;
|
||||
|
||||
procedure TForm1.mnuHDClick(Sender: TObject);
|
||||
begin
|
||||
mnuHD.Checked := True;
|
||||
end;
|
||||
|
||||
procedure TForm1.mnuTImageClick(Sender: TObject);
|
||||
var
|
||||
RowPtr: PInteger;
|
||||
RawImage: TRawImage;
|
||||
BytePerRow: integer;
|
||||
s: TDateTime;
|
||||
i: integer;
|
||||
j: integer;
|
||||
begin
|
||||
PageControl1.ActivePage := ImageTabSheet;
|
||||
|
||||
s := Now;
|
||||
for j := 1 to 10 do
|
||||
for i := 1 to 23 do
|
||||
begin
|
||||
if FileCache50.GetData(i, bmp) then
|
||||
begin
|
||||
with bmp do
|
||||
try
|
||||
Image1.Picture.Bitmap.Width := 1920;
|
||||
Image1.Picture.Bitmap.Height := 1080;
|
||||
Image1.Picture.Bitmap.PixelFormat := pf32bit;
|
||||
Image1.Picture.Bitmap.BeginUpdate(False);
|
||||
RawImage := Image1.Picture.Bitmap.RawImage;
|
||||
RowPtr := PInteger(RawImage.Data);
|
||||
BytePerRow := RawImage.Description.BytesPerLine;
|
||||
Move(bmp.PixelsData^, RowPtr^, Size.Y * BytePerRow);
|
||||
finally
|
||||
Image1.Picture.Bitmap.EndUpdate(False);
|
||||
end;
|
||||
//Image1.Picture.Bitmap.LoadFromRawImage(png.RawImage, False);
|
||||
Application.ProcessMessages;
|
||||
end;
|
||||
end;
|
||||
|
||||
AddTestToListBox('TImage', 230 / ((Now - s) * 24 * 3600));
|
||||
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.
|
||||
@ -53,11 +53,14 @@ function TFileCache.GetData(Number: integer; var Bitmap: TPortableNetworkGraphic
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result := False;
|
||||
for i := 0 to FCount - 1 do
|
||||
if FCacheList[i].number = Number then
|
||||
begin
|
||||
cache_stream.Position := FCacheList[i].start;
|
||||
Bitmap.LoadFromStream(cache_stream, FCacheList[i].length);
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
BIN
applications/draw_test/untitled.blend
Normal file
BIN
applications/draw_test/untitled.blend
Normal file
Binary file not shown.
Loading…
Reference in New Issue
Block a user