Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Gráficos
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 30-12-2007
Thorax Thorax is offline
Registrado
 
Registrado: dic 2007
Posts: 2
Poder: 0
Thorax Va por buen camino
Modificando Procedimiento para concatenar imagenes JPG

Hola! , soy nuevo en el foro, anque lo vengo leyendo hace bastante.
Tengo una consulta sobre un procedimiento que encontre en internet.

http://www.saiyine.com/post.471.php?tags=+DELPHI+

El mismo lo que hace es concatenar imagenes de igual tamaño de izquierda a derecha de menor a mayor, formando una tira, o sea que la imagen mas chica va a quedar en la izquierda y la mas grande en la derecha.
las imagenes las toma de un tstringlist, de ahi saca la lista.

Cuando me refiero a mas chica o mas grande es el nombre que lleva, que es un numero.

Lo que yo necesito es concatenar las imagenes de igual manera pero de abajo hacia arriba, de menor a mayor, quedando la imagen mas chica abajo de todo y la mas grande arriba.


Modifique el codigo en algunas lineas y pude obtener como resultado que el procedimiento cree la tira de forma vertical, e inserte las imagenes chicas formando la tira, pero lo que no puedo lograr es que lo haga en el orden correcto.
Lo que logro es colocar la mas chica arriba de todo y la mas grande abajo. sospecho que esto pasa porque el procedimiento crea la tira de arriba hacia abajo en lugar de hacerlo de abajo hacia arriba.

Necesitaria una solucion en la que los datos se sigan cargando en el tstrinlist de igual manera, a lo que me refiero es que no me serviria cargar las imagenes en el tstringlist al revez para solucionar el problema

Les dejo el codigo original, el codigo modificado por mi y los procedimientos y funciones utilizadas

procedimiento original:

Código:
//  GrabarJPG('resultado.jpg',sumar_jpg_de_lado(memo1.lines));
function sumar_jpg_de_lado(nombres : tstrings) : TBitmap;
var
b : array [0..10] of tbitmap;  // limite de JPGs laterales, subir si hace falta
c,x,y,i,j,k : integer;
begin
        c:=nombres.count;
        for i:=0 to c-1 do b[i]:=LeerJPG(nombres[i]);
        //  ATENCION: Es para n JPGs de dimesiones identicas
        x:=b[0].width;
        y:=b[0].height;
        result:=CrearBitmap(x*c,y);
 for i:=0 to x-1 do
        for j:=0 to y-1 do
        for k:=0 to c-1 do
        result.canvas.Pixels[i+k*x,j]:=b[k].canvas.pixels[i,j];
end;
Mi programa completo (aca puede encontrar los procedimientos y funciones faltantes)

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,jpeg;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

 //////////////////////////////////////////////////////////////////////

implementation
{$R *.DFM}
///////////////////////////////////////////////////////////////////////
function LeerJPG(n : string) : TBitmap;
Var
jpeg: TJPEGImage;
Begin
        jpeg:= TJPEGImage.Create;
        try
        jpeg.LoadFromFile(n);
        result:= TBitmap.Create;
        try
        result.Assign( jpeg );
        finally
end;
finally
jpeg.free
end;
end;
///////////////////////////////////////////////////////////////////////
function CrearBitmap(tamx,tamy : integer) : TBitmap;
begin
  result:=TBitmap.Create;
  result.Height:=tamy;
  result.Width:=tamx;
  result.PixelFormat := pf24Bit;
end;
///////////////////////////////////////////////////////////////////////
function sumar_jpg_de_lado(nombres : tstrings) : TBitmap;
var
b : array [0..10] of tbitmap;  // limite de JPGs laterales, subir si hace falta
c,x,y,i,j,k : integer;
begin
        c:=nombres.count;
        for i:=0 to c-1 do b[i]:=LeerJPG(nombres[i]);
        //  ATENCION: Es para n JPGs de dimesiones identicas
        x:=b[0].width;
        y:=b[0].height;
        result:=CrearBitmap(x,y*c); //(x*c,y);  //
        for i:=0 to x-1 do
        for j:=0 to y-1 do
        for k:=0 to c-1 do
        result.canvas.Pixels[i,j+k*y]:=b[k].canvas.pixels[i,j];  //result.canvas.Pixels[i+k*x,j]:=b[k].canvas.pixels[i,j];
end;
///////////////////////////////////////////////////////////////////////
procedure GrabarJPG(n : string; d : TBitmap);
Var
jpeg: TJPEGImage;

Begin
        jpeg:= TJPEGImage.Create;
        jpeg.Assign( d );  // d es el origen tstringlist
        jpeg.savetofile(n);    //n es el nombre
        jpeg.free
end;
///////////////////////////////////////////////////////////////////////

procedure TForm1.Button1Click(Sender: TObject);
var
searchResult : TSearchRec;
begin
SetCurrentDir('E:\Xplane\Fotoreal\sadf\Nueva carpeta');
memo1.clear;

      if FindFirst('*.jpg', faAnyFile, searchResult) = 0 then begin
                repeat
                        Memo1.Lines.Add(searchresult.name);
                until FindNext(searchResult) <> 0;

        FindClose(searchResult);
end;
GrabarJPG('resultado.jpg',sumar_jpg_de_lado(memo1.lines));
memo1.lines.add('resultado.jpg');
end;
end.

espero la respuesta, gracias!
Responder Con Cita
  #2  
Antiguo 03-01-2008
Avatar de cHackAll
[cHackAll] cHackAll is offline
Baneado?
 
Registrado: oct 2006
Posts: 2.159
Poder: 20
cHackAll Va por buen camino
Se me ocurre; utilizas un buffer doble; en el de segundo plano tienes un BMP que se va extendiendo... cómo? (Bitmap.Height := Bitmap.Height + Origen.Height)... y luego le haces "append" a la imagen... cómo? (Bitmap.Canvas.Draw(0, Bitmap.Height - Origen.Height, jpeg);)

Con eso puedes hacerlo en direccion horizontal y vertical.

Saludos
Responder Con Cita
  #3  
Antiguo 04-01-2008
Thorax Thorax is offline
Registrado
 
Registrado: dic 2007
Posts: 2
Poder: 0
Thorax Va por buen camino
ya lo pude solucionar gracias
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
algun procedimiento para obtener el RFC Goyo Varios 11 12-08-2012 19:47:05
Dos aplicaciones modificando el mismo registro ... seoane Firebird e Interbase 31 27-09-2007 12:32:28
Modificando total de acuerdo a existencia karlaoax SQL 5 02-05-2007 23:06:46
Modificando exes b0rn Varios 3 06-03-2007 22:36:18
Procedimiento para llamar formas Luis OOP 7 11-03-2005 14:29:43


La franja horaria es GMT +2. Ahora son las 00:49:49.


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