apophysis/2.10/Source/formPostProcess.pas

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.