mirror-github-bspeice/Apophysis-AV
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
b1552d0ebc
Apophysis-AV/Forms/formPostProcess.pas

565 lines
16 KiB
ObjectPascal
Raw Blame History

{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
Apophysis AV "Phoenix Edition" Copyright (C) 2021-2022 Alice V. Koryagina
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit formPostProcess;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, RenderingInterface, ControlPoint, StdCtrls, ComCtrls;
type
TfrmPostProcess = class(TForm)
Panel1: TPanel;
ScrollBox1: TScrollBox;
Image: TImage;
pnlBackColor: TPanel;
ColorDialog: TColorDialog;
ProgressBar1: TProgressBar;
txtFilterRadius: TEdit;
txtGamma: TEdit;
txtVibrancy: TEdit;
txtContrast: TEdit;
txtBrightness: TEdit;
pnlGamma: TPanel;
pnlBrightness: TPanel;
pnlContrast: TPanel;
pnlVibrancy: TPanel;
pnlFilter: TPanel;
shBack: TShape;
pnlBackground: TPanel;
btnSave: TButton;
chkFitToWindow: TCheckBox;
btnApply: TButton;
pnlRelGamma: TPanel;
txtRelGamma: TEdit;
// procedure chkFitToWindowClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
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);
procedure DragPanelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DragPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure DragPanelMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DragPanelDblClick(Sender: TObject);
procedure shBackMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure EditKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
FRenderer: TBaseRenderer;
FCP: TControlPoint;
FImagename: string;
pnlDragMode, pnlDragged, pnlMM: boolean;
pnlDragPos, pnlDragOld: integer;
pnlDragValue: double;
mousepos: TPoint;
BkgColor: TColor;
Filter, Gamma, Brightness, RelGamma, Contrast, Vibrancy: double;
ImCount: shortint; // AV: the number of saved images
procedure UpdateFlame;
procedure SetDefaultValues;
procedure OnProgress(prog: double);
public
cp : TControlPoint;
procedure SetRenderer(Renderer: TBaseRenderer);
procedure SetControlPoint(CP: TControlPoint);
procedure SetImageName(imagename: string);
end;
var
frmPostProcess: TfrmPostProcess;
implementation
uses
Registry, Global, Main, Translation;
{$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;
ImCount := -1; // AV: reset the counter
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;
FRenderer.Free; // weirdness!!! :-/
FRenderer := nil;
Image.Picture.Graphic := nil;
FCP.Free;
FCP := nil;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.SetDefaultValues;
begin
BkgColor := RGB(Fcp.background[0], Fcp.background[1], Fcp.background[2]);
pnlBackColor.Color := BkgColor;
shBack.Brush.Color := BkgColor;
Filter := FCP.spatial_filter_radius;
txtFilterRadius.Text := FloatTostr(Filter);
Gamma := FCP.gamma;
txtGamma.Text := FloatTostr(Gamma);
RelGamma := FCP.gammaThreshRelative; // AV
txtRelGamma.Text := FloatTostr(RelGamma); // AV
Vibrancy := FCP.vibrancy;
txtVibrancy.Text := FloatTostr(Vibrancy);
Contrast := FCP.contrast;
txtContrast.Text := FloatTostr(Contrast);
Brightness := FCP.brightness;
txtBrightness.Text := FloatTostr(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 := shBack.Brush.Color;
if ColorDialog.Execute then begin
pnlBackColor.Color := ColorDialog.Color;
shBack.Brush.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
Screen.Cursor := crHourGlass;
FRenderer.UpdateImage(FCP);
Image.Picture.Graphic := FRenderer.GetImage;
Screen.Cursor := crDefault;
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);
var
temp, tempg: double;
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;
// AV
if TryStrToFloat(txtRelGamma.Text, tempg) then FCP.gammathreshrelative := tempg;
if FCP.gammathreshrelative < 0 then begin
FCP.gammathreshrelative := 0;
txtRelGamma.Text := '0';
end;
TryStrToFloat(txtVibrancy.Text, FCP.vibrancy);
if FCP.vibrancy > 30 then begin // AV: maximum was 10,
FCP.vibrancy := 30; // but Apo allows to use higher values
txtVibrancy.Text := '30'; // AV
end else if FCP.vibrancy < 0.01 then begin
FCP.vibrancy := 0.01;
txtVibrancy.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;
if TryStrToFloat(txtBrightness.Text, temp) then FCP.brightness := temp;
//TryStrToFloat(txtBrightness.Text, FCP.brightness);
if FCP.brightness > 100 then begin
FCP.brightness := 100;
txtBrightness.Text := '100';
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);
var NewName: string; // AV
begin
inc(ImCount);
if ImCount = 0 then
FRenderer.SaveImage(FImagename)
else begin // AV: enumerating different versions of the image
NewName := FImagename;
Insert(' (' + IntToStr(ImCount) + ')', NewName, length(NewName) - 3);
FRenderer.SaveImage(NewName);
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.SetImageName(imagename: string);
begin
FImagename := imagename;
end;
// -----------------------------------------------------------------------------
procedure TfrmPostProcess.DragPanelMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button <> mbLeft then exit;
if (Sender = pnlFilter) then
pnlDragValue := fcp.spatial_filter_radius * 10
else if (Sender = pnlGamma) then
pnlDragValue := fcp.gamma
else if (Sender = pnlRelGamma) then // AV
pnlDragValue := fcp.gammaThreshRelative * 10
else if (Sender = pnlBrightness) then
pnlDragValue := fcp.brightness
else if (Sender = pnlContrast) then
pnlDragValue := fcp.contrast
else if (Sender = pnlVibrancy) then
pnlDragValue := fcp.vibrancy
else exit;//assert(false);
pnlDragMode := true;
pnlDragPos := 0;
pnlDragOld := x;
pnlMM := false;
SetCaptureControl(TControl(Sender));
Screen.Cursor := crHSplit;
GetCursorPos(mousepos); // hmmm
pnlDragged := false;
end;
procedure TfrmPostProcess.DragPanelMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
v: double;
pEdit: ^TEdit;
enableDrag : boolean;
begin
if pnlMM then // hack: to skip MouseMove event
begin
pnlMM:=false;
end
else
if pnlDragMode and (x <> pnlDragOld) then
begin
Inc(pnlDragPos, x - pnlDragOld);
if GetKeyState(VK_MENU) < 0 then v := 100000
else if GetKeyState(VK_CONTROL) < 0 then v := 10000
else if GetKeyState(VK_SHIFT) < 0 then v := 100
else v := 1000;
v := Round6(pnlDragValue + pnlDragPos / v);
SetCursorPos(MousePos.x, MousePos.y); // hmmm
pnlMM:=true;
enableDrag := true;
if (Sender = pnlFilter) then
begin
v := v / 10;
if v > 2 then v := 2
else if v < 0.01 then v := 0.01;
fcp.spatial_filter_radius := v;
pEdit := @txtFilterRadius;
end
else if (Sender = pnlGamma) then
begin
if v > 10 then v := 10
else if v < 0.01 then v := 0.01;
fcp.gamma := v;
pEdit := @txtGamma;
end
else if (Sender = pnlRelGamma) then
begin
v := v * 0.1;
if v < 0 then v := 0;
fcp.gammaThreshRelative := v;
pEdit := @txtRelGamma;
end
else if (Sender = pnlBrightness) then
begin
if v > 100 then v := 100
else if v < 0.01 then v := 0.01;
fcp.brightness := v;
pEdit := @txtBrightness;
end
else if (Sender = pnlContrast) then
begin
if v > 10 then v := 10
else if v < 0.01 then v := 0.01;
fcp.contrast := v;
pEdit := @txtContrast;
end
else if (Sender = pnlVibrancy) then
begin
if v > 30 then v := 30 // AV: was 10, but higher values are allowed
else if v < 0.01 then v := 0.01;
fcp.vibrancy := v;
pEdit := @txtVibrancy;
end else exit;
if enableDrag then begin
pEdit^.Text := FloatToStr(v);
//pEdit.Refresh;
pnlDragged := True;
// TODO: image preview (?)
//DrawPreview;
end;
end;
end;
procedure TfrmPostProcess.DragPanelMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button <> mbLeft then exit;
if pnlDragMode then
begin
SetCaptureControl(nil);
pnlDragMode := false;
Screen.Cursor := crDefault;
if pnlDragged then
begin
//UpdateFlame;
pnlDragged := False;
end;
end;
end;
procedure TfrmPostProcess.EditKeyPress(Sender: TObject; var Key: Char);
begin // AV
if (Key = ',') then Key := '.'; //FormatSettings.DecimalSeparator;
if not CharinSet(Key,['0'..'9', #8, #13, '.'])
then Key:= #0;
end;
procedure TfrmPostProcess.DragPanelDblClick(Sender: TObject);
var
pValue: ^double;
pDefaultValue: ^double;
pEdit: ^TEdit;
begin
if (Sender = pnlFilter) then
begin
pValue := @fcp.spatial_filter_radius;
pDefaultValue := @Filter;
pEdit := @txtFilterRadius;
end
else if (Sender = pnlGamma) then
begin
pValue := @fcp.gamma;
pDefaultValue := @Gamma;
pEdit := @txtGamma;
end
else if (Sender = pnlRelGamma) then
begin
// AV: because it's a property, not a field
if fcp.gammaThreshRelative = RelGamma then exit;
fcp.gammaThreshRelative := RelGamma;
txtRelGamma.Text := FloatToStr(fcp.gammaThreshRelative);
exit;
end
else if (Sender = pnlBrightness) then
begin
if fcp.brightness = Brightness then exit;
fcp.brightness := Brightness;
txtBrightness.Text := FloatToStr(fcp.brightness);
exit;
end
else if (Sender = pnlContrast) then
begin
pValue := @fcp.contrast;
pDefaultValue := @Contrast;
pEdit := @txtContrast
end
else if (Sender = pnlVibrancy) then
begin
pValue := @fcp.vibrancy;
pDefaultValue := @Vibrancy;
pEdit := @txtVibrancy;
end
else exit; //assert(false);
if pValue^ = pDefaultValue^ then exit;
pValue^ := pDefaultValue^;
pEdit^.Text := FloatToStr(pValue^);
//UpdateFlame;
end;
procedure TfrmPostProcess.shBackMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
pnlBackColorClick(sender);
end;
procedure TfrmPostProcess.FormCreate(Sender: TObject);
begin
btnApply.Caption := TextByKey('common-apply');
pnlFilter.Caption := TextByKey('common-filterradius');
pnlGamma.Caption := TextByKey('common-gamma');
pnlRelGamma.Caption := TextByKey('common-gammathreshold');
pnlBrightness.Caption := TextByKey('common-brightness');
pnlContrast.Caption := TextByKey('common-contrast');
pnlVibrancy.Caption := TextByKey('common-vibrancy');
pnlBackground.Caption := TextByKey('common-background');
pnlFilter.Hint := TextByKey('common-dragpanelhint');
pnlGamma.Hint := TextByKey('common-dragpanelhint');
pnlBrightness.Hint := TextByKey('common-dragpanelhint');
pnlVibrancy.Hint := TextByKey('common-dragpanelhint');
pnlContrast.Hint := TextByKey('common-dragpanelhint');
pnlRelGamma.Hint := TextByKey('common-dragpanelhint');
self.Caption := TextByKey('postprocess-title');
btnSave.Caption := TextByKey('postprocess-save');
chkFitToWindow.Caption := TextByKey('postprocess-fittowindow');
end;
{
procedure TfrmPostProcess.chkFitToWindowClick(Sender: TObject);
begin
if (chkFitToWindow.Checked) then begin
Image.Stretch := true;
Image.Align := alClient;
end else begin
Image.Stretch := false;
Image.Align := alNone;
end;
end;
}
end.
Reference in New Issue View Git Blame Copy Permalink