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

Initial commit

Browse Source
This commit is contained in:
Alice Vital
2022-03-08 20:25:51 +03:00
commit 25a72c3c86
187 changed files with 154390 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5367
Forms/About.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

163
Forms/About.pas Normal file
View File

@ -0,0 +1,163 @@
{
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 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 About;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Global, Translation;
type
TAboutForm = class(TForm)
btnOK: TButton;
Label3: TLabel;
Label4: TLabel;
Label10: TLabel;
Label11: TLabel;
lblFlamecom: TLabel;
Bevel1: TBevel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Bevel3: TBevel;
Label17: TLabel;
Label18: TLabel;
Label16: TLabel;
Label2: TLabel;
Bevel2: TBevel;
Label19: TLabel;
Label20: TLabel;
Image1: TImage;
Label5: TLabel;
Bevel4: TBevel;
Label1: TLabel;
Label15: TLabel;
Bevel5: TBevel;
Label21: TLabel;
lbApoTitle: TLabel;
lbApoVers: TLabel;
Label24: TLabel;
Bevel6: TBevel;
lblAuthor: TLabel;
Label26: TLabel;
Label27: TLabel;
Label28: TLabel;
Bevel7: TBevel;
Bevel8: TBevel;
lblPlugins: TLabel;
Bevel9: TBevel;
lblVersion: TLabel;
procedure btnOKClick(Sender: TObject);
procedure lblPluginsClick(Sender: TObject);
procedure DevelopersClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure SetTitleColor;
end;
var
AboutForm: TAboutForm;
implementation
uses Main, ShellAPI;
{$R *.DFM}
procedure TAboutForm.btnOKClick(Sender: TObject);
begin
ModalResult := mrOK;
end;
procedure TAboutForm.lblPluginsClick(Sender: TObject);
var URL : String;
begin
URL := lblPlugins.Hint;
ShellExecute(ValidParentForm(Self).Handle, 'open', PChar(URL), nil, nil, SW_SHOWNORMAL);
URL := 'https://onedrive.live.com/?authkey=%21AEhvN24LOQKCzBY&cid=828A1C23C17CA4C9&id=828A1C23C17CA4C9%211037&parId=root&action=locate';
ShellExecute(ValidParentForm(Self).Handle, 'open', PChar(URL), nil, nil, SW_SHOWNORMAL);
end;
procedure TAboutForm.SetTitleColor;
var clr: TColor;
begin
if IsDarkTheme or (CurrentStyle = 'Cyan Night') or (CurrentStyle = 'Calypso SLE')
or (CurrentStyle = 'Obsidian') or (CurrentStyle = 'Metropolis UI Green') then
clr := BrightColor
else
clr := clMaroon;
lbApoTitle.Font.Color := clr;
lbApoVers.Font.Color := clr;
end;
procedure TAboutForm.DevelopersClick(Sender: TObject);
begin
ShellExecute(ValidParentForm(Self).Handle, 'open', PChar(TLabel(Sender).Hint),
nil, nil, SW_SHOWNORMAL);
end;
procedure TAboutForm.FormCreate(Sender: TObject);
var s1, s2, s3: string;
AVFont: TResourceStream;
begin
btnOK.Caption := TextByKey('common-close');
if (LanguageFile <> AvailableLanguages.Strings[0]) and (LanguageFile <> '') then
begin
LanguageInfo(LanguageFile, s1, s2);
s3 := LanguageAuthor(LanguageFile);
Label20.Visible := (s2 <> '') and (s3 <> '');
Label20.Caption := s2 + #32 + TextByKey('common-translation') + #32#32 + s3;
end;
lblPlugins.Caption := TextByKey('common-pluginlink');
Label3.Caption := TextByKey('common-thirdparty');
SetTitleColor;
if (pos(LowerCase(s1), 'russian') > 0) or (pos(LowerCase(s1), '<27><><EFBFBD><EFBFBD><EFBFBD>') > 0) then
lblAuthor.Caption := '<27><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
if Screen.Fonts.IndexOf('Harlow Solid Italic') = -1 then
begin // shouldn't happen on modern OS
AVFont := TResourceStream.Create(hInstance, 'HARLOWSI', RT_FONT);
try
s3 := GetEnvVarValue('WINDIR') + '\Fonts\Harlow Solid Italic.ttf';
AVFont.SavetoFile(s3);
except
s3 := AppPath + 'Harlow Solid Italic.ttf';
AVFont.SavetoFile(s3);
end;
AddFontResource(PChar(s3));
SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
AVFont.Free;
end;
end;
end.

2113
Forms/Adjust.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

3526
Forms/Adjust.pas Normal file
View File

File diff suppressed because it is too large Load Diff

374
Forms/Browser.dfm Normal file
View File

@ -0,0 +1,374 @@
object GradientBrowser: TGradientBrowser
Left = 494
Top = 299
BorderIcons = [biSystemMenu, biMinimize]
Caption = 'Gradient Browser'
ClientHeight = 297
ClientWidth = 528
Color = clBtnFace
Constraints.MinHeight = 120
Constraints.MinWidth = 380
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Icon.Data = {
0000010001001010000001002000680400001600000028000000100000002000
0000010020000000000040040000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000045C6F00100000000000000002DA5D654247EACE51F89B8FD1F7D
A8FC2385AFFA209DD2A01DA9DF53000000000000000000000000000000000000
00000000000000000000000000003AB6E247228CC1F143C2EAFF48C3E7FF4EC9
ECFF44C1E2F538A3C7FB1A7CABF9199BD1830000000000000000000000000000
000063D2F201000000000000000020B5E9FF34B0DBCE59D2F0FF5CD4F0FF5CD7
F2FF5AD6F2FD51CFECFB37AED7F4187BA9FD1A94C98F00000000000000000000
000070D8F302000000000000000022B3E7FE1C97C9E751CAE9FF5FD7F2FF0AB3
67FF006F00FF008825FF53D1EEFA2E9FCCEE187DACFE0B87BD020000000082DF
F4027CDCF40700000000000000006AD4F36C1181B2FD52CAE8FE62DAF3FF23D9
71FF00912BFF006000FF62D9F3FF49C3E5EF1280B0FE1B9BCE73000000000000
000089E2F42084DFF4421D99C2FD37A4C9FF46C2EBFF65D4F0FB66DAF3FE3EDB
8CFF00BA50FF00AB67FF63D9F3FF51CBEBF41E8BB9F81D95C8A7000000000000
000076DCF4693BB4DCF78BE2F4B59AE7F7E895E6F6FE95E8F6FE8CE3F5FF85E3
F4FF70DEF4FF68DCF4FF6ADBF4FF5CD4EFF4208BB9F72297C9AB000000000000
000054CBF3F98EE3F5CFB6F1F8FFB6F1F8FF9EEAF6FE93E9F6FF94E8F6FFB359
23FFB30F00FFAB2B00FF73DEF4FB63D7EFEE1D84B4F8279DCE94000000000000
000070D4F5FFA4EDF6E6B6F1F8FF2959F3FF00007AFF001FDBFF93E9F6FFB08C
64FFB03A00FF610000FF73DEF4F45CC3E3DE2781AEEF64D3F23E000000000000
000070D4F5FFACF0F7EBB6F1F8FF5490FFFF0022D9FF000058FFB2F0F8FFB4B6
97FFB38D64FFB6AB8CFF78D3ECE8359AC9EC51B6DB8F00000000000000000000
00007AD8F5F89EEAF6E6B6F1F8FF6DAFFFFF5590FFFF6DB0FFFFB6F1F8FFA5EC
F7FEA7ECF7FE98E7F5F14DB0D9F55DBBDDAB84DFF44000000000000000000000
0000A9EFF7786BD4F4FB9DEAF6EEAFF1F7F4B6F1F8FFB6F1F8FFB6F1F8FFA6EE
F6F9A0EAF6EF70D2EDE354C6EDF895E7F5580000000000000000000000000000
000000000000AAEFF78F5ACFF3F998E8F6E0B6F1F8FFB6F1F8FFB6F1F8FF92E7
F6E46CD4F4FA65D2F4E984D4E874000000000000000000000000000000000000
00000000000000000000A9EFF7737CD9F6F476D6F5FA72D4F5FD75D6F5FB5ECF
F4F190E6F5930000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FFFF
0000D80F0000F0070000B0030000B00100003001000080010000800100008001
000080010000800300008003000080070000C00F0000E03F0000FFFF0000}
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnResize = FormResize
OnShow = FormShow
DesignSize = (
528
297)
PixelsPerInch = 96
TextHeight = 13
object btnDefGradient: TSpeedButton
Left = 411
Top = 7
Width = 23
Height = 21
Hint = 'Open...'
Anchors = [akTop, akRight]
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Arial'
Font.Style = [fsBold]
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF75848F66808F
607987576E7B4E626F4456613948522E3A43252E351B222914191E0E12160E13
18FF00FFFF00FFFF00FF77879289A1AB6AB2D4008FCD008FCD008FCD048CC708
88BE0F82B4157CA91B779F1F7296224B5C87A2ABFF00FFFF00FF7A8A957EBED3
8AA4AE7EDCFF5FCFFF55CBFF4CC4FA41BCF537B3F02EAAEB24A0E5138CD42367
805E696DFF00FFFF00FF7D8E9879D2EC8BA4AD89C2CE71D8FF65D3FF5CCEFF51
C9FE49C1FA3FB9F534B0EE29A8E91085CD224B5B98B2BAFF00FF80919C81D7EF
7DC5E08CA6B080DDFE68D3FF67D4FF62D1FF58CDFF4EC7FC46BEF73BB6F231AC
EC2569817A95A1FF00FF83959F89DCF18CE2FF8DA8B18CBAC774D8FF67D4FF67
D4FF67D4FF5FD0FF54CDFF4BC5FC41BBF72EA2DB51677498B2BA869AA392E1F2
98E8FD80C4DE8EA7B081DEFD84E0FF84E0FF84E0FF84E0FF81DFFF7BDDFF74D8
FF6BD6FF56A9D18F9BA4889CA59AE6F39FEBFB98E8FE8BACB98BACB98AAAB788
A6B386A3AF839FAA819AA67F95A17C919D7A8E99798B957788938BA0A8A0EAF6
A6EEF99FEBFB98E8FE7ADAFF67D4FF67D4FF67D4FF67D4FF67D4FF67D4FF7788
93FF00FFFF00FFFF00FF8EA2ABA7EEF6ABF0F7A6EEF99FEBFB98E8FD71D4FB89
9EA78699A382949F7E909A7A8C97778893FF00FFFF00FFFF00FF8FA4ACA0D2DA
ABF0F7ABF0F7A6EEF99FEBFB8DA1AAB5CBD0FF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFBDCED48FA4AC8FA4AC8FA4AC8FA4AC8FA4ACB5CBD0FF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnDefGradientClick
end
object btnRandom: TSpeedButton
Left = 464
Top = 263
Width = 23
Height = 21
Anchors = [akTop, akRight]
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Arial'
Font.Style = [fsBold]
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
FFFFFFFFFFFFF9F9F99E9E9EA3A7A69F9F9FC4C3C3EFEEEEFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA0A0A0C6C6C5EAFAF9D7
EAE8BEC7C59B9D9DAFAFAEDAD9DAFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFA7A7A7B9B9B9E7E6E7E3F8F7B5C1BE838784D9E9E6C6D0CDA6ACAA9F9F
A0BBBBBBF5F5F5FFFFFFFFFFFFFFFFFFB0B0B0A8A8A8DEDDDDDCDCDCE3F9F7BA
C9C7403D3CC2D3D1EDFFFCCAD3CFC0C5C1B8BDBA959595FFFFFFFFFFFFBDBDBD
9A9A9AD5D5D5D4D5D5DDDDDDDBEFEEE1FDFBDFF3F2C2D1CECBD9D69B9B993932
31D5DDD9939594FFFFFFFFFFFF878787C7C7C7BEBDBDCCCACADDDDDDE1F7F6C7
DBDACBDDDCA2A7A6352F2EBFCDC99AA19DD0D9D5949594FFFFFFFFFFFF8C8D8D
CCCDCD544C4C9F9D9DE3E3E3E5FDFDA9B4B4332C2CBCCBCB9BA5A4CFE0DDECFE
FAE1EEE98F908FFFFFFFFFFFFF8A8A8AC3C3C38C8A8AC0C1C1E2E1E1F0FCFCE1
F8F79FAEAECBE3E1EFFFFFABB0AF6F6E6DDBEAE7949997FFFFFFFFFFFF888888
C1C1C1CDCDCDD6D6D6F3F3F3FAF8F8FAF9FAFDFFFFE6F8F7DEF6F4B6C1C04644
44C7D5D29DA2A1FFFFFFFFFFFF898989C0C0C0C2C2C2F2F2F2EDECEC67626274
6D6EFDFBFBF6F6F6EEF2F2EAF5F4DBEBE8E2F4EFA1A6A5FFFFFFFFFFFF868686
BEBEBEE3E3E3FFFFFFF6F5F5A5A5A5A7A5A5F3F2F2F0EFEFEDEBEBEBE9E9EFEF
EFF8FDFB9A9D9BFFFFFFFFFFFF8D8D8DEDEDEDFFFFFFFAFAFAFFFFFFE8E7E765
5F5F817C7CF4F4F4ECECECE6E6E6F1F0F0AFAEAEA3A3A3FFFFFFFFFFFF858585
E9E9E9FEFEFEFFFFFFFFFFFFEFEEEEA09E9E999595E0DFDFEAEBEBF0F0F0ABAB
ABA3A3A3FEFEFEFFFFFFFFFFFFD2D2D2969696979797BBBBBBE9E9E9FFFFFFCE
CCCC423E3E999696FBFBFBA4A4A4A9A9A9FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFF1F1F1B5B5B5999999979797BDBDBDC7C7C7E5E5E5A0A0A0B1B1B1FFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBFBFBE1E1E1B3
B3B39797978E8E8EB4B4B4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnRandomClick
end
object ListView: TListView
Left = 7
Top = 7
Width = 398
Height = 234
Anchors = [akLeft, akTop, akRight, akBottom]
Columns = <
item
Caption = 'Title'
Width = 150
end>
HideSelection = False
RowSelect = True
ParentShowHint = False
PopupMenu = PopupMenu
ShowHint = True
SmallImages = SmallImages
SortType = stText
TabOrder = 1
ViewStyle = vsList
OnChange = ListViewChange
OnDblClick = ListViewDblClick
OnEdited = ListViewEdited
OnInfoTip = ListViewInfoTip
OnKeyPress = ListViewKeyPress
end
object pnlMain: TPanel
Left = 0
Top = 0
Width = 528
Height = 4
Align = alTop
BevelOuter = bvNone
TabOrder = 0
end
object pnlPreview: TPanel
Left = 0
Top = 256
Width = 457
Height = 37
Anchors = [akLeft, akRight, akBottom]
BevelOuter = bvLowered
TabOrder = 2
object Image: TImage
Left = 1
Top = 1
Width = 455
Height = 35
Align = alClient
Stretch = True
ExplicitWidth = 485
ExplicitHeight = 23
end
end
object SmallImages: TImageList
Left = 192
Top = 24
Bitmap = {
494C010101000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000001000000001002000000000000010
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFF5F000FFF1
E900FFEFE600FFEFE600FFF0E700FFF1E800FFF1E900FFF3EB00FFF3EC00FFF4
ED00FFF6F0000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFF4ED00FFEE
E400FFEBDF00FFEBDF00FFEBE000FFECE200FFEDE200FFEEE400FFEFE500FFEF
E600FFF1EA000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFF1E900CD52
0800CD520800CD520800CD520800CD520800CD520800CD520800CD520800CD52
0800FFEDE3000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFEFE600CD52
0800E2651800EB7A3700FFA77200FFD1B200FFF7ED00C2E9FF0042ADF700CD52
0800FFE9DC000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFEDE200CD52
0800E1651900E9783500FFA77000FFD1B200FFF7EC00C2E9FF0040ADF700CD52
0800FFE5D6000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFEBDF00CD52
0800E1651800EB783600FFA77000FFD1B200FFF7EC00C2E9FF0042ADF700CD52
0800FFE1D0000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFE9DB00CD52
0800E1651900EC793500FFA77000FFD0B200FFF7EC00C2E9FF0040AEF700CD52
0800FFDFCD000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFE7D800CD52
0800E1651900EB793500FFA57000FFD1B200FFF7EC00C2E9FF0040ADF700CD52
0800FFE1D0000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFE4D500CD52
0800E3651A00EB7A3900FFA87400FFD1B300FFF7EC00C4E9FF0044AEF700CD52
0800FFE9DC000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFE3D100CD52
0800ED793500F9945700FFBC8D00FFE1C500FFFFF90000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFE1CF00CD52
0800CD520800CD520800CD520800CD520800CD52080000000000E17D4100EB92
5E00000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFE2D100FFD7
BF00FFD0B400FFCEB100FFCFB300FFD0B400FFD3B80000000000F5A779000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFE7DA00FFE2
D000FFDECB00FFDECA00FFDDC900FFDECA00FFDFCD0000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000424D3E000000000000003E000000
2800000040000000100000000100010000000000800000000000000000000000
000000000000000000000000FFFFFF00FFFF0000000000008003000000000000
8003000000000000800300000000000080030000000000008003000000000000
8003000000000000800300000000000080030000000000008003000000000000
800300000000000080030000000000008007000000000000800F000000000000
801F000000000000803F00000000000000000000000000000000000000000000
000000000000}
end
object PopupMenu: TPopupMenu
Left = 32
Top = 24
object DeleteItem: TMenuItem
Caption = 'Delete'
ShortCut = 16430
OnClick = DeleteItemClick
end
object RenameItem: TMenuItem
Caption = 'Rename'
ShortCut = 113
OnClick = RenameItemClick
end
end
object OpenDialog: TOpenDialog
DefaultExt = 'ugr'
Filter = 'Gradient files (*.ugr)|*.ugr|Fractint map files (*.map)|*.map'
Left = 136
Top = 24
end
object TooltipTimer: TTimer
OnTimer = TooltipTimerTimer
Left = 88
Top = 20
end
end

602
Forms/Browser.pas Normal file
View File

@ -0,0 +1,602 @@
{
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 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 Browser;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, ToolWin, ImgList, StdCtrls, System.ImageList,
Cmap, Menus, Global, Buttons, Translation;
const
PixelCountMax = 32768;
PaletteTooltipTimeout = 1500;
type
TGradientBrowser = class(TForm)
SmallImages: TImageList;
pnlMain: TPanel;
PopupMenu: TPopupMenu;
DeleteItem: TMenuItem;
RenameItem: TMenuItem;
OpenDialog: TOpenDialog;
TooltipTimer: TTimer;
ListView: TListView;
pnlPreview: TPanel;
Image: TImage;
btnDefGradient: TSpeedButton;
btnRandom: TSpeedButton;
procedure FormResize(Sender: TObject);
procedure ListViewChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure DeleteItemClick(Sender: TObject);
procedure RenameItemClick(Sender: TObject);
procedure ListViewEdited(Sender: TObject; Item: TListItem;
var S: string);
procedure btnDefGradientClick(Sender: TObject);
procedure ListViewDblClick(Sender: TObject);
procedure ListViewKeyPress(Sender: TObject; var Key: Char);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ListViewInfoTip(Sender: TObject; Item: TListItem;
var InfoTip: String);
procedure TooltipTimerTimer(Sender: TObject);
// AV: now you really can rename it :-)
function RenameGradient(OldIdent: string; var NewIdent: string): boolean;
procedure btnRandomClick(Sender: TObject); // AV
private
procedure DrawPalette;
procedure Apply;
public
// AV: deleted all unused identifiers: cp, Renderer, integers etc.
Extension, Identifier, Filename: string;
Palette: TColorMap;
procedure ListFileContents;
function LoadFractintMap(filen: string): TColorMap;
end;
type
EFormatInvalid = class(Exception);
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..PixelCountMax - 1] of TRGBTriple;
var
GradientBrowser: TGradientBrowser;
function CreatePalette(strng: string): TColorMap;
implementation
uses Main, Options, Editor, Registry, Adjust, Mutate;
{$R *.DFM}
function GetVal(token: string): string;
var
p: integer;
begin
p := Pos('=', token);
Delete(Token, 1, p);
Result := Token;
end;
function ReplaceTabs(str: string): string;
{Changes tab characters in a string to spaces}
var
i: integer;
begin
for i := 1 to Length(str) do
begin
if str[i] = #9 then
begin
Delete(str, i, 1);
Insert(#32, str, i);
end;
end;
Result := str;
end;
function TGradientBrowser.LoadFractintMap(filen: string): TColorMap;
var
i: integer;
s: string;
pal: TColorMap;
MapFile: TextFile;
begin
{ Load a map file }
AssignFile(MapFile, Filen);
try
Reset(MapFile);
for i := 0 to 255 do
begin
Read(MapFile, Pal[i][0]);
Read(MapFile, Pal[i][1]);
Read(MapFile, Pal[i][2]);
Read(MapFile, s);
end;
CloseFile(MapFile);
Result := Pal;
except
on EInOutError do Application.MessageBox(PChar(Format(TextByKey('common-genericopenfailure'), [FileName])), PCHAR('Apophysis'), 16);
end;
end;
function CreatePalette(strng: string): TColorMap;
{ Loads a palette from a gradient string }
var
Strings: TStringList;
index, i: integer;
Tokens: TStringList;
Indices, Colors: TStringList;
a, b: integer;
begin
Strings := TStringList.Create;
Tokens := TStringList.Create;
Indices := TStringList.Create;
Colors := TStringList.Create;
try
try
Strings.Text := strng;
if Pos('}', Strings.Text) = 0 then raise EFormatInvalid.Create('No closing brace');
if Pos('{', Strings[0]) = 0 then raise EFormatInvalid.Create('No opening brace.');
GetTokens(ReplaceTabs(strings.text), tokens);
Tokens.Text := Trim(Tokens.text);
i := 0;
while (Pos('}', Tokens[i]) = 0) and (Pos('opacity:', Lowercase(Tokens[i])) = 0) do
begin
if Pos('index=', LowerCase(Tokens[i])) <> 0 then
Indices.Add(GetVal(Tokens[i]))
else if Pos('color=', LowerCase(Tokens[i])) <> 0 then
Colors.Add(GetVal(Tokens[i]));
inc(i)
end;
for i := 0 to 255 do
begin
Result[i][0] := 0;
Result[i][1] := 0;
Result[i][2] := 0;
end;
if Indices.Count = 0 then raise EFormatInvalid.Create('No color info');
for i := 0 to Indices.Count - 1 do
begin
try
index := StrToInt(Indices[i]);
while index < 0 do inc(index, 400);
index := Round(Index * (255 / 399));
indices[i] := IntToStr(index);
assert(index>=0);
assert(index<256);
Result[index][0] := StrToInt(Colors[i]) mod 256;
Result[index][1] := trunc(StrToInt(Colors[i]) / 256) mod 256;
Result[index][2] := trunc(StrToInt(Colors[i]) / 65536);
except
end;
end;
i := 1;
repeat
a := StrToInt(Trim(Indices[i - 1]));
b := StrToInt(Trim(Indices[i]));
RGBBlend(a, b, Result);
inc(i);
until i = Indices.Count;
if (Indices[0] <> '0') or (Indices[Indices.Count - 1] <> '255') then
begin
a := StrToInt(Trim(Indices[Indices.Count - 1]));
b := StrToInt(Trim(Indices[0])) + 256;
RGBBlend(a, b, Result);
end;
except on EFormatInvalid do
// Result := False;
end;
finally
Tokens.Free;
Strings.Free;
Indices.Free;
Colors.Free;
end;
end;
procedure TGradientBrowser.DrawPalette;
var
i, j: integer;
Row: pRGBTripleArray;
BitMap: TBitMap;
begin
BitMap := TBitMap.Create;
try
Bitmap.PixelFormat := pf24bit;
BitMap.Width := 256;
BitMap.Height := 1;
for j := 0 to Bitmap.Height - 1 do
begin
Row := Bitmap.Scanline[j];
for i := 0 to Bitmap.Width - 1 do
begin
with Row[i] do
begin
rgbtRed := Palette[i][0];
rgbtGreen := Palette[i][1];
rgbtBlue := Palette[i][2];
end
end
end;
Image.Picture.Graphic := Bitmap;
Image.Refresh;
finally
BitMap.Free;
end;
end;
procedure TGradientBrowser.ListFileContents;
{ List identifiers in file }
var
i, p: integer;
Title: string;
ListItem: TListItem;
FStrings: TStringList;
begin
FStrings := TStringList.Create;
FStrings.LoadFromFile(filename);
try
ListView.Items.BeginUpdate;
ListView.Items.Clear;
if Lowercase(ExtractFileExt(filename)) = '.map' then
begin
ListItem := ListView.Items.Add;
Listitem.Caption := Trim(filename);
end
else
if (Pos('{', FStrings.Text) <> 0) then
begin
for i := 0 to FStrings.Count - 1 do
begin
p := Pos('{', FStrings[i]);
if (p <> 0) and (Pos('(3D)', FStrings[i]) = 0) then
begin
Title := Trim(Copy(FStrings[i], 1, p - 1));
if Title <> '' then
begin { Otherwise bad format }
ListItem := ListView.Items.Add;
Listitem.Caption := Trim(Copy(FStrings[i], 1, p - 1));
end;
end;
end;
end;
ListView.Items.EndUpdate;
ListView.Selected := ListView.Items[0];
finally
FStrings.Free;
end;
end;
procedure TGradientBrowser.ListViewChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
var
Tokens, FStrings: TStringList;
EntryStrings: TStringList;
i: integer;
begin
Application.ProcessMessages;
FStrings := TStringList.Create;
EntryStrings := TStringList.Create;
Tokens := TStringList.Create;
try
if Lowercase(ExtractFileExt(filename)) = '.map' then
begin
Palette := LoadFractintMap(filename);
DrawPalette;
end
else
if (ListView.SelCount <> 0) and (ListView.Selected.Caption <> Identifier) then
begin
Identifier := ListView.Selected.Caption;
FStrings.LoadFromFile(Filename);
for i := 0 to FStrings.count - 1 do
if Pos(Lowercase(ListView.Selected.Caption) + ' ', Trim(Lowercase(FStrings[i]))) = 1 then break;
EntryStrings.Add(FStrings[i]);
repeat
inc(i);
EntryStrings.Add(FStrings[i]);
until Pos('}', FStrings[i]) <> 0;
Palette := CreatePalette(EntryStrings.Text);
DrawPalette;
end;
finally
EntryStrings.Free;
FStrings.Free;
Tokens.Free;
end;
end;
procedure TGradientBrowser.FormCreate(Sender: TObject);
begin
self.Caption := TextByKey('gradientbrowser-title');
btnDefGradient.Hint := TextByKey('common-browse');
DeleteItem.Caption := TextByKey('common-delete');
RenameItem.Caption := TextByKey('common-rename');
btnRandom.Hint := TextByKey('adjustment-tab-gradient-presethint');
end;
procedure TGradientBrowser.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\Browser', False) then
begin
if Registry.ValueExists('Left') then
GradientBrowser.Left := Registry.ReadInteger('Left');
if Registry.ValueExists('Top') then
GradientBrowser.Top := Registry.ReadInteger('Top');
if Registry.ValueExists('Width') then
GradientBrowser.Width := Registry.ReadInteger('Width');
if Registry.ValueExists('Height') then
GradientBrowser.Height := Registry.ReadInteger('Height');
end;
Registry.CloseKey;
finally
Registry.Free;
end;
if FileExists(filename) then ListFileContents;
end;
procedure TGradientBrowser.DeleteItemClick(Sender: TObject);
var
c: boolean;
begin
if ListView.SelCount <> 0 then
begin
if ConfirmDelete then
c := Application.MessageBox(
PChar(Format(TextByKey('common-confirmdelete'), [ListView.Selected.Caption])), 'Apophysis', 36) = IDYES
else
c := True;
if c then
if ListView.Focused and (ListView.SelCount <> 0) then
begin
Application.ProcessMessages;
if DeleteEntry(ListView.Selected.Caption, Filename) then
begin
ListView.Items.Delete(ListView.Selected.Index);
ListView.Selected := ListView.ItemFocused;
end;
end;
end;
end;
function TGradientBrowser.RenameGradient(OldIdent: string; var NewIdent: string): boolean;
var
Strings: TStringList;
p, i: integer;
s: string;
begin
Result := True;
Strings := TStringList.Create;
try
try
i := 0;
Strings.LoadFromFile(Filename);
if Pos(OldIdent + ' ', Trim(Strings.Text)) <> 0 then
begin
while Pos(OldIdent + ' ', Trim(Strings[i])) <> 1 do
begin
inc(i);
end;
p := Pos('{', Strings[i]);
s := Copy(Strings[i], p, Length(Strings[i]) - p + 1);
Strings[i] := NewIdent + ' ' + s;
Strings.SaveToFile(Filename);
end
else
Result := False;
except on Exception do Result := False;
end;
finally
Strings.Free;
end;
end;
procedure TGradientBrowser.RenameItemClick(Sender: TObject);
begin
if ListView.SelCount <> 0 then
ListView.Items[ListView.Selected.Index].EditCaption;
end;
procedure TGradientBrowser.ListViewEdited(Sender: TObject; Item: TListItem;
var S: string);
begin
if s <> Item.Caption then
if not RenameGradient(Item.Caption, s) then // AV
s := Item.Caption;
end;
procedure TGradientBrowser.btnDefGradientClick(Sender: TObject);
var
fn:string;
begin
OpenDialog.InitialDir := BrowserPath;
OpenDialog.Filter := Format('%s|*.gradient;*.ugr|%s|*.map|%s|*.*',
[TextByKey('common-filter-gradientfiles'),
TextByKey('common-filter-fractintfiles'),
TextByKey('common-filter-allfiles')]);
OpenDialog.FileName := '';
if OpenSaveFileDialog(GradientBrowser, OpenDialog.DefaultExt, OpenDialog.Filter, OpenDialog.InitialDir, TextByKey('common-browse'), fn, true, false, false, true) then
//if OpenDialog.Execute then
begin
Filename := fn; //OpenDialog.FileName;
GradientFile := Filename;
BrowserPath := ExtractFilePath(fn); //ExtractFilePath(OpenDialog.FileName);
ListFileContents;
end;
end;
procedure TGradientBrowser.btnRandomClick(Sender: TObject);
var i: integer;
begin
if ListView.Items.Count < 2 then exit;
i := random(ListView.Items.Count);
ListView.Selected := ListView.Items[i];
Apply;
end;
procedure TGradientBrowser.Apply;
begin
MainForm.StopThread;
MainForm.UpdateUndo;
MainCp.cmap := Palette;
MainCP.cmapindex := -1;
if EditForm.Visible then EditForm.UpdateDisplay;
if AdjustForm.Visible then AdjustForm.UpdateDisplay;
if MutateForm.Visible then MutateForm.UpdateDisplay;
MainForm.RedrawTimer.enabled := true;
end;
procedure TGradientBrowser.ListViewDblClick(Sender: TObject);
begin
Apply;
end;
procedure TGradientBrowser.ListViewKeyPress(Sender: TObject;
var Key: Char);
begin
if Key = #13 then Apply;
end;
procedure TGradientBrowser.FormClose(Sender: TObject;
var Action: TCloseAction);
var
Registry: TRegistry;
begin
{ Write position to registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
{ Defaults }
if Registry.OpenKey('\Software\' + APP_NAME + '\Forms\Browser', True) then
begin
Registry.WriteInteger('Top', GradientBrowser.Top);
Registry.WriteInteger('Left', GradientBrowser.Left);
Registry.WriteInteger('Width', GradientBrowser.Width);
Registry.WriteInteger('Height', GradientBrowser.Height);
end;
finally
Registry.Free;
end;
end;
procedure TGradientBrowser.ListViewInfoTip(Sender: TObject;
Item: TListItem; var InfoTip: String);
var
i, j: integer;
Row: pRGBTripleArray;
Bitmap: TBitmap;
pal: TColorMap;
EntryStrings, FStrings: TStringList;
rect: TRect;
begin
BitMap := TBitMap.create;
Bitmap.PixelFormat := pf24bit;
BitMap.Width := 256;
BitMap.Height := 100;
FStrings := TStringList.Create;
EntryStrings := TStringList.Create;
try
if Lowercase(ExtractFileExt(filename)) = '.map' then
begin
pal := LoadFractintMap(filename);
end
else
begin
Identifier := Item.Caption;
FStrings.LoadFromFile(Filename);
for i := 0 to FStrings.count - 1 do
if Pos(Lowercase(Item.Caption) + ' ', Trim(Lowercase(FStrings[i]))) = 1 then break;
EntryStrings.Add(FStrings[i]);
repeat
inc(i);
EntryStrings.Add(FStrings[i]);
until Pos('}', FStrings[i]) <> 0;
pal := CreatePalette(EntryStrings.Text);
end;
finally
EntryStrings.Free;
FStrings.Free;
end;
for j := 0 to Bitmap.Height - 1 do
begin
Row := Bitmap.Scanline[j];
for i := 0 to Bitmap.Width - 1 do
begin
with Row[i] do
begin
rgbtRed := pal[i][0];
rgbtGreen := pal[i][1];
rgbtBlue := pal[i][2];
end
end
end;
rect.TopLeft := Item.Position;
rect.BottomRight.X := rect.TopLeft.X + 100;
rect.BottomRight.Y := rect.TopLeft.Y + 16;
with ListView do
begin
Canvas.Rectangle(Rect);
Canvas.StretchDraw(Rect, Bitmap);
end;
BitMap.Free;
InfoTip := '';
TooltipTimer.Interval := PaletteTooltipTimeout;
TooltipTimer.Enabled := true;
end;
procedure TGradientBrowser.TooltipTimerTimer(Sender: TObject);
begin
ListView.Repaint;
TooltipTimer.Enabled := false;
end;
procedure TGradientBrowser.FormResize(Sender: TObject);
begin
Listview.Width := self.ClientWidth - 4;
btnDefGradient.Left := self.ClientWidth - 2 - btnDefGradient.Width;
ListView.Height := self.ClientHeight - pnlPreview.Height - 6;
btnDefGradient.Top := self.ClientHeight - pnlPreview.Height - 2 + pnlPreview.Height div 2 - btnDefGradient.Height div 2;
btnRandom.Left := btnDefGradient.Left - btnRandom.Width - 2;
btnRandom.Top := btnDefGradient.Top;
ListView.Top := 2;
ListView.Left := 2;
pnlPreview.Top := self.ClientHeight - pnlPreview.Height - 2;
pnlPreview.Left := 2;
pnlPreview.Width := self.ClientWidth - btnDefGradient.Width - 6 - btnRandom.Width;
end;
end.

131
Forms/Chaos.dfm Normal file
View File

@ -0,0 +1,131 @@
object ChaosForm: TChaosForm
Left = 0
Top = 0
Caption = 'Transform Transitions'
ClientHeight = 324
ClientWidth = 494
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Icon.Data = {
0000010001001010200000000000680400001600000028000000100000002000
0000010020000000000000040000000000000000000000000000000000000501
01002A0E0D00250D0B00250D0B00260D0B0026090700000000007B7B7B00E6E6
E600000000000000000000000000000000000000000000000000000000002A0F
0C00F1554A00DE4E4400DF4E4400F653480057181400D7DEDF001A1A1A000000
0000D8D8D800000000000000000000000000000000000000000000000000250D
0B00DE4E4400CD483F00D9483E003A020000D6E1E20000000000000000000000
000000000000E6E6E6000000000000000000000000000000000000000000250D
0B00DF4E4500D8483E004C1C1800CAD8D900000000000000000000000000F4F4
F40010101000000000000000000000000000000000000000000000000000260D
0B00F65348003A020000CAD8D900000000000000000000000000000000000000
0000848484000000000000000000000000000000000000000000000000002609
060056171300D6E1E20000000000000000000000000000000000000000000000
000000000000000000006D6D6D00000000000000000000000000000000000000
0000DAE1E100000000000000000000000000000000000000000000000000F7F7
F7000A0A0A005B5B5B000000000000000000000000000000000000000000F1F1
F10099999900F7F7F70000000000000000000000000000000000000000000000
0000E9E9E9000000000000000000000000000000000000000000000000009292
92000000000000000000E9E9E900DFDFDF00C2C3B600C5C6B700C5C6B700C5C6
B700CACABC00C4C4C100CECECE00000000000000000000000000000000006262
62000000000078787800BBBBBB004C4D40000000620000006E0000006C000000
6D000000850000000000B3B4B10000000000000000000000000000000000DADA
DA0000000000F1F1F10000000000505139001B11EF00261DFD00261DFB00251C
FF0000006F00C9C9C3000000000000000000000000000000000000000000D0D0
D00000000000F5F5F50000000000505139001910E300241CEF00261DFF000906
6400CDCEB800000000000000000000000000000000000000000000000000C8C8
C800000000003F3F3F009F9F9F005D5E46001910E400261DFF0000005E007A7A
6A00393A3C00000000000000000000000000E8E8E8009C9C9C00000000000000
00007F7F7F00000000007373730060614B00160DF00004006700D1D2BF00DBDB
DB0000000000000000004B4B4B00F8F8F800C8C8C80000000000ADADAD000000
00000000000000000000000000004F50460000005900C3C4AD00000000000000
0000BDBDBD006666660000000000000000000000000000000000424242000000
00000000000000000000000000003D3D3D00C9C9BF0000000000000000000000
00000000000000000000C8C8C800D4D4D400AFAFAF004343430000000000007F
0000003F0000031F0000071F00000F9F00001F0F00003F1F00001FBF0000000F
0000000F0000101F0000103F00000039000080000000F1800000F3E10000}
OldCreateOrder = False
OnActivate = FormActivate
OnCreate = FormCreate
OnResize = FormResize
DesignSize = (
494
324)
PixelsPerInch = 96
TextHeight = 13
object PageControl1: TPageControl
Left = 0
Top = 8
Width = 496
Height = 277
ActivePage = TabMatrix
Anchors = [akLeft, akTop, akRight, akBottom]
TabOrder = 0
object TabMatrix: TTabSheet
Caption = 'Probability Matrix'
DesignSize = (
488
249)
object ChaosMatrix: TStringGrid
Left = 0
Top = 80
Width = 488
Height = 145
Anchors = [akLeft, akTop, akRight]
Color = clBtnFace
ColCount = 2
RowCount = 2
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goThumbTracking]
TabOrder = 0
OnDrawCell = ChaosMatrixDrawCell
end
object chkPercents: TCheckBox
Left = 10
Top = 229
Width = 350
Height = 17
Caption = ' Show values in percents'
TabOrder = 1
OnClick = chkPercentsClick
end
object WeightVector: TStringGrid
Left = 0
Top = 0
Width = 488
Height = 70
Align = alTop
Color = clBtnFace
ColCount = 2
RowCount = 2
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goThumbTracking]
ScrollBars = ssHorizontal
TabOrder = 2
OnDrawCell = ChaosMatrixDrawCell
end
end
object TabDiagram: TTabSheet
Caption = 'Xaos Diagram'
ImageIndex = 1
TabVisible = False
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
end
end
object btnClose: TButton
Left = 400
Top = 291
Width = 86
Height = 25
Anchors = [akRight, akBottom]
Caption = 'Close'
Default = True
ModalResult = 8
TabOrder = 1
OnClick = btnCloseClick
end
end

168
Forms/Chaos.pas Normal file
View File

@ -0,0 +1,168 @@
{ Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }
unit Chaos;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.ComCtrls, Editor, Translation,
Vcl.StdCtrls, Math;
type
TChaosForm = class(TForm)
PageControl1: TPageControl;
TabMatrix: TTabSheet;
ChaosMatrix: TStringGrid;
btnClose: TButton;
TabDiagram: TTabSheet;
chkPercents: TCheckBox;
WeightVector: TStringGrid;
procedure ChaosMatrixDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure chkPercentsClick(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
ChaosForm: TChaosForm;
implementation
{$R *.dfm}
procedure TChaosForm.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TChaosForm.ChaosMatrixDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
h, ax, ay, bx, by: integer;
val: double;
trgColor : TColor;
newRect: TRect;
begin
if (ARow = 0) and (ACol = 0) then exit;
if not (gdFixed in State) then
begin
trgColor := EditForm.GetTriangleColor(ACol - 1);
with TStringGrid(Sender).Canvas do begin
Brush.Color := trgColor;
FillRect(Rect);
Font.Color := clBlack; //clWindowText;
if Sender = ChaosMatrix then
begin
val := EditForm.cp.xform[ACol - 1].modWeights[ARow - 1];
if not chkPercents.Checked then
TextOut(Rect.Left + 4, Rect.Top + 4, FloatToStr(RoundTo(val, -4)))
else begin
if ChaosMatrix.Cells[ACol, 1] = '0' then
TextOut(Rect.Left + 4, Rect.Top + 4, '0%')
else
TextOut(Rect.Left + 4, Rect.Top + 4, Format('%g%%',
[RoundTo(val / StrToFloat(ChaosMatrix.Cells[ACol, 1]), -4)]));
end;
end else // if Sender = WeightVector then
begin
val := EditForm.cp.xform[ACol - 1].density;
if not chkPercents.Checked then
TextOut(Rect.Left + 4, Rect.Top + 4, FloatToStr(RoundTo(val, -4)))
else // weight sum is always not zero
TextOut(Rect.Left + 4, Rect.Top + 4, Format('%g%%',
[RoundTo(val / StrToFloat(WeightVector.Cells[1,1]), -4)]));
end;
end;
end else
begin
if (ACol = 0) then
trgColor := EditForm.GetTriangleColor(ARow - 1)
else
trgColor := EditForm.GetTriangleColor(ACol - 1);
if (Sender = WeightVector) and (ARow = 1) then exit;
with TStringGrid(Sender).Canvas do begin
h := Rect.Bottom - Rect.Top - 2;
ax := Rect.Right - 3;
ay := Rect.Top + 2;
bx := Rect.Right - h;
by := Rect.Bottom - 3;
pen.Color := clBlack;
Polyline([Point(ax+1, ay-2), Point(ax+1, by+1), Point(bx-2, by+1), Point(ax+1, ay-2)]);
pen.Color := trgColor;
brush.Color := pen.Color shr 1 and $7f7f7f;
Polygon([Point(ax, ay), Point(ax, by), Point(bx, by)]);
end;
end;
end;
procedure TChaosForm.chkPercentsClick(Sender: TObject);
begin
WeightVector.Invalidate;
ChaosMatrix.Invalidate;
end;
procedure TChaosForm.FormActivate(Sender: TObject);
var
i, j, n: integer;
sum: double;
begin
n := EditForm.cp.NumXForms + 1;
sum := 0;
with WeightVector do begin
ColCount := n;
for i := 1 to n do
Cells[i,0] := ' ' + IntToStr(i);
for j := 0 to n-2 do
sum := sum + EditForm.cp.xform[j].density;
Cells[1, 1] := FloatToStr(sum * 0.01);
end;
with ChaosMatrix do begin
ColCount := n;
RowCount := n;
for i := 1 to n do
begin
Cells[0,i] := Format(TextByKey('editor-common-toprefix'), [i]);
Cells[i,0] := Format(TextByKey('editor-common-fromprefix'), [i]);
sum := 0;
for j := 0 to n-2 do
sum := sum + EditForm.cp.xform[i-1].modWeights[j];
Cells[i, 1] := FloatToStr(sum * 0.01);
end;
Height := TabMatrix.Height - Top - 24;
Invalidate;
end;
chkPercents.Top := TabMatrix.Height - 20;
end;
procedure TChaosForm.FormCreate(Sender: TObject);
begin
self.Caption := TextByKey('transitions-title');
TabMatrix.Caption := TextByKey('transitions-matrix');
btnClose.Caption := TextByKey('common-close');
ChaosMatrix.Cells[0,0] := TextByKey('editor-tab-chaos-path');
chkPercents.Caption := TextByKey('transitions-inpercents');
WeightVector.Cells[0,0] := TextByKey('transitions-transform');
WeightVector.Cells[0,1] := TextByKey('editor-common-weight');
// AV: TODO: visualize Markov chain transitions using arrows
// TabDiagram.Caption := TextByKey('transitions-diagram');
end;
procedure TChaosForm.FormResize(Sender: TObject);
begin
ChaosMatrix.Height := TabMatrix.Height - ChaosMatrix.Top - 24;
chkPercents.Top := TabMatrix.Height - 20;
TabMatrix.Invalidate;
end;
end.

133
Forms/ColorRangeForm.dfm Normal file
View File

@ -0,0 +1,133 @@
object ColorSelection: TColorSelection
Left = 0
Top = 0
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'Palette Interval Selection'
ClientHeight = 114
ClientWidth = 287
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Icon.Data = {
0000010001001010000000000000680400001600000028000000100000002000
000001002000000000000004000000000000000000000000000000000000020C
16000C283700051D2900051C260001121A2703131C780A2937C611374AE11038
4CE7061B27A1020D150C030F19000617230011384B000E2E3E0006131F00020C
16000C2736000218222E0F2E3E9B285C7AE03E7DA4FF468FBDFF4994C0FF4C9C
CBFF317295FF1D4E692D1B4A630016476100123E52000D2D3D0006131F00010A
1300092331522A617EE84D99C5FF4F9FD0FF408CB9FF3884AFFF3783AFFF3C8D
BCFF245775CC0F30410C16435A0016486200123D51000D2D3D0006131F00010B
1637316584EE51A3D1FF257AB1FF2A77A3FF3684ADFF3584AFFF3586B1FF3482
ADFF153A4E900A2B3C380F35473D12435B3E0E374A3E0B2A390F061320002142
55B552ACD7FF2391C7FF3FB5E1FF2485C0FF2D7CADFF388AB7FF347AA6FF337D
A6FF2E7499FA27688AF02D7293F139799EF4346E91F51B4960C6020D17344075
93F656B6DEFF31CBF0FF21E4FEFF26B4E2FF2D7FB9FF4096C1FF336E94FF3056
71FF2774A0FF286A90F130749891387EA8E64CA4D8FF55ABDDFF224D67D74380
A1F576BADCFF76BCDCFF7FD1FAFF62B6F0FF61ABD9FF64AFD4FF4699C2FF98AF
BDFF5A839EFF1A638BFD225A7AF52B81AFFC3FA1D2FF4DAAD8FF3A85ABFA3464
7CC774BFE6FF70B0CEFF439186FF367A4FFF4A9D8EFF79BCE6FF77BBDEFF6CAA
CDFFC0CED3FF4C819FFF4D7B98FF61686EFF6B7072FF55A4CAFF2E769AEA1532
3F44599DC7F661BAB3FF18BB0EFF009400FF278543FF7EC4E9FF8ECDE8FF5CAC
D0FF75B1CEFFA1BBC2FF955438FFD4580BFFBA6E34FF5A99B4FF0F31466E0B1E
2700214D626569BCE3F979CBBBFF67DD98FF82CEE0FF77B8E4FF365DC9FF254C
B5FF1D58A9FF3991BCFF4FAEC6FF809DA6FF79B7CCFF2E617EA405111D0F0E23
2E00173B4D0055AAD23D6ABCF0CD82C4FDFB92D4F2FF7EC1E5FF3B6ADDFF1930
DBFF295FD1FF4DA0CEFF3FBDE4FF3EB7EAFF368BBC8F204A6304020913000E23
2D00193E510057AAD30056B4DF0055B8E35459B9E58E63C1E9AB6FC8EDCD64C0
EDD160C2EBC264BFEA8E3E9DCEAF4AC1E0FF49ACDAD73A87AD0A1D425A000E23
2D00193E510057AAD30058B5E00057B9E40057B8E5004FB7E6005CC0E81962C4
E81D57BDE7105AB9E700249BCF0F38ADD3C056C6E6FF4198C66F49C3EB000E23
2D00193E510057AAD30058B5E00057B9E40057B8E50051B8E6005EC0E80062C3
E80058BEE70058B8E50018A2D50023A5D71B4BC4E6DA44A7C9FB41C1E32E0E23
2D00193E510057AAD30058B5E00057B9E40057B8E50051B8E6005EC0E80062C3
E80058BEE70058B8E5001AA1D40024A9D90032B9E32D3CA7CFEE45C8E9540E23
2D00193E510057AAD30058B5E00057B9E40057B8E50051B8E6005EC0E80062C3
E80058BEE70058B8E5001AA1D40025A8D80030B6E2003CC5EB5C50DDFA4FFC3F
0000E03F0000C03F0000803F0000000100000000000000000000000000008001
0000C0010000E0030000F8030000FFF30000FFF90000FFFD0000FFFF0000}
OldCreateOrder = False
Position = poDefault
OnCreate = FormCreate
OnShow = FormShow
DesignSize = (
287
114)
PixelsPerInch = 96
TextHeight = 13
object StartColor: TShape
Left = 10
Top = 40
Width = 30
Height = 22
end
object LastColor: TShape
Left = 140
Top = 40
Width = 30
Height = 22
end
object lbStart: TLabel
Left = 8
Top = 16
Width = 94
Height = 13
Caption = 'Start palette index:'
end
object lbLast: TLabel
Left = 140
Top = 16
Width = 90
Height = 13
Caption = 'Last palette index:'
end
object btOK: TButton
Left = 101
Top = 82
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 0
OnClick = btOKClick
end
object btCancel: TButton
Left = 186
Top = 82
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
object SpinStart: TSpinEdit
Left = 40
Top = 40
Width = 70
Height = 22
MaxValue = 253
MinValue = 0
TabOrder = 2
Value = 0
OnChange = SpinStartChange
OnKeyPress = SpinValueKeyPress
end
object SpinLast: TSpinEdit
Left = 170
Top = 40
Width = 70
Height = 22
MaxValue = 255
MinValue = 2
TabOrder = 3
Value = 255
OnChange = SpinLastChange
OnKeyPress = SpinValueKeyPress
end
end

91
Forms/ColorRangeForm.pas Normal file
View File

@ -0,0 +1,91 @@
{ Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }
unit ColorRangeForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, ComCtrls, StdCtrls, ExtCtrls, Vcl.Forms, Vcl.Dialogs, Adjust, Translation,
Vcl.Samples.Spin;
type
TColorSelection = class(TForm)
btOK: TButton;
btCancel: TButton;
SpinStart: TSpinEdit;
SpinLast: TSpinEdit;
StartColor: TShape;
LastColor: TShape;
lbStart: TLabel;
lbLast: TLabel;
procedure FormCreate(Sender: TObject);
procedure btOKClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure SpinLastChange(Sender: TObject);
procedure SpinValueKeyPress(Sender: TObject; var Key: Char);
procedure SpinStartChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
ColorSelection: TColorSelection;
implementation
{$R *.dfm}
procedure TColorSelection.btOKClick(Sender: TObject);
begin
AdjustForm.selA := SpinStart.Value;
AdjustForm.selB := SpinLast.Value;
end;
procedure TColorSelection.FormCreate(Sender: TObject);
begin
self.Caption := TextBykey('selectcolors-title');
lbStart.Caption := TextBykey('selectcolors-start');
lbLast.Caption := TextBykey('selectcolors-last');
btOK.Caption := TextByKey('common-ok');
btCancel.Caption := TextByKey('common-cancel');
end;
procedure TColorSelection.SpinValueKeyPress(Sender: TObject; var Key: Char);
begin
if Key = '-' then Key := #0; // AV: non-negative indices only
end;
procedure TColorSelection.FormShow(Sender: TObject);
var a, b: byte;
begin
self.Left := AdjustForm.Left + ((AdjustForm.Width - self.Width) shr 1);
self.Top := AdjustForm.Top + 55;
a := AdjustForm.selA;
b := AdjustForm.selB;
SpinStart.Value := a;
SpinLast.Value := b;
StartColor.Brush.Color := RGB(AdjustForm.palette[a,0], AdjustForm.palette[a,1], AdjustForm.palette[a,2]);
LastColor.Brush.Color := RGB(AdjustForm.palette[b,0], AdjustForm.palette[b,1], AdjustForm.palette[b,2]);
end;
procedure TColorSelection.SpinStartChange(Sender: TObject);
begin
if SpinStart.Value > 253 then SpinStart.Value := 253;
if (SpinLast.Value - SpinStart.Value < 2) then
SpinStart.Value := SpinLast.Value - 2;
StartColor.Brush.Color := RGB(AdjustForm.palette[SpinStart.Value,0],
AdjustForm.palette[SpinStart.Value,1], AdjustForm.palette[SpinStart.Value,2]);
end;
procedure TColorSelection.SpinLastChange(Sender: TObject);
begin
if SpinLast.Value > 255 then SpinLast.Value := 255;
if (SpinLast.Value - SpinStart.Value < 2) then
SpinLast.Value := SpinStart.Value + 2;
LastColor.Brush.Color := RGB(AdjustForm.palette[SpinLast.Value,0],
AdjustForm.palette[SpinLast.Value,1], AdjustForm.palette[SpinLast.Value,2]);
end;
end.

125
Forms/Curves.dfm Normal file
View File

@ -0,0 +1,125 @@
object CurvesForm: TCurvesForm
Left = 197
Top = 111
BorderStyle = bsDialog
Caption = 'Curves'
ClientHeight = 492
ClientWidth = 489
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 16
object Label1: TLabel
Left = 8
Top = 16
Width = 75
Height = 13
Caption = 'Selected curve:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
end
object CurvesPanel: TPanel
Left = 8
Top = 68
Width = 473
Height = 414
BevelOuter = bvNone
Color = clBlack
ParentBackground = False
TabOrder = 0
end
object cbChannel: TComboBox
Left = 8
Top = 35
Width = 185
Height = 21
Style = csDropDownList
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ItemIndex = 0
ParentFont = False
TabOrder = 1
Text = 'Overall'
OnChange = cbChannelChange
Items.Strings = (
'Overall'
'Red'
'Green'
'Blue')
end
object tbWeightLeft: TScrollBar
Left = 326
Top = 8
Width = 155
Height = 21
Max = 160
PageSize = 0
Position = 80
TabOrder = 2
OnChange = tbWeightChange
OnScroll = tbWeightScroll
end
object tbWeightRight: TScrollBar
Left = 326
Top = 35
Width = 155
Height = 21
Max = 160
PageSize = 0
Position = 80
TabOrder = 3
OnChange = tbWeightChange
OnScroll = tbWeightScroll
end
object Panel2: TPanel
Left = 199
Top = 8
Width = 121
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = ' First CP weight:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 4
end
object Panel1: TPanel
Left = 199
Top = 35
Width = 121
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = ' Second CP weight:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 5
end
end

123
Forms/Curves.pas Normal file
View File

@ -0,0 +1,123 @@
unit Curves;
interface
uses Windows, Classes, Graphics, Forms, Controls, CurvesControl, Vcl.ExtCtrls,
Vcl.StdCtrls, Vcl.ComCtrls, ControlPoint, Registry, Global;
type
TCurvesForm = class(TForm)
CurvesPanel: TPanel;
cbChannel: TComboBox;
tbWeightLeft: TScrollBar;
tbWeightRight: TScrollBar;
Panel2: TPanel;
Panel1: TPanel;
Label1: TLabel;
procedure FormShow(Sender: TObject);
procedure cbChannelChange(Sender: TObject);
procedure tbWeightChange(Sender: TObject);
procedure tbWeightScroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
published
CurvesControl: TCurvesControl;
public
procedure SetCp(cp: TControlPoint);
end;
var
CurvesForm: TCurvesForm;
implementation
uses Main;
{$R *.DFM}
procedure TCurvesForm.tbWeightScroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
begin
if ScrollCode = scEndScroll then
CurvesControl.UpdateFlame;
end;
procedure TCurvesForm.SetCp(cp: TControlPoint);
begin
if CurvesControl = nil then Exit;
CurvesControl.SetCp(cp);
end;
procedure TCurvesForm.cbChannelChange(Sender: TObject);
begin
if CurvesControl = nil then Exit;
CurvesControl.ActiveChannel := TCurvesChannel(cbChannel.ItemIndex);
tbWeightLeft.Position := Round(CurvesControl.WeightLeft * 10);
tbWeightRight.Position := Round(CurvesControl.WeightRight * 10);
end;
procedure TCurvesForm.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\Curves', True) then
begin
Registry.WriteInteger('Top', self.Top);
Registry.WriteInteger('Left', self.Left);
end;
finally
Registry.Free;
end;
// bStop := True;
end;
procedure TCurvesForm.FormCreate(Sender: TObject);
begin
//
end;
procedure TCurvesForm.FormShow(Sender: TObject);
var Registry: TRegistry;
begin
if not (assigned(curvesControl)) then
begin
CurvesControl := TCurvesControl.Create(self);
CurvesControl.Align := alClient;
CurvesControl.Parent := CurvesPanel;
end;
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('Software\' + APP_NAME + '\Forms\Curves', False) then
begin
if Registry.ValueExists('Left') then
self.Left := Registry.ReadInteger('Left');
if Registry.ValueExists('Top') then
self.Top := Registry.ReadInteger('Top');
Registry.CloseKey;
end;
finally
Registry.Free;
end;
tbWeightLeft.Position := Round(CurvesControl.WeightLeft * 10);
tbWeightRight.Position := Round(CurvesControl.WeightRight * 10);
SetCp(MainCp);
end;
procedure TCurvesForm.tbWeightChange(Sender: TObject);
begin
CurvesControl.WeightLeft := tbWeightLeft.Position / 10.0;
CurvesControl.WeightRight := tbWeightRight.Position / 10.0;
end;
end.

5937
Forms/Editor.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

7659
Forms/Editor.pas Normal file
View File

File diff suppressed because it is too large Load Diff

713
Forms/FormExport.dfm Normal file
View File

@ -0,0 +1,713 @@
object ExportDialog: TExportDialog
Left = 313
Top = 276
BorderStyle = bsDialog
Caption = 'Export Flame'
ClientHeight = 403
ClientWidth = 496
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnShow = FormShow
DesignSize = (
496
403)
PixelsPerInch = 96
TextHeight = 13
object btnOK: TButton
Left = 398
Top = 182
Width = 89
Height = 25
Anchors = [akTop, akRight]
Caption = '&OK'
Default = True
ModalResult = 1
TabOrder = 0
OnClick = btnOKClick
end
object btnCancel: TButton
Left = 398
Top = 210
Width = 89
Height = 25
Anchors = [akTop, akRight]
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
object GroupBox1: TGroupBox
Left = 8
Top = 5
Width = 481
Height = 57
Anchors = [akLeft, akTop, akRight]
Caption = ' Destination '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 2
DesignSize = (
481
57)
object btnBrowse: TSpeedButton
Left = 448
Top = 19
Width = 24
Height = 24
Hint = 'Browse...'
Anchors = [akTop, akRight]
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF75848F66808F
607987576E7B4E626F4456613948522E3A43252E351B222914191E0E12160E13
18FF00FFFF00FFFF00FF77879289A1AB6AB2D4008FCD008FCD008FCD048CC708
88BE0F82B4157CA91B779F1F7296224B5C87A2ABFF00FFFF00FF7A8A957EBED3
8AA4AE7EDCFF5FCFFF55CBFF4CC4FA41BCF537B3F02EAAEB24A0E5138CD42367
805E696DFF00FFFF00FF7D8E9879D2EC8BA4AD89C2CE71D8FF65D3FF5CCEFF51
C9FE49C1FA3FB9F534B0EE29A8E91085CD224B5B98B2BAFF00FF80919C81D7EF
7DC5E08CA6B080DDFE68D3FF67D4FF62D1FF58CDFF4EC7FC46BEF73BB6F231AC
EC2569817A95A1FF00FF83959F89DCF18CE2FF8DA8B18CBAC774D8FF67D4FF67
D4FF67D4FF5FD0FF54CDFF4BC5FC41BBF72EA2DB51677498B2BA869AA392E1F2
98E8FD80C4DE8EA7B081DEFD84E0FF84E0FF84E0FF84E0FF81DFFF7BDDFF74D8
FF6BD6FF56A9D18F9BA4889CA59AE6F39FEBFB98E8FE8BACB98BACB98AAAB788
A6B386A3AF839FAA819AA67F95A17C919D7A8E99798B957788938BA0A8A0EAF6
A6EEF99FEBFB98E8FE7ADAFF67D4FF67D4FF67D4FF67D4FF67D4FF67D4FF7788
93FF00FFFF00FFFF00FF8EA2ABA7EEF6ABF0F7A6EEF99FEBFB98E8FD71D4FB89
9EA78699A382949F7E909A7A8C97778893FF00FFFF00FFFF00FF8FA4ACA0D2DA
ABF0F7ABF0F7A6EEF99FEBFB8DA1AAB5CBD0FF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFBDCED48FA4AC8FA4AC8FA4AC8FA4AC8FA4ACB5CBD0FF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnBrowseClick
end
object Label10: TPanel
Left = 8
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'File name'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 1
end
object txtFilename: TEdit
Left = 112
Top = 20
Width = 337
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
end
end
object GroupBox3: TGroupBox
Left = 256
Top = 66
Width = 233
Height = 105
Anchors = [akTop, akRight]
Caption = ' Quality '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 3
DesignSize = (
233
105)
object udOversample: TUpDown
Left = 212
Top = 68
Width = 12
Height = 21
Anchors = [akTop, akRight]
Associate = txtOversample
Min = 1
Max = 4
Position = 2
TabOrder = 3
end
object Label4: TPanel
Left = 8
Top = 20
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Density'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 4
end
object txtDensity: TEdit
Left = 120
Top = 20
Width = 105
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
OnChange = txtDensityChange
end
object Label5: TPanel
Left = 8
Top = 44
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Filter radius'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 5
end
object txtFilterRadius: TEdit
Left = 120
Top = 44
Width = 105
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 1
OnChange = txtFilterRadiusChange
end
object Label3: TPanel
Left = 8
Top = 68
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Oversample'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 6
end
object txtOversample: TEdit
Left = 120
Top = 68
Width = 92
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ReadOnly = True
TabOrder = 2
Text = '2'
OnChange = txtOversampleChange
end
end
object GroupBox2: TGroupBox
Left = 8
Top = 66
Width = 241
Height = 105
Anchors = [akLeft, akTop, akRight]
Caption = ' Size '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 4
DesignSize = (
241
105)
object chkMaintain: TCheckBox
Left = 8
Top = 76
Width = 225
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Maintain aspect ratio'
Checked = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
State = cbChecked
TabOrder = 0
OnClick = chkMaintainClick
end
object Label1: TPanel
Left = 8
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Width'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 3
end
object Label2: TPanel
Left = 8
Top = 44
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Height'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 4
end
object cbHeight: TComboBox
Left = 112
Top = 44
Width = 121
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 2
OnChange = txtHeightChange
Items.Strings = (
'200'
'240'
'480'
'600'
'768'
'1024'
'1200'
'2048'
'2400')
end
object cbWidth: TComboBox
Left = 112
Top = 20
Width = 121
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 1
OnChange = txtWidthChange
Items.Strings = (
'320'
'640'
'800'
'1024'
'1280'
'1600'
'1920'
'2048'
'2560'
'3200')
end
end
object GroupBox4: TGroupBox
Left = 8
Top = 176
Width = 377
Height = 113
Anchors = [akLeft, akTop, akRight]
Caption = ' Parameters '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 5
DesignSize = (
377
113)
object udStrips: TUpDown
Left = 172
Top = 52
Width = 12
Height = 21
Associate = txtStrips
Min = 1
Max = 512
Position = 1
TabOrder = 2
end
object Label7: TPanel
Left = 8
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Buffer depth'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 7
end
object Label8: TPanel
Left = 8
Top = 52
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Strips'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 8
end
object Label9: TPanel
Left = 192
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'DE Radius'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 9
end
object txtEstimator: TEdit
Left = 296
Top = 20
Width = 73
Height = 21
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 3
Text = '5'
OnChange = txtEstimatorChange
end
object txtStrips: TEdit
Left = 112
Top = 52
Width = 60
Height = 21
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 1
Text = '1'
end
object cmbDepth: TComboBox
Left = 112
Top = 20
Width = 73
Height = 21
Style = csDropDownList
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ItemIndex = 2
ParentFont = False
TabOrder = 0
Text = '32-bit float'
Items.Strings = (
'16-bit'
'32-bit'
'32-bit float'
'64-bit')
end
object Label14: TPanel
Left = 8
Top = 84
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Gamma threshold'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 10
end
object Label12: TPanel
Left = 192
Top = 52
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'DE Curve'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 11
end
object Label11: TPanel
Left = 192
Top = 84
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'DE Minimum'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 12
end
object txtGammaTreshold: TEdit
Left = 112
Top = 84
Width = 73
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 6
Text = '0.01'
OnChange = txtGammaTresholdChange
end
object txtEstimatorCurve: TEdit
Left = 296
Top = 52
Width = 73
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 5
Text = '0.6'
OnChange = txtEstimatorCurveChange
end
object txtEstimatorMin: TEdit
Left = 296
Top = 84
Width = 73
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 4
Text = '0'
OnChange = txtEstimatorMinChange
end
end
object chkRender: TCheckBox
Left = 400
Top = 246
Width = 89
Height = 43
Anchors = [akTop, akRight]
Caption = 'Render'
Checked = True
State = cbChecked
TabOrder = 6
end
object Panel1: TPanel
Left = 8
Top = 296
Width = 481
Height = 105
Anchors = [akLeft, akTop, akRight]
BevelKind = bkSoft
BevelOuter = bvNone
Color = clInfoBk
TabOrder = 7
OnResize = Panel1Resize
DesignSize = (
477
101)
object Label6: TLabel
Left = 8
Top = 2
Width = 453
Height = 24
Alignment = taCenter
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = 'WARNING!'
Font.Charset = DEFAULT_CHARSET
Font.Color = clInfoText
Font.Height = -19
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label15: TLabel
Left = 8
Top = 25
Width = 465
Height = 54
Alignment = taCenter
Anchors = [akLeft, akRight]
AutoSize = False
Caption =
'Fractals created with this version of Apophysis are not supporte' +
'd by the external renderer! To render 2D-only fractals, download' +
' the latest version of FLAM3 from'
Color = clInfoBk
Font.Charset = DEFAULT_CHARSET
Font.Color = clInfoText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentColor = False
ParentFont = False
WordWrap = True
end
object lblFlam3Link: TLabel
Left = 180
Top = 80
Width = 111
Height = 13
Cursor = crHandPoint
Hint = 'https://code.google.com/archive/p/flam3/downloads'
Caption = 'http://www.flam3.com/'
Color = clBlue
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsUnderline]
ParentColor = False
ParentFont = False
OnClick = lblFlam3LinkClick
end
end
object SaveDialog: TSaveDialog
DefaultExt = 'jpg'
Filter =
'JPEG Image (*.jpg)|*.jpg|PPM Image (*.ppm)|*.ppm|PNG Images (*.p' +
'ng)|*.png'
Left = 464
Top = 264
end
end

302
Forms/FormExport.pas Normal file
View File

@ -0,0 +1,302 @@
{
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 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 FormExport;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ComCtrls, ExtCtrls, Translation;
type
TExportDialog = class(TForm)
btnOK: TButton;
btnCancel: TButton;
GroupBox1: TGroupBox;
btnBrowse: TSpeedButton;
txtFilename: TEdit;
SaveDialog: TSaveDialog;
GroupBox3: TGroupBox;
txtOversample: TEdit;
txtFilterRadius: TEdit;
txtDensity: TEdit;
udOversample: TUpDown;
GroupBox2: TGroupBox;
chkMaintain: TCheckBox;
cbWidth: TComboBox;
cbHeight: TComboBox;
GroupBox4: TGroupBox;
cmbDepth: TComboBox;
chkRender: TCheckBox;
txtStrips: TEdit;
udStrips: TUpDown;
txtEstimator: TEdit;
txtEstimatorMin: TEdit;
txtEstimatorCurve: TEdit;
txtGammaTreshold: TEdit;
Panel1: TPanel;
Label6: TLabel;
Label15: TLabel;
Label4: TPanel;
Label5: TPanel;
Label3: TPanel;
Label1: TPanel;
Label2: TPanel;
Label7: TPanel;
Label8: TPanel;
Label9: TPanel;
Label14: TPanel;
Label12: TPanel;
Label11: TPanel;
Label10: TPanel;
lblFlam3Link: TLabel;
procedure Panel1Resize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnBrowseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure txtWidthChange(Sender: TObject);
procedure chkMaintainClick(Sender: TObject);
procedure txtHeightChange(Sender: TObject);
procedure txtDensityChange(Sender: TObject);
procedure txtFilterRadiusChange(Sender: TObject);
procedure txtOversampleChange(Sender: TObject);
procedure txtEstimatorChange(Sender: TObject);
procedure txtEstimatorMinChange(Sender: TObject);
procedure txtEstimatorCurveChange(Sender: TObject);
procedure txtGammaTresholdChange(Sender: TObject);
procedure lblFlam3LinkClick(Sender: TObject);
private
FloatFormatSettings: TFormatSettings;
public
Filename: string;
ImageWidth, ImageHeight, Oversample, Batches, Strips: Integer;
Sample_Density, Filter_Radius: double;
Estimator, EstimatorMin, EstimatorCurve: double;
GammaTreshold: double;
Jitters: integer;
end;
var
ExportDialog: TExportDialog;
Ratio: double;
implementation
uses Global, Main, ShellAPI;
{$R *.DFM}
procedure TExportDialog.btnBrowseClick(Sender: TObject);
begin
SaveDialog.InitialDir := ExtractFileDir(txtFilename.text);
SaveDialog.Filename := txtFilename.Text;
case ExportFileFormat of
0: SaveDialog.DefaultExt := 'jpg';
1: SaveDialog.DefaultExt := 'ppm';
end;
SaveDialog.filterIndex := ExportFileFormat;
SaveDialog.Filter := Format('Portable Pixmap (*.ppm)|*.ppm|%s|*.jpg;*.jpeg|%s|*.png|%s|*.*',
[TextByKey('common-filter-jpeg'), TextByKey('common-filter-png'),
TextByKey('common-filter-allfiles')]);
if SaveDialog.Execute then
begin
case SaveDialog.FilterIndex of
1: txtFilename.Text := ChangeFileExt(SaveDialog.Filename, '.jpg');
2: txtFilename.Text := ChangeFileExt(SaveDialog.Filename, '.ppm');
3: txtFilename.Text := ChangeFileExt(SaveDialog.Filename, '.png');
end;
ExportFileFormat := SaveDialog.FilterIndex;
renderPath := ExtractFilePath(SaveDialog.Filename);
end;
end;
procedure TExportDialog.FormShow(Sender: TObject);
begin
txtFilename.Text := Filename;
cbWidth.Text := IntToStr(MainCp.Width);
cbHeight.Text := IntToStr(MainCp.Height);
ImageWidth := MainCp.Width;
ImageHeight := MainCp.Height;
txtDensity.text := FloatToStr(Sample_density);
txtFilterRadius.text := FloatToStr(Filter_Radius);
txtOversample.text := IntToSTr(Oversample);
udOversample.Position := Oversample;
Ratio := ImageWidth / ImageHeight;
Batches := 1;
Estimator := 9.0;
EstimatorMin := 0.0;
EstimatorCurve := 0.4;
Jitters := 1;
GammaTreshold := MainCP.gamma_threshold; //0.01;
GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, FloatFormatSettings);
txtEstimator.Text := FloatToStr(Estimator, FloatFormatSettings);
txtEstimatorMin.Text := FloatToStr(EstimatorMin, FloatFormatSettings);
txtEstimatorCurve.Text := FloatToStr(EstimatorCurve, FloatFormatSettings);
txtGammaTreshold.Text := FloatToStr(GammaTreshold, FloatFormatSettings);
end;
procedure TExportDialog.btnOKClick(Sender: TObject);
begin
Filename := txtFilename.text;
ImageWidth := StrToInt(cbWidth.Text);
ImageHeight := StrToInt(cbHeight.Text);
end;
procedure TExportDialog.txtWidthChange(Sender: TObject);
begin
try
ImageWidth := StrToInt(cbWidth.Text);
if chkMaintain.checked and cbWidth.Focused then
begin
ImageHeight := Round(ImageWidth / ratio);
cbHeight.Text := IntToStr(ImageHeight)
end;
except
end;
end;
procedure TExportDialog.chkMaintainClick(Sender: TObject);
begin
Ratio := ImageWidth / ImageHeight;
end;
procedure TExportDialog.txtHeightChange(Sender: TObject);
begin
try
ImageHeight := StrToInt(cbHeight.Text);
if chkMaintain.checked and cbHeight.Focused then
begin
ImageWidth := Round(ImageHeight * ratio);
cbWidth.Text := IntToStr(ImageWidth)
end;
except
end;
end;
procedure TExportDialog.txtDensityChange(Sender: TObject);
begin
try
Sample_Density := StrToFloat(txtDensity.Text);
except
end;
end;
procedure TExportDialog.txtFilterRadiusChange(Sender: TObject);
begin
try
Filter_Radius := StrToFloat(txtFilterRadius.Text);
except
end;
end;
procedure TExportDialog.txtOversampleChange(Sender: TObject);
begin
if StrToInt(txtOversample.Text) > udOversample.Max then
txtOversample.Text := IntToStr(udOversample.Max);
if StrToInt(txtOversample.Text) < udOversample.Min then
txtOversample.Text := IntToStr(udOversample.Min);
try
Oversample := StrToInt(txtOversample.Text);
except
end;
end;
procedure TExportDialog.txtEstimatorChange(Sender: TObject);
begin
Estimator := 0;
try
Estimator := StrToFloat(txtEstimator.Text, FloatFormatSettings);
except
end;
end;
procedure TExportDialog.txtEstimatorMinChange(Sender: TObject);
begin
EstimatorMin := 0;
try
EstimatorMin := StrToFloat(txtEstimatorMin.Text, FloatFormatSettings);
except
end;
end;
procedure TExportDialog.txtEstimatorCurveChange(Sender: TObject);
begin
EstimatorCurve := 0;
try
EstimatorCurve := StrToFloat(txtEstimatorCurve.Text, FloatFormatSettings);
except
end;
end;
procedure TExportDialog.txtGammaTresholdChange(Sender: TObject);
begin
//GammaTreshold := 0.01;
try
GammaTreshold := StrToFloat(txtGammaTreshold.Text, FloatFormatSettings);
except
end;
end;
procedure TExportDialog.lblFlam3LinkClick(Sender: TObject);
begin
ShellExecute(ValidParentForm(Self).Handle, 'open', PChar(TLabel(Sender).Hint),
nil, nil, SW_SHOWNORMAL);
end;
procedure TExportDialog.FormCreate(Sender: TObject);
begin
btnOK.Caption := TextByKey('common-ok');
btnCancel.Caption := TextByKey('common-cancel');
Label1.Caption := TextByKey('common-width');
Label2.Caption := TextByKey('common-height');
GroupBox2.Caption := TextByKey('common-size');
chkMaintain.Caption := TextByKey('common-keepaspect');
GroupBox1.Caption := TextByKey('common-destination');
Label10.Caption := TextByKey('common-filename');
btnBrowse.Hint := TextByKey('common-browse');
GroupBox3.Caption := TextByKey('common-quality');
Label5.Caption := TextByKey('common-filterradius');
Label4.Caption := TextByKey('common-density');
Label3.Caption := TextByKey('common-oversample');
Label14.Caption := TextByKey('common-gammathreshold');
self.Caption := TextByKey('main-menu-file-exportflame');
GroupBox4.Caption := TextByKey('export-paramoptions-title');
Label7.Caption := TextByKey('export-paramoptions-bufferdepth');
Label8.Caption := TextByKey('export-paramoptions-strips');
Label9.Caption := TextByKey('export-paramoptions-estimatorradius');
Label12.Caption := TextByKey('export-paramoptions-estimatorcurve');
Label11.Caption := TextByKey('export-paramoptions-estimatormin');
chkRender.Caption := TextByKey('export-paramoptions-dorender');
Label6.Caption := TextByKey('export-paramoptions-warningtitle');
Label15.Caption := TextByKey('export-paramoptions-warningtext');
end;
procedure TExportDialog.Panel1Resize(Sender: TObject);
begin
Label15.Top := (Panel1.Height - 30) div 2 - Label15.Height div 2 + 25;
end;
end.

553
Forms/FormExportC.dfm Normal file
View File

@ -0,0 +1,553 @@
object ExportCDialog: TExportCDialog
Left = 313
Top = 276
BorderStyle = bsDialog
Caption = 'Export Flame'
ClientHeight = 134
ClientWidth = 496
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnShow = FormShow
DesignSize = (
496
134)
PixelsPerInch = 96
TextHeight = 13
object btnOK: TButton
Left = 254
Top = 98
Width = 115
Height = 25
Anchors = [akTop, akRight]
Caption = '&OK'
Default = True
ModalResult = 1
TabOrder = 0
OnClick = btnOKClick
end
object btnCancel: TButton
Left = 376
Top = 98
Width = 111
Height = 25
Anchors = [akTop, akRight]
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
object GroupBox1: TGroupBox
Left = 8
Top = 237
Width = 481
Height = 57
Anchors = [akLeft, akTop, akRight]
Caption = ' Destination '
TabOrder = 2
Visible = False
DesignSize = (
481
57)
object btnBrowse: TSpeedButton
Left = 448
Top = 19
Width = 24
Height = 24
Hint = 'Browse...'
Anchors = [akTop, akRight]
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF75848F66808F
607987576E7B4E626F4456613948522E3A43252E351B222914191E0E12160E13
18FF00FFFF00FFFF00FF77879289A1AB6AB2D4008FCD008FCD008FCD048CC708
88BE0F82B4157CA91B779F1F7296224B5C87A2ABFF00FFFF00FF7A8A957EBED3
8AA4AE7EDCFF5FCFFF55CBFF4CC4FA41BCF537B3F02EAAEB24A0E5138CD42367
805E696DFF00FFFF00FF7D8E9879D2EC8BA4AD89C2CE71D8FF65D3FF5CCEFF51
C9FE49C1FA3FB9F534B0EE29A8E91085CD224B5B98B2BAFF00FF80919C81D7EF
7DC5E08CA6B080DDFE68D3FF67D4FF62D1FF58CDFF4EC7FC46BEF73BB6F231AC
EC2569817A95A1FF00FF83959F89DCF18CE2FF8DA8B18CBAC774D8FF67D4FF67
D4FF67D4FF5FD0FF54CDFF4BC5FC41BBF72EA2DB51677498B2BA869AA392E1F2
98E8FD80C4DE8EA7B081DEFD84E0FF84E0FF84E0FF84E0FF81DFFF7BDDFF74D8
FF6BD6FF56A9D18F9BA4889CA59AE6F39FEBFB98E8FE8BACB98BACB98AAAB788
A6B386A3AF839FAA819AA67F95A17C919D7A8E99798B957788938BA0A8A0EAF6
A6EEF99FEBFB98E8FE7ADAFF67D4FF67D4FF67D4FF67D4FF67D4FF67D4FF7788
93FF00FFFF00FFFF00FF8EA2ABA7EEF6ABF0F7A6EEF99FEBFB98E8FD71D4FB89
9EA78699A382949F7E909A7A8C97778893FF00FFFF00FFFF00FF8FA4ACA0D2DA
ABF0F7ABF0F7A6EEF99FEBFB8DA1AAB5CBD0FF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFBDCED48FA4AC8FA4AC8FA4AC8FA4AC8FA4ACB5CBD0FF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnBrowseClick
end
object Label10: TPanel
Left = 8
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'File name'
ParentShowHint = False
ShowHint = True
TabOrder = 1
end
object txtFilename: TEdit
Left = 112
Top = 20
Width = 337
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
end
end
object GroupBox3: TGroupBox
Left = 256
Top = 10
Width = 233
Height = 79
Anchors = [akTop, akRight]
Caption = ' Quality '
TabOrder = 3
DesignSize = (
233
79)
object udOversample: TUpDown
Left = 212
Top = 44
Width = 12
Height = 21
Anchors = [akTop, akRight]
Associate = txtOversample
Min = 1
Max = 4
Position = 2
TabOrder = 2
end
object Label5: TPanel
Left = 8
Top = 20
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Filter radius'
ParentShowHint = False
ShowHint = True
TabOrder = 3
end
object txtFilterRadius: TEdit
Left = 120
Top = 20
Width = 105
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
OnChange = txtFilterRadiusChange
end
object Label3: TPanel
Left = 8
Top = 44
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Oversample'
ParentShowHint = False
ShowHint = True
TabOrder = 4
end
object txtOversample: TEdit
Left = 120
Top = 44
Width = 92
Height = 21
Anchors = [akLeft, akTop, akRight]
ReadOnly = True
TabOrder = 1
Text = '2'
OnChange = txtOversampleChange
end
end
object GroupBox2: TGroupBox
Left = 8
Top = 10
Width = 241
Height = 111
Anchors = [akLeft, akTop, akRight]
Caption = ' Size '
TabOrder = 4
DesignSize = (
241
111)
object Label13: TLabel
Left = 184
Top = 36
Width = 26
Height = 13
Anchors = [akLeft, akTop, akRight]
Caption = 'pixels'
Visible = False
end
object Label16: TLabel
Left = 168
Top = 22
Width = 15
Height = 36
Anchors = [akLeft, akTop, akRight]
Caption = '}'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -32
Font.Name = 'Times New Roman'
Font.Style = []
ParentFont = False
Visible = False
end
object chkMaintain: TCheckBox
Left = 8
Top = 76
Width = 225
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Maintain aspect ratio'
Checked = True
State = cbChecked
TabOrder = 0
OnClick = chkMaintainClick
end
object Label1: TPanel
Left = 8
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Width'
ParentShowHint = False
ShowHint = True
TabOrder = 3
end
object Label2: TPanel
Left = 8
Top = 44
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Height'
ParentShowHint = False
ShowHint = True
TabOrder = 4
end
object cbHeight: TComboBox
Left = 112
Top = 44
Width = 121
Height = 21
Anchors = [akLeft, akTop, akRight]
ItemHeight = 13
TabOrder = 2
OnChange = txtHeightChange
Items.Strings = (
'200'
'240'
'480'
'600'
'768'
'1024'
'1200'
'2048'
'2400')
end
object cbWidth: TComboBox
Left = 112
Top = 20
Width = 121
Height = 21
Anchors = [akLeft, akTop, akRight]
ItemHeight = 13
TabOrder = 1
OnChange = txtWidthChange
Items.Strings = (
'320'
'640'
'800'
'1024'
'1280'
'1600'
'1920'
'2048'
'2560'
'3200')
end
end
object GroupBox4: TGroupBox
Left = 8
Top = 392
Width = 377
Height = 113
Anchors = [akLeft, akTop, akRight]
Caption = ' Parameters '
TabOrder = 5
Visible = False
DesignSize = (
377
113)
object udStrips: TUpDown
Left = 172
Top = 52
Width = 12
Height = 21
Associate = txtStrips
Min = 1
Max = 512
Position = 1
TabOrder = 2
end
object Label7: TPanel
Left = 8
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Buffer depth'
ParentShowHint = False
ShowHint = True
TabOrder = 7
end
object Label8: TPanel
Left = 8
Top = 52
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Strips'
ParentShowHint = False
ShowHint = True
TabOrder = 8
end
object Label9: TPanel
Left = 8
Top = 84
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'DE Radius'
ParentShowHint = False
ShowHint = True
TabOrder = 9
end
object txtEstimator: TEdit
Left = 112
Top = 84
Width = 73
Height = 21
TabOrder = 3
Text = '5'
end
object txtStrips: TEdit
Left = 112
Top = 52
Width = 60
Height = 21
TabOrder = 1
Text = '1'
end
object cmbDepth: TComboBox
Left = 112
Top = 20
Width = 73
Height = 21
Style = csDropDownList
ItemHeight = 13
TabOrder = 0
Items.Strings = (
'16-bit'
'32-bit'
'32-bit float'
'64-bit')
end
object Label14: TPanel
Left = 192
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Gamma threshold'
ParentShowHint = False
ShowHint = True
TabOrder = 10
end
object Label12: TPanel
Left = 192
Top = 52
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'DE Curve'
ParentShowHint = False
ShowHint = True
TabOrder = 11
end
object Label11: TPanel
Left = 192
Top = 84
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'DE Minimum'
ParentShowHint = False
ShowHint = True
TabOrder = 12
end
object txtGammaTreshold: TEdit
Left = 296
Top = 20
Width = 73
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 6
Text = '0.01'
OnChange = txtGammaTresholdChange
end
object txtEstimatorCurve: TEdit
Left = 296
Top = 52
Width = 73
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 5
Text = '0.6'
end
object txtEstimatorMin: TEdit
Left = 296
Top = 84
Width = 73
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 4
Text = '0'
end
end
object chkRender: TCheckBox
Left = 392
Top = 398
Width = 89
Height = 43
Anchors = [akTop, akRight]
Caption = 'Render'
Checked = True
State = cbChecked
TabOrder = 6
Visible = False
end
object Panel1: TPanel
Left = 8
Top = 296
Width = 481
Height = 89
Anchors = [akLeft, akTop, akRight]
BevelKind = bkSoft
BevelOuter = bvNone
Color = clInfoBk
TabOrder = 7
Visible = False
DesignSize = (
477
85)
object Label6: TLabel
Left = 8
Top = 4
Width = 453
Height = 24
Alignment = taCenter
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = 'WARNING!'
Font.Charset = DEFAULT_CHARSET
Font.Color = clInfoText
Font.Height = -19
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label15: TLabel
Left = 8
Top = 25
Width = 447
Height = 26
Alignment = taCenter
Anchors = [akLeft, akRight]
Caption =
'Fractals created with this version of Apophysis are not supporte' +
'd by the external renderer! To render 2D-only fractals, download' +
' the latest version of FLAM3 from http://www.flam3.com'
Color = clInfoBk
Font.Charset = DEFAULT_CHARSET
Font.Color = clInfoText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentColor = False
ParentFont = False
WordWrap = True
end
end
object txtDensity: TEdit
Left = 120
Top = 212
Width = 105
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 8
Visible = False
OnChange = txtDensityChange
end
object Label4: TPanel
Left = 8
Top = 212
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Density'
ParentShowHint = False
ShowHint = True
TabOrder = 9
Visible = False
end
object SaveDialog: TSaveDialog
DefaultExt = 'jpg'
Filter =
'JPEG Image (*.jpg)|*.jpg|PPM Image (*.ppm)|*.ppm|PNG Images (*.p' +
'ng)|*.png'
Left = 464
Top = 264
end
end

257
Forms/FormExportC.pas Normal file
View File

@ -0,0 +1,257 @@
{
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
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 FormExportC;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ComCtrls, ExtCtrls, Translation;
type
TExportCDialog = class(TForm)
btnOK: TButton;
btnCancel: TButton;
GroupBox1: TGroupBox;
btnBrowse: TSpeedButton;
txtFilename: TEdit;
SaveDialog: TSaveDialog;
GroupBox3: TGroupBox;
txtOversample: TEdit;
txtFilterRadius: TEdit;
udOversample: TUpDown;
GroupBox2: TGroupBox;
chkMaintain: TCheckBox;
cbWidth: TComboBox;
cbHeight: TComboBox;
GroupBox4: TGroupBox;
cmbDepth: TComboBox;
chkRender: TCheckBox;
txtStrips: TEdit;
udStrips: TUpDown;
txtEstimator: TEdit;
txtEstimatorMin: TEdit;
txtEstimatorCurve: TEdit;
txtGammaTreshold: TEdit;
Panel1: TPanel;
Label6: TLabel;
Label15: TLabel;
Label13: TLabel;
Label16: TLabel;
Label5: TPanel;
Label3: TPanel;
Label1: TPanel;
Label2: TPanel;
Label7: TPanel;
Label8: TPanel;
Label9: TPanel;
Label14: TPanel;
Label12: TPanel;
Label11: TPanel;
Label10: TPanel;
txtDensity: TEdit;
Label4: TPanel;
procedure FormCreate(Sender: TObject);
procedure btnBrowseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure txtWidthChange(Sender: TObject);
procedure chkMaintainClick(Sender: TObject);
procedure txtHeightChange(Sender: TObject);
procedure txtDensityChange(Sender: TObject);
procedure txtFilterRadiusChange(Sender: TObject);
procedure txtOversampleChange(Sender: TObject);
procedure txtGammaTresholdChange(Sender: TObject);
private
FloatFormatSettings: TFormatSettings;
Estimator, EstimatorMin, EstimatorCurve: double;
Jitters, Batches, Strips: integer;
public
Filename: string;
ImageWidth, ImageHeight, Oversample: Integer;
Sample_Density, Filter_Radius: double;
GammaTreshold: double;
end;
var
ExportCDialog: TExportCDialog;
Ratio: double;
implementation
uses Global, Main, ShellAPI;
{$R *.DFM}
procedure TExportCDialog.btnBrowseClick(Sender: TObject);
begin
SaveDialog.InitialDir := ExtractFileDir(txtFilename.text);
SaveDialog.Filename := txtFilename.Text;
SaveDialog.DefaultExt := 'png';
SaveDialog.filterIndex := ExportFileFormat;
SaveDialog.Filter := Format('%s|*.png|%s|*.*',
[TextByKey('common-filter-png'),
TextByKey('common-filter-allfiles')]);
if SaveDialog.Execute then
begin
ExportFileFormat := SaveDialog.FilterIndex;
renderPath := ExtractFilePath(SaveDialog.Filename);
end;
end;
procedure TExportCDialog.FormShow(Sender: TObject);
begin
txtFilename.Text := Filename;
cbWidth.Text := IntToStr(MainCp.Width);
cbHeight.Text := IntToStr(MainCp.Height);
ImageWidth := MainCp.Width;
ImageHeight := MainCp.Height;
txtDensity.text := FloatToStr(Sample_density);
// if cmbDepth.ItemIndex <> 2 then
// txtBatches.text := IntToStr(Round(Sample_density / 4));
txtFilterRadius.text := FloatToStr(Filter_Radius);
txtOversample.text := IntToSTr(Oversample);
udOversample.Position := Oversample;
Ratio := ImageWidth / ImageHeight;
Batches := 1;
Estimator := 9.0;
EstimatorMin := 0.0;
EstimatorCurve := 0.4;
Jitters := 1;
GammaTreshold := MainCP.gamma_threshold; //0.01;
GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, FloatFormatSettings);
txtEstimator.Text := FloatToStr(Estimator, FloatFormatSettings);
txtEstimatorMin.Text := FloatToStr(EstimatorMin, FloatFormatSettings);
txtEstimatorCurve.Text := FloatToStr(EstimatorCurve, FloatFormatSettings);
// txtJitters.Text := IntToStr(Jitters);
txtGammaTreshold.Text := FloatToStr(GammaTreshold, FloatFormatSettings);
end;
procedure TExportCDialog.btnOKClick(Sender: TObject);
begin
Filename := txtFilename.text;
ImageWidth := StrToInt(cbWidth.Text);
ImageHeight := StrToInt(cbHeight.Text);
end;
procedure TExportCDialog.txtWidthChange(Sender: TObject);
begin
try
ImageWidth := StrToInt(cbWidth.Text);
if chkMaintain.checked and cbWidth.Focused then
begin
ImageHeight := Round(ImageWidth / ratio);
cbHeight.Text := IntToStr(ImageHeight)
end;
except
end;
end;
procedure TExportCDialog.chkMaintainClick(Sender: TObject);
begin
Ratio := ImageWidth / ImageHeight;
end;
procedure TExportCDialog.txtHeightChange(Sender: TObject);
begin
try
ImageHeight := StrToInt(cbHeight.Text);
if chkMaintain.checked and cbHeight.Focused then
begin
ImageWidth := Round(ImageHeight * ratio);
cbWidth.Text := IntToStr(ImageWidth)
end;
except
end;
end;
procedure TExportCDialog.txtDensityChange(Sender: TObject);
begin
try
Sample_Density := StrToFloat(txtDensity.Text);
// if cmbDepth.ItemIndex <> 2 then
// txtBatches.text := IntToStr(Round(Sample_density / 4));
except
end;
end;
procedure TExportCDialog.txtFilterRadiusChange(Sender: TObject);
begin
try
Filter_Radius := StrToFloat(txtFilterRadius.Text);
except
end;
end;
procedure TExportCDialog.txtOversampleChange(Sender: TObject);
begin
if StrToInt(txtOversample.Text) > udOversample.Max then
txtOversample.Text := IntToStr(udOversample.Max);
if StrToInt(txtOversample.Text) < udOversample.Min then
txtOversample.Text := IntToStr(udOversample.Min);
try
Oversample := StrToInt(txtOversample.Text);
except
end;
end;
procedure TExportCDialog.txtGammaTresholdChange(Sender: TObject);
begin
//GammaTreshold := 0.01;
try
GammaTreshold := StrToFloat(txtGammaTreshold.Text, FloatFormatSettings);
except
end;
end;
procedure TExportCDialog.FormCreate(Sender: TObject);
begin
btnOK.Caption := TextByKey('common-ok');
btnCancel.Caption := TextByKey('common-cancel');
Label1.Caption := TextByKey('common-width');
Label2.Caption := TextByKey('common-height');
GroupBox2.Caption := TextByKey('common-size');
Label13.Caption := TextByKey('common-pixels');
chkMaintain.Caption := TextByKey('common-keepaspect');
GroupBox1.Caption := TextByKey('common-destination');
Label10.Caption := TextByKey('common-filename');
btnBrowse.Hint := TextByKey('common-browse');
GroupBox3.Caption := TextByKey('common-quality');
Label5.Caption := TextByKey('common-filterradius');
Label4.Caption := TextByKey('common-density');
Label3.Caption := TextByKey('common-oversample');
Label14.Caption := TextByKey('common-gammathreshold');
self.Caption := TextByKey('main-menu-file-exportchaotica');
GroupBox4.Caption := TextByKey('export-paramoptions-title');
Label7.Caption := TextByKey('export-paramoptions-bufferdepth');
Label8.Caption := TextByKey('export-paramoptions-strips');
Label9.Caption := TextByKey('export-paramoptions-estimatorradius');
Label12.Caption := TextByKey('export-paramoptions-estimatorcurve');
Label11.Caption := TextByKey('export-paramoptions-estimatormin');
chkRender.Caption := TextByKey('export-paramoptions-dorender');
Label6.Caption := TextByKey('export-paramoptions-warningtitle');
Label15.Caption := TextByKey('export-paramoptions-warningtext');
end;
end.

338
Forms/FormFavorites.dfm Normal file
View File

@ -0,0 +1,338 @@
object FavoritesForm: TFavoritesForm
Left = 493
Top = 541
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'Favorite Scripts'
ClientHeight = 275
ClientWidth = 352
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Icon.Data = {
0000010001001010200000000000680400001600000028000000100000002000
0000010020000000000000040000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000D3D8ED00EFEFF800577FD1006988DA00EFEFFA00D3D9F600F8F9FE000000
0000000000000000000000000000000000000000000000000000BABADD009497
CB005B88CB007682CA004583D2005682DB00607ED700297DE100D1D8F6000000
000000000000000000000000000000000000F9F9FC008080C2003737C600211D
B3003C5DB40065A7E0004497DF00419CE50032AFE800597FDF00EFEFFC000000
0000000000000000000000000000E9E9F3006161B300302FD2002D2EE2004E65
D700415CB8005CA8E00084F8FF0066F9FF0032A3E8004880DF007295EA000000
00000000000000000000D0D0E5004949AF003232DE001C1BE5000001BF00557D
CC006F9BE00061AFE80090FFFF006DFFFF0033AFEB002BA6E700348AE7000000
000000000000B1B1D1003434AD002A2AE6001010E2000000D1000000D6000105
CD001F35C30066A9DE0057BAEB0049C2EF0033AFE700697DDC00D7DAF700FDFD
FE009898C3002727B6002929F0000C0CE1000000D6000000DD000000E2000208
D6006299D8003C5CD2002E73D7003B73E6002B7EEB003698E600DDE1F600B5B5
D1002424B8003C3CFE004646FD003D3DF4002828EF000A0AE8000000E8000205
E5001021D7000000D9002E70DB002C63DF00180EEC002134C600C9C9DF004C4C
A8004242F5006565FF006767FF006868FF006969FF005858FB002C2CF5000000
F2000000EF000000EB000612DC00030ED4000501E0002019D9007E7EB5003232
B4007171FF008181FF007B7BFF007B7BFF007D7DFF008181FF008080FF005959
FC001B1BF5000000EE000000E8000000E1000000D8001313EB004646A9003D3D
B7009191FF009898FF009494FF009494FF009494FF009494FF009595FF009C9C
FF008E8EFE005151F8001414EC000000E1000000D7000909EB004040A8004C4C
A2009F9FFC00B9B9FF00ACACFF00ACACFF00ACACFF00ACACFF00B2B2FF00B0B0
FF00B2B2FF00B6B6FF009797FC006565F1004646EC003030E7006969A7009B9B
BB006969C500D3D3FF00D7D7FF00D0D0FF00D1D1FF00D7D7FF00CBCBFF00CECE
FF00D5D5FF00D2D2FF00D8D8FF00E4E4FF00C9C9FF005353AF00C4C4D500F5F5
F7007B7BA6006D6DBD00BFBFF100D6D6FF00D5D5FF00B4B4F8005757D6006A6A
DC00C0C0FD00D7D7FF00D5D5FF00B4B4E9005C5CAB009B9BB700FDFDFE000000
0000F7F7F900ACACC00061619B005454A8004F4FAB004C4C9E008B8BAE007C7C
A6004A4AA0005151AB005454A4006A6A9E00C1C1D000FEFEFE00000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FF80
0000FE000000F8000000F0000000E0000000C000000000000000000000000000
0000000000000000000000000000000000000000000080010000FFFF0000}
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
DesignSize = (
352
275)
PixelsPerInch = 96
TextHeight = 13
object btnMoveUp: TSpeedButton
Left = 241
Top = 80
Width = 99
Height = 25
BiDiMode = bdLeftToRight
Caption = 'Move &Up'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFAE5D36
A23C0FA93F0BB24D17EBCEBEFFFFFFFFFFFFFFFFFFFFFFFFF8E1D2E46D1EE966
0EF16B0EF9822BFFFFFFFFFFFFA64A1EE4A66EE79146D06620B95F33FBF4F1FF
FFFFFFFFFFFDF7F3DC793FEA7720F89A40FA9D44F5720FFFFFFFFFFFFFA95233
E0B18AFFDA96FEA754BF5212CD8F73FFFFFFFFFFFFDFA282D96B21FD9433FFA9
4CF79B43ED7420FFFFFFFFFFFFDFC0B5A14423F1CEA8FFC882F09546B14510EC
D4C7F3E0D6C76128F58C36FF7F14FA8524E06109F7C7A8FFFFFFFFFFFFFFFFFF
C0816FB87155FDE2BAFFBE72D97831B55B31BF6B43DF8346FF7A14FF7406E05F
07E59461FFFFFFFFFFFFFFFFFFFFFFFFF8F0EDA74F32D5A992FFE5B5FDB362BC
5417BC5013FD8323FF6D00E86302CE6625FAEBE1FFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFE1C4B89F4020ECD7C5FFDBA5F6A456F48B36FF8117F46902BF4A01EBC1
A7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC38773B2684FFBF3DFFF
C987FFAC5BFD963BC65108D08A64FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFDFAF9A64D32CEA394FFF3D6FFC47BD87D38AF5228FBF5F2FFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE9D2C9A04226EC
DCD4F2D0A9A24016E5C8BAFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFC68D7DB2674AB97559C0826FFFFEFEFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF8F6AE
5D3CAB5634FBF7F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnMoveUpClick
end
object btnMoveDown: TSpeedButton
Left = 241
Top = 112
Width = 99
Height = 25
BiDiMode = bdLeftToRight
Caption = 'Move &Down'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFEF9F6EB7F38F07D30FEF6F0FFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEAA177E9
7522F0822CF39F6AFFFEFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFF3D5C3DA6219F8B46FFC9036EB6008F9D1B5FFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDF9F6D2672EEB9C5FFF
BA73FF760BF56903EC7623FEF5EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFD9916DD77538FDD29EFF9B44FF8420FE770EEE6300F0995DFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE7C4B1C15117F5CBA3FFC484F9
9138F8872CFF8521FB7209E85F00F7C4A1FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
F7EEE9BC592DE3AD88FFE3B9FEB267D66317D75F11FE963CFF821BF56C07E873
22FCE9DBFFFFFFFFFFFFFFFFFFFFFFFFC6816AC87B56FEF0D9FFD99EE28B46CE
6C36D57741E6853DFF973BFF7B14ED6604EE965AFFFFFFFFFFFFFFFFFFDDBAAF
AA4923F4E6D9FFF7D1F1BF85BF521AF3DBCDF7E6DBCF6225F4A05CFF8E2FFB78
12E65F01F5C5A3FFFFFFFFFFFFA95131E3C6BDFFFFFFFDF2C7C16430D59479FF
FFFFFFFFFFE3A688D46E35FDA75DFF8C28F77612E76D17FFFFFFFFFFFFA74F28
E1C4B2E3C7AACC8E61B85C36FBF5F2FFFFFFFFFFFFFDF7F4D37742E07529F382
28F47618E46103FFFFFFFFFFFFB0613D9D3B179D3A14A7461CECD3C6FFFFFFFF
FFFFFFFFFFFFFFFFF6E3D7CF6220D1570CD65B0BE1772FFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnMoveDownClick
end
object btnAdd: TSpeedButton
Left = 241
Top = 16
Width = 99
Height = 25
BiDiMode = bdLeftToRight
Caption = '&Add'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
9CD8F52195E1B7D7F3FFFFFFFFFFFFFFFFFFFFFFFFF0F6FC3A80811A6B3E196B
3725734184B094FFFFFFFFFFFFFFFFFFBBE7F935B9EB209BE366AAE5F3F8FDFF
FFFFB7D9F21A7782288C5364BA8D95D2B264BA8D288C5381AE91FFFFFFFFFFFF
F7FCFE1BB0EBADE7F83AB1E9248ADC60ABE5249FE11D6F3F62BA8B60BA87FFFF
FF60B98767BC8F20703DFFFFFFFFFFFFFFFFFF58C7F283D7F58DDEF672D3F355
C3EE75D7F4317B4C9CD4B6FFFFFFFFFFFFFFFFFF95D2B2196B37FFFFFFFFFFFF
FFFFFF9BDEF853C6F089DDF576D7F46FD5F463D2F345896290D3B192D6B1FFFF
FF65BC8C67BC8F20703DFFFFFFFFFFFFF3FBFE51C2F277D5F589DCF678D8F46E
D5F366D3F361B2AE61AB8195D4B4BAE6D06ABB8F2D8F5781AE91FFFFFFDBF2FD
27AEF151C7F4A1E3F78ADDF67FD9F575D7F46CD4F36FD5F357ACB15493734F8E
664A8A6199BDA6FFFFFFB1E6FC0CACF46AD2F6C3EDFAABE7F99AE1F788DCF57E
D9F57AD8F57ED9F58BDDF686D9F42CA5E54E9CE0F3F9FDFFFFFF30C7FA41CAF8
41C9F740C8F63FC6F57DD7F79CE1F78BDCF67CD7F54EC4F038BAED39BAEC34B5
EA14A8E4A2D9F3FFFFFFF7FDFFD5F4FED2F3FED2F2FDB1B5AA36B3DA9BE1F8A1
E3F849C5F282ACB5D2F0FBD2EFFBD2EFFBE3F5FCFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFD8B69AC18E5E7AB9C06CD4F7AAE5F916A6E2B48055CEAC92FFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDABA9DC69564D9BC95BBAF8A17BBF370
D5F75BA4B7D3B08BB78154CEAC92FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
B97940DDC299D5B581C99E5F45B5D12EC3F59E9873CDA575D3B28BA25E2AFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBC7D42E2CCA4CEA867CCA46495AB8F51
B1C1C6995BC49658DABC97A5612DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
BE8045E4CFA6D1AD6BCFAA68CDA666CBA363C99F60C79B5DDCC099A86530FFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC18347E5D1A8D3B26FD2AE6DD0AB6ACE
A867CCA565CAA161DDC49DAB6933FFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnAddClick
end
object btnRemove: TSpeedButton
Left = 241
Top = 48
Width = 99
Height = 25
BiDiMode = bdLeftToRight
Caption = '&Remove'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
9CD8F52195E1B7D7F3FFFFFFFFFFFFFFFFFFFFFFFFF0F6FC417ACD084ABA0543
BC1F59C186A6DDFFFFFFFFFFFFFFFFFFBBE7F935B9EB209BE366AAE5F3F8FDFF
FFFFB7D9F21A6DCA2565C92177E60579EA0164DD074FBE86A6DDFFFFFFFFFFFF
F7FCFE1BB0EBADE7F83AB1E9248ADC60ABE5249FE10E53BF639DF4187FFF0076
F80076EE0368E11E59C0FFFFFFFFFFFFFFFFFF58C7F283D7F58DDEF672D3F355
C3EE75D7F40443BCAECDFEFFFFFFFFFFFFFFFFFF187FEF0543BCFFFFFFFFFFFF
FFFFFF9BDEF853C6F089DDF576D7F46FD5F463D2F31257C18DB5F64D92FF1177
FF2186FF408AEB245CC2FFFFFFFFFFFFF3FBFE51C2F277D5F589DCF678D8F46E
D5F366D3F34B9ADE3773D18DB5F7B8D6FE72A8F52F6DCC94AFE2FFFFFFDBF2FD
27AEF151C7F4A1E3F78ADDF67FD9F575D7F46CD4F36FD5F33B91DB0C52C30543
BC205AC188A7DEFFFFFFB1E6FC0CACF46AD2F6C3EDFAABE7F99AE1F788DCF57E
D9F57AD8F57ED9F58BDDF686D9F42CA5E54E9CE0F3F9FDFFFFFF30C7FA41CAF8
41C9F740C8F63FC6F57DD7F79CE1F78BDCF67CD7F54EC4F038BAED39BAEC34B5
EA14A8E4A2D9F3FFFFFFF7FDFFD5F4FED2F3FED2F2FDB1B5AA36B3DA9BE1F8A1
E3F849C5F282ACB5D2F0FBD2EFFBD2EFFBE3F5FCFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFD8B69AC18E5E7AB9C06CD4F7AAE5F916A6E2B48055CEAC92FFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDABA9DC69564D9BC95BBAF8A17BBF370
D5F75BA4B7D3B08BB78154CEAC92FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
B97940DDC299D5B581C99E5F45B5D12EC3F59E9873CDA575D3B28BA25E2AFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBC7D42E2CCA4CEA867CCA46495AB8F51
B1C1C6995BC49658DABC97A5612DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
BE8045E4CFA6D1AD6BCFAA68CDA666CBA363C99F60C79B5DDCC099A86530FFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC18347E5D1A8D3B26FD2AE6DD0AB6ACE
A867CCA565CAA161DDC49DAB6933FFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnRemoveClick
end
object btnSort: TSpeedButton
Left = 241
Top = 144
Width = 99
Height = 25
BiDiMode = bdLeftToRight
Caption = ' &Sort'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFBFBFF
C7C7FFA7A7FFA4A4FFA4A4FFA6A6FFD5D5FFFDFDFFFFFFFFC8C8C82828289898
98FFFFFFFFFFFFFFFFFFFFFFFFF6F6FF6A6AFF1010FF1D1DFF3434FF3C3CFFA3
A3FFFCFCFFF9F9F98484841717175C5C5CE4E4E4FFFFFFFFFFFFFFFFFFFCFCFF
A2A2FF1D1DFF2A2AFFA2A2FFD1D1FFE9E9FFFFFFFFD8D8D83E3E3E1010102626
26B0B0B0FCFCFCFFFFFFFFFFFFFFFFFFEBEBFF7373FF1616FF6F6FFFEFEFFFFF
FFFFFFFFFF9090902625261A19191F1F1F636363F3F3F3FFFFFFFFFFFFFFFFFF
FFFFFFD9D9FF4D4DFF1B1BFF9A9AFFF9F9FFFFFFFFCECDCD8988883737377070
70BABABAFAFAFAFFFFFFFFFFFFFEFEFFDFDFFFBFBFFF7777FF1010FF3232FFCE
CEFFFFFFFFFFFFFFD3D3D34E4E4EABABABFFFFFFFFFFFFFFFFFFFFFFFFFBFBFF
9C9CFF3B3BFF2D2DFF2525FF2C2CFFBABAFFFFFFFFFFFFFFD4D4D4575757AFAF
AFFFFFFFFFFFFFFFFFFFFFFFFFFEFEFFE4E4FFC6C6FFC2C2FFC2C2FFC6C6FFEE
EEFFFFFFFFFFFFFFD7D6D6626262B4B4B4FFFFFFFFFFFFFFFFFFFFFFFFFEFCFB
F6E1D1F8E4D5FFFDFBFFFFFDF9E8DAF4DDCBFDFAF7FFFFFFD9D9D96D6D6DB9B9
B9FFFFFFFFFFFFFFFFFFFFFFFFFCF8F4DC9B67D68A4CF2DAC6F5E3D4D99259D7
8C4FFAEFE7FFFFFFDDDDDC797979BFBFBFFFFFFFFFFFFFFFFFFFFFFFFFFEFCFA
E4B188CA6717D07932D27D38C96210DD9D6AFCF6F2FFFFFFE0E0DF858584C4C5
C4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF1D6C0CD7024CE7228CF752DC96412EB
C4A5FFFEFEFFFFFFE3E3E2919190CACACAFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
F9EDE3D88F54CF752CD07730D27F3BF5E2D3FFFFFFFFFFFFE6E6E69D9D9DD0D0
D0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFCFAE5B48CC8600CC65B05DD9D6AFC
F8F4FFFFFFFFFFFFE9E9E9A9A9A9D6D6D6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFF0D4BDCF752DCC6B1DEAC3A3FFFFFFFFFFFFFFFFFFECECECB8B8B8DCDC
DCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF5EFEFD2BAEDCCB1FAF0E8FF
FFFFFFFFFFFFFFFFF9F9F9E7E7E7F3F3F3FFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnSortClick
end
object btnClear: TSpeedButton
Left = 241
Top = 176
Width = 99
Height = 25
BiDiMode = bdLeftToRight
Caption = ' &Clear'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000CC483FBEBEBE
9F9F9FA1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1
A19F9F9FB4B4B4CC483FC7C7C7BABABAEAEAEAF2F2F2F5F5F5F7F7F7F9F9F9FB
FBFBFCFCFCFBFBFBF9F9F9F7F7F7F5F5F5F1F1F1CACACAB0B0B0A4A4A4E3E3E3
6E6EE41717DB1616D91414D81313D71212D61111D61212D61212D71414D81515
D95454E1F0F0F0A3A3A3A0A0A0E9E9E92929DF1313DC1111DA1010D90E0ED80E
0ED80E0ED80E0ED80E0ED80F0FD91111DA1212DCF1F1F1A9A9A9A0A0A0E9E9E9
2B2BE11515DE1717DD7F80E56566E31111DA1111DA3838DE898AE63031DF1313
DD1515DEF1F1F1A9A9A9A0A0A0E8E8E82D2DE31818E04E4FE3ECEEEEECEEEE7B
7CE54444E0E0E2EDECEEEE8E8FE71616DF1818E0F0F0F0A9A9A9A0A0A0E7E7E7
2E2EE41A1AE32020E2C6C8ECECEEEEECEEEEE6E8EDECEEEEE4E6EE4949E41919
E11A1AE2EFEFEFA9A9A9A0A0A0E6E6E63131E61D1DE51C1CE42C2DE4D0D2EDEC
EEEEECEEEEE9EBEE5152E61B1BE31C1CE41D1DE5EDEDEDA9A9A9A0A0A0E5E5E5
3333E82020E71F1FE74F4FE8E2E4EEECEEEEECEEEEECEEEE8485EA1E1EE61F1F
E62020E7ECECECA8A8A8A0A0A0E3E3E33636EB2323EA3F40EAE3E5EEECEEEEE4
E7EED1D3EDECEEEEECEEEE696AEA2222E92323EAEAEAEAA8A8A8A0A0A0E1E1E1
3838ED2626EC5252ECECEEEEE4E6EE5859EC3435ECC8CAEDECEEEE8E8FED2525
EC2626ECE8E8E8A8A8A8A0A0A0E0E0E03939EE2828EE2828EE5657EE3E3EEE27
27ED2727ED3434ED5F5FED3030EE2828EE2828EEE6E6E6A8A8A8A0A0A0DEDEDE
3D3DED2828EE2828EE2828EE2828EE2828EE2828EE2828EE2828EE2828EE2828
EE2B2BEEE4E4E4A8A8A8A9A9A9D2D2D29D9DE75D5DEB5C5CEB5D5DEC5D5DEC5D
5DEC5D5DEC5D5DEC5D5DEC5D5DEC5C5CEB8D8DE8DFDFDFA1A1A1D2D2D2A9A9A9
CBCBCBD4D4D4D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5
D5D0D0D0B2B2B2BBBBBBCC483FDBDBDBB3B3B3ACACACACACACACACACACACACAC
ACACACACACACACACACACACACACACACACACAFAFAFD1D1D1CC483F}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnClearClick
end
object ScriptList: TListView
Left = 16
Top = 16
Width = 218
Height = 215
Anchors = [akLeft, akTop, akRight, akBottom]
Columns = <
item
AutoSize = True
Caption = 'Name'
end>
HideSelection = False
ReadOnly = True
RowSelect = True
ParentShowHint = False
ShowColumnHeaders = False
ShowHint = True
TabOrder = 0
ViewStyle = vsReport
OnChange = ScriptListChange
OnInfoTip = ScriptListInfoTip
end
object btnOK: TButton
Left = 180
Top = 246
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = '&OK'
TabOrder = 1
OnClick = btnOKClick
end
object btnCancel: TButton
Left = 260
Top = 246
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = '&Cancel'
ModalResult = 2
TabOrder = 2
end
end

273
Forms/FormFavorites.pas Normal file
View File

@ -0,0 +1,273 @@
{
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 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 FormFavorites;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, Translation, Vcl.Buttons;
type
TFavoritesForm = class(TForm)
ScriptList: TListView;
btnMoveUp: TSpeedButton;
btnMoveDown: TSpeedButton;
btnOK: TButton;
btnCancel: TButton;
btnAdd: TSpeedButton;
btnRemove: TSpeedButton;
btnSort: TSpeedButton;
btnClear: TSpeedButton;
procedure FormShow(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnAddClick(Sender: TObject);
procedure btnRemoveClick(Sender: TObject);
procedure ScriptListChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure btnMoveUpClick(Sender: TObject);
procedure btnMoveDownClick(Sender: TObject);
procedure ScriptListInfoTip(Sender: TObject; Item: TListItem;
var InfoTip: string);
procedure btnSortClick(Sender: TObject);
procedure btnClearClick(Sender: TObject);
private
{ Private declarations }
public
Faves: TStringList;
{ Public declarations }
end;
var
FavoritesForm: TFavoritesForm;
implementation
uses Global, ScriptForm;
{$R *.DFM}
procedure TFavoritesForm.FormShow(Sender: TObject);
var
ListItem: TListItem;
i: integer;
s: string;
begin
Faves.Text := Favorites.Text;
ScriptList.Items.Clear;
for i := 0 to Favorites.Count - 1 do
begin
ListItem := ScriptList.Items.Add;
s := ExtractFileName(Favorites[i]);
s := Copy(s, 0, length(s) - Length(ExtractFileExt(s)));
Listitem.Caption := s;
end;
if Favorites.Count <> 0 then
ScriptList.Selected := ScriptList.Items[0]
else
btnRemove.Enabled := False;
if ScriptList.Items.Count <= 1 then
begin
btnMoveUp.Enabled := False;
btnMoveDown.Enabled := False;
end;
end;
procedure TFavoritesForm.btnOKClick(Sender: TObject);
begin
ModalResult := mrOK;
Faves.SaveToFile(AppPath + scriptFavsFilename);
end;
procedure TFavoritesForm.FormCreate(Sender: TObject);
begin
btnOK.Caption := TextByKey('common-ok');
btnCancel.Caption := TextByKey('common-cancel');
self.Caption := TextByKey('favscripts-title');
btnAdd.Caption := TextByKey('favscripts-add');
btnRemove.Caption := TextByKey('favscripts-remove');
btnMoveUp.Caption := TextByKey('favscripts-moveup');
btnMoveDown.Caption := TextByKey('favscripts-movedown');
btnSort.Caption := TextByKey('varorder-byname'); // AV
btnClear.Caption := TextByKey('common-clear'); // AV
Faves := TStringList.Create;
end;
procedure TFavoritesForm.FormDestroy(Sender: TObject);
begin
Faves.Free;
end;
procedure TFavoritesForm.btnAddClick(Sender: TObject);
var
ListItem: TListItem;
i : integer;
s: string;
begin
s := AppPath + 'Scripts';
if DirectoryExists(s) then
ScriptEditor.MainOpenDialog.InitialDir := s
else ScriptEditor.MainOpenDialog.InitialDir := ParamFolder;
ScriptEditor.MainOpenDialog.Filter := Format('%s|*.aposcript;*.asc|%s|*.*',
[TextByKey('common-filter-scriptfiles'),
TextByKey('common-filter-allfiles')]);
if ScriptEditor.mainOpenDialog.Execute then
begin
for i := 0 to Faves.Count - 1 do
begin
if ScriptEditor.MainOpenDialog.Filename = Faves[i] then exit;
end;
Faves.add(ScriptEditor.MainOpenDialog.Filename);
ListItem := ScriptList.Items.Add;
s := ExtractFileName(ScriptEditor.MainOpenDialog.Filename);
s := Copy(s, 0, length(s) - Length(ExtractFileExt(s)));
Listitem.Caption := s;
ScriptList.Selected := ScriptList.Items[ScriptList.Items.Count - 1];
btnRemove.Enabled := True;
end;
if ScriptList.Items.Count <= 1 then
begin
btnMoveUp.Enabled := False;
btnMoveDown.Enabled := False;
end;
end;
procedure TFavoritesForm.btnRemoveClick(Sender: TObject);
var
i: integer;
begin
if not assigned(ScriptList.Selected) then exit; // AV
i := ScriptList.Selected.Index;
Faves.Delete(i);
ScriptList.Items[i].delete;
if ScriptList.Items.Count <> 0 then
if i < ScriptList.Items.Count then
ScriptList.Selected := ScriptList.Items[i]
else
ScriptList.Selected := ScriptList.Items[ScriptList.Items.Count - 1]
else
btnRemove.Enabled := False;
if ScriptList.Items.Count <= 1 then
begin
btnMoveUp.Enabled := False;
btnMoveDown.Enabled := False;
end;
end;
procedure TFavoritesForm.btnSortClick(Sender: TObject);
var
scripts: TStringList;
i : integer;
begin
if (ScriptList.Items.Count <= 1) then exit;
scripts := TStringList.Create;
for i := 0 to Faves.Count - 1 do
scripts.AddPair(ScriptList.Items[i].Caption, Faves[i]);
ScriptList.Items.BeginUpdate;
scripts.Sort;
for i := 0 to Faves.Count - 1 do
begin
ScriptList.Items[i].Caption := scripts.Names[i];
Faves[i] := scripts.ValueFromIndex[i];
end;
ScriptList.Items.EndUpdate;
scripts.Free;
end;
procedure TFavoritesForm.ScriptListChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
begin
// TODO: optimize old code
btnRemove.Enabled := (ScriptList.Items.Count > 0);
if (Item.Index = ScriptList.Items.Count - 1) then
btnMoveDown.Enabled := False
else
btnMoveDown.Enabled := True;
if (Item.Index = 0) then
btnMoveUp.Enabled := False
else
btnMoveUp.Enabled := True;
if (ScriptList.Items.Count <= 1) then
begin
btnMoveDown.Enabled := False;
btnMoveUp.Enabled := False;
end;
end;
procedure TFavoritesForm.ScriptListInfoTip(Sender: TObject; Item: TListItem;
var InfoTip: string);
begin
InfoTip := Faves[Item.Index]; // AV: show the corresponding full file name
end;
procedure TFavoritesForm.btnMoveUpClick(Sender: TObject);
var
i: integer;
s: string;
begin
if not assigned(ScriptList.Selected) then exit; // AV
i := ScriptList.Selected.Index;
s := Faves[i];
Faves[i] := Faves[i - 1];
Faves[i - 1] := s;
s := ScriptList.Selected.Caption;
ScriptList.Selected.Caption := ScriptList.Items[i - 1].Caption;
ScriptList.Items[i - 1].Caption := s;
ScriptList.Selected := ScriptList.Items[i - 1];
end;
procedure TFavoritesForm.btnClearClick(Sender: TObject);
begin
ScriptList.Items.Clear;
Faves.Clear;
btnRemove.Enabled := False;
end;
procedure TFavoritesForm.btnMoveDownClick(Sender: TObject);
var
i: integer;
s: string;
begin
if not assigned(ScriptList.Selected) then exit; // AV
i := ScriptList.Selected.Index;
s := faves[i];
Faves[i] := Faves[i + 1];
Faves[i + 1] := s;
s := ScriptList.Selected.Caption;
ScriptList.Selected.Caption := ScriptList.Items[i + 1].Caption;
ScriptList.Items[i + 1].Caption := s;
ScriptList.Selected := ScriptList.Items[i + 1];
end;
end.

971
Forms/FormRender.dfm Normal file
View File

@ -0,0 +1,971 @@
object RenderForm: TRenderForm
Left = 851
Top = 205
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'Render to Disk'
ClientHeight = 532
ClientWidth = 497
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnActivate = FormActivate
OnClose = FormClose
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
DesignSize = (
497
532)
PixelsPerInch = 96
TextHeight = 13
object btnRender: TButton
Left = 252
Top = 483
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'Start'
Default = True
TabOrder = 0
OnClick = btnRenderClick
end
object btnCancel: TButton
Left = 412
Top = 483
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'Close'
TabOrder = 1
OnClick = btnCancelClick
end
object btnPause: TButton
Left = 332
Top = 483
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'Pause'
TabOrder = 2
OnClick = btnPauseClick
end
object PageCtrl: TPageControl
Left = 8
Top = 8
Width = 481
Height = 436
ActivePage = TabSettings
Anchors = [akLeft, akTop, akRight, akBottom]
Images = MainForm.Buttons
TabOrder = 3
object TabSettings: TTabSheet
Caption = 'Settings'
ImageIndex = 18
DesignSize = (
473
407)
object btnBrowse: TSpeedButton
Left = 416
Top = 7
Width = 24
Height = 24
Hint = 'Browse...'
Anchors = [akTop, akRight]
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF75848F66808F
607987576E7B4E626F4456613948522E3A43252E351B222914191E0E12160E13
18FF00FFFF00FFFF00FF77879289A1AB6AB2D4008FCD008FCD008FCD048CC708
88BE0F82B4157CA91B779F1F7296224B5C87A2ABFF00FFFF00FF7A8A957EBED3
8AA4AE7EDCFF5FCFFF55CBFF4CC4FA41BCF537B3F02EAAEB24A0E5138CD42367
805E696DFF00FFFF00FF7D8E9879D2EC8BA4AD89C2CE71D8FF65D3FF5CCEFF51
C9FE49C1FA3FB9F534B0EE29A8E91085CD224B5B98B2BAFF00FF80919C81D7EF
7DC5E08CA6B080DDFE68D3FF67D4FF62D1FF58CDFF4EC7FC46BEF73BB6F231AC
EC2569817A95A1FF00FF83959F89DCF18CE2FF8DA8B18CBAC774D8FF67D4FF67
D4FF67D4FF5FD0FF54CDFF4BC5FC41BBF72EA2DB51677498B2BA869AA392E1F2
98E8FD80C4DE8EA7B081DEFD84E0FF84E0FF84E0FF84E0FF81DFFF7BDDFF74D8
FF6BD6FF56A9D18F9BA4889CA59AE6F39FEBFB98E8FE8BACB98BACB98AAAB788
A6B386A3AF839FAA819AA67F95A17C919D7A8E99798B957788938BA0A8A0EAF6
A6EEF99FEBFB98E8FE7ADAFF67D4FF67D4FF67D4FF67D4FF67D4FF67D4FF7788
93FF00FFFF00FFFF00FF8EA2ABA7EEF6ABF0F7A6EEF99FEBFB98E8FD71D4FB89
9EA78699A382949F7E909A7A8C97778893FF00FFFF00FFFF00FF8FA4ACA0D2DA
ABF0F7ABF0F7A6EEF99FEBFB8DA1AAB5CBD0FF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFBDCED48FA4AC8FA4AC8FA4AC8FA4AC8FA4ACB5CBD0FF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnBrowseClick
end
object btnGoTo: TSpeedButton
Left = 440
Top = 7
Width = 24
Height = 24
Hint = 'Browse...'
Anchors = [akTop, akRight]
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FF964924EADBD3FF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF9D
4D259D4E28EADBD3FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFCF835D9247239A4B25A24F27AB5429BF6A3FA0502AEADBD3FF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFD78B65FDB089F7905CEC8856DE
7F4FD17648C46E42A25631EADBD3FF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFDE926CFCB997FDA578FC935EF28C59E58453D87B4CC66E41AE582BFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFE49872FBC3A6FDBE9EFEAE85FF
A87DF89D6FE58351AE582BF4E7E1FF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFE89C76E29670DA8E68D1855FDB906AF79A6BAE582BF4E7E1FF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFE5
9973C5764EF3E6DFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFE89C76F8EDE8FF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnGoToClick
end
object GroupBox5: TGroupBox
Left = 5
Top = 35
Width = 425
Height = 57
Caption = 'Preset'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
object btnSavePreset: TSpeedButton
Left = 368
Top = 18
Width = 24
Height = 24
Hint = 'Save Preset'
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnSavePresetClick
end
object btnDeletePreset: TSpeedButton
Left = 392
Top = 18
Width = 24
Height = 24
Hint = 'Delete Preset'
Caption = 'r'
Flat = True
Font.Charset = SYMBOL_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Marlett'
Font.Style = [fsItalic]
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnDeletePresetClick
end
object cmbPreset: TComboBox
Left = 10
Top = 20
Width = 351
Height = 21
Style = csDropDownList
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
OnChange = cmbPresetChange
end
end
object GroupBox2: TGroupBox
Left = 5
Top = 92
Width = 233
Height = 97
Anchors = [akLeft, akTop, akRight]
Caption = 'Size'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
DesignSize = (
233
97)
object lblRatio: TLabel
Left = 12
Top = 72
Width = 56
Height = 13
Caption = 'Aspect ratio'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object pnlWidth: TPanel
Left = 8
Top = 20
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Width'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 2
end
object pnlHeight: TPanel
Left = 8
Top = 44
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Height'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 3
end
object cbHeight: TComboBox
Left = 120
Top = 44
Width = 105
Height = 21
Anchors = [akLeft, akTop, akRight]
BiDiMode = bdLeftToRight
Enabled = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentBiDiMode = False
ParentFont = False
TabOrder = 1
OnChange = txtHeightChange
OnExit = cbHeightExit
OnKeyPress = NumFieldKeyPress
Items.Strings = (
'200'
'240'
'480'
'600'
'768'
'1024'
'1200'
'1920'
'2048'
'2400')
end
object cbWidth: TComboBox
Left = 120
Top = 20
Width = 105
Height = 21
Anchors = [akLeft, akTop, akRight]
BiDiMode = bdLeftToRight
Enabled = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentBiDiMode = False
ParentFont = False
TabOrder = 0
OnChange = txtWidthChange
OnExit = cbWidthExit
OnKeyPress = NumFieldKeyPress
Items.Strings = (
'320'
'640'
'800'
'1024'
'1280'
'1600'
'1920'
'2048'
'2560'
'3200')
end
object cbAspectRatio: TComboBox
Left = 101
Top = 70
Width = 123
Height = 21
Style = csDropDownList
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 4
OnChange = cbAspectRatioChange
Items.Strings = (
'Custom'
'Maintain aspect ratio'
'3 : 2 (Classic Film)'
'4 : 3 (Standart Monitor)'
'5 : 4 '
'16 : 9 (HD Video)'
'16 : 10'
'21 : 9 (CinemaScope)')
end
end
object GroupBox3: TGroupBox
Left = 248
Top = 92
Width = 218
Height = 97
Anchors = [akTop, akRight]
Caption = 'Quality settings'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 2
DesignSize = (
218
97)
object udOversample: TUpDown
Left = 196
Top = 68
Width = 15
Height = 21
Anchors = [akTop, akRight]
Associate = txtOversample
Min = 1
Max = 4
Position = 1
TabOrder = 3
end
object pnlDensity: TPanel
Left = 8
Top = 20
Width = 121
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Density'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 4
end
object pnlFilter: TPanel
Left = 8
Top = 44
Width = 121
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Filter radius'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 5
end
object pnlOversample: TPanel
Left = 8
Top = 68
Width = 121
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Oversample'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 6
end
object txtDensity: TComboBox
Left = 128
Top = 20
Width = 82
Height = 21
AutoComplete = False
Anchors = [akLeft, akTop, akRight]
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
OnChange = txtDensityChange
OnCloseUp = txtDensityChange
OnExit = txtDensityExit
OnKeyPress = NumFieldKeyPress
Items.Strings = (
'200'
'500'
'1000'
'2000'
'4000')
end
object txtFilterRadius: TEdit
Left = 128
Top = 44
Width = 68
Height = 21
Anchors = [akLeft, akTop, akRight]
BiDiMode = bdLeftToRight
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentBiDiMode = False
ParentFont = False
TabOrder = 1
Text = '0.1'
OnExit = txtFilterRadiusExit
OnKeyPress = NumFieldKeyPress
end
object txtOversample: TEdit
Left = 128
Top = 68
Width = 68
Height = 21
Anchors = [akLeft, akTop, akRight]
BiDiMode = bdLeftToRight
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentBiDiMode = False
ParentFont = False
ReadOnly = True
TabOrder = 2
Text = '1'
OnChange = txtOversampleChange
OnKeyPress = NumFieldKeyPress
end
object sbFilterRadius: TSpinButton
Left = 196
Top = 44
Width = 15
Height = 21
DownGlyph.Data = {
0E010000424D0E01000000000000360000002800000009000000060000000100
200000000000D800000000000000000000000000000000000000008080000080
8000008080000080800000808000008080000080800000808000008080000080
8000008080000080800000808000000000000080800000808000008080000080
8000008080000080800000808000000000000000000000000000008080000080
8000008080000080800000808000000000000000000000000000000000000000
0000008080000080800000808000000000000000000000000000000000000000
0000000000000000000000808000008080000080800000808000008080000080
800000808000008080000080800000808000}
FocusControl = txtFilterRadius
TabOrder = 7
UpGlyph.Data = {
0E010000424D0E01000000000000360000002800000009000000060000000100
200000000000D800000000000000000000000000000000000000008080000080
8000008080000080800000808000008080000080800000808000008080000080
8000000000000000000000000000000000000000000000000000000000000080
8000008080000080800000000000000000000000000000000000000000000080
8000008080000080800000808000008080000000000000000000000000000080
8000008080000080800000808000008080000080800000808000000000000080
8000008080000080800000808000008080000080800000808000008080000080
800000808000008080000080800000808000}
OnDownClick = sbFilterRadiusDownClick
OnUpClick = sbFilterRadiusUpClick
end
end
object GroupBox4: TGroupBox
Left = 5
Top = 192
Width = 461
Height = 99
Anchors = [akLeft, akTop, akRight]
Caption = 'Resource usage'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 3
DesignSize = (
461
99)
object lblApproxMem: TLabel
Left = 431
Top = 100
Width = 50
Height = 13
Alignment = taRightJustify
Caption = '0000 Mb'
Visible = False
end
object lblPhysical: TLabel
Left = 439
Top = 96
Width = 42
Height = 13
Alignment = taRightJustify
Caption = '0000 Mb'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
Visible = False
end
object lblMaxbits: TLabel
Left = 433
Top = 116
Width = 40
Height = 13
Hint = '- No render stats -'
Alignment = taRightJustify
Caption = '99.999'
ParentShowHint = False
ShowHint = True
Visible = False
end
object Label9: TLabel
Left = 440
Top = 108
Width = 117
Height = 13
Hint = '- No render stats -'
Caption = 'Max bits per sample:'
ParentShowHint = False
ShowHint = True
Visible = False
end
object lblMemory: TLabel
Left = 11
Top = 12
Width = 445
Height = 24
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption =
'The render process will use 0000 Mb of 0000MB available physical' +
' memory'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
Layout = tlCenter
WordWrap = True
ExplicitWidth = 442
end
object lblCPUCores: TLabel
Left = 11
Top = 35
Width = 445
Height = 26
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
Layout = tlCenter
WordWrap = True
ExplicitWidth = 442
end
object chkLimitMem: TCheckBox
Left = 444
Top = 134
Width = 125
Height = 17
Caption = 'Limit memory usage to:'
TabOrder = 0
Visible = False
end
object pnlLimit: TPanel
Left = 8
Top = 68
Width = 121
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Memory limit'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 2
end
object cbMaxMemory: TComboBox
Left = 128
Top = 68
Width = 97
Height = 21
Style = csDropDownList
BiDiMode = bdLeftToRight
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ItemIndex = 0
ParentBiDiMode = False
ParentFont = False
TabOrder = 1
Text = 'No limit'
OnChange = cbMaxMemoryChange
Items.Strings = (
'No limit'
'32'
'64'
'128'
'256'
'512'
'1024'
'1536')
end
object PBMem: TProgressBar
Left = 232
Top = 68
Width = 217
Height = 21
TabOrder = 3
end
end
object GroupBox1: TGroupBox
Left = 5
Top = 303
Width = 220
Height = 81
Caption = 'Output options'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 5
DesignSize = (
220
81)
object chkSave: TCheckBox
Left = 8
Top = 16
Width = 204
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Save parameters in a flame'
Checked = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
State = cbChecked
TabOrder = 0
end
object chkSaveIncompleteRenders: TCheckBox
Left = 8
Top = 58
Width = 204
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Save incomplete renders'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 1
OnClick = chkSaveIncompleteRendersClick
end
object chkEmbedFlame: TCheckBox
Left = 8
Top = 37
Width = 204
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Save parameters in a PNG-image '
Checked = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
State = cbChecked
TabOrder = 2
end
end
object GroupBox6: TGroupBox
Left = 232
Top = 303
Width = 234
Height = 81
Anchors = [akLeft, akTop, akRight]
Caption = 'Completion options'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 6
DesignSize = (
234
81)
object chkPostProcess: TCheckBox
Left = 8
Top = 16
Width = 217
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Post-process after completion'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
end
object chkShutdown: TCheckBox
Left = 8
Top = 37
Width = 217
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Shut down computer when complete'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 1
end
object chkPlaySound: TCheckBox
Left = 8
Top = 58
Width = 217
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Play sound when complete'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 2
OnClick = chkPlaySoundClick
end
end
object pnlTarget: TPanel
Left = 5
Top = 8
Width = 121
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Destination'
TabOrder = 7
end
object txtFilename: TEdit
Left = 125
Top = 8
Width = 290
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 4
OnChange = txtFilenameChange
end
object chkBinary: TCheckBox
Left = 13
Top = 388
Width = 457
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption =
'Write raw data (WARNING: this is experimental and slows down the' +
' rendering!!!)'
Enabled = False
TabOrder = 8
Visible = False
end
end
object TabOutput: TTabSheet
Caption = 'Output'
ImageIndex = 38
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
object Output: TMemo
Left = 0
Top = 0
Width = 473
Height = 407
Align = alClient
BorderStyle = bsNone
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clBtnText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 0
end
end
end
object StatusBar: TStatusBar
Left = 0
Top = 513
Width = 497
Height = 19
Panels = <
item
Width = 161
end
item
Width = 150
end
item
Width = 50
end>
end
object btnDonate: TButton
Left = 8
Top = 483
Width = 82
Height = 25
Anchors = [akLeft, akBottom]
Caption = 'Donate'
ParentShowHint = False
ShowHint = True
TabOrder = 6
OnClick = btnDonateClick
end
object btnSaveLog: TButton
Left = 95
Top = 483
Width = 73
Height = 25
Anchors = [akLeft, akBottom]
Caption = 'Save log'
Enabled = False
TabOrder = 5
Visible = False
OnClick = btnSaveLogClick
end
object ProgressBar2: TProgressBar
Left = 8
Top = 451
Width = 481
Height = 25
Anchors = [akLeft, akRight, akBottom]
TabOrder = 7
end
object btnSnapshot: TButton
Left = 172
Top = 483
Width = 75
Height = 25
Anchors = [akLeft, akBottom]
Caption = 'Snapshot'
TabOrder = 8
Visible = False
OnClick = btnSnapshotClick
end
object SaveDialog: TSaveDialog
Left = 456
Top = 72
end
object ProgressTaskbar: TTaskbar
TaskBarButtons = <>
ProgressMaxValue = 100
TabProperties = []
Left = 432
Top = 424
end
end

1501
Forms/FormRender.pas Normal file
View File

File diff suppressed because it is too large Load Diff

58
Forms/Fullscreen.dfm Normal file
View File

@ -0,0 +1,58 @@
object FullscreenForm: TFullscreenForm
Left = 439
Top = 325
BorderStyle = bsNone
Caption = 'FullscreenForm'
ClientHeight = 131
ClientWidth = 186
Color = clBlack
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PopupMenu = FullscreenPopup
OnClose = FormClose
OnCreate = FormCreate
OnDblClick = ImageDblClick
OnDestroy = FormDestroy
OnKeyPress = FormKeyPress
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Image: TImage
Left = 0
Top = 0
Width = 186
Height = 131
PopupMenu = FullscreenPopup
OnDblClick = ImageDblClick
end
object Timelimiter: TTimer
Enabled = False
Interval = 2000
OnTimer = TimelimiterOnTimer
Left = 8
Top = 8
end
object FullscreenPopup: TPopupMenu
Left = 40
Top = 8
object RenderStop: TMenuItem
Caption = '&Stop Render'
OnClick = RenderStopClick
end
object RenderMore: TMenuItem
Caption = 'Render &More'
OnClick = RenderMoreClick
end
object N1: TMenuItem
Caption = '-'
end
object Exit1: TMenuItem
Caption = '&Close'
OnClick = ImageDblClick
end
end
end

344
Forms/Fullscreen.pas Normal file
View File

@ -0,0 +1,344 @@
{
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 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 Fullscreen;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ExtCtrls, ControlPoint, RenderThread, Translation;
type
TFullscreenForm = class(TForm)
Image: TImage;
Timelimiter: TTimer;
FullscreenPopup: TPopupMenu;
RenderStop: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
RenderMore: TMenuItem;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure ImageDblClick(Sender: TObject);
procedure TimelimiterOnTimer(Sender: TObject);
procedure RenderStopClick(Sender: TObject);
procedure RenderMoreClick(Sender: TObject);
private
Remainder, StartTime, t: double;
imgLeft, imgTop,
imgWidth, imgHeight: integer;
Closing: boolean;
Renderer: TRenderThread;
procedure showTaskbar;
procedure hideTaskbar;
procedure DrawFlame;
procedure OnProgress(prog: double);
procedure HandleThreadCompletion(var Message: TMessage);
message WM_THREAD_COMPLETE;
procedure HandleThreadTermination(var Message: TMessage);
message WM_THREAD_TERMINATE;
public
Calculate : boolean;
cp: TControlPoint;
Zoom: double;
center: array[0..1] of double;
ActiveForm: TForm;
end;
var
FullscreenForm: TFullscreenForm;
implementation
uses
Main, Math, Global,
Tracer;
{$R *.DFM}
procedure Trace1(const str: string);
begin
if TraceLevel >= 1 then
TraceForm.FullscreenTrace.Lines.Add('. ' + str);
end;
procedure Trace2(const str: string);
begin
if TraceLevel >= 2 then
TraceForm.FullscreenTrace.Lines.Add('. . ' + str);
end;
procedure TFullscreenForm.DrawFlame;
var
r: double;
begin
if (cp.width / cp.height) > (ClientWidth / ClientHeight) then
begin
imgWidth := ClientWidth;
r := cp.width / imgWidth;
imgHeight := round(cp.height / r);
imgLeft := 1;
imgTop := (ClientHeight - imgHeight) div 2;
end
else begin
imgHeight := ClientHeight;
r := cp.height / imgHeight;
imgWidth := round(cp.Width / r);
imgTop := 1;
imgLeft := (ClientWidth - ImgWidth) div 2;
end;
cp.AdjustScale(imgWidth, imgHeight);
// cp.Zoom := MainForm.Zoom;
// cp.center[0] := MainForm.center[0];
// cp.center[1] := MainForm.center[1];
cp.sample_density := defSampleDensity;
StartTime := Now;
t := now;
Remainder := 1;
if Assigned(Renderer) then begin // hmm...
Trace2('Killing previous RenderThread #' + inttostr(Renderer.ThreadID));
Renderer.Terminate;
Renderer.WaitFor;
while Renderer <> nil do
Application.ProcessMessages; // HandleThreadTermination kinda should be called here...(?)
end;
assert(not assigned(renderer), 'Render thread is still running!?');
Renderer := TRenderThread.Create; // Hmm... Why do we use RenderThread here, anyway? :-\
Renderer.TargetHandle := Handle;
Renderer.OnProgress := OnProgress;
Renderer.NrThreads := NrTreads; // AV: fixed Apo7X glitch here
if TraceLevel > 0 then Renderer.Output := TraceForm.FullscreenTrace.Lines;
Renderer.SetCP(cp);
Renderer.WaitForMore := true;
RenderStop.Enabled := true;
RenderMore.Enabled := false;
Renderer.Resume;
end;
procedure TFullscreenForm.HandleThreadCompletion(var Message: TMessage);
var
bm: TBitmap;
begin
Trace2(MsgComplete + IntToStr(message.LParam));
if not Assigned(Renderer) then begin
Trace2(MsgNotAssigned);
exit;
end;
if Renderer.ThreadID <> message.LParam then begin
Trace2(MsgAnotherRunning);
exit;
end;
if Assigned(Renderer) then
begin
bm := TBitmap.Create;
bm.assign(Renderer.GetImage);
Image.SetBounds(imgLeft, imgTop, imgWidth, imgHeight);
Image.Picture.Graphic := bm;
bm.Free;
end;
RenderStop.Enabled := false;
RenderMore.Enabled := true;
TimeLimiter.Enabled := false;
end;
procedure TFullscreenForm.HandleThreadTermination(var Message: TMessage);
var
bm: TBitmap;
begin
Trace2(MsgTerminated + IntToStr(message.LParam));
if not Assigned(Renderer) then begin
Trace2(MsgNotAssigned);
exit;
end;
if Renderer.ThreadID <> message.LParam then begin
Trace2(MsgAnotherRunning);
exit;
end;
RenderStop.Enabled := false;
RenderMore.Enabled := false;
TimeLimiter.Enabled := false;
end;
procedure TFullscreenForm.OnProgress(prog: double);
begin
prog := (Renderer.Slice + Prog) / Renderer.NrSlices;
Canvas.Lock;
try
if prog >= 1 then
begin
Canvas.Brush.Color := clBlack;
Canvas.FillRect(Rect(5, ClientHeight - 15, ClientWidth - 5, ClientHeight - 5));
end
else if prog >= 0 then begin
Canvas.Brush.Color := clTeal;
Canvas.FrameRect(Rect(5, ClientHeight - 15, ClientWidth - 5, ClientHeight - 5));
Canvas.Brush.Color := clTeal;
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));
end;
finally
Canvas.Unlock;
end;
//Application.ProcessMessages;
end;
procedure TFullscreenForm.hideTaskbar;
var wndHandle: THandle;
wndClass: array[0..50] of Char;
begin
StrPCopy(@wndClass[0], 'Shell_TrayWnd');
wndHandle := FindWindow(@wndClass[0], nil);
ShowWindow(wndHandle, SW_HIDE);
end;
procedure TFullscreenForm.showTaskbar;
var wndHandle: THandle;
wndClass: array[0..50] of Char;
begin
StrPCopy(@wndClass[0], 'Shell_TrayWnd');
wndHandle := FindWindow(@wndClass[0], nil);
ShowWindow(wndHandle, SW_RESTORE);
end;
procedure TFullscreenForm.FormShow(Sender: TObject);
begin
Trace1('--- Opening Fullscreen View ---');
if Image.Width < ClientWidth then
Image.Left := (ClientWidth - Image.Width) div 2;
if Image.Height < ClientHeight then
Image.Top := (ClientHeight - Image.Height) div 2;
Closing := false;
TimeLimiter.Enabled := false;
RenderStop.Enabled := false;
RenderMore.Enabled := false;
MainForm.mnuFullScreen.enabled := true;
HideTaskbar;
if calculate then
DrawFlame;
end;
procedure TFullscreenForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Closing := true;
if Assigned(Renderer) then begin
if Renderer.Suspended then begin
Renderer.WaitForMore := false;
Renderer.Resume;
end;
Trace2('Form closing: killing RenderThread #' + inttostr(Renderer.ThreadID));
Renderer.Terminate;
Renderer.WaitFor;
Trace2('Destroying RenderThread #' + IntToStr(Renderer.ThreadID));
Renderer.Free;
Renderer := nil;
end;
Trace1('--- Closing Fullscreen View ---');
Trace1('');
ShowTaskbar;
ActiveForm.SetFocus;
end;
procedure TFullscreenForm.FormCreate(Sender: TObject);
begin
Exit1.Caption := TextByKey('common-close');
RenderMore.Caption := TextByKey('fullscreen-popup-rendermore');
RenderStop.Caption := TextByKey('fullscreen-popup-stoprender');
cp := TControlPoint.Create;
end;
procedure TFullscreenForm.FormDestroy(Sender: TObject);
begin
if assigned(Renderer) then begin
Renderer.Terminate;
Renderer.WaitFor;
Renderer.Free;
end;
cp.Free;
end;
procedure TFullscreenForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key = ' ' then begin
if RenderStop.Enabled then RenderStop.Click
else if RenderMore.Enabled then RenderMore.Click;
end
else Close;
end;
procedure TFullscreenForm.ImageDblClick(Sender: TObject);
begin
Close;
end;
procedure TFullscreenForm.TimelimiterOnTimer(Sender: TObject);
begin
//if assigned(Renderer) then Renderer.Break;
TimeLimiter.Enabled := false;
end;
procedure TFullscreenForm.RenderStopClick(Sender: TObject);
begin
if assigned(Renderer) then Renderer.BreakRender;
end;
procedure TFullscreenForm.RenderMoreClick(Sender: TObject);
begin
if assigned(Renderer) and Renderer.Suspended then begin
Renderer.Resume;
RenderStop.Enabled := true;
RenderMore.Enabled := false;
end;
end;
end.

120
Forms/LoadTracker.dfm Normal file
View File

@ -0,0 +1,120 @@
object LoadForm: TLoadForm
Left = 443
Top = 274
ActiveControl = Button1
Anchors = [akLeft, akTop, akRight, akBottom]
Caption = 'Messages'
ClientHeight = 388
ClientWidth = 662
Color = clBtnFace
Constraints.MinHeight = 275
Constraints.MinWidth = 550
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
FormStyle = fsStayOnTop
Icon.Data = {
0000010001001010000001002000680400001600000028000000100000002000
0000010020000000000040040000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000006349
35146349352E927A69FF8C7563FF87705EFF6349352E7F6654FF7A624FFF755D
4AFF6349352E6E5441FF6A513EFF674E3AFF6349352E00000000000000006349
352EAE9888FFEFE3DDFFF2E7E1FFEDDFD7FF836B59FFB79B8BFFDBBDADFFD9B7
A6FF725946FFAE8B77FFD0A692FFCC9E87FF654B38FF6349352E00000000B7A2
93FFFBF8F7FFF9F4F2FFF7F0ECFFF4EBE6FFF1E5DFFF7F6754FF7A624FFF765D
4AFF735946FF6E5542FF6B523EFF674E3AFF654B38FF634935FF00000000B7A2
93FFFDFCFBFFFBF9F7FFFAF5F2FFF7EFEDFFF4EAE6FFF2E5DFFFDDDCD7FFDFD7
CEFFDECDC0FFDEC5B6FFDEBFACFFDBBAA6FFD8B5A3FF634935FF00000000B7A2
93FFFFFFFFFFB47F65FFB47F64FFEDDDD5FFB37E63FFF4EBE6FFF1E5DFFFEFDF
D7FFEBD9D1FFE8D3C9FFE5CDC1FFE1C6B9FFD6B3A1FF634A35FF00000000B9A4
95FFFFFFFFFFFFFFFFFFFDFCFCFFFCF9F7FFFAF4F2FFF6F0ECFFF4EBE5FFF2E5
DFFFEEDFD8FFEBD9D0FFE8D3C8FFE5CCC1FFDBBDADFF634A36FF00000000BDA7
98FFFFFFFFFF968E88FFEEDED7FF968E87FFEDDDD6FF968D86FF958C85FFF4EB
E6FFF2E5DFFFEFDFD8FFECD9D0FFE8D3C9FFE0C7BAFF634A35FF00000000C1AB
9CFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDFCFCFFFBF8F7FFFAF4F2FFF7F0
ECFFF4EAE6FFF1E5DFFFEEDFD7FFEBD9D0FFE6D1C6FF634A35FF00000000C5AF
A0FFFFFFFFFFB48065FFB48065FF968E88FFC2B0A3FF968E87FF968E86FFF9F4
F2FFF7EFECFFF4EBE6FFF2E5DFFFEFDFD8FFEADBD1FF634936FF00000000C8B2
A3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDFCFCFFFCF8
F7FFF9F5F2FFF7F0ECFFF4EBE6FFF1E5DFFFEEE2DAFF644A36FF00000000C9B4
A5FFFFFFFFFFFFFFFFFF66A365FF66A365FF66A365FFC0B4ADFF66A365FF66A3
65FF66A264FFFAF5F2FFF7F0ECFFF4EBE6FFEEE2DAFF644A36FF00000000C8B2
A3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFEFCFBFFFBF9F7FFFAF4F2FFF7F0EDFFF3EAE4FF644A36FF00000000C8B2
A3FFCAB4A5FFCBB5A6FFCAB4A5FFC9B3A4FFC7B2A3FFC6B0A1FFC3AE9FFFC1AC
9DFFBFAA9BFFBDA899FFBBA697FFB9A495FFB8A394FFB7A293FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FFFF
0000FFFF00000003000000010000000100000001000000010000000100000001
0000000100000001000000010000000100000001000000010000FFFF0000}
OldCreateOrder = False
OnCreate = FormCreate
OnResize = FormResize
DesignSize = (
662
388)
PixelsPerInch = 96
TextHeight = 13
object Bevel1: TBevel
Left = 7
Top = 7
Width = 533
Height = 308
Anchors = [akLeft, akTop, akRight, akBottom]
Style = bsRaised
end
object Button1: TButton
Left = 527
Top = 359
Width = 110
Height = 22
Anchors = [akRight, akBottom]
Caption = 'Close'
TabOrder = 0
OnClick = Button1Click
end
object CheckBox1: TCheckBox
Left = 8
Top = 360
Width = 384
Height = 24
Anchors = [akLeft, akRight, akBottom]
Caption = 'Automatically open this window when loading flame'
TabOrder = 1
WordWrap = True
OnClick = CheckBox1Click
end
object Button2: TButton
Left = 406
Top = 359
Width = 110
Height = 22
Anchors = [akRight, akBottom]
Caption = 'Clear'
TabOrder = 2
OnClick = Button2Click
end
object Output: TMemo
Left = 8
Top = 8
Width = 528
Height = 303
BevelOuter = bvRaised
BorderStyle = bsNone
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clBtnText
Font.Height = -12
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 3
end
end

105
Forms/LoadTracker.pas Normal file
View File

@ -0,0 +1,105 @@
{
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 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 LoadTracker;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Global, Settings, ExtCtrls, Translation;
type
TLoadForm = class(TForm)
Button1: TButton;
CheckBox1: TCheckBox;
Button2: TButton;
Bevel1: TBevel;
Output: TMemo;
procedure FormResize(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
LoadForm: TLoadForm;
implementation
{$R *.dfm}
procedure TLoadForm.Button1Click(Sender: TObject);
begin
Close;
end;
procedure TLoadForm.CheckBox1Click(Sender: TObject);
begin
AutoOpenLog := CheckBox1.Checked;
end;
procedure TLoadForm.FormCreate(Sender: TObject);
begin
Button2.Caption := TextByKey('common-clear');
Button1.Caption := TextByKey('common-close');
self.Caption := TextByKey('messages-title');
CheckBox1.Caption := TextByKey('messages-openautomatically');
CheckBox1.Checked := AutoOpenLog;
end;
procedure TLoadForm.Button2Click(Sender: TObject);
begin
Output.Text := '';
end;
procedure TLoadForm.FormResize(Sender: TObject);
begin
CheckBox1.Left := 2;
Checkbox1.Top := self.ClientHeight - Checkbox1.Height - 2;
CheckBox1.Width := self.ClientWidth - button1.Width - button2.Width - 8;
Button1.Left := self.ClientWidth - button1.Width - button2.Width - 4;
Button1.Top := self.ClientHeight - Checkbox1.Height - 2 + Checkbox1.Height div 2 - Button1.Height div 2;
Button2.Left := self.ClientWidth - button2.Width - 2;
Button2.Top := Button1.Top;
Bevel1.Left := 2;
Bevel1.Top := 2;
Bevel1.Width := self.ClientWidth - 4;
Bevel1.Height := self.ClientHeight - 6 - checkbox1.Height;
Output.Left := Bevel1.Left + 2;
Output.Top := Bevel1.Top + 2;
Output.Width := Bevel1.Width - 4;
Output.Height := Bevel1.Height -4;
end;
end.

4009
Forms/Main.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

8306
Forms/Main.pas Normal file
View File

File diff suppressed because it is too large Load Diff

383
Forms/Mutate.dfm Normal file
View File

@ -0,0 +1,383 @@
object MutateForm: TMutateForm
Left = 589
Top = 326
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'Mutation'
ClientHeight = 398
ClientWidth = 422
Color = clBtnFace
Constraints.MinHeight = 400
Constraints.MinWidth = 400
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poDefault
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
DesignSize = (
422
398)
PixelsPerInch = 96
TextHeight = 13
object GroupBox1: TGroupBox
Left = 8
Top = 8
Width = 409
Height = 273
Anchors = [akLeft, akTop, akRight, akBottom]
Caption = 'Directions'
TabOrder = 0
DesignSize = (
409
273)
object Panel10: TPanel
Left = 12
Top = 20
Width = 384
Height = 238
Anchors = [akLeft, akTop, akRight, akBottom]
BevelOuter = bvNone
TabOrder = 0
object Panel6: TPanel
Left = 112
Top = 168
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 0
object Image6: TImage
Tag = 6
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
object Panel7: TPanel
Left = 0
Top = 168
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 1
object Image7: TImage
Tag = 7
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
object Panel4: TPanel
Left = 224
Top = 84
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 2
object Image4: TImage
Tag = 4
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
object Panel0: TPanel
Left = 112
Top = 84
Width = 108
Height = 80
HelpContext = 2003
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 3
object Image0: TImage
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = Image0Click
end
end
object Panel8: TPanel
Left = 0
Top = 84
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 4
object Image8: TImage
Tag = 8
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
object Panel3: TPanel
Left = 224
Top = 0
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 5
object Image3: TImage
Tag = 3
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
object Panel2: TPanel
Left = 112
Top = 0
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 6
object Image2: TImage
Tag = 2
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 7
object Image1: TImage
Tag = 1
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
object Panel5: TPanel
Left = 224
Top = 168
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 8
object Image5: TImage
Tag = 5
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
end
end
object GroupBox2: TGroupBox
Left = 8
Top = 288
Width = 409
Height = 105
Anchors = [akLeft, akRight, akBottom]
TabOrder = 1
DesignSize = (
409
105)
object scrollTime: TScrollBar
Left = 120
Top = 20
Width = 202
Height = 20
Anchors = [akLeft, akTop, akRight]
LargeChange = 5
Max = 50
Min = 1
PageSize = 0
Position = 1
TabOrder = 0
OnChange = scrollTimeChange
end
object cmbTrend: TComboBox
Left = 119
Top = 48
Width = 282
Height = 21
Style = csDropDownList
Anchors = [akLeft, akTop, akRight]
DropDownCount = 16
TabOrder = 1
OnChange = cmbTrendChange
Items.Strings = (
'Random'
'Linear')
end
object chkSameNum: TCheckBox
Left = 12
Top = 78
Width = 389
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Same no. of transforms'
TabOrder = 2
OnClick = chkSameNumClick
end
object pnlSpeed: TPanel
Left = 12
Top = 20
Width = 101
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Speed'
ParentShowHint = False
ShowHint = True
TabOrder = 3
end
object txtTime: TEdit
Left = 328
Top = 20
Width = 73
Height = 21
Anchors = [akTop, akRight]
ReadOnly = True
TabOrder = 4
Text = '0.25'
end
object pnlTrend: TPanel
Left = 12
Top = 48
Width = 101
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Trend'
ParentShowHint = False
ShowHint = True
TabOrder = 5
end
end
object Timer: TTimer
Enabled = False
Interval = 100
OnTimer = TimerTimer
Left = 168
Top = 80
end
object QualityPopup: TPopupMenu
Images = MainForm.Buttons
Left = 144
Top = 40
object mnuLowQuality: TMenuItem
Caption = 'Low Quality'
RadioItem = True
OnClick = mnuLowQualityClick
end
object mnuMediumQuality: TMenuItem
Caption = 'Medium Quality'
Checked = True
RadioItem = True
OnClick = mnuMediumQualityClick
end
object mnuHighQuality: TMenuItem
Caption = 'High Quality'
RadioItem = True
OnClick = mnuHighQualityClick
end
object N3: TMenuItem
Caption = '-'
end
object mnuBack: TMenuItem
Caption = 'Previous'
Enabled = False
ImageIndex = 4
OnClick = mnuBackClick
end
object N1: TMenuItem
Caption = '-'
end
object mnuMaintainSym: TMenuItem
Caption = 'Maintain Symmetry'
Checked = True
OnClick = mnuMaintainSymClick
end
object N2: TMenuItem
Caption = '-'
end
object mnuResetLocation: TMenuItem
Caption = 'Reset Location'
Checked = True
OnClick = mnuResetLocationClick
end
end
end

634
Forms/Mutate.pas Normal file
View File

@ -0,0 +1,634 @@
{
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 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 Mutate;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ControlPoint, ComCtrls, Menus, Buttons, Cmap,
RenderingInterface, Translation, Curves;
type
TMutateForm = class(TForm)
GroupBox1: TGroupBox;
Timer: TTimer;
GroupBox2: TGroupBox;
scrollTime: TScrollBar;
cmbTrend: TComboBox;
chkSameNum: TCheckBox;
QualityPopup: TPopupMenu;
mnuLowQuality: TMenuItem;
mnuMediumQuality: TMenuItem;
mnuHighQuality: TMenuItem;
N3: TMenuItem;
mnuResetLocation: TMenuItem;
mnuBack: TMenuItem;
N1: TMenuItem;
mnuMaintainSym: TMenuItem;
N2: TMenuItem;
Panel10: TPanel;
Panel6: TPanel;
Image6: TImage;
Panel7: TPanel;
Image7: TImage;
Panel4: TPanel;
Image4: TImage;
Panel0: TPanel;
Image0: TImage;
Panel8: TPanel;
Image8: TImage;
Panel3: TPanel;
Image3: TImage;
Panel2: TPanel;
Image2: TImage;
Panel1: TPanel;
Image1: TImage;
Panel5: TPanel;
Image5: TImage;
pnlSpeed: TPanel;
txtTime: TEdit;
pnlTrend: TPanel;
//procedure Panel10Resize(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Image0Click(Sender: TObject);
procedure MutantClick(Sender: TObject);
procedure sbTimeChange(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure scrollTimeChange(Sender: TObject);
procedure cmbTrendChange(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure mnuHighQualityClick(Sender: TObject);
procedure mnuLowQualityClick(Sender: TObject);
procedure mnuMediumQualityClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure chkSameNumClick(Sender: TObject);
procedure mnuResetLocationClick(Sender: TObject);
procedure mnuBackClick(Sender: TObject);
procedure mnuMaintainSymClick(Sender: TObject);
private
name: string;
bm: TBitmap;
PreviewDensity: double;
Updating: boolean;
cps: array[0..8] of TControlPoint;
Mutants: array[0..8] of TControlPoint;
Render: TRenderer;
Time: double;
bstop: boolean;
brightness, gamma, vibrancy, contrast, gamma_threshold: double;
width, height: integer; // AV: to keep original flame size
seed, InitSeed: integer;
procedure RandomSet;
procedure ShowMain;
procedure ShowMutants;
procedure Interpolate;
public
Zoom: Double;
Center: array[0..1] of double;
cmap: TColorMap;
procedure UpdateDisplay;
procedure UpdateFlame;
end;
var
MutateForm: TMutateForm;
implementation
uses
Main, Global, Registry, Editor, Adjust, XFormMan;
{$R *.DFM}
procedure TMutateForm.UpdateFlame;
begin
MainForm.StopThread;
MainForm.UpdateUndo;
MainCp.Copy(cps[0]);
Transforms := MainCp.TrianglesFromCP(MainTriangles);
MainCp.cmap := cmap;
MainCp.name := name; // this is kinda funny
MainCp.AdjustScale(width, height); // AV: restore normal size
if mnuResetLocation.checked then
begin
//MainForm.Mainzoom := cps[0].zoom;
MainForm.Center[0] := cps[0].Center[0];
MainForm.Center[1] := cps[0].Center[1];
end;
MainForm.RedrawTimer.enabled := true;
if EditForm.Visible then EditForm.UpdateDisplay;
// if AdjustForm.Visible then AdjustForm.UpdateDisplay;
end;
procedure TMutateForm.UpdateDisplay;
begin
cps[0].copy(MainCp);
cps[0].AdjustScale(Image0.Width, Image0.Height);
cps[0].cmap := MainCp.cmap;
cmap := MainCp.cmap;
name := Maincp.name;
zoom := MainCp.zoom;
width := MainCp.Width; // AV
height := MainCp.Height; // AV
center[0] := MainCp.center[0];
center[1] := MainCp.center[1];
vibrancy := cps[0].vibrancy;
gamma := cps[0].gamma;
gamma_threshold := cps[0].gamma_threshold; // AV
brightness := cps[0].brightness;
contrast := cps[0].contrast; // AV
Interpolate;
ShowMain;
Application.ProcessMessages;
ShowMutants;
end;
procedure TMutateForm.ShowMain;
begin
cps[0].Width := Image0.Width;
cps[0].Height := Image0.Height;
cps[0].spatial_oversample := defOversample;
cps[0].spatial_filter_radius := defFilterRadius;
cps[0].sample_density := PreviewDensity;
cps[0].brightness := brightness;
cps[0].contrast := contrast; // AV
cps[0].gamma := gamma;
cps[0].gamma_threshold := gamma_threshold; // AV
cps[0].vibrancy := vibrancy;
cps[0].sample_density := PreviewDensity;
cps[0].cmap := cmap;
cps[0].background := MainCp.background;
if mnuResetLocation.checked then begin
cps[0].CalcBoundbox;
zoom := 0;
center[0] := cps[0].center[0];
center[1] := cps[0].Center[1];
end;
cps[0].zoom := zoom;
cps[0].center[0] := center[0];
cps[0].center[1] := center[1];
Render.SetCP(cps[0]);
Render.Render;
BM.Assign(Render.GetImage);
Image0.Picture.Graphic := bm;
end;
procedure TMutateForm.ShowMutants;
var
i: integer;
begin
if Visible = false then exit;
Updating := true;
for i := 1 to 8 do
begin
mutants[i].Width := Image1.Width;
mutants[i].Height := Image1.Height;
mutants[i].spatial_filter_radius := defFilterRadius;
mutants[i].spatial_oversample := defOversample;
mutants[i].sample_density := PreviewDensity;
mutants[i].brightness := brightness;
mutants[i].contrast := contrast; // AV
mutants[i].gamma := gamma;
mutants[i].vibrancy := vibrancy;
mutants[i].gamma_threshold := gamma_threshold; // AV
if mnuResetLocation.checked then
begin
mutants[i].CalcBoundbox;
mutants[i].zoom := 0;
end
else begin
mutants[i].zoom := zoom;
mutants[i].center[0] := center[0];
mutants[i].center[1] := center[1];
end;
Render.SetCP(mutants[i]);
Render.Render;
BM.Assign(Render.GetImage);
case i of
1: begin
Image1.Picture.Graphic := bm;
Image1.Refresh;
end;
2: begin
Image2.Picture.Graphic := bm;
Image2.Refresh;
end;
3: begin
Image3.Picture.Graphic := bm;
Image3.Refresh;
end;
4: begin
Image4.Picture.Graphic := bm;
Image4.Refresh;
end;
5: begin
Image5.Picture.Graphic := bm;
Image5.Refresh;
end;
6: begin
Image6.Picture.Graphic := bm;
Image6.Refresh;
end;
7: begin
Image7.Picture.Graphic := bm;
Image7.Refresh;
end;
8: begin
Image8.Picture.Graphic := bm;
Image8.Refresh;
end;
end;
Updating := false;
end;
end;
procedure TMutateForm.Interpolate;
var i, j, k: Integer;
begin
if MainCp = nil then Exit;
for i := 1 to 8 do
begin
if bstop then exit;
cps[0].Time := 0;
cps[i].Time := 1;
(* -X- something is not right here...
Mutants[i] may be destroyed already
Investigate? *)
Mutants[i].clear;
Mutants[i].InterpolateX(cps[0], cps[i], Time / 100);
Mutants[i].cmapindex := cps[0].cmapindex;
Mutants[i].cmap := cps[0].cmap;
Mutants[i].background := MainCp.background;
if mnuMaintainSym.Checked then // maintain symmetry
for j := 0 to transforms - 1 do
if cps[0].xform[j].Symmetry = 1 then
mutants[i].xform[j].Assign(cps[0].xform[j]);
end;
end;
procedure TMutateForm.RandomSet;
var i, j, k: Integer;
begin
RandSeed := seed;
for i := 1 to 8 do
begin
cps[i].clear;
if chkSameNum.checked then
cps[i].RandomCP(transforms, transforms, false)
else
cps[i].RandomCP(mutantMinTransforms, mutantMaxTransforms, false);
if cmbTrend.ItemIndex = NRVAR then // AV
cps[i].SetVariation(vRandom)
else
for j := 0 to cps[i].NumXforms-1 do
begin
for k := 0 to NrVar-1 do // AV: simplified the calculations
cps[i].xform[j].SetVariation(k, 0);
cps[i].xform[j].SetVariation(cmbTrend.ItemIndex, 1);
end;
if cps[0].HasFinalXForm = false then
begin
cps[i].xform[cps[i].NumXForms].Clear;
cps[i].xform[cps[i].NumXForms].symmetry := 1;
end;
end;
Interpolate;
end;
procedure TMutateForm.FormShow(Sender: TObject);
var
Registry: TRegistry;
begin
{ Read position from registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('Software\' + APP_NAME + '\Forms\Mutate', False) then
begin
if Registry.ValueExists('Left') then
MutateForm.Left := Registry.ReadInteger('Left');
if Registry.ValueExists('Top') then
MutateForm.Top := Registry.ReadInteger('Top');
end;
Registry.CloseKey;
finally
Registry.Free;
end;
{
if (cps[0].xform[0].density <> 0) and Assigned(MainCp) then
begin // hmm...!?
//Interpolate; // AV: this method is already called inside RandomSet
ShowMain;
ShowMutants;
end;
}
end;
procedure TMutateForm.FormCreate(Sender: TObject);
var
i: integer;
begin
self.Caption := TextByKey('mutation-title');
GroupBox1.Caption := TextByKey('mutation-directions');
pnlSpeed.Caption := TextByKey('mutation-speed');
pnlTrend.Caption := TextByKey('mutation-trend');
chkSameNum.Caption := TextByKey('mutation-keepnumberoftransforms');
mnuLowQuality.Caption := TextByKey('common-lowquality');
mnuMediumQuality.Caption := TextByKey('common-mediumquality');
mnuHighQuality.Caption := TextByKey('common-highquality');
mnuResetLocation.Caption := TextByKey('common-resetlocation');
mnuMaintainSym.Caption := TextByKey('mutation-maintainsymmetry');
mnuBack.Caption := TextByKey('mutation-previous');
cmbTrend.Items.clear;
for i:= 0 to NRVAR -1 do // AV
cmbTrend.Items.Add(varnames(i));
cmbTrend.Items.Add(TextByKey('mutation-randomtrend'));
bm := TBitMap.Create;
case MutatePrevQual of
0: begin
mnuLowQuality.Checked := true;
PreviewDensity := prevLowQuality;
end;
1: begin
mnuMediumQuality.Checked := true;
PreviewDensity := prevMediumQuality;
end;
2: begin
mnuHighQuality.Checked := true;
PreviewDensity := prevHighQuality;
end;
end;
Render := TRenderer.Create;
for i := 0 to 8 do
begin
cps[i] := TControlPoint.Create;
Mutants[i] := TControlPoint.Create;
end;
Time := 35;
scrollTime.Position := 25;
txtTime.Text := '0.25'; // AV
cmbTrend.ItemIndex := NRVAR; // AV
InitSeed := random(1234567890);
seed := InitSeed;
RandomSet;
end;
procedure TMutateForm.FormDestroy(Sender: TObject);
var
i: integer;
begin
Render.Stop;
Render.Free;
for i := 0 to 8 do
begin
cps[i].Free;
Mutants[i].Free;
end;
bm.free;
end;
procedure TMutateForm.Image0Click(Sender: TObject);
begin
Render.Stop;
mnuBack.Enabled := true;
inc(seed);
RandomSet;
ShowMutants;
end;
procedure TMutateForm.MutantClick(Sender: TObject);
var
i: integer;
cpt: TControlPoint;
begin
cpt := TControlPoint.Create;
cpt.Copy(cps[0], false, transforms); // AV
bstop := true;
// AV: optimized fast version without checking indices
i := TImage(Sender).Tag;
cps[0].Time := 0;
cps[i].Time := 1;
cps[0].InterpolateX(cps[0], cps[i], Time / 100);
if mnuMaintainSym.Checked then // maintain symmetry
begin
for i := 0 to transforms - 1 do
begin
if cpt.xform[i].Symmetry = 1 then
cps[0].xform[i].Assign(cpt.xform[i]);
end;
end;
bstop := false;
ShowMain;
Interpolate;
ShowMutants;
UpdateFlame;
cpt.free;
end;
procedure TMutateForm.sbTimeChange(Sender: TObject);
begin
bstop := true;
Render.Stop;
Time := scrollTime.Position;
bstop := false;
Interpolate;
ShowMutants;
end;
procedure TMutateForm.TimerTimer(Sender: TObject);
begin
Timer.Enabled := false;
if (Time <> scrollTime.Position) and (not updating) then
begin
Time := scrollTime.Position;
Interpolate;
ShowMutants;
end;
end;
procedure TMutateForm.scrollTimeChange(Sender: TObject);
begin
Timer.Enabled := true;
txtTime.Text := FloatToStr(scrollTime.Position / 100);
end;
procedure TMutateForm.cmbTrendChange(Sender: TObject);
var
i, j, k: integer;
begin
for i := 1 to 8 do
if cmbTrend.ItemIndex = NRVAR then
cps[i].SetVariation(VRandom) // AV
else
for j := 0 to cps[i].NumXforms-1 do
begin // AV
for k := 0 to NrVar-1 do
cps[i].xform[j].SetVariation(k, 0);
cps[i].xform[j].SetVariation(cmbTrend.ItemIndex, 1);
end;
Interpolate;
ShowMutants;
end;
procedure TMutateForm.btnCancelClick(Sender: TObject);
begin
ModalResult := mrCancel;
end;
procedure TMutateForm.mnuHighQualityClick(Sender: TObject);
begin
mnuHighQuality.Checked := True;
PreviewDensity := prevHighQuality;
MutatePrevQual := 2;
ShowMain;
ShowMutants;
end;
procedure TMutateForm.mnuLowQualityClick(Sender: TObject);
begin
mnuLowQuality.Checked := True;
PreviewDensity := prevLowQuality;
MutatePrevQual := 0;
ShowMain;
ShowMutants;
end;
procedure TMutateForm.mnuMediumQualityClick(Sender: TObject);
begin
mnuMediumQuality.Checked := True;
PreviewDensity := prevMediumQuality;
MutatePrevQual := 1;
ShowMain;
ShowMutants;
end;
procedure TMutateForm.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\Mutate', True) then
begin
Registry.WriteInteger('Top', MutateForm.Top);
Registry.WriteInteger('Left', MutateForm.Left);
end;
finally
Registry.Free;
end;
end;
procedure TMutateForm.chkSameNumClick(Sender: TObject);
begin
RandomSet;
// Interpolate; // AV: this method is already called inside RandomSet
ShowMutants;
end;
procedure TMutateForm.mnuResetLocationClick(Sender: TObject);
begin
mnuResetLocation.Checked := not mnuResetLocation.Checked;
if not mnuResetLocation.checked then
begin
cps[0].width := MainCp.width;
cps[0].height := MainCp.height;
cps[0].pixels_per_unit := MainCp.pixels_per_unit;
cps[0].AdjustScale(Image0.width, Image0.Height);
cps[0].zoom := MainCp.zoom;
cps[0].center[0] := MainCp.center[0];
cps[0].center[1] := MainCp.center[1];
zoom := cps[0].zoom;
center[0] := cps[0].center[0];
center[1] := cps[0].center[1];
end;
ShowMain;
ShowMutants;
end;
procedure TMutateForm.mnuBackClick(Sender: TObject);
begin
Render.Stop;
if seed > InitSeed then
dec(seed);
if seed = InitSeed then mnuBack.enabled := false;
RandomSet;
ShowMutants;
end;
procedure TMutateForm.mnuMaintainSymClick(Sender: TObject);
begin
mnuMaintainSym.Checked := not mnuMaintainSym.Checked;
Interpolate;
ShowMutants;
end;
(*
procedure TMutateForm.Panel10Resize(Sender: TObject);
const gap:integer = 4 ;
var
w, h : integer;
begin
w := (Panel10.Width - 2*gap) div 3;
h := (Panel10.Height - 2*gap) div 3;
Panel0.Width := w; Panel1.Width := w; Panel2.Width := w;
Panel3.Width := w; Panel4.Width := w; Panel5.Width := w;
Panel6.Width := w; Panel7.Width := w; Panel8.Width := w;
Panel0.Height := h; Panel1.Height := h; Panel2.Height := h;
Panel3.Height := h; Panel4.Height := h; Panel5.Height := h;
Panel6.Height := h; Panel7.Height := h; Panel8.Height := h;
Panel2.Left := w + gap; Panel0.Left := w + gap; Panel6.Left := w + gap;
Panel3.Left := 2*(w + gap); Panel4.Left := 2*(w + gap); Panel5.Left := 2*(w + gap);
Panel8.Top := h + gap; Panel0.Top := h + gap; Panel4.Top := h + gap;
Panel7.Top := 2*(h + gap); Panel6.Top := 2*(h + gap); Panel5.Top := 2*(h + gap);
end;
*)
end.

4308
Forms/Options.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

1796
Forms/Options.pas Normal file
View File

File diff suppressed because it is too large Load Diff

66
Forms/Preview.dfm Normal file
View File

@ -0,0 +1,66 @@
object PreviewForm: TPreviewForm
Left = 541
Top = 357
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSizeToolWin
Caption = 'Preview'
ClientHeight = 147
ClientWidth = 196
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PopupMenu = PreviewPopup
Scaled = False
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyPress = FormKeyPress
PixelsPerInch = 96
TextHeight = 13
object BackPanel: TPanel
Left = 0
Top = 0
Width = 196
Height = 147
Align = alClient
BevelInner = bvLowered
BevelOuter = bvLowered
Color = clBlack
TabOrder = 0
object Image: TImage
Left = 2
Top = 2
Width = 192
Height = 143
Align = alClient
AutoSize = True
Stretch = True
ExplicitWidth = 200
ExplicitHeight = 153
end
end
object PreviewPopup: TPopupMenu
Left = 72
Top = 40
object MakeScreenShot: TMenuItem
Caption = 'Make a screenshot of the window'
ShortCut = 16471
OnClick = MakeScreenShotClick
end
object KeepFrame: TMenuItem
AutoCheck = True
Caption = 'Keep the window frame'
end
object N1: TMenuItem
Caption = '-'
end
object PreviewPause: TMenuItem
Caption = 'Pause the preview'
OnClick = PreviewPauseClick
end
end
end

151
Forms/Preview.pas Normal file
View File

@ -0,0 +1,151 @@
{
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 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 Preview;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ControlPoint, RenderingInterface, Translation, Vcl.Menus,
Vcl.Imaging.PNGimage;
type
TPreviewForm = class(TForm)
BackPanel: TPanel;
Image: TImage;
PreviewPopup: TPopupMenu;
MakeScreenShot: TMenuItem;
KeepFrame: TMenuItem;
N1: TMenuItem;
PreviewPause: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure MakeScreenShotClick(Sender: TObject); // AV
procedure PreviewPauseClick(Sender: TObject); // AV
private
public
cp: TControlPoint;
Render: TRenderer;
procedure DrawFlame;
end;
var
PreviewForm: TPreviewForm;
implementation
uses Main, Global, ScriptForm;
{$R *.DFM}
procedure TPreviewForm.DrawFlame;
begin
Render.Stop;
// AV: this is already done by cp.AdjustScale
{
cp.width := Image.width;
cp.Height := Image.Height;
}
Render.SetCP(cp);
Render.Render;
Image.Picture.Bitmap.Assign(Render.GetImage);
Application.ProcessMessages;
end;
procedure TPreviewForm.FormCreate(Sender: TObject);
begin
self.Caption := TextByKey('preview-title');
MakeScreenShot.Caption := TextByKey('main-menu-screenshot');
KeepFrame.Caption := TextByKey('preview-keepframe');
cp := TControlPoint.Create;
Render := TRenderer.Create;
PreviewPause.Caption := TextByKey('preview-pause');
end;
procedure TPreviewForm.FormDestroy(Sender: TObject);
begin
Render.Free;
cp.Free;
end;
procedure TPreviewForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
if ScriptEditor.btnPause.Down then ScriptEditor.btnPause.Click; // AV
ScriptEditor.Stopped := True;
end;
procedure TPreviewForm.MakeScreenShotClick(Sender: TObject);
var
s: string;
pic: TPNGObject;
begin
if not DirectoryExists(ScreenShotPath) then
begin
CreateDir(AppPath + 'ScreenShots\');
ScreenShotPath := AppPath + 'ScreenShots\';
end;
s := ScreenShotPath + 'Apophysis Animation Preview' + FormatDateTime(' (MM-dd-yyyy hh-mm-ss)', Now) + '.bmp';
try
if KeepFrame.Checked then
GetFormScreenShot(s)
else
begin
try
pic := TPNGObject.Create;
try
pic.Assign(Image.Picture.Bitmap);
if cp.name = '' then cp.name := RemoveExt(s);
pic.AddtEXt('ApoFlame', AnsiString(Trim(MainForm.RetrieveXML(cp))));
s := ChangeFileExt(s, '.png');
pic.SaveToFile(s);
finally
pic.Free;
end;
except
Image.Picture.Bitmap.SaveToFile(s);
end;
end;
Application.MessageBox(PChar(Format(TextByKey('common-screenshot-saved'),
[ExtractFileName(s), ExtractFilePath(s)])), PChar('Apophysis AV'), MB_ICONINFORMATION);
except
Application.MessageBox(PChar(TextByKey('common-screenshot-error')), PChar('Apophysis AV'), MB_ICONERROR);
end;
end;
procedure TPreviewForm.PreviewPauseClick(Sender: TObject);
begin
ScriptEditor.btnPause.Click;
end;
procedure TPreviewForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ScriptEditor.btnPause.Down then ScriptEditor.btnPause.Click; // AV
ScriptEditor.Stopped := True;
end;
end.

153
Forms/Save.dfm Normal file
View File

@ -0,0 +1,153 @@
object SaveForm: TSaveForm
Left = 434
Top = 432
BorderStyle = bsDialog
Caption = 'Save Parameters'
ClientHeight = 153
ClientWidth = 517
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -14
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poOwnerFormCenter
OnCreate = FormCreate
OnShow = FormShow
DesignSize = (
517
153)
PixelsPerInch = 120
TextHeight = 16
object btnDefGradient: TSpeedButton
Left = 480
Top = 9
Width = 30
Height = 29
Hint = 'Browse...'
Anchors = [akTop, akRight]
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Arial'
Font.Style = [fsBold]
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF75848F66808F
607987576E7B4E626F4456613948522E3A43252E351B222914191E0E12160E13
18FF00FFFF00FFFF00FF77879289A1AB6AB2D4008FCD008FCD008FCD048CC708
88BE0F82B4157CA91B779F1F7296224B5C87A2ABFF00FFFF00FF7A8A957EBED3
8AA4AE7EDCFF5FCFFF55CBFF4CC4FA41BCF537B3F02EAAEB24A0E5138CD42367
805E696DFF00FFFF00FF7D8E9879D2EC8BA4AD89C2CE71D8FF65D3FF5CCEFF51
C9FE49C1FA3FB9F534B0EE29A8E91085CD224B5B98B2BAFF00FF80919C81D7EF
7DC5E08CA6B080DDFE68D3FF67D4FF62D1FF58CDFF4EC7FC46BEF73BB6F231AC
EC2569817A95A1FF00FF83959F89DCF18CE2FF8DA8B18CBAC774D8FF67D4FF67
D4FF67D4FF5FD0FF54CDFF4BC5FC41BBF72EA2DB51677498B2BA869AA392E1F2
98E8FD80C4DE8EA7B081DEFD84E0FF84E0FF84E0FF84E0FF81DFFF7BDDFF74D8
FF6BD6FF56A9D18F9BA4889CA59AE6F39FEBFB98E8FE8BACB98BACB98AAAB788
A6B386A3AF839FAA819AA67F95A17C919D7A8E99798B957788938BA0A8A0EAF6
A6EEF99FEBFB98E8FE7ADAFF67D4FF67D4FF67D4FF67D4FF67D4FF67D4FF7788
93FF00FFFF00FFFF00FF8EA2ABA7EEF6ABF0F7A6EEF99FEBFB98E8FD71D4FB89
9EA78699A382949F7E909A7A8C97778893FF00FFFF00FFFF00FF8FA4ACA0D2DA
ABF0F7ABF0F7A6EEF99FEBFB8DA1AAB5CBD0FF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFBDCED48FA4AC8FA4AC8FA4AC8FA4AC8FA4ACB5CBD0FF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnDefGradientClick
end
object btnSave: TButton
Left = 310
Top = 116
Width = 93
Height = 30
Anchors = [akRight, akBottom]
Caption = '&Save'
Default = True
TabOrder = 2
OnClick = btnSaveClick
end
object btnCancel: TButton
Left = 410
Top = 116
Width = 92
Height = 30
Anchors = [akRight, akBottom]
Caption = 'Cancel'
TabOrder = 3
OnClick = btnCancelClick
end
object pnlTarget: TPanel
Left = 10
Top = 10
Width = 124
Height = 26
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Destination'
ParentShowHint = False
ShowHint = True
TabOrder = 4
OnDblClick = pnlTargetDblClick
end
object pnlName: TPanel
Left = 10
Top = 39
Width = 124
Height = 26
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Name'
ParentShowHint = False
ShowHint = True
TabOrder = 5
end
object txtFilename: TEdit
Left = 128
Top = 10
Width = 353
Height = 24
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
Text = 'txtFilename'
end
object txtTitle: TEdit
Left = 128
Top = 39
Width = 383
Height = 24
Anchors = [akLeft, akTop, akRight]
TabOrder = 1
Text = 'txtTitle'
end
object optUseOldFormat: TRadioButton
Left = 10
Top = 79
Width = 304
Height = 21
Anchors = [akLeft, akTop, akRight]
Caption = 'Use classic flame format'
Checked = True
TabOrder = 6
TabStop = True
end
object optUseNewFormat: TRadioButton
Left = 10
Top = 101
Width = 304
Height = 21
Anchors = [akLeft, akTop, akRight]
Caption = 'Use new flame format'
Enabled = False
TabOrder = 7
end
end

243
Forms/Save.pas Normal file
View File

@ -0,0 +1,243 @@
{
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 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 Save;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls, Translation;
type
ESaveType = (stSaveParameters, stSaveAllParameters, stSaveGradient, stExportUPR, stSaveTemplate);
TSaveForm = class(TForm)
txtFilename: TEdit;
txtTitle: TEdit;
btnSave: TButton;
btnCancel: TButton;
btnDefGradient: TSpeedButton;
pnlTarget: TPanel;
pnlName: TPanel;
optUseOldFormat: TRadioButton;
optUseNewFormat: TRadioButton;
procedure FormCreate(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnDefGradientClick(Sender: TObject);
procedure pnlTargetDblClick(Sender: TObject);
private
public
Title: string;
Filename: string;
SaveType : ESaveType;
end;
var
SaveForm: TSaveForm;
implementation
uses Main, Global, cmap;
{$R *.DFM}
function EntryExists(En, Fl: string): boolean;
{ Searches for existing identifier in parameter files }
var
FStrings: TStringList;
i: integer;
begin
Result := False;
if FileExists(Fl) then
begin
FStrings := TStringList.Create;
try
FStrings.LoadFromFile(Fl);
for i := 0 to FStrings.Count - 1 do
if Pos(LowerCase(En) + ' {', Lowercase(FStrings[i])) = 1 then
Result := True;
finally
FStrings.Free;
end
end
else
Result := False;
end;
function SaveTypeTextKey(st : ESaveType) : string;
begin
case st of
stSaveParameters: Result := 'save-type-parameters';
stSaveAllParameters: Result := 'save-type-allparameters';
stSaveGradient: Result := 'save-type-gradient';
stExportUPR: Result := 'save-type-exportupr';
stSaveTemplate: Result := 'save-type-template';
end;
end;
function SaveDefaultExt(st : ESaveType) : string;
begin
case st of
stSaveParameters: Result := 'flame';
stSaveAllParameters: Result := 'flame';
stSaveGradient: Result := 'gradient';
stExportUPR: Result := 'upr';
stSaveTemplate: Result := 'template';
end;
end;
function SaveFilter(st : ESaveType): string;
begin
case st of
stSaveParameters: Result := Format('%s|*.flame;*.xml|%s|*.*',
[TextByKey('common-filter-flamefiles'), TextByKey('common-filter-allfiles')]);
stSaveAllParameters: Result := Format('%s|*.flame;*.xml|%s|*.*',
[TextByKey('common-filter-flamefiles'), TextByKey('common-filter-allfiles')]);
stSaveGradient: Result := Format('%s|*.gradient;*.ugr|%s|*.*',
[TextByKey('common-filter-gradientfiles'), TextByKey('common-filter-allfiles')]);
stExportUPR: Result := Format('%s|*.upr|%s|*.*',
[TextByKey('common-filter-uprfiles'), TextByKey('common-filter-allfiles')]);
stSaveTemplate: Result := Format('%s|*.template;*.flame',
[TextByKey('common-filter-templatefiles')]);
end;
end;
procedure TSaveForm.btnSaveClick(Sender: TObject);
var
t, f: string;
check, onestr: boolean;
begin
t := Trim(txtTitle.Text);
f := Trim(txtFilename.Text);
if ((t = '') and txtTitle.Enabled) then
begin
Application.MessageBox(PChar(TextByKey('save-status-notitle')), 'Apophysis', 48);
Exit;
end;
if f = '' then
begin
Application.MessageBox(PChar(TextByKey('save-status-invalidfilename')), 'Apophysis', 48);
Exit;
end;
if ExtractFileExt(f) = '' then
begin
Application.MessageBox(PChar(TextByKey('save-status-invalidfilename')), 'Apophysis', 48);
Exit;
end;
if (SaveType = stSaveParameters) or (SaveType = stSaveTemplate) then // AV
begin
check := XMLEntryExists(t, f);
onestr := false;
end
else if SaveType = stSaveAllParameters then
begin
onestr := true;
check := FileExists(f);
end
else
begin
onestr := false;
t := CleanIdentifier(t);
check := EntryExists(t, f);
end;
if check then begin if onestr then begin
if Application.MessageBox(PChar(Format(TextByKey('save-status-alreadyexists2'), [f])),
'Apophysis', 52) = ID_NO then exit;
end else begin
if Application.MessageBox(PChar(Format(TextByKey('save-status-alreadyexists'), [t, f])),
'Apophysis', 52) = ID_NO then exit;
end end;
if (t = '*') then t := '';
Title := t;
Filename := f;
ModalResult := mrOK;
end;
procedure TSaveForm.btnCancelClick(Sender: TObject);
begin
ModalResult := mrCancel;
end;
procedure TSaveForm.FormShow(Sender: TObject);
begin
txtFilename.Text := Filename;
txtTitle.Text := Title;
//btnSave.SetFocus;
self.Caption := TextByKey(SaveTypeTextKey(SaveType));
{if (SaveType = stSaveParameters) or (SaveType = stSaveAllParameters) then
self.Height := 160
else self.Height := 120; }
if (SaveType = stSaveGradient) then // AV
pnlName.Caption := TextByKey('save-namepal')
else pnlName.Caption := TextByKey('save-name');
if (SaveType = stSaveAllParameters) then txtTitle.Text := '';
txtTitle.Enabled := (SaveType <> stSaveAllParameters);
if (not txtTitle.Enabled) then pnlName.Font.Color := clGrayText
else pnlName.Font.Color := clWindowText;
optUseOldFormat.Visible := (SaveType = stSaveParameters) or (SaveType = stSaveAllParameters);
optUseNewFormat.Visible := (SaveType = stSaveParameters) or (SaveType = stSaveAllParameters);
txtFileName.ReadOnly := (SaveType = stSaveTemplate); // AV
end;
procedure TSaveForm.pnlTargetDblClick(Sender: TObject);
begin
if (SaveType = stSaveParameters) then // AV
txtFileName.Text := OpenFile;
end;
procedure TSaveForm.btnDefGradientClick(Sender: TObject);
var
fn:string;
begin
if OpenSaveFileDialog(self, SaveDefaultExt(SaveType), SaveFilter(SaveType),
ExtractFilePath(txtFilename.Text), TextByKey('common-browse'), fn, false,
false, false, false) then
if (SaveType <> stSaveTemplate) then
txtFileName.Text := fn
else
txtFileName.Text := AppPath + 'Templates\' + ExtractFileName(fn); // AV
end;
procedure TSaveForm.FormCreate(Sender: TObject);
begin
btnCancel.Caption := TextByKey('common-cancel');
btnSave.Caption := TextByKey('common-ok');
btnDefGradient.Hint := TextByKey('common-browse');
pnlTarget.Caption := TextByKey('common-destination');
//pnlName.Caption := TextByKey('save-name');
optUseOldFormat.Caption := TextByKey('save-oldformat');
optUseNewFormat.Caption := TextByKey('save-newformat');
end;
end.

63
Forms/SavePreset.dfm Normal file
View File

@ -0,0 +1,63 @@
object SavePresetForm: TSavePresetForm
Left = 295
Top = 331
BorderStyle = bsDialog
Caption = 'Save Preset'
ClientHeight = 66
ClientWidth = 349
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
DesignSize = (
349
66)
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 190
Top = 37
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 1
OnClick = Button1Click
end
object Button2: TButton
Left = 270
Top = 37
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'Cancel'
ModalResult = 2
TabOrder = 2
end
object pnlName: TPanel
Left = 8
Top = 8
Width = 101
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Name'
ParentShowHint = False
ShowHint = True
TabOrder = 3
end
object txtPresetName: TEdit
Left = 104
Top = 8
Width = 239
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
end
end

70
Forms/SavePreset.pas Normal file
View File

@ -0,0 +1,70 @@
{
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 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 SavePreset;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Translation;
type
TSavePresetForm = class(TForm)
txtPresetName: TEdit;
Button1: TButton;
Button2: TButton;
pnlName: TPanel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
SavePresetForm: TSavePresetForm;
implementation
{$R *.DFM}
procedure TSavePresetForm.Button1Click(Sender: TObject);
begin
if txtPresetName.Text = '' then
begin
Application.MessageBox(PChar(TextByKey('savepreset-notitle')), 'Apophysis', 48);
Exit;
end;
end;
procedure TSavePresetForm.FormCreate(Sender: TObject);
begin
self.Caption := TextBykey('savepreset-title');
button1.Caption := TextByKey('common-ok');
button2.Caption := TextByKey('common-cancel');
pnlName.Caption := TextByKey('savepreset-name');
end;
end.

1482
Forms/ScriptForm.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

5913
Forms/ScriptForm.pas Normal file
View File

File diff suppressed because it is too large Load Diff

40
Forms/ScriptRender.dfm Normal file
View File

@ -0,0 +1,40 @@
object ScriptRenderForm: TScriptRenderForm
Left = 390
Top = 391
BorderStyle = bsDialog
Caption = 'ScriptRenderForm'
ClientHeight = 58
ClientWidth = 285
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
DesignSize = (
285
58)
PixelsPerInch = 96
TextHeight = 13
object btnCancel: TButton
Left = 96
Top = 28
Width = 95
Height = 25
Anchors = [akLeft, akRight, akBottom]
Caption = '&Cancel'
TabOrder = 0
OnClick = btnCancelClick
end
object ProgressBar: TProgressBar
Left = 8
Top = 8
Width = 271
Height = 13
Anchors = [akLeft, akTop, akRight]
TabOrder = 1
end
end

178
Forms/ScriptRender.pas Normal file
View File

@ -0,0 +1,178 @@
{
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 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, cmap, ControlPoint, Translation;
type
TScriptRenderForm = class(TForm)
btnCancel: TButton;
ProgressBar: TProgressBar;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
private
// PixelsPerUnit: double;
StartTime: TDateTime;
Remainder: TDateTime;
procedure HandleThreadCompletion(var Message: TMessage);
message WM_THREAD_COMPLETE;
procedure HandleThreadTermination(var Message: TMessage);
message WM_THREAD_TERMINATE;
public
Renderer: TRenderThread;
ColorMap: TColorMap;
cp: TControlPoint;
Filename: string;
ImageWidth, ImageHeight, Oversample: Integer;
zoom, Sample_Density, Brightness, Gamma, Vibrancy, Filter_Radius: double;
center: array[0..1] of double;
procedure OnProgress(prog: double);
procedure Render;
procedure SetRenderBounds;
end;
var
ScriptRenderForm: TScriptRenderForm;
Cancelled: boolean;
implementation
uses Global, Math, FormRender, ScriptForm, Main;
{$R *.DFM}
procedure TScriptRenderForm.SetRenderBounds;
begin
cp.copy(ScriptEditor.cp);
cp.AdjustScale(ScriptEditor.Renderer.Width, ScriptEditor.Renderer.Height);
// --?-- cp.CalcBoundBox;
cp.center[0] := ScriptEditor.cp.center[0];
cp.center[1] := ScriptEditor.cp.center[1];
cp.zoom := ScriptEditor.cp.zoom;
end;
procedure TScriptRenderForm.Render;
begin
assert(not Assigned(Renderer));
Renderer := TRenderThread.Create;
Cancelled := False;
ScriptEditor.Scripter.Paused := True;
StartTime := Now;
Remainder := 1;
cp.copy(ScriptEditor.cp);
Filename := ScriptEditor.Renderer.Filename;
cp.AdjustScale(ScriptEditor.Renderer.Width, ScriptEditor.Renderer.Height);
//cp.Transparency := (PNGTransparency <> 0) and (UpperCase(ExtractFileExt(ScriptEditor.Renderer.FileName)) = '.PNG');
if (UpperCase(ExtractFileExt(ScriptEditor.Renderer.FileName)) = '.PNG') then
begin // AV: added new property
cp.Transparency := (PNGTransparency <> 0);
if ScriptEditor.Renderer.EmbedParameters then
Renderer.EmbedText(Trim(MainForm.RetrieveXML(cp))); // AV
end
else
cp.Transparency := False; // AV
Renderer.OnProgress := OnProgress;
Renderer.SetCP(cp);
if (ScriptEditor.Renderer.MaxMemory > 0) then
Renderer.MaxMem := ScriptEditor.Renderer.MaxMemory;
Renderer.TargetHandle := Handle;
renderPath := ExtractFilePath(ScriptEditor.Renderer.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
//Renderer := TRenderThread.Create;
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;
// Renderer.Stop;
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.

3638
Forms/SplashForm.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

60
Forms/SplashForm.pas Normal file
View File

@ -0,0 +1,60 @@
unit SplashForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Global, Vcl.Imaging.jpeg;
type
TSplashWindow = class(TForm)
BackgroundImage: TImage;
lblVersion: TLabel;
lblInfo: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormHide(Sender: TObject);
private
{ Private declarations }
public
procedure SetInfo(info:string);
end;
const DURATION: integer = 900;
var
SplashWindow: TSplashWindow;
implementation
{$R *.dfm}
procedure TSplashWindow.FormCreate(Sender: TObject);
begin
lblVersion.Caption := APP_VERSION + APP_BUILD;
// AV: for compatibility with different UI color styles:
with lblVersion do Canvas.Font := Font;
Left := (Screen.Width - Width) div 2;
Top := (Screen.Height - Height) div 2;
end;
procedure TSplashWindow.FormHide(Sender: TObject);
begin
repeat
Application.ProcessMessages;
until CloseQuery;
AnimateWindow(Handle, DURATION, {AW_BLEND} AW_CENTER or AW_HIDE)
end;
procedure TSplashWindow.FormShow(Sender: TObject);
begin
AnimateWindow(Handle, DURATION, {AW_BLEND} AW_CENTER);
end;
procedure TSplashWindow.SetInfo(info: string);
begin
// AV: for compatibility with different UI color styles:
lblInfo.Repaint;
lblInfo.Canvas.TextOut(0, 0, info);
end;
end.

110
Forms/Template.dfm Normal file
View File

@ -0,0 +1,110 @@
object TemplateForm: TTemplateForm
Left = 399
Top = 213
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'New Flame'
ClientHeight = 391
ClientWidth = 564
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
FormStyle = fsStayOnTop
Icon.Data = {
0000010001001010000001001800680300001600000028000000100000002000
0000010018000000000000030000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000B7A293634935634935634935
6349356349356349356349356349356349356349350000000000000000000000
00000000B7A293FFFFFFB7A293B7A293B7A293B7A293B7A293B7A293B7A293B7
A293634935000000000000000000000000000000B7A293FFFFFFFFFFFFFCFAF9
F7F1EEF1E7E1ECDDD5E6D3C9E1CABDB7A2936349350000000000000000000000
00000000B7A293FFFFFFFFFFFFF5F5F5F1EEECECE4E0E6DBD4E1D1C9E4CFC4B7
A293634935000000000000000000000000000000B7A293FFFFFFC1C1C1ACACAC
ABAAA9A7A4A2A39D99A09692B4A69FB7A2936349350000000000000000000000
00000000BAA596FFFFFFB6B6B6ECECECFFFFFFFBF8F7EEE7E49C9591E8D8D0B7
A293634935000000000000000000000000000000BEA99AFFFFFFB6B6B6ECECEC
FFFFFFF8F7F6ACAAA7E7DEDAEEE1DAB7A2936349350000000000000000000000
00000000C3AE9EFFFFFFB6B6B6ECECECFCFCFCB9B9B9CCCBCAF7F1EEF1E7E1B7
A293634935000000000000000000000000000000C8B2A3FFFFFFB5B5B5EDEDED
C1C1C1CBCBCBFEFEFEFAF7F5F5EDE9B7A2936349350000000000000000000000
00000000CCB6A7FFFFFFB0B0B0C7C7C7C7C7C7FFFFFFFFFFFFFDFCFBB7A293B7
A293644A36000000000000000000000000000000D1BBABFFFFFFB6B6B6C1C1C1
FFFFFFFFFFFFFFFFFFB7A293644A36644A36644A360000000000000000000000
00000000D5BFAFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB9A495D4C5BA64
4A36E1D5CD000000000000000000000000000000D8C2B2FFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFC0AB9C644A36E2D6CD0000000000000000000000000000
00000000D8C2B2D8C2B2D8C2B2D8C2B2D8C2B2D4BEAECFB9A9C9B3A4E2D6CD00
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FFFF
0000C0070000C0070000C0070000C0070000C0070000C0070000C0070000C007
0000C0070000C0070000C0070000C0070000C00F0000C01F0000FFFF0000}
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
DesignSize = (
564
391)
PixelsPerInch = 96
TextHeight = 13
object lblFile: TLabel
Left = 16
Top = 364
Width = 346
Height = 13
Anchors = [akLeft, akRight, akBottom]
AutoSize = False
ExplicitWidth = 329
end
object btnCancel: TButton
Left = 464
Top = 359
Width = 89
Height = 25
Anchors = [akRight, akBottom]
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
object btnOK: TButton
Left = 368
Top = 359
Width = 89
Height = 25
Anchors = [akRight, akBottom]
Caption = 'OK'
Default = True
Enabled = False
TabOrder = 2
OnClick = btnOKClick
end
object TemplateList: TListView
Left = 8
Top = 8
Width = 546
Height = 344
Anchors = [akLeft, akTop, akRight, akBottom]
BevelInner = bvNone
BevelOuter = bvNone
BevelKind = bkTile
BorderStyle = bsNone
Color = clBtnFace
Columns = <>
ColumnClick = False
LargeImages = UsedThumbnails
TabOrder = 0
OnChange = TemplateListChange
end
object UsedThumbnails: TImageList
Height = 128
Masked = False
Width = 128
Left = 40
Top = 304
end
end

347
Forms/Template.pas Normal file
View File

@ -0,0 +1,347 @@
{
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 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 Template;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Translation,
Dialogs, StdCtrls, ComCtrls, ImgList, ControlPoint, cmap, RenderingInterface, Main,
Global, Adjust, System.ImageList;
type
TTemplateForm = class(TForm)
TemplateList: TListView;
btnCancel: TButton;
btnOK: TButton;
UsedThumbnails: TImageList;
lblFile: TLabel;
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TemplateListChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure btnOKClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
Files: TStringList; // AV: replaced "useless" hidded TListBox
public
{ Public declarations }
end;
var
TemplateForm: TTemplateForm;
const
blankFlameXML1 = '<flame name="Blank Flame" version="Apophysis" size="1500 1000" center="0 0" background="0 0 0">';
blankFlameXML2 = '<xform weight="0.5" color="0" linear3D="1" coefs="1 0 0 1 0 0" />';
blankFlameXML3 = '<palette count="256" format="RGB">';
procedure ListTemplateByFileName(filename:string);
implementation
{$R *.dfm}
function LoadUserTemplates2(mask: string): integer;
var
FindResult: integer;
SearchRec : TSearchRec;
Path : string;
begin
Path := AppPath + 'Templates\'; // AV
result := 0;
FindResult := FindFirst(Path + Mask, faAnyFile - faDirectory, SearchRec);
while FindResult = 0 do
begin
ListTemplateByFileName(Path + SearchRec.Name);
result := result + 1;
FindResult := FindNext(SearchRec);
end;
{ free memory }
FindClose(SearchRec);
end;
function LoadUserTemplates: integer;
begin
LoadUserTemplates2('*.flame');
LoadUserTemplates2('*.template');
Result := 0; // make RTL happy
end;
function BlankXML: string;
var
i: integer;
s: string;
const
break = ' ';
begin
s := blankFlameXML1 + break + blankFlameXML2 + break + blankFlameXML3 + break;
for i := 1 to 256 do begin
s := s + '000000';
if (i mod 32 = 0) then s := s + break;
end;
s := s + '</palette></flame>';
Result := s;
end;
procedure DropBlank();
var
flameXML: string;
cp: TControlPoint;
bm: TBitmap;
Render: TRenderer;
ListItem: TListItem;
begin
cp := TControlPoint.Create;
Render := TRenderer.Create;
bm := TBitmap.Create;
cp.Clear;
flameXML := BlankXML;
MainForm.ParseXML(cp, PCHAR(flameXML), true);
cp.AdjustScale(TemplateForm.UsedThumbnails.Width, TemplateForm.UsedThumbnails.Height);
// start preview
cp.Width := TemplateForm.UsedThumbnails.Width;
cp.Height := TemplateForm.UsedThumbnails.Height;
cp.spatial_oversample := 1;
cp.spatial_filter_radius := 0.1;
cp.sample_density := 0.5; //3;
try
Render.SetCP(cp);
Render.Render;
finally
BM.Assign(Render.GetImage);
cp.Free;
Render.free;
end;
// Thumbnails
TemplateForm.UsedThumbnails.Add(bm, nil);
bm.Free; // AV: fixed multiple memory leaks!
ListItem := TemplateForm.TemplateList.Items.Add;
ListItem.Caption := 'Blank Flame';
ListItem.ImageIndex := 0;
TemplateForm.Files.Add('n/a');
//end preview
//
Application.ProcessMessages;
end;
procedure DropListItem(FileName: string; FlameName: string);
var
flameXML: string;
cp: TControlPoint;
bm: TBitmap;
Render: TRenderer;
ListItem: TListItem;
begin
cp := TControlPoint.Create;
Render := TRenderer.Create;
bm := TBitmap.Create;
cp.Clear;
flameXML := LoadXMLFlameText(filename, FlameName);
MainForm.ParseXML(cp, PCHAR(flameXML), true);
cp.AdjustScale(TemplateForm.UsedThumbnails.Width, TemplateForm.UsedThumbnails.Height);
// start preview
cp.Width := TemplateForm.UsedThumbnails.Width;
cp.Height := TemplateForm.UsedThumbnails.Height;
cp.spatial_oversample := 1;
cp.spatial_filter_radius := 0.1;
cp.sample_density := 3;
try
Render.SetCP(cp);
Render.Render;
finally
BM.Assign(Render.GetImage);
cp.Free;
Render.free;
end;
// Thumbnails
TemplateForm.UsedThumbnails.Add(bm, nil);
bm.Free; // AV: fixed multiple memory leaks!
ListItem := TemplateForm.TemplateList.Items.Add;
ListItem.Caption := FlameName;
ListItem.ImageIndex := TemplateForm.TemplateList.Items.Count - 1;
TemplateForm.Files.Add(FileName);
//end preview
//
Application.ProcessMessages;
end;
procedure ListTemplateByFileName(filename:string);
{ List .flame file }
var
sel: integer;
i, p: integer;
Title: string;
FStrings: TStringList;
begin
sel := 0;
if not FileExists(FileName) then exit;
FStrings := TStringList.Create;
FStrings.LoadFromFile(FileName);
try
if (Pos('<flame ', Lowercase(FStrings.Text)) <> 0) then
begin
for i := 0 to FStrings.Count - 1 do
begin
p := Pos('<flame ', LowerCase(FStrings[i]));
if (p <> 0) then
begin
MainForm.ListXMLScanner.LoadFromBuffer(PAnsiChar(Utf8String(FSTrings[i])));
MainForm.ListXMLScanner.Execute;
if Length(pname) = 0 then
Title := '*untitled ' + ptime
else
Title := Trim(pname);
if Title <> '' then
begin { Otherwise bad format }
DropListItem(FileName, Title);
end;
end;
end;
end;
finally
FStrings.Free;
end;
end;
procedure ListTemplate;
begin
TemplateForm.TemplateList.Items.BeginUpdate;
TemplateForm.TemplateList.Items.Clear;
TemplateForm.UsedThumbnails.Clear;
// AV: fixed - someone forgot to refresh the file list
TemplateForm.Files.Clear;
// hmmm...
(*for i := 0 to TemplateForm.UsedThumbnails.Count - 1 do
begin
TemplateForm.UsedThumbnails.GetBitmap(i, bm);
bm.Free;
end; *)
DropBlank;
ListTemplateByFileName(AppPath + templateFileName);
LoadUserTemplates;
TemplateForm.TemplateList.Items.EndUpdate;
TemplateForm.TemplateList.Selected := TemplateForm.TemplateList.Items[0];
end;
procedure TTemplateForm.FormCreate(Sender: TObject);
begin
self.Caption := TextByKey('template-title');
btnOK.Caption := TextByKey('common-ok');
btnCancel.Caption := TextByKey('common-cancel');
Files := TStringList.Create; // AV
end;
procedure TTemplateForm.FormDestroy(Sender: TObject);
begin
Files.Free; // AV
end;
procedure TTemplateForm.TemplateListChange(Sender: TObject;
Item: TListItem; Change: TItemChange);
var
fn : string;
begin
if (TemplateList.Selected = nil) then
btnOK.Enabled := false
else begin
if (TemplateList.Selected.Index >= 0) then begin
btnOK.Enabled := true;
if (TemplateList.Selected.Index > 0) then begin
fn := ChangeFileExt(ExtractFileName(Files[TemplateList.Selected.Index]), '');
if (LowerCase(fn) <> 'apophysisav') then
lblFile.Caption := TextByKey('template-filename') + fn
else lblFile.Caption := '';
end else begin
lblFile.Caption := '';
end;
end else
btnOK.Enabled := false;
end;
end;
procedure TTemplateForm.btnOKClick(Sender: TObject);
var
flameXML: string;
fn: string;
ci: integer;
blank: boolean;
begin
fn := Files[TemplateList.Selected.Index];
blank := (TemplateList.Selected.Index = 0);
if blank then
flameXML := BlankXML
else
flameXML := LoadXMLFlameText(fn, TemplateList.Selected.Caption);
MainForm.UpdateUndo;
MainForm.StopThread;
MainForm.InvokeLoadXML(flameXML);
Transforms := MainCp.TrianglesFromCP(MainTriangles);
MainForm.Statusbar.Panels[3].Text := MainCp.name;
{if ResizeOnLoad then}
MainForm.ResizeImage;
MainForm.RedrawTimer.Enabled := True;
Application.ProcessMessages;
MainForm.UpdateWindows;
// AV: fixed a bug with black flames on the black background
if RandomizeTemplates or blank then // AV
if (randGradient = 3) then // AV: only if user prefer new palettes
AdjustForm.mnuRandomize.Click
else begin // AV: use preset palette
ci := Random(NRCMAPS);
GetCMap(ci, 1, MainCp.cmap);
MainCp.cmapIndex := ci;
end;
if blank then // AV: fixed resetting values to 1
begin
MainCp.brightness := defBrightness;
MainCp.gamma := defGamma;
MainCp.gammaThreshRelative := defGammaThreshold;
MainCp.contrast := defContrast;
MainCp.Vibrancy := defVibrancy;
Maincp.sample_density := defSampleDensity;
end;
ModalResult := mrOK; // AV
end;
procedure TTemplateForm.FormShow(Sender: TObject);
begin
ListTemplate;
end;
end.

132
Forms/Tracer.dfm Normal file
View File

@ -0,0 +1,132 @@
object TraceForm: TTraceForm
Left = 36
Top = 159
Caption = 'Trace'
ClientHeight = 489
ClientWidth = 395
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Icon.Data = {
0000010001001010000000000800680500001600000028000000100000002000
0000010008000000000000010000000000000000000000010000000100000000
0000000080000080000000808000800000008000800080800000C0C0C000C0DC
C000F0CAA60004040400080808000C0C0C0011111100161616001C1C1C002222
220029292900555555004D4D4D004242420039393900807CFF005050FF009300
D600FFECCC00C6D6EF00D6E7E70090A9AD000000330000006600000099000000
CC00003300000033330000336600003399000033CC000033FF00006600000066
330000666600006699000066CC000066FF000099000000993300009966000099
99000099CC000099FF0000CC000000CC330000CC660000CC990000CCCC0000CC
FF0000FF660000FF990000FFCC00330000003300330033006600330099003300
CC003300FF00333300003333330033336600333399003333CC003333FF003366
00003366330033666600336699003366CC003366FF0033990000339933003399
6600339999003399CC003399FF0033CC000033CC330033CC660033CC990033CC
CC0033CCFF0033FF330033FF660033FF990033FFCC0033FFFF00660000006600
330066006600660099006600CC006600FF006633000066333300663366006633
99006633CC006633FF00666600006666330066666600666699006666CC006699
00006699330066996600669999006699CC006699FF0066CC000066CC330066CC
990066CCCC0066CCFF0066FF000066FF330066FF990066FFCC00CC00FF00FF00
CC009999000099339900990099009900CC009900000099333300990066009933
CC009900FF00996600009966330099336600996699009966CC009933FF009999
330099996600999999009999CC009999FF0099CC000099CC330066CC660099CC
990099CCCC0099CCFF0099FF000099FF330099CC660099FF990099FFCC0099FF
FF00CC00000099003300CC006600CC009900CC00CC0099330000CC333300CC33
6600CC339900CC33CC00CC33FF00CC660000CC66330099666600CC669900CC66
CC009966FF00CC990000CC993300CC996600CC999900CC99CC00CC99FF00CCCC
0000CCCC3300CCCC6600CCCC9900CCCCCC00CCCCFF00CCFF0000CCFF330099FF
6600CCFF9900CCFFCC00CCFFFF00CC003300FF006600FF009900CC330000FF33
3300FF336600FF339900FF33CC00FF33FF00FF660000FF663300CC666600FF66
9900FF66CC00CC66FF00FF990000FF993300FF996600FF999900FF99CC00FF99
FF00FFCC0000FFCC3300FFCC6600FFCC9900FFCCCC00FFCCFF00FFFF3300CCFF
6600FFFF9900FFFFCC006666FF0066FF660066FFFF00FF666600FF66FF00FFFF
66002100A5005F5F5F00777777008686860096969600CBCBCB00B2B2B200D7D7
D700DDDDDD00E3E3E300EAEAEA00F1F1F100F8F8F800F0FBFF00A4A0A0008080
80000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF000000
000000000000000000000000000000000000000000000000000000000000AC12
1212121212121212121212F70000AC000000000000000000000000120000AC00
0000000000000000000000120000AC00FA00FAFA00FA0000000000120000AC00
0000000000000000000000120000AC00FAFA00FAFAFA00FA000000120000AC00
0000000000000000000000120000AC00FA00FAFA00FAFA00000000120000AC00
0000000000000000000000120000AC000000000000000000000000120000ACAC
ACACACACACACACACACACACAC0000ACFF090909090909090909FFADFF0000ACAC
ACACACACACACACACACACACACAC0000000000000000000000000000000000FFFF
0000000100000001000000010000000100000001000000010000000100000001
0000000100000001000000010000000100000001000000010000FFFF0000}
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
DesignSize = (
395
489)
PixelsPerInch = 96
TextHeight = 13
object PageControl1: TPageControl
Left = 0
Top = 0
Width = 395
Height = 489
ActivePage = TabMain
Align = alClient
Images = MainForm.Buttons
TabOrder = 0
object TabMain: TTabSheet
Caption = 'Main'
ImageIndex = 16
object MainTrace: TMemo
Left = 0
Top = 0
Width = 387
Height = 460
Align = alClient
Color = clBlack
Font.Charset = DEFAULT_CHARSET
Font.Color = clLime
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 0
end
end
object TabFullscreen: TTabSheet
Caption = 'Fullscreen'
ImageIndex = 52
object FullscreenTrace: TMemo
Left = 0
Top = 0
Width = 387
Height = 460
Align = alClient
Color = clBlack
Font.Charset = DEFAULT_CHARSET
Font.Color = clLime
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 0
end
end
end
object cbTraceLevel: TComboBox
Left = 280
Top = 0
Width = 121
Height = 21
Style = csDropDownList
Anchors = [akTop, akRight]
TabOrder = 1
OnSelect = cbTraceLevelSelect
Items.Strings = (
'No trace'
'Minimal trace'
'Full trace')
end
end

156
Forms/Tracer.pas Normal file
View File

@ -0,0 +1,156 @@
{
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
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 Tracer;
{$define TRACEFORM_HIDDEN}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Translation;
type
TTraceForm = class(TForm)
PageControl1: TPageControl;
TabMain: TTabSheet;
TabFullscreen: TTabSheet;
FullscreenTrace: TMemo;
cbTraceLevel: TComboBox;
MainTrace: TMemo;
procedure cbTraceLevelSelect(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
TraceForm: TTraceForm;
var
TraceLevel: integer;
const
MsgComplete = '< Received WM_THREAD_COMPLETE from RenderThread #';
MsgTerminated = '< Received WM_THREAD_TERMINATE from RenderThread #';
MsgNotAssigned = 'Ignoring message: RenderThread does not exist';
MsgAnotherRunning = 'Ignoring message: another RenderThread is running';
implementation
{$R *.dfm}
uses
Registry,
Global, Main;
procedure TTraceForm.cbTraceLevelSelect(Sender: TObject);
begin
TraceLevel := cbTraceLevel.ItemIndex;
end;
procedure TTraceForm.FormCreate(Sender: TObject);
var
Registry: TRegistry;
begin
{ Read position from registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('Software\' + APP_NAME + '\Forms\Trace', False) then
begin
if Registry.ValueExists('Top') then
self.Top := Registry.ReadInteger('Top');
if Registry.ValueExists('Left') then
self.Left := Registry.ReadInteger('Left');
if Registry.ValueExists('Width') then
self.Width := Registry.ReadInteger('Width');
if Registry.ValueExists('Height') then
self.Height := Registry.ReadInteger('Height');
{$ifndef TRACEFORM_HIDDEN}
if Registry.ValueExists('TraceLevel') then
TraceLevel := Registry.ReadInteger('TraceLevel')
else
TraceLevel := 0;
MainForm.tbShowTrace.Visible := true;
MainForm.tbShowTrace.Enabled := true;
MainForm.tbTraceSeparator.Visible := true;
MainForm.tbTraceSeparator.Enabled := true;
{$else}
TraceLevel := 0;
//MainForm.tbShowTrace.Visible := false;
//MainForm.tbShowTrace.Enabled := false;
//MainForm.tbTraceSeparator.Visible := false;
//MainForm.tbTraceSeparator.Enabled := false;
{$endif}
end;
Registry.CloseKey;
finally
Registry.Free;
end;
// AV: translation added
self.Caption := TextByKey('common-trace-title');
TabMain.Caption := TextByKey('common-trace-main');
TabFullScreen.Caption := TextByKey('common-trace-fullscreen');
cbTraceLevel.Items[0] := TextByKey('common-trace-notrace');
cbTraceLevel.Items[1] := TextByKey('common-trace-minimal');
cbTraceLevel.Items[2] := TextByKey('common-trace-fulltrace');
cbTraceLevel.ItemIndex := TraceLevel;
end;
procedure TTraceForm.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\Trace', True) then
begin
if self.WindowState <> wsMaximized then begin
Registry.WriteInteger('Top', self.Top);
Registry.WriteInteger('Left', self.Left);
Registry.WriteInteger('Width', self.Width);
Registry.WriteInteger('Height', self.Height);
Registry.WriteInteger('TraceLevel', TraceLevel);
end;
end;
finally
Registry.Free;
end;
end;
end.

381
Forms/VarOrderForm.dfm Normal file
View File

@ -0,0 +1,381 @@
object VarOrder: TVarOrder
Left = 0
Top = 0
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'Variation Order'
ClientHeight = 371
ClientWidth = 335
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Icon.Data = {
0000010001001616000000000000100800001600000028000000160000002C00
000001002000000000009007000000000000000000000000000000000000FFFF
FF00FFFFFF00FFFFFF00FF66000BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF66003FFF66
00DFFF6B09FFFF6600E0FF66003AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FF690601FF6906E4FFB17EFFFFC299FFFFB5
84FFFF6906D2FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FF731606FF7316F7FF934CFFFF751AFFFFCDACFFFF7316F5FFFF
FF004F4F4FB44F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F
4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FB4FFFFFF00FFFFFF00FFFF
FF00FF7D2657FF7D26FFFFC69FFFFFAA71FFFF7D26C1FFFFFF00636363FFFCFC
FCFFFCFCFCFFFCFCFCFFFCFCFCFFF9F9F9FFF3F3F3FFEDEDEDFFE6E6E6FFE0E0
E0FFE0E0E0FFE0E0E0FF636363FFFFFFFF00FFFFFF00FFFFFF00FF8636E8FFA5
68FFFF893BFFFFCBA9FFFF8636DCFFFFFF00777777B4777777FF777777FF7777
77FF777777FF777777FF777777FF777777FF777777FF777777FF777777FF7777
77FF777777B4FFFFFF00FFFFFF00FFFFFF00FF9046C4FFB17DFFFFCCA9FFFFB4
81FFFF9046B1FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FF995522FF9955B4FF9955E2FF9955B0FF995519FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FF66000BFF660040FF660040FF66003DFF660006FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF660003FF6600C1FF66
00FFFF6600FFFF6600FFFF6600B4FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FF6B0904FF6C0AF4FFD2B3FFFFB585FFFFA3
65FFFF6B09BBFFFFFF004F4F4FB44F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F
4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FB4FFFF
FF00FFFFFF00FFFFFF00FF771D8BFF924AFFFFB98AFFFF7B25FFFF771D74FFFF
FF00636363FFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFF9F9F9FFF3F3F3FFEDED
EDFFE6E6E6FFE0E0E0FFE0E0E0FFE0E0E0FF636363FFFFFFFF00FFFFFF00FFFF
FF00FF8330EAFF8D41FFFF9D5BFFFFB482FFFF8330B5FFFFFF00777777B47777
77FF777777FF777777FF777777FF777777FF777777FF777777FF777777FF7777
77FF777777FF777777FF777777B4FFFFFF00FFFFFF00FFFFFF00FF8F44C0FFBD
91FFFFC49CFFFFB07BFFFF8F4487FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF9A5717FF9A5796FF9A57B9FF9A
577EFF9A5707FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FF660008FF660040FF660040FF66003CFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FF6600B9FF6600FFFF6600FFFF6600FFFF66008EFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF6600CAFFA5
69FFFFCFAFFFFF9853FFFF66009EFFFFFF004F4F4FB44F4F4FFF4F4F4FFF4F4F
4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F
4FFF4F4F4FB4FFFFFF00FFFFFF00FFFFFF00FF701151FF7011FDFFC29AFFFF70
11E6FF701104FFFFFF00636363FFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFF9F9
F9FFF3F3F3FFEDEDEDFFE6E6E6FFE0E0E0FFE0E0E0FFE0E0E0FF636363FFFFFF
FF00FFFFFF00FFFFFF00FF7C24EBFF8433FFFFC59EFFFF7C24DEFFFFFF00FFFF
FF00777777B4777777FF777777FF777777FF777777FF777777FF777777FF7777
77FF777777FF777777FF777777FF777777FF777777B4FFFFFF00FFFFFF00FFFF
FF00FF8737BEFFAE78FFFFC7A2FFFF8737D6FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF934A0DFF93
4A87FF934ABDFF934A30FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C7FFFF0083FFFF0082000E00C200
0E0082000F0083FFFE00C7FFFE00FFFFFF0083FFFF0082000E0086000E008200
0E0083FFFE00CFFFFE00FFFFFF0083FFFF0082000E00C6000E0086000F0087FF
FE00CFFFFE00}
OldCreateOrder = False
Position = poOwnerFormCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
DesignSize = (
335
371)
PixelsPerInch = 96
TextHeight = 13
object btnTop: TSpeedButton
Left = 221
Top = 25
Width = 96
Height = 25
BiDiMode = bdLeftToRight
Caption = 'To Top'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFBF6331
CA7544CB7238C56125DFA88DFFFFFFFFFFFFFFFFFFFFFFFFEAB99BD96215E161
0AE46A14E16E1FFFFFFFFFFFFFBE653CE6C1A6FFFCD6F5C283CB6220D89A7CFF
FFFFFFFFFFE2A98AD66921F77711FF8A22F3852BDE7025FFFFFFFFFFFFF2E1D9
C06847DEAF91FFE9BDF9B064D0611AD79673DB9F7FD67032FA8325FF8B21EB7E
26D97434F7DECEFFFFFFFFFFFFFFFFFFF6EBE6BE6842D99D7BFFDBA8FD9C42D4
5A0BD35B0CFC8222FF871DE5761DD47134F8E6DBFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFDF9F8C36F4BD2936DFECE96FF8722FF6F00FF8419DF6E1BD17741FBF3
EEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFCF8F6C7795CCD855DFD
C285FF8E2AD66413CF7E52FBF4F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFEFECC876CCB7A4DD0773BCF835EFDFBF9FFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFEFFFEFEFFFFFFFFFFFFFEFCFBDB
AA93DBA68CFDFAF8FFFFFFFFFFFFFFFEFEFFFEFEFFFFFFFFFFFFFFFFFFCE9E86
B56849B76745C27E60F3E6E0FFFFFFFFFFFFFFFFFFFFFFFFF7ECE6D38E67CC74
41CF7641DFA27CFFFFFFFFFFFFA44516DDBA92E7C392D38B53B15831EEDBD3FF
FFFFFFFFFFF3E2DBC16C3FDA5F0AEE7310EB7D25C55209FFFFFFFFFFFFD4A591
BA7352F7F4CFFFE8ABE18D4BAF5027ECD8CEF1E1D9B8633AE4792DFF8618FB90
2DCF6117DEA584FFFFFFFFFFFFFFFFFFD3A497AD5A35EEDBB0FFD48BE67F2EAF
4D1BB1562BE67F36FF861AF48625C05210DBA58AFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFD8AFA3AB5835E8D0A6FFC575EC6E0FEA6605FF8314EE7F22BA5114DCAF
99FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE0BEB4A95537E2C497FF
B760FF7E0FE9791EB4501BDFB8A6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFE8D0C9AA5639DEB688E59850AE4C22E5C9BCFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEEDCD6AF
5F3BAE603AEAD4CBFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnTopClick
end
object btnMoveUp: TSpeedButton
Left = 221
Top = 60
Width = 96
Height = 25
BiDiMode = bdLeftToRight
Caption = 'Move Up'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFAE5D36
A23C0FA93F0BB24D17EBCEBEFFFFFFFFFFFFFFFFFFFFFFFFF8E1D2E46D1EE966
0EF16B0EF9822BFFFFFFFFFFFFA64A1EE4A66EE79146D06620B95F33FBF4F1FF
FFFFFFFFFFFDF7F3DC793FEA7720F89A40FA9D44F5720FFFFFFFFFFFFFA95233
E0B18AFFDA96FEA754BF5212CD8F73FFFFFFFFFFFFDFA282D96B21FD9433FFA9
4CF79B43ED7420FFFFFFFFFFFFDFC0B5A14423F1CEA8FFC882F09546B14510EC
D4C7F3E0D6C76128F58C36FF7F14FA8524E06109F7C7A8FFFFFFFFFFFFFFFFFF
C0816FB87155FDE2BAFFBE72D97831B55B31BF6B43DF8346FF7A14FF7406E05F
07E59461FFFFFFFFFFFFFFFFFFFFFFFFF8F0EDA74F32D5A992FFE5B5FDB362BC
5417BC5013FD8323FF6D00E86302CE6625FAEBE1FFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFE1C4B89F4020ECD7C5FFDBA5F6A456F48B36FF8117F46902BF4A01EBC1
A7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC38773B2684FFBF3DFFF
C987FFAC5BFD963BC65108D08A64FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFDFAF9A64D32CEA394FFF3D6FFC47BD87D38AF5228FBF5F2FFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE9D2C9A04226EC
DCD4F2D0A9A24016E5C8BAFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFC68D7DB2674AB97559C0826FFFFEFEFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF8F6AE
5D3CAB5634FBF7F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnMoveUpClick
end
object btnMoveDown: TSpeedButton
Left = 221
Top = 95
Width = 96
Height = 25
BiDiMode = bdLeftToRight
Caption = 'Move Down'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFEF9F6EB7F38F07D30FEF6F0FFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEAA177E9
7522F0822CF39F6AFFFEFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFF3D5C3DA6219F8B46FFC9036EB6008F9D1B5FFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDF9F6D2672EEB9C5FFF
BA73FF760BF56903EC7623FEF5EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFD9916DD77538FDD29EFF9B44FF8420FE770EEE6300F0995DFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE7C4B1C15117F5CBA3FFC484F9
9138F8872CFF8521FB7209E85F00F7C4A1FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
F7EEE9BC592DE3AD88FFE3B9FEB267D66317D75F11FE963CFF821BF56C07E873
22FCE9DBFFFFFFFFFFFFFFFFFFFFFFFFC6816AC87B56FEF0D9FFD99EE28B46CE
6C36D57741E6853DFF973BFF7B14ED6604EE965AFFFFFFFFFFFFFFFFFFDDBAAF
AA4923F4E6D9FFF7D1F1BF85BF521AF3DBCDF7E6DBCF6225F4A05CFF8E2FFB78
12E65F01F5C5A3FFFFFFFFFFFFA95131E3C6BDFFFFFFFDF2C7C16430D59479FF
FFFFFFFFFFE3A688D46E35FDA75DFF8C28F77612E76D17FFFFFFFFFFFFA74F28
E1C4B2E3C7AACC8E61B85C36FBF5F2FFFFFFFFFFFFFDF7F4D37742E07529F382
28F47618E46103FFFFFFFFFFFFB0613D9D3B179D3A14A7461CECD3C6FFFFFFFF
FFFFFFFFFFFFFFFFF6E3D7CF6220D1570CD65B0BE1772FFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnMoveDownClick
end
object btnBottom: TSpeedButton
Left = 221
Top = 130
Width = 96
Height = 25
BiDiMode = bdLeftToRight
Caption = 'To Bottom'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFF5D9CBE07936E57C36F7D5C0FFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEECBBDD66E37F2
C48DF79E4EE3671BF5CAB0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFE5B9A7CB6A38F2CF9CFFAE58FF770BF7801EE46A16F2BD9BFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDBA999C46936F3D8A8FFBD6FF1
710FF16906FF7F13F98522E66B14F1B58FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
D29D8CBD683CF5E1B3FFCE87EA7F2DCB6121D06C31EE8337FF831AFB8825E76B
12EFAA7DFFFEFEFFFFFFFFFFFFCC9985C17E5BFDFCD2FFE4A8E38B47C05E2AF5
E3D8F9ECE5D1723CEB7B2CFF8116FF8F2CEC741AF0A979FFFFFFFFFFFFA74717
D8B18AE1B787D0824BBD653BF3E2DAFFFFFFFFFFFFF8E9E1D67F49E46308F171
0DF17E23E36208FFFFFFFFFFFFDDAF97BD795FBD785ECB9177F6EBE5FFFFFFFF
FFFFFFFFFFFFFFFFFBF2EDE3A47DDF8E5BE4905AF0B790FFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFCF9FFB580FFB27AFFFAF6FFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF8FE9D60FF
9D54FF953EFE9854FFF9F4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFEF6F1F58F51FCA564FFBD80FF8724FF7C15FF9447FFF3E9FFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDF4EFED8342F7AC76FFC990FF
821EFF6C00FF7F17FF811CFF8B37FFEEE2FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
F8E5DBE3773AF3B183FFD5A2FD983FF66D09FA7310FF8324FF811AFF831FFF86
2DFFE3D0FFFFFFFFFFFFFFFFFFF4DBCEDB7746F1C09CFFE6BAFCAE62ED7018F6
AD7DFAB789FB8431FF8426FF841EFF8927FF852BFFDDC4FFFFFFFFFFFFD06B33
F0C7A8FFF4CEF8BF7EE26D1EF1AF87FFFFFFFFFFFFFBBF96FA7D22FF7710FF83
1EFF8C2AFF7E1DFFFFFFFFFFFFCD7039D3743DD67231D86C26EFBA9BFFFFFFFF
FFFFFFFFFFFFFFFFFCCBA9FB7819FE7007FF7812FF8529FFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnBottomClick
end
object btnSort: TSpeedButton
Left = 221
Top = 165
Width = 96
Height = 25
BiDiMode = bdLeftToRight
Caption = 'Sort by name'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFBFBFF
C7C7FFA7A7FFA4A4FFA4A4FFA6A6FFD5D5FFFDFDFFFFFFFFC8C8C82828289898
98FFFFFFFFFFFFFFFFFFFFFFFFF6F6FF6A6AFF1010FF1D1DFF3434FF3C3CFFA3
A3FFFCFCFFF9F9F98484841717175C5C5CE4E4E4FFFFFFFFFFFFFFFFFFFCFCFF
A2A2FF1D1DFF2A2AFFA2A2FFD1D1FFE9E9FFFFFFFFD8D8D83E3E3E1010102626
26B0B0B0FCFCFCFFFFFFFFFFFFFFFFFFEBEBFF7373FF1616FF6F6FFFEFEFFFFF
FFFFFFFFFF9090902625261A19191F1F1F636363F3F3F3FFFFFFFFFFFFFFFFFF
FFFFFFD9D9FF4D4DFF1B1BFF9A9AFFF9F9FFFFFFFFCECDCD8988883737377070
70BABABAFAFAFAFFFFFFFFFFFFFEFEFFDFDFFFBFBFFF7777FF1010FF3232FFCE
CEFFFFFFFFFFFFFFD3D3D34E4E4EABABABFFFFFFFFFFFFFFFFFFFFFFFFFBFBFF
9C9CFF3B3BFF2D2DFF2525FF2C2CFFBABAFFFFFFFFFFFFFFD4D4D4575757AFAF
AFFFFFFFFFFFFFFFFFFFFFFFFFFEFEFFE4E4FFC6C6FFC2C2FFC2C2FFC6C6FFEE
EEFFFFFFFFFFFFFFD7D6D6626262B4B4B4FFFFFFFFFFFFFFFFFFFFFFFFFEFCFB
F6E1D1F8E4D5FFFDFBFFFFFDF9E8DAF4DDCBFDFAF7FFFFFFD9D9D96D6D6DB9B9
B9FFFFFFFFFFFFFFFFFFFFFFFFFCF8F4DC9B67D68A4CF2DAC6F5E3D4D99259D7
8C4FFAEFE7FFFFFFDDDDDC797979BFBFBFFFFFFFFFFFFFFFFFFFFFFFFFFEFCFA
E4B188CA6717D07932D27D38C96210DD9D6AFCF6F2FFFFFFE0E0DF858584C4C5
C4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF1D6C0CD7024CE7228CF752DC96412EB
C4A5FFFEFEFFFFFFE3E3E2919190CACACAFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
F9EDE3D88F54CF752CD07730D27F3BF5E2D3FFFFFFFFFFFFE6E6E69D9D9DD0D0
D0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFCFAE5B48CC8600CC65B05DD9D6AFC
F8F4FFFFFFFFFFFFE9E9E9A9A9A9D6D6D6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFF0D4BDCF752DCC6B1DEAC3A3FFFFFFFFFFFFFFFFFFECECECB8B8B8DCDC
DCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF5EFEFD2BAEDCCB1FAF0E8FF
FFFFFFFFFFFFFFFFF9F9F9E7E7E7F3F3F3FFFFFFFFFFFFFFFFFF}
Margin = 3
ParentShowHint = False
ParentBiDiMode = False
ShowHint = True
Spacing = 5
OnClick = btnSortClick
end
object btnDefOrder: TSpeedButton
Left = 221
Top = 200
Width = 96
Height = 25
BiDiMode = bdLeftToRight
Caption = 'Default order'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0864C
B0681FA65400FFFFFFA65400FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFC0874BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
B1691FFFFFFFFFFFFFFFFFFFFFFFFF0000000000000000000000000000000000
00000000000000000000FFFFFFFFFFFFFFFFFFA65400FFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0864B
B0681EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFC1864CB1691FA65400FFFFFFA65400FFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
B1691FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB1681EFFFFFFFFFFFFFFFFFFFFFFFF00
0000000000000000000000000000000000000000000000000000FFFFFFC1874B
B0681EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB1691FFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentShowHint = False
ParentBiDiMode = False
ShowHint = True
Spacing = 5
OnClick = btnDefOrderClick
end
object pnlVarList: TPanel
Left = 8
Top = 8
Width = 200
Height = 320
ShowCaption = False
TabOrder = 0
object VarListView: TListView
Left = 1
Top = 1
Width = 198
Height = 318
Align = alClient
Columns = <
item
Width = 175
end>
ColumnClick = False
DragMode = dmAutomatic
FullDrag = True
HideSelection = False
ReadOnly = True
SmallImages = EditForm.IconsAV
TabOrder = 0
ViewStyle = vsReport
OnChange = VarListViewChange
OnCustomDrawItem = VarListViewCustomDrawItem
OnDragDrop = VarListViewDragDrop
OnDragOver = VarListViewDragOver
end
end
object btnOK: TButton
Left = 142
Top = 338
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = '&OK'
ModalResult = 1
TabOrder = 1
end
object btnCancel: TButton
Left = 231
Top = 338
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = '&Cancel'
ModalResult = 2
TabOrder = 2
end
end

340
Forms/VarOrderForm.pas Normal file
View File

@ -0,0 +1,340 @@
{ Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }
unit VarOrderForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, StrUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Editor, Translation, Vcl.StdCtrls,
Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.Buttons;
type
TVarOrder = class(TForm)
pnlVarList: TPanel;
VarListView: TListView;
btnOK: TButton;
btnCancel: TButton;
btnTop: TSpeedButton;
btnMoveUp: TSpeedButton;
btnMoveDown: TSpeedButton;
btnBottom: TSpeedButton;
btnSort: TSpeedButton;
btnDefOrder: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnMoveUpClick(Sender: TObject);
procedure VarListViewChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure btnMoveDownClick(Sender: TObject);
procedure btnTopClick(Sender: TObject);
procedure btnBottomClick(Sender: TObject);
procedure btnSortClick(Sender: TObject);
procedure btnDefOrderClick(Sender: TObject);
procedure VarListViewDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure VarListViewDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure VarListViewCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
totVars: integer;
usedVars: TStringList;
procedure ExchangeVars(const i, j: integer);
procedure SetVarIcon(const s: string; ListItem: TListItem);
procedure ShowSelected(const i: integer);
public
{ Public declarations }
Changed: boolean;
end;
var
VarOrder: TVarOrder;
implementation
uses
XFormMan, Global; // to get default variation order
{$R *.dfm}
procedure TVarOrder.btnBottomClick(Sender: TObject);
var i: integer;
begin
if not assigned(VarListView.Selected) then
begin
Application.MessageBox(PChar(TextByKey('varorder-noselected')),
PChar('Apophysis AV'), MB_ICONWARNING);
exit;
end;
i := VarListView.Selected.Index;
ExchangeVars(i, totVars);
ShowSelected(totVars);
end;
procedure TVarOrder.btnDefOrderClick(Sender: TObject);
var
i, j: integer;
s, cap: string;
begin
VarListView.Items.BeginUpdate;
if assigned(VarListView.Selected) then
cap := VarListView.Selected.Caption
else
cap := 'linear';
j := 0;
for i := 0 to totVars do
begin
s := Varnames(i);
VarListView.Items[i].Caption := s;
SetVarIcon(s, VarListView.Items[i]);
if s = cap then j := i;
end;
VarListView.Selected := VarListView.Items[j];
ShowSelected(j);
VarListView.Items.EndUpdate;
Changed := True;
end;
procedure TVarOrder.btnMoveDownClick(Sender: TObject);
var i: integer;
begin
if not assigned(VarListView.Selected) then
begin
Application.MessageBox(PChar(TextByKey('varorder-noselected')),
PChar('Apophysis AV'), MB_ICONWARNING);
exit;
end;
i := VarListView.Selected.Index;
ExchangeVars(i, i + 1);
ShowSelected(i + 1);
end;
procedure TVarOrder.btnMoveUpClick(Sender: TObject);
var i: integer;
begin
if not assigned(VarListView.Selected) then
begin
Application.MessageBox(PChar(TextByKey('varorder-noselected')),
PChar('Apophysis AV'), MB_ICONWARNING);
exit;
end;
i := VarListView.Selected.Index;
ExchangeVars(i, i - 1);
ShowSelected(i - 1);
end;
procedure TVarOrder.btnSortClick(Sender: TObject);
begin
VarListView.Items.BeginUpdate;
VarListView.SortType := stText;
VarListView.SortType := stNone;
if not assigned(VarListView.Selected) then
VarListView.Selected := VarListView.Items[0];
ShowSelected(VarListView.Selected.Index);
VarListView.Items.EndUpdate;
Changed := True;
end;
procedure TVarOrder.btnTopClick(Sender: TObject);
var i: integer;
begin
if not assigned(VarListView.Selected) then
begin
Application.MessageBox(PChar(TextByKey('varorder-noselected')),
PChar('Apophysis AV'), MB_ICONWARNING);
exit;
end;
i := VarListView.Selected.Index;
ExchangeVars(i, 0);
ShowSelected(0);
end;
procedure TVarOrder.ExchangeVars(const i, j: integer);
var
tmpVarItem: TListItem;
n: integer;
begin
VarListView.Items.BeginUpdate;
tmpVarItem := TListItem.Create(VarListView.Items);
try
if (i < j) then
for n := i to (j - 1) do
begin
tmpVarItem.Assign(VarListView.Items.Item[n]);
VarListView.Items.Item[n] := VarListView.Items.Item[n + 1];
VarListView.Items.Item[n + 1] := tmpVarItem;
end
else // if (i > j) then
for n := i downto (j + 1) do
begin
tmpVarItem.Assign(VarListView.Items.Item[n]);
VarListView.Items.Item[n] := VarListView.Items.Item[n - 1];
VarListView.Items.Item[n - 1] := tmpVarItem;
end;
VarListView.Selected := VarListView.Items[j];
Changed := True;
finally
tmpVarItem.Free;
VarListView.Items.EndUpdate;
end;
end;
procedure TVarOrder.FormCreate(Sender: TObject);
begin
btnOK.Caption := TextByKey('common-ok');
btnCancel.Caption := TextByKey('common-cancel');
btnMoveUp.Caption := TextByKey('favscripts-moveup');
btnMoveDown.Caption := TextByKey('favscripts-movedown');
btnTop.Caption := TextByKey('varorder-totop');
btnBottom.Caption := TextByKey('varorder-tobottom');
btnSort.Caption := TextByKey('varorder-byname');
btnSort.Hint := TextByKey('varorder-bynamehint');
btnDefOrder.Caption := TextByKey('varorder-byindex');
btnDefOrder.Hint := TextByKey('varorder-byindexhint');
self.Caption := TextByKey('varorder-title');
usedVars := TStringList.Create;
end;
procedure TVarOrder.FormDestroy(Sender: TObject);
begin
usedVars.Free;
end;
procedure TVarOrder.FormShow(Sender: TObject);
var
ListItem: TListItem;
i, SelTX: integer;
s: string;
begin
Changed := False;
SelTX := EditForm.cbTransforms.ItemIndex;
if SelTX < EditForm.cp.NumXForms then
begin
s := TextByKey('editor-common-transform') + ' ' + IntToStr(SelTX + 1);
//if (EditForm.txtName.Text <> '') then
// s := s + ' - ' + EditForm.txtName.Text;
end else
s := TextByKey('editor-common-transform') + ' ' +
TextByKey('editor-common-finalxformlistitem');
VarListView.Column[0].Caption := s;
totVars := NrVar - 1;
VarListView.Items.BeginUpdate;
VarListView.Items.Clear;
usedVars.Clear;
for i := 0 to totVars do
begin
ListItem := VarListView.Items.Add;
s := EditForm.cp.xform[SelTX].ifs[i];
ListItem.Caption := s;
SetVarIcon(s, ListItem);
ListItem.Indent := 1;
if EditForm.cp.xform[SelTX].GetVariation(i) <> 0 then
usedVars.Add(Varnames(i));
end;
VarListView.Items.EndUpdate;
VarListView.Selected := VarListView.Items[0];
end;
procedure TVarOrder.SetVarIcon(const s: string; ListItem: TListItem);
begin
if (LeftStr(s, 4) = 'pre_') or (s = 'flatten') then
ListItem.ImageIndex := 7 // red
else if LeftStr(s, 5) = 'post_' then
ListItem.ImageIndex := 4 // blue
else if (s = 'trianglecrop') or (s = 'projective')
or (s = 'affine3D') or (s = 'spherecrop') then
ListItem.ImageIndex := 6 // violet
else
ListItem.ImageIndex := 5 // blue;
end;
procedure TVarOrder.ShowSelected(const i: integer);
begin
try
VarListView.Items[i].MakeVisible(false);
finally
VarListView.SetFocus;
end;
end;
procedure TVarOrder.VarListViewChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
begin
if (Item.Index = totVars) or (Item.Index < 0) then
begin
btnMoveDown.Enabled := False;
btnBottom.Enabled := False;
end else begin
btnMoveDown.Enabled := True;
btnBottom.Enabled := True;
end;
if (Item.Index <= 0) then
begin
btnMoveUp.Enabled := False;
btnTop.Enabled := False;
end else begin
btnMoveUp.Enabled := True;
btnTop.Enabled := True;
end;
end;
procedure TVarOrder.VarListViewCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
vRect: TRect;
begin
DefaultDraw := True;
if (usedVars.Count = 0) then exit;
vRect := Item.DisplayRect(drLabel);
if usedVars.IndexOf(Item.Caption) >= 0 then
with VarListView.Canvas do
begin
if (CurrentStyle = 'Windows') then
Brush.Color := $0002B076
else
Brush.Color := BrightColor;
FillRect(vRect);
if (CurrentStyle = 'Auric') then // make the text more visible
Font.Color := WinColor
else
Font.Color := TextColor;
TextOut(vRect.Left + 2, vRect.Top + 2, Item.Caption);
end;
end;
procedure TVarOrder.VarListViewDragDrop(Sender, Source: TObject; X, Y: Integer);
var
i, j: integer;
begin
if not assigned(VarListView.Selected) then exit;
if Source = VarListView then
begin
try
i := VarListView.Selected.Index;
j := VarListView.GetItemAt(X,Y).Index;
if (j >= 0) and (i >= 0) and (i <> j) then
ExchangeVars(i, j);
except
Beep;
end;
end;
end;
procedure TVarOrder.VarListViewDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := (Source = VarListView);
end;
end.

279
Forms/formPostProcess.dfm Normal file
View File

@ -0,0 +1,279 @@
object frmPostProcess: TfrmPostProcess
Left = 421
Top = 359
Caption = 'Post Render'
ClientHeight = 537
ClientWidth = 693
Color = clBtnFace
Constraints.MinHeight = 200
Constraints.MinWidth = 700
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
DesignSize = (
693
537)
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 693
Height = 81
Align = alTop
BevelOuter = bvNone
TabOrder = 0
DesignSize = (
693
81)
object pnlFilter: TPanel
Left = 8
Top = 32
Width = 110
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = 'Filter Radius'
TabOrder = 11
OnDblClick = DragPanelDblClick
OnMouseDown = DragPanelMouseDown
OnMouseMove = DragPanelMouseMove
OnMouseUp = DragPanelMouseUp
end
object pnlVibrancy: TPanel
Left = 337
Top = 32
Width = 95
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = 'Vibrancy'
TabOrder = 10
OnDblClick = DragPanelDblClick
OnMouseDown = DragPanelMouseDown
OnMouseMove = DragPanelMouseMove
OnMouseUp = DragPanelMouseUp
end
object pnlBrightness: TPanel
Left = 180
Top = 32
Width = 95
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = 'Brightness'
TabOrder = 8
OnDblClick = DragPanelDblClick
OnMouseDown = DragPanelMouseDown
OnMouseMove = DragPanelMouseMove
OnMouseUp = DragPanelMouseUp
end
object pnlContrast: TPanel
Left = 337
Top = 8
Width = 95
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = 'Contrast'
TabOrder = 9
OnDblClick = DragPanelDblClick
OnMouseDown = DragPanelMouseDown
OnMouseMove = DragPanelMouseMove
OnMouseUp = DragPanelMouseUp
end
object pnlGamma: TPanel
Left = 180
Top = 8
Width = 95
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = 'Gamma'
TabOrder = 7
OnDblClick = DragPanelDblClick
OnMouseDown = DragPanelMouseDown
OnMouseMove = DragPanelMouseMove
OnMouseUp = DragPanelMouseUp
end
object ProgressBar1: TProgressBar
Left = 8
Top = 61
Width = 682
Height = 20
Anchors = [akLeft, akRight, akBottom]
TabOrder = 15
end
object txtFilterRadius: TEdit
Left = 117
Top = 32
Width = 57
Height = 21
TabOrder = 2
OnKeyPress = EditKeyPress
end
object txtGamma: TEdit
Left = 274
Top = 8
Width = 57
Height = 21
TabOrder = 3
OnKeyPress = EditKeyPress
end
object txtVibrancy: TEdit
Left = 431
Top = 32
Width = 57
Height = 21
TabOrder = 6
OnKeyPress = EditKeyPress
end
object txtContrast: TEdit
Left = 431
Top = 8
Width = 57
Height = 21
TabOrder = 5
OnKeyPress = EditKeyPress
end
object txtBrightness: TEdit
Left = 274
Top = 32
Width = 57
Height = 21
TabOrder = 4
OnKeyPress = EditKeyPress
end
object pnlBackground: TPanel
Left = 495
Top = 8
Width = 100
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Background'
TabOrder = 12
OnDblClick = DragPanelDblClick
OnMouseDown = DragPanelMouseDown
OnMouseMove = DragPanelMouseMove
OnMouseUp = DragPanelMouseUp
end
object pnlBackColor: TPanel
Left = 600
Top = 8
Width = 57
Height = 21
Cursor = crHandPoint
BevelInner = bvRaised
BevelOuter = bvLowered
BorderStyle = bsSingle
TabOrder = 0
OnClick = pnlBackColorClick
object shBack: TShape
Left = 2
Top = 2
Width = 49
Height = 13
Align = alClient
Brush.Color = clBlack
Pen.Color = clWindow
Pen.Style = psClear
Pen.Width = 0
OnMouseUp = shBackMouseUp
ExplicitLeft = 0
end
end
object btnApply: TButton
Left = 535
Top = 32
Width = 97
Height = 25
Anchors = [akTop, akRight]
Caption = '&Apply'
Default = True
TabOrder = 13
OnClick = btnApplyClick
end
object pnlRelGamma: TPanel
Left = 8
Top = 8
Width = 110
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = 'Gamma Threshold'
TabOrder = 14
OnDblClick = DragPanelDblClick
OnMouseDown = DragPanelMouseDown
OnMouseMove = DragPanelMouseMove
OnMouseUp = DragPanelMouseUp
end
object txtRelGamma: TEdit
Left = 117
Top = 8
Width = 57
Height = 21
TabOrder = 1
OnKeyPress = EditKeyPress
end
end
object ScrollBox1: TScrollBox
Left = 8
Top = 88
Width = 689
Height = 417
Align = alCustom
Anchors = [akLeft, akTop, akRight, akBottom]
BevelInner = bvNone
BevelKind = bkSoft
BorderStyle = bsNone
Color = clAppWorkSpace
ParentColor = False
TabOrder = 1
object Image: TImage
Left = 0
Top = 0
Width = 687
Height = 415
Align = alClient
AutoSize = True
Center = True
Proportional = True
Stretch = True
end
end
object btnSave: TButton
Left = 588
Top = 510
Width = 97
Height = 25
Anchors = [akRight, akBottom]
Caption = '&Save'
TabOrder = 2
OnClick = btnSaveClick
end
object chkFitToWindow: TCheckBox
Left = 8
Top = 512
Width = 490
Height = 17
Anchors = [akLeft, akRight, akBottom]
Caption = 'Fit to window'
Checked = True
State = cbChecked
TabOrder = 3
Visible = False
OnClick = chkFitToWindowClick
end
object ColorDialog: TColorDialog
Left = 612
Top = 76
end
end

568
Forms/formPostProcess.pas Normal file
View File

@ -0,0 +1,568 @@
{
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 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,
Translation;
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
NewName: string; // AV
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;
{$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);
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.