Using an ImageMap extracting Images (PNG) and display on TImage

Question

I'm trying to achieve the following:

Assume a large png (transparent background 16000 x 70px) which contains 50 different other png files... I need to load that png and extract individual pngs from it (best would be e.g. to have kind of a function which I could say by coords (left, top, height, width) which png I would like to extract... The extracted png should be displayed in a timage then...

Well of course I could use Gif images and recreate the animation again but I need png for some reason...

An idea was to load it into an imagelist but that failed because all of the 50 pngs have a dimension of (320x70px) timagelist supports only 256px width...

My next Idea was maybe I could do something like:

Load the Png into a TBitmapArray. Well, the extraction works quite nicely but with the side effect that all are losing the alphachannel nothing is transparent anymore instead I get a fat black border :-(

type
  TRectArray = array of TRect;
  TBitmapArray = array of TBitmap;


// Zwei Funktionen die Rechtecke aufbereiten:
function FixRect(SrcRect: TRect): TRect;
  procedure Switch(var a,b: integer);
  var c: integer;
  begin
    c := a; a := b; b := c;
  end;
begin
  if SrcRect.Left > SrcRect.Right then
    Switch(SrcRect.Left,SrcRect.Right);
  if SrcRect.Top > SrcRect.Bottom then
    Switch(SrcRect.Top,SrcRect.Bottom);
  result := SrcRect;
end;

function TrimRect(SrcRect: TRect; minx,miny,maxx,maxy: integer): TRect;
begin
  result := fixrect(srcrect);
  if result.Left < minx then result.left := minx;
  if result.top < miny then result.top := miny;
  if result.right > maxx then result.right := maxx;
  if result.bottom > maxy then result.bottom := maxy;
end;

// Stanzt die in SrcRect übergebenen rechtecke aus SrcPNG aus und lädt sie ins
// DstBitmapArray
procedure GetBitmaps(const SrcPNG: TPNGObject; const SrcRects: TRectArray;
  var DstBitmapArray: TBitmapArray);
var
  i: integer;
  Rct: TRect;
  Bmp: TBitmap;
begin
  // Bitmap vom PNG Erzeugen
  Bmp := TBitmap.Create;
  Bmp.Assign(SrcPNG);
  // Länge der auszugebenden Bilderliste festlegen (=Anzahl der Rechtecke)
  setlength(DstBitmapArray,high(SrcRects)+1);
  for i := 0 to high(SrcRects) do
  begin
    // Bitmap erzeugen
    DstBitmapArray[i] := TBitmap.Create;
    // Rechteck vorbereiten mit obigen Funktionen (ggf Zurechtschneiden,
    // falls es über die Grenzen des PNGs hinausgeht)
    Rct := TrimRect(SrcRects[i],0,0,SrcPng.Width,SrcPNG.Height);
    // Größe des Bitmaps setzen
    DstBitmapArray[i].SetSize(rct.Right-rct.left,rct.bottom-rct.top);
    // rechteck ausstanzen und auf Bitmap kopieren
    BitBlt(DstBitmapArray[i].Canvas.Handle,0,0,DstBitmapArray[i].width,
      DstBitmapArray[i].Height,bmp.Canvas.handle,rct.left,rct.top,srccopy);
  end;
  Bmp.free;
end;

// Stanzt ebenfalls Bilder aus dem PNG aus, die rechtecke werden aber im
// Parameter Positions testbasiert übergeben. jede Zeile definiert ein rechteck
// Die Koordinaten des Rechtecks werden in der reihenfolge Left, Top, Right, Bottom
// angegeben und durch Kommata separiert. Beispiel:
// 0,0,100,50
// 100,0,100,100
// etc...
procedure LoadBitmaps(const SrcPNG: TPNGObject; const Positions: TStrings;
  var DstBitmapArray: TBitmapArray);
var
  i: integer;
  l: integer;
  rectarray: TRectArray;
  tmp: tstringlist;
begin
  setlength(rectarray,positions.Count);
  l := 0;
  tmp := tstringlist.Create;
  tmp.Delimiter := ',';
  for i := 0 to positions.count - 1 do
  begin
    tmp.DelimitedText := Positions[i];
    if TryStrToInt(trim(tmp[0]),rectarray[l].Left) and
       TryStrToInt(trim(tmp[1]),rectarray[l].Top) and
       TryStrToInt(trim(tmp[2]),rectarray[l].Right) and
       TryStrToInt(trim(tmp[3]),rectarray[l].Bottom) then
      inc(l);
  end;
  setlength(rectarray,l);
  GetBitmaps(srcpng,rectarray,dstbitmaparray);
  tmp.free;
end; 

//extract the second png from the large one

procedure TForm1.btnExtractClick(Sender: TObject);
var
  src: TPNGImage;
begin
  src := TPNGImage.Create;
  src.Assign(img.Picture.Graphic);
  try
    myPictures[0] := TBitmap.Create;
    // ok transparency is lost here!
    LoadBitmaps(src, ImageListAreas, myPictures);
    imgExtract.Picture.Assign(myPictures[0]);
  finally
    FreeAndNil(src);
  end;
end;

Maybe someone have an idea how this could be done without losing tranparency... Any help is much appreciated but it would be nice perhaps without 3rd party components... at least Gr32 would be ok too

Kindest regards,
s!

What exactly is the end goal here? Are you trying to create an animation? Do you need the graphic files embedded into the exe? — GrandmasterB
Extracting individual pngs from a large png with transparency stays intact! Not talkig about embedding sth inside of the executeable thats no problem... I'm loading the imagefiles from disc regards s! — stOrM

Uwe Raabe Uwe Raabe · Accepted Answer · 2010-07-08T13:47:51

I'm not sure about any size restrictions, but did you try the TPngCollection from PngComponents (I hope you are on D2009+). In contrast to TPngImageList, each entry in TPngCollection can be of different size. Although you may not need that here it might break the size barrier.

Well, not really without 3rd party...

Using an ImageMap extracting Images (PNG) and display on TImage

2 Answers