views:

85

answers:

2

Hi, 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!

+1  A: 

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...

Uwe Raabe
Yes I'm in Delphi 2010 ...The Problem is, the PngImagelist had the same restrictions.For your idea about the Pngcollection, that will not work since, it does not cut the whole large 16000px wide png at a specified coord instead it will load it as one part, which doesnt help me... Well also it will be much more work since I would need to cut all 50 png's on my own and save all of them into seperate files and then load them into the PngCollection component...Kindest regards,s!
stOrM
A: 

You're essentially building your own imagelist. Maybe you can find existing ImageList code and modify it. If you have the Delphi source, it shouldn't be hard. Probably just expanding some constants to let it use larger images. I see that the TcxImageList by DevExpress lets you do custom sizes. I just tried 500x500 and it let me (didn't test it though, but I expect that it works). TMS also has an ImageList, not sure of the capabilities (don't have it right here, right now).

Chris Thornton
Hmm that could work perhaps I haven't checked this out yet but I really would prefer a way by doing it from inside of an extract function or something just with tranparency :-)...
stOrM
Btw. I've tested the TcxImageList shortly its true no limited dimensions but the images doesnt stay intact later even with the right width / height defined.Funny inside the TcxImageList everything looks fine ...
stOrM