Initial release 2.02f
This commit is contained in:
ronaldhordijk
509
2.02f/Source/Browser.pas
Normal file
509
2.02f/Source/Browser.pas
Normal file
@ -0,0 +1,509 @@
|
||||
{
|
||||
Apophysis Copyright (C) 2001-2004 Mark Townsend
|
||||
|
||||
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, ControlPoint, ToolWin, ImgList, Render, StdCtrls,
|
||||
Cmap, Menus, Global, Buttons;
|
||||
|
||||
const
|
||||
PixelCountMax = 32768;
|
||||
|
||||
type
|
||||
TGradientBrowser = class(TForm)
|
||||
RightPanel: TPanel;
|
||||
SmallImages: TImageList;
|
||||
ListView: TListView;
|
||||
pnlMain: TPanel;
|
||||
PopupMenu: TPopupMenu;
|
||||
DeleteItem: TMenuItem;
|
||||
RenameItem: TMenuItem;
|
||||
btnDefGradient: TSpeedButton;
|
||||
btnCancel: TButton;
|
||||
pnlPreview: TPanel;
|
||||
Image: TImage;
|
||||
pnlControls: TPanel;
|
||||
OpenDialog: TOpenDialog;
|
||||
LargeImages: TImageList;
|
||||
procedure ListViewChange(Sender: TObject; Item: TListItem;
|
||||
Change: TItemChange);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(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 SpeedButton1Click(Sender: TObject);
|
||||
procedure ListViewKeyPress(Sender: TObject; var Key: Char);
|
||||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
private
|
||||
procedure DrawPalette;
|
||||
procedure Apply;
|
||||
public
|
||||
PreviewDensity: double;
|
||||
FlameIndex, GradientIndex: Integer;
|
||||
Extension, Identifier, Filename: string;
|
||||
cp: TControlPoint;
|
||||
Palette: TColorMap;
|
||||
zoom: double;
|
||||
Center: array[0..1] of double;
|
||||
Render: TRenderer;
|
||||
procedure ListFileContents;
|
||||
function LoadFractintMap(filen: string): TColorMap;
|
||||
end;
|
||||
|
||||
type
|
||||
EFormatInvalid = class(Exception);
|
||||
pRGBTripleArray = ^TRGBTripleArray;
|
||||
TRGBTripleArray = array[0..PixelCountMax - 1] of TRGBTriple;
|
||||
|
||||
var
|
||||
GradientBrowser: TGradientBrowser;
|
||||
FlameString: string;
|
||||
|
||||
function CreatePalette(strng: string): TColorMap;
|
||||
|
||||
implementation
|
||||
|
||||
uses Main, Options, Editor, Gradient, Registry, Adjust, Mutate;
|
||||
|
||||
{$R *.DFM}
|
||||
|
||||
|
||||
procedure RGBBlend(a, b: integer; var Palette: TColorMap);
|
||||
{ Linear blend between to indices of a palette }
|
||||
var
|
||||
c, v: real;
|
||||
vrange, range: real;
|
||||
i: integer;
|
||||
begin
|
||||
if a = b then
|
||||
begin
|
||||
Exit;
|
||||
end;
|
||||
range := b - a;
|
||||
vrange := Palette[b mod 256][0] - Palette[a mod 256][0];
|
||||
c := Palette[a mod 256][0];
|
||||
v := vrange / range;
|
||||
for i := (a + 1) to (b - 1) do
|
||||
begin
|
||||
c := c + v;
|
||||
Palette[i mod 256][0] := Round(c);
|
||||
end;
|
||||
vrange := Palette[b mod 256][1] - Palette[a mod 256][1];
|
||||
c := Palette[a mod 256][1];
|
||||
v := vrange / range;
|
||||
for i := a + 1 to b - 1 do
|
||||
begin
|
||||
c := c + v;
|
||||
Palette[i mod 256][1] := Round(c);
|
||||
end;
|
||||
vrange := Palette[b mod 256][2] - Palette[a mod 256][2];
|
||||
c := Palette[a mod 256][2];
|
||||
v := vrange / range;
|
||||
for i := a + 1 to b - 1 do
|
||||
begin
|
||||
c := c + v;
|
||||
Palette[i mod 256][2] := Round(c);
|
||||
end;
|
||||
end;
|
||||
|
||||
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('Cannot Open File: ' +
|
||||
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
|
||||
index := StrToInt(Indices[i]);
|
||||
index := Round(Index * (255 / 399));
|
||||
indices[i] := IntToStr(index);
|
||||
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);
|
||||
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
|
||||
begin
|
||||
// Result := False;
|
||||
end;
|
||||
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
|
||||
PreviewDensity := prevMediumQuality;
|
||||
cp := TControlPoint.Create;
|
||||
cp.gamma := defGamma;
|
||||
cp.brightness := defBrightness;
|
||||
cp.vibrancy := defVibrancy;
|
||||
cp.spatial_oversample := defOversample;
|
||||
cp.spatial_filter_radius := defFilterRadius;
|
||||
Render := TRenderer.Create;
|
||||
FlameIndex := 0;
|
||||
GradientIndex := 0;
|
||||
end;
|
||||
|
||||
procedure TGradientBrowser.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
Render.Free;
|
||||
cp.Free;
|
||||
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('Are you sure you want to permanently delete' + ' "'
|
||||
+ 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;
|
||||
|
||||
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 RenameIFS(Item.Caption, s, Filename) then
|
||||
// s := Item.Caption;
|
||||
end;
|
||||
|
||||
procedure TGradientBrowser.btnDefGradientClick(Sender: TObject);
|
||||
begin
|
||||
OpenDialog.InitialDir := BrowserPath;
|
||||
OpenDialog.FileName := '';
|
||||
if OpenDialog.Execute then
|
||||
begin
|
||||
Filename := OpenDialog.FileName;
|
||||
GradientFile := Filename;
|
||||
BrowserPath := ExtractFilePath(OpenDialog.FileName);
|
||||
ListFileContents;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGradientBrowser.Apply;
|
||||
begin
|
||||
MainForm.StopThread;
|
||||
MainForm.UpdateUndo;
|
||||
MainCp.cmap := Palette;
|
||||
gradientForm.UpdateGradient(Palette);
|
||||
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.SpeedButton1Click(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;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user