PostRender form added

This commit is contained in:
ronaldhordijk 2005-06-04 14:14:45 +00:00
parent 0c003c61b0
commit ef1ff8e948
6 changed files with 470 additions and 21 deletions

View File

@ -1,11 +1,12 @@
2.02h 2.02h
+ Disable screen saver when rendering to disk + Disable screen saver when rendering to disk
+ Automatic system shutdown after rendering completion + Automatic system shutdown after rendering completion
B1116907 Values Editing events + B1116907 Values Editing events
+ FR1183940 Added triangle rotation functions in the editors popup menu. + FR1183940 Added triangle rotation functions in the editors popup menu.
+ Added gradient drawing in a tooltip form in the gradient browser window. + Added gradient drawing in a tooltip form in the gradient browser window.
+ Editor window now has controls for precise moving and rotating triangles. + Editor window now has controls for precise moving and rotating triangles.
Fixed a bug causing floating point errors on big unzooming and other editing tasks. + Fixed a bug causing floating point errors on big unzooming and other editing tasks.
+ Added form to modify the image after rendering.
2.02g 2.02g
+ Delphi2005 Project + Delphi2005 Project

View File

@ -4,7 +4,7 @@ object RenderForm: TRenderForm
BorderIcons = [biSystemMenu, biMinimize] BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle BorderStyle = bsSingle
Caption = 'RenderForm' Caption = 'RenderForm'
ClientHeight = 405 ClientHeight = 424
ClientWidth = 424 ClientWidth = 424
Color = clBtnFace Color = clBtnFace
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -50,15 +50,16 @@ object RenderForm: TRenderForm
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object ProgressBar: TProgressBar object ProgressBar: TProgressBar
Left = 8 Left = 0
Top = 330 Top = 392
Width = 409 Width = 424
Height = 13 Height = 13
Align = alBottom
TabOrder = 0 TabOrder = 0
end end
object btnRender: TButton object btnRender: TButton
Left = 256 Left = 256
Top = 352 Top = 364
Width = 75 Width = 75
Height = 23 Height = 23
Caption = 'Render' Caption = 'Render'
@ -68,7 +69,7 @@ object RenderForm: TRenderForm
end end
object btnCancel: TButton object btnCancel: TButton
Left = 344 Left = 344
Top = 350 Top = 362
Width = 75 Width = 75
Height = 25 Height = 25
Caption = 'Close' Caption = 'Close'
@ -337,7 +338,7 @@ object RenderForm: TRenderForm
end end
object btnPause: TButton object btnPause: TButton
Left = 168 Left = 168
Top = 350 Top = 362
Width = 75 Width = 75
Height = 25 Height = 25
Caption = 'Pause' Caption = 'Pause'
@ -346,7 +347,7 @@ object RenderForm: TRenderForm
end end
object chkSave: TCheckBox object chkSave: TCheckBox
Left = 8 Left = 8
Top = 346 Top = 330
Width = 113 Width = 113
Height = 17 Height = 17
Caption = 'Save parameters' Caption = 'Save parameters'
@ -360,7 +361,7 @@ object RenderForm: TRenderForm
Width = 408 Width = 408
Height = 57 Height = 57
Caption = 'Preset' Caption = 'Preset'
TabOrder = 9 TabOrder = 11
object btnSavePreset: TSpeedButton object btnSavePreset: TSpeedButton
Left = 344 Left = 344
Top = 18 Top = 18
@ -408,7 +409,7 @@ object RenderForm: TRenderForm
end end
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Top = 386 Top = 405
Width = 424 Width = 424
Height = 19 Height = 19
Panels = < Panels = <
@ -428,7 +429,15 @@ object RenderForm: TRenderForm
Width = 137 Width = 137
Height = 17 Height = 17
Caption = 'Shutdown on complete' Caption = 'Shutdown on complete'
TabOrder = 11 TabOrder = 10
end
object cbPostProcess: TCheckBox
Left = 8
Top = 348
Width = 97
Height = 17
Caption = 'Post render'
TabOrder = 9
end end
object SaveDialog: TSaveDialog object SaveDialog: TSaveDialog
Left = 368 Left = 368

