Direct2D, TDirectCanvas и все-все-все

procedure Tform2.Scale1();
var
Status:Hresult;
ImagingFactory:IWICImagingFactory;
DirectCanvas:TDirect2DCanvas;
DirectBitmap:ID2D1Bitmap;
RenderTarget: ID2D1RenderTarget;
size : TD2DSizeF;
WicImage : TWicImage;
FormatConverter : IWICFormatConverter;
Scale:TD2D1Matrix3x2F;
D2DSizeF:D2D1_SIZE_F;
D2DPointF:D2D_POINT_2F;
begin
try
DirectCanvas := TDirect2DCanvas.Create(Canvas.Handle,ClientRect); //Связываем Direct 2D canvas с canvas формы
RenderTarget:= DirectCanvas.RenderTarget as ID2D1RenderTarget; //Получаем контекст построителя изображения
WicImage := TWicImage.Create(); //Создаем объект-обертку над WIC -апи  [url]http://msdn.microsoft.com/en-us/library/windows/desktop/ee719673%28v=vs.85%29.aspx[/url]
ImagingFactory := WicImage.ImagingFactory;  //Контекст фабрики для создания объектов для преобразования изображений
WicImage.LoadFromFile(pchar('c:\in.jpg'));  //Загружаем файл, скорее всего во внутренний IStream
Status:=ImagingFactory.CreateFormatConverter(FormatConverter); //Создаем конвертер из фабрики
if not Succeeded(Status) then raise Exception.Create('');
Status:=FormatConverter.Initialize(WicImage.Handle, GUID_WICPixelFormat32bppPBGRA,WICBitmapDitherTypeNone,nil,0,WICBitmapPaletteTypeCustom); //инициализируем конвертер потоком с изображением, при этом он и сделает то, что требуется.
//То есть, конвертация происходит при инициации, а не при выполении отдельного метода, к примеру Convert(). fuck my mint! см. _http://msdn.microsoft.com/en-us/library/windows/desktop/ee690274%28v=vs.85%29.aspx
if not Succeeded(Status) then raise Exception.Create('');
Status:=RenderTarget.CreateBitmapFromWicBitmap(FormatConverter,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('');
 
RenderTarget.BeginDraw(); //Начинаем рисовать
RenderTarget.Clear(D2D1ColorF(clRed)); //Очищаем красным, чтобы было видно
DirectBitmap.GetSize(Size); //Получаем размер изображения, потом пригодится. пока не используется.
ZeroMemory(@Scale,16);
RenderTarget.GetSize(Size); //получаем размер холста, он равен размеру ClientRect формы
D2DSizeF.width:=2;
D2DSizeF.height:=2; //Увеличиваем рисунок в 2 раза по длине и ширине.
D2DPointF.x:=Round(Size.width/2);
D2DPointF.y:=Round(Size.height/2);
Scale:=TD2DMatrix3x2F.Scale(D2DSizeF,D2DPointF); //Создаем матрицу пространственного преобразования
RenderTarget.SetTransform(Scale); //Преобразовываем Direct2D холст, по аналогии с SetWorldTransform() для HDC
if assigned(DirectBitmap) then RenderTarget.DrawBitmap(DirectBitmap); // Рисуем картинку. Все норм, на форме она есть. Ура.
//Как ее теперь вытащить из формы? Опять получать через HDC и CopyBitmap() ? Чето не то...
RenderTarget.EndDraw();
finally
RenderTarget:=nil;
DirectCanvas.Free;
ImagingFactory:=nil;
WicImage.Free;
end;
 
end;

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. еще понятный. см. [url]http://msdn.microsoft.com/en-us/library/windows/desktop/dd742779%28v=vs.85%29.aspx[/url]
    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.