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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 09.02.2015, 22:53   #1
Alexandr17
Форумчанин
 
Регистрация: 10.12.2013
Сообщений: 227
По умолчанию Отрисовка несколько пнг с прозрачность на 1 image delphi 7

Как отрисовать несколько пнг картинок на image используя TPngObject
Пробовал так
Код:
procedure TfrmRCE.RePayntImgMapDoms;
begin
  lblDisplayRegions0.Transparent:=True;
  lblDisplayRegions0.Canvas.Draw(0, 0, MaskPngRegions);
end;
но отрисовывает без прозрачности. Как отрисовать с прозрачностью.
Alexandr17 вне форума Ответить с цитированием
Старый 09.02.2015, 23:19   #2
WinCoder
Заблокирован
 
Регистрация: 24.11.2014
Сообщений: 721
По умолчанию

Ну на. Развлекайся. Только не говори что не понятно.
http://desksoft.ru/index.php?forum=13&th=269
WinCoder вне форума Ответить с цитированием
Старый 10.02.2015, 08:44   #3
phomm
personality
Старожил
 
Аватар для phomm
 
Регистрация: 28.04.2009
Сообщений: 2,882
По умолчанию

Советую изучить сию тему http://programmersforum.ru/showthread.php?t=251149
phomm вне форума Ответить с цитированием
Старый 10.02.2015, 18:47   #4
Alexandr17
Форумчанин
 
Регистрация: 10.12.2013
Сообщений: 227
По умолчанию

Делал по этому примеру
http://programmersforum.ru/attachmen...0&d=1389455324
Итог:

1 Изображение:

2 картинка отображается без проблем а вот 1 черти что отображает.
Вот исходник 1 картинки
https://yadi.sk/d/UV-EX8j8earC2
Alexandr17 вне форума Ответить с цитированием
Старый 10.02.2015, 18:49   #5
WinCoder
Заблокирован
 
Регистрация: 24.11.2014
Сообщений: 721
По умолчанию

А надо было по моему. В том примере решались проблемы с отсутствием альфа канала. У Вас имеются такие проблемы?
WinCoder вне форума Ответить с цитированием
Старый 10.02.2015, 18:55   #6
Alexandr17
Форумчанин
 
Регистрация: 10.12.2013
Сообщений: 227
По умолчанию

Не знаю 2 же картинка выводится нормально а конвертторгба я применял как и для 1 так и для 2 картинки.
У тебя идет конвертация из Png в BMP
Я уже пробывал dsdjlbnm bmp с прозрачностью на основе этого примера.
http://www.delphisources.ru/pages/fa...nt_bitmap.html
Черти что получалось
И кстати даже если не использовать эту процедуру
Код:
procedure ConvertToRGBA(var png: TPNG);
var
  tmp: TPNG;
  tRNS: TChunktRNS;
  PLTE: TChunkPLTE;
  dst: pRGBLine;
  src, alpha: pByteArray;
  x,y: integer;
  i: byte;
