AVImake: Delphi Version

{*****************************************************************************
*                                                                            *
*  AVImake.dpr                                                               *
*  AVImakeU.pas                                                              *
*                                                                            *
*  This program creates an AVI file from an FLI or FLC file.                 *
*                                                                            *
*****************************************************************************}
unit AVImakeU;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, FGWin, Menus;
type
  TForm1 = class(TForm)
    MainMenu: TMainMenu;
    Convert: TMenuItem;
    Exit1: TMenuItem;
    OpenDialog: TOpenDialog;
    procedure AppOnActivate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ConvertClick(Sender: TObject);
    procedure ExitClick(Sender: TObject);
  end;
var
  Form1: TForm1;
implementation
{$R *.DFM}
var
  dc : hDC;
  hPal : hPalette;
  hVB : integer;
  cxClient, cyClient : integer;
  cxBuffer, cyBuffer : integer;
{*****************************************************************************
*                                                                            *
*  SwitchBuffers()                                                           *
*                                                                            *
*  Close the and release the virtual buffers for the current image, then     *
*  create and open new virtual buffers for the new image file.               *
*                                                                            *
*****************************************************************************}
procedure SwitchBuffers;
begin
  fg_vbclose;
  fg_vbfree(hVB);
  hVB := fg_vballoc(cxBuffer,cyBuffer);
  fg_vbopen(hVB);
  fg_vbcolors;
end;
{****************************************************************************}
procedure TForm1.AppOnActivate(Sender: TObject);
begin
  fg_realize(hPal);
  Invalidate;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
  fg_realize(hPal);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  dc := GetDC(Form1.Handle);
  fg_setdc(dc);
  hPal := fg_defpal;
  fg_realize(hPal);
  fg_vbinit;
  cxBuffer := 32;
  cyBuffer := 32;
  hVB := fg_vballoc(cxBuffer,cyBuffer);
  fg_vbopen(hVB);
  fg_vbcolors;
  fg_setcolor(-1);
  fg_fillpage;
  Application.OnActivate := AppOnActivate;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
  fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
  cxClient := ClientWidth;
  cyClient := ClientHeight;
  Invalidate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  fg_vbclose;
  fg_vbfree(hVB);
  fg_vbfin;
  DeleteObject(hPal);
  ReleaseDC(Form1.Handle,dc);
end;
procedure TForm1.ConvertClick(Sender: TObject);
var
  ContextFlic : array [1..16] of byte;
  ContextAVI  : array [1..24] of byte;
  FileHeader : array [1..128] of byte;
  FileName : string;
  mbString : string;
  Bitmap : pointer;
begin
  { open the flic file to convert }
  OpenDialog.DefaultExt := 'fli';
  OpenDialog.FileName := '';
  OpenDialog.Filter := 'flic files (*.fli,*.flc)|*.FLI;*.FLC';
  OpenDialog.Options := [ofReadOnly];
  if (OpenDialog.Execute = False) then Exit;
  FileName := OpenDialog.FileName;
  { make sure it really is a flic file, and if so, open it }
  if (fg_flichead(FileName,FileHeader) < 0) then
  begin
    mbString := FileName + chr(13) + 'is not an FLI or FLC file.';
    MessageDlg(mbString,mtError,[mbOK],0);
    Exit;
  end;
  fg_flicsize(FileHeader,cxBuffer,cyBuffer);
  SwitchBuffers;
  fg_flicopen(FileName,ContextFlic);
  { display the first flic frame }
  fg_flicplay(ContextFlic,1,FG_NODELAY);
  fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
  { create an empty AVI file with the same name as the flic file,
    but with an .avi extension }
  FileName := ChangeFileExt(FileName,'.avi');
  if (fg_avimake(FileName,ContextAVI,-1,cxBuffer,cyBuffer,8,10000,30) < 0) then
  begin
    mbString := 'Cannot create AVI file' + chr(13) + FileName;
    MessageDlg(mbString,mtError,[mbOK],0);
    Exit;
  end;
  { create a 256-color bitmap whose size is equal to the flic resolution }
  GetMem(Bitmap,fg_imagesiz(cxBuffer,cyBuffer));
  { create the AVI file frame by frame }
  Cursor := crHourGlass;
  fg_move(0,cyBuffer-1);
  repeat
  begin
    fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
    fg_getimage(Bitmap^,cxBuffer,cyBuffer);
    fg_aviframe(ContextAVI,Bitmap^);
  end
  until (fg_flicplay(ContextFlic,1,FG_NODELAY) = 0);
  Cursor := crDefault;
  { close the flic and AVI files, and release the bitmap memory }
  fg_flicdone(ContextFlic);
  fg_avidone(ContextAVI);
  FreeMem(Bitmap,fg_imagesiz(cxBuffer,cyBuffer));
end;
procedure TForm1.ExitClick(Sender: TObject);
begin
  Close;
end;
end.