Mmm... interesting, let's take a look at this code...
The only thing I dunno is to render texture contents onto a layered window (WPF would do for Vista, but I'm aiming for something XP compatible

)
@vigil & vhanla:
The fastest way to do gfx is with hardware acceleration (either 2d or 3d). Of course one can write an MMX / SIMD / SSEx / whatever optimized routine, but video board acceleration is usually much faster.
I can't promise anything because of lack of time, but I'll try and see if I can contribute with something.
Edit
Ok, made some changes...
Added my unitLayeredWindow.pas:
unit unitLayeredWindow;
interface
uses Windows, SysUtils, Forms, Graphics;
procedure LWSetupForm (form : TForm);
procedure LWSetImage (form : TForm; bmp : TBitmap);
//-----------------------------------------
const
WS_EX_LAYERED = $80000;
LWA_COLORKEY = 1;
LWA_ALPHA = 2;
ULW_COLORKEY = 1;
ULW_ALPHA = 2;
ULW_OPAQUE = 4;
AC_SRC_ALPHA = 1;
function SetLayeredWindowAttributes (hwnd : HWND; crKey : COLORREF; bAlpha : BYTE; dwFlags : DWORD) : BOOL; stdcall;
function UpdateLayeredWindow (hwnd : HWND; dstHDC : HDC; ppDst : PPoint; ASize : PSize; srcHDC : HDC; pptSrc : PPoint; crKey : COLORREF; var bf : _BLENDFUNCTION; dwFlag : DWORD) : BOOL; stdcall;
function SetLayeredWindowAttributes; external 'user32.dll' name 'SetLayeredWindowAttributes';
function UpdateLayeredWindow; external 'user32.dll' name 'UpdateLayeredWindow';
implementation
var
buffer : TBitmap;
procedure Preprocesar (bmp : TBitmap);
var
x, y : Integer;
p : PByteArray;
begin
If bmp.PixelFormat <> pf32bit Then
Exit;
For y := 0 To bmp.Height-1 do
begin
p := bmp.Scanline[y];
For x := 0 To bmp.Width-1 do
begin
p[x*4 ] := (Integer(p[x*4 ]) * p[x*4+3]) div 255;
p[x*4+1] := (Integer(p[x*4+1]) * p[x*4+3]) div 255;
p[x*4+2] := (Integer(p[x*4+2]) * p[x*4+3]) div 255;
end;
end;
end;
procedure LWSetupForm (form : TForm);
begin
form.BorderStyle := bsNone;
SetWindowLong (form.Handle, GWL_EXSTYLE, GetWindowLong (form.Handle, GWL_EXSTYLE) Or WS_EX_LAYERED);
end;
procedure LWSetImage (form : TForm; bmp : TBitmap);
var
y : Integer;
bf : TBlendFunction;
spt, dpt : TPoint;
sz : TSize;
begin
If bmp.PixelFormat <> pf32bit Then
Exit;
buffer.PixelFormat := pf32bit;
buffer.Width := bmp.Width;
buffer.Height := bmp.Height;
For y := 0 To bmp.Height-1 do
Move (bmp.Scanline[y]^, buffer.Scanline[y]^, bmp.Width*4);
Preprocesar (buffer);
bf.BlendOp := AC_SRC_OVER;
bf.BlendFlags := 0;
bf.SourceConstantAlpha := $FF;
bf.AlphaFormat := AC_SRC_ALPHA;
spt.x := 0;
spt.y := 0;
sz.cx := buffer.Width;
sz.cy := buffer.Height;
dpt.x := form.Left;
dpt.y := form.Top;
UpdateLayeredWindow (form.Handle, form.Canvas.Handle, @dpt, @sz, buffer.Canvas.Handle, @spt, 0, bf, ULW_ALPHA);
end;
initialization
buffer := TBitmap.Create;
finalization
buffer.Destroy;
end.
Added window clipping to minimal regions for faster animations, and use layered window with per pixel alpha instead of key color (much smoother because of that too):
(GenieFXsrc.pas)
{
GenieFXLib v0.1
Author: vhanla
This is a Genie Effect animation library sample
}
unit GenieFXsrc;
interface
uses
Windows, Messages, SysUtils, {Variants, }Classes, Graphics, Controls, Forms,
Dialogs, WindowsEx, Math, unitLayeredWindow;
type
pgrap=^TBitmap;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
procedure GenieFX(pbmp: pgrap;sl,sr,st,sb,el,er,et,eb:integer);
end;
type
(*
TRGB32 = packed record
B,G,R,A:byte;
end;
*)
TRGB32 = Cardinal;
TRGB32Array=packed array[0..MaxInt div sizeof(TRGB32)-1] of TRGB32;
PRGB32Array = ^TRGB32Array;
var
Form1: TForm1;
implementation
{$R *.dfm}
{-$DEFINE USE_STRETCHBLT}
// maybe faster than StretchBlt
procedure LineBlit (src, dst : PRGB32Array; src_scanline_width, dst_scanline_width, dst_x, dst_width : Integer);
var
src_p, src_i, x : Integer;
begin
If dst_width = 0 Then Exit;
src_p := 0;
src_i := 256 * src_scanline_width div dst_width;
// frustrum culling
If dst_x + dst_width <= 0 Then Exit;
If dst_x >= dst_scanline_width Then Exit;
// clipping
If dst_x + dst_width >= dst_scanline_width Then
dst_width := dst_scanline_width - dst_x;
If dst_x < 0 Then
begin
inc (src_p, src_i * (-dst_x));
dst_x := 0;
end;
// blitting
For x := 0 To dst_width-1 do
begin
dst[dst_x + x] := src[src_p div 256] Or $FF000000;
inc (src_p, src_i);
end;
end;
procedure FillRGB32 (var dst; count : Cardinal); stdcall; assembler;
asm
push edi
push eax
push ecx
mov edi, dst
mov ecx, count
//mov eax, $FF00FF
sub eax, eax
rep stosd
pop ecx
pop eax
pop edi
end;
{
sl : start left
sr: start right
st: start top
sb: start bottom
el: end left
er: end right
et: end top
eb: end bottom
pgrap: pointer to bitmap
all relative to screen size
}
procedure TForm1.GenieFX(pbmp: pgrap;sl,sr,st,sb,el,er,et,eb:integer);
var
i,j,w1,w2,h: integer;
m1,m2:integer;
l,r:array [0..5000]of integer;
x,y,ya,y1,y2:real;
bmp,bmpout,buffer:tbitmap;
const
//STEP = 24; //to control speed
STEP = 1;
(*
BAAAAD WAY TO CONTROL SPEED!!! SHOULD SPECIFY DURATION IN SECONDS, INSTEAD
Regards,
~ Matonga
*)
var
al, at, ar, ab : Integer;
begin
//
al := Min (sl, el);
at := Min (st, et);
ar := Max (sr, er);
ab := Max (sb, eb);
//SetWindowPos (Handle, 0, al, at, ar-al, ab-at, SWP_NOZORDER Or SWP_NOACTIVATE);
Left := al;
Top := at;
Width := ar-al;
Height := ab-at;
dec (sl, al); dec (st, at); dec (sr, al); dec (sb, at);
dec (el, al); dec (et, at); dec (er, al); dec (eb, at);
//
y1:=0.047425873;//1-1/(1+exp(-3));
y2:=0.952574126;//1-1/(1+exp(3));
h:=(et-st);//total height
w1:=round(abs(sl-el)); //left width
w2:=round(abs(sr-er)); //right width
bmp:=tbitmap.Create;
bmp.Height:=h;
bmp.Width:=w1;
bmp.Canvas.StretchDraw(rect(0,0,w1,h),pbmp^);//image1.Picture.Graphic);
bmpout:=tbitmap.Create;
bmpout.Height:=sr-sl;
bmpout.Width:=w1;
bmpout.Canvas.StretchDraw(rect(0,0,w1,sr-sl),pbmp^);//image1.Picture.Graphic);
buffer:=tbitmap.Create;
//buffer.Height:=canvas.ClipRect.Bottom-canvas.ClipRect.Top;
//buffer.Width:=canvas.ClipRect.Right-canvas.ClipRect.Left;
buffer.Height := ab - at;
buffer.Width := ar - al;
//buffer.Canvas.Brush.Color:=clFuchsia;
//buffer.Canvas.FillRect(buffer.Canvas.ClipRect);
// Force all bitmaps to 32 bits
pbmp^.PixelFormat := pf32bit;
bmp.PixelFormat := pf32bit;
buffer.PixelFormat := pf32bit;
bmpout.PixelFormat := pf32bit;
//Animamos el encogido
m1:=sl;
m2:=sr;
while (abs(m1-el)>STEP) or (abs(m2-er)>STEP) do
begin
//limpiamos el buffer
{$IFDEF USE_STRETCHBLT}
buffer.Canvas.FillRect(buffer.Canvas.ClipRect);
{$ELSE}
For i := 0 To buffer.Height-1 do
FillRGB32 (buffer.Scanline[i]^, buffer.Width);
{$ENDIF}
for i:=0 to pbmp^.Height-1 do
begin
x:=i*6/h-3;//pbmp^.Height-3;
y:=1-1/(1+exp(x));
ya:=(y-y1)/(y2-y1);
if m1<el then
l[i]:=sl+round(ya*round(abs(m1-sl)))
else
l[i]:=sl-round(ya*round(abs(m1-sl)));
if m2<er then
r[i]:=sr+round(ya*round(abs(m2-sr)))
else
r[i]:=sr-round(ya*round(abs(m2-sr)));
//dibujamos linea por linea
{$IFDEF USE_STRETCHBLT}
StretchBlt(buffer.Canvas.Handle,
l[i],
st+i,
r[i]-l[i],1,
pbmp^.Canvas.Handle,0,i,pbmp^.Width,1,SRCCOPY);
{$ELSE}
If (st+i >= 0) And (st+i < buffer.Height) And
(i >= 0) And (i < pbmp^.Height) Then
LineBlit (pbmp^.Scanline[i], buffer.Scanline[st+i], pbmp^.Width, buffer.Width, l[i], r[i]-l[i]);
{$ENDIF}
end;
//canvas.CopyRect(clientrect,buffer.Canvas,clientrect);
LWSetImage (self, buffer);
Sleep (1);
//reducimos el tamanio
if abs(m1-el)>STEP then
begin
if m1>el then m1:=m1-STEP;
if m1<el then m1:=m1+STEP;
end
else
begin
if m1>el then m1:=m1-1;
if m1<el then m1:=m1+1;
end;
if abs(m2-er)>STEP then
begin
if m2>er then m2:=m2-STEP;
if m2<er then m2:=m2+STEP;
end
else
begin
if m2>er then m2:=m2-1;
if m2<er then m2:=m2+1;
end;
end;
{primero recolectamos la forma en un array}
for i:=0 to h-1 do
begin
x:=i*6/h-3;
y:=1-1/(1+exp(x));
ya:=(y-y1)/(y2-y1);
if sl<el then
l[h-i]:=el-round(ya*w1)
else
l[h-i]:=el+round(ya*w1);
if sr<er then
r[h-i]:=er-round(ya*w2)
else
r[h-i]:=er+round(ya*w2);
end;
{ahora dibujamos frames de bajada}
j:=h-1;
while j>=0 do
begin
j:=j-STEP;
//limpiamos el buffer
{$IFDEF USE_STRETCHBLT}
buffer.Canvas.FillRect(buffer.Canvas.ClipRect);
{$ELSE}
For i := 0 To buffer.Height-1 do
FillRGB32 (buffer.Scanline[i]^, buffer.Width);
{$ENDIF}
//dibujamos linea por linea
for i:=0 to j-1 do
begin
{$IFDEF USE_STRETCHBLT}
StretchBlt(buffer.Canvas.Handle,
l[i+h-j],st+i+h-j,r[i+h-j]-l[i+h-j],1,
bmp.Canvas.Handle,0,i,bmp.Width,1,SRCCOPY);
{$ELSE}
If (st+i+h-j >= 0) And (st+i+h-j < buffer.Height) And
(i >= 0) And (i < bmp.Height) Then
LineBlit (bmp.Scanline[i], buffer.Scanline[st+i+h-j], bmp.Width, buffer.Width, l[i+h-j], r[i+h-j]-l[i+h-j]);
{$ENDIF}
end;
//canvas.CopyRect(clientrect,buffer.Canvas,clientrect);
LWSetImage (self, buffer);
Sleep (1);
end;
bmpout.free;
buffer.Free;
bmp.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
(*
DoubleBuffered:=True;
//Application.ShowMainForm:=false;
ShowWindow(Handle, SW_HIDE);
SetWindowLong(Handle, GWL_EXSTYLE, getWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
ShowWindow(Handle, SW_SHOW);
BorderStyle:=bsNone;
//WindowState:=wsMaximized;
Height:=screen.Height;
Width:=screen.Width;
SetWindowLong(handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) Or WS_EX_LAYERED);
SetLayeredWindowAttributes(Handle,$0ff00ff, 0, ULW_COLORKEY);
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(handle, GWL_STYLE) And Not WS_BORDER);
*)
SetWindowLong(Handle, GWL_EXSTYLE, (getWindowLong(Handle, GWL_EXSTYLE) And Not WS_EX_APPWINDOW) or WS_EX_TOOLWINDOW);
LWSetupForm (self);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;
end.
Made a change in .dpr, I dunno if it's important:
(GenieFXLib.dpr)
library GenieFXLib;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,
Classes,
GenieFXsrc in 'GenieFXsrc.pas' {Form1},
WindowsEx in 'WindowsEx.pas',
Windows;
{$R *.res}
procedure GenieFX(pbmp: pgrap;sl,sr,st,sb,el,er,et,eb:integer);stdcall;
begin
Form1:=TForm1.Create(nil);
//Form1.show;
ShowWindow (Form1.Handle, SW_SHOW);
Form1.GenieFX(pbmp,sl,sr,st,sb,el,er,et,eb);
Form1.Close;
end;
exports
GenieFX;
begin
end.
The library still needs a lot of improvement, but at least it runs smooth now.
Edit
BTW I forgot to mention in last post:
Please don't pass a TBitmap!!! Even Delphi 5 is incompatible with that (I had to recompile both the .dll and the .exe demo to make them work together).
Use a pointer to bytes instead, or at least an HBITMAP handle (can get TBitmap.Handle, can then use pbmp := TBitmap.Create; pbmp.Handle := the_handle; ..... do all stuff ..... pbmp.ReleaseHandle; pbmp.Destroy; )
Edit
Didn't like the animation, so rewrote it from scratch. Plus now it uses duration (in milliseconds) instead of steps.
GenieFXSrc.pas:
{
GenieFXLib v0.1
Author: vhanla
This is a Genie Effect animation library sample
}
unit GenieFXsrc;
interface
uses
Windows, Messages, SysUtils, {Variants, }Classes, Graphics, Controls, Forms,
Dialogs, WindowsEx, Math, unitLayeredWindow;
type
pgrap=^TBitmap;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
procedure GenieFX(pbmp: pgrap;sl,sr,st,sb,el,er,et,eb:integer);
end;
type
(*
TRGB32 = packed record
B,G,R,A:byte;
end;
*)
TRGB32 = Cardinal;
TRGB32Array=packed array[0..MaxInt div sizeof(TRGB32)-1] of TRGB32;
PRGB32Array = ^TRGB32Array;
var
Form1: TForm1;
implementation
{$R *.dfm}
{-$DEFINE USE_STRETCHBLT}
// maybe faster than StretchBlt
(*
procedure ABlit (src, dst : Pointer; count, src_ini, src_inc : Cardinal); stdcall; assembler;
asm
push eax
push ebx
push ecx
push edx
push esi
push edi
mov esi, src
mov edi, dst
mov ecx, count
mov edx, src_ini
@loop:
mov ebx, edx
mov eax, [esi]
add edx, src_inc
or eax, $FF000000
shr ebx, 8
add esi, 4
shl ebx, 2
mov [edi+ebx], eax
inc edi
dec ecx
jnz @loop
pop edi
pop esi
pop edx
pop ecx
pop ebx
pop eax
end;
*)
procedure LineBlit (src, dst : PRGB32Array; src_scanline_width, dst_scanline_width, dst_x, dst_width : Integer);
var
src_p, src_i, x : Integer;
begin
If dst_width = 0 Then Exit;
src_p := 0;
src_i := 256 * src_scanline_width div dst_width;
// frustrum culling
If dst_x + dst_width <= 0 Then Exit;
If dst_x >= dst_scanline_width Then Exit;
// clipping
If dst_x + dst_width >= dst_scanline_width Then
dst_width := dst_scanline_width - dst_x;
If dst_x < 0 Then
begin
inc (src_p, src_i * (-dst_x));
dst_x := 0;
end;
// blitting
For x := 0 To dst_width-1 do
begin
dst[dst_x + x] := src[src_p div 256] Or $FF000000;
inc (src_p, src_i);
end;
//ABlit (src[0], dst[dst_x], dst_width, src_p, src_i);
//ABlit (src, dst, dst_width, 0, 256);
end;
procedure FillRGB32 (var dst; count : Cardinal); stdcall; assembler;
asm
push edi
push eax
push ecx
mov edi, dst
mov ecx, count
//mov eax, $FF00FF
sub eax, eax
rep stosd
pop ecx
pop eax
pop edi
end;
{
sl : start left
sr: start right
st: start top
sb: start bottom
el: end left
er: end right
et: end top
eb: end bottom
pgrap: pointer to bitmap
all relative to screen size
}
procedure TForm1.GenieFX(pbmp: pgrap;sl,sr,st,sb,el,er,et,eb:integer);
var
i,j,w1,w2,h: integer;
m1,m2:integer;
l,r:array [0..5000]of integer;
x,y,ya,y1,y2:real;
bmp,bmpout,buffer:tbitmap;
bl, br : array[0..5000] of Integer; // bordes
const
//STEP = 24; //to control speed
//STEP = 1;
DURATION = 1000; // animation duration in milliseconds
(*
BAAAAD WAY TO CONTROL SPEED!!! SHOULD SPECIFY DURATION IN SECONDS, INSTEAD
Regards,
~ Matonga
*)
var
al, at, ar, ab : Integer;
sk, ek : Double;
tick_s, tick_t : Cardinal;
t : Double;
y_ofs : Integer;
var
cbl, cbr : Integer;
begin
//
al := Min (sl, el);
at := Min (st, et);
ar := Max (sr, er);
ab := Max (sb, eb);
//SetWindowPos (Handle, 0, al, at, ar-al, ab-at, SWP_NOZORDER Or SWP_NOACTIVATE);
Left := al;
Top := at;
Width := ar-al;
Height := ab-at;
dec (sl, al); dec (st, at); dec (sr, al); dec (sb, at);
dec (el, al); dec (et, at); dec (er, al); dec (eb, at);
//
y1:=0.047425873;//1-1/(1+exp(-3));
y2:=0.952574126;//1-1/(1+exp(3));
h:=(et-st);//total height
w1:=round(abs(sl-el)); //left width
w2:=round(abs(sr-er)); //right width
bmp:=tbitmap.Create;
bmp.Height:=h;
bmp.Width:=w1;
bmp.Canvas.StretchDraw(rect(0,0,w1,h),pbmp^);//image1.Picture.Graphic);
bmpout:=tbitmap.Create;
bmpout.Height:=sr-sl;
bmpout.Width:=w1;
bmpout.Canvas.StretchDraw(rect(0,0,w1,sr-sl),pbmp^);//image1.Picture.Graphic);
buffer:=tbitmap.Create;
//buffer.Height:=canvas.ClipRect.Bottom-canvas.ClipRect.Top;
//buffer.Width:=canvas.ClipRect.Right-canvas.ClipRect.Left;
buffer.Height := ab - at;
buffer.Width := ar - al;
//buffer.Canvas.Brush.Color:=clFuchsia;
//buffer.Canvas.FillRect(buffer.Canvas.ClipRect);
// Force all bitmaps to 32 bits
pbmp^.PixelFormat := pf32bit;
bmp.PixelFormat := pf32bit;
buffer.PixelFormat := pf32bit;
bmpout.PixelFormat := pf32bit;
// Bordes... de otra manera. ~Matonga
For i := st To et do
begin
sk := -Cos((et - i) / (et - st) * PI)*0.5+0.5;
ek := 1.0 - sk;
bl[i] := Round(sl * sk + el * ek);
br[i] := Round(sr * sk + er * ek);
end;
//Animamos el encogido
(*
m1:=sl;
m2:=sr;
while (abs(m1-el)>STEP) or (abs(m2-er)>STEP) do
begin
//limpiamos el buffer
{$IFDEF USE_STRETCHBLT}
buffer.Canvas.FillRect(buffer.Canvas.ClipRect);
{$ELSE}
For i := 0 To buffer.Height-1 do
FillRGB32 (buffer.Scanline[i]^, buffer.Width);
{$ENDIF}
for i:=0 to pbmp^.Height-1 do
begin
x:=i*6/h-3;//pbmp^.Height-3;
y:=1-1/(1+exp(x));
ya:=(y-y1)/(y2-y1);
if m1<el then
l[i]:=sl+round(ya*round(abs(m1-sl)))
else
l[i]:=sl-round(ya*round(abs(m1-sl)));
if m2<er then
r[i]:=sr+round(ya*round(abs(m2-sr)))
else
r[i]:=sr-round(ya*round(abs(m2-sr)));
//dibujamos linea por linea
{$IFDEF USE_STRETCHBLT}
StretchBlt(buffer.Canvas.Handle,
l[i],
st+i,
r[i]-l[i],1,
pbmp^.Canvas.Handle,0,i,pbmp^.Width,1,SRCCOPY);
{$ELSE}
If (st+i >= 0) And (st+i < buffer.Height) And
(i >= 0) And (i < pbmp^.Height) Then
LineBlit (pbmp^.Scanline[i], buffer.Scanline[st+i], pbmp^.Width, buffer.Width, l[i], r[i]-l[i]);
{$ENDIF}
end;
//canvas.CopyRect(clientrect,buffer.Canvas,clientrect);
LWSetImage (self, buffer);
Application.ProcessMessages;
//reducimos el tamanio
if abs(m1-el)>STEP then
begin
if m1>el then m1:=m1-STEP;
if m1<el then m1:=m1+STEP;
end
else
begin
if m1>el then m1:=m1-1;
if m1<el then m1:=m1+1;
end;
if abs(m2-er)>STEP then
begin
if m2>er then m2:=m2-STEP;
if m2<er then m2:=m2+STEP;
end
else
begin
if m2>er then m2:=m2-1;
if m2<er then m2:=m2+1;
end;
end;
{primero recolectamos la forma en un array}
for i:=0 to h-1 do
begin
x:=i*6/h-3;
y:=1-1/(1+exp(x));
ya:=(y-y1)/(y2-y1);
if sl<el then
l[h-i]:=el-round(ya*w1)
else
l[h-i]:=el+round(ya*w1);
if sr<er then
r[h-i]:=er-round(ya*w2)
else
r[h-i]:=er+round(ya*w2);
end;
*)
tick_s := GetTickCount;
tick_t := DURATION div 4;
While True do
begin
t := (GetTickCount - tick_s) / tick_t;
If t > 1.0 Then Break;
For i := 0 To buffer.Height-1 do
FillRGB32 (buffer.Scanline[i]^, buffer.Width);
sk := Cos(t * PI)*0.5+0.5;
ek := 1.0 - sk;
For j := 0 To pbmp^.Height-1 do
begin
cbl := Round(sl * sk + bl[j+st] * ek);
cbr := Round(sr * sk + br[j+st] * ek);
If (st+j >= 0) And (st+j < buffer.Height) Then
begin
LineBlit (pbmp^.Scanline[j], buffer.Scanline[st+j], pbmp^.Width, buffer.Width, cbl, cbr-cbl);
end;
end;
LWSetImage (self, buffer);
end;
{ahora dibujamos frames de bajada}
(*
j:=h-1;
while j>=0 do
begin
j:=j-STEP;
//limpiamos el buffer
{$IFDEF USE_STRETCHBLT}
buffer.Canvas.FillRect(buffer.Canvas.ClipRect);
{$ELSE}
For i := 0 To buffer.Height-1 do
FillRGB32 (buffer.Scanline[i]^, buffer.Width);
{$ENDIF}
//dibujamos linea por linea
for i:=0 to j-1 do
begin
{$IFDEF USE_STRETCHBLT}
StretchBlt(buffer.Canvas.Handle,
l[i+h-j],st+i+h-j,r[i+h-j]-l[i+h-j],1,
bmp.Canvas.Handle,0,i,bmp.Width,1,SRCCOPY);
{$ELSE}
If (st+i+h-j >= 0) And (st+i+h-j < buffer.Height) And
(i >= 0) And (i < bmp.Height) Then
LineBlit (bmp.Scanline[i], buffer.Scanline[st+i+h-j], bmp.Width, buffer.Width, l[i+h-j], r[i+h-j]-l[i+h-j]);
{$ENDIF}
end;
//canvas.CopyRect(clientrect,buffer.Canvas,clientrect);
LWSetImage (self, buffer);
Application.ProcessMessages;
end;
*)
inc (tick_s, tick_t);
tick_t := DURATION *3 div 4;
While True do
begin
t := (GetTickCount - tick_s) / tick_t;
If t > 1.0 Then Break;
For i := 0 To buffer.Height-1 do
FillRGB32 (buffer.Scanline[i]^, buffer.Width);
y_ofs := st + Round((et-st)*t);
For j := 0 To pbmp^.Height-1 do
If (y_ofs+j >= st) And (y_ofs+j < et) And
(y_ofs+j >= 0) And (y_ofs+j < buffer.Height) Then
begin
LineBlit (pbmp^.Scanline[j], buffer.Scanline[y_ofs+j], pbmp^.Width, buffer.Width, bl[y_ofs+j], br[y_ofs+j]-bl[y_ofs+j]);
end;
LWSetImage (self, buffer);
end;
bmpout.free;
buffer.Free;
bmp.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
(*
DoubleBuffered:=True;
//Application.ShowMainForm:=false;
ShowWindow(Handle, SW_HIDE);
SetWindowLong(Handle, GWL_EXSTYLE, getWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
ShowWindow(Handle, SW_SHOW);
BorderStyle:=bsNone;
//WindowState:=wsMaximized;
Height:=screen.Height;
Width:=screen.Width;
SetWindowLong(handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) Or WS_EX_LAYERED);
SetLayeredWindowAttributes(Handle,$0ff00ff, 0, ULW_COLORKEY);
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(handle, GWL_STYLE) And Not WS_BORDER);
*)
SetWindowLong(Handle, GWL_EXSTYLE, (getWindowLong(Handle, GWL_EXSTYLE) And Not WS_EX_APPWINDOW) or WS_EX_TOOLWINDOW);
LWSetupForm (self);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;
end.
Edit
ABlit routine was not working, but now I found mistake, here is corrected version:
procedure ABlit (src, dst : Pointer; count, src_ini, src_inc : Cardinal); stdcall; assembler;
asm
push eax
push ebx
push ecx
push edx
push esi
push edi
mov esi, src
mov edi, dst
mov ecx, count
mov edx, src_ini
@loop:
mov ebx, edx
shr ebx, 8
add edx, src_inc
mov eax, [esi+ebx*4]
or eax, $FF000000
mov [edi], eax
dec ecx
lea edi, [edi+4]
jnz @loop
pop edi
pop esi
pop edx
pop ecx
pop ebx
pop eax
end;
procedure LineBlit (src, dst : PRGB32Array; src_scanline_width, dst_scanline_width, dst_x, dst_width : Integer);
var
src_p, src_i{, x} : Integer;
begin
If dst_width = 0 Then Exit;
src_p := 0;
src_i := 256 * src_scanline_width div dst_width;
// frustrum culling
If dst_x + dst_width <= 0 Then Exit;
If dst_x >= dst_scanline_width Then Exit;
// clipping
If dst_x + dst_width >= dst_scanline_width Then
dst_width := dst_scanline_width - dst_x;
If dst_x < 0 Then
begin
inc (src_p, src_i * (-dst_x));
dst_x := 0;
end;
// blitting
(*For x := 0 To dst_width-1 do
begin
dst[dst_x + x] := src[src_p div 256] Or $FF000000;
inc (src_p, src_i);
end;*)
ABlit (src, Pointer(Integer(dst)+dst_x*4), dst_width, src_p, src_i);
//ABlit (src, dst, dst_width, 0, 256);
end;
I think it can be made even faster, somehow...
Edit
Ok, maybe faster: (should do a benchmark)
procedure ABlit (src, dst : Pointer; count, src_ini, src_inc : Cardinal); stdcall; assembler;
asm
push eax
push ebx
push ecx
push edx
push esi
push edi
mov esi, src
mov edi, dst
mov ecx, count
mov edx, src_inc
ror edx, 16
mov src_inc, edx
mov edx, src_ini
ror edx, 16
sub ebx, ebx
@loop:
mov bx, dx
add edx, src_inc
mov eax, [esi+ebx*4]
adc edx, 0
or eax, $FF000000
mov [edi], eax
dec ecx
lea edi, [edi+4]
jnz @loop
pop edi
pop esi
pop edx
pop ecx
pop ebx
pop eax
end;
procedure LineBlit (src, dst : PRGB32Array; src_scanline_width, dst_scanline_width, dst_x, dst_width : Integer);
var
src_p, src_i : Integer;
begin
If dst_width = 0 Then Exit;
src_p := 0;
src_i := 65536 * src_scanline_width div dst_width;
// frustrum culling
If dst_x + dst_width <= 0 Then Exit;
If dst_x >= dst_scanline_width Then Exit;
// clipping
If dst_x + dst_width >= dst_scanline_width Then
dst_width := dst_scanline_width - dst_x;
If dst_x < 0 Then
begin
inc (src_p, src_i * (-dst_x));
dst_x := 0;
end;
// blitting
ABlit (src, Pointer(Integer(dst)+dst_x*4), dst_width, src_p, src_i);
end;
Edit
Ok, made a lot of code cleanup and uploaded at File2Go:
http://www.file2go.net/view/7d6b30cdea
Edit
Forgot to mention: the version I uploaded to File2Go uses HBITMAP instead of ^TBitmap. This is *a lot* more compatible with other programming languages and other versions of Delphi.