Ver Mensaje Individual
  #4  
Antiguo 30-04-2004
Turboleta Turboleta is offline
Miembro
 
Registrado: may 2003
Ubicación: Valencia
Posts: 26
Reputación: 0
Turboleta Va por buen camino
Lightbulb Una posible solución

Creo que esta funcion te puede servir:

{* Realiza el fundido de un BMP sobre un cancas de tres formas diferentes *}
{* Hay que deshabilitar Range Checking para evitar un error de fuera de rango *}
{* en ejecución, porque Tcoord se creará dinámicamente *}
{* c= columna; l= línea => coordenadas esquina sup. izquierda *}
procedure fundido(Fondo:Tcanvas;Const Marca:TBitmap;
c,l,Tipo,Espera:integer);
type Tpixels= record
x, y: word // Tipo coordenadas de un pixel
end;
Tcoord= array[0..0] of TPixels; // Array de coordenadas para los pixels
Pcoord= ^TCoord; // Puntero al array
var col,lin: integer;
CTotal,tot,i,ord: longint;
coords: Pcoord; // Del Tipo puntero al array
begin
if (tipo > 3) or (Tipo < 1) then tipo:= 1;
case tipo of
1: begin
CTotal:= marca.width * marca.height; // Total de pixel del BMP
GetMem(Coords, CTotal * SizeOf(TPixels));// Se crea el array dinámicamente
for lin:= 0 to marca.Height - 1 do
for col:= 0 to marca.Width - 1 do
begin // Se guardan en el array todas
Ord:= lin * marca.width + col; // las coord. de todos los pixels
Coords^[ord].x:= col; // del BMP
Coords^[ord].y:= lin;
end; // se guarda en Tot el nº de pixels
tot:= CTotal;
for i:= 0 to CTotal do
begin // Se eligen unas coord. y ese pixel
ord:= Random(Tot); // se copia en el TImage
fondo.pixels[c + Coords^[ord].x, l + Coords^[ord].y]:=
marca.canvas.pixels[Coords^[ord].x,Coords^[ord].y];
Coords^[ord]:= Coords^[tot - 1];
Dec(tot);
if i mod 500 = 0 then
begin
Application.ProcessMessages;
Sleep(espera);
fondo.refresh; // Se repinta el TImage
end
end; // Se libera la men. del array
FreeMem(Coords, CTotal * SizeOf(TPixels));
end;
2: Begin // Se dibuja por líneas, de arriba
for lin:= 0 to marca.Height - 1 do // hacia abajo.
begin
for col:= 0 to marca.Width - 1 do
begin
fondo.pixels[c + col, l + lin]:= marca.canvas.pixels[col,lin];
end;
Application.ProcessMessages;
sleep(espera);
fondo.refresh;
end
end;
3: Begin // Se dibuja por columnas de Izq. a
for col:= 0 to marca.width - 1 do // derecha.
begin
for lin:= 0 to marca.Height - 1 do
begin
fondo.pixels[c + col, l + lin]:= marca.canvas.pixels[col,lin];
end;
sleep(espera);
Application.ProcessMessages;
if col mod 2 = 0 then
fondo.refresh;
end
end
end;
fondo.refresh
end;


¡Ya me contarás qué te parece! Te aseguro que funciona.
Responder Con Cita