我有一个Manga Viewer,它通常必须在很短的时间内加载大量图像,这些图像的尺寸大多大于8096px(大多数情况是高度大于8096px),这就是为什么我不得不将它们加载到TBitmapSurface
中,然后将其拆分为多个TBitmap
,最后将这些TBitmaps
分配给多个TImages
。
我目前遇到的问题是这些图像的加载时间相当长,这就是为什么我要优化我的图像类,我的代码并找出我做错了什么的原因,非常感谢任何提示和帮助。 br />
这是您可能想知道的一些静力学
加载时
图片数量:24
尺寸图片〜2048 * 8765
每个图像的大小(KB)〜700KB
GPU:GTX 980
硬盘:SSD 250 Samsung
CPU:990X
我的时间是
1- 1.3秒用于加载位图
2- 2.3秒,用于将位图分配给TImage
3- 4毫秒,用于对TImages
进行排序和重新排列。
这是我的Image类的代码,名为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.