begin
  tmp:=TPNG.CreateBlank(COLOR_RGBALPHA, 8, png.Width, png.Height);
  case png.Header.ColorType of
    COLOR_PALETTE:
    begin
      tRNS:=png.Chunks.ItemFromClass(TChunktRNS) as TChunktRNS;
      PLTE:=png.Chunks.ItemFromClass(TChunkPLTE) as TChunkPLTE;
      for y:=0 to png.Height-1 do begin
        dst:=tmp.Scanline[y];
        src:=png.Scanline[y];
        alpha:=tmp.AlphaScanline[y];
        for x:=0 to png.Width-1 do begin
          case png.Header.BitDepth of
            8: i:=src[x];
            2,4: i:=src[x div 2] shr ((1-(x mod 2))*4) and $0F;
            1: i:=src[x div 8] shr (7-(x mod 8)) and 1;
          end;
          dst[x].rgbtBlue:=PLTE.Item[i].rgbBlue;
          dst[x].rgbtGreen:=PLTE.Item[i].rgbGreen;
          dst[x].rgbtRed:=PLTE.Item[i].rgbRed;
          if tRNS<>nil then alpha[x]:=tRNS.PaletteValues[i] else alpha[x]:=255;

        end;
      end;
    end;

    COLOR_RGB, COLOR_GRAYSCALE:
    begin
      BitBlt(tmp.Canvas.Handle, 0,0, tmp.Width,tmp.Height, png.Canvas.Handle, 0,0, SRCCOPY);
      for y:=0 to png.Height-1 do
        FillChar(tmp.AlphaScanline[y]^, png.Width, 255);
    end;

    COLOR_GRAYSCALEALPHA:
    begin
      BitBlt(tmp.Canvas.Handle, 0,0, tmp.Width,tmp.Height, png.Canvas.Handle, 0,0, SRCCOPY);
      for y:=0 to png.Height-1 do begin
        src:=png.AlphaScanline[y];
        alpha:=tmp.AlphaScanline[y];
        Move(src^, alpha^, png.Width);
      end;
    end;

    else tmp.Assign(png);
  end;
  png.Free;
  png:=tmp;
end;
а использовать только эту
Код:
procedure OverlapPNG(Layer1, Layer2: TPNG; AX, AY: Integer);
const
  defrgb: TRGBTriple = (rgbtBlue: 0; rgbtGreen: 0; rgbtRed: 0);
var
  x, y, wd, hg, sx1, sx2, sy1, sy2, fx1, fx2, fy1, fy2: Integer;
  SL1, SL2, SLBlended: pRGBLine;
  aSL1, aSL2, aSLBlended: PByteArray;
  bc1, bc2, bc3, a1, a2: single;
  aSL1x, aSL2x: Byte;
  L1rgb, L2rgb: TRGBTriple;
  blendedPNG: TPNG;
begin
  wd := Abs(Min(0, Ax)) + Max(Layer1.Width, Ax + Layer2.Width);
  hg := Abs(Min(0, Ay)) + Max(Layer1.Height, Ay + Layer2.Height);
  blendedPNG := TPNG.CreateBlank(COLOR_RGBALPHA, 8, wd, hg);
  sx1 := Abs(Min(0, AX));
  sy1 := Abs(Min(0, AY));
  sx2 := Max(0, AX);
  sy2 := Max(0, AY);
  fx1 := sx1 + Layer1.Width;
  fy1 := sy1 + Layer1.Height;
  fx2 := sx2 + Layer2.Width;
  fy2 := sy2 + Layer2.Height;

  for y := 0 to hg - 1 do
  begin
    SL1 := nil;
    aSL1 := nil;
    SL2 := nil;
    aSL2 := nil;
    if (y >= sy1) and (y < fy1) then
      SL1 := Layer1.Scanline[y - sy1];
    if (y >= sy1) and (y < fy1) then
      aSL1 := Layer1.AlphaScanline[y - sy1];
    if (y >= sy2) and (y < fy2) then
      SL2 := Layer2.Scanline[y - sy2];
    if (y >= sy2) and (y < fy2) then
      aSL2 := Layer2.AlphaScanline[y - sy2];
    SLBlended := blendedPNG.Scanline[y];
    aSLBlended := blendedPNG.AlphaScanline[y];

    for x := 0 to wd - 1 do
    begin
      aSL1x := 0;
      aSL2x := 0;
      L1rgb := defrgb;
      L2rgb := defrgb;
      if Assigned(aSL1) and (x >= sx1) and (x < fx1) then
        aSL1x := aSL1[x - sx1];
      if Assigned(aSL2) and (x >= sx2) and (x < fx2) then
        aSL2x := aSL2[x - sx2];
      if (aSL1x = 0) and (aSL2x = 0) then
        Continue;
      if Assigned(SL1) and (x >= sx1) and (x < fx1) then
        L1rgb := SL1[x - sx1];
      if Assigned(SL2) and (x >= sx2) and (x < fx2) then
        L2rgb := SL2[x - sx2];
      // Porter-Duff Alpha-Blending Formulas
      a1 := aSL1x / 255;
      a2 := aSL2x / 255;
      bc3 := 1 - (1 - a2) * (1 - a1);
      aSLBlended[x] := Round(bc3 * 255);
      bc2 := a1 * (1 - a2);
      SLBlended[x].rgbtRed := Round((L2rgb.rgbtRed * a2 + L1rgb.rgbtRed * bc2) / bc3);
      SLBlended[x].rgbtGreen := Round((L2rgb.rgbtGreen * a2 + L1rgb.rgbtGreen * bc2) / bc3);
      SLBlended[x].rgbtBlue := Round((L2rgb.rgbtBlue * a2 + L1rgb.rgbtBlue * bc2) / bc3);
    end;
  end;
  Layer1.Assign(blendedPNG);
  blendedPNG.Free;
