How can i improve and optimize my customized image class

  

I have a Manga Viewer which usually has to load a large number of images in a very short time, the dimension for these images are mostly higher than 8096px (mostly only the height is higher than 8096px) which is why i had to load them in a TBitmapSurface and then split it into several TBitmap and finally assign these TBitmaps to several TImages.
The problem i currently have is that the loading time for these images is fairly high which is why i am looking to optimize my image class, and my codes and find out if i am doing something wrong, any tips and help is much appreciated.
Here are some statics you might wanna know
While loading
Number of images : 24
Size Images ~ 2048 * 8765
Size (KB) per image ~ 700KB
GPU: GTX 980
HardDrive: SSD 250 Samsung
CPU: 990X

I get a timing of
1- 1.3 second for loading the bitmaps
2- 2.3 second for assigning the bitmaps to TImage
3- 4 ms for sorting and rearranging the TImages.
Here is the code for my Image class called TATDLargeImage

unit ATDLargeImage;

interface

uses
FMX.Graphics, FMX.Surfaces, FMX.Objects, FMX.Types, System.UITypes, System.Classes, System.Generics.Collections;

type
TLargeImageMouseUpCallBack = procedure(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single) of object;

type
TLargeImageKeyUpCallBack = procedure(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState) of object;

type
TATDLargeImage = class(TObject)
private
mImageList: Tlist<TImage>;
mBitmapSurface, mEmptyBitmapSurface: TBitmapSurface;
mX, mY: Single;
mParent: TFmxObject;
mOnCustomMouseUp: TLargeImageMouseUpCallBack;
mOnCustomKeyUp: TLargeImageKeyUpCallBack;
mTagString: String;
mWidth, mHeight: Single;
mTag: Integer;
mVisible: boolean;
mOpacity: Single;
mScale: Single;
mMaxWidth: Single;

procedure drawBitmapSurfaceOnImages();
procedure legacy_drawBitmapSurfaceOnImages();
procedure reArrangeImages();

procedure setX(value: Single);
function getX(): Single;

procedure setY(value: Single);
function getY(): Single;

procedure onMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single);
procedure onKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);

procedure setVisible(state: boolean);
function getVisible(): boolean;

procedure setOpacity(value: single);
function getOpacity(): Single;

procedure setScale(value: single);

function getWidth(): Single;
function getHeight(): Single;

procedure resizeBitmap(var source: TBitmap; newWidth, newHeight: Single);

procedure createImage();

{ private declarations }
protected
{ protected declarations }
public
{ public declarations }
constructor create(parent: TFmxObject);
destructor destroy();

procedure loadFromFile(const AFileName: string);

procedure BeginUpdate();
procedure EndUpdate();

procedure EmptyBitmaps;

function isEmpty(): boolean;

//draws the TBitmap on The TImage, make sure this happens in the UI Thread
procedure draw();

procedure resizeByScale(scale: single);

property X: Single read getX write setX;
property Y: Single read getY write setY;

property onCustomMouseUp: TLargeImageMouseUpCallBack read mOnCustomMouseUp write mOnCustomMouseUp;
property onCustomKeyUp: TLargeImageKeyUpCallBack read mOnCustomKeyUp write mOnCustomKeyUp;

property TagString: String read mTagString write mTagString;

property Width: Single read getWidth write mWidth;
property Height: Single read getHeight write mHeight;

property Tag: integer read mTag write mTag;

property Visible: Boolean read getVisible write setVisible;

property Opacity: Single read getOpacity write setOpacity;

property Scale: Single read mScale write setScale;

property MaxWidth: Single read mMaxWidth write mMaxWidth;
published
{ published declarations }
end;

implementation
uses
system.types;

constructor TATDLargeImage.create(parent: TFmxObject);
var
I: Integer;
maxImageCount: integer;
begin
mParent := parent;
mWidth := 0;
mHeight := 0;
mTag := 0;
mOpacity := 0;
mX := 0;
mY := 0;
mScale := 1;
mVisible := true;
mMaxWidth := -1;

mBitmapSurface := TBitmapSurface.Create;
mEmptyBitmapSurface := TBitmapSurface.Create;

mImageList := TList<TImage>.create;

maxImageCount := 1;

for I := 0 to maxImageCount – 1 do
begin
createImage;
end;
end;

destructor TATDLargeImage.destroy;
var
I: Integer;
begin
mBitmapSurface.Free;

for I := 0 to mImageList.Count – 1 do
begin
mImageList[I].Free;
end;
end;

procedure TATDLargeImage.createImage;
var
image: TImage;
begin
image := TImage.Create(nil);
image.Parent := mParent;
image.Width := 0;
image.Height := 0;
image.OnMouseUp := onMouseUp;
image.OnKeyUp := onKeyUp;
mImageList.add(image);
end;

procedure TATDLargeImage.loadFromFile(const AFileName: string);
begin
TBitmapCodecManager.LoadFromFile(AFileName, mBitmapSurface);
mWidth := mBitmapSurface.Width;
mHeight := mBitmapSurface.Height;
end;

procedure TATDLargeImage.draw;
begin
drawBitmapSurfaceOnImages;
reArrangeImages();
end;

procedure TATDLargeImage.drawBitmapSurfaceOnImages;
var
src, dest: TBitmapSurface;
partitionCount: integer;
w, h, hSum : integer;
destIndexCounter: integer;

I, scan: Integer;

