mirror-github-bspeice/apophysis
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

screensaver

Browse Source
This commit is contained in:
ronaldhordijk
2005-07-23 09:19:11 +00:00
parent ac49ddb123
commit e03da98d5d
10 changed files with 1602 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

146
2.10/ScreenSaver/FlameIO.pas Normal file
View File

@ -0,0 +1,146 @@
unit FlameIO;
interface
uses
Controlpoint;
function FlameToXML(const cp1: TControlPoint; sheep: boolean; compact: boolean = false): string;
implementation
uses
Classes, SysUtils, xForm;
function NumXForms(const cp: TControlPoint): integer;
var
i: integer;
begin
Result := NXFORMS;
for i := 0 to NXFORMS - 1 do begin
if cp.xform[i].density = 0 then
begin
Result := i;
Break;
end;
end;
end;
function CleanXMLName(ident: string): string;
var
i: integer;
begin
for i := 0 to Length(ident) do
begin
if ident[i] = '*' then
ident[i] := '_'
else if ident[i] = '"' then
ident[i] := #39;
end;
Result := ident;
end;
function ColorToXmlCompact(cp1: TControlPoint): string;
var
i: integer;
begin
Result := ' <colors count="256" data="';
for i := 0 to 255 do begin
Result := Result + IntToHex(0,2)
+ IntToHex(cp1.cmap[i, 0],2)
+ IntToHex(cp1.cmap[i, 1],2)
+ IntToHex(cp1.cmap[i, 2],2);
end;
Result := Result + '"/>';
end;
function ColorToXml(cp1: TControlPoint): string;
var
i: integer;
begin
Result := '';
for i := 0 to 255 do begin
Result := Result + ' <color index="' + IntToStr(i) +
'" rgb="' + IntToStr(cp1.cmap[i, 0]) + ' ' +
IntToStr(cp1.cmap[i, 1]) + ' ' +
IntToStr(cp1.cmap[i, 2]) + '"/>' + #13#10;
end;
end;
function FlameToXML(const cp1: TControlPoint; sheep: boolean; compact: boolean = false): string;
var
t, i, j: integer;
FileList: TStringList;
x, y, a, b, cc, d, e, f: double;
varlist, nick, url, pal, hue: string;
begin
FileList := TStringList.create;
x := cp1.center[0];
y := cp1.center[1];
pal := ''; hue := '';
if sheep then
begin
pal := 'palette="' + IntToStr(cp1.cmapindex) + '" ';
hue := 'hue="' + format('%g', [cp1.hue_rotation]) + '" ';
end;
// if Trim(SheepNick) <> '' then nick := 'nick="' + Trim(SheepNick) + '"';
// if Trim(SheepURL) <> '' then url := 'url="' + Trim(SheepURL) + '" ';
try
FileList.Add('<flame name="' + CleanXMLName(cp1.name) + format('" time="%g" ', [cp1.time]) +
pal + 'size="' + IntToStr(cp1.width) + ' ' + IntToStr(cp1.height) +
format('" center="%g %g" ', [x, y]) +
format('scale="%g" ', [cp1.pixels_per_unit]) +
format('angle="%g" ', [cp1.FAngle]) +
format('rotate="%g" ', [-180 * cp1.FAngle/Pi]) +
format('zoom="%g" ', [cp1.zoom]) +
'oversample="' + IntToStr(cp1.spatial_oversample) +
format('" filter="%g" ', [cp1.spatial_filter_radius]) +
format('quality="%g" ', [cp1.sample_density]) +
'batches="' + IntToStr(cp1.nbatches) +
format('" background="%g %g %g" ', [cp1.background[0] / 255, cp1.background[1] / 255, cp1.background[2] / 255]) +
format('brightness="%g" ', [cp1.brightness]) +
format('gamma="%g" ', [cp1.gamma]) +
format('vibrancy="%g" ', [cp1.vibrancy]) + hue + url + nick + '>');
{ Write transform parameters }
t := NumXForms(cp1);
for i := 0 to t - 1 do
begin
with cp1.xform[i] do
begin
a := c[0][0];
b := c[1][0];
cc := c[0][1];
d := c[1][1];
e := c[2][0];
f := c[2][1];
varlist := '';
for j := 0 to NRVAR - 1 do
begin
if vars[j] <> 0 then
begin
varlist := varlist + varnames[j] + format('="%f" ', [vars[j]]);
end;
end;
FileList.Add(Format(' <xform weight="%g" color="%g" symmetry="%g" ', [density, color, symmetry]) +
varlist + Format('coefs="%g %g %g %g %g %g"/>', [a, cc, b, d, e, f]));
end;
end;
{ Write palette data }
if not sheep then begin
if not compact then
FileList.Add(ColorToXml(cp1));
FileList.Add(ColorToXmlcompact(cp1));
end;
FileList.Add('</flame>');
result := FileList.text;
finally
FileList.free
end;
end;
end.

