Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   OOP (https://www.clubdelphi.com/foros/forumdisplay.php?f=5)
-   -   Funcion para unir varias imagenes png (https://www.clubdelphi.com/foros/showthread.php?t=84788)

look 05-12-2013 18:23:55
Funcion para unir varias imagenes png
 
hola amigos tengo vairias imagenes en un directorio, "A.png , B.png , C.png ", lo que quiero hacer es una funcion para unir estas images y exportartas quedando como resultado " ABC.PNG" .

¿Podrian hecharme una manito?

ecfisa 05-12-2013 18:34:54
Hola look :)

Fijate si te sirve, o te da alguna idea, este ejemplo del blog de Neftali

Saludos :)

look 05-12-2013 18:52:34
Cita:
Empezado por ecfisa (Mensaje 470449)
Hola look :)

Fijate si te sirve, o te da alguna idea, este ejemplo del blog de Neftali

Saludos :)
Gracias amigo , le hechare un vistazo!

look 05-12-2013 21:57:02
Cita:
Empezado por ecfisa (Mensaje 470449)
Hola look :)

Fijate si te sirve, o te da alguna idea, este ejemplo del blog de Neftali

Saludos :)
Hola amigo, este ejemplo funciona bien con imagenes bmp, pero no trabaja con imagenes png. :( , ¿sera posible hacer esto mismo pero con png? , modificar el codigo para trabajar con images png, tengo instalado un componente que me permite cargar imagenes png en un Timage, pero de aqui estoy perdido.


...

look 06-12-2013 22:53:10
Encontre este codigo, con el logro unir varias imagenes pero al guardar la imagen se guarda con fondo blanco y no transparente, hay alguna mera de solucionar esto?

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
var
  png1, png2, png3: TPNGObject;
  bmp: TBitmap;
begin
  png1 := TPNGObject.Create; //no error-handling just for testing
  png2 := TPNGObject.Create;
  png3 := TPNGObject.Create;

  png1.LoadFromFile('c:\a.png');
  png2.LoadFromFile('c:\b.png');
  png3.LoadFromFile('c:\c.png');

  bmp:= TBitmap.Create;
  bmp.Width:= png3.Width;
  bmp.Height:= png3.Height;
  bmp.PixelFormat:= pf24bit;

  // Clear background with form's color
  bmp.Canvas.Brush.Color:= Color;
  bmp.Canvas.FillRect(Rect(0, 0, bmp.Width, bmp.Height));


  png3.Draw(bmp.Canvas, Rect(0, 0, png3.Width, png3.Height));
  png1.Draw(bmp.Canvas, Rect(0, 0, png1.Width, png1.Height));
  png2.Draw(bmp.Canvas, Rect(0, 0, png2.Width+30, png2.Height));

  Image1.Picture.Assign(bmp); //display it on a TImage component
  Image1.Picture.SaveToFile('c:\abc.png');
  bmp.Free;
  png1.Free;
  png2.Free;
  png3.Free;

ecfisa 07-12-2013 01:53:20
Hola look.

Perdón por la demora, recién entro.

Proba de este modo:
Código Delphi [-]
uses pngimage;

procedure TForm1.Button1Click(Sender: TObject);
const
   PATH = 'C:\';
var
  png1, png2, png3: TPNGObject;
  bmp: TBitmap;
begin
  png1 := TPNGObject.Create;
  png2 := TPNGObject.Create;
  png3 := TPNGObject.Create;
  try
    png1.LoadFromFile(PATH+'a.png');
    png2.LoadFromFile(PATH+'b.png');
    png3.LoadFromFile(PATH+'c.png');
    bmp := TBitmap.Create;
    try
      bmp.Width  := png1.Width + png2.Width  + png3.Width;
      bmp.Height := png1.Height;
      bmp.PixelFormat:= pf24bit;
      bmp.Canvas.Brush.Color := Color;
      bmp.Canvas.FillRect(Rect(0, 0, bmp.Width, bmp.Height));
      bmp.TransparentColor := Color;   // "Color" será transparente
      bmp.Transparent := True;         // Aplicar
      png1.Draw(bmp.Canvas, Rect(0, 0, png1.Width, png1.Height));
      png2.Draw(bmp.Canvas, Rect(png1.Width, 0, png1.Width + png2.Width, png2.Height));
      png3.Draw(bmp.Canvas, Rect(png1.Width + png2.Width, 0,
          png1.Width + png2.Width  + png3.Width, png3.Height));
      bmp.SaveToFile(PATH+'abc.png'); // mostrar
      Image1.Picture.Assign(bmp);     // guardar
    finally
      bmp.Free
    end
  finally
    png1.Free;
    png2.Free;
    png3.Free
  end;
end;
Fijate que al pasar a bmp, hice espacio en sentido horizontal para que quepan las tres imágenes, la transparencia del color de fondo está comentada en el código.

Saludos. :)

