Autor Téma: Nacteni TImageListu v run-time, aby mely .PNG obrazky pruhledne pozadi  (Přečteno 598 krát)

Offline pf1957

  • Padawan
  • ******
  • Příspěvků: 2297
  • Karma: 123
    • Verze Delphi: D2007, XE3, DX10
Ahoj vsichni,

mam tu podezrele chovani, tak se zeptam, jestli nekdo nevi, co je za problem:

1. Popis problemu
a. Kolega v ramci inovace aplikace nahradil pasky glyfu puvodne v .BMP za pasky .PNG
b. Graficka udelala nove pasky s pruhlednym pozadim - nacteno napr. do GIMPu - skutecne jsou pruhledne
c. pasky mame jako resource v .DLL napr.
Kód: Delphi [Vybrat]
  1. MAIN32  RCDATA "DATA\MAIN32.png"
d. Co jsem se dival, tak kolega pouzil pro nacteni techniku doporucovanou bezne na webu
Kód: Delphi [Vybrat]
  1.   PNG := TPngImage.Create;
  2.   try
  3.     png.LoadFromResourceNAme(hRes, ResName);
  4.     BMP := TBitmap.Create;
  5.     try
  6.       BMP.Assign(PNG);
  7.       IML.Clear;
  8.       IML.Height := BMP.Height;
  9.       if Count = 0 then
  10.         IML.Width := BMP.Height
  11.       else
  12.         IML.Width := BMP.Width div Count;
  13.       iml.DrawingStyle := dsTransparent;
  14.      iml.ColorDepth := cd32Bit ;
  15.      iml.Add(BMP, nil);
  16.     finally
  17.       BMP.Free;
  18.     end;
  19.   finally
  20.     PNG.Free;
  21.   end;
e. Vysledkem bylo, ze na nekterych pocitacich to bylo pruhledne spravne, na jinych vcetne mem jsem mel pozadi cerne

2. Reseni na prasaka
a. Kdyz jsem se dival, jak jsme to resivali v dobe, kdy zadne pruhledne pozadi u obrazku nebyvalo, tak jsme pouzivali AddMasked
b. Nahradil jsem tedy volani iml.Add(BMP, nil) volanim
Kód: Delphi [Vybrat]
  1. iml.AddMasked(BMP, BMP.TransparentColor)
c. Vysledkekm bylo, ze nektere image listy se zacaly zobrazovat s pruhlednym pozadim, jine meli pozadi nadale cerne
d. Zjistil jsem, ze u tech, ktere se vykresluji spravne je spravne i hodnota BMP.TansparentColor, u tech ostatnich jsou tam hausnumera, pricemz barva leveho dolniho pixlu je v kazdem pasku transparentni.
e. Nakonec jsem tam dal na prasaka natvrdo cernou a zda se, ze to funguje na vsech pocitacih
Kód: Delphi [Vybrat]
  1. iml.AddMasked(BMP, 0)


Nevi nekdo, co delame spatne nebo co muze byt ve hre a jak to nejakym standardnim zpusobem napravit?

Je to v Delphi 10.2 Tokio v 32-bit rezimu (vcetne radkoveho command line prekladace).


Ď, pf

Offline vandrovnik

  • Guru
  • *****
  • Příspěvků: 507
  • Karma: 36
    • Verze Delphi: 10.2
Asi bych se nejdřív podíval, jestli po provedení řádku č. 6 jsou u všech stejné hodnoty:
 Bmp.HandleType (bmDIB)
 Bmp.PixelFormat (pf32bit)
Popř. si je zkusit vynutit - akorát nikdy nevím, jestli ještě před tím Assign, nebo se to tím stejně přepíše.

Offline pf1957

  • Padawan
  • ******
  • Příspěvků: 2297
  • Karma: 123
    • Verze Delphi: D2007, XE3, DX10
Asi bych se nejdřív podíval, jestli po provedení řádku č. 6 jsou u všech stejné hodnoty:
 Bmp.HandleType (bmDIB)
 Bmp.PixelFormat (pf32bit)
