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.
|