163
2.10/ScreenSaver/ScrConfig.dfm Normal file
View File

@ -0,0 +1,163 @@
object frmConfig: TfrmConfig
Left = 422
Top = 262
BorderStyle = bsToolWindow
Caption = 'Configure'
ClientHeight = 330
ClientWidth = 201
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Panel2: TPanel
Left = 0
Top = 299
Width = 201
Height = 31
Align = alBottom
BevelOuter = bvLowered
TabOrder = 0
object btnOk: TButton
Left = 40
Top = 5
Width = 75
Height = 21
Caption = '&Ok'
Default = True
ModalResult = 1
TabOrder = 0
OnClick = btnOkClick
end
object btnCancel: TButton
Left = 120
Top = 5
Width = 75
Height = 21
Cancel = True
Caption = '&Cancel'
ModalResult = 2
TabOrder = 1
OnClick = btnCancelClick
end
end
object Panel3: TPanel
Left = 0
Top = 200
Width = 201
Height = 99
Align = alBottom
BevelOuter = bvLowered
TabOrder = 1
object Label1: TLabel
Left = 8
Top = 10
Width = 92
Height = 13
Caption = 'Oversample <1 - 3>'
end
object Label2: TLabel
Left = 8
Top = 30
Width = 76
Height = 13
Caption = 'Filter <0.2 - 2.0>'
end
object Label3: TLabel
Left = 8
Top = 50
Width = 62
Height = 13
Caption = 'Filter in pixels'
end
object Label4: TLabel
Left = 8
Top = 70
Width = 71
Height = 13
Caption = 'Sample density'
end
object edtOversample: TEdit
Left = 152
Top = 8
Width = 41
Height = 21
TabOrder = 0
Text = '1'
OnExit = edtOversampleExit
end
object edtFiltersize: TEdit
Left = 152
Top = 28
Width = 41
Height = 21
TabOrder = 1
Text = '0.1'
OnExit = edtFiltersizeExit
end
object edtDensity: TEdit
Left = 152
Top = 68
Width = 41
Height = 21
TabOrder = 2
Text = '10'
OnExit = edtDensityExit
end
object pnlFilterpixels: TPanel
Left = 152
Top = 48
Width = 41
Height = 21
Alignment = taLeftJustify
BevelOuter = bvLowered
BorderWidth = 2
Caption = '1'
TabOrder = 3
end
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 201
Height = 137
Align = alTop
BevelOuter = bvLowered
TabOrder = 2
object chkSave: TCheckBox
Left = 8
Top = 8
Width = 97
Height = 17
Caption = 'Save images'
TabOrder = 0
end
object chkShowOtherImages: TCheckBox
Left = 8
Top = 24
Width = 177
Height = 17
Caption = 'Show previous rendered images'
TabOrder = 1
end
object rgQuality: TRadioGroup
Left = 8
Top = 48
Width = 185
Height = 81
Caption = 'Quality'
Items.Strings = (
'Low'
'Medium'
'High'
'User defined')
TabOrder = 2
OnClick = rgQualityClick
end
end
end

181
2.10/ScreenSaver/ScrConfig.pas Normal file
View File