end;
то тоже самоя чертовщина с 1 картинкой.
Со всеми последующими все нормально.

Последний раз редактировалось Alexandr17; 10.02.2015 в 19:15.
Alexandr17 вне форума Ответить с цитированием
Старый 10.02.2015, 19:13   #7
WinCoder
Заблокирован
 
Регистрация: 24.11.2014
Сообщений: 721
По умолчанию

Цитата:
У тебя идет конвертация из Png в BMP
Не у меня. Не я писал этот код. Да идёт, и что? Там так же идёт обратный конверт. Код рабочий 100%. Проверялось.
WinCoder вне форума Ответить с цитированием
Старый 10.02.2015, 21:12   #8
Alexandr17
Форумчанин
 
Регистрация: 10.12.2013
Сообщений: 227
По умолчанию

Другой способ должен быть. Тем более мне кажется что проблема с моей картинкой. Попробуй этот код применить на мою картинку вот она:
https://yadi.sk/d/UV-EX8j8earC2
А вообще мнебы не хотелось использовать дополнительный битмап темболее что картинок пнг 61 штука но отрисовка будет идти лишь 11
Ту что я сбросил является задним фоном или маской. Остальные 10 частицы карты. Если их наложить друг на друга то получится целая карта. Но без маски будет не очень красиво выглядить.
Собственно я делаю редактор для думаю известной сегавской игры DuneHack
1 версия работала создавая 11 штук имаджей. В этой версии хочу задействовать отрисовку дабы сыкономить ресурсы.

Цитата:
Сообщение от WinCoder Посмотреть сообщение
Не у меня. Не я писал этот код. Да идёт, и что? Там так же идёт обратный конверт. Код рабочий 100%. Проверялось.
Возникает ошибка



Ошибка возникает на этой строке
if(Bout.Width<B_in.Width+x) then Bout.Width:=B_in.Width+x;

Последний раз редактировалось Stilet; 12.02.2015 в 10:52.
Alexandr17 вне форума Ответить с цитированием
Старый 11.02.2015, 17:23   #9
WinCoder
Заблокирован
 
Регистрация: 24.11.2014
Сообщений: 721
По умолчанию

Включаем мозг и начинаем думать
Код:
var
TS: TStringList;
begin
TS.Add('1'); // ошибка в этой строке
Вопрос на засыпку. Ошибка В ЭТОЙ СТРОКЕ??? Если я выложу её на форум, мне укажут на ошибку в этой строке? ДУМАЕМ!!!
P.S. Вообще не вижу смысла в этой беседе. Код рабочий. Какой вывод напрашивается?

Последний раз редактировалось WinCoder; 11.02.2015 в 17:26.
WinCoder вне форума Ответить с цитированием
Старый 12.02.2015, 09:06   #10
phomm
personality
Старожил
 
Аватар для phomm
 
Регистрация: 28.04.2009
Сообщений: 2,882
По умолчанию

Проект с контентом прикладывайте (либо минимальный тестовый проект, где воспроизводится проблема), иначе смысла мало, телепатия ещё не прокачана.
phomm вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 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