Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 12.02.2015, 12:08   #11
Alexandr17
Форумчанин
 
Регистрация: 10.12.2013
Сообщений: 227
По умолчанию

Ошибку исправил но он выводит пустое белый фон а не картинку.
Alexandr17 вне форума Ответить с цитированием
Старый 12.02.2015, 12:15   #12
WinCoder
Заблокирован
 
Регистрация: 24.11.2014
Сообщений: 721
По умолчанию

Зачем ты ту пишешь, если не читаешь ответы? Что в предыдущем сообщении было написано? А что сделал ты?
WinCoder вне форума Ответить с цитированием
Старый 12.02.2015, 14:09   #13
Alexandr17
Форумчанин
 
Регистрация: 10.12.2013
Сообщений: 227
По умолчанию

Код функций обработки пнг
Код:
procedure BuildPNG2BMP(PNB:TPng; bmp:tbitmap);
var iii,ii:integer;
    fff:PRGBAArray; aaa:pByteArray;
begin
  pnb.CreateAlpha;
  bmp.Assign(pnb);
  bmp.PixelFormat:=pf32bit;
  for ii:=0 to bmp.Height-1 do begin
    fff:=bmp.ScanLine[ii];
    aaa:=pnb.AlphaScanline[ii];
    for iii:=0 to bmp.Width-1 do begin
      fff[iii].rgbReserved:=aaa[iii];
    end;
  end;
end;

procedure BuildBMP2PNG(bmp:Tbitmap; png:string);
var iii,ii:integer; PNB:TPng; fff:PRGBAArray; aaa:pByteArray;
begin
  PNB:=TPng.Create;
  try

    PNB.Assign(bmp);
    pnb.CreateAlpha;
    for ii:=0 to bmp.Height-1 do begin
        fff:=bmp.ScanLine[ii];
        aaa:=pnb.AlphaScanline[ii];
        for iii:=0 to bmp.Width-1 do begin
          aaa[iii]:=fff[iii].rgbReserved;
        end;
    end;

    PNB.SaveToFile(png);

  finally
    PNB.free;
  end;
end;

procedure Copy32to32_Bitmap(B_in:TBitmap; Bout:Tbitmap; x,y:integer);
var cy,cx:Integer;  
   RowOut,Row1,Row2,Row3,Row4: PRGBAArray;
begin
  if(Bout.Width<B_in.Width+x) then Bout.Width:=B_in.Width+x;
  if(Bout.Height<B_in.Height+y) then Bout.Height:=B_in.Height+y;
  for cy:=0 to B_in.Height-1 do begin
    Row1:=B_in.ScanLine[cy];
    RowOut:=Bout.ScanLine[cy+y];
    for cx:=0 to B_in.Width-1 do begin
       RowOut[cx+x]:=Row1[cx];
    end;
  end;
end;

procedure BlendBitmap_GDI(ACanvas: TCanvas; BT:Tbitmap; x,y:integer);
const
 MaxPixelCountA = MaxInt div SizeOf(TRGBQuad);
type
 PRGBAArray = ^TRGBAArray;
 TRGBAArray = array[0..MaxPixelCountA-1] of TRGBQuad;
var xTo,sx,YTo,ddx,ddy,sy,w,h,dstw,dsth: integer;
   bt_buff:Tbitmap; i,ii,itemp:integer; RSource,RDest:PRGBAArray; dd:double;
begin
 w:=BT.Width;
 h:=bt.Height;
 dstw:=ACanvas.ClipRect.Right-ACanvas.ClipRect.Left;
 dsth:=ACanvas.ClipRect.Bottom-ACanvas.ClipRect.Top;
 XTo:=x+W-1; YTo:=y+H-1;
 if (y>=dstH) or (x>=dstW) or (YTo<0) or (XTo<0) then exit;
 ddx:=0; ddy:=0;
 sx:=W; sy:=H;
 if X<0 then begin
     ddx:=-X;
     inc(sx,X);
     x:=0;
 end;
 if Y<0 then begin
     ddy:=-Y;
     inc(sy,Y);
     y:=0;
 end;
 if XTo>=dstw then dec(sx,XTo-dstw+1);
 if YTo>=dsth then dec(sy,YTo-dsth+1);
 if (sx<=0) or (sy<=0) then exit;
 if(BT.PixelFormat<>pf32bit) then exit;

 bt_buff:=Tbitmap.Create;
 try
   bt_buff.Width:=sx;
   bt_buff.Height:=sy;
   bt_buff.canvas.CopyRect( rect(0,0,bt_buff.Width,bt_buff.Height), ACanvas ,rect(x,y,x+sx,y+sy) );
   bt_buff.PixelFormat:=pf32bit;
   for i:=0 to sy-1 do begin
     RSource:=BT.ScanLine[i+ddy];
     RDest:=bt_buff.ScanLine[i];
     for ii:=0 to sx-1 do begin
       dd:=((100/255)/100)*RSource[ii+ddx].rgbReserved;

       itemp:=round(RDest[ii].rgbRed+(RSource[ii+ddx].rgbRed-RDest[ii].rgbRed)*dd);
       if itemp>255 then itemp:=255 else if itemp<0 then itemp:=0;
       RDest[ii].rgbRed:=itemp;

       itemp:=round(RDest[ii].rgbGreen+(RSource[ii+ddx].rgbGreen-RDest[ii].rgbGreen)*dd);
       if itemp>255 then itemp:=255 else if itemp<0 then itemp:=0;
       RDest[ii].rgbGreen:=itemp;

       itemp:=round(RDest[ii].rgbBlue+(RSource[ii+ddx].rgbBlue-RDest[ii].rgbBlue)*dd);
       if itemp>255 then itemp:=255 else if itemp<0 then itemp:=0;
       RDest[ii].rgbBlue:=itemp;
     end;
   end;
   ACanvas.CopyRect( rect(x,y,x+sx,y+sy), bt_buff.canvas ,rect(0,0,bt_buff.Width,bt_buff.Height) );
 finally
   bt_buff.Free;
 end;
end;
Вызов
Код:
BuildPNG2BMP( MaskPngRegions,bmp );
  Copy32to32_Bitmap(bmp,bmpout,0,0);
  BlendBitmap_GDI(lblDisplayRegions0.Canvas, bmpout, 0, 0);
Вместо какртинки выводится белый фон.
lblDisplayRegions0 - TImage
Alexandr17 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Плохая отрисовка Label [прозрачность] Orchestroman Общие вопросы Delphi 5 12.05.2012 23:47
Отрисовка Image на прозрачной форме werrey Общие вопросы Delphi 3 17.10.2011 10:28
Прозрачность Image Dominatorsha Помощь студентам 1 27.12.2010 13:45
Можно ли в компоненте Image, настроить прозрачность изображения? zmey31313 Компоненты Delphi 1 07.03.2010 16:47
Прозрачность для нескольких цветов в Image SERG1980 Общие вопросы Delphi 3 11.05.2007 19:53