使用 ImageMap 提取图像 (PNG) 并在 TImage 上显示

发布于 2024-09-09 03:12:15 字数 3865 浏览 4 评论 0原文

我试图实现以下目标:

假设一个大 png(透明背景 16000 x 70px),其中包含 50 个不同的其他 png 文件... 我需要加载该png并从中提取单个png(最好是有一种功能,我可以通过坐标(左,上,高,宽)来表示我想提取哪个png...提取的png 应该显示在 timage 中...

当然我可以使用 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;

也许有人知道如何在不失去透明度的情况下做到这一点...... 非常感谢任何帮助,但如果没有第 3 方组件,那就太好了……至少 Gr32 也可以,最

诚挚的问候,

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!

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(2

戏舞 2024-09-16 03:12:15

我不确定是否有任何大小限制,但是您是否尝试过 PngComponents 中的 TPngCollection (我希望您使用的是 D2009+)。与 TPngImageList 相比,TPngCollection 中的每个条目可以具有不同的大小。尽管您在这里可能不需要它,但它可能会打破尺寸障碍。

好吧,并不是真的没有第 3 方......

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

£噩梦荏苒 2024-09-16 03:12:15

您本质上是在构建自己的图像列表。也许你可以找到现有的ImageList代码并修改它。如果你有 Delphi 源代码,那应该不难。可能只是扩展一些常量以使其使用更大的图像。我发现 DevExpress 的 TcxImageList 允许您自定义尺寸。我刚刚尝试了 500x500,它让我可以(虽然没有测试它,但我希望它能工作)。 TMS 也有一个 ImageList,但不确定其功能(现在这里没有)。

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

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文