Po vytvoreni bitmapy jsou bmDDB & pfDevice, po assign bmDIB & pf32bit, nastaveni DIB a pf32bit pred assign nema vliv (a po vyrazeni meho bugfixu je pozadi cerne).

Offline PaJi

  • Nováček
  • *
  • Příspěvků: 6
  • Karma: 3
    • Verze Delphi: D5, D10.2.3-Tokyo
Zdravím,

kdysi jsem s podobným problémem také zápasil, ale byly to hódně starší verze, problém byl v routině "TBitmap.Assign" a druhého potomka "TGraphic" (v tomto případě PNG objektu).
Podle výsledků Vaší reakce na Vandrovníka bych to viděl skutečně na tu metodu Assign.

V D19 (10.2.3) jsou definice PngImage takto:

TPngImage = class{$IFDEF UseDelphi}(TGraphic){$ENDIF}
TBitmap = class(TGraphic)

Takže oba mají předka "TGraphic" a v metodě "TBitmap.Assign" je dotaz:

  if (Source = nil) or (Source is TBitmap) then

a TPngImage není potomkem TBitmap, takže se udělá jen "holá" bitmapa bez ostatních věcí. Tyto hodnoty se Vám se vší pravděpodobností nepřenesou:
        FTransparent := TBitmap(Source).FTransparent;
        FTransparentColor := TBitmap(Source).FTransparentColor;
        FTransparentMode := TBitmap(Source).FTransparentMode;
        PixelFormat := TBitmap(Source).PixelFormat;
        FAlphaFormat := TBitmap(Source).AlphaFormat;

Mrkněte do zdrojáků unity "Vcl.Graphics.pas", konkrétně "TBitmap.Assign".

Podle mě to Vaše přiřazení "AddMasked" je téměř nutná podmínka. Odkrokujte si Váš kód, kudy to "leze" v metodě "Assign".
Jinak i to přiřazení AddMasked bych udělal jinak:
1.iml.AddMasked(BMP, BMP.TransparentColor) - by mělo být spíše "iml.AddMasked(BMP, PNG.TransparentColor)", protože v BMP.TransparentColor může být cokoliv - záleží na tom, co dělá Assign metoda.

Ale systémovější by bylo řádně "dodělat" BMP - naplnit všechny properties, aby se AddMasked už nemusel volat - to maskování je opravdu rychlý bypass....

Offline pf1957

  • Padawan
  • ******
  • Příspěvků: 2297
  • Karma: 123
    • Verze Delphi: D2007, XE3, DX10
a TPngImage není potomkem TBitmap, takže se udělá jen "holá" bitmapa bez ostatních věcí. Tyto hodnoty se Vám se vší pravděpodobností nepřenesou:
Diky za podnetnou pripominku. Ciste teoreticky by to pak mohlo fungovat obracene:
Kód: Delphi [Vybrat]
  1. PNG.AssignTo(BMP)
kde se Daud nejak snazi rozeznat, ze prirazuje do bitmapy a prenest i neco z toho, co zminujes. Ale stejne to nefunguje, protoze nastavi bitmape Canvas.Bursh.Color cernou a o pruhlednost se moc nestara -> pozadi je tudiz cerne.

Citace
Jinak i to přiřazení AddMasked bych udělal jinak:
by mělo být spíše "iml.AddMasked(BMP, PNG.TransparentColor)"
Ano, to je logicke a taky se zda, ze to funguje bez ohledu na Assign/AssignTo. Alespon na mem pocitaci. Jestli to bude fungovat na ostatnich nevyzkousim, protoze jsme se rozprchli na dovolene.

Ď, pf



Offline Ondřej Pokorný

  • Guru
  • *****
  • Příspěvků: 786
  • Karma: 56
    • Verze Delphi: Primárně Lazarus, jinak D7 až aktuální
    • Kluug.net
