Image: Delphi Version

{*****************************************************************************
*                                                                            *
*  Image.dpr                                                                 *
*  ImageU.pas                                                                *
*                                                                            *
*  This program demonstrates the Fastgraph for Windows image file display    *
*  and creation functions.                                                   *
*                                                                            *
*****************************************************************************}
unit ImageU;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, CommDlg, Menus, FGWin;
type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    BMP: TMenuItem;
    BMPOpen: TMenuItem;
    BMPMake: TMenuItem;
    BMPDetails: TMenuItem;
    PCX: TMenuItem;
    PCXOpen: TMenuItem;
    PCXMake: TMenuItem;
    PCXDetails: TMenuItem;
    JPEG: TMenuItem;
    JPEGOpen: TMenuItem;
    JPEGDetails: TMenuItem;
    Flic: TMenuItem;
    FlicOpen: TMenuItem;
    FlicPlay: TMenuItem;
    FlicFrame: TMenuItem;
    FlicReset: TMenuItem;
    FlicDetails: TMenuItem;
    Exit1: TMenuItem;
    AVI: TMenuItem;
    AVIOpen: TMenuItem;
    AVIPlay: TMenuItem;
    AVIFrame: TMenuItem;
    AVIReset: TMenuItem;
    AVIDetails: TMenuItem;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    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 BMPOpenClick(Sender: TObject);
    procedure BMPMakeClick(Sender: TObject);
    procedure BMPDetailsClick(Sender: TObject);
    procedure PCXOpenClick(Sender: TObject);
    procedure PCXMakeClick(Sender: TObject);
    procedure PCXDetailsClick(Sender: TObject);
    procedure JPEGOpenClick(Sender: TObject);
    procedure JPEGDetailsClick(Sender: TObject);
    procedure FlicOpenClick(Sender: TObject);
    procedure FlicPlayClick(Sender: TObject);
    procedure FlicFrameClick(Sender: TObject);
    procedure FlicResetClick(Sender: TObject);
    procedure FlicDetailsClick(Sender: TObject);
    procedure AVIOpenClick(Sender: TObject);
    procedure AVIPlayClick(Sender: TObject);
    procedure AVIFrameClick(Sender: TObject);
    procedure AVIResetClick(Sender: TObject);
    procedure AVIDetailsClick(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;
  nColors : integer;
  FileHeader : array [0..127] of byte;
  FileName   : string;
  mbString   : string;
  Context : array [1..48] of byte;
  nFrames : integer;
{*****************************************************************************
*                                                                            *
*  CloseContext()                                                            *
*                                                                            *
*  Closes the active flic or AVI context. This function is called from       *
*  SwitchBuffers() and also from the FormDestroy handler.                    *
*                                                                            *
*****************************************************************************}
procedure CloseContext;
begin
  if Form1.FlicDetails.Enabled then
    fg_flicdone(Context)
  else if Form1.AVIDetails.Enabled then
    fg_avidone(Context);
end;
{*****************************************************************************
*                                                                            *
*  SwitchBuffers()                                                           *
*                                                                            *
*  Close the and release the active virtual buffer, then create and open a   *
*  new virtual buffer to hold the new image file.                            *
*                                                                            *
*****************************************************************************}
procedure SwitchBuffers;
begin
  CloseContext;
  fg_vbclose;
  fg_vbfree(hVB);
  if (nColors = 0) then
    fg_vbdepth(24)
  else
    fg_vbdepth(8);
  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
  CloseContext;
  fg_vbclose;
  fg_vbfree(hVB);
  fg_vbfin;
  DeleteObject(hPal);
  ReleaseDC(Form1.Handle,dc);
end;
{*****************************************************************************
*                                                                            *
*  Event handlers for the items on the BMP menu.                             *
*                                                                            *
*****************************************************************************}
procedure TForm1.BMPOpenClick(Sender: TObject);
begin
  OpenDialog.DefaultExt := 'bmp';
  OpenDialog.FileName := '';
  OpenDialog.Filter := 'BMP files (*.bmp)|*.BMP';
  OpenDialog.Options := [ofReadOnly];
  if (OpenDialog.Execute = False) then Exit;
  FileName := OpenDialog.FileName;
  if (fg_bmphead(FileName,FileHeader) < 0) then
  begin
    mbString := FileName + chr(13) + 'is not a BMP file.';
    MessageDlg(mbString,mtError,[mbOK],0);
    Exit;
  end;
  FileName := OpenDialog.FileName;
  nColors := fg_bmppal(FileName,nil^);
  Cursor := crHourGlass;
  fg_bmpsize(FileHeader,cxBuffer,cyBuffer);
  SwitchBuffers;
  fg_showbmp(FileName,0);
  fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
  Cursor := crDefault;
  BMPMake.Enabled := True;
  BMPDetails.Enabled := True;
  PCXMake.Enabled := True;
  PCXDetails.Enabled := False;
  JPEGDetails.Enabled := False;
  FlicPlay.Enabled := False;
  FlicFrame.Enabled := False;
  FlicReset.Enabled := False;
  FlicDetails.Enabled := False;
  AVIPlay.Enabled := False;
  AVIFrame.Enabled := False;
  AVIReset.Enabled := False;
  AVIDetails.Enabled := False;
end;
procedure TForm1.BMPMakeClick(Sender: TObject);
var
  ColorDepth : integer;
begin
  SaveDialog.DefaultExt := 'bmp';
  SaveDialog.FileName := ChangeFileExt(FileName,'.bmp');
  SaveDialog.Filter := 'BMP files (*.bmp)|*.BMP';
  SaveDialog.Options := [ofHideReadOnly,ofOverwritePrompt,ofPathMustExist];
  if (SaveDialog.Execute = False) then Exit;
  FileName := SaveDialog.FileName;
  if (nColors = 0) then
    ColorDepth := 24
  else if (nColors = 256) then
    ColorDepth := 8
  else if (nColors = 16) then
    ColorDepth := 4
  else
    ColorDepth := 1;
  Cursor := crHourGlass;
  fg_makebmp(0,cxBuffer-1,0,cyBuffer-1,ColorDepth,FileName);
  Cursor := crDefault;
end;
procedure TForm1.BMPDetailsClick(Sender: TObject);
begin
  mbString := '';
  mbString := mbString + FileName + chr(13) +
    IntToStr(cxBuffer) + 'x' + IntToStr(cyBuffer) + ' pixels' + chr(13);
  if (nColors > 0) then
    mbString := mbString + IntToStr(nColors) + ' colors'
  else
    mbString := mbString + '24-bit RGB';
  MessageDlg(mbString,mtInformation,[mbOK],0);
end;
{*****************************************************************************
*                                                                            *
*  Event handlers for the items on the PCX menu.                             *
*                                                                            *
*****************************************************************************}
procedure TForm1.PCXOpenClick(Sender: TObject);
begin
  OpenDialog.DefaultExt := 'pcx';
  OpenDialog.FileName := '';
  OpenDialog.Filter := 'PCX files (*.pcx)|*.PCX';
  OpenDialog.Options := [ofReadOnly];
  if (OpenDialog.Execute = False) then Exit;
  FileName := OpenDialog.FileName;
  if (fg_pcxhead(FileName,FileHeader) < 0) then
  begin
    mbString := FileName + chr(13) + 'is not a PCX file.';
    MessageDlg(mbString,mtError,[mbOK],0);
    Exit;
  end;
  nColors := fg_pcxpal(FileName,nil^);
  Cursor := crHourGlass;
  fg_pcxsize(FileHeader,cxBuffer,cyBuffer);
  SwitchBuffers;
  fg_move(0,0);
  fg_showpcx(FileName,FG_AT_XY);
  fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
  Cursor := crDefault;
  BMPMake.Enabled := True;
  BMPDetails.Enabled := False;
  PCXMake.Enabled := True;
  PCXDetails.Enabled := True;
  JPEGDetails.Enabled := False;
  FlicPlay.Enabled := False;
  FlicFrame.Enabled := False;
  FlicReset.Enabled := False;
  FlicDetails.Enabled := False;
  AVIPlay.Enabled := False;
  AVIFrame.Enabled := False;
  AVIReset.Enabled := False;
  AVIDetails.Enabled := False;
end;
procedure TForm1.PCXMakeClick(Sender: TObject);
begin
  SaveDialog.DefaultExt := 'pcx';
  SaveDialog.FileName := ChangeFileExt(FileName,'.pcx');
  SaveDialog.Filter := 'PCX files (*.pcx)|*.PCX';
  SaveDialog.Options := [ofHideReadOnly,ofOverwritePrompt,ofPathMustExist];
  if (SaveDialog.Execute = False) then Exit;
  FileName := SaveDialog.FileName;
  Cursor := crHourGlass;
  fg_makepcx(0,cxBuffer-1,0,cyBuffer-1,FileName);
  Cursor := crDefault;
end;
procedure TForm1.PCXDetailsClick(Sender: TObject);
begin
  mbString := '';
  mbString := mbString + FileName + chr(13) +
    IntToStr(cxBuffer) + 'x' + IntToStr(cyBuffer) + ' pixels' + chr(13);
  if (nColors > 0) then
    mbString := mbString + IntToStr(nColors) + ' colors'
  else
    mbString := mbString + '24-bit RGB';
  MessageDlg(mbString,mtInformation,[mbOK],0);
end;
{*****************************************************************************
*                                                                            *
*  Event handlers for the items on the JPEG menu.                            *
*                                                                            *
*****************************************************************************}
procedure TForm1.JPEGOpenClick(Sender: TObject);
begin
  OpenDialog.DefaultExt := 'jpg';
  OpenDialog.FileName := '';
  OpenDialog.Filter := 'JPEG files (*.jpg)|*.JPG';
  OpenDialog.Options := [ofReadOnly];
  if (OpenDialog.Execute = False) then Exit;
  FileName := OpenDialog.FileName;
  if (fg_jpeghead(FileName,FileHeader) < 0) then
  begin
    mbString := FileName + chr(13) + 'is not a baseline JPEG file.';
    MessageDlg(mbString,mtError,[mbOK],0);
    Exit;
  end;
  nColors := 0;
  Cursor := crHourGlass;
  fg_jpegsize(FileHeader,cxBuffer,cyBuffer);
  SwitchBuffers;
  fg_showjpeg(FileName,0);
  fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
  Cursor := crDefault;
  BMPMake.Enabled := True;
  BMPDetails.Enabled := False;
  PCXMake.Enabled := True;
  PCXDetails.Enabled := False;
  JPEGDetails.Enabled := True;
  FlicPlay.Enabled := False;
  FlicFrame.Enabled := False;
  FlicReset.Enabled := False;
  FlicDetails.Enabled := False;
  AVIPlay.Enabled := False;
  AVIFrame.Enabled := False;
  AVIReset.Enabled := False;
  AVIDetails.Enabled := False;
end;
procedure TForm1.JPEGDetailsClick(Sender: TObject);
begin
  mbString := '';
  mbString := mbString + FileName + chr(13) +
    IntToStr(cxBuffer) + 'x' + IntToStr(cyBuffer) + ' pixels' + chr(13);
  mbString := mbString + '24-bit RGB';
  MessageDlg(mbString,mtInformation,[mbOK],0);
end;
{*****************************************************************************
*                                                                            *
*  Event handlers for the items on the FLI/FLC menu.                         *
*                                                                            *
*****************************************************************************}
procedure TForm1.FlicOpenClick(Sender: TObject);
begin
  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;
  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;
  nColors := 256;
  fg_flicsize(FileHeader,cxBuffer,cyBuffer);
  SwitchBuffers;
  fg_flicopen(FileName,Context);
  fg_flicplay(Context,1,FG_NODELAY);
  fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
  Move(FileHeader[6],nFrames,2);
  BMPMake.Enabled := True;
  BMPDetails.Enabled := False;
  PCXMake.Enabled := True;
  PCXDetails.Enabled := False;
  JPEGDetails.Enabled := False;
  FlicPlay.Enabled := True;
  FlicFrame.Enabled := True;
  FlicReset.Enabled := True;
  FlicDetails.Enabled := True;
  AVIPlay.Enabled := False;
  AVIFrame.Enabled := False;
  AVIReset.Enabled := False;
  AVIDetails.Enabled := False;
end;
procedure TForm1.FlicPlayClick(Sender: TObject);
begin
  Cursor := crHourGlass;
  fg_showflic(FileName,0,FG_NODELAY);
  Cursor := crDefault;
  fg_flicskip(Context,-1);
end;
procedure TForm1.FlicFrameClick(Sender: TObject);
begin
  if (fg_flicplay(Context,1,FG_NODELAY) = 0) then
  begin
    fg_flicskip(Context,-1);
    fg_flicplay(Context,1,FG_NODELAY);
  end;
  fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
end;
procedure TForm1.FlicResetClick(Sender: TObject);
begin
  fg_flicskip(Context,-1);
  fg_flicplay(Context,1,FG_NODELAY);
  fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
end;
procedure TForm1.FlicDetailsClick(Sender: TObject);
begin
  mbString := '';
  mbString := mbString + FileName + chr(13) +
    IntToStr(cxBuffer) + 'x' + IntToStr(cyBuffer) + ' pixels' + chr(13);
  mbString := mbString + IntToStr(nFrames) + ' frames';
  MessageDlg(mbString,mtInformation,[mbOK],0);
end;
{*****************************************************************************
*                                                                            *
*  Event handlers for the items on the AVI menu.                             *
*                                                                            *
*****************************************************************************}
procedure TForm1.AVIOpenClick(Sender: TObject);
begin
  OpenDialog.DefaultExt := 'avi';
  OpenDialog.FileName := '';
  OpenDialog.Filter := 'AVI files (*.avi)|*.AVI';
  OpenDialog.Options := [ofReadOnly];
  if (OpenDialog.Execute = False) then Exit;
  FileName := OpenDialog.FileName;
  if (fg_avihead(FileName,FileHeader) < 0) then
  begin
    mbString := FileName + chr(13) + 'is not an AVI file.';
    MessageDlg(mbString,mtError,[mbOK],0);
    Exit;
  end;
  nColors := fg_avipal(FileName,nil^);
  fg_avisize(FileHeader,cxBuffer,cyBuffer);
  SwitchBuffers;
  if (fg_aviopen(FileName,Context) < 0) then
  begin
    mbString := 'Cannot play AVI file' + chr(13) + FileName + '.';
    MessageDlg(mbString,mtError,[mbOK],0);
    AVIPlay.Enabled := False;
    AVIFrame.Enabled := False;
    AVIReset.Enabled := False;
    AVIDetails.Enabled := False;
    Exit;
  end;
  fg_aviplay(Context,1,FG_NODELAY);
  fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
  BMPMake.Enabled := True;
  BMPDetails.Enabled := False;
  PCXMake.Enabled := True;
  PCXDetails.Enabled := False;
  JPEGDetails.Enabled := False;
  FlicPlay.Enabled := False;
  FlicFrame.Enabled := False;
  FlicReset.Enabled := False;
  FlicDetails.Enabled := False;
  AVIPlay.Enabled := True;
  AVIFrame.Enabled := True;
  AVIReset.Enabled := True;
  AVIDetails.Enabled := True;
end;
procedure TForm1.AVIPlayClick(Sender: TObject);
begin
  Cursor := crHourGlass;
  fg_showavi(FileName,0,FG_NODELAY);
  Cursor := crDefault;
  fg_aviskip(Context,-1);
end;
procedure TForm1.AVIFrameClick(Sender: TObject);
begin
  if (fg_aviplay(Context,1,FG_NODELAY) = 0) then
  begin
    fg_aviskip(Context,-1);
    fg_aviplay(Context,1,FG_NODELAY);
  end;
  fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
end;
procedure TForm1.AVIResetClick(Sender: TObject);
begin
  fg_aviskip(Context,-1);
  fg_aviplay(Context,1,FG_NODELAY);
  fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
end;
procedure TForm1.AVIDetailsClick(Sender: TObject);
begin
  mbString := '';
  mbString := mbString + FileName + chr(13) +
    IntToStr(cxBuffer) + 'x' + IntToStr(cyBuffer) + ' pixels' + chr(13);
  if (nColors > 0) then
    mbString := mbString + IntToStr(nColors) + ' colors'
  else
    mbString := mbString + '24-bit RGB';
  MessageDlg(mbString,mtInformation,[mbOK],0);
end;
{****************************************************************************}
procedure TForm1.ExitClick(Sender: TObject);
begin
  Close;
end;
end.

<< Prev

Next >>

Contents
Fastgraph Home Page

 

copyright 2001 Ted Gruber Software, Inc.