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.