17 июня 2020

Изменение разрешения изображения. Ускорение

    Приведенный в статье "Изменение разрешения изображения" алгоритм изменения разрешения изображения рабочий, только, как оказалось, очень медленный. Я сразу подумал, что это из-за использования мной режима масштабирования изображения HALFTONE. Но, даже при использовании режима COLORONCOLOR, моя процедура в 3-4 раза медленнее стандартного метода Canvas.StretchDraw!
    Пройдя под отладкой от вызова Canvas.StretchDraw до TBitmap.Draw я нашел, что причиной такой разницы в скорости работы является получение хэндла Canvas. У TBitmap.Draw он читается напрямую - ACanvas.FHandle, а у меня через свойство Canvas.Handle. Геттер этого свойства вызывает метод TCanvas.RequiredState, в котором он пересоздает хэндл Canvas используя метод TBitmapCanvas.CreateHandle. Итак, чтобы решить проблему с быстродействием надо избавиться от повторного создания хэндла, а для этого необходимо получить доступ к приватному свойству TCanvas.FHandle:
type
  TCanvas = class(TCustomCanvas)
  private
    FHandle: HDC;
Это свойство видят и используют методы классов, которые расположены в модуле Vcl.Graphics. От остальных программистов оно скрыто за модификатором доступа private. Что бы восстановить справедливость, воспользуемся одним из способов, которые я описал в статье "Доступ к private членам класса". Я выбрал способ, которого разработчики Delphi пытались нас лишить в Delphi 10.1 Berlin, но на наше счастье они допустили баг и оставили лазейку - создадим class helper для TCanvas:
type
  TCanvasHelper = class helper for TCanvas
    function GetFHandle: HDC;
  end;

implementation

{ TCanvasHelper }

function TCanvasHelper.GetFHandle: HDC;
begin
  with Self do
    begin
      if FHandle = 0 then
        RequiredState([csHandleValid..csBrushValid]);
      Result := FHandle;
    end;
end;
Получим в процедуре ScaleJpeg хэндлы используя функцию GetFHandle из helper'а:
procedure ScaleJpeg(jpg: TJPEGImage; const NewWidth, NewHeight: Integer; 
                    const StretchMode: Integer = COLORONCOLOR);
var
  bmp: Vcl.Graphics.TBitmap;
  fScale: Double;
  PrevPt: TPoint;
  hBMP, hJPG: HDC;
begin
  fScale := Min(NewWidth / jpg.Width, NewHeight / jpg.Height);
  bmp := Vcl.Graphics.TBitmap.Create;
  try
    bmp.SetSize(Round(jpg.Width * fScale), Round(jpg.Height * fScale));

    hBMP := bmp.Canvas.GetFHandle;
    hJPG := jpg.Canvas.GetFHandle;

    GetBrushOrgEx(hBMP, PrevPt);
    SetStretchBltMode(hBMP, StretchMode);
    SetBrushOrgEx(hBMP, PrevPt.x, PrevPt.y, @PrevPt);
    StretchBlt(hBMP, 0, 0, bmp.Width, bmp.Height, 
               hJPG, 0, 0, jpg.Width, jpg.Height,
               SRCCOPY);
    jpg.Assign(bmp);
  finally
    bmp.Free;
  end;
end;
    Теперь масштабирование тестового изображения большого разрешения моей процедурой в режиме COLORONCOLOR работает с такой же скоростью, как у стандартного метода Canvas.StretchDraw.
    В результате всех моих изысканий окончательный вариант модуля для изменения разрешения изображения у меня получился такой:
unit ahGraphics;

interface

uses
  System.Classes, System.SysUtils, System.Math, 
  Vcl.Graphics, Vcl.Imaging.jpeg, WinAPI.Windows;

type
  TCanvasHelper = class helper for TCanvas
    function GetFHandle: HDC;
  end;

  TJPEGImageHelper = class helper for TJPEGImage
    procedure Resize(const NewWidth, NewHeight: Integer; 
                     const StretchMode: Integer = COLORONCOLOR);
  end;

implementation

{ TCanvasHelper }

function TCanvasHelper.GetFHandle: HDC;
begin
  with Self do
    begin
      if FHandle = 0 then
        RequiredState([csHandleValid..csBrushValid]);
      Result := FHandle;
    end;
end;

{ TJPEGImageHelper }

procedure TJPEGImageHelper.Resize(const NewWidth, NewHeight, 
                                        StretchMode: Integer);
var
  bmp: Vcl.Graphics.TBitmap;
  fScale: Double;
  PrevPt: TPoint;
  hBMP, hJPG: HDC;
begin
  if (NewWidth <> Width) or (NewHeight <> Height) then
    begin
      fScale := Min(NewWidth / Width, NewHeight / Height);
      bmp := Vcl.Graphics.TBitmap.Create;
      try
        bmp.SetSize(Round(Width * fScale), Round(Height * fScale));
        hBMP := bmp.Canvas.GetFHandle;
        hJPG := Canvas.GetFHandle;

        GetBrushOrgEx(hBMP, PrevPt);
        SetStretchBltMode(hBMP, StretchMode);
        SetBrushOrgEx(hBMP, PrevPt.x, PrevPt.y, @PrevPt);
        StretchBlt(hBMP, 0, 0, bmp.Width, bmp.Height, 
                   hJPG, 0, 0, Width, Height, SRCCOPY);
        Assign(bmp);
      finally
        bmp.Free;
      end;
    end;
end;

end.
Пример использования:
var
  jpg: TJPEGImage;
begin
...
  jpg.Resize(1000, 1000, HALFTONE);

P.S. Кто-то еще сомневается в пользе возможности доступа к приватным членам класса в Delphi?

Комментариев нет:

Отправка комментария