Autor Beitrag
SixpointedStarsoft
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 22
Erhaltene Danke: 1



BeitragVerfasst: Sa 18.12.10 17:35 
Hallo zusammen

Habe ein Bitmap im Format pf32bit mit Alphaformat afPremultiplied und möchte das nun als PNG mit Transparenz speichern.
Mit dem TPngImage geht das nicht, da mit Assign oder AssignHandle die Alphawerte nicht mitgenommen werden.

ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
png:=TPngImage.Create;
  png.AssignHandle(Bitmap.Handle,true,clBlack);
  und auch das geht nicht -> PNG.Assign(Bitmap);
  PNG.SaveToFile('C:\Delphi XE\Transp.png');
  PNG.Free;


Was mache ich da falsch?
Vielen Dank für Eure Bemühungen
bummi
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 1248
Erhaltene Danke: 187

XP - Server 2008R2
D2 - Delphi XE
BeitragVerfasst: Sa 18.12.10 19:35 
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
  type
  TRGBA=Record
    B:Byte;
    G:Byte;
    R:Byte;
    A:Byte;
  End;
  TScanline=Array [0..$effffffof TRGBA;
  PScanline=^TScanline;



Function PNG4TransparentBitMap(bmp:TBitmap):TPNGImage;
//201011 Thomas Wassermann
var
  x, y:Integer;
  SC:PScanline;
begin
    Result := TPNGImage.CreateBlank(COLOR_RGB, 8, bmp.Width , bmp.Height);
    Result.CreateAlpha;
    Result.Canvas.Draw(0,0,bmp);
    for x := 0 to bmp.width - 1 do
      for y := 0 to bmp.Height - 1 do
        begin
        sc := bmp.ScanLine[y];
        Result.AlphaScanline[y][x] :=  sc[x].A;
        end;
end;

_________________
Das Problem liegt üblicherweise zwischen den Ohren H₂♂
DRY DRY KISS
SixpointedStarsoft Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 22
Erhaltene Danke: 1



BeitragVerfasst: Sa 18.12.10 20:05 
Oh, vielen Dank.
Funktioniert perfekt.

Vielen, vielen Dank und noch schöne und lichtvolle Weihnachtszeit.
SixpointedStarsoft Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 22
Erhaltene Danke: 1



BeitragVerfasst: Sa 18.12.10 21:05 
Habe noch eine Ergänzung. Da PNG die Farbe nicht premultiplied ist und das Bitmap diesen Modus aufweist, muss man noch das Primultiplie auf der Farbe zurücksetzen, ansonsten ist das Bild zu dunkel. Hier den abgeänderten Code:
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
function PNG4TransparentBitMap(bmp:TBitmap):TPNGImage;
//201011 Thomas Wassermann
var
  x, y:Integer;
  SC:PScanline;
  vRGB: ^TRGBA;//^TRGBTriple;
begin
  Result := TPNGImage.CreateBlank(COLOR_RGBALPHA, 8, bmp.Width , bmp.Height);
  Result.CreateAlpha;
  Result.Canvas.CopyMode:= cmSrcCopy;
  Result.Canvas.Draw(0,0,bmp);
  for x := 0 to bmp.width - 1 do
    for y := 0 to bmp.Height - 1 do begin
      sc := bmp.ScanLine[y];

      if bmp.AlphaFormat= afPremultiplied then begin
        vRGB:= Result.Scanline[y];
        if sc[x].A <> 0 then begin
          vRGB.b:= round(sc[x].b/sc[x].A*255);
          vRGB.r:= round(sc[x].r/sc[x].A*255);
          vRGB.g:= round(sc[x].g/sc[x].A*255);
        end;
        Result.Pixels[x,y]:= RGB(vRGB.r,vRGB.g,vRGB.b);
      end;

      Result.AlphaScanline[y][x] :=  sc[x].A;
    end;
end;

Für diesen Beitrag haben gedankt: bummi
jaenicke
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 18989
Erhaltene Danke: 1685

W10 x64 (Chrome, Edge)
Delphi 10.4 Ent, Oxygene, C# (VS 2019), JS/HTML, Java (NB), PHP, Lazarus
BeitragVerfasst: So 19.12.10 12:23 
user profile iconSixpointedStarsoft hat folgendes geschrieben Zum zitierten Posting springen:
ausblenden Delphi-Quelltext
1:
        Result.Pixels[x,y]:= RGB(vRGB.r,vRGB.g,vRGB.b);					
Wenn es AlphaScanLine gibt, gibt es doch bestimmt auch ScanLine in TPngImage, oder? Das wäre (nehme ich an) auch bei TPngImage um Größenordnungen schneller.
SixpointedStarsoft Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 22
Erhaltene Danke: 1



BeitragVerfasst: So 19.12.10 15:23 
Danke, völlig recht.
Hier die neue Version:
ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
type
  TRGB      = packed record b, g, r: Byte end;
  TRGBA      = packed record b, g, r, a: Byte end;
  TRGBAArray = array[0..0of TRGBA;

function PNG4TransparentBitMap(bmp:TBitmap):TPNGImage;
//201011 Thomas Wassermann
var
  x, y:Integer;
  vBmpRGBA: ^TRGBAArray;
  vPngRGB: ^TRGB;
begin
  Result := TPNGImage.CreateBlank(COLOR_RGBALPHA, 8, bmp.Width , bmp.Height);
  Result.CreateAlpha;
  Result.Canvas.CopyMode:= cmSrcCopy;
  Result.Canvas.Draw(0,0,bmp);

  for y := 0 to pred(bmp.Height) do begin
    vBmpRGBA := bmp.ScanLine[y];
    vPngRGB:= Result.Scanline[y];

    for x := 0 to pred(bmp.width) do begin
      Result.AlphaScanline[y][x] :=  vBmpRGBA[x].A;
      if bmp.AlphaFormat in [afDefined,afPremultiplied] then begin
        if vBmpRGBA[x].A <> 0 then begin
          vPngRGB^.b:= round(vBmpRGBA[x].b/vBmpRGBA[x].A*255);
          vPngRGB^.r:= round(vBmpRGBA[x].r/vBmpRGBA[x].A*255);
          vPngRGB^.g:= round(vBmpRGBA[x].g/vBmpRGBA[x].A*255);
        end else begin
          vPngRGB^.b:= round(vBmpRGBA[x].b*255);
          vPngRGB^.r:= round(vBmpRGBA[x].r*255);
          vPngRGB^.g:= round(vBmpRGBA[x].g*255);
        end;
      end;
      inc(vPngRGB);
    end;
  end;

end;