look 07-12-2013 15:16:15
Cita:
Empezado por ecfisa (Mensaje 470498)
Hola look.

Perdón por la demora, recién entro.

Proba de este modo:
Código Delphi [-]
uses pngimage;

procedure TForm1.Button1Click(Sender: TObject);
const
   PATH = 'C:\';
var
  png1, png2, png3: TPNGObject;
  bmp: TBitmap;
begin
  png1 := TPNGObject.Create;
  png2 := TPNGObject.Create;
  png3 := TPNGObject.Create;
  try
    png1.LoadFromFile(PATH+'a.png');
    png2.LoadFromFile(PATH+'b.png');
    png3.LoadFromFile(PATH+'c.png');
    bmp := TBitmap.Create;
    try
      bmp.Width  := png1.Width + png2.Width  + png3.Width;
      bmp.Height := png1.Height;
      bmp.PixelFormat:= pf24bit;
      bmp.Canvas.Brush.Color := Color;
      bmp.Canvas.FillRect(Rect(0, 0, bmp.Width, bmp.Height));
      bmp.TransparentColor := Color;   // "Color" será transparente
      bmp.Transparent := True;         // Aplicar
      png1.Draw(bmp.Canvas, Rect(0, 0, png1.Width, png1.Height));
      png2.Draw(bmp.Canvas, Rect(png1.Width, 0, png1.Width + png2.Width, png2.Height));
      png3.Draw(bmp.Canvas, Rect(png1.Width + png2.Width, 0,
          png1.Width + png2.Width  + png3.Width, png3.Height));
      bmp.SaveToFile(PATH+'abc.png'); // mostrar
      Image1.Picture.Assign(bmp);     // guardar
    finally
      bmp.Free
    end
  finally
    png1.Free;
    png2.Free;
    png3.Free
  end;
end;
Fijate que al pasar a bmp, hice espacio en sentido horizontal para que quepan las tres imágenes, la transparencia del color de fondo está comentada en el código.

Saludos. :)

Hola amigo, gracias por tu ayuda, al guardar la imagen queda con fondo blanco, pero encontre esta funcion:

Código Delphi [-]
function ConvertToPNG(oBMPSrc: TBitmap; sFilename: String):TPNGObject;
var
  oPNGDest: TPNGObject;
begin
  oPNGDest := TPNGObject.Create;
  try
    oPNGDest.Assign(oBMPSrc);
    oPNGDest.SaveToFile(sFilename);
  finally
    oPNGDest.Free;
  end;
end;

Quedando asi:

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
const
   PATH = 'C:\';
var
  png1, png2, png3: TPNGObject;
  bmp: TBitmap;
