Использование ImageMap для извлечения изображений (PNG) и отображения на TImage

Question

Я пытаюсь добиться следующего:

Предположим, большой PNG (прозрачный фон 16000 x 70 пикселей), который содержит 50 различных других файлов PNG... Мне нужно загрузить этот PNG и извлечь из него отдельные PNG (лучше всего, например, иметь вид функции, которую я мог бы сказать по координатам (слева, сверху, высота, ширина), какой png я хотел бы извлечь... Извлеченный png должен отображаться в виде затем...

Ну, конечно, я мог бы использовать изображения Gif и воссоздать анимацию снова, но мне почему-то нужен png...

Идея состояла в том, чтобы загрузить его в список изображений, но это не удалось, потому что все 50 png имеют размер (320x70px). Timagelist поддерживает только 256px ширину...

Моей следующей идеей было, может быть, я мог бы сделать что-то вроде:

Загрузите Png в TBitmapArray. Ну, извлечение работает довольно хорошо, но с побочным эффектом, что все теряют альфа-канал, ничто больше не прозрачно, вместо этого я получаю толстую черную границу:-(

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;

Может быть, у кого-то есть идея, как это можно сделать без потери прозрачности... Любая помощь очень ценится, но было бы неплохо, возможно, без сторонних компонентов... по крайней мере, Gr32 тоже будет в порядке

С наилучшими пожеланиями,
s!

Answer 1

Я не уверен насчет каких-либо ограничений по размеру, но вы пробовали TPngCollection от PngComponents (надеюсь, вы используете D2009+). В отличие от TPngImageList, каждая запись в TPngCollection может иметь разный размер. Хотя вам это может и не понадобиться, это может сломать размерный барьер.

Ну не совсем без стороннего...

Answer 2

По сути, вы создаете свой собственный список изображений. Может быть, вы можете найти существующий код ImageList и изменить его. Если у вас есть источник Delphi, это не должно быть сложно. Вероятно, просто расширив некоторые константы, чтобы позволить ему использовать большие изображения. Я вижу, что TcxImageList от DevExpress позволяет вам делать нестандартные размеры. Я только что попробовал 500x500, и он позволил мне (хотя не проверял, но я ожидаю, что это работает). В TMS также есть ImageList, который не уверен в своих возможностях (прямо сейчас его нет).