Как я могу улучшить и оптимизировать свой собственный класс изображений

Question

У меня есть Manga Viewer, который обычно должен загружать большое количество изображений за очень короткое время, размер этих изображений в основном выше 8096px (в основном только высота выше 8096px), поэтому мне пришлосьзагрузите их в TBitmapSurface, а затем разделите на несколько TBitmap и, наконец, присвойте эти TBitmaps нескольким TImages.
. У меня сейчас проблема в том, что время загрузки этих изображений довольно велико,почему я пытаюсь оптимизировать свой класс изображений, свои коды и узнать, делаю ли я что-то не так, любые советы и помощь очень ценятся.
Вот некоторые статические характеристики, которые вы, возможно, захотите знать
Во время загрузки
Количество изображений: 24
Размер изображения ~ 2048 *8765* 1010 * Размер (КБ) на изображение ~ 700 КБ
Графический процессор: GTX 980
Жесткий диск: SSD 250 Samsung
Процессор: 990X

Я получаю синхронизацию
1- 1,3 секунды для загрузки растровых изображений
2- 2,3 секунды для назначения растровых изображений TImage
3- 4 мс для сортировкиg и перестановка TImages.
Вот код для моего класса изображений под названием 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.