begin
  png1 := TPNGObject.Create;
  png2 := TPNGObject.Create;
  png3 := TPNGObject.Create;
  try
    png1.LoadFromFile(PATH+'a.png');
    png2.LoadFromFile(PATH+'b.png');
    png3.LoadFromFile(PATH+'c.png');
    bmp := TBitmap.Create;
    try
      bmp.Width  := png1.Width + png2.Width  + png3.Width;
      bmp.Height := png1.Height;
      bmp.PixelFormat:= pf32bit;
      bmp.Canvas.Brush.Color := clWhite;
      bmp.Canvas.FillRect(Rect(0, 0, bmp.Width, bmp.Height));
      bmp.TransparentColor := clWhite;   // "Color" será transparente
      bmp.Transparent := True;         // Aplicar
      png1.Draw(bmp.Canvas, Rect(0, 0, png1.Width, png1.Height));
      png2.Draw(bmp.Canvas, Rect(png1.Width, 0, png1.Width + png2.Width, png2.Height));
      png3.Draw(bmp.Canvas, Rect(png1.Width + png2.Width, 0,
          png1.Width + png2.Width  + png3.Width, png3.Height));
      bmp.SaveToFile(PATH+'abc.png'); // mostrar
      Image1.Picture.Assign(bmp);     // guardar
     ConvertToPNG(bmp,'c:\res.png'); /// utilizo la funcion para guardar
    finally
      bmp.Free
    end
  finally
    png1.Free;
    png2.Free;
    png3.Free
  end;
end;

La funcion mas el codigo que me diste funciona muy bien, gracias amigo!
Saludos!

ecfisa 07-12-2013 16:36:07
Hola look.

Gracias por poner la función ^\||/. Y me alegra que te sirviera el código.

Saludos :)

look 07-12-2013 17:19:30
Cita:
Empezado por ecfisa (Mensaje 470506)
Hola look.

Gracias por poner la función ^\||/. Y me alegra que te sirviera el código.

Saludos :)
Hola, he mejorado la funcion:

Código Delphi [-]
procedure TForm1.ConvertNamePng(sName:string ; Path:string ; img:TImage);
var
  bmp: TBitmap;
  aPng : array of TPNGObject;
  i,pngWidth : Integer;
begin
  SetLength(aPng,Length(sName));
  bmp := TBitmap.Create;
  for  i:=0  to Length(sName)-1 do
  begin
    aPng[i] := TPNGObject.Create;
    aPng[i].LoadFromFile(PATH+copy(sName,i+1,1)+'.png');
  end;
  bmp.Width  := (aPng[0].Width*Length(sName))-1;
  bmp.Height := aPng[0].Height;
  bmp.PixelFormat:= pf32bit;
  bmp.Canvas.Brush.Color := clWhite;
  bmp.Canvas.FillRect(Rect(0, 0, bmp.Width, bmp.Height));
  bmp.TransparentColor := clWhite;
  bmp.Transparent := True;
  pngWidth := 0;
  for  i:=0  to Length(sName)-1 do
  begin
    aPng[i].Draw(bmp.Canvas, Rect(pngWidth , 0, aPng[i].Width + pngWidth , aPng[0].Height));
    pngWidth := aPng[i].Width+pngWidth;
  end;
  bmp.SaveToFile(PATH+'abc.png');
  img.Picture.Assign(bmp);
  ConvertToPNG(bmp,'c:\res.png');
  bmp.Free;
  for i := 0  to Length(sName)-1  do aPng[i].Free;
end;

ahora le mandas una cadena de texto y esta devuelve una imagen correspondiente al texto partiendo de un directorio en donde cada imagen represente una letra. :)

ecfisa 08-12-2013 04:58:12
Hola look.

Otra vueltita de tuerca...
Código Delphi [-]
procedure ConcatPngHrz(const PngNames: array of TFileName; const PngPath, FullTargetName: string);
var
  bmp: TBitmap;
  png: array of TPNGObject;
  i,hgt,wdt: Integer;
