2005-06-04 10:14:45 -04:00
|
|
|
unit formPostProcess;
|
|
|
|
|
|
|
|
interface
|
|
|
|
|
|
|
|
uses
|
|
|
|
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|
|
|
Dialogs, ExtCtrls, Render, controlpoint, StdCtrls, ComCtrls;
|
|
|
|
|
|
|
|
type
|
|
|
|
TfrmPostProcess = class(TForm)
|
|
|
|
Panel1: TPanel;
|
|
|
|
ScrollBox1: TScrollBox;
|
|
|
|
Image: TImage;
|
|
|
|
btnSave: TButton;
|
|
|
|
Label1: TLabel;
|
|
|
|
pnlBackColor: TPanel;
|
|
|
|
ColorDialog: TColorDialog;
|
|
|
|
ProgressBar1: TProgressBar;
|
|
|
|
Label2: TLabel;
|
|
|
|
btnApply: TButton;
|
|
|
|
txtFilterRadius: TEdit;
|
|
|
|
Label3: TLabel;
|
|
|
|
txtGamma: TEdit;
|
|
|
|
Label4: TLabel;
|
|
|
|
txtVib: TEdit;
|
|
|
|
Label5: TLabel;
|
|
|
|
txtContrast: TEdit;
|
|
|
|
Label6: TLabel;
|
|
|
|
txtBrightness: TEdit;
|
|
|
|
procedure btnSaveClick(Sender: TObject);
|
|
|
|
procedure btnApplyClick(Sender: TObject);
|
|
|
|
procedure FormDestroy(Sender: TObject);
|
|
|
|
procedure pnlBackColorClick(Sender: TObject);
|
|
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
|
|
procedure FormShow(Sender: TObject);
|
|
|
|
private
|
|
|
|
{ Private declarations }
|
|
|
|
FRenderer: TBaseRenderer;
|
|
|
|
FCP: TControlPoint;
|
|
|
|
FImagename: string;
|
|
|
|
|
|
|
|
procedure UpdateFlame;
|
|
|
|
procedure SetDefaultValues;
|
|
|
|
|
|
|
|
procedure OnProgress(prog: double);
|
|
|
|
|
|
|
|
public
|
|
|
|
procedure SetRenderer(Renderer: TBaseRenderer);
|
|
|
|
procedure SetControlPoint(CP: TControlPoint);
|
|
|
|
procedure SetImageName(imagename: string);
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
frmPostProcess: TfrmPostProcess;
|
|
|
|
|
|
|
|
implementation
|
|
|
|
|
|
|
|
uses
|
2005-09-03 07:22:04 -04:00
|
|
|
Registry, Global;
|
2005-06-04 10:14:45 -04:00
|
|
|
|
|
|
|
{$R *.dfm}
|
|
|
|
|
|
|
|
{ TfrmPostProcess }
|
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TfrmPostProcess.SetRenderer(Renderer: TBaseRenderer);
|
|
|
|
begin
|
|
|
|
if assigned(FRenderer) then
|
|
|
|
FRenderer.Free;
|
|
|
|
|
|
|
|
FRenderer := Renderer;
|
|
|
|
Frenderer.OnProgress := OnProgress;
|
|
|
|
Image.Picture.Graphic := FRenderer.GetImage;
|
|
|
|
end;
|
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TfrmPostProcess.FormShow(Sender: TObject);
|
|
|
|
var
|
|
|
|
Registry: TRegistry;
|
|
|
|
begin
|
|
|
|
{ Read posution from registry }
|
|
|
|
Registry := TRegistry.Create;
|
|
|
|
try
|
|
|
|
Registry.RootKey := HKEY_CURRENT_USER;
|
|
|
|
if Registry.OpenKey('Software\' + APP_NAME + '\Forms\PostProcess', False) then begin
|
|
|
|
if Registry.ValueExists('Left') then
|
|
|
|
Left := Registry.ReadInteger('Left');
|
|
|
|
if Registry.ValueExists('Top') then
|
|
|
|
Top := Registry.ReadInteger('Top');
|
|
|
|
if Registry.ValueExists('Width') then
|
|
|
|
Width := Registry.ReadInteger('Width');
|
|
|
|
if Registry.ValueExists('Height') then
|
|
|
|
Height := Registry.ReadInteger('Height');
|
|
|
|
end;
|
|
|
|
Registry.CloseKey;
|
|
|
|
finally
|
|
|
|
Registry.Free;
|
|
|
|
end;
|
|
|
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TfrmPostProcess.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
|
|
var
|
|
|
|
Registry: TRegistry;
|
|
|
|
begin
|
|
|
|
{ Write position to registry }
|
|
|
|
Registry := TRegistry.Create;
|
|
|
|
try
|
|
|
|
Registry.RootKey := HKEY_CURRENT_USER;
|
|
|
|
if Registry.OpenKey('\Software\' + APP_NAME + '\Forms\PostProcess', True) then
|
|
|
|
begin
|
|
|
|
Registry.WriteInteger('Top', Top);
|
|
|
|
Registry.WriteInteger('Left', Left);
|
|
|
|
Registry.WriteInteger('Width', Width);
|
|
|
|
Registry.WriteInteger('Height', Height);
|
|
|
|
end;
|
|
|
|
finally
|
|
|
|
Registry.Free;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TfrmPostProcess.SetDefaultValues;
|
|
|
|
begin
|
|
|
|
pnlBackColor.Color := RGB(Fcp.background[0], Fcp.background[1], Fcp.background[2]);
|
|
|
|
txtFilterRadius.Text := FloatTostr(FCP.spatial_filter_radius);
|
|
|
|
txtGamma.Text := FloatTostr(FCP.gamma);
|
|
|
|
txtVib.Text := FloatTostr(FCP.vibrancy);
|
|
|
|
txtContrast.Text := FloatTostr(FCP.contrast);
|
|
|
|
txtBrightness.Text := FloatTostr(FCP.brightness);
|
|
|
|
end;
|
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TfrmPostProcess.SetControlPoint(CP: TControlPoint);
|
|
|
|
begin
|
|
|
|
if assigned(FCP) then
|
|
|
|
FCP.Free;
|
|
|
|
|
|
|
|
FCP := cp.Clone;
|
|
|
|
SetDefaultValues;
|
|
|
|
end;
|
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TfrmPostProcess.pnlBackColorClick(Sender: TObject);
|
|
|
|
var
|
|
|
|
col: Longint;
|
|
|
|
begin
|
|
|
|
ColorDialog.Color := pnlBackColor.Color;
|
|
|
|
if ColorDialog.Execute then begin
|
|
|
|
pnlBackColor.Color := ColorDialog.Color;
|
|
|
|
col := ColorToRGB(ColorDialog.Color);
|
|
|
|
Fcp.background[0] := col and 255;
|
|
|
|
Fcp.background[1] := (col shr 8) and 255;
|
|
|
|
Fcp.background[2] := (col shr 16) and 255;
|
|
|
|
UpdateFlame;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TfrmPostProcess.UpdateFlame;
|
|
|
|
begin
|
|
|
|
FRenderer.UpdateImage(FCP);
|
|
|
|
Image.Picture.Graphic := FRenderer.GetImage;
|
|
|
|
end;
|
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TfrmPostProcess.FormDestroy(Sender: TObject);
|
|
|
|
begin
|
|
|
|
if assigned(FRenderer) then
|
|
|
|
FRenderer.Free;
|
|
|
|
|
|
|
|
if assigned(FCP) then
|
|
|
|
FCP.Free;
|
|
|
|
end;
|
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TfrmPostProcess.OnProgress(prog: double);
|
|
|
|
begin
|
|
|
|
ProgressBar1.Position := round(100 * prog);
|
|
|
|
end;
|
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TfrmPostProcess.btnApplyClick(Sender: TObject);
|
|
|
|
begin
|
|
|
|
TryStrToFloat(txtFilterRadius.Text, FCP.spatial_filter_radius);
|
|
|
|
if FCP.spatial_filter_radius > 2 then begin
|
|
|
|
FCP.spatial_filter_radius := 2;
|
|
|
|
txtFilterRadius.Text := '2';
|
|
|
|
end else if FCP.spatial_filter_radius < 0 then begin
|
|
|
|
FCP.spatial_filter_radius := 0.01;
|
|
|
|
txtFilterRadius.Text := FloatTostr(0.01);
|
|
|
|
end;
|
|
|
|
|
|
|
|
TryStrToFloat(txtGamma.Text, FCP.gamma);
|
|
|
|
if FCP.gamma > 10 then begin
|
|
|
|
FCP.gamma := 10;
|
|
|
|
txtGamma.Text := '10';
|
|
|
|
end else if FCP.gamma < 0.01 then begin
|
|
|
|
FCP.gamma := 0.01;
|
|
|
|
txtGamma.Text := FloatTostr(0.01);
|
|
|
|
end;
|
|
|
|
|
|
|
|
TryStrToFloat(txtVib.Text, FCP.vibrancy);
|
|
|
|
if FCP.vibrancy > 10 then begin
|
|
|
|
FCP.vibrancy := 10;
|
|
|
|
txtVib.Text := '10';
|
|
|
|
end else if FCP.vibrancy < 0.01 then begin
|
|
|
|
FCP.vibrancy := 0.01;
|
|
|
|
txtVib.Text := FloatTostr(0.01);
|
|
|
|
end;
|
|
|
|
|
|
|
|
TryStrToFloat(txtContrast.Text, FCP.contrast);
|
|
|
|
if FCP.contrast > 10 then begin
|
|
|
|
FCP.contrast := 10;
|
|
|
|
txtContrast.Text := '10';
|
|
|
|
end else if FCP.contrast < 0.01 then begin
|
|
|
|
FCP.contrast := 0.01;
|
|
|
|
txtContrast.Text := FloatTostr(0.01);
|
|
|
|
end;
|
|
|
|
|
|
|
|
TryStrToFloat(txtBrightness.Text, FCP.brightness);
|
|
|
|
if FCP.brightness > 10 then begin
|
|
|
|
FCP.brightness := 10;
|
|
|
|
txtBrightness.Text := '10';
|
|
|
|
end else if FCP.brightness < 0.01 then begin
|
|
|
|
FCP.brightness := 0.01;
|
|
|
|
txtBrightness.Text := FloatTostr(0.01);
|
|
|
|
end;
|
|
|
|
|
|
|
|
UpdateFlame;
|
|
|
|
end;
|
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TfrmPostProcess.btnSaveClick(Sender: TObject);
|
|
|
|
begin
|
2005-09-03 07:22:04 -04:00
|
|
|
FRenderer.SaveImage(FImagename);
|
2005-06-04 10:14:45 -04:00
|
|
|
end;
|
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TfrmPostProcess.SetImageName(imagename: string);
|
|
|
|
begin
|
|
|
|
FImagename := imagename;
|
|
|
|
end;
|
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
end.
|