@ -0,0 +1,181 @@
unit ScrConfig;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TfrmConfig = class(TForm)
btnCancel: TButton;
btnOk: TButton;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
chkSave: TCheckBox;
chkShowOtherImages: TCheckBox;
rgQuality: TRadioGroup;
edtOversample: TEdit;
edtFiltersize: TEdit;
edtDensity: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
pnlFilterpixels: TPanel;
procedure btnCancelClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnOkClick(Sender: TObject);
procedure rgQualityClick(Sender: TObject);
procedure edtDensityExit(Sender: TObject);
procedure edtFiltersizeExit(Sender: TObject);
procedure edtOversampleExit(Sender: TObject);
private
procedure SetFilterPixels;
{ Private declarations }
public
{ Public declarations }
end;
var
frmConfig: TfrmConfig;
implementation
{$R *.dfm}
uses
ControlPoint, Registry;
procedure TfrmConfig.FormCreate(Sender: TObject);
var
Registry: TRegistry;
begin
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('\Software\BobsFreubels\FlameSS', False) then begin
if Registry.ValueExists('SaveImage') then begin
chkSave.Checked := Registry.ReadBool('SaveImage');
end else begin
chkSave.Checked := False;
end;
if Registry.ValueExists('ShowOtherImages') then begin
chkShowOtherImages.Checked := Registry.ReadBool('ShowOtherImages');
end else begin
chkShowOtherImages.Checked := False;
end;
if Registry.ValueExists('Quality') then begin
rgQuality.itemindex := Registry.ReadInteger('Quality');
end else begin
rgQuality.itemindex := 1;
end;
if Registry.ValueExists('Oversample') then begin
edtOversample.Text := IntToStr(Registry.ReadInteger('Oversample'));
end else begin
edtOversample.Text := '1';
end;
if Registry.ValueExists('Filter') then begin
edtFiltersize.Text := FloatToStr(Registry.ReadFloat('Filter'));
end else begin
edtFiltersize.Text := '0.1';
end;
if Registry.ValueExists('Density') then begin
edtDensity.Text := FloatToStr(Registry.ReadFloat('Density'));
end else begin
edtDensity.Text := '100';
end;
end else begin
chkSave.Checked := False;
chkShowOtherImages.Checked := False;
rgQuality.itemindex := 1;
edtOversample.Text := '1';
edtFiltersize.Text := '0.1';
edtDensity.Text := '100';
end;
finally
Registry.Free;
end;
SetFilterPixels;
rgQualityClick(nil);
end;
procedure TfrmConfig.btnCancelClick(Sender: TObject);
begin
Close
end;
procedure TfrmConfig.btnOkClick(Sender: TObject);
var
Registry: TRegistry;
begin
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('\Software\BobsFreubels\FlameSS', True) then begin
Registry.WriteBool('SaveImage', chkSave.Checked);
Registry.WriteBool('ShowOtherImages', chkShowOtherImages.Checked);
Registry.WriteInteger('Quality', rgQuality.itemindex);
Registry.WriteInteger('Oversample', StrToInt(edtOversample.Text));
Registry.WriteFloat('Filter', StrToFloat(edtFiltersize.Text));
Registry.WriteFloat('Density', StrToFloat(edtDensity.Text));
end;
finally
Registry.Free;
end;
Close
end;
procedure TfrmConfig.edtOversampleExit(Sender: TObject);
begin
try
StrToInt(edtOversample.Text);
except
edtOversample.Text := '1';
end;
SetFilterPixels
end;
procedure TfrmConfig.edtFiltersizeExit(Sender: TObject);
begin
try
StrToFloat(edtFiltersize.Text);
except
edtFiltersize.Text := '0.1';
end;
SetFilterPixels
end;
procedure TfrmConfig.edtDensityExit(Sender: TObject);
begin
try
StrToFloat(edtDensity.Text);
except
edtDensity.Text := '10';
end;
end;
procedure TfrmConfig.SetFilterPixels;
var
filter_width: integer;
begin
filter_width := Round(2.0 * FILTER_CUTOFF * StrToFloat(edtFiltersize.Text) * StrToInt(edtOversample.Text) );
if odd(filter_width + StrToInt(edtOversample.Text)) then
inc(filter_width);
pnlFilterpixels.Caption := IntToStr(filter_width);
end;
procedure TfrmConfig.rgQualityClick(Sender: TObject);
begin
if rgQuality.ItemIndex = 3 then
ClientHeight := panel1.Height + Panel2.Height + panel3.Height
else
ClientHeight := panel1.Height + Panel2.Height;
end;
end.

25
2.10/ScreenSaver/ScrMain.dfm Normal file
View File

@ -0,0 +1,25 @@
object frmMain: TfrmMain
Left = 223
Top = 103
BorderStyle = bsNone
Caption = 'Main'
ClientHeight = 146
ClientWidth = 231
Color = clBlack
Font.Charset = ANSI_CHARSET
Font.Color = clWindow
Font.Height = -21
Font.Name = 'Times New Roman'
Font.Style = [fsBold, fsItalic]
OldCreateOrder = False
WindowState = wsMaximized
OnActivate = FormActivate
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyDown = FormKeyDown
OnMouseDown = FormMouseDown
OnPaint = FormPaint
PixelsPerInch = 96
TextHeight = 24
end