Co já vím, tak PNG->BMP nefunguje/nefungovalo v Delphi nikdy spolehlivě pomocí standarních metod. Konkrétně třeba "iml.AddMasked(BMP, PNG.TransparentColor)" by klíďopíďo mohlo úplně zrušit alpha channel (alespoň kdysi to dělalo, možná to někdy změnili, co já vím - v novějších Delphi už takový přehled nemám).

Já používám ve svých legacy Delphi projektech PngImageList: https://cc.embarcadero.com/Item/26127.

Ten používá trik: PNG->ICO->TCustomImageList (t.j. konverzi přes ICO místo BMP). Jestli nechceš instalovat PngImageList, tak se koukni, jak PngImageList konvertuje PNG na ICO (TPngImageList.AddPng, TPngImageList.PngToIcon a pod.) a to samé udělej v nějakém tvém class helperu. T.j. konvertuj PNG do ICO a pak tu ikonu přidej pomocí function TCustomImageList.AddIcon(Image: TIcon): Integer;.

Funguje bez problémů už od dob Delphi 2007. Dost se divím, žes na tohle narazil až teď. Já jsem řešil alpha-transparentní PNG ikony už asi před 10 lety.
Embarcadero Technology Partner, juj. Člen Lazarus týmu, oj.

Offline pf1957

  • Padawan
  • ******
  • Příspěvků: 2297
  • Karma: 123
    • Verze Delphi: D2007, XE3, DX10
Co já vím, tak PNG->BMP nefunguje/nefungovalo v Delphi nikdy spolehlivě pomocí standarních metod.
Tohle me udivuje, protoze my jsme v dobe, kdy Delphi PNG format nepodporoval, pouzivali implementaci od Gustavo Huffenbacher Dauda a kdyz jsem se vcera nebo kdy dival do zdrojovek, tak ji EMBD nebo kdo do Delphi inkorporoval, ale neduhy neodstranil

Citace
Dost se divím, žes na tohle narazil až teď. Já jsem řešil alpha-transparentní PNG ikony už asi před 10 lety.
To je dano jednak tim, ze jsem posledni roky v Delphi nic nedelal a ted jsem tam jen na vypomoc v nestastne nasmlouvanem projektu. Ale kdyby graficka udelala glyfy jako BMP, jako se to delavalo, tak by nebyl zadny duvod pri inovaci projektu, jehoz doba zivota je vyrazne pres 10 let, prechazet na .PNG, zejmena v napjate scheduli. Takhle si kolega chtel usetrit krok offline transformace PNG->BMP nejakym grafickym toolem.

Me spis udivuje, ze kdyz je to common problem Delphi, ze z Google nevyskoci na prvni dobrou spravne reseni, vzdy jenom to, co udelal kolega. Na druhou stranu, nekdo v EMBD to umet bude, protoze prime nacteni tech PNG pasku do image listu v design-time funguje bez problemu. Akorat se s tim s nami zapomel podelit a nabidnout nam high level metodu jako TImageList.LoadFromFile(), abychom se nemuseli zabyvat detaily grafiky.

Offline Ondřej Pokorný

  • Guru
  • *****
  • Příspěvků: 786
  • Karma: 56
    • Verze Delphi: Primárně Lazarus, jinak D7 až aktuální
    • Kluug.net
Co já vím, tak PNG->BMP nefunguje/nefungovalo v Delphi nikdy spolehlivě pomocí standarních metod.
Tohle me udivuje, protoze my jsme v dobe, kdy Delphi PNG format nepodporoval, pouzivali implementaci od Gustavo Huffenbacher Dauda a kdyz jsem se vcera nebo kdy dival do zdrojovek, tak ji EMBD nebo kdo do Delphi inkorporoval, ale neduhy neodstranil

PngImage od Gustavo Dauda a konverze PNG->BMP jsou dvě různé věci.
Embarcadero Technology Partner, juj. Člen Lazarus týmu, oj.

Offline pf1957

  • Padawan
  • ******
  • Příspěvků: 2297
  • Karma: 123
    • Verze Delphi: D2007, XE3, DX10
