[Hadgehogs]

Дня доброго.
Я тут новенький.
С Дельфи профессионально не работаю, моя стезя - 1С 8.2.

В 1с есть проблема - картинки, при выводе которых на экран/принтер через графическую систему 1С - идет отжор памяти без ее освобождения.

Немного об GDI от 1С: окна Windows ей нужны только для масштабирования окон (но не элементов) а также для отлова событий от ОС (WM_CLOSE, и.т.д.). Вся отрисовка - своя, основана на перехвате WM_PAINT

Запилил addins через отдельную dll, в которой формочка (окно), отдельное от графической системы 1С (1С не перехватывает его WM_PAINT). На формочке - TImage. Все нормально, супергуд.

10 метровые фотки летают...
Но хочется большего.
По умолчанию - GDI не поддерживает TIFF (а это важно, часто сканы в 1С - это сканы сопроводиловки - Ч/Б печать).

Впилил GDI+. Но даже по ощущениям увидел, что медленней стало.
Замерил - примерно в 5 раз медленнее таже конвертация из bmp в jpeg идет. Бида.

Узнал про поддержку Direct2D в Win7, начал экспериментировать.
Увидел, что она действительно работает - например масштабирование рисунка через TDirect2DCanvas.RenderTarget выполняется раза в 2.5 быстрее, чем через GDI (реализацию приведу чуть позже) и при это загружен GPU видюхи на 17-20 процентов. Профит.

Но вот как потом получить трансформированное изображение с TDirect2DCanvas - не могу осилить.

[Hadgehogs]

Вернемся к старым песням.
С конвертацией изображений разобрался, все быстро и четко.
Особенно понравился новый формат HD-Photo (JPEG-XR) на основе вейвлет сжатия. На малом качестве он творит чудеса, вытягивая картинку.

Но мы движемся дальше.
Теперь моя цель - создать свой компонент на основе TImage который будет отрисовывать Direct2D графику. Вот первые наброски:

Код:

unit Direct2DImages;

interface

uses Windows,SysUtils,Classes,messages,Controls,Forms,ExtCtrls,Direct2d,WinCodec,d2d1,Graphics,ActiveX;

type
  TDirect2DImage= class(TImage)
  private
    fOldWidth:integer;
    fOldHeight:integer;
    fDirectBitmap:IWICFormatConverter;
    procedure SetDirectImage(ImageData:TMemoryStream);
    procedure DirectPaint();
  protected
    procedure Paint;override;
    procedure WMResize(var MSG:TWMSize);message WM_SIZE;
  public
    constructor Create(AOwner:TComponent);override;
    Property DirectImage:TMemoryStream write SetDirectImage;
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples',[TDirect2DImage]);
end;

function _GetErrorMsg(ecode:DWORD):string;
var
  Buf: array [0..1024] of char;
