L'utilisation d'un cliquable extraire des images (PNG) et affichage sur TImage

Question

Je suis en train de réaliser les objectifs suivants:

On suppose un grand .png (fond transparent x 70px 16000) qui contient 50 différents autres fichiers .png ... J'ai besoin de charger ce png et d'en extraire des png individuels (le mieux serait par exemple d'avoir une sorte de fonction que je pourrais dire par des coords (left, top, height, width) que png je voudrais extraire ... png devrait être affiché dans un délai alors ...

Bien sûr, je pourrais utiliser des images Gif et recréer l'animation à nouveau, mais j'ai besoin de png pour une raison quelconque ...

Une idée était de le charger dans un imagelist mais qui a échoué parce que tous les 50 PNGs ont une dimension de (320x70px) TImageList ne supporte que la largeur 256px ...

Ma prochaine idée était peut-être que je pouvais faire quelque chose comme:

Chargez le Png dans un TBitmapArray. Eh bien, l'extraction fonctionne assez bien, mais avec l'effet secondaire que tous perdent rien de alphachannel est transparent plus au lieu que je reçois une bordure noire de graisse :-(

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; 

Peut-être que quelqu'un a une idée de comment cela pourrait se faire sans perdre ... Toute Tranparency aide est très appréciée, mais ce serait bien peut-être sans composants 3ème partie ... au moins GR32 serait ok trop

Sincères salutations,
s!

Answer 1

Je ne suis pas sûr de toutes les restrictions de taille, mais avez-vous essayé le TPn gCollection de PngComponents (J'espère que vous êtes sur D2009 +). Contrairement à TPngImageList, chaque entrée de TPngCollection peut avoir une taille différente. Bien que vous n'en ayez pas besoin ici, cela pourrait casser la barrière de taille.

Eh bien, pas vraiment sans 3ème partie ...

Answer 2

vous construisez votre propre essentiellement imagelist. Peut-être que vous pouvez trouver le code ImageList existant et le modifier. Si vous avez la source Delphi, cela ne devrait pas être difficile. Probablement juste en développant certaines constantes pour le laisser utiliser des images plus grandes. Je vois que le TcxImageList de DevExpress vous permet de faire des tailles personnalisées. J'ai juste essayé 500x500 et il m'a laissé (ne l'ai pas testé cependant, mais je m'attends à ce que cela fonctionne). TMS a également une ImageList, pas sûr des capacités (ne l'avez pas ici, maintenant).