View File

@ -67,6 +67,7 @@ type
cbHeight: TComboBox; cbHeight: TComboBox;
StatusBar: TStatusBar; StatusBar: TStatusBar;
chkShutdown: TCheckBox; chkShutdown: TCheckBox;
cbPostProcess: TCheckBox;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure btnRenderClick(Sender: TObject); procedure btnRenderClick(Sender: TObject);
@ -88,10 +89,11 @@ type
procedure cmbPresetChange(Sender: TObject); procedure cmbPresetChange(Sender: TObject);
procedure chkMaintainClick(Sender: TObject); procedure chkMaintainClick(Sender: TObject);
private private
StartTime: TDateTime; StartTime: TDateTime;
Remainder: TDateTime; Remainder: TDateTime;
procedure DoPostProcess;
procedure HandleThreadCompletion(var Message: TMessage); procedure HandleThreadCompletion(var Message: TMessage);
message WM_THREAD_COMPLETE; message WM_THREAD_COMPLETE;
procedure HandleThreadTermination(var Message: TMessage); procedure HandleThreadTermination(var Message: TMessage);
@ -119,7 +121,7 @@ var
implementation implementation
uses Main, Global, SavePreset, FileCtrl; uses Main, Global, SavePreset, FileCtrl, formPostProcess;
{$R *.DFM} {$R *.DFM}
@ -134,6 +136,7 @@ begin
txtOversample.Enabled := true; txtOversample.Enabled := true;
chkLimitMem.Enabled := true; chkLimitMem.Enabled := true;
cbMaxMemory.enabled := chkLimitMem.Checked; cbMaxMemory.enabled := chkLimitMem.Checked;
cbPostProcess.Enabled := not chkLimitMem.Checked;
btnRender.Enabled := true; btnRender.Enabled := true;
cmbPreset.enabled := true; cmbPreset.enabled := true;
chkSave.enabled := true; chkSave.enabled := true;
@ -169,6 +172,10 @@ begin
Assign(Renderer.GetImage); Assign(Renderer.GetImage);
JPEGLoader.Default.Quality := JPEGQuality; JPEGLoader.Default.Quality := JPEGQuality;
SaveToFile(RenderForm.FileName); SaveToFile(RenderForm.FileName);
if cbPostProcess.enabled and
cbPostProcess.checked then
DoPostProcess;
Renderer.Free; Renderer.Free;
Renderer := nil; Renderer := nil;
ResetControls; ResetControls;
@ -420,6 +427,7 @@ end;
procedure TRenderForm.chkLimitMemClick(Sender: TObject); procedure TRenderForm.chkLimitMemClick(Sender: TObject);
begin begin
cbMaxMemory.enabled := chkLimitMem.Checked; cbMaxMemory.enabled := chkLimitMem.Checked;
cbPostProcess.Enabled := not chkLimitMem.Checked;
end; end;
procedure TRenderForm.txtFilenameChange(Sender: TObject); procedure TRenderForm.txtFilenameChange(Sender: TObject);
@ -482,13 +490,10 @@ end;
procedure TRenderForm.btnPauseClick(Sender: TObject); procedure TRenderForm.btnPauseClick(Sender: TObject);
begin begin
if Assigned(Renderer) then if Assigned(Renderer) then
if Renderer.Suspended = false then if Renderer.Suspended = false then begin
begin
renderer.suspend; renderer.suspend;
btnPause.caption := 'Resume'; btnPause.caption := 'Resume';
end end else begin
else
begin
renderer.resume; renderer.resume;
btnPause.caption := 'Pause'; btnPause.caption := 'Pause';
end; end;
@ -671,6 +676,14 @@ begin
Ratio := ImageWidth / ImageHeight; Ratio := ImageWidth / ImageHeight;
end; end;
procedure TRenderForm.DoPostProcess;
begin
frmPostProcess.SetRenderer(Renderer.GetRenderer);
frmPostProcess.SetControlPoint(CP);
frmPostProcess.SetImageName(RenderForm.FileName);
frmPostProcess.Show;
end;
function TRenderForm.WindowsExit(RebootParam: Longword = EWX_POWEROFF or EWX_FORCE): Boolean; function TRenderForm.WindowsExit(RebootParam: Longword = EWX_POWEROFF or EWX_FORCE): Boolean;
var var
TTokenHd: THandle; TTokenHd: THandle;