begin
  SetString(result,Buf,FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,ecode,0,@Buf,sizeOf(Buf),nil));
  result:=StringReplace(result,#13#10,'',[rfReplaceAll]);
end;
{ TDirect2DImage }

constructor TDirect2DImage.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  fOldWidth:=0;
  fOldHeight:=0;
end;

procedure TDirect2DImage.DirectPaint;
var
  Status:Hresult;
  ImagingFactory:IWICImagingFactory;
  DirectCanvas:TDirect2DCanvas;
  DirectBitmap:ID2D1Bitmap;
  RenderTarget:ID2D1RenderTarget;
  BitmapSize,RenderSize:TD2DSizeF;
  Scale:TD2D1Matrix3x2F;
  D2DSizeF:D2D1_SIZE_F;
  D2DPointF:D2D_POINT_2F;
  ImageRect,OwnerRect:TRect;
  ScaleX,ScaleY:real;
begin
  if fDirectBitmap=nil then
    exit;
  try
    ImageRect:=(self as TImage).ClientRect;
    OwnerRect:=(self.Owner as TForm).ClientRect;
    ImageRect.Left:=ImageRect.Left+(self as TImage).Left;
    ImageRect.Right:=ImageRect.Right+(self as TImage).Left;
    ImageRect.Top:=ImageRect.Top+(self as TImage).Top;
    ImageRect.Bottom:=ImageRect.Bottom+(self as TImage).Top;
    DirectCanvas:=TDirect2DCanvas.Create((self.Owner as TForm).Canvas.Handle,ImageRect); // Связываем Direct 2D canvas с canvas формы
    RenderTarget:=DirectCanvas.RenderTarget as ID2D1RenderTarget;
    Status:=RenderTarget.CreateBitmapFromWicBitmap(fDirectBitmap,nil,DirectBitmap); // Создаем bitmap, годный для операций с Direct2D, типа ID2D1Bitmap. Это уже голый Direct2D, до этого был WIC. еще понятный. см. http://msdn.microsoft.com/en-us/library/windows/desktop/dd742779%28v=vs.85%29.aspx
    if not Succeeded(Status) then
      raise Exception.Create('Не удалось создать контекст изображения D2D про причине:"'+_GetErrorMsg(ResultCode(Status))+'"');
    RenderTarget.BeginDraw(); // Начинаем рисовать
    RenderTarget.Clear(D2D1ColorF(clRed)); // Очищаем красным, чтобы было видно
    DirectBitmap.GetSize(BitmapSize); // Получаем размер изображения
    ZeroMemory(@Scale,16);
    RenderTarget.GetSize(RenderSize); // получаем размер холста
    ScaleX:=RenderSize.Width/BitmapSize.Width;
    ScaleY:=RenderSize.height/BitmapSize.height;
    D2DSizeF.Width:=ScaleX;
    D2DSizeF.height:=ScaleY; // Увеличиваем рисунок до холста, потом будет с сохранением пропорций
    D2DPointF.x:=0;
    D2DPointF.y:=0;
    Scale:=TD2DMatrix3x2F.Scale(D2DSizeF,D2DPointF); // Создаем матрицу пространственного преобразования
    RenderTarget.SetTransform(Scale); // Преобразовываем Direct2D холст, по аналогии с SetWorldTransform() для HDC
    // Мне дико непонятно, какой режим масштабирования - тупо "ближайший сосед", "Билинейная" или годная "Бикубическая". Есть мысли?
    if assigned(DirectBitmap) then
      RenderTarget.DrawBitmap(DirectBitmap); // Рисуем картинку. Все норм, на форме она есть. Ура.
    RenderTarget.EndDraw(); // Фиксируем
  finally
    RenderTarget:=nil;
    DirectCanvas.Free;
    ImagingFactory:=nil;
  end;
end;

procedure TDirect2DImage.Paint; // Что то изменилось, размеры, лиюо форма перекрыта другой.
begin
  // if ((Self.Owner as TForm).Width<>fOldWidth) or ((Self.Owner as TForm).Height<>fOldHeight) then
  if ((self as TImage).Width<>fOldWidth)or((self as TImage).height<>fOldHeight) then begin
    fOldWidth:=(self as TImage).Width;
    fOldHeight:=(self as TImage).height;
    DirectPaint();
  end;
end;

// Загружаем изобрадение из потока в Конвертер, выполняется 1 раз, при этом происходит масштабирование до размера экрана
procedure TDirect2DImage.SetDirectImage(ImageData:TMemoryStream);
  function Max(const A,B:Extended):Extended;
  begin
    if A>B then
      result:=A
    else
      result:=B;
  end;

var
  ImagingFactory:IWICImagingFactory;
  WicImage:TWicImage;
  BitmapScaler:IWICBitmapScaler;
  HDC:THandle;
  ScreenWidth:integer;
  ScreenHeight:integer;
  CoefWidth:real;
  CoefHeight:real;
  TotalCoef:real;
  Status:Hresult;
begin
  if ImageData=nil then
    exit; // Нуавдруг
  HDC:=GetDC((self.Owner as TForm).Handle);
  ScreenWidth:=GetDeviceCaps(HDC,HORZRES);
  ScreenHeight:=GetDeviceCaps(HDC,VERTRES);
  WicImage:=TWicImage.Create(); // Обертка Дельфи над IWicBitmap. Воспользуемся.
  ImagingFactory:=WicImage.ImagingFactory;
  ImageData.Seek(0,0); // На начало, мало ли.
  WicImage.LoadFromStream(ImageData); // Загрузим из потока
  CoefWidth:=WicImage.Width/ScreenWidth;
  CoefHeight:=WicImage.height/ScreenHeight;
  TotalCoef:=Max(CoefWidth,CoefHeight);
  TotalCoef:=Max(1,TotalCoef); // Нам надо отмасштабировать под размер экрана, сохранив пропорции
  Status:=ImagingFactory.CreateBitmapScaler(BitmapScaler); // Создадим масштабировщик
  if not Succeeded(Status) then
    raise Exception.Create('');
  // Инициируем масштабирование, бикубичесое.
  Status:=BitmapScaler.Initialize(WicImage.Handle,Round(WicImage.Width/TotalCoef),Round(WicImage.height/TotalCoef),WICBitmapInterpolationModeCubic);
  if not Succeeded(Status) then
    raise Exception.Create('');
  Status:=ImagingFactory.CreateFormatConverter(fDirectBitmap); // Создаем конвертер из фабрики
  if not Succeeded(Status) then
    raise Exception.Create('');
  // Render не принимает на отрисовку BitmapScaler, а BitmapConverter - Норм, дадим ему его.
  Status:=fDirectBitmap.Initialize(BitmapScaler,GUID_WICPixelFormat32bppPBGRA,WICBitmapDitherTypeNone,nil,0,WICBitmapPaletteTypeCustom); // инициализируем конвертер потоком с изображением, при этом он и сделает то, что требуется.
  BitmapScaler:=nil;
  ImagingFactory:=nil;
  WicImage.Free;
end;

procedure TDirect2DImage.WMResize(var MSG:TWMSize);
begin
end;

end.

[Hadgehogs]

Чего пока нет:
1) Годной обработки ошибок.
2) Поддержки старого GDI (2-х режимности, ну это нетрудно).

Есть много вопросов:

1) Как перехватить ресайз TImage. Именно ресайс. При отлове Paint - этих сообщений дико много, по каждому чиху (движение формы, например) - и отрисовка кадрируется. Даже после предварительного масштабирования до размера экрана. Смотрел как сделано в типовой Дельфи - вроде все также, однако не тормозит. Ниасилил.
2) Изображение можно масштабировать 2 методами - через WIC (Интерфейс IWICBitmapScaler) и непосредственно при rendere через SetWorldTransform(). В первом случае можно задать режим масштабирования (бикубический, билинейный, ближайший), однако я не уверен, что там (в WIC) используется Direct2D (обработка через GPU). Во втором случае точно используется GPU (мерил через MSI Afterburner), однако не понятно, как указать режим масштабирования. Есть мысли?

[Hadgehogs]

Что то не густо.

[lmikle]

Сообщение от Hadgehogs

Что то не густо.

Не густо чего? Вопрос то где?

Кстати, у меня один проект без всяких Direct2D, GDI, GDI+ делает отрисовку, в том числе с масштабированием, без всяких тормозов. Картинка JPEG 8mp, все летает на не самых мощных компах.

Все дело в волшебных пузырьках. Т.е. в буфферировании. Картинки читается, конвертится в битмап а памяти (да, не очень экономично по памяти, но тут компромис ресурсы/время) и далее еще через один буфер выводится на канву (второй буфер идет под отрисовку по размерам).