BSOne.SFC/EM.Lib/ImageEn_SRC/Demos/ImageEditing/ChromaKey/umain.pas

363 lines
11 KiB
Plaintext

unit umain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, hyieutils, ExtCtrls,
StdCtrls, ieview, imageenview, imageenproc, hyiedefs, ComCtrls, Buttons, math, histogrambox, iexBitmaps,
iesettings, iexLayers, iexRulers;
type
TMainForm = class(TForm)
Panel1: TPanel;
lbxBackgrounds: TListBox;
lblBackgrounds: TLabel;
lblForegrounds: TLabel;
lbxForegrounds: TListBox;
ImageEnView1: TImageEnView;
Panel2: TPanel;
lblTolerance: TLabel;
trkTolerance: TTrackBar;
lblDetail: TLabel;
trkZoom: TTrackBar;
btnFit: TButton;
ProgressBar1: TProgressBar;
chkRemoveNoise: TCheckBox;
lblSaturation: TLabel;
trkSaturation: TTrackBar;
pnlKeyColor: TPanel;
btnReset: TButton;
lblEdgeFeather: TLabel;
edtEdgeFeather: TEdit;
updEdgeFeather: TUpDown;
HistogramBox1: THistogramBox;
lblBackground: TLabel;
memInfo: TMemo;
cmbHueReduction: TComboBox;
lblHueReduction: TLabel;
tmrUpdateChromaKey: TTimer;
rdbSetBackground: TRadioButton;
rdbMoveForeground: TRadioButton;
cmbSetBackground: TComboBox;
procedure FormDestroy(Sender: TObject);
procedure btnResetClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure lbxBackgroundsClick(Sender: TObject);
procedure lbxForegroundsClick(Sender: TObject);
procedure ImageEnView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure trkZoomChange(Sender: TObject);
procedure trkToleranceChange(Sender: TObject);
procedure btnFitClick(Sender: TObject);
procedure ImageEnView1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ImageEnView1SelectionChange(Sender: TObject);
procedure ControlChange(Sender: TObject);
procedure CursorControlChange(Sender: TObject);
procedure ImageEnView1Progress(Sender: TObject; per: Integer);
procedure tmrUpdateChromaKeyTimer(Sender: TObject);
private
{ Private declarations }
fKeyColor: TRGB;
fForegroundSrc: TIEBitmap;
fToleranceLastPosition: integer;
procedure ApplyChromaKey();
procedure DelayedApplyChromaKey();
procedure InitializeControls();
procedure ResetChromaKeyImage();
procedure SetKeyColor(const Value: TRGB);
public
{ Public declarations }
property KeyColor: TRGB read fKeyColor write SetKeyColor;
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
{$R WindowsTheme.res}
const
Backgrounds_Path = '.\Backgrounds\';
Foregrounds_Path = '.\Foregrounds\';
// Items of cmbSetBackground
_cmbSetBackground_ClickBackground = 0;
_cmbSetBackground_SelectBackgroundRegion = 1;
_cmbSetBackground_SelectForeground = 2;
procedure TMainForm.InitializeControls();
begin
trkSaturation.Position := 30;
updEdgeFeather.Position := 2;
cmbHueReduction.ItemIndex := 0;
chkRemoveNoise.checked := False;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
InitializeControls();
fForegroundSrc := TIEBitmap.create;
TIEDirContent.PopulateStrings( Backgrounds_Path + '*.*', lbxBackgrounds.Items );
TIEDirContent.PopulateStrings( Foregrounds_Path + '*.*', lbxForegrounds.Items );
ImageEnView1.LayersAdd( ielkImage );
if lbxBackgrounds.Count = 0 then
raise Exception.create( 'Could not find backgrounds folder: ' + Backgrounds_Path );
if lbxForegrounds.Count = 0 then
raise Exception.create( 'Could not find foregrounds folder: ' + Foregrounds_Path );
lbxBackgrounds.ItemIndex := 0;
lbxForegrounds.ItemIndex := 0;
lbxBackgroundsClick( nil );
lbxForegroundsClick( nil );
lblDetail.Caption := '';
cmbSetBackground.ItemIndex := _cmbSetBackground_SelectBackgroundRegion;
CursorControlChange( nil );
end;
procedure TMainForm.lbxBackgroundsClick(Sender: TObject);
begin
// Load background layer
ImageEnView1.LayersCurrent := 0;
ImageEnView1.IO.LoadFromFile( Backgrounds_Path + lbxBackgrounds.Items[ lbxBackgrounds.ItemIndex ] );
// Set Chromakey layer as current
ImageEnView1.LayersCurrent := 1;
DelayedApplyChromaKey()
end;
procedure TMainForm.lbxForegroundsClick(Sender: TObject);
begin
// Load chroma key image (into current layer, which is 1)
fForegroundSrc.Read( Foregrounds_Path + lbxForegrounds.Items[ lbxForegrounds.ItemIndex ] );
if fForegroundSrc.Width > 1024 then
fForegroundSrc.Resample( 1024, -1 );
ImageEnView1.Deselect;
ResetChromaKeyImage();
HistogramBox1.UpdateFromBitmap(fForegroundSrc);
btnResetClick( nil );
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
FreeAndNil( fForegroundSrc );
end;
procedure TMainForm.ApplyChromaKey();
var
w, h: integer;
begin
if ImageEnView1.IsEmpty2 then
exit;
ResetChromaKeyImage();
// Resize background to match foreground layer if it smaller
w := imax(ImageEnView1.Layers[ 0 ].Bitmap.Width, ImageEnView1.Layers[ 1 ].Bitmap.Width );
h := imax(ImageEnView1.Layers[ 0 ].Bitmap.Height, ImageEnView1.Layers[ 1 ].Bitmap.Height );
ImageEnView1.Layers[ 0 ].Bitmap.Resample( w, h );
ImageEnView1.LayersCurrent := 1;
ImageEnView1.Proc.RemoveChromaKey( KeyColor,
trkTolerance.Position / 1000,
trkSaturation.Position,
updEdgeFeather.Position,
cmbHueReduction.ItemIndex,
chkRemoveNoise.Checked );
ImageEnView1.Update();
ProgressBar1.Visible := False;
end;
procedure TMainForm.tmrUpdateChromaKeyTimer(Sender: TObject);
begin
tmrUpdateChromaKey.Enabled := False;
ApplyChromaKey();
end;
procedure TMainForm.DelayedApplyChromaKey();
begin
// Reset timer
tmrUpdateChromaKey.Enabled := False;
tmrUpdateChromaKey.Enabled := True;
end;
procedure TMainForm.btnResetClick(Sender: TObject);
var
Tolerance: Double;
begin
ImageEnView1.Deselect;
ResetChromaKeyImage();
// Guess key RGB and Tolerance
KeyColor := ImageEnView1.Proc.GuessChromaKeyColor( Tolerance );
// Tolerance is only based on a small sample, so may be too low (0.21 is a good default)
if Tolerance < 0.210 then
Tolerance := 0.210;
trkTolerance.Position := Trunc( Tolerance * 1000 );
InitializeControls();
DelayedApplyChromaKey();
end;
procedure TMainForm.ImageEnView1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
// Get the key color from the clicked pixel
if ( rdbSetBackground.checked ) and ( cmbSetBackground.ItemIndex = _cmbSetBackground_ClickBackground ) then
begin
X := ImageEnView1.Layers[ 1 ].ConvXScr2Bmp( X );
Y := ImageEnView1.Layers[ 1 ].ConvYScr2Bmp( Y );
if ( X >= 0 ) and ( X <= fForegroundSrc.Width ) and ( Y >= 0 ) and ( Y <= fForegroundSrc.Height ) then
begin
// Read from fForegroundSrc so that it is not affected by ChromaKey effect on current layer
KeyColor := fForegroundSrc.Pixels[ X, Y ];
trkTolerance.Position := 210;
//
DelayedApplyChromaKey();
end;
end;
end;
procedure TMainForm.ImageEnView1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
d1, d2, d3: double;
i1, i2, i3: integer;
w1, w2, w3: word;
txt: string;
begin
// Display information about the foreground color under the cursor
X := ImageEnView1.Layers[ 1 ].ConvXScr2Bmp( X );
Y := ImageEnView1.Layers[ 1 ].ConvYScr2Bmp( Y );
if ( X >= 0 ) and ( X < ImageEnView1.Layers[ 1 ].Bitmap.Width ) and ( Y >= 0 ) and ( Y < ImageEnView1.Layers[ 1 ].Bitmap.Height ) then
begin
txt := Format( 'Details for X=%d Y=%d:', [ X, Y ]);
with fForegroundSrc.Pixels[ X, Y ] do
txt := txt + Format( ' RGBA=%d %d %d %d', [ r, g, b, ImageEnView1.Layers[ 1 ].Bitmap.Alpha[ X, Y ] ] );
RGB2HSL( fForegroundSrc.Pixels[ X, Y ], d1, d2, d3);
txt := txt + Format( ' HSV=%f %f %f', [ d1, d2, d3 ] );
IERGB2YCbCr( fForegroundSrc.Pixels[ X, Y ], i1, i2, i3 );
txt := txt + Format( ' YCbCr=%d %d %d', [ i1, i2, i3 ] );
RGB2HSV(fForegroundSrc.Pixels[ X, Y ], i1, i2, i3);
txt := txt + Format( ' HSV=%d %d %d', [ i1, i2, i3 ] );
HistogramBox1.MouseInteract := mhSelectValue;
HistogramBox1.MinSelected := i1;
with fForegroundSrc.Pixels[ X, Y ] do
IERGBtoHSB( r, g, b, w1, w2, w3 );
txt := txt + Format( ' HSB=%d %d %d', [ w1, w2, w3 ] );
lblDetail.Caption := txt;
lblDetail.Update;
end;
end;
procedure TMainForm.trkZoomChange(Sender: TObject);
begin
ImageEnView1.Zoom := trkZoom.Position;
end;
procedure TMainForm.trkToleranceChange(Sender: TObject);
begin
lblTolerance.Caption := format( 'Tolerance (%d)', [ trkTolerance.Position ]);
if fToleranceLastPosition <> trkTolerance.Position then
begin
fToleranceLastPosition := trkTolerance.Position;
DelayedApplyChromaKey();
end;
end;
procedure TMainForm.btnFitClick(Sender: TObject);
begin
ImageEnView1.Fit();
end;
procedure TMainForm.ImageEnView1SelectionChange(Sender: TObject);
var
Tolerance: Double;
begin
// Set key color to the average color of the selection
if ImageEnView1.Selected then
begin
ResetChromaKeyImage();
// User has selected the foreground, so invert selection to get all background area
if cmbSetBackground.ItemIndex = _cmbSetBackground_SelectForeground then
ImageEnView1.InvertSelection;
KeyColor := ImageEnView1.Proc.GuessChromaKeyColor( Tolerance );
trkTolerance.Position := Trunc( Tolerance * 1000 );
DelayedApplyChromaKey();
ImageEnView1.Deselect;
end;
end;
procedure TMainForm.SetKeyColor(const Value: TRGB);
begin
fKeyColor := Value;
pnlKeyColor.Color := TRGB2TColor( Value );
end;
procedure TMainForm.ControlChange(Sender: TObject);
begin
lblSaturation.Caption := format( 'Saturation (%d)', [ trkSaturation.Position ]);
DelayedApplyChromaKey();
end;
procedure TMainForm.CursorControlChange(Sender: TObject);
begin
cmbSetBackground.Enabled := rdbSetBackground.checked;
if rdbMoveForeground.checked then
ImageEnView1.MouseInteract := [ miMoveLayers, miResizeLayers ]
else
case cmbSetBackground.ItemIndex of
_cmbSetBackground_ClickBackground : ImageEnView1.MouseInteract := [];
_cmbSetBackground_SelectBackgroundRegion : ImageEnView1.MouseInteract := [ miSelect ];
_cmbSetBackground_SelectForeground : ImageEnView1.MouseInteract := [ miSelectLasso ];
end;
end;
procedure TMainForm.ImageEnView1Progress(Sender: TObject; per: Integer);
begin
ProgressBar1.Position := per;
ProgressBar1.Visible := True;
end;
procedure TMainForm.ResetChromaKeyImage();
begin
// Reset image
ImageEnView1.Layers[ 1 ].Bitmap.Assign( fForegroundSrc );
end;
end.