View File

@ -393,7 +393,10 @@ begin
Exit; Exit;
if (i and $F = 0) then if (i and $F = 0) then
Progress(i / nrbatches); if nrbatches > 0 then
Progress(i / nrbatches)
else
Progress(0);
// generate points // generate points
case Compatibility of case Compatibility of

View File

@ -0,0 +1,168 @@
object frmPostProcess: TfrmPostProcess
Left = 0
Top = 0
Width = 434
Height = 320
Caption = 'Post Render'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 426
Height = 149
Align = alTop
BevelOuter = bvLowered
TabOrder = 0
DesignSize = (
426
149)
object Label1: TLabel
Left = 12
Top = 12
Width = 84
Height = 13
Caption = 'Background Color'
end
object Label2: TLabel
Left = 12
Top = 32
Width = 24
Height = 13
Caption = 'Filter'
end
object Label3: TLabel
Left = 12
Top = 52
Width = 35
Height = 13
Caption = 'Gamma'
end
object Label4: TLabel
Left = 12
Top = 72
Width = 45
Height = 13
Caption = 'Vibrancy:'
end
object Label5: TLabel
Left = 12
Top = 92
Width = 42
Height = 13
Caption = 'Contrast'
end
object Label6: TLabel
Left = 12
Top = 112
Width = 50
Height = 13
Caption = 'Brightness'
end
object btnSave: TButton
Left = 340
Top = 36
Width = 75
Height = 25
Anchors = [akTop, akRight]
Caption = '&Save'
TabOrder = 8
OnClick = btnSaveClick
end
object pnlBackColor: TPanel
Left = 104
Top = 8
Width = 97
Height = 21
BevelOuter = bvLowered
TabOrder = 0
OnClick = pnlBackColorClick
end
object ProgressBar1: TProgressBar
Left = 1
Top = 136
Width = 424
Height = 12
Align = alBottom
Min = 0
Max = 100
TabOrder = 1
end
object btnApply: TButton
Left = 340
Top = 8
Width = 75
Height = 25
Anchors = [akTop, akRight]
Caption = '&Apply'
Default = True
TabOrder = 7
OnClick = btnApplyClick
end
object txtFilterRadius: TEdit
Left = 104
Top = 28
Width = 97
Height = 21
TabOrder = 2
end
object txtGamma: TEdit
Left = 104
Top = 48
Width = 97
Height = 21
TabOrder = 3
end
object txtVib: TEdit
Left = 104
Top = 68
Width = 97
Height = 21
TabOrder = 4
end
object txtContrast: TEdit
Left = 104
Top = 88
Width = 97
Height = 21
TabOrder = 5
end
object txtBrightness: TEdit
Left = 104
Top = 108
Width = 97
Height = 21
TabOrder = 6
end
end
object ScrollBox1: TScrollBox
Left = 0
Top = 149
Width = 426
Height = 137
Align = alClient
TabOrder = 1
object Image: TImage
Left = 0
Top = 0
Width = 105
Height = 105
AutoSize = True
end
end
object ColorDialog: TColorDialog
Ctl3D = True
Left = 284
Top = 4
end
end

View 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.