begin
  hgt := 0;
  wdt := 0;
  SetLength(png, Length(PngNames));
  for i := Low(PngNames) to High(PngNames) do
  begin
    png[i] := TPNGObject.Create;
    png[i].LoadFromFile(IncludeTrailingPathDelimiter(PngPath) + PngNames[i]);
    if png[i].Height > hgt then hgt := png[i].Height;
    Inc(wdt, png[i].Width);
  end;
  bmp := TBitmap.Create;
  bmp.PixelFormat:= pf32bit;
  bmp.Width  := wdt;
  bmp.Height := hgt;
  bmp.Canvas.Brush.Color := clWhite;
  bmp.Canvas.FillRect(Rect(0, 0, wdt, hgt));
  bmp.TransparentColor := clWhite;
  bmp.Transparent := True;
  wdt := 0;
  for i := Low(PngNames) to High(PngNames) do
  begin
    png[i].Draw(bmp.Canvas, Rect(wdt, 0, wdt +  png[i].Width, png[i].Height));
    Inc(wdt, png[i].Width);
  end;
  with png[Low(PngNames)] do
  begin
    Assign(bmp);
    SaveToFile(FullTargetName);
  end;
  for i := Low(PngNames) to High(PngNames) do png[i].Free;
  bmp.Free;
end;
De este modo eliminamos la limitante a tres archivos orígen, y también podemos usar diferentes altos ya que la imágen destino se ajusta a la de mayor tamaño.

Por ejemplo, una llamada podría ser:
Código Delphi [-]
  ConcatPngHrz(['A.PNG', 'B.PNG', 'C.PNG' ,'D.PNG', 'E.PNG', 'F.PNG', { (...) }], 'C:\IMAGENES', 'C:\IMAGENES\CONCAT.PNG');
Si además te interesa mostrarla en un TImage dentro del código, convendría hacer al procedimiento ConcatPngHrz método de un form (o agregar un parámetro de tipo TForm).

Saludos :)

look 09-12-2013 15:35:15
Cita:
Empezado por ecfisa (Mensaje 470528)
Hola look.

Otra vueltita de tuerca...
Código Delphi [-]
procedure ConcatPngHrz(const PngNames: array of TFileName; const PngPath, FullTargetName: string);
var
  bmp: TBitmap;
  png: array of TPNGObject;
  i,hgt,wdt: Integer;
begin
  hgt := 0;
  wdt := 0;
  SetLength(png, Length(PngNames));
  for i := Low(PngNames) to High(PngNames) do
  begin
    png[i] := TPNGObject.Create;
    png[i].LoadFromFile(IncludeTrailingPathDelimiter(PngPath) + PngNames[i]);
    if png[i].Height > hgt then hgt := png[i].Height;
    Inc(wdt, png[i].Width);
  end;
  bmp := TBitmap.Create;
  bmp.PixelFormat:= pf32bit;
  bmp.Width  := wdt;
  bmp.Height := hgt;
  bmp.Canvas.Brush.Color := clWhite;
  bmp.Canvas.FillRect(Rect(0, 0, wdt, hgt));
  bmp.TransparentColor := clWhite;
  bmp.Transparent := True;
  wdt := 0;
  for i := Low(PngNames) to High(PngNames) do
  begin
    png[i].Draw(bmp.Canvas, Rect(wdt, 0, wdt +  png[i].Width, png[i].Height));
    Inc(wdt, png[i].Width);
  end;
  with png[Low(PngNames)] do
  begin
    Assign(bmp);
    SaveToFile(FullTargetName);
  end;
  for i := Low(PngNames) to High(PngNames) do png[i].Free;
  bmp.Free;
end;
De este modo eliminamos la limitante a tres archivos orígen, y también podemos usar diferentes altos ya que la imágen destino se ajusta a la de mayor tamaño.

Por ejemplo, una llamada podría ser:
Código Delphi [-]
  ConcatPngHrz(['A.PNG', 'B.PNG', 'C.PNG' ,'D.PNG', 'E.PNG', 'F.PNG', { (...) }], 'C:\IMAGENES', 'C:\IMAGENES\CONCAT.PNG');
Si además te interesa mostrarla en un TImage dentro del código, convendría hacer al procedimiento ConcatPngHrz método de un form (o agregar un parámetro de tipo TForm).

Saludos :)
Hola amigo, excelente, muchas gracias, me agrada como evouciono la funcion :)

Saludos!


La franja horaria es GMT +2. Ahora son las 08:34:22.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi