Прозрачность PNG в проектах Lazarus ...
Модератор: Модераторы
Прозрачность PNG в проектах Lazarus ...
Собствено говоря часть вопроса уже озвучена в названии темы,.. возможно ли такое впринципе. Есть лишь одна небольшая поправка: нужно чтобы была возможность полупрозрачности и сглаживания, т.к. в противном случае PGN не имеет никаких приимуществ по сравнению с тем же BMP.
P.S. Буду признателен за любую информацию.
P.S. Буду признателен за любую информацию.
Неужели ни у кого нет идей?... Путь это даже будет даже не PNG, а что-то другое, главное чтобы со сглаживанием!
-
Павел Ишенин
- постоялец
- Сообщения: 475
- Зарегистрирован: 24.03.2007 09:16:52
А что собственно не работает у вас? Вы пробовали? У меня замечательно работает прозрачность PNG 
Если имеется в виду прозрачность Transparent, то с этим проблем нет.
Имеется в виду немного другое: например я нарисовал в Gimp картинку (обыкновенная линия, проведенная под некоторым углом отличным от 90 градусов) затем сохранил изображение с прозрачным фоном и пытаюсь поместить эту картинку на форму... она помещается, но вот сглаженные края линии (то как она выглядела в Gimp) изчезают, становятся ребристыми. Возможно я не совсем корректно выразился, когда сказал "сглаживание", более уместным было бы "антиалиасинг", но я не знаю насколько этот термин рименим к статическому PNG изображению.
Andreich писал(а):Если имеется в виду прозрачность Transparent, то с этим проблем нет.Имеется в виду немного другое: например я нарисовал в Gimp картинку (обыкновенная линия, проведенная под некоторым углом отличным от 90 градусов) затем сохранил изображение с прозрачным фоном и пытаюсь поместить эту картинку на форму... она помещается, но вот сглаженные края линии (то как она выглядела в Gimp) изчезают, становятся ребристыми. Возможно я не совсем корректно выразился, когда сказал "сглаживание", более уместным было бы "антиалиасинг", но я не знаю насколько этот термин рименим к статическому PNG изображению.
Это только с GTK - GTK2 такая проблема, - не работает альфа канал, который отвечает за полупрозрачность и все из этого вытекающее. Сказали, что в релизе 0.9.28 можно не ждать, будет в следующем. В QT работает.
У одного из посетителей этого форума есть реализация этой проблемы, но ему лень сделать патч, говорит, что много переписать придется.
Logo писал(а):Это только с GTK - GTK2 такая проблема, - не работает альфа канал, который отвечает за полупрозрачность и все из этого вытекающее. Сказали, что в релизе 0.9.28 можно не ждать, будет в следующем. В QT работает.
А что нужно, чтобы пересобрать Lazarus под Qt?
make в каталоге .../lcl/interfaces/qt выполнил, а вот из IDE он пересобираться не хочет,.. ругается на -lqt4intf (not found).
-
Павел Ишенин
- постоялец
- Сообщения: 475
- Зарегистрирован: 24.03.2007 09:16:52
В gtk2 альфа канал работает пока только в TBitBtn и TListView.
Вот столкнулся с этой проблемой, пришлось переписать процедуру прорисовки растровых изображений.
Замените в rasterimage.inc процедуру Draw на
и перекопилируйте lazarus.
Тестировал только под Linux, GTK 2, но по идее с остальными системами тоже должно работать.
Замените в rasterimage.inc процедуру Draw на
Код: Выделить всё
procedure TRasterImage.Draw(DestCanvas: TCanvas; const DestRect: TRect);
var
UseMaskHandle: HBitmap;
SrcDC: hDC;
DestDC: hDC;
DstBmp:TBitmap;
RShift, GShift, BShift, AShift, DstRShift, DstGShift, DstBShift:Integer;
RWidth, RHeight:integer;
ix, iy, iyStartByte, dstiyStartByte:integer;
srcdata, dstdata: PByteArray;
tmpdc:HDC;
bmp, old: HBitmap;
msk: HBitmap;
FinishX:Integer;
FinishY:Integer;
DP, SP:integer;
SrcPR, DstPR:byte;
SrcWidthPR,SrcHeightPR:single;
begin
if (Width=0) or (Height=0)
then Exit;
BitmapHandleNeeded;
if not BitmapHandleAllocated then Exit;
if Masked then
UseMaskHandle:=MaskHandle
else
UseMaskHandle:=0;
DestCanvas.Changing;
DestDC := DestCanvas.GetUpdatedHandle([csHandleValid]);
if ((WidgetSet.LCLPlatform = lpGtk) or (WidgetSet.LCLPlatform = lpGtk2)) and
(PixelFormat = pf32bit) and (RawImage.Description.BitsPerPixel = 32) and
(RawImage.Description.Format = ricfRGBA) then
begin
RWidth:= DestRect.Right-DestRect.Left;
RHeight:= DestRect.Bottom-DestRect.Top;
DstBmp := TBitmap.Create;
DstBmp.PixelFormat:=pf32bit;
DstBmp.SetSize(RWidth,RHeight);
DstBmp.Canvas.CopyRect(rect(0,0,DstBmp.Width,DstBmp.Height),DestCanvas,DestRect);
try
srcdata:=PByteArray(RawImage.Data);
dstdata:=PByteArray(DstBmp.RawImage.Data);
RShift:=RawImage.Description.RedShift div 8;
GShift:=RawImage.Description.GreenShift div 8;
BShift:=RawImage.Description.BlueShift div 8;
AShift:=RawImage.Description.AlphaShift div 8;
DstRShift:=DstBmp.RawImage.Description.RedShift div 8;
DstGShift:=DstBmp.RawImage.Description.GreenShift div 8;
DstBShift:=DstBmp.RawImage.Description.BlueShift div 8;
FinishY:=min(rHeight,DstBmp.RawImage.Description.Height);
FinishX:=min(rWidth,DstBmp.RawImage.Description.Width);
if (Height = rHeight)and(Width = rWidth) then
begin
for iy := 0 to FinishY-1 do
begin
iyStartByte := iy*RawImage.Description.Width;
dstiyStartByte := iy*dstBmp.RawImage.Description.Width;
for ix := 0 to FinishX-1 do
begin
DP :=((ix+dstiyStartByte)*4);
SP :=((ix+iyStartByte)*4);
SrcPR:=srcdata^[SP+AShift];
DstPR:=255-SrcPR;
dstdata^[DP+DstRShift]:=((srcdata^[SP+RShift]*SrcPR)+(dstdata^[DP+DstRShift]*DstPR)) div 255;
dstdata^[DP+DstGShift]:=((srcdata^[SP+GShift]*SrcPR)+(dstdata^[DP+DstGShift]*DstPR)) div 255;
dstdata^[DP+DstBShift]:=((srcdata^[SP+BShift]*SrcPR)+(dstdata^[DP+DstBShift]*DstPR)) div 255;
end;
end;
end else
begin
SrcWidthPR:=Width/RWidth;
SrcHeightPR:=Height/RHeight;
for iy := 0 to FinishY-1 do
begin
iyStartByte := trunc(iy*SrcHeightPR)*RawImage.Description.Width;
dstiyStartByte := iy*dstBmp.RawImage.Description.Width;
for ix := 0 to FinishX-1 do
begin
DP :=((ix+dstiyStartByte)*4);
SP :=((trunc(ix*SrcWidthPR)+iyStartByte)*4);
SrcPR:=srcdata^[SP+AShift];
DstPR:=255-SrcPR;
dstdata^[DP+RShift]:=((srcdata^[SP+RShift]*SrcPR)+(dstdata^[DP+RShift]*DstPR))div 255;
dstdata^[DP+GShift]:=((srcdata^[SP+GShift]*SrcPR)+(dstdata^[DP+GShift]*DstPR))div 255;
dstdata^[DP+BShift]:=((srcdata^[SP+BShift]*SrcPR)+(dstdata^[DP+BShift]*DstPR))div 255;
end;
end;
end;
WidgetSet.RawImage_CreateBitmaps(dstBmp.RawImage, bmp, msk, false);
tmpDC := CreateCompatibleDC(DestDC);
old := SelectObject(tmpDC, bmp);
StretchMaskBlt(DestDC, DestRect.Left, DestRect.Top, DstBmp.RawImage.Description.Width, DstBmp.RawImage.Description.Height, TmpDC, 0, 0, DstBmp.RawImage.Description.Width, DstBmp.RawImage.Description.Height,
0, 0,0,DestCanvas.CopyMode);
finally
DeleteObject(SelectObject(tmpDC, old));
DeleteObject(msk);
DeleteDC(tmpDC);
DstBmp.Free;
end;
end else
begin
SrcDC := Canvas.GetUpdatedHandle([csHandleValid]);
StretchMaskBlt(DestDC,
DestRect.Left,DestRect.Top,
DestRect.Right-DestRect.Left,DestRect.Bottom-DestRect.Top,
SrcDC,0,0,Width,Height, UseMaskHandle,0,0,DestCanvas.CopyMode);
end;
DestCanvas.Changed;
end;
и перекопилируйте lazarus.
Тестировал только под Linux, GTK 2, но по идее с остальными системами тоже должно работать.
Последний раз редактировалось carrots 02.08.2009 05:35:14, всего редактировалось 1 раз.
carrots писал(а):Тестировал только под Linux, GTK 2, но по идее с остальными системами тоже должно работать.
После выполнения предложенной последовательности произошло примерно следующее...
(Ubuntu 9.04, Lazarus 0.9.26.3 + Gtk2)
У вас нет необходимых прав для просмотра вложений в этом сообщении.
Попробуй этот
Здесь используется предыдущий вариант переноса битов и еще несколько поправок, но по моему лучше первый вариант.
Еще причина может быть в старом lazarus-е, у меня v0.9.27, fpc 2.3.1
Код: Выделить всё
procedure TRasterImage.Draw(DestCanvas: TCanvas; const DestRect: TRect);
var
UseMaskHandle: HBitmap;
SrcDC: hDC;
DestDC: hDC;
RWidth, RHeight:Integer;
DstMap: TLazIntfImage;
DstBmp:TBitmap;
SrcBmp:TBitmap;
ix, iy, SrcPos, DstPos:integer;
srcdata, dstdata, outdata: PByteArray;
srccolors, dstcolors: PIntegerArray;
tmpDC: HDC;
bmp, old: HBitmap;
msk: HBitmap;
SrcPR, DstPR:single;
RShift, GShift, BShift, AShift, DstRShift, DstGShift, DstBShift:Integer;
begin
if (Width=0) or (Height=0)
then Exit;
if PixelFormat = pf32bit then
begin
RWidth:=DestRect.Right-DestRect.Left;
RHeight:=DestRect.Bottom-DestRect.Top;
SrcBmp := tbitmap(self);
if (SrcBmp.Width <> RWidth) or (SrcBmp.Height <> RHeight) then
begin
SrcBmp := TBitmap.Create;
SrcBmp.PixelFormat:=pf32bit;
SrcBmp.RawImage.Description.AlphaShift:=RawImage.Description.AlphaShift;
SrcBmp.RawImage.Description.RedShift:=RawImage.Description.RedShift;
SrcBmp.RawImage.Description.GreenShift:=RawImage.Description.GreenShift;
SrcBmp.RawImage.Description.BlueShift:=RawImage.Description.BlueShift;
SrcBmp.SetSize(RWidth,RHeight);
SrcBmp.Canvas.FillRect(0,0,1,1);
srccolors:=PIntegerArray(RawImage.Data);
dstcolors:=PIntegerArray(SrcBmp.RawImage.Data);
for ix := 0 to SrcBmp.Width-1 do
for iy := 0 to SrcBmp.Height-1 do
dstcolors^[ix+(iy*SrcBmp.Width)] := srccolors^[((ix*Width)div SrcBmp.Width)+(((iy*Height)div SrcBmp.Height)*Width)];
end;
DstBmp := TBitmap.Create;
DstBmp.PixelFormat:=pf24bit;
DstBmp.TransparentMode:=tmFixed;
DstBmp.Transparent:=false;
DstBmp.Masked:=false;
DstBmp.SetSize(SrcBmp.Width,SrcBmp.Height);
DstBmp.Canvas.CopyRect(rect(0,0,DstBmp.Width,DstBmp.Height),DestCanvas,DestRect);
DstMap := DstBmp.CreateIntfImage;
try
srcdata:=PByteArray(SrcBmp.RawImage.Data);
dstdata:=PByteArray(DstBmp.RawImage.Data);
outdata:=DstMap.GetDataLineStart(0);
RShift:=RawImage.Description.RedShift div 8;
GShift:=RawImage.Description.GreenShift div 8;
BShift:=RawImage.Description.BlueShift div 8;
AShift:=RawImage.Description.AlphaShift div 8;
DstRShift:=DstBmp.RawImage.Description.RedShift div 8;
DstGShift:=DstBmp.RawImage.Description.GreenShift div 8;
DstBShift:=DstBmp.RawImage.Description.BlueShift div 8;
for ix := 0 to (SrcBmp.Width*SrcBmp.Height)-1 do
begin
SrcPR:=(srcdata^[(ix*4)+AShift])/256;
DstPR:=1-SrcPR;
outdata^[(ix*4)+DstRShift]:=trunc((srcdata^[(ix*4)+RShift]*SrcPR)+(dstdata^[(ix*4)+DstRShift]*DstPR));
outdata^[(ix*4)+DstGShift]:=trunc((srcdata^[(ix*4)+GShift]*SrcPR)+(dstdata^[(ix*4)+DstGShift]*DstPR));
outdata^[(ix*4)+DstBShift]:=trunc((srcdata^[(ix*4)+BShift]*SrcPR)+(dstdata^[(ix*4)+DstBShift]*DstPR));
end;
DstMap.CreateBitmaps(bmp, msk, false);
tmpDC := CreateCompatibleDC(DestCanvas.Handle);
old := SelectObject(tmpDC, bmp);
// DestCanvas.Changing;
// BitBlt(DestCanvas.Handle, DestRect.Left, DestRect.Top, DestRect.Right, DestRect.Bottom, tmpDC, 0, 0, SRCCOPY);
// DestCanvas.Changed;
DestCanvas.Changing;
DestDC := DestCanvas.GetUpdatedHandle([csHandleValid]);
StretchMaskBlt(DestDC,
DestRect.Left,DestRect.Top,
DstMap.Width,DstMap.Height,
tmpDC,0,0,DstMap.Width,DstMap.Height, 0,0,0,DestCanvas.CopyMode);
DestCanvas.Changed;
finally
DeleteObject(SelectObject(tmpDC, old));
DeleteObject(msk);
DeleteDC(tmpDC);
DstMap.Free;
DstBmp.Free;
if SrcBmp <> self then SrcBmp.free;
end;
end else
begin
BitmapHandleNeeded;
if not BitmapHandleAllocated then Exit;
if Masked then
UseMaskHandle:=MaskHandle
else
UseMaskHandle:=0;
SrcDC := Canvas.GetUpdatedHandle([csHandleValid]);
DestCanvas.Changing;
DestDC := DestCanvas.GetUpdatedHandle([csHandleValid]);
StretchMaskBlt(DestDC,
DestRect.Left,DestRect.Top,
DestRect.Right-DestRect.Left,DestRect.Bottom-DestRect.Top,
SrcDC,0,0,Width,Height, UseMaskHandle,0,0,DestCanvas.CopyMode);
DestCanvas.Changed;
end;
end; Здесь используется предыдущий вариант переноса битов и еще несколько поправок, но по моему лучше первый вариант.
Еще причина может быть в старом lazarus-е, у меня v0.9.27, fpc 2.3.1
Последний раз редактировалось carrots 30.07.2009 19:23:10, всего редактировалось 1 раз.
Оооо......
Теперь моё приложение приняло человеческий вид
Lazarus 0.9.27 SVN, OS Mandriva.
Все работает на ура и весьма быстро.
carrots, еще компонент анимации, плизззззз....
Добавлено спустя 29 минут 32 секунды:
Под QT со "спецэффектами"
Нужно делать условную компиляцию
Теперь моё приложение приняло человеческий вид
Lazarus 0.9.27 SVN, OS Mandriva.
Все работает на ура и весьма быстро.
carrots, еще компонент анимации, плизззззз....
Добавлено спустя 29 минут 32 секунды:
Под QT со "спецэффектами"
Нужно делать условную компиляцию
Logo писал(а):Нужно делать условную компиляцию
Этот файл не реагирует на ключ {$IFDEF LCLGTK2}
2Andreich пробовал под suse, mandriva, debian, под gnome и KDE, везде работает, так что причина наверное в старом lazarus и FPC
carrots
Перенеси свою реализацию в файл lazarus/lcl/interfaces/gtk/gtkwidgetset.inc футкция
function TGtkWidgetSet.StretchCopyArea(DestDC: HDC; X, Y, Width, Height: Integer;
Из rasterimage.inc
Вызов идет из function TGtkWidgetSet.StretchMaskBlt(
и из function TGtkWidgetSet.StretchBlt(
Учти там параметры.
Короче StretchMaskBlt для каждого виджетсет реализуется своя, а ключи условной компиляции в rasterimage.inc не действуют.
И еще, я не понял зачем заливать один пиксел :
Перенеси свою реализацию в файл lazarus/lcl/interfaces/gtk/gtkwidgetset.inc футкция
function TGtkWidgetSet.StretchCopyArea(DestDC: HDC; X, Y, Width, Height: Integer;
Из rasterimage.inc
Код: Выделить всё
procedure TRasterImage.Draw(DestCanvas: TCanvas; const DestRect: TRect);
.....
StretchMaskBlt(DestDC, // Ссылается на function TGtkWidgetSet.StretchMaskBlt( из gtkwinapi.inc, а затем StretchCopyArea(
....
Вызов идет из function TGtkWidgetSet.StretchMaskBlt(
и из function TGtkWidgetSet.StretchBlt(
Учти там параметры.
Короче StretchMaskBlt для каждого виджетсет реализуется своя, а ключи условной компиляции в rasterimage.inc не действуют.
И еще, я не понял зачем заливать один пиксел :
Код: Выделить всё
...
SrcBmp.SetSize(RWidth,RHeight);
SrcBmp.Canvas.FillRect(0,0,1,1); // ?????? Может нужно всю площадь канвы очистить, тогда и шума не будет в старой версии Лазаруса?
...
Переписал под виджет, правда основную тоже пришлось затронуть, дополнительно маску передать, а то там ее достать никак....
function TGtkWidgetSet.StretchCopyArea в gtkwidgetset.inc
procedure TRasterImage.Draw в rasterimage.inc
Делалоcь на последнем lazarus и fpc с svn
function TGtkWidgetSet.StretchCopyArea в gtkwidgetset.inc
Код: Выделить всё
function TGtkWidgetSet.StretchCopyArea(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer;
Mask: HBITMAP; XMask, YMask: Integer;
Rop: Cardinal): Boolean;
var
SrcDevContext: TGtkDeviceContext absolute SrcDC;
DstDevContext: TGtkDeviceContext absolute DestDC;
TempPixmap: PGdkPixmap;
TempMaskBitmap: PGdkBitmap;
SizeChange, ROpIsSpecial: Boolean;
FlipHorz, FlipVert: Boolean;
function ScaleAndROP(DestGC: PGDKGC;
Src: PGDKDrawable; SrcPixmap: PGdkDrawable; SrcMaskBitmap: PGdkBitmap): Boolean;
var
Depth: Integer;
ScaleMethod: TGdkInterpType;
ShrinkWidth, ShrinkHeight: Boolean;
GC: PGDKGC;
begin
{$IFDEF VerboseStretchCopyArea}
DebugLn('ScaleAndROP START DestGC=',DbgS(DestGC),
' SrcPixmap=',DbgS(SrcPixmap),
' SrcMaskPixmap=',DbgS(SrcMaskPixmap));
{$ENDIF}
Result := False;
if DestGC = nil
then begin
DebugLn('WARNING: [TGtkWidgetSet.StretchCopyArea] Uninitialized DestGC');
exit;
end;
// create a temporary graphic context for the scale and raster operations
// copy the destination GC values into the temporary GC
GC := gdk_gc_new(DstDevContext.Drawable);
gdk_gc_copy(GC, DestGC);
// clear any previous clipping in the temporary GC
gdk_gc_set_clip_region(GC, nil);
gdk_gc_set_clip_rectangle(GC, nil);
if SizeChange
then begin
{$IFDEF VerboseStretchCopyArea}
Depth:=gdk_visual_get_system^.Depth;
DebugLn('ScaleAndROP Scaling buffer: '+dbgs(Width),' x '+dbgs(Height),' x '+dbgs(Depth));
{$ENDIF}
// calculate ScaleMethod
{$IFDEF VerboseGtkToDos}{$note use SetStretchBltMode(dc, mode) here}{$ENDIF}
//GDKPixbuf Scaling is not done in the same way as Windows
//but by rights ScaleMethod should really be chosen based
//on the destination device's internal flag
{GDK_INTERP_NEAREST,GDK_INTERP_TILES,
GDK_INTERP_BILINEAR,GDK_INTERP_HYPER);}
ShrinkWidth := Width < SrcWidth;
ShrinkHeight := Height < SrcHeight;
if ShrinkWidth and ShrinkHeight
then ScaleMethod := GDK_INTERP_TILES
else
if ShrinkWidth or ShrinkHeight
then ScaleMethod := GDK_INTERP_BILINEAR//GDK_INTERP_HYPER
else ScaleMethod := GDK_INTERP_BILINEAR;
// Scale the src part to a temporary pixmap with the size of the
// destination rectangle
Result := ScalePixmapAndMask(GC, ScaleMethod,
SrcPixmap, XSrc, YSrc, SrcWidth, SrcHeight,
nil, SrcMaskBitmap,
Width, Height, FlipHorz, FlipVert, TempPixmap, TempMaskBitmap);
if not Result
then DebugLn('WARNING: ScaleAndROP ScalePixmap for pixmap failed');
end
else begin
if ROpIsSpecial
then begin
// no scaling, but special ROp
Depth:=gdk_visual_get_system^.Depth;
{$IFDEF VerboseStretchCopyArea}
DebugLn('ScaleAndROP Creating rop buffer: '+dbgs(Width),' x '+dbgs(Height),' x '+dbgs(Depth));
{$ENDIF}
TempPixmap := gdk_pixmap_new(nil,SrcWidth,SrcHeight,Depth);
gdk_window_copy_area(TempPixmap, GC, 0, 0,
Src, XSrc, YSrc, SrcWidth, SrcHeight);
end;
Result := True;
end;
// set raster operation in the destination GC
if Result
then SetGCRasterOperation(DestGC, ROP);
gdk_gc_unref(GC);
end;
procedure ROPFillBuffer(DC : hDC);
var
OldCurrentBrush: PGdiObject;
Brush : hBrush;
begin
if TempPixmap = nil then exit;
if not ((ROp=WHITENESS) or (ROp=BLACKNESS) or (ROp=DSTINVERT)) then Exit;
{$IFDEF VerboseStretchCopyArea}
DebugLn('ROPFillBuffer ROp='+dbgs(ROp));
{$ENDIF}
with TGtkDeviceContext(DC) do
begin
// Temporarily hold the old brush to
// replace it with the given brush
OldCurrentBrush := CurrentBrush;
if ROP = WHITENESS
then
Brush := GetStockObject(WHITE_BRUSH)
else
Brush := GetStockObject(BLACK_BRUSH);
CurrentBrush := PGdiObject(Brush);
SelectedColors := dcscBrush;
if not IsNullBrush
then begin
gdk_draw_rectangle(TempPixmap, GC, 1, 0, 0, Width, Height);
end;
// Restore current brush
CurrentBrush := OldCurrentBrush;
end;
end;
function SrcDevBitmapToDrawable: Boolean;
var
SrcDrawable: PGdkDrawable;
MskBitmap: PGdkBitmap;
ClipMask: PGdkBitmap;
SrcGDIBitmap: PGdiObject;
begin
Result:=true;
{$IFDEF VerboseStretchCopyArea}
DebugLn('SrcDevBitmapToDrawable Start');
{$ENDIF}
SrcGDIBitmap := SrcDevContext.CurrentBitmap;
if SrcGDIBitmap = nil
then begin
SrcDrawable := SrcDevContext.Drawable;
MskBitmap := nil;
if SrcDrawable = nil then
begin
DebugLn('SrcDevBitmapToDrawable NOTE: SrcDevContext.CurrentBitmap=nil, SrcDevContext.Drawable = nil');
exit;
end;
end
else begin
SrcDrawable := SrcGDIBitmap^.GDIPixmapObject.Image;
MskBitmap := CreateGdkMaskBitmap(HBITMAP(PtrUInt(SrcGDIBitmap)), Mask);
end;
{$IFDEF VerboseStretchCopyArea}
DebugLn('SrcDevBitmapToDrawable SrcPixmap=[',GetWindowDebugReport(SrcPixmap),']',
' MaskPixmap=[',GetWindowDebugReport(MaskPixmap),']');
{$ENDIF}
if (MskBitmap = nil) and (not SizeChange) and (ROP=SRCCOPY)
then begin
// simply copy the area
{$IFDEF VerboseStretchCopyArea}
DebugLn('SrcDevBitmapToDrawable Simple copy');
{$ENDIF}
gdk_gc_set_function(DstDevContext.GC, GDK_COPY);
gdk_window_copy_area(DstDevContext.Drawable, DstDevContext.GC, X, Y,
SrcDrawable, XSrc, YSrc, Width, Height);
gdk_gc_set_function(DstDevContext.GC, DstDevContext.GetFunction);
Exit;
end;
// perform raster operation and scaling into Scale and fGC
DstDevContext.SelectedColors := dcscCustom;
if not ScaleAndROP(DstDevContext.GC, SrcDevContext.Drawable, SrcDrawable, MskBitmap)
then begin
DebugLn('WARNING: SrcDevBitmapToDrawable: ScaleAndROP failed');
Exit;
end;
{$IFDEF VerboseStretchCopyArea}
DebugLn('SrcDevBitmapToDrawable TempPixmap=',DbgS(TempPixmap),' TempMaskPixmap=',DbgS(TempMaskBitmap));
{$ENDIF}
if TempPixmap <> nil
then begin
SrcDrawable := TempPixmap;
XSrc := 0;
YSrc := 0;
SrcWidth := Width;
SrcHeight := Height;
end;
if TempMaskBitmap <> nil
then begin
MskBitmap := TempMaskBitmap;
XMask := 0;
YMask := 0;
end;
case ROP of
WHITENESS, BLACKNESS :
ROPFillBuffer(DestDC);
end;
{$IFDEF VerboseStretchCopyArea}
DebugLn('SrcDevBitmapToDrawable ',
' SrcPixmap=',DbgS(SrcPixmap),
' XSrc='+dbgs(XSrc),' YSrc='+dbgs(YSrc),' SrcWidth='+dbgs(SrcWidth),' SrcHeight='+dbgs(SrcHeight),
' MaskPixmap=',DbgS(MaskPixmap),
' XMask='+dbgs(XMask),' YMask='+dbgs(YMask),
'');
{$ENDIF}
// set clipping mask for transparency
MergeClipping(DstDevContext, DstDevContext.GC, X, Y, Width, Height,
MskBitmap, XMask, YMask, ClipMask);
// draw image
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
gdk_window_copy_area(DstDevContext.Drawable, DstDevContext.GC, X, Y,
SrcDrawable, XSrc, YSrc, SrcWidth, SrcHeight);
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
// unset clipping mask for transparency
DstDevContext.ResetGCClipping;
if ClipMask <> nil
then gdk_bitmap_unref(ClipMask);
// restore raster operation to SRCCOPY
gdk_gc_set_function(DstDevContext.GC, GDK_Copy);
Result:=True;
end;
function DrawableToDrawable: Boolean;
begin
{$IFDEF VerboseStretchCopyArea}
DebugLn('DrawableToDrawable Start');
{$ENDIF}
Result:=SrcDevBitmapToDrawable;
end;
function PixmapToDrawable: Boolean;
begin
{$IFDEF VerboseStretchCopyArea}
DebugLn('PixmapToDrawable Start');
{$ENDIF}
Result:=SrcDevBitmapToDrawable;
end;
function PixmapToBitmap: Boolean;
begin
DebugLn('WARNING: [TGtkWidgetSet.StretchCopyArea] PixmapToBitmap unimplemented!');
Result:=false;
end;
function BitmapToPixmap: Boolean;
begin
DebugLn('WARNING: [TGtkWidgetSet.StretchCopyArea] BitmapToPixmap unimplemented!');
Result:=false;
end;
function Unsupported: Boolean;
begin
DebugLn('WARNING: [TGtkWidgetSet.StretchCopyArea] Destination and/or Source unsupported!!');
Result:=false;
end;
//----------
function NoDrawableToNoDrawable: Boolean;
begin
Result := Unsupported;
if SrcDevContext.CurrentBitmap = nil then Exit;
if DstDevContext.CurrentBitmap = nil then Exit;
case SrcDevContext.CurrentBitmap^.GDIBitmapType of
gbBitmap:
case DstDevContext.CurrentBitmap^.GDIBitmapType of
gbBitmap: Result:=DrawableToDrawable;
gbPixmap: Result:=BitmapToPixmap;
end;
gbPixmap:
case DstDevContext.CurrentBitmap^.GDIBitmapType of
gbBitmap: Result:=PixmapToBitmap;
gbPixmap: Result:=DrawableToDrawable;
end;
end;
end;
function NoDrawableToDrawable: Boolean;
begin
Result := Unsupported;
if SrcDevContext.CurrentBitmap = nil then Exit;
case SrcDevContext.CurrentBitmap^.GDIBitmapType of
gbBitmap: Result:=PixmapToDrawable;
gbPixmap: Result:=PixmapToDrawable;
end;
end;
function DrawableToNoDrawable: Boolean;
begin
Result := Unsupported;
if DstDevContext.CurrentBitmap = nil then Exit;
case DstDevContext.CurrentBitmap^.GDIBitmapType of
gbBitmap: Result:=Unsupported;
gbPixmap: Result:=Unsupported;
end;
end;
procedure RaiseSrcDrawableNil;
begin
DebugLn(['RaiseSrcDrawableNil ',GetWidgetDebugReport(SrcDevContext.Widget)]);
RaiseGDBException(Format('TGtkWidgetSet.StretchCopyArea SrcDC=%p Drawable=nil', [Pointer(SrcDevContext)]));
end;
procedure RaiseDestDrawableNil;
begin
RaiseGDBException(Format('TGtkWidgetSet.StretchCopyArea DestDC=%p Drawable=nil', [Pointer(DstDevContext)]));
end;
var
NewSrcWidth: Integer;
NewSrcHeight: Integer;
NewWidth: Integer;
NewHeight: Integer;
SrcDCOrigin: TPoint;
DstDCOrigin: TPoint;
SrcWholeWidth, SrcWholeHeight: integer;
DstWholeWidth, DstWholeHeight: integer;
ix, iy, SrcPos, DstPos, iyStartByte, dstiyStartByte:integer;
srcdata, dstdata, maskdata: PByteArray;
srccolors, dstcolors: PIntegerArray;
DstBmp:TRawImage;
SrcBmp:TRawImage;
MaskBmp:TRawImage;
ResBMPData: array of integer;
tmpdc:HDC;
bmp, old: HBitmap;
msk: HBitmap;
StartX, FinishX:Integer;
StartY, FinishY:Integer;
DP, SP:integer;
SrcWidthPR,SrcHeightPR:single;
SrcPR, DstPR:byte;
RShift, GShift, BShift, AShift, DstRShift, DstGShift, DstBShift:Integer;
begin
if (Width=0) or (Height=0)
then Exit;
if Mask <> 0 then
begin
WidgetSet.RawImage_FromDevice(SrcBmp,SrcDC,rect(0,0,SrcWidth,SrcHeight));
if (SrcBmp.Description.Format = ricfRGBA) and (SrcBmp.Description.BitsPerPixel = 32) then
begin
WidgetSet.RawImage_FromDevice(DstBmp,DestDC,rect(x,y,x+Width,y+height));
WidgetSet.RawImage_FromBitmap(MaskBmp,Mask,0);
try
srcdata:=PByteArray(SrcBmp.Data);
dstdata:=PByteArray(DstBmp.Data);
maskdata:=PByteArray(MaskBmp.Data);
RShift:=SrcBmp.Description.RedShift div 8;
GShift:=SrcBmp.Description.GreenShift div 8;
BShift:=SrcBmp.Description.BlueShift div 8;
AShift:=SrcBmp.Description.AlphaShift div 8;
DstRShift:=DstBmp.Description.RedShift div 8;
DstGShift:=DstBmp.Description.GreenShift div 8;
DstBShift:=DstBmp.Description.BlueShift div 8;
StartY:=max(0,height-DstBmp.Description.Height);
StartX:=max(0,width-DstBmp.Description.width);
FinishY:=min(Height,DstBmp.Description.Height);
FinishX:=min(Width,DstBmp.Description.Width);
if (SrcHeight = Height)and(SrcWidth = Width) then
begin
for iy := 0 to FinishY-1 do
begin
iyStartByte := (iy+starty)*srcBmp.Description.Width;
dstiyStartByte := iy*dstBmp.Description.Width;
for ix := 0 to FinishX-1 do
begin
DP :=((ix+dstiyStartByte)*4);
SP :=(((ix+StartX)+iyStartByte)*4);
SrcPR:=maskdata^[SP];
DstPR:=255-SrcPR;
dstdata^[DP+RShift]:=((srcdata^[SP+RShift]*SrcPR)+(dstdata^[DP+RShift]*DstPR)) div 255;
dstdata^[DP+GShift]:=((srcdata^[SP+GShift]*SrcPR)+(dstdata^[DP+GShift]*DstPR)) div 255;
dstdata^[DP+BShift]:=((srcdata^[SP+BShift]*SrcPR)+(dstdata^[DP+BShift]*DstPR)) div 255;
end;
end;
end else
begin
SrcWidthPR:=SrcWidth/Width;
SrcHeightPR:=SrcHeight/Height;
for iy := 0 to FinishY-1 do
begin
iyStartByte := trunc((iy+starty)*SrcHeightPR)*srcBmp.Description.Width;
dstiyStartByte := iy*dstBmp.Description.Width;
for ix := 0 to FinishX-1 do
begin
DP :=((ix+dstiyStartByte)*4);
SP :=((trunc((ix+StartX)*SrcWidthPR)+iyStartByte)*4);
SrcPR:=maskdata^[SP];
DstPR:=255-SrcPR;
dstdata^[DP+RShift]:=((srcdata^[SP+RShift]*SrcPR)+(dstdata^[DP+RShift]*DstPR))div 255;
dstdata^[DP+GShift]:=((srcdata^[SP+GShift]*SrcPR)+(dstdata^[DP+GShift]*DstPR))div 255;
dstdata^[DP+BShift]:=((srcdata^[SP+BShift]*SrcPR)+(dstdata^[DP+BShift]*DstPR))div 255;
end;
end;
end;
WidgetSet.RawImage_CreateBitmaps(dstBmp, bmp, msk, false);
tmpDC := CreateCompatibleDC(DestDC);
old := SelectObject(tmpDC, bmp);
StretchMaskBlt(DestDC, x+StartX, y+StartY, DstBmp.Description.Width, DstBmp.Description.Height, TmpDC, 0, 0, DstBmp.Description.Width, DstBmp.Description.Height,
0, XMask, YMask, Rop);
finally
DeleteObject(SelectObject(tmpDC, old));
DeleteObject(msk);
DeleteDC(tmpDC);
DstBmp.FreeData;
SrcBmp.FreeData;
MaskBmp.FreeData;
end;
end;
end else
begin
Result := IsValidDC(DestDC) and IsValidDC(SrcDC);
{$IFDEF VerboseStretchCopyArea}
DebugLn('StretchCopyArea Start '+dbgs(Result));
{$ENDIF}
if not Result then Exit;
FlipHorz := Width < 0;
if FlipHorz then
begin
Width := -Width;
X := X - Width;
end;
FlipVert := Height < 0;
if FlipVert then
begin
Height := -Height;
Y := Y - Height;
end;
if (Width = 0) or (Height = 0) then exit;
if (SrcWidth = 0) or (SrcHeight = 0) then exit;
SizeChange := (Width <> SrcWidth) or (Height <> SrcHeight) or FlipVert or FlipHorz;
ROpIsSpecial := (Rop <> SRCCOPY);
SrcDCOrigin := SrcDevContext.Offset;
Inc(XSrc, SrcDCOrigin.X);
Inc(YSrc, SrcDCOrigin.Y);
if SrcDevContext.Drawable = nil then RaiseSrcDrawableNil;
gdk_window_get_size(PGdkWindow(SrcDevContext.Drawable), @SrcWholeWidth, @SrcWholeHeight);
DstDCOrigin := DstDevContext.Offset;
Inc(X, DstDCOrigin.X);
Inc(Y, DstDCOrigin.Y);
if DstDevContext.Drawable = nil then RaiseDestDrawableNil;
gdk_window_get_size(PGdkWindow(DstDevContext.Drawable), @DstWholeWidth, @DstWholeHeight);
{$IFDEF VerboseStretchCopyArea}
DebugLn('TGtkWidgetSet.StretchCopyArea BEFORE CLIPPING X='+dbgs(X),' Y='+dbgs(Y),' Width='+dbgs(Width),' Height='+dbgs(Height),
' XSrc='+dbgs(XSrc)+' YSrc='+dbgs(YSrc)+' SrcWidth='+dbgs(SrcWidth)+' SrcHeight='+dbgs(SrcHeight),
' SrcDrawable=',DbgS(TGtkDeviceContext(SrcDC).Drawable),
' SrcOrigin='+dbgs(SrcDCOrigin),
' DestDrawable='+DbgS(TGtkDeviceContext(DestDC).Drawable),
' DestOrigin='+dbgs(DestDCOrigin),
' Mask='+DbgS(Mask)+' XMask='+dbgs(XMask)+' YMask='+dbgs(YMask),
' SizeChange='+dbgs(SizeChange)+' ROpIsSpecial='+dbgs(ROpIsSpecial),
' DestWhole='+dbgs(DestWholeWidth)+','+dbgs(DestWholeHeight),
' SrcWhole='+dbgs(SrcWholeWidth)+','+dbgs(SrcWholeHeight),
'');
{$ENDIF}
{$IFDEF VerboseGtkToDos}{$note use intersectrect here}{$ENDIF}
if X >= DstWholeWidth then Exit;
if Y >= DstWholeHeight then exit;
if X + Width <= 0 then exit;
if Y + Height <=0 then exit;
if XSrc >= SrcWholeWidth then Exit;
if YSrc >= SrcWholeHeight then exit;
if XSrc + SrcWidth <= 0 then exit;
if YSrc + SrcHeight <=0 then exit;
// gdk does not allow copying areas, party laying out of bounds
// -> clip
// clip src to the left
if (XSrc<0) then begin
NewSrcWidth:=SrcWidth+XSrc;
NewWidth:=((Width*NewSrcWidth) div SrcWidth);
{$IFDEF VerboseStretchCopyArea}
DebugLn('StretchCopyArea Cliping Src to left NewSrcWidth='+dbgs(NewSrcWidth),' NewWidth='+dbgs(NewWidth));
{$ENDIF}
if NewWidth = 0 then exit;
inc(X, Width-NewWidth);
if X >= DstWholeWidth then exit;
XSrc:=0;
SrcWidth := NewSrcWidth;
end;
// clip src to the top
if (YSrc<0) then begin
NewSrcHeight:=SrcHeight+YSrc;
NewHeight:=((Height*NewSrcHeight) div SrcHeight);
{$IFDEF VerboseStretchCopyArea}
DebugLn('StretchCopyArea Cliping Src to top NewSrcHeight='+dbgs(NewSrcHeight),' NewHeight='+dbgs(NewHeight));
{$ENDIF}
if NewHeight = 0 then exit;
inc(Y, Height - NewHeight);
if Y >= DstWholeHeight then exit;
YSrc:=0;
SrcHeight := NewSrcHeight;
end;
// clip src to the right
if (XSrc+SrcWidth>SrcWholeWidth) then begin
NewSrcWidth:=SrcWholeWidth-XSrc;
Width:=((Width*NewSrcWidth) div SrcWidth);
{$IFDEF VerboseStretchCopyArea}
DebugLn('StretchCopyArea Cliping Src to right NewSrcWidth='+dbgs(NewSrcWidth),' NewWidth='+dbgs(Width));
{$ENDIF}
if (Width=0) then exit;
if (X+Width<=0) then exit;
SrcWidth:=NewSrcWidth;
end;
// clip src to the bottom
if (YSrc+SrcHeight>SrcWholeHeight) then begin
NewSrcHeight:=SrcWholeHeight-YSrc;
Height:=((Height*NewSrcHeight) div SrcHeight);
{$IFDEF VerboseStretchCopyArea}
DebugLn('StretchCopyArea Cliping Src to bottom NewSrcHeight='+dbgs(NewSrcHeight),' NewHeight='+dbgs(Height));
{$ENDIF}
if (Height=0) then exit;
if (Y+Height<=0) then exit;
SrcHeight:=NewSrcHeight;
end;
if Mask = 0
then begin
XMask := XSrc;
YMask := YSrc;
end;
// mark temporary scaling/rop buffers as uninitialized
TempPixmap := nil;
TempMaskBitmap := nil;
{$IFDEF VerboseStretchCopyArea}
write('TGtkWidgetSet.StretchCopyArea AFTER CLIPPING X='+dbgs(X)+' Y='+dbgs(Y)+' Width='+dbgs(Width)+' Height='+dbgs(Height),
' XSrc='+dbgs(XSrc),' YSrc='+dbgs(YSrc)+' SrcWidth='+dbgs(SrcWidth)+' SrcHeight='+dbgs(SrcHeight),
' SrcDrawable='+DbgS(SrcDevContext.Drawable),
' DestDrawable='+DbgS(DstDevContext.Drawable),
' Mask='+DbgS(Mask)+' XMask='+dbgs(XMask)+' YMask='+dbgs(YMask),
' SizeChange='+dbgs(SizeChange)+' ROpIsSpecial='+dbgs(ROpIsSpecial));
write(' ROp=');
case ROp of
SRCCOPY : DebugLn('SRCCOPY');
SRCPAINT : DebugLn('SRCPAINT');
SRCAND : DebugLn('SRCAND');
SRCINVERT : DebugLn('SRCINVERT');
SRCERASE : DebugLn('SRCERASE');
NOTSRCCOPY : DebugLn('NOTSRCCOPY');
NOTSRCERASE : DebugLn('NOTSRCERASE');
MERGECOPY : DebugLn('MERGECOPY');
MERGEPAINT : DebugLn('MERGEPAINT');
PATCOPY : DebugLn('PATCOPY');
PATPAINT : DebugLn('PATPAINT');
PATINVERT : DebugLn('PATINVERT');
DSTINVERT : DebugLn('DSTINVERT');
BLACKNESS : DebugLn('BLACKNESS');
WHITENESS : DebugLn('WHITENESS');
else
DebugLn('???');
end;
{$ENDIF}
{$IFDEF VerboseGtkToDos}{$note tode remove, earlier checks require drawable <> nil}{$ENDIF}
if SrcDevContext.Drawable = nil
then begin
if DstDevContext.Drawable = nil
then
Result := NoDrawableToNoDrawable
else
Result := NoDrawableToDrawable;
end
else begin
if DstDevContext.Drawable = nil
then
Result := DrawableToNoDrawable
else
Result := DrawableToDrawable;
end;
if TempPixmap <> nil
then gdk_pixmap_unref(TempPixmap);
if TempMaskBitmap <> nil
then gdk_pixmap_unref(TempMaskBitmap);
end;
end;
procedure TRasterImage.Draw в rasterimage.inc
Код: Выделить всё
procedure TRasterImage.Draw(DestCanvas: TCanvas; const DestRect: TRect);
var
UseMaskHandle, Maskbuf: HBitmap;
MaskBMP: TRawImage;
BuferedMask: boolean;
SrcData, MaskData: PByteArray;
i, AShift: integer;
SrcDC: hDC;
DestDC: hDC;
begin
if (Width=0) or (Height=0)
then Exit;
BitmapHandleNeeded;
if not BitmapHandleAllocated then Exit;
BuferedMask := false;
if Masked then
UseMaskHandle:=MaskHandle
else
if (PixelFormat = pf32bit)and(RawImage.Description.BitsPerPixel = 32) then
begin
WidgetSet.RawImage_FromBitmap(MaskBMP,BitmapHandle,MaskHandle);
SrcData:=PByteArray(RawImage.Data);
MaskData:=PByteArray(MaskBMP.Data);
AShift:=RawImage.Description.AlphaShift div 8;
for i := 0 to (Width*Height)-1 do
MaskData^[i*4] := SrcData^[(i*4)+AShift];
WidgetSet.RawImage_CreateBitmaps(MaskBMP,UseMaskHandle,Maskbuf);
MaskBMP.FreeData;
DeleteObject(Maskbuf);
BuferedMask := true;
end else UseMaskHandle:=0;
SrcDC := Canvas.GetUpdatedHandle([csHandleValid]);
DestCanvas.Changing;
DestDC := DestCanvas.GetUpdatedHandle([csHandleValid]);
StretchMaskBlt(DestDC,
DestRect.Left,DestRect.Top,
DestRect.Right-DestRect.Left,DestRect.Bottom-DestRect.Top,
SrcDC,0,0,Width,Height, UseMaskHandle,0,0,DestCanvas.CopyMode);
DestCanvas.Changed;
if BuferedMask then DeleteObject(UseMaskHandle);
end; Делалоcь на последнем lazarus и fpc с svn