PngImage od Gustavo Dauda a konverze PNG->BMP jsou dvě různé věci.
Nejsou: ma tam metodu AssignTo, kde kresli PNG na Canvas bitmapy

Offline PaJi

  • Nováček
  • *
  • Příspěvků: 6
  • Karma: 3
    • Verze Delphi: D5, D10.2.3-Tokyo
Zdravím ještě jednou,
taky mě to udivuje, že jste na to ještě nenarazil, ale vše je jednou poprvé.......
Jak už výše Ondra podotkl, v minulosti se to řešilo různě, každej si většinou našel nějakej zdroják a ten si upravil k obrazu svému.
V rychlosti teď tady koukám na ten zdroják v D10.2.3 té metody "TPngImage.AssignTo" a tam to dokonce zná TBitmap atd., i když parametr je TPersistent - podívejte se do "Vcl.Imaging.pngimage", takže by to řešením mohlo být (jsou tam zase jiné podmínky). Bohužel je to potřeba vyzkoušet. Vyplatí se na ty grafické objekty - zdrojáky podívat, zabere Vám to míň času, než hledat různé náhražky. Ještě jsem neobjevil nějakou, která by fungovala na 100 % (každá má nějaké "ale") a to se v tom hrabu už od 16-bitové verze D1. PNG bylo do Delphi doděláváno až hodně pozdě a ruku v ruce s tím jdou i problémy, které to má.  Jinak téměř všechny grafické formáty jsou potomkem z TGraphic (nejsou potomkem TBitmap, atd.) a každý má svůj TxxxImageList.
Mně se při konverzích osvědčilo vždy dodělat TBitmap k obrazu mému (nebo TIcon (tam bacha na sežrané resources u dřívějších verzí)) a pak teprve dál s tím pracovat, ale je to pouze můj soukromý názor, v ostatních případech jsem si (dříve nebo později) vždy nabil čumák.
Takže hodně štěstí a ať se daří.

Offline Ondřej Pokorný

  • Guru
  • *****
  • Příspěvků: 786
  • Karma: 56
    • Verze Delphi: Primárně Lazarus, jinak D7 až aktuální
    • Kluug.net
PngImage od Gustavo Dauda a konverze PNG->BMP jsou dvě různé věci.
Nejsou: ma tam metodu AssignTo, kde kresli PNG na Canvas bitmapy

Jo to jsem řekl dost blbě. AssignTo ale je v PngImage od Delphi taky. Asi jsem měl na mysli (PngImage od Gustavo Dauda) <> (přidání BMP z PNG do image listu).

Jsem s radami v koncích - jednu jsem ti dal (otestovat PngImageList) a víc už asi nezvládnu :(
Embarcadero Technology Partner, juj. Člen Lazarus týmu, oj.

Offline pf1957

  • Padawan
  • ******
  • Příspěvků: 2297
  • Karma: 123
    • Verze Delphi: D2007, XE3, DX10
Jsem s radami v koncích - jednu jsem ti dal (otestovat PngImageList) a víc už asi nezvládnu :(
Me slo hlavne se dopidit:
a) proc se to deje - na to jste s PaJi v podstate odpovedeli
b) jestli to ma nejake standardni reseni ev. jestli muzu nechat prasacke reseni, ktere jsem pouzil a skoro bych rekl, ze kdyz se pouzije AssignTo, ktere nastavi Brush.Color natvrdo na black a ja mu dam MaskColor taky black, ze by to mohlo fungovat vsude.

Vyvijet podporu pro PNG v Delphi nehodlam

Offline JaroB

  • Guru
  • *****
  • Příspěvků: 881
  • Karma: 25
    • Verze Delphi: XE8, Seattle