444
2.10/ScreenSaver/ScrMain.pas Normal file
View File

@ -0,0 +1,444 @@
unit ScrMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Gauges, Render64, ControlPoint;
type
TfrmMain = class(TForm)
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
cp : TControlPoint;
Render: TRenderer64;
bStop : boolean;
bm: TBitmap;
Quality: integer;
bSave: boolean;
bShowOtherImages: boolean;
Oversample: Integer;
FilterSize: double;
Density: double;
SaveIndex: integer;
SavePath: string;
ImageList: TStringList;
ShowNextImage: TDateTime;
StartTime: TDateTime;
Remainder: TDateTime;
procedure ReadSettings;
procedure PrePareSave;
procedure Save;
public
procedure Onprogress(prog: double);
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
uses
math, jpeg, registry, FlameIO,
rndFlame, regstry, global;
procedure TfrmMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Close;
end;
procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Close;
end;
procedure TfrmMain.FormActivate(Sender: TObject);
begin
DecimalSeparator := '.';
OnActivate := nil;
ShowCursor(False);
ReadSettings;
Remainder := 1;
// first one quickly
cp.ParseString( 'pixels_per_unit 277.456647 center -1.0982659 0 gamma 2 spatial_filter_radius' +
' 0.5 contrast 1 brightness 1.5 zoom 0 spatial_oversample 1 sample_density 1 nbatches' +
' 1 white_level 200 cmap_inter 0 time 0 cmap 33 xform 0 density 1 color 0 var 0 0 0 1 0' +
' 0 0 coefs 0.466381997 -0.0618700013 0.0792416036 0.610638022 -0.475656986 -0.28115499'+
' xform 1 density 1 color 1 var 0 0 0 0 1 0 0 coefs -0.513867021 0.271649003 -0.254521996' +
' -0.550984025 -0.674094975 -0.600323975');
(*
'center 0.01 1.96 pixels_per_unit 145.24' +
'spatial_oversample 3 spatial_filter_radius 0.30' +
'sample_density 200.00' +
'nbatches 1 white_level 200 background 0.00 0.00 0.00' +
'brightness 4.00 gamma 4.00 vibrancy 1.00 hue_rotation 0.68 cmap_inter 0' +
'xform 0 density 0.17 color 1.00' +
'var 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00' +
'coefs 0.94 0.69 -0.27 0.75 1.67 0.29' +
'xform 1 density 0.17 color 0.00' +
'var 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00' +
'coefs -0.07 -0.94 0.69 -0.15 1.93 -1.57' +
'xform 2 density 0.17 color 0.00' +
'var 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00' +
'coefs 0.42 -0.37 -0.88 -0.25 -0.65 0.22' +
'xform 3 density 0.17 color 0.00' +
'var 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00' +
'coefs 0.61 0.99 0.06 0.51 -1.59 -1.58' +
'xform 4 density 0.17 color 0.00' +
'var 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00' +
'coefs -0.77 0.12 -0.36 -0.69 -0.74 1.53' +
'xform 5 density 0.17 color 0.00 ' +
'var 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00' +
'coefs 0.58 -0.20 -0.92 0.60 -0.29 1.30');
*)
cp.sample_density := 2;
cp.Width := ClientWidth;
cp.Height := ClientHeight;
cp.spatial_oversample := 1;
cp.spatial_filter_radius := 0.3;
cp.Gamma := 4;
cp.brightness := 4;
cp.CalcBoundbox;
Render.SetCP(cp);
StartTime := Now;
Render.Render;
if bstop then
Exit;
BM.Assign(Render.GetImage);
Canvas.StretchDraw(Rect(0,0,ClientWidth, ClientHeight),bm);
PrepareSave;
if bstop then
Exit;
ShowNextImage := Now + EncodeTime(0,0,5,0);
cp.Width := ClientWidth;
cp.Height := ClientHeight;
cp.spatial_filter_radius := 0.2;
cp.Gamma := 4;
cp.brightness := 4;
cp.spatial_oversample := 1;
Case Quality of
0:
begin
cp.sample_density := 10;
end;
1:
begin
cp.sample_density := 100;
end;
2:
begin
cp.sample_density := 1000;
end;
else
begin
cp.sample_density := Density;
cp.spatial_oversample := Oversample;
cp.spatial_filter_radius := FilterSize;
end;
end;
// APO setting for randomflame
regstry.ReadSettings;
Global.MainSeed := Round(Random(100000));
while true do begin
Remainder := 0;
// cp.RandomCP;
(*
cp2 := cp.Clone;
cp2.pixels_per_unit := (cp.pixels_per_unit * 128)/cp.Width;
cp2.width := 256;
cp2.height := 256;
cp2.spatial_oversample := 1;
cp2.spatial_filter_radius := 0.1;
cp2.sample_density := 1;
cp2.gamma := 2;
cp2.brightness := 1;
cp2.contrast := 1;
Render.SetCP(cp2);
Render.Test(fracBlack, fracWhite, avgColor);
cp2.Free;
*)
// Canvas.Draw(0,100,Render.GetImage);
// if (fracBlack > 0.990) or ((avgColor/(fracBlack + 1E-6)) < 0.35) then
// Continue;
cp := RandomFlame(cp,0);
cp.Width := ClientWidth;
cp.Height := ClientHeight;
cp.spatial_filter_radius := 0.2;
cp.Gamma := 4;
cp.brightness := 4;
cp.spatial_oversample := 1;
Case Quality of
0:
begin
cp.sample_density := 10;
end;
1:
begin
cp.sample_density := 100;
end;
2:
begin
cp.sample_density := 1000;
end;
else
begin
cp.sample_density := Density;
cp.spatial_oversample := Oversample;
cp.spatial_filter_radius := FilterSize;
end;
end;
cp.CalcBoundbox;
Remainder := 1;
Render.SetCP(cp);
StartTime := Now;
Render.Render;
if bstop then
Exit;
bm.assign(Render.GetImage);
// bm.Canvas.Font.Color := ClWhite;
// bm.Canvas.Brush.Color := CLBlack;
// bm.Canvas.TextOut(10,10, Format('fracBlack : %.4f',[fracBlack] ));
// bm.Canvas.TextOut(10,26, Format('fracWhite : %.4f',[fracWhite] ));
// bm.Canvas.TextOut(10,42, Format('avgColor : %.4f',[avgColor] ));
// bm.Canvas.TextOut(10,58, Format('ColorValue: %.4f',[avgColor/fracBlack] ));
Canvas.Draw(0,0,bm);
Save;
ShowNextImage := Now + EncodeTime(0,0,30,0);
end;
end;
procedure TfrmMain.Onprogress(prog: double);
var
JPeg: TJPEGImage;
NewIndex: Integer;
Elapsed: TDateTime;
begin
if bstop then
Exit;
if bShowOtherImages and (Now > ShowNextImage) and (ImageList.Count > 0) then begin
NewIndex := Random(ImageList.Count);
JPeg := TJPEGImage.Create;
JPeg.LoadFromFile(SavePath + ImageList[NewIndex]);
bm.Assign(JPeg);
JPeg.Free;
repaint;
SetbkMode(Canvas.Handle, TRANSPARENT);
Canvas.TextOut(ClientWidth - 150, 10, ImageList[NewIndex]);
ShowNextImage := Now + EncodeTime(0,0,10,0);
end;
prog := (Render.Slice + Prog)/Render.NrSlices;
// Canvas.Brush.Color := clBlack;
// Canvas.Fillrect(Rect(7, ClientHeight - 13, ClientWidth - 7, ClientHeight - 7));
// Canvas.Brush.Color := clBlack;
// Canvas.Fillrect(Rect(5, ClientHeight - 15, ClientWidth - 5, ClientHeight - 5));
Canvas.Brush.Color := clYellow;
Canvas.FrameRect(Rect(5, ClientHeight - 15, ClientWidth - 5, ClientHeight - 5));
Canvas.Brush.Color := clYellow;
Canvas.Fillrect(Rect(7, ClientHeight - 13, 7 + Round(prog * (ClientWidth - 14)), ClientHeight - 7));
Canvas.Brush.Color := clBlack;
Canvas.Fillrect(Rect(7 + Round(prog * (ClientWidth - 14)), ClientHeight - 13, ClientWidth - 7, ClientHeight - 7));
Elapsed := Now - StartTime;
Canvas.Brush.Color := clBlack;
Canvas.TextOut(5, ClientHeight - 25 - 2 * Canvas.TextHeight('X'), Format('Elapsed %2.2d:%2.2d:%2.2d.%2.2d',
[Trunc(Elapsed * 24),
Trunc((Elapsed * 24 - Trunc(Elapsed * 24)) * 60),
Trunc((Elapsed * 24 * 60 - Trunc(Elapsed * 24 * 60)) * 60),
Trunc((Elapsed * 24 * 60 * 60 - Trunc(Elapsed * 24 * 60 * 60)) * 100)]));
if prog > 0 then
Remainder := Min(Remainder, Elapsed * (power(1/prog, 1.2) - 1));
Canvas.TextOut(5, ClientHeight - 20 - Canvas.TextHeight('X'), Format('Remainder %2.2d:%2.2d:%2.2d.%2.2d',
[Trunc(Remainder * 24),
Trunc((Remainder * 24 - Trunc(Remainder * 24)) * 60),
Trunc((Remainder * 24 * 60 - Trunc(Remainder * 24 * 60)) * 60),
Trunc((Remainder * 24 * 60 * 60 - Trunc(Remainder * 24 * 60 * 60)) * 100)]));
Canvas.TextOut(5, ClientHeight - 50 - Canvas.TextHeight('X'), IncludeTrailingPathDelimiter(ExtractFileDir(paramstr(0))) + 'images');
Application.ProcessMessages;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
bm:= TBitmap.create;
randomize;
cp := TControlPoint.Create;
Render := TRenderer64.Create;
Render.OnProgress := Onprogress;
ImageList := TStringList.Create;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
ShowCursor(true);
cp.Free;
render.Free;
ImageList.Free;
end;
procedure TfrmMain.FormPaint(Sender: TObject);
begin
if assigned(bm) then
Canvas.Draw(0,0,bm);
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
bm.Free;
Render.Stop;
bStop := True;
end;
procedure TfrmMain.ReadSettings;
var
Registry: TRegistry;
begin
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('\Software\BobsFreubels\FlameSS', False) then begin
if Registry.ValueExists('SaveImage') then begin
bSave := Registry.ReadBool('SaveImage');
end else begin
bSave := False;
end;
if Registry.ValueExists('ShowOtherImages') then begin
bShowOtherImages := Registry.ReadBool('ShowOtherImages');
end else begin
bShowOtherImages := False;
end;
if Registry.ValueExists('Quality') then begin
Quality := Registry.ReadInteger('Quality');
end else begin
Quality := 1;
end;
if Registry.ValueExists('Oversample') then begin
Oversample := Registry.ReadInteger('Oversample');
end else begin
Oversample := 1;
end;
if Registry.ValueExists('Filter') then begin
Filtersize := Registry.ReadFloat('Filter');
end else begin
Filtersize := 0.1;
end;
if Registry.ValueExists('Density') then begin
Density := Registry.ReadFloat('Density');
end else begin
Density := 100;
end;
end else begin
bSave := False;
Quality := 1;
end;
finally
Registry.Free;
end;
end;
procedure TfrmMain.PrePareSave;
var
sr: TSearchRec;
begin
// if not bSave then
// Exit;
SaveIndex := 1;
SavePath := IncludeTrailingPathDelimiter(ExtractFileDir(paramstr(0))) + 'images';
SavePath := IncludeTrailingPathDelimiter(SavePath);
ForceDirectories(SavePath);
if FindFirst(SavePath + '*.jpg', faAnyFile, sr) = 0 then begin
repeat
ImageList.Add(UpperCase(sr.Name));
until FindNext(sr) <> 0;
FindClose(sr);
end;
end;
procedure TfrmMain.Save;
var
sl: TStringlist;
ImageName: string;
jpeg : TJPegImage;
begin
if not bSave then
Exit;
repeat
ImageName := Format('FL_%5.5d.JPG',[SaveIndex]);
Inc(SaveIndex);
until (ImageList.IndexOf(ImageName) < 0);
jpeg := TJPegImage.Create;
jpeg.assign(bm);
jpeg.CompressionQuality := 80;
jpeg.SaveToFile(SavePath+ImageName);
jpeg.free;
ImageList.Add(ImageName);
sl := TStringlist.Create;
Cp.name := ChangeFileExt(ImageName,'');
sl.add(FlameToXML(cp,False, True));
sl.SaveToFile(ChangeFileExt(SavePath+ImageName,'.flame'));
sl.Free;
// cp.SaveToFile(ChangeFileExt(SavePath+ImageName,'.TXT'));
end;
end.