Using an ImageMap extracting Images (PNG) and display on TImage
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开发者_StackOverflow社区
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!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...
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).
精彩评论