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.

<< Prev

Next >>

Contents
Fastgraph Home Page

 

copyright 2001 Ted Gruber Software, Inc.