Приведенный в статье "Изменение разрешения изображения" алгоритм изменения разрешения изображения рабочий, только, как оказалось, очень медленный. Я сразу подумал, что это из-за использования мной режима масштабирования изображения HALFTONE. Но, даже при использовании режима COLORONCOLOR, моя процедура в 3-4 раза медленнее стандартного метода Canvas.StretchDraw!
Пройдя под отладкой от вызова Canvas.StretchDraw до TBitmap.Draw я нашел, что причиной такой разницы в скорости работы является получение хэндла Canvas. У TBitmap.Draw он читается напрямую - ACanvas.FHandle, а у меня через свойство Canvas.Handle. Геттер этого свойства вызывает метод TCanvas.RequiredState, в котором он пересоздает хэндл Canvas используя метод TBitmapCanvas.CreateHandle. Итак, чтобы решить проблему с быстродействием надо избавиться от повторного создания хэндла, а для этого необходимо получить доступ к приватному свойству TCanvas.FHandle:
В результате всех моих изысканий окончательный вариант модуля для изменения разрешения изображения у меня получился такой:
P.S. Кто-то еще сомневается в пользе возможности доступа к приватным членам класса в Delphi?
Пройдя под отладкой от вызова 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 ahGraphicsHelpers; 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?
Комментариев нет:
Отправить комментарий