[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]
{
Hi, This is an easy made screensaver, viewing FLI files from
Autodesk animator, it's not optimized for reading FLC files, since
that would be a larger project, which i dont have enough spare-time
for now!
The "Treatframe" and "Getclock" routine was taken from Eirik Pedersens
fli player, found in snipet: "misc". I had to change Treatframe a litle
just to handle the palette. Use at your own risk.
There's not much documentation, but if there's so much you don't understand,
send me a mail, and i'll try to answer it as soon as possible!
Tommy Andersen
email: tommy.andersen@dialogue.telemax.no
snail: Tommy Andersen
Andebuveien 11
3170 SEM
Norway
}
Program Fliplay;
Uses
Forms,
Unit1 in 'UNIT1.PAS' {Form1};
{$R *.RES}
Begin
{ Prevent multiple instances }
IF HPrevinst <> 0 Then Exit;
Application.CreateForm(TForm1, Form1);
Application.Run;
End.
{ ------------- Cut out and save as UNIT1.PAS ----------------- }
Unit Unit1;
Interface
Uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs;
Const
CLOCK_HZ = 4608; { Frequency of clock }
MONItoR_HZ = 70; { Frequency of monitor }
CLOCK_SCALE = CLOCK_HZ div MONItoR_HZ;
CDATA = $040; { Port number of timer 0 }
CMODE = $043; { Port number of timers control Word }
Scale_FLI = False; { Set this to true if saver shall use whole screen }
Type
Big_Buffer_Type = Array[0..65534] of Byte;
FliHeaderType = Record
Size : Longint;
Magic : Word;
Frames : Word;
Width : Word;
Height : Word;
Bitsperpixel : Word;
Flags : Integer;
Speed : Integer;
Nexthead : Longint;
Framesintable : Longint;
hfile : Integer;
hframe1offset : Longint;
Strokes : Longint;
Session : Longint;
Reserved : Array [1..88] of Byte;
End;
FrameHeaderType = Record
Size : LongInt;
Magic : Word; { $F1FA }
Chunks : Word;
Expand : Array[1..8] of Byte;
End;
TForm1 = Class(TForm)
OpenDialog1: TOpenDialog;
Procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
Private
{ Private declarations }
Public
{ Public declarations }
Start_Screensaver : Boolean;
MouseMovement : Byte;
Fli_Filename : String;
Screensaver_Ini_filename : String;
ScreenBitmap : TBitmap;
Flifilestream : TMemoryStream;
FliScreenstream : TMemoryStream;
Screen_Buffer : ^Big_Buffer_Type;
File_Buffer : ^Big_Buffer_Type;
FLI_Header : FLIHeaderType;
FLI_FrameHeader : FrameHeaderType;
FLI_Speed : Longint;
FLI_Nexttime : Longint;
Fli_FrameNr : Word;
FLI_SecondPosition : Longint;
Procedure Get_INI_Filename;
Procedure Read_INI_Settings;
Procedure Write_INI_Settings;
Procedure Create_Bitmap;
Procedure Show_Next_Frame;
Procedure Load_FLI_File;
Procedure Kill_FLI_Screensaver;
End;
Var
Form1: TForm1;
Implementation
{$R *.DFM}
Uses Inifiles;
Function GetClock:LongInt; Assembler; {Taken from the FLILIB source}
{ this routine returns a clock With occassional spikes where time
will look like its running backwards 1/18th of a second. The resolution
of the clock is 1/(18*256) = 1/4608 second. 66 ticks of this clock
are supposed to be equal to a monitor 1/70 second tick.}
Asm
mov ah,0 { get tick count from Dos and use For hi 3 Bytes }
int 01ah { lo order count in DX, hi order in CX }
mov ah,dl
mov dl,dh
mov dh,cl
mov al,0 { read lo Byte straight from timer chip }
out CMODE,al { latch count }
mov al,1
out CMODE,al { set up to read count }
in al,CDATA { read in lo Byte (and discard) }
in al,CDATA { hi Byte into al }
neg al { make it so counting up instead of down }
End;
Procedure TForm1.Get_INI_Filename;
Var
Buffer : Array[0..255] of Char;
Size : Word;
Begin
Size := GetSystemDirectory(Buffer, 256);
IF Size <> 0 Then
Begin
Screensaver_Ini_filename := StrPas(Buffer);
Screensaver_Ini_filename[0] := Chr(Size);
End
Else Screensaver_Ini_filename := 'C:\';
{ Make sure filename got the last expected slash }
IF Screensaver_Ini_filename[Length(Screensaver_Ini_filename)] <> '\' Then
Screensaver_Ini_filename := Screensaver_Ini_filename + '\';
Screensaver_Ini_filename := Screensaver_Ini_filename + 'FLIPLAY.INI';
End;
Procedure TForm1.Write_INI_Settings;
Var
Inifile : TInifile;
Begin
Inifile := TInifile.Create(Screensaver_Ini_filename);
Inifile.WriteString('FLI-Screensaver', 'Filename', Fli_Filename);
Inifile.Free;
End;
Procedure TForm1.Read_INI_Settings;
Var
Inifile : TInifile;
Begin
Inifile := TInifile.Create(Screensaver_Ini_filename);
Fli_Filename := Inifile.ReadString('FLI-Screensaver', 'Filename', '');
Inifile.Free;
End;
Procedure TForm1.Load_FLI_File;
Var
Temp : Word;
Begin
Fli_FrameNr := 0;
FliFileStream.Clear;
IF FileExists(Fli_Filename) Then
Begin
Try
FliFileStream.LoadFromFile(Fli_Filename);
Except
FliFileStream.Clear;
End;
IF (FliFileStream.Size > 128) Then
Begin
FliFileStream.Seek(0, 0);
Temp := FliFileStream.Read(Fli_Header, 128);
IF (Temp = 128) and (Fli_Header.Magic = $AF11) Then
Begin
{ Ok }
FLI_Speed := Fli_Header.Speed;
FLI_Speed := FLI_Speed*CLOCK_SCALE;
FLI_NextTime := 0;
End
Else FliFileStream.Clear;
End;
End;
End;
Procedure TForm1.Create_Bitmap;
Type
BitmapHeader = Record
ID : Word;
FSize : LongInt;
Ver : LongInt;
Image : LongInt;
Misc : LongInt;
Width : LongInt;
Height: LongInt;
Num : Word;
Bits : Word;
Comp : LongInt;
ISize : LongInt;
XRes : LongInt;
YRes : LongInt;
PSize : LongInt;
Res : LongInt;
End;
Var
BmpHeader : BitmapHeader;
T, myByte : Byte;
MSize : LongInt;
Begin
FLIScreenStream.Clear;
MSize := 64000;
MSize := MSize + 1024;
MSize := MSize + 54;
BmpHeader.ID := 19778;
BmpHeader.FSize := MSize;
BmpHeader.Ver := 0;
BmpHeader.Image := 54 + (256*4);
BmpHeader.Misc := 40;
BmpHeader.Width := 320;
BmpHeader.Height := 200;
BmpHeader.Num := 1;
BmpHeader.Bits := 8;
BmpHeader.Comp := bi_RGB;
BmpHeader.ISize := BmpHeader.FSize - BmpHeader.Image;
BmpHeader.XRes := 0;
BmpHeader.YRes := 0;
BmpHeader.Res := 0;
FLIScreenStream.Write(BmpHeader.ID, 2);
FLIScreenStream.Write(BmpHeader.FSize, 4);
FLIScreenStream.Write(BmpHeader.Ver, 4);
FLIScreenStream.Write(BmpHeader.Image, 4);
FLIScreenStream.Write(BmpHeader.Misc, 4);
FLIScreenStream.Write(BmpHeader.Width, 4);
FLIScreenStream.Write(BmpHeader.Height, 4);
FLIScreenStream.Write(BmpHeader.Num, 2);
FLIScreenStream.Write(BmpHeader.Bits, 2);
FLIScreenStream.Write(BmpHeader.Comp, 4);
FLIScreenStream.Write(BmpHeader.ISize, 4);
FLIScreenStream.Write(BmpHeader.XRes, 4);
FLIScreenStream.Write(BmpHeader.YRes, 4);
FLIScreenStream.Write(BmpHeader.Res, 4);
FLIScreenStream.Seek(54, 0);
{ Create palette }
For T := 0 To 255 do
Begin
{ Blue }
myByte := T;
FLIScreenStream.Write(myByte, 1);
{ Green }
FLIScreenStream.Write(myByte, 1);
{ Red }
FLIScreenStream.Write(myByte, 1);
myByte := 0;
FLIScreenStream.Write(myByte, 1);
End;
FillChar(Screen_Buffer^, 64000, 0);
FLIScreenStream.Write(Screen_Buffer^, 64000);
End;
Procedure TForm1.Kill_FLI_Screensaver;
Begin
Freemem(Screen_Buffer, 64000);
Freemem(File_Buffer, 65535);
Flifilestream.Free;
FliScreenstream.Free;
ScreenBitmap.Free;
Halt(0);
End;
Procedure TForm1.FormCreate(Sender: TObject);
Var
Param : String;
S : String;
Begin
Flifilestream := TMemoryStream.Create;
FliScreenstream := TMemoryStream.Create;
ScreenBitmap := TBitmap.Create;
Param := Uppercase( Paramstr(1) );
Caption := 'FLI screensaver, made by Tommy Andersen!';
Application.Title := Caption;
Getmem(Screen_Buffer, 64000);
Getmem(File_Buffer, 65535);
Get_INI_Filename;
Read_INI_Settings;
{ Config screensaver? }
IF Param = '/C' Then
Begin
{ Yes }
Start_Screensaver := False;
Windowstate := wsMinimized;
S := '';
Param := FLI_Filename;
While Pos('\', Param) > 0 do
Begin
S := S + Copy(Param, 1, Pos('\', Param));
Delete(Param, 1, Pos('\', Param));
End;
Opendialog1.Initialdir := S;
Opendialog1.Filename := Param;
Opendialog1.Filter := 'FLI files|*.FLI|All files|*.*';
IF Opendialog1.Execute Then
Begin
FLI_Filename := Opendialog1.Filename;
Write_INI_Settings;
End;
Kill_FLI_Screensaver;
End
Else
Begin
{ No! Start screensaver! }
Create_Bitmap;
Load_FLI_File;
Start_Screensaver := True;
Windowstate := wsMaximized;
{
Formstyle := fsStayOnTop;
}
Borderstyle := bsNone;
Color := clBlack;
MouseMovement := 0;
End;
End;
Procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y : Integer);
Begin
IF MouseMovement > 2 Then Kill_FLI_Screensaver;
Inc(MouseMovement);
End;
Procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
Begin
Kill_FLI_Screensaver;
End;
Procedure TForm1.Show_Next_Frame;
Type
Paltype = Array[0..767] of Byte;
Var
Temp : Word;
Nextpos : Longint;
Palette : ^Paltype;
Paladdr : Word;
Procedure TreatFrame(Var Buffer, ScreenBuffer, Palette; Chunks:Word); Assembler;
{ this is the 'workhorse' routine that takes a frame and put it on the screen }
{ chunk by chunk }
Label
Color_Loop, Copy_Bytes, Copy_Bytes2, Exit, Fli_Black, Fli_Brun, Fli_Color,
Fli_Copy, Fli_Lc, Fli_Loop, Jump_Over, Line_Loop, Line_Loop2, Next_Line,
Next_Line2, Pack_Loop, Pack_Loop2, C_Loop;
Asm
Cli
push ds
lds si,Buffer { let DS:SI point at the frame to be drawn }
Fli_Loop: { main loop that goes through all the chunks in a frame }
cmp Chunks,0 { are there any more chunks to draw? }
je Exit
dec Chunks { decrement Chunks For the chunk to process now }
mov ax,[Word ptr ds:si+4] { let AX have the ChunkType }
add si,6 { skip the ChunkHeader }
cmp ax,0Bh { is it a FLI_COLor chunk? }
je Fli_Color
cmp ax,0Ch { is it a FLI_LC chunk? }
je Fli_Lc
cmp ax,0Dh { is it a FLI_BLACK chunk? }
je Fli_Black
cmp ax,0Fh { is it a FLI_BRUN chunk? }
je Fli_Brun
cmp ax,10h { is it a FLI_COPY chunk? }
je Fli_Copy
jmp Fli_Loop { This command should not be necessary since the Program should make one - }
{ - of the other jumps }
Fli_Color:
mov bx,[Word ptr ds:si] { number of packets in this chunk (allways 1?) }
add si,2 { skip the NumberofPackets }
mov al,0 { start at color 0 }
xor cx,cx { reset CX }
Color_Loop:
or bx,bx { set flags }
jz Fli_Loop { Exit if no more packages }
dec bx { decrement NumberofPackages For the package to process now }
mov cl,[Byte ptr ds:si+0] { first Byte in packet tells how many colors to skip }
add al,cl { add the skiped colors to the start to get the new start }
mov cl,[Byte ptr ds:si+1] { next Byte in packet tells how many colors to change }
or cl,cl { set the flags }
jnz Jump_Over { if NumberstoChange=0 then NumberstoChange=256 }
inc ch { CH=1 and CL=0 => CX=256 }
Jump_Over:
add al,cl { update the color to start at }
mov di,cx { since each color is made of 3 Bytes (Red, Green & Blue) we have to - }
shl cx,1 { - multiply CX (the data counter) With 3 }
add cx,di { - CX = old_CX shl 1 + old_CX (the fastest way to multiply With 3) }
add si,2 { skip the NumberstoSkip and NumberstoChange Bytes }
{ Find start position }
Les di, Palette
Mov CL, AL
@LLL:
Cmp CL, 0
Je C_Loop
Dec CL
Add di, 3
Jmp @LLL
C_Loop:
Cmp CX, 0
Je Color_Loop
Dec CX
Mov AL, [Byte ptr DS:SI]
Add AL, AL
Add AL, AL
Mov [Byte ptr ES:DI], AL
Inc SI
Inc DI
Jmp C_Loop
Fli_Lc:
Les di, ScreenBuffer
mov di,[Word ptr ds:si+0] { put LinestoSkip into DI - }
mov ax,di { - to get the offset address to this line we have to multiply With 320 - }
shl ax,8 { - DI = old_DI shl 8 + old_DI shl 6 - }
shl di,6 { - it is the same as DI = old_DI*256 + old_DI*64 = old_DI*320 - }
add di,ax { - but this way is faster than a plain mul }
mov bx,[Word ptr ds:si+2] { put LinestoChange into BX }
add si,4 { skip the LinestoSkip and LinestoChange Words }
xor cx,cx { reset cx }
Line_Loop:
or bx,bx { set flags }
jz Fli_Loop { Exit if no more lines to change }
dec bx
mov dl,[Byte ptr ds:si] { put PacketsInLine into DL }
inc si { skip the PacketsInLine Byte }
push di { save the offset address of this line }
Pack_Loop:
or dl,dl { set flags }
jz Next_Line { Exit if no more packets in this line }
dec dl
mov cl,[Byte ptr ds:si+0] { put BytestoSkip into CL }
add di,cx { update the offset address }
mov cl,[Byte ptr ds:si+1] { put BytesofDatatoCome into CL }
or cl,cl { set flags }
jns Copy_Bytes { no SIGN means that CL number of data is to come - }
{ - else the next data should be put -CL number of times }
mov al,[Byte ptr ds:si+2] { put the Byte to be Repeated into AL }
add si,3 { skip the packet }
neg cl { Repeat -CL times }
rep stosb
jmp Pack_Loop { finish With this packet }
Copy_Bytes:
add si,2 { skip the two count Bytes at the start of the packet }
rep movsb
jmp Pack_Loop { finish With this packet }
Next_Line:
pop di { restore the old offset address of the current line }
add di,320 { offset address to the next line }
jmp Line_Loop
Fli_Black:
Les di, ScreenBuffer
xor di,di
mov cx,32000 { number of Words in a screen }
xor ax,ax { color 0 is to be put on the screen }
rep stosw
jmp Fli_Loop { jump back to main loop }
Fli_Brun:
Les di, ScreenBuffer
xor di,di
mov bx,200 { numbers of lines in a screen }
xor cx,cx
Line_Loop2:
mov dl,[Byte ptr ds:si] { put PacketsInLine into DL }
inc si { skip the PacketsInLine Byte }
push di { save the offset address of this line }
Pack_Loop2:
or dl,dl { set flags }
jz Next_Line2 { Exit if no more packets in this line }
dec dl
mov cl,[Byte ptr ds:si] { put BytesofDatatoCome into CL }
or cl,cl { set flags }
js Copy_Bytes2 { SIGN meens that CL number of data is to come - }
{ - else the next data should be put -CL number of times }
mov al,[Byte ptr ds:si+1] { put the Byte to be Repeated into AL }
add si,2 { skip the packet }
rep stosb
jmp Pack_Loop2 { finish With this packet }
Copy_Bytes2:
inc si { skip the count Byte at the start of the packet }
neg cl { Repeat -CL times }
rep movsb
jmp Pack_Loop2 { finish With this packet }
Next_Line2:
pop di { restore the old offset address of the current line }
add di,320 { offset address to the next line }
dec bx { any more lines to draw? }
jnz Line_Loop2
jmp Fli_Loop { jump back to main loop }
Fli_Copy:
Les di, ScreenBuffer
xor di,di
mov cx,32000 { number of Words in a screen }
rep movsw
jmp Fli_Loop { jump back to main loop }
Exit:
mov ax, 0
mov es, ax
pop ds
Sti
end;
Procedure ReadPalette;
Var
T, Zero : Byte;
Begin
FLIScreenstream.Seek(54, 0);
For T := 0 to 255 do
Begin
FLIScreenStream.Read(Palette^[T*3+2], 1); { Blue }
FLIScreenStream.Read(Palette^[T*3+1], 1); { Green }
FLIScreenStream.Read(Palette^[T*3], 1); { Red }
FLIScreenStream.Read(Zero, 1); { Zero }
End;
End;
Procedure WritePalette;
Var
T, Zero : Byte;
Begin
Zero := 0;
FLIScreenStream.Seek(54, 0);
For T := 0 to 255 do
Begin
FLIScreenStream.Write(Palette^[T*3+2], 1); { Blue }
FLIScreenStream.Write(Palette^[T*3+1], 1); { Green }
FLIScreenStream.Write(Palette^[T*3], 1); { Red }
FLIScreenStream.Write(Zero, 1); { Zero }
End;
End;
Procedure Write_To_Screen;
Var
Y : Word;
Begin
FLIScreenStream.Seek(1078, 0);
For Y := 199 downto 0 do
Begin
FLIScreenStream.Write(Screen_Buffer^[Y*320], 320);
End;
End;
Begin
IF GetClock < FLI_Nexttime Then Exit;
IF (FliFileStream.Size > 128) Then
Begin
FillChar(FLI_FrameHeader, 16, 0);
FliFileStream.Read(FLI_FrameHeader.Size, 4);
FliFileStream.Read(FLI_FrameHeader.Magic, 2);
FliFileStream.Read(FLI_FrameHeader.Chunks, 2);
FliFileStream.Read(FLI_FrameHeader.Expand, 8);
IF (FLI_FrameHeader.Magic = $F1FA) Then
Begin
FLI_FrameHeader.Size := FLI_FrameHeader.Size - 16;
FliFileStream.Read(File_Buffer^, FLI_FrameHeader.Size);
Getmem(Palette, 768);
Paladdr := Seg(Palette^);
ReadPalette;
TreatFrame(File_Buffer^, Screen_Buffer^, Palette^, FLI_FrameHeader.Chunks);
WritePalette;
Freemem(Palette, 768);
Write_To_Screen;
IF FLI_FrameNr = 0 Then
Begin
FLI_SecondPosition := FliFileStream.Position;
End;
Inc(Fli_FrameNr);
IF Fli_FrameNr > FLI_Header.Frames Then
Begin
FliFileStream.Seek(FLI_SecondPosition, 0);
Fli_FrameNr := 1;
End;
FLI_NextTime := GetClock + FLI_Speed;
End;
End;
End;
Procedure TForm1.FormPaint(Sender: TObject);
Begin
IF not Start_Screensaver Then Exit;
Start_Screensaver := False;
While True do
Begin
Show_Next_Frame;
FLIScreenStream.Seek(0, 0);
Try
ScreenBitmap.LoadFromStream(FLIScreenStream);
Except
End;
IF not Scale_FLI Then Canvas.Draw((Screen.Width div 2) - 160, (Screen.Height div 2) - 100, ScreenBitmap)
Else Canvas.StretchDraw(ClientRect, ScreenBitmap);
Application.ProcessMessages;
End;
End;
End.
{ ------------- Cut out and save as UNIT1.DFM ----------------- }
object Form1: TForm1
Left = 216
Top = 168
Width = 435
Height = 300
Caption = 'Form1'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
PixelsPerInch = 96
OnCreate = FormCreate
OnKeyDown = FormKeyDown
OnMouseMove = FormMouseMove
OnPaint = FormPaint
TextHeight = 16
object OpenDialog1: TOpenDialog
Left = 4
Top = 4
end
end
[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]