{ 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 ScriptRender; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls, RenderThread, ControlPoint; type TScriptRenderForm = class(TForm) btnCancel: TButton; ProgressBar: TProgressBar; procedure FormDestroy(Sender: TObject); procedure FormCreate(Sender: TObject); procedure btnCancelClick(Sender: TObject); private StartTime: TDateTime; Remainder: TDateTime; Filename: string; procedure HandleThreadCompletion(var Message: TMessage); message WM_THREAD_COMPLETE; procedure HandleThreadTermination(var Message: TMessage); message WM_THREAD_TERMINATE; public Renderer: TRenderThread; cp: TControlPoint; procedure OnProgress(prog: double); procedure Render; procedure SetRenderBounds; end; var ScriptRenderForm: TScriptRenderForm; Cancelled: boolean; implementation uses Global, Math, FormRender, ScriptForm, Main, Translation; {$R *.DFM} procedure TScriptRenderForm.SetRenderBounds; // AV: do not use it - just waste of time begin cp.copy(ScriptEditor.cp); cp.AdjustScale(ScriptEditor.Renderer.Width, ScriptEditor.Renderer.Height); end; procedure TScriptRenderForm.Render; var ScrRender: TScriptRender; // AV begin assert(not Assigned(Renderer)); Renderer := TRenderThread.Create; Cancelled := False; ScriptEditor.Scripter.Paused := True; StartTime := Now; Remainder := 1; //cp.copy(ScriptEditor.cp); // <-- AV: already done by RenderProc ScrRender := ScriptEditor.Renderer; // AV: for speed Filename := ScrRender.Filename; cp.AdjustScale(ScrRender.Width, ScrRender.Height); if (UpperCase(ExtractFileExt(FileName)) = '.PNG') then begin // AV: added new property cp.Transparency := (PNGTransparency <> 0); if ScrRender.EmbedParameters then Renderer.EmbedText(Trim(FlameToXML(cp))); // AV end else cp.Transparency := False; // AV Renderer.OnProgress := OnProgress; Renderer.SetCP(cp); if (ScrRender.MaxMemory > 0) then Renderer.MaxMem := ScrRender.MaxMemory; Renderer.TargetHandle := Handle; renderPath := ExtractFilePath(Filename); Renderer.Priority := tpLower; Renderer.NrThreads := NrTreads; // AV: now works fine Renderer.Resume; // Renderer.SaveImage(FileName); // ScriptEditor.Scripter.Paused := False; end; procedure TScriptRenderForm.OnProgress(prog: double); var Elapsed: TDateTime; begin prog := (Renderer.Slice + Prog) / Renderer.NrSlices; ProgressBar.Position := round(100 * prog); Elapsed := Now - StartTime; // if prog > 0 then Remainder := Elapsed * (1/prog - 1); //Application.ProcessMessages; end; procedure TScriptRenderForm.FormDestroy(Sender: TObject); begin cp.free; assert(not Assigned(Renderer)); //if Assigned(Renderer) then Renderer.free; end; procedure TScriptRenderForm.FormCreate(Sender: TObject); begin self.Hint := TextByKey('script-rendering'); btnCancel.Caption := TextByKey('common-cancel'); cp := TControlPoint.Create; end; procedure TScriptRenderForm.btnCancelClick(Sender: TObject); begin ScriptEditor.Scripter.Halt; Cancelled := True; if Assigned(Renderer) then begin Renderer.Terminate; Renderer.WaitFor; Renderer.Free; Renderer := nil; end; LastError := TextByKey('script-status-cancelrender'); end; procedure TScriptRenderForm.HandleThreadCompletion(var Message: TMessage); begin Renderer.SaveImage(FileName); Renderer.Free; Renderer := nil; ScriptEditor.Scripter.Paused := False; end; procedure TScriptRenderForm.HandleThreadTermination(var Message: TMessage); begin if Assigned(Renderer) then begin Renderer.Free; Renderer := nil; end; end; end.