PostRender form added
This commit is contained in:
ronaldhordijk
255
2.10/Source/formPostProcess.pas
Normal file
255
2.10/Source/formPostProcess.pas
Normal file
@ -0,0 +1,255 @@
|
||||
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
|
||||
ImageDLLLoader, ICOLoader, PNGLOader, HIPSLoader, BMPLoader, PCXLoader, WMFLoader,
|
||||
LinarBitmap, FileUtils, JPEGLoader, JPEG, Registry, Global;
|
||||
|
||||
{$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
|
||||
with TLinearBitmap.Create do
|
||||
try
|
||||
Assign(FRenderer.GetImage);
|
||||
JPEGLoader.Default.Quality := JPEGQuality;
|
||||
SaveToFile(FImagename);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
procedure TfrmPostProcess.SetImageName(imagename: string);
|
||||
begin
|
||||
FImagename := imagename;
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
end.
|
||||
Reference in New Issue
Block a user