Já to chápu tak, že PNG je vlastně jen transportní formát, který se musí před vlastním použitím stejně rozprsknout do nějaké matrice. Kdysi jsem dělal konverzní program PNG2DIB a narážel na podobné problémy. Nejrozumnější a nejefektivnější řešení bylo vždy použití bitmapy s alfakanálem (ale tvořil jsem to v rámci unDelphiX, které má vlastní imagelist - ve kterém může být libovolný typ obrázku, jaký je v Delphi registrován, a můžu si každý smysluplně! pojmenovat) protože nakonec, když dojde k vlastnímu použití/kreslení, stejně se to musí dekomprimovat a je úplně jedno, jestli to kreslí VCL s překrytými metodami, anebo to za mě udělá DirectX z textury.
Použití v Delphi je dost nešťastné, pro jednoduchý toolbar je mnohdy potřeba více imagelistů a nelze je jednoduše při větším množství obrázků dobře řídit (ikonek mám v pár aplikacích víc jak tisíc, je to vopruz, a to už pak ani nevím, co která ikona nebo obrázek representuje).

Poznámka:
Metoda AssignTo/Assign obecně by měla umět převzít jakýkoliv cizí formát skrzevá registrace grafických formátů VCL (ale implementace pro ně musí být zde, pak by to stejně mohlo sklouznout do bitmapy jako contactcopy formátu) a přiřadit ho do PNG, ale pak je tady vlastní Draw a ta musí umět akceptovat při kreslení nejen TransparentColor, ale i AphaChannel z dalšího layeru.

Jako příklad jsem skopčil nějaký svůj starší kód z jednotky DIB.pas (ta lze použít i bez directX), kdy se vlastní contactcopy udělá nakreslením (ale jednotnou bází je právě DIB32).
Je to jak pro PNG Gustavo Dauda, tak i pro zabudované PNG:

Kód: Delphi [Vybrat]
  1.   procedure AssignGraphic(Source: TGraphic);
  2.   {$IFDEF PNG_GRAPHICS}
  3.   var
  4.     alpha: TDIB;
  5.     png: {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF};
  6.     i, j: Integer;
  7.     q: pByteArray;
  8.   {$ENDIF}
  9.   begin
  10.     {$IFDEF PNG_GRAPHICS}
  11.     if Source is {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF} then
  12.     begin
  13.       alpha := TDIB.Create;
  14.       try
  15.         {png image}
  16.         png := {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF}.Create;
  17.         try
  18.           png.Assign(Source);
  19.           if png.TransparencyMode = ptmPartial then
  20.           begin
  21.             Alpha.SetSize(png.Width, png.Height, 8);
  22.             {separate alpha}
  23.             for i := 0 to png.Height - 1 do
  24.             begin
  25.               q := png.AlphaScanline[i];
  26.               for j := 0 to png.Width - 1 do
  27.                 alpha.Pixels[j,i] := q[j];
  28.             end;
  29.           end;
  30.           SetSize(png.Width, png.Height, 32);
  31.           FillChar(PBits^, Size, 0);
  32.           Canvas.Draw(0, 0, png);
  33.           Transparent := png.Transparent;
  34.         finally
  35.           png.Free;
  36.         end;
  37.         if not alpha.Empty then
  38.           AssignAlphaChannel(alpha);
  39.       finally
  40.         alpha.Free;
  41.       end;
  42.     end
  43.     else
  44.     {$ENDIF}
  45.     if Source is TBitmap then
  46.       AssignBitmap(TBitmap(Source))
  47.     else
  48.     begin
  49.       SetSize(Source.Width, Source.Height, 32);
  50.       FillChar(PBits^, Size, 0);
  51.       Canvas.Draw(0, 0, Source);
  52.       Transparent := Source.Transparent;
  53.       if not HasAlphaChannel then
  54.       begin
  55.         SetSize(Source.Width, Source.Height, 24);
  56.         FillChar(PBits^, Size, 0);
  57.         Canvas.Draw(0, 0, Source);
  58.         Transparent := Source.Transparent;
  59.       end
  60.     end;
  61.   end;
  62.  

Možná to jako inspirace pomůže :)

 

S rychlou odpovědí můžete používat BB kódy a emotikony jako v běžném okně pro odpověď, ale daleko rychleji.

Jméno: E-mail:
Ověření:
Kolik je šest plus čtyři (slovem):