ImgProc: Delphi Version
{*****************************************************************************
* *
* ImgProc.pas *
* ImgProcU.pas *
* *
* This program demonstrates several of the Fastgraph for Windows image *
* processing functions. *
* *
*****************************************************************************}
unit ImgProcU;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Menus, FGWin;
type
TForm1 = class(TForm)
MainMenu: TMainMenu;
File1: TMenuItem;
Open: TMenuItem;
SaveAs: TMenuItem;
Details: TMenuItem;
Exit1: TMenuItem;
Edit1: TMenuItem;
Undo: TMenuItem;
RestoreOriginal: TMenuItem;
N1: TMenuItem;
ContrastEnhancement: TMenuItem;
GammaCorrection: TMenuItem;
Grayscale: TMenuItem;
PhotoInversion: 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 OpenClick(Sender: TObject);
procedure SaveAsClick(Sender: TObject);
procedure DetailsClick(Sender: TObject);
procedure ExitClick(Sender: TObject);
procedure UndoClick(Sender: TObject);
procedure RestoreOriginalClick(Sender: TObject);
procedure ContrastEnhancementClick(Sender: TObject);
procedure GammaCorrectionClick(Sender: TObject);
procedure GrayscaleClick(Sender: TObject);
procedure PhotoInversionClick(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
dc : hDC;
hPal : hPalette;
hVB, hVBoriginal, hVBundo : integer;
cxClient, cyClient : integer;
cxBuffer, cyBuffer : integer;
nColors : integer;
FileHeader : array [1..128] of byte;
FileName : string;
mbString : string;
{*****************************************************************************
* *
* 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);
fg_vbfree(hVBoriginal);
fg_vbfree(hVBundo);
hVB := fg_vballoc(cxBuffer,cyBuffer);
fg_vbopen(hVB);
hVBoriginal := fg_vballoc(cxBuffer,cyBuffer);
hVBundo := fg_vballoc(cxBuffer,cyBuffer);
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);
{ initialize the virtual buffer environment }
fg_vbinit;
fg_vbdepth(24);
{ create the main virtual buffer for the working copy of the image }
cxBuffer := 32;
cyBuffer := 32;
hVB := fg_vballoc(cxBuffer,cyBuffer);
fg_vbopen(hVB);
{ create two additional virtual buffers -- one for a copy of the original }
{ image, and one used for the undo operation }
hVBoriginal := fg_vballoc(cxBuffer,cyBuffer);
hVBundo := fg_vballoc(cxBuffer,cyBuffer);
{ start with a window full of white pixels }
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_vbfree(hVBoriginal);
fg_vbfree(hVBundo);
fg_vbfin;
DeleteObject(hPal);
ReleaseDC(Form1.Handle,dc);
end;
{*****************************************************************************
* *
* Event handlers for the items on the File menu. *
* *
*****************************************************************************}
procedure TForm1.OpenClick(Sender: TObject);
begin
{ open the bmp, jpeg, or pcx image file }
OpenDialog.FileName := '';
OpenDialog.Filter :=
'All image files (*.bmp,*.jpg,*.pcx)|*.BMP;*.JPG;*.PCX|' +
'BMP files (*.bmp)|*.BMP|' +
'JPEG files (*.jpg)|*.JPG|' +
'PCX files (*.pcx)|*.PCX';
OpenDialog.Options := [ofReadOnly];
if (OpenDialog.Execute = False) then Exit;
FileName := OpenDialog.FileName;
{ check for a bmp file }
if (fg_bmphead(FileName,FileHeader) = 0) then
begin
Cursor := crHourGlass;
nColors := fg_bmppal(FileName,nil^);
fg_bmpsize(FileHeader,cxBuffer,cyBuffer);
SwitchBuffers;
fg_showbmp(FileName,0);
SaveDialog.DefaultExt := 'bmp';
end
{ check for a jpeg file }
else if (fg_jpeghead(FileName,FileHeader) = 0) then
begin
Cursor := crHourGlass;
nColors := 0;
fg_jpegsize(FileHeader,cxBuffer,cyBuffer);
SwitchBuffers;
fg_showjpeg(FileName,0);
SaveDialog.DefaultExt := 'pcx';
end
{ check for a pcx file }
else if (fg_pcxhead(FileName,FileHeader) = 0) then
begin
Cursor := crHourGlass;
nColors := fg_pcxpal(FileName,nil^);
fg_pcxsize(FileHeader,cxBuffer,cyBuffer);
SwitchBuffers;
fg_move(0,0);
fg_showpcx(FileName,FG_AT_XY);
SaveDialog.DefaultExt := 'pcx';
end
{ the file is not a valid bmp, jpeg, or pcx file }
else
begin
mbString := OpenDialog.FileName + chr(13) +
'is not a recognized image file.';
MessageDlg(mbString,mtError,[mbOK],0);
Exit;
end;
{ make a copy of the original image }
fg_copypage(hVB,hVBoriginal);
{ display the image }
fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
Cursor := crDefault;
{ enable remaining items on the File menu, and the image processing }
{ items on the Edit menu }
SaveAs.Enabled := True;
Details.Enabled := True;
Undo.Enabled := False;
RestoreOriginal.Enabled := False;
ContrastEnhancement.Enabled := True;
GammaCorrection.Enabled := True;
Grayscale.Enabled := True;
PhotoInversion.Enabled := True;
end;
procedure TForm1.SaveAsClick(Sender: TObject);
begin
{ set the file save dialog options }
SaveDialog.Options := [ofHideReadOnly,ofOverwritePrompt,ofPathMustExist];
SaveDialog.FileName := ChangeFileExt(FileName,'.'+SaveDialog.DefaultExt);
{ save image as a bmp file (original image was bmp) }
if (SaveDialog.DefaultExt = 'bmp') then
begin
SaveDialog.Filter := 'BMP files (*.bmp)|*.BMP';
if (SaveDialog.Execute = False) then Exit;
Cursor := crHourGlass;
FileName := SaveDialog.FileName;
fg_makebmp(0,cxBuffer-1,0,cyBuffer-1,24,FileName);
nColors := 0;
Cursor := crDefault;
end
{ save image as a pcx file (original image was jpeg or pcx) }
else if (SaveDialog.DefaultExt = 'pcx') then
begin
SaveDialog.Filter := 'PCX files (*.pcx)|*.PCX';
if (SaveDialog.Execute = False) then Exit;
Cursor := crHourGlass;
FileName := SaveDialog.FileName;
fg_makepcx(0,cxBuffer-1,0,cyBuffer-1,FileName);
nColors := 0;
Cursor := crDefault;
end;
end;
procedure TForm1.DetailsClick(Sender: TObject);
begin
{ display the original image resolution and color depth }
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;
{*****************************************************************************
* *
* Event handlers for the items on the Edit menu. *
* *
*****************************************************************************}
procedure TForm1.UndoClick(Sender: TObject);
begin
{ undo the previous image processing operation }
fg_copypage(hVBundo,hVB);
fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
Undo.Enabled := False;
RestoreOriginal.Enabled := True;
end;
procedure TForm1.RestoreOriginalClick(Sender: TObject);
begin
{ restore the original image }
fg_copypage(hVB,hVBundo);
fg_copypage(hVBoriginal,hVB);
fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
Undo.Enabled := True;
RestoreOriginal.Enabled := False;
end;
procedure TForm1.ContrastEnhancementClick(Sender: TObject);
begin
{ perform a contrast enhancement transform on the active virtual buffer }
fg_copypage(hVB,hVBundo);
fg_move(0,cyBuffer-1);
fg_contvb(63,192,cxBuffer,cyBuffer);
fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
Undo.Enabled := True;
RestoreOriginal.Enabled := True;
end;
procedure TForm1.GammaCorrectionClick(Sender: TObject);
begin
{ perform a gamma correction transform on the active virtual buffer }
fg_copypage(hVB,hVBundo);
fg_move(0,cyBuffer-1);
fg_gammavb(0.45,cxBuffer,cyBuffer);
fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
Undo.Enabled := True;
RestoreOriginal.Enabled := True;
end;
procedure TForm1.GrayscaleClick(Sender: TObject);
begin
{ perform a grayscale transform on the active virtual buffer }
fg_copypage(hVB,hVBundo);
fg_move(0,cyBuffer-1);
fg_grayvb(cxBuffer,cyBuffer);
fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
Undo.Enabled := True;
RestoreOriginal.Enabled := True;
end;
procedure TForm1.PhotoInversionClick(Sender: TObject);
begin
{ perform a photo-inversion transform on the active virtual buffer }
fg_copypage(hVB,hVBundo);
fg_move(0,cyBuffer-1);
fg_photovb(cxBuffer,cyBuffer);
fg_vbscale(0,cxBuffer-1,0,cyBuffer-1,0,cxClient-1,0,cyClient-1);
Undo.Enabled := True;
RestoreOriginal.Enabled := True;
end;
end.
|