mapSize_H: integer;
begin
for I := 1 to mImageList.Count – 1 do
begin
mImageList[I].Bitmap.Assign(mEmptyBitmapSurface);
end;

mapSize_H := 8096;

src := mBitmapSurface;
try
partitionCount := (src.Height div mapSize_H) + 1;

if (partitionCount = 1) then
mImageList[0].Bitmap.assign(src)
else
begin
dest := TBitmapSurface.Create;

hSum := 0;

while (mImageList.Count < partitionCount) do
createImage;

for I := 0 to partitionCount – 1 do
begin
w := src.Width;
if (I = partitionCount – 1) then
h := src.Height – hSum
else
h := mapSize_H;

dest.SetSize(w, h, TPixelFormat.RGBA);

destIndexCounter := 0;
for scan := hSum to h + hSum – 1 do
begin
//src.width * 4 means that make space for width * 4 (RGBA?) bytes
Move(src.Scanline[scan]^, TBitmapSurface(dest).Scanline[destIndexCounter]^, src.Width * 4);
inc(destIndexCounter);
end;

mImageList[I].Bitmap.Assign(dest);

hSum := hSum + h;
end;
end;
except
partitionCount := 0;
end;
end;

procedure TATDLargeImage.reArrangeImages;
var
I: Integer;
image: TImage;
offset: Single;
begin
offset := 0;

for I := 0 to mImageList.count – 1 do
begin
image := mImageList[I];
image.width := image.bitmap.width * mScale;
if (mMaxWidth <> -1) then
begin
if (image.Width > mMaxWidth) then
begin
image.Width := mMaxWidth;
mWidth := mMaxWidth;
end;
end;

image.height := image.bitmap.height * mScale;

image.Position.X := mX;
image.Position.Y := mY + offset;

offset := offset + image.Height;
end;
end;

procedure TATDLargeImage.setX(value: Single);
begin
mX := value;

reArrangeImages;
end;

function TATDLargeImage.getX(): Single;
begin
Result := mX;
end;

procedure TATDLargeImage.setY(value: Single);
begin
mY := value;

reArrangeImages;
end;

function TATDLargeImage.getY(): Single;
begin
Result := mY;
end;

procedure TATDLargeImage.onMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single);
begin
mOnCustomMouseUp(self, button, shift, x, y);
end;

procedure TATDLargeImage.onKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
begin
mOnCustomKeyUp(self, key, keyChar, shift);
end;

procedure TATDLargeImage.BeginUpdate;
var
I: Integer;
begin
for I := 0 to mImageList.Count – 1 do
begin
mImageList[I].BeginUpdate;
end;
end;

procedure TATDLargeImage.EndUpdate;
var
I: Integer;
begin

for I := 0 to mImageList.Count – 1 do
begin
mImageList[I].EndUpdate;
end;
end;

procedure TATDLargeImage.EmptyBitmaps;
var
I: Integer;
begin
mBitmapSurface.Assign(mEmptyBitmapSurface);

{for I := 0 to mImageList.Count – 1 do
begin
mImageList[I].Bitmap := nil;
end;}
end;

function TATDLargeImage.isEmpty(): boolean;
var
I: Integer;
begin
//Result := true;

{for I := 0 to mImageList.Count – 1 do
begin
Result := Result and mImageList[I].Bitmap.IsEmpty;
end;}

if (mBitmapSurface.Width = 0) and (mBitmapSurface.Height = 0) then
Result := true
else
Result := false;
end;

procedure TATDLargeImage.setVisible(state: Boolean);
var
I: Integer;
begin
mVisible := state;

for I := 0 to mImageList.Count – 1 do
begin
mImageList[I].Visible := mVisible;
end;
end;

function TATDLargeImage.getVisible(): boolean;
begin
Result := mVisible;
end;

procedure TATDLargeImage.setOpacity(value: Single);
var
I: Integer;
begin
mOpacity := value;

for I := 0 to mImageList.Count – 1 do
begin
mImageList[I].Opacity := mOpacity;
end;
end;

function TATDLargeImage.getOpacity;
begin
Result := mOpacity;
end;

procedure TATDLargeImage.resizeBitmap(var source: TBitmap; newWidth, newHeight: Single);
var
newBitmap: Tbitmap;
src, trg: TRectF;
targetWidth, targetHeight: integer;
begin
newBitmap:= TBitmap.Create;
try
newBitmap.SetSize(targetWidth, targetHeight);

src := RectF(0, 0, source.Width, source.Height);
trg := RectF(0, 0, targetWidth, targetHeight);

newBitmap.Canvas.BeginScene;
newBitmap.Canvas.DrawBitmap(source, src, trg, 1);
newBitmap.Canvas.EndScene;

source.SetSize(targetWidth, targetHeight);
source.Assign(newBitmap);
finally
newBitmap.Free;
end;
end;

procedure TATDLargeImage.setScale(value: Single);
begin
mScale := value;
end;

function TATDLargeImage.getWidth(): Single;
begin
Result := mWidth * mScale;
end;

function TATDLargeImage.getHeight(): Single;
begin
Result := mHeight * mScale;
end;

procedure TATDLargeImage.resizeByScale(scale: Single);
var
I: Integer;
begin
mBitmapSurface.SetSize(Trunc(mBitmapSurface.Width * Scale), Trunc(mBitmapSurface.Height * Scale));
mWidth := mBitmapSurface.Width;
mHeight := mBitmapSurface.Height;

drawBitmapSurfaceOnImages;
reArrangeImages();
end;

end.

Comments are closed.