Remove unused units

This commit is contained in:
ronaldhordijk 2005-09-11 17:16:01 +00:00
parent 5ff6758e7a
commit fafa848225
7 changed files with 2 additions and 2135 deletions

View File

@ -1,488 +0,0 @@
object GradientForm: TGradientForm
Left = 565
Top = 216
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'Gradient'
ClientHeight = 172
ClientWidth = 372
Color = clBtnFace
DragMode = dmAutomatic
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Icon.Data = {
0000010001001010000000000000680300001600000028000000100000002000
0000010018000000000040030000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000DA7F48DE7F46E68C56F1A273FDBA92FFCDB1FFE1CFFFF4EDE3F2FCA2
D5F862B9F339A1F0000000000000000000000000DA7D46DD7D41E68952F09F6F
FCB88FFFCDAFFFE1CEFFF4EEE2F2FD9FD4F85EB6F3349FF00000000000000000
00000000D97D45DD7C42E58750F09E6EFCB88FFFCCAFFFE0CEFFF4EDE2F2FD9F
D4F85DB6F4339FEF000000000000000000000000D97D45DD7D42E58851F09E6E
FCB88FFFCDAFFFE1CEFFF4EDE2F2FD9FD4F85DB6F3339FEF0000000000000000
00000000D97D45DD7D41E68851F09E6EFDB88FFFCCAFFFE1CEFFF4EDE2F2FD9F
D4F85EB6F3329FEF000000000000000000000000D97D45DD7C42E68851F19E6E
FDB78FFFCDAFFFE1CEFFF4EEE2F2FD9FD4F85EB6F4329FEF0000000000000000
00000000D97D45DD7D42E68851F19F6EFCB88FFFCCAFFFE0CEFFF4EDE1F2FD9F
D4F85DB7F3339FEF000000000000000000000000D97D45DD7D42E58850F19F6E
FDB78FFFCDAFFFE0CFFFF4EDE1F2FD9FD4F85DB6F3329FEF0000000000000000
00000000DA7D46DD7C41E68952F19E6EFDB88FFFCDAFFFE0CEFFF4EEE1F2FD9F
D4F85EB6F3339FF0000000000000000000000000DA7F48DE7F46E68C56F0A173
FCBA93FFCEB1FFE1D0FFF4EDE2F2FDA3D5F862B8F338A1F00000000000000000
00000000DB834EE08752E89563F3A97EFDC09CFFD2B8FFE4D4FFF5EFE4F3FDAA
D9F96FBEF449AAF1000000000000000000000000DD8A58E39565ECA57AF5B692
FDCAABFFD9C3FFE8DBFFF7F2E8F5FDB7DFFA85C8F763B6F20000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FFFF
0000800100008001000080010000800100008001000080010000800100008001
0000800100008001000080010000800100008001000080010000FFFF0000}
OldCreateOrder = True
Position = poDefault
OnClose = FormClose
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object pnlPalette: TPanel
Left = 0
Top = 0
Width = 372
Height = 102
Align = alClient
BevelOuter = bvLowered
TabOrder = 0
object GradientImage: TImage
Left = 1
Top = 1
Width = 370
Height = 100
Align = alClient
PopupMenu = PopupMenu
Stretch = True
OnDblClick = mnuRandomizeClick
end
end
object pnlControls: TPanel
Left = 0
Top = 102
Width = 372
Height = 70
Align = alBottom
BevelOuter = bvNone
TabOrder = 1
object btnMenu: TSpeedButton
Left = 8
Top = 10
Width = 57
Height = 22
Caption = 'Rotate'
Flat = True
PopupMenu = Popup
OnClick = btnMenuClick
end
object lblVal: TLabel
Left = 344
Top = 16
Width = 6
Height = 13
Caption = '0'
end
object btnOpen: TSpeedButton
Left = 312
Top = 40
Width = 23
Height = 22
Hint = 'Gradient Browser'
Flat = True
Glyph.Data = {
76030000424D7603000000000000360000002800000011000000100000000100
18000000000040030000120B0000120B00000000000000000000FF00FFFF00FF
0000000000000000000000000000000000000000000000000000000000000000
00000000000000FF00FFFF00FF00FF00FFFF00FF000000FFF5F0FFF1E9FFEFE6
FFEFE6FFF0E7FFF1E8FFF1E9FFF3EBFFF3ECFFF4EDFFF6F0000000FF00FFFF00
FF00FF00FFFF00FF000000FFF4EDFFEEE4FFEBDFFFEBDFFFEBE0FFECE2FFEDE2
FFEEE4FFEFE5FFEFE6FFF1EA000000FF00FFFF00FF00FF00FFFF00FF000000FF
F1E9CD5208CD5208CD5208CD5208CD5208CD5208CD5208CD5208CD5208FFEDE3
000000FF00FFFF00FF00FF00FFFF00FF000000FFEFE6CD5208E26518EB7A37FF
A772FFD1B2FFF7EDC2E9FF42ADF7CD5208FFE9DC000000FF00FFFF00FF00FF00
FFFF00FF000000FFEDE2CD5208E16519E97835FFA770FFD1B2FFF7ECC2E9FF40
ADF7CD5208FFE5D6000000FF00FFFF00FF00FF00FFFF00FF000000FFEBDFCD52
08E16518EB7836FFA770FFD1B2FFF7ECC2E9FF42ADF7CD5208FFE1D0000000FF
00FFFF00FF00FF00FFFF00FF000000FFE9DBCD5208E16519EC7935FFA770FFD0
B2FFF7ECC2E9FF40AEF7CD5208FFDFCD000000FF00FFFF00FF00FF00FFFF00FF
000000FFE7D8CD5208E16519EB7935FFA570FFD1B2FFF7ECC2E9FF40ADF7CD52
08FFE1D0000000FF00FFFF00FF00FF00FFFF00FF000000FFE4D5CD5208E3651A
EB7A39FFA874FFD1B3FFF7ECC4E9FF44AEF7CD5208FFE9DC000000FF00FFFF00
FF00FF00FFFF00FF000000FFE3D1CD5208ED7935F99457FFBC8DFFE1C5FFFFF9
000000000000000000000000000000FF00FFFF00FF00FF00FFFF00FF000000FF
E1CFCD5208CD5208CD5208CD5208CD5208CD5208000000E17D41EB925E000000
FF00FFFF00FFFF00FF00FF00FFFF00FF000000FFE2D1FFD7BFFFD0B4FFCEB1FF
CFB3FFD0B4FFD3B8000000F5A779000000FF00FFFF00FFFF00FFFF00FF00FF00
FFFF00FF000000FFE7DAFFE2D0FFDECBFFDECAFFDDC9FFDECAFFDFCD00000000
0000FF00FFFF00FFFF00FFFF00FFFF00FF00FF00FFFF00FF0000000000000000
00000000000000000000000000000000000000FF00FFFF00FFFF00FFFF00FFFF
00FFFF00FF00FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF00}
ParentShowHint = False
ShowHint = True
OnClick = btnOpenClick
end
object btnSmoothPalette: TSpeedButton
Left = 336
Top = 40
Width = 23
Height = 22
Hint = 'Smooth Palette'
Flat = True
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000FF00FFFF00FF000000
374BA83A53AB3E5DB14368B74876BF4E84C65493CE5BA3D661B2DE67C0E66CCE
EC71DAF3000000FF00FFFF00FF000000374BA83A53AB3E5DB14368B74876BF4E
84C65593CE5BA2D661B2DE67C0E66CCEED71DAF3000000FF00FFFF00FF000000
374BA83A52AC3E5DB14369B84876BE4F84C65593CE5BA3D661B1DE67C1E66CCD
ED71D9F3000000FF00FFFF00FF000000374BA83A53AB3E5CB14369B74876BE4E
84C65494CE5BA2D661B2DE66C1E56CCEEC71DAF3000000FF00FFFF00FF000000
374BA83A53AC3E5DB14368B74975BE4F84C65593CE5AA2D661B2DE67C0E56CCE
ED71D9F3000000FF00FFFF00FF000000374BA83A52AC3E5DB14368B84976BF4E
84C65493CE5BA3D661B2DE66C0E56CCEEC71D9F3000000FF00FFFF00FF000000
374BA83A52AC3E5CB14369B74975BE4F84C65494CD5BA2D661B1DE66C0E56CCE
ED71DAF3000000FF00FFFF00FF000000374BA83A53AC3E5CB14368B74876BF4E
84C65493CE5BA2D660B2DE67C0E56DCEEC71D9F3000000FF00FFFF00FF000000
374BA83A52AC3E5CB24368B74975BE4E84C65594CE5AA3D661B2DE67C1E66DCE
EC71D9F3000000FF00FFFF00FF000000374BA83A52AC3E5CB14369B74875BF4F
84C65493CE5AA3D661B2DE66C0E66DCEEC71DAF3000000FF00FFFF00FF000000
374BA83A52AC3E5DB14368B74976BF4F84C65593CE5BA3D660B2DE67C0E56CCD
ED71D9F3000000FF00FFFF00FF000000374BA83A53AC3E5CB14268B74876BF4F
84C65593CE5BA3D661B2DE67C1E66CCEED71DAF3000000FF00FFFF00FF000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentShowHint = False
ShowHint = True
OnClick = mnuSmoothPaletteClick
end
object Label1: TLabel
Left = 8
Top = 43
Width = 57
Height = 13
Alignment = taCenter
AutoSize = False
Caption = 'Preset'
end
object btnPaste: TSpeedButton
Left = 288
Top = 40
Width = 23
Height = 22
Flat = True
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF00000000
0000000000000000000000000000000000000000000000FF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFF000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF000000FF
FFFFE39A6FFFFFFFE3996CE2996DE3996DFFFFFF000000FF00FFFF00FFFF00FF
000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFF000000FF00FFFF00FF00000056B9F556B9F556B9F556B9F5000000FF
FFFFE29566E39363FFFFFFE39262E29363FFFFFF000000FF00FFFF00FF000000
56B9F556B9F556B9F556B9F5000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFF000000FF00FFFF00FF00000056B9F556B9F556B9F556B9F5000000FF
FFFFE3915FE28C58FFFFFFFFFFFFE29364FFFFFF000000FF00FFFF00FF000000
56B9F556B9F556B9F556B9F5000000FFFFFFFFFFFFFFFFFFFFFFFF0000000000
00000000000000FF00FFFF00FF00000056B9F556B9F556B9F556B9F5000000FF
FFFFE29160FFFFFFFFFFFF000000FFFFFF000000FF00FFFF00FFFF00FF000000
56B9F556B9F556B9F556B9F5000000FFFFFFFFFFFFFFFFFFFFFFFF0000000000
00FF00FFFF00FFFF00FFFF00FF00000056B9F500000000000000000000000000
0000000000000000000000000000000000FF00FFFF00FFFF00FFFF00FF000000
56B9F5000000BBE5F9BBE5F9BBE5F9BBE5F9BBE5F9BBE5F900000056B9F50000
00FF00FFFF00FFFF00FFFF00FF00000056B9F556B9F5000000BBE5F900000000
0000BBE5F900000056B9F556B9F5000000FF00FFFF00FFFF00FFFF00FFFF00FF
000000000000000000000000BBE5F9BBE5F9000000000000000000000000FF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF00000000000000
0000000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
OnClick = btnPasteClick
end
object btnCopy: TSpeedButton
Left = 264
Top = 40
Width = 23
Height = 22
Flat = True
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FF00000000000000000000000000000000
0000000000000000000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FF000000FFFFFFE39A6FFFFFFFE3996CE2
996DE3996DFFFFFF000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
000000FFFFFFFFFFFFFFFFFF0000000000000000000000000000000000000000
00000000000000FF00FFFF00FFFF00FF000000FFFFFFE29566E39363000000FF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF00FFFF00FFFF00FF
000000FFFFFFFFFFFFFFFFFF000000FFFFFFE39A6FFFFFFFE3996CE2996DE399
6DFFFFFF000000FF00FFFF00FFFF00FF000000FFFFFFE3915FE28C58000000FF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF00FFFF00FFFF00FF
000000FFFFFFFFFFFFFFFFFF000000FFFFFFE29566E39363FFFFFFE39262E293
63FFFFFF000000FF00FFFF00FFFF00FF000000FFFFFFE29160FFFFFF000000FF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF00FFFF00FFFF00FF
000000FFFFFFFFFFFFFFFFFF000000FFFFFFE3915FE28C58FFFFFFFFFFFFE293
64FFFFFF000000FF00FFFF00FFFF00FF000000000000000000000000000000FF
FFFFFFFFFFFFFFFFFFFFFF000000000000000000000000FF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FF000000FFFFFFE29160FFFFFFFFFFFF000000FFFF
FF000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF000000FF
FFFFFFFFFFFFFFFFFFFFFF000000000000FF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FF000000000000000000000000000000000000FF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
OnClick = btnCopyClick
end
object cmbPalette: TComboBox
Left = 72
Top = 42
Width = 177
Height = 19
Style = csOwnerDrawFixed
Color = clBlack
DropDownCount = 20
Font.Charset = ANSI_CHARSET
Font.Color = clWhite
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ItemHeight = 13
ParentFont = False
ParentShowHint = False
ShowHint = False
TabOrder = 1
OnChange = cmbPaletteChange
OnDrawItem = cmbPaletteDrawItem
Items.Strings = (
'south-sea-bather'
'sky-flesh'
'blue-bather'
'no-name'
'pillows'
'mauve-splat'
'facial-treescape 6'
'fasion-bug'
'leafy-face'
'mouldy-sun'
'sunny-harvest'
'peach-tree'
'fire-dragon'
'ice-dragon'
'german-landscape'
'no-name'
'living-mud-bomb'
'cars'
'unhealthy-tan'
'daffodil'
'rose'
'healthy-skin'
'orange'
'white-ivy'
'summer-makeup'
'glow-buzz'
'deep-water'
'afternoon-beach'
'dim-beach'
'cloudy-brick'
'burning-wood'
'aquatic-garden'
'no-name'
'fall-quilt'
'night-blue-sky'
'shadow-iris'
'solid-sky'
'misty-field'
'wooden-highlight'
'jet-tundra'
'pastel-lime'
'hell'
'indian-coast'
'dentist-decor'
'greenland'
'purple-dress'
'no-name'
'spring-flora'
'andi'
'gig-o835'
'rie02'
'rie05'
'rie11'
'etretat.ppm'
'the-hollow-needle-at-etretat.ppm'
'rouen-cathedral-sunset.ppm'
'the-houses-of-parliament.ppm'
'starry-night.ppm'
'water-lilies-sunset.ppm'
'gogh.chambre-arles.ppm'
'gogh.entrance.ppm'
'gogh.the-night-cafe.ppm'
'gogh.vegetable-montmartre.ppm'
'matisse.bonheur-vivre.ppm'
'matisse.flowers.ppm'
'matisse.lecon-musique.ppm'
'modigliani.nude-caryatid.ppm'
'braque.instruments.ppm'
'calcoast09.ppm'
'dodge102.ppm'
'ernst.anti-pope.ppm'
'ernst.ubu-imperator.ppm'
'fighting-forms.ppm'
'fog25.ppm'
'geyser27.ppm'
'gris.josette.ppm'
'gris.landscape-ceret.ppm'
'kandinsky.comp-9.ppm'
'kandinsky.yellow-red-blue.ppm'
'klee.insula-dulcamara.ppm'
'nile.ppm'
'picasso.jfille-chevre.ppm'
'pollock.lavender-mist.ppm'
'yngpaint.ppm')
end
object ScrollBar: TScrollBar
Left = 72
Top = 16
Width = 257
Height = 13
LargeChange = 15
Max = 255
PageSize = 0
TabOrder = 0
OnChange = ScrollBarChange
OnScroll = ScrollBarScroll
end
end
object PopupMenu: TPopupMenu
Images = MainForm.Buttons
Left = 8
Top = 8
object mnuRandomize: TMenuItem
Caption = 'Randomize'
OnClick = mnuRandomizeClick
end
object N7: TMenuItem
Caption = '-'
end
object mnuInvert: TMenuItem
Caption = 'Invert'
OnClick = mnuInvertClick
end
object mnuReverse: TMenuItem
Caption = '&Reverse'
OnClick = mnuReverseClick
end
object N3: TMenuItem
Caption = '-'
end
object mnuSmoothPalette: TMenuItem
Caption = 'Smooth Palette...'
ImageIndex = 34
OnClick = mnuSmoothPaletteClick
end
object mnuGradientBrowser: TMenuItem
Caption = 'Gradient Browser...'
ImageIndex = 22
OnClick = btnOpenClick
end
object N4: TMenuItem
Caption = '-'
end
object SaveGradient1: TMenuItem
Caption = 'Save Gradient...'
ImageIndex = 2
OnClick = SaveGradient1Click
end
object SaveasMapfile1: TMenuItem
Caption = 'Save as Map file...'
OnClick = SaveasMapfile1Click
end
object N6: TMenuItem
Caption = '-'
end
object mnuSaveasDefault: TMenuItem
Caption = 'Save as Default'
OnClick = mnuSaveasDefaultClick
end
object N5: TMenuItem
Caption = '-'
end
object mnuCopy: TMenuItem
Caption = 'Copy'
ImageIndex = 7
OnClick = btnCopyClick
end
object mnuPaste: TMenuItem
Caption = 'Paste'
ImageIndex = 8
OnClick = btnPasteClick
end
end
object Popup: TPopupMenu
AutoHotkeys = maManual
AutoPopup = False
Left = 40
Top = 8
object mnuRotate: TMenuItem
Caption = 'Rotate'
OnClick = mnuRotateClick
end
object N1: TMenuItem
Caption = '-'
end
object mnuHue: TMenuItem
Caption = 'Hue'
OnClick = mnuHueClick
end
object mnuSaturation: TMenuItem
Caption = 'Saturation'
OnClick = mnuSaturationClick
end
object mnuBrightness: TMenuItem
Caption = 'Brightness'
OnClick = mnuBrightnessClick
end
object Contrast1: TMenuItem
Caption = 'Contrast'
OnClick = Contrast1Click
end
object N2: TMenuItem
Caption = '-'
end
object mnuBlur: TMenuItem
Caption = 'Blur'
OnClick = mnuBlurClick
end
object mnuFrequency: TMenuItem
Caption = 'Frequency'
OnClick = mnuFrequencyClick
end
end
object SaveDialog: TSaveDialog
DefaultExt = 'map'
Filter = 'Map files|*.map'
Left = 72
Top = 8
end
object ApplicationEvents: TApplicationEvents
OnActivate = ApplicationEventsActivate
Left = 104
Top = 8
end
end

View File

@ -1,790 +0,0 @@
{
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 Gradient;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ComCtrls, Registry, cmap, Menus, ToolWin, Buttons,
AppEvnts;
const
PixelCountMax = 32768;
type
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..PixelCountMax - 1] of TRGBTriple;
type
TGradientForm = class(TForm)
pnlPalette: TPanel;
pnlControls: TPanel;
cmbPalette: TComboBox;
GradientImage: TImage;
PopupMenu: TPopupMenu;
mnuReverse: TMenuItem;
mnuInvert: TMenuItem;
btnMenu: TSpeedButton;
Popup: TPopupMenu;
mnuHue: TMenuItem;
mnuRotate: TMenuItem;
N1: TMenuItem;
mnuSaturation: TMenuItem;
mnuBrightness: TMenuItem;
N2: TMenuItem;
ScrollBar: TScrollBar;
lblVal: TLabel;
mnuBlur: TMenuItem;
btnOpen: TSpeedButton;
N3: TMenuItem;
mnuGradientBrowser: TMenuItem;
mnuSmoothPalette: TMenuItem;
btnSmoothPalette: TSpeedButton;
N4: TMenuItem;
SaveGradient1: TMenuItem;
SaveasMapfile1: TMenuItem;
SaveDialog: TSaveDialog;
Label1: TLabel;
btnPaste: TSpeedButton;
btnCopy: TSpeedButton;
N5: TMenuItem;
mnuCopy: TMenuItem;
mnuPaste: TMenuItem;
ApplicationEvents: TApplicationEvents;
mnuSaveasDefault: TMenuItem;
N6: TMenuItem;
mnuRandomize: TMenuItem;
N7: TMenuItem;
mnuFrequency: TMenuItem;
Contrast1: TMenuItem;
procedure cmbPaletteChange(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnApplyClick(Sender: TObject);
procedure DrawPalette;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure mnuReverseClick(Sender: TObject);
procedure mnuInvertClick(Sender: TObject);
procedure btnMenuClick(Sender: TObject);
procedure mnuRotateClick(Sender: TObject);
procedure mnuHueClick(Sender: TObject);
procedure mnuSaturationClick(Sender: TObject);
procedure ScrollBarChange(Sender: TObject);
procedure mnuBrightnessClick(Sender: TObject);
procedure mnuBlurClick(Sender: TObject);
procedure btnOpenClick(Sender: TObject);
procedure mnuSmoothPaletteClick(Sender: TObject);
procedure SaveGradient1Click(Sender: TObject);
procedure SaveasMapfile1Click(Sender: TObject);
procedure cmbPaletteDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure ScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
procedure btnCopyClick(Sender: TObject);
procedure btnPasteClick(Sender: TObject);
procedure ApplicationEventsActivate(Sender: TObject);
procedure mnuSaveasDefaultClick(Sender: TObject);
procedure mnuRandomizeClick(Sender: TObject);
procedure mnuFrequencyClick(Sender: TObject);
procedure Contrast1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure Apply;
function Blur(const radius: integer; const pal: TColorMap): TColorMap;
function Frequency(const times: Integer; const pal: TColorMap): TColorMap;
procedure SaveMap(FileName: string);
public
Palette: TColorMap;
BackupPal: TColorMap;
procedure UpdateGradient(Pal: TColorMap);
function RandomGradient: TColorMap;
end;
var
GradientForm: TGradientForm;
pCmap: integer;
function GradientInClipboard: boolean;
procedure RGBToHSV(R, G, B: byte; var H, S, V: real);
procedure HSVToRGB(H, S, V: real; var Rb, Gb, Bb: integer);
implementation
uses
RndFlame, Main, cmapdata, Math, Browser, Editor, Global,
Save, Adjust, Mutate, ClipBrd, GradientHlpr;
{$R *.DFM}
procedure TGradientForm.Apply;
begin
MainForm.StopThread;
MainForm.UpdateUndo;
MainCp.CmapIndex := cmbPalette.ItemIndex;
MainCp.cmap := 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 TGradientForm.SaveMap(FileName: string);
var
i: Integer;
l: string;
MapFile: TextFile;
begin
{ Save a map file }
AssignFile(MapFile, FileName);
try
ReWrite(MapFile);
{ first line with comment }
l := Format(' %3d %3d %3d Exported from Apophysis 2.0', [Palette[0][0], palette[0][1],
palette[0][2]]);
Writeln(MapFile, l);
{ now the rest }
for i := 1 to 255 do
begin
l := Format(' %3d %3d %3d', [Palette[i][0], palette[i][1],
palette[i][2]]);
Writeln(MapFile, l);
end;
CloseFile(MapFile);
except
on EInOutError do Application.MessageBox(PChar('Cannot Open File: ' +
FileName), 'Apophysis', 16);
end;
end;
procedure TGradientForm.UpdateGradient(Pal: TColorMap);
begin
Palette := Pal;
BackupPal := Pal;
DrawPalette;
ScrollBar.Position := 0;
end;
procedure HSVToRGB(H, S, V: real; var Rb, Gb, Bb: integer);
var
R, G, B, Sa, Va, Hue, i, f, p, q, t: real;
begin
R := 0;
G := 0;
B := 0;
Sa := S / 100;
Va := V / 100;
if S = 0 then
begin
R := Va;
G := Va;
B := Va;
end
else
begin
Hue := H / 60;
if Hue = 6 then Hue := 0;
i := Int(Hue);
f := Hue - i;
p := Va * (1 - Sa);
q := Va * (1 - (Sa * f));
t := Va * (1 - (Sa * (1 - f)));
case Round(i) of
0: begin
R := Va;
G := t;
B := p;
end;
1: begin
R := q;
G := Va;
B := p;
end;
2: begin
R := p;
G := Va;
B := t;
end;
3: begin
R := p;
G := q;
B := Va;
end;
4: begin
R := t;
G := p;
B := Va;
end;
5: begin
R := Va;
G := p;
B := q;
end;
end;
end;
Rb := Round(Int(255.9999 * R));
Gb := Round(Int(255.9999 * G));
Bb := Round(Int(255.9999 * B));
end;
procedure RGBToHSV(R, G, B: byte; var H, S, V: real);
var
vRed, vGreen, vBlue, Mx, Mn, Va, Sa, rc, gc, bc: real;
begin
vRed := R / 255;
vGreen := G / 255;
vBlue := B / 255;
Mx := vRed;
if vGreen > Mx then Mx := vGreen;
if vBlue > Mx then Mx := vBlue;
Mn := vRed;
if vGreen < Mn then Mn := vGreen;
if vBlue < Mn then Mn := vBlue;
Va := Mx;
if Mx <> 0 then
Sa := (Mx - Mn) / Mx
else
Sa := 0;
if Sa = 0 then
H := 0
else
begin
rc := (Mx - vRed) / (Mx - Mn);
gc := (Mx - vGreen) / (Mx - Mn);
bc := (Mx - vBlue) / (Mx - Mn);
if Mx = vRed then
H := bc - gc
else if Mx = vGreen then
H := 2 + rc - bc
else if Mx = vBlue then
H := 4 + gc - rc;
H := H * 60;
if H < 0 then H := H + 360;
end;
S := Sa * 100;
V := Va * 100;
end;
function TGradientForm.Blur(const Radius: Integer; const pal: TColorMap): TColorMap;
var
r, g, b, n, i, j, k: Integer;
begin
Result := Pal;
if Radius <> 0 then
for i := 0 to 255 do
begin
n := -1;
r := 0;
g := 0;
b := 0;
for j := i - radius to i + radius do
begin
inc(n);
k := (256 + j) mod 256;
if k <> i then begin
r := r + Pal[k][0];
g := g + Pal[k][1];
b := b + Pal[k][2];
end;
end;
if n <> 0 then begin
Result[i][0] := r div n;
Result[i][1] := g div n;
Result[i][2] := b div n;
end;
end;
end;
function TGradientForm.Frequency(const times: Integer; const pal: TColorMap): TColorMap;
{ This can be improved }
var
n, i, j: Integer;
begin
Result := Pal;
if times <> 1 then
begin
n := 256 div times;
for j := 0 to times do
for i := 0 to n do
begin
if (i + j * n) < 256 then
begin
Result[i + j * n][0] := pal[i * times][0];
Result[i + j * n][1] := pal[i * times][1];
Result[i + j * n][2] := pal[i * times][2];
end;
end;
end;
end;
procedure TGradientForm.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;
GradientImage.Picture.Graphic := Bitmap;
GradientImage.Refresh;
finally
BitMap.Free;
end;
end;
procedure TGradientForm.cmbPaletteChange(Sender: TObject);
var
i: integer;
begin
i := cmbPalette.ItemIndex;
GetCmap(i, 1, Palette);
BackupPal := Palette;
ScrollBar.Position := 0;
DrawPalette;
Apply;
end;
procedure TGradientForm.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\Gradient', False) then
begin
if Registry.ValueExists('Left') then
GradientForm.Left := Registry.ReadInteger('Left');
if Registry.ValueExists('Top') then
GradientForm.Top := Registry.ReadInteger('Top');
end;
Registry.CloseKey;
finally
Registry.Free;
end;
DrawPalette;
end;
procedure TGradientForm.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\Gradient', True) then
begin
Registry.WriteInteger('Top', GradientForm.Top);
Registry.WriteInteger('Left', GradientForm.Left);
end;
finally
Registry.Free;
end;
end;
procedure TGradientForm.btnApplyClick(Sender: TObject);
begin
Apply;
end;
procedure TGradientForm.mnuReverseClick(Sender: TObject);
var
i: integer;
pal: TColorMap;
begin
for i := 0 to 255 do begin
pal[i][0] := Palette[255 - i][0];
pal[i][1] := Palette[255 - i][1];
pal[i][2] := Palette[255 - i][2];
end;
UpdateGradient(pal);
Apply;
end;
procedure TGradientForm.mnuInvertClick(Sender: TObject);
var
i: integer;
begin
for i := 0 to 255 do
begin
Palette[i][0] := 255 - Palette[i][0];
Palette[i][1] := 255 - Palette[i][1];
Palette[i][2] := 255 - Palette[i][2];
end;
UpdateGradient(palette);
Apply;
end;
procedure TGradientForm.btnMenuClick(Sender: TObject);
begin
Popup.Popup(btnMenu.ClientOrigin.x, btnMenu.ClientOrigin.y + btnMenu.Height);
end;
procedure TGradientForm.ScrollBarChange(Sender: TObject);
var
intens, i, r, g, b: integer;
h, s, v: real;
begin
lblVal.Caption := IntToStr(ScrollBar.Position);
if btnMenu.Caption = 'Hue' then
begin
for i := 0 to 255 do
begin
RGBToHSV(BackupPal[i][0], BackupPal[i][1], BackupPal[i][2], h, s, v);
h := Round(360 + h + ScrollBar.Position) mod 360;
HSVToRGB(h, s, v, Palette[i][0], Palette[i][1], Palette[i][2]);
end;
end;
if btnMenu.Caption = 'Saturation' then
begin
for i := 0 to 255 do
begin
RGBToHSV(BackupPal[i][0], BackupPal[i][1], BackupPal[i][2], h, s, v);
s := s + ScrollBar.Position;
if s > 100 then s := 100;
if s < 0 then s := 0;
HSVToRGB(h, s, v, Palette[i][0], Palette[i][1], Palette[i][2]);
end;
end;
if btnMenu.Caption = 'Contrast' then
begin
intens := scrollBar.Position;
if intens > 0 then intens := intens * 2;
for i := 0 to 255 do
begin
r := BackupPal[i][0];
g := BackupPal[i][1];
b := BackupPal[i][2];
r := round(r + intens / 100 * (r - 127));
g := round(g + intens / 100 * (g - 127));
b := round(b + intens / 100 * (b - 127));
if R > 255 then R := 255 else if R < 0 then R := 0;
if G > 255 then G := 255 else if G < 0 then G := 0;
if B > 255 then B := 255 else if B < 0 then B := 0;
Palette[i][0] := r;
Palette[i][1] := g;
Palette[i][2] := b;
end;
end;
if btnMenu.Caption = 'Brightness' then
begin
for i := 0 to 255 do
begin
Palette[i][0] := BackupPal[i][0] + ScrollBar.Position;
if Palette[i][0] > 255 then Palette[i][0] := 255;
if Palette[i][0] < 0 then Palette[i][0] := 0;
Palette[i][1] := BackupPal[i][1] + ScrollBar.Position;
if Palette[i][1] > 255 then Palette[i][1] := 255;
if Palette[i][1] < 0 then Palette[i][1] := 0;
Palette[i][2] := BackupPal[i][2] + ScrollBar.Position;
if Palette[i][2] > 255 then Palette[i][2] := 255;
if Palette[i][2] < 0 then Palette[i][2] := 0;
end;
end;
if btnMenu.Caption = 'Rotate' then
begin
for i := 0 to 255 do
begin
Palette[i][0] := BackupPal[(255 + i - ScrollBar.Position) mod 256][0];
Palette[i][1] := BackupPal[(255 + i - ScrollBar.Position) mod 256][1];
Palette[i][2] := BackupPal[(255 + i - ScrollBar.Position) mod 256][2];
end;
end;
if btnMenu.Caption = 'Blur' then
begin
Palette := Blur(ScrollBar.Position, BackupPal);
end;
if btnMenu.Caption = 'Frequency' then
begin
Palette := Frequency(ScrollBar.Position, BackupPal);
end;
DrawPalette;
end;
{ ***************************** Adjust menu ********************************* }
procedure TGradientForm.mnuRotateClick(Sender: TObject);
begin
btnMenu.Caption := 'Rotate';
BackupPal := Palette;
ScrollBar.Min := 0;
ScrollBar.Max := 255;
ScrollBar.LargeChange := 15;
ScrollBar.Position := 0;
end;
procedure TGradientForm.mnuHueClick(Sender: TObject);
begin
btnMenu.Caption := 'Hue';
BackupPal := Palette;
ScrollBar.Min := 0;
ScrollBar.Max := 360;
ScrollBar.LargeChange := 15;
ScrollBar.Position := 0;
end;
procedure TGradientForm.mnuBrightnessClick(Sender: TObject);
begin
btnMenu.Caption := 'Brightness';
BackupPal := Palette;
ScrollBar.Min := -255;
ScrollBar.Max := 255;
ScrollBar.LargeChange := 15;
ScrollBar.Position := 0;
end;
procedure TGradientForm.mnuSaturationClick(Sender: TObject);
begin
btnMenu.Caption := 'Saturation';
BackupPal := Palette;
ScrollBar.Min := -100;
ScrollBar.Max := 100;
ScrollBar.LargeChange := 15;
ScrollBar.Position := 0;
end;
procedure TGradientForm.mnuBlurClick(Sender: TObject);
begin
btnMenu.Caption := 'Blur';
BackupPal := Palette;
ScrollBar.Min := 0;
ScrollBar.Max := 127;
ScrollBar.LargeChange := 15;
ScrollBar.Position := 0;
end;
procedure TGradientForm.mnuFrequencyClick(Sender: TObject);
begin
btnMenu.Caption := 'Frequency';
BackupPal := Palette;
ScrollBar.Min := 1;
ScrollBar.Max := 10;
ScrollBar.LargeChange := 1;
ScrollBar.Position := 1;
end;
procedure TGradientForm.btnOpenClick(Sender: TObject);
begin
GradientBrowser.Filename := GradientFile;
GradientBrowser.Show;
end;
procedure TGradientForm.mnuSmoothPaletteClick(Sender: TObject);
begin
MainForm.SmoothPalette;
end;
procedure TGradientForm.SaveGradient1Click(Sender: TObject);
var
gradstr: TStringList;
begin
gradstr := TStringList.Create;
try
SaveForm.Caption := 'Save Gradient';
SaveForm.Filename := GradientFile;
SaveForm.Title := MainCp.name;
if SaveForm.ShowModal = mrOK then
begin
gradstr.add(CleanIdentifier(SaveForm.Title) + ' {');
gradstr.add(MainForm.GradientFromPalette(Palette, SaveForm.Title));
gradstr.add('}');
if MainForm.SaveGradient(gradstr.text, SaveForm.Title, SaveForm.Filename) then
GradientFile := SaveForm.FileName;
end;
finally
gradstr.free
end;
end;
procedure TGradientForm.SaveasMapfile1Click(Sender: TObject);
begin
SaveDialog.Filename := MainCp.name + '.map';
if SaveDialog.execute then
SaveMap(SaveDialog.Filename);
end;
procedure TGradientForm.cmbPaletteDrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
i, j: integer;
Row: pRGBTripleArray;
Bitmap: TBitmap;
pal: TColorMap;
PalName: string;
begin
{ Draw the preset palettes on the combo box items }
GetCMap(index, 1, pal);
GetCmapName(index, PalName);
BitMap := TBitMap.create;
Bitmap.PixelFormat := pf24bit;
BitMap.Width := 256;
BitMap.Height := 100;
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;
with Control as TComboBox do
begin
Canvas.Rectangle(Rect);
Canvas.TextOut(4, Rect.Top, PalName);
Rect.Left := (Rect.Left + rect.Right) div 2;
Canvas.StretchDraw(Rect, Bitmap);
end;
BitMap.Free;
end;
procedure TGradientForm.ScrollBarScroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
if ScrollCode = scEndScroll then Apply;
end;
procedure TGradientForm.btnCopyClick(Sender: TObject);
var
gradstr: TStringList;
begin
gradstr := TStringList.Create;
try
gradstr.add(CleanIdentifier(MainCp.name) + ' {');
gradstr.add('gradient:');
gradstr.add(' title="' + MainCp.name + '" smooth=no');
gradstr.add(GradientString(Palette));
gradstr.add('}');
Clipboard.SetTextBuf(PChar(gradstr.text));
btnPaste.enabled := true;
mnuPaste.enabled := true;
// MainForm.btnPaste.enabled := False;
MainForm.mnuPaste.enabled := False;
finally
gradstr.free
end;
end;
procedure TGradientForm.btnPasteClick(Sender: TObject);
begin
if Clipboard.HasFormat(CF_TEXT) then
begin
UpdateGradient(CreatePalette(Clipboard.AsText));
Apply;
end;
end;
function GradientInClipboard: boolean;
var
gradstr: TStringList;
begin
{ returns true if gradient in clipboard - can be tricked }
result := true;
if Clipboard.HasFormat(CF_TEXT) then
begin
gradstr := TStringList.Create;
try
gradstr.text := Clipboard.AsText;
if (Pos('}', gradstr.text) = 0) or (Pos('{', gradstr.text) = 0) or
(Pos('gradient:', gradstr.text) = 0) or (Pos('fractal:', gradstr.text) <> 0) then
begin
result := false;
exit;
end;
finally
gradstr.free;
end;
end
else
result := false;
end;
procedure TGradientForm.ApplicationEventsActivate(Sender: TObject);
begin
if GradientInClipboard then begin
mnuPaste.enabled := true;
btnPaste.enabled := true;
end
else
begin
mnuPaste.enabled := false;
btnPaste.enabled := false;
end;
end;
procedure TGradientForm.mnuSaveasDefaultClick(Sender: TObject);
begin
DefaultPalette := Palette;
SaveMap(AppPath + 'default.map');
end;
function TGradientForm.RandomGradient: TColorMap;
begin
Result := GradientHelper.RandomGradient;
end;
procedure TGradientForm.mnuRandomizeClick(Sender: TObject);
begin
GradientForm.UpdateGradient(RandomGradient);
GradientForm.Apply;
end;
procedure TGradientForm.Contrast1Click(Sender: TObject);
begin
btnMenu.Caption := 'Contrast';
BackupPal := Palette;
ScrollBar.Min := -100;
ScrollBar.Max := 100;
ScrollBar.LargeChange := 15;
ScrollBar.Position := 0;
end;
procedure TGradientForm.FormCreate(Sender: TObject);
begin
Sendmessage(cmbPalette.Handle, CB_SETDROPPEDWIDTH , cmbPalette.width * 2, 0);
end;
end.

View File

@ -377,7 +377,7 @@ uses
{$ENDIF}
Editor, Options, Regstry, Render,
FullScreen, FormRender, Mutate, Adjust, Browser, Save, About, CmapData,
HtmlHlp, ScriptForm, FormFavorites, Size, FormExport, msMultiPartFormData,
HtmlHlp, ScriptForm, FormFavorites, FormExport, msMultiPartFormData,
ImageColoring, RndFlame;
{$R *.DFM}

View File

@ -1,609 +0,0 @@
{
Flame screensaver Copyright (C) 2002 Ronald Hordijk
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 Render32;
interface
uses
Windows, Graphics,
Render, Controlpoint;
type
TOnProgress = procedure(prog: double) of object;
type
TColorMapColor = Record
Red : Integer;
Green: Integer;
Blue : Integer;
// Count: Integer;
end;
PColorMapColor = ^TColorMapColor;
TColorMapArray = array[0..255] of TColorMapColor;
TBucket = Record
Red : Integer;
Green: Integer;
Blue : Integer;
Count: Integer;
end;
PBucket = ^TBucket;
TBucketArray = array of TBucket;
PLongintArray = ^TLongintArray;
TLongintArray = array[0..0] of Longint;
PByteArray = ^TByteArray;
TByteArray = array[0..0] of Byte;
type
TRenderer32 = class(TBaseRenderer)
private
bm: TBitmap;
oversample: Integer;
filter_width: Integer;
filter: array of array of extended;
image_Width: Integer;
image_Height: Integer;
BucketWidth: Integer;
BucketHeight: Integer;
BucketSize: Integer;
gutter_width: Integer;
sample_density: extended;
Buckets: TBucketArray;
ColorMap: TColorMapArray;
bg: array[0..2] of extended;
vib_gam_n: Integer;
vibrancy: double;
gamma: double;
bounds: array[0..3] of extended;
size: array[0..1] of extended;
ppux, ppuy: extended;
procedure CreateFilter;
procedure NormalizeFilter;
procedure InitValues;
procedure InitBuffers;
procedure InitBitmap(w: Integer = 0; h: Integer = 0);
procedure ClearBuffers;
procedure ClearBuckets;
procedure CreateColorMap;
procedure CreateCamera;
procedure AddPointsToBuckets(const points: TPointsArray); overload;
procedure AddPointsToBucketsAngle(const points: TPointsArray); overload;
procedure SetPixels;
procedure CreateBMFromBuckets(YOffset: Integer = 0);
public
constructor Create; override;
destructor Destroy; override;
function GetImage: TBitmap; override;
procedure Render; override;
end;
implementation
uses
Math, Sysutils;
{ TRenderer32 }
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.ClearBuckets;
var
i: integer;
begin
for i := 0 to BucketSize - 1 do begin
buckets[i].Red := 0;
buckets[i].Green := 0;
buckets[i].Blue := 0;
buckets[i].Count := 0;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.ClearBuffers;
begin
ClearBuckets;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.CreateCamera;
var
scale: double;
t0, t1: double;
corner0, corner1: double;
shift: Integer;
begin
scale := power(2, fcp.zoom);
sample_density := fcp.sample_density * scale * scale;
ppux := fcp.pixels_per_unit * scale;
ppuy := fcp.pixels_per_unit * scale;
// todo field stuff
shift := 0;
t0 := gutter_width / (oversample * ppux);
t1 := gutter_width / (oversample * ppuy);
corner0 := fcp.center[0] - image_width / ppux / 2.0;
corner1 := fcp.center[1] - image_height / ppuy / 2.0;
bounds[0] := corner0 - t0;
bounds[1] := corner1 - t1 + shift;
bounds[2] := corner0 + image_width / ppux + t0;
bounds[3] := corner1 + image_height / ppuy + t1; //+ shift;
if abs(bounds[2] - bounds[0]) > 0.01 then
size[0] := 1.0 / (bounds[2] - bounds[0])
else
size[0] := 1;
if abs(bounds[3] - bounds[1]) > 0.01 then
size[1] := 1.0 / (bounds[3] - bounds[1])
else
size[1] := 1;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.CreateColorMap;
var
i: integer;
begin
for i := 0 to 255 do begin
ColorMap[i].Red := (fcp.CMap[i][0] * fcp.white_level) div 256;
ColorMap[i].Green := (fcp.CMap[i][1] * fcp.white_level) div 256;
ColorMap[i].Blue := (fcp.CMap[i][2] * fcp.white_level) div 256;
// cmap[i][3] := fcp.white_level;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.CreateFilter;
var
i, j: integer;
fw: integer;
adjust: double;
ii, jj: double;
begin
oversample := fcp.spatial_oversample;
fw := Trunc(2.0 * FILTER_CUTOFF * oversample * fcp.spatial_filter_radius);
filter_width := fw + 1;
// make sure it has same parity as oversample
if odd(filter_width + oversample) then
inc(filter_width);
if (fw > 0.0) then
adjust := (1.0 * FILTER_CUTOFF * filter_width) / fw
else
adjust := 1.0;
setLength(filter, filter_width, filter_width);
for i := 0 to filter_width - 1 do begin
for j := 0 to filter_width - 1 do begin
ii := ((2.0 * i + 1.0)/ filter_width - 1.0) * adjust;
jj := ((2.0 * j + 1.0)/ filter_width - 1.0) * adjust;
filter[i, j] := exp(-2.0 * (ii * ii + jj * jj));
end;
end;
Normalizefilter;
end;
///////////////////////////////////////////////////////////////////////////////
destructor TRenderer32.Destroy;
begin
if assigned(bm) then
bm.Free;
inherited;
end;
///////////////////////////////////////////////////////////////////////////////
function TRenderer32.GetImage: TBitmap;
begin
Result := bm;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.InitBuffers;
begin
gutter_width := (filter_width - oversample) div 2;
BucketHeight := oversample * image_height + 2 * gutter_width;
Bucketwidth := oversample * image_width + 2 * gutter_width;
BucketSize := BucketWidth * BucketHeight;
if high(buckets) <> (BucketSize - 1) then begin
SetLength(buckets, BucketSize);
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.InitValues;
begin
image_height := fcp.Height;
image_Width := fcp.Width;
CreateFilter;
CreateCamera;
InitBuffers;
CreateColorMap;
vibrancy := 0;
gamma := 0;
vib_gam_n := 0;
bg[0] := 0;
bg[1] := 0;
bg[2] := 0;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.NormalizeFilter;
var
i, j: integer;
t: double;
begin
t := 0;
for i := 0 to filter_width - 1 do
for j := 0 to filter_width - 1 do
t := t + filter[i, j];
for i := 0 to filter_width - 1 do
for j := 0 to filter_width - 1 do
filter[i, j] := filter[i, j] / t;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.AddPointsToBuckets(const points: TPointsArray);
var
i: integer;
px, py: double;
bws, bhs: double;
bx, by: double;
wx, wy: double;
// R: double;
// V1, v2, v3: integer;
Bucket: PBucket;
MapColor: PColorMapColor;
begin
bws := (BucketWidth - 0.5) * size[0];
bhs := (BucketHeight - 0.5) * size[1];
bx := bounds[0];
by := bounds[1];
wx := bounds[2] - bounds[0];
wy := bounds[3] - bounds[1];
for i := SUB_BATCH_SIZE - 1 downto 0 do begin
if FStop then
Exit;
px := points[i].x - bx;
py := points[i].y - by;
if ((px < 0) or (px > wx) or
(py < 0) or (py > wy)) then
continue;
MapColor := @ColorMap[Round(points[i].c * 255)];
Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth];
Inc(Bucket.Red, MapColor.Red);
Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
Inc(Bucket.Count);
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.AddPointsToBucketsAngle(const points: TPointsArray);
var
i: integer;
px, py: double;
ca,sa: double;
nx, ny: double;
bws, bhs: double;
bx, by: double;
wx, wy: double;
// R: double;
// V1, v2, v3: integer;
Bucket: PBucket;
MapColor: PColorMapColor;
begin
bws := (BucketWidth - 0.5) * size[0];
bhs := (BucketHeight - 0.5) * size[1];
bx := bounds[0];
by := bounds[1];
wx := bounds[2] - bounds[0];
wy := bounds[3] - bounds[1];
ca := cos(FCP.FAngle);
sa := sin(FCP.FAngle);
for i := SUB_BATCH_SIZE - 1 downto 0 do begin
if FStop then
Exit;
px := points[i].x - FCP.Center[0];
py := points[i].y - FCP.Center[1];
nx := px * ca + py * sa;
ny := -px * sa + py * ca;
px := nx + FCP.Center[0] - bx;
py := ny + FCP.Center[1] - by;
if ((px < 0) or (px > wx) or
(py < 0) or (py > wy)) then
continue;
MapColor := @ColorMap[Round(points[i].c * 255)];
Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth];
Inc(Bucket.Red, MapColor.Red);
Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
Inc(Bucket.Count);
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.SetPixels;
var
i: integer;
nsamples: Int64;
nrbatches: Integer;
points: TPointsArray;
begin
SetLength(Points, SUB_BATCH_SIZE);
nsamples := Round(sample_density * bucketSize / (oversample * oversample));
nrbatches := Round(nsamples / (fcp.nbatches * SUB_BATCH_SIZE));
Randomize;
for i := 0 to nrbatches do begin
if FStop then
Exit;
if (i and $F = 0) then
Progress(i / nrbatches);
// generate points
case Compatibility of
0: fcp.iterate_Old(SUB_BATCH_SIZE, points);
1: fcp.iterateXYC(SUB_BATCH_SIZE, points);
end;
if FCP.FAngle = 0 then
AddPointsToBuckets(points)
else
AddPointsToBucketsAngle(points);
end;
Progress(1);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.CreateBMFromBuckets(YOffset: Integer);
var
i, j: integer;
alpha: double;
// r,g,b: double;
ai, ri, gi, bi: Integer;
bgtot: Integer;
ls: double;
ii, jj: integer;
fp: array[0..3] of double;
Row: PLongintArray;
vib, notvib: Integer;
bgi: array[0..2] of Integer;
bucketpos: Integer;
filterValue: double;
filterpos: Integer;
lsa: array[0..1024] of double;
var
k1, k2: double;
area: double;
begin
if fcp.gamma = 0 then
gamma := fcp.gamma
else
gamma := 1 / fcp.gamma;
vib := round(fcp.vibrancy * 256.0);
notvib := 256 - vib;
bgi[0] := round(fcp.background[0]);
bgi[1] := round(fcp.background[1]);
bgi[2] := round(fcp.background[2]);
bgtot := RGB(bgi[2], bgi[1], bgi[0]);
k1 := (fcp.Contrast * BRIGHT_ADJUST * fcp.brightness * 268 * PREFILTER_WHITE) / 256.0;
area := image_width * image_height / (ppux * ppuy);
k2 := (oversample * oversample) / (fcp.Contrast * area * fcp.White_level * sample_density);
lsa[0] := 0;
for i := 1 to 1024 do begin
lsa[i] := (k1 * log10(1 + fcp.White_level * i * k2)) / (fcp.White_level * i);
end;
if filter_width > 1 then begin
for i := 0 to BucketWidth * BucketHeight - 1 do begin
if Buckets[i].count = 0 then
Continue;
ls := lsa[Min(1023, Buckets[i].Count)];
Buckets[i].Red := Round(Buckets[i].Red * ls);
Buckets[i].Green := Round(Buckets[i].Green * ls);
Buckets[i].Blue := Round(Buckets[i].Blue * ls);
Buckets[i].Count := Round(Buckets[i].Count * ls);
end;
end;
bm.PixelFormat := pf32bit;
ls := 0;
ai := 0;
bucketpos := 0;
for i := 0 to Image_Height - 1 do begin
if FStop then
Break;
Progress(i / Image_Height);
Row := PLongintArray(bm.scanline[YOffset + i]);
for j := 0 to Image_Width - 1 do begin
if filter_width > 1 then begin
fp[0] := 0;
fp[1] := 0;
fp[2] := 0;
fp[3] := 0;
for ii := 0 to filter_width - 1 do begin
for jj := 0 to filter_width - 1 do begin
filterValue := filter[ii, jj];
filterpos := bucketpos + ii * BucketWidth + jj;
fp[0] := fp[0] + filterValue * Buckets[filterpos].Red;
fp[1] := fp[1] + filterValue * Buckets[filterpos].Green;
fp[2] := fp[2] + filterValue * Buckets[filterpos].Blue;
fp[3] := fp[3] + filterValue * Buckets[filterpos].Count;
end;
end;
fp[0] := fp[0] / PREFILTER_WHITE;
fp[1] := fp[1] / PREFILTER_WHITE;
fp[2] := fp[2] / PREFILTER_WHITE;
fp[3] := fcp.white_level * fp[3] / PREFILTER_WHITE;
end else begin
ls := lsa[Min(1023, Buckets[bucketpos].count)] / PREFILTER_WHITE;
fp[0] := ls * Buckets[bucketpos].Red;
fp[1] := ls * Buckets[bucketpos].Green;
fp[2] := ls * Buckets[bucketpos].Blue;
fp[3] := ls * Buckets[bucketpos].Count * fcp.white_level;
end;
Inc(bucketpos, oversample);
if (fp[3] > 0.0) then begin
alpha := power(fp[3], gamma);
ls := vib * alpha / fp[3];
ai := round(alpha * 256);
if (ai < 0) then
ai := 0
else if (ai > 256) then
ai := 256;
ai := 256 - ai;
end else begin
// no intensity so simply set the BG;
Row[j] := bgtot;
continue;
end;
if (notvib > 0) then
ri := Round(ls * fp[0] + notvib * power(fp[0], gamma))
else
ri := Round(ls * fp[0]);
ri := ri + (ai * bgi[0]) shr 8;
if (ri < 0) then
ri := 0
else if (ri > 255) then
ri := 255;
if (notvib > 0) then
gi := Round(ls * fp[1] + notvib * power(fp[1], gamma))
else
gi := Round(ls * fp[1]);
gi := gi + (ai * bgi[1]) shr 8;
if (gi < 0) then
gi := 0
else if (gi > 255) then
gi := 255;
if (notvib > 0) then
bi := Round(ls * fp[2] + notvib * power(fp[2], gamma))
else
bi := Round(ls * fp[2]);
bi := bi + (ai * bgi[2]) shr 8;
if (bi < 0) then
bi := 0
else if (bi > 255) then
bi := 255;
Row[j] := RGB(bi, gi, ri);
end;
Inc(bucketpos, 2 * gutter_width);
Inc(bucketpos, (oversample - 1) * BucketWidth);
end;
bm.PixelFormat := pf24bit;
Progress(1);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.InitBitmap(w, h: Integer);
begin
if not Assigned(bm) then
bm := TBitmap.Create;
bm.PixelFormat := pf32bit;
if (w <> 0) and (h <> 0) then begin
bm.Width := w;
bm.Height := h;
end else begin
bm.Width := image_Width;
bm.Height := image_Height;
end;
end;
///////////////////////////////////////////////////////////////////////////////
constructor TRenderer32.Create;
begin
inherited Create;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.Render;
begin
FStop := False;
InitValues;
InitBitmap;
ClearBuffers;
SetPixels;
CreateBMFromBuckets;
end;
///////////////////////////////////////////////////////////////////////////////
end.

View File

@ -23,7 +23,7 @@ uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ControlPoint, Buttons, ComCtrls, ToolWin,
Menus, atScript, atPascal, AdvMemo, Advmps, XFormMan, XForm, GradientHlpr,
cmap, Gradient;
cmap;
const NCPS = 10;
type

View File

@ -1,70 +0,0 @@
object SizeTool: TSizeTool
Left = 330
Top = 199
BorderStyle = bsDialog
Caption = 'Image Size'
ClientHeight = 113
ClientWidth = 152
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
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 18
Top = 23
Width = 28
Height = 13
Caption = '&Width'
FocusControl = txtWidth
end
object Bevel: TBevel
Left = 8
Top = 8
Width = 137
Height = 97
Shape = bsFrame
end
object Label2: TLabel
Left = 18
Top = 47
Width = 34
Height = 13
Caption = '&Height:'
FocusControl = txtHeight
end
object txtWidth: TEdit
Left = 64
Top = 20
Width = 70
Height = 21
TabOrder = 0
OnChange = txtWidthChange
OnKeyPress = txtWidthKeyPress
end
object txtHeight: TEdit
Left = 64
Top = 44
Width = 70
Height = 21
TabOrder = 1
OnChange = txtHeightChange
OnKeyPress = txtHeightKeyPress
end
object chkMaintain: TCheckBox
Left = 16
Top = 76
Width = 121
Height = 17
Caption = '&Maintain aspect ratio'
TabOrder = 2
OnClick = chkMaintainClick
end
end

View File

@ -1,176 +0,0 @@
{
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 Size;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TSizeTool = class(TForm)
Label1: TLabel;
txtWidth: TEdit;
Bevel: TBevel;
txtHeight: TEdit;
Label2: TLabel;
chkMaintain: TCheckBox;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure txtHeightKeyPress(Sender: TObject; var Key: Char);
procedure txtWidthKeyPress(Sender: TObject; var Key: Char);
procedure chkMaintainClick(Sender: TObject);
procedure txtWidthChange(Sender: TObject);
procedure txtHeightChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
SizeTool: TSizeTool;
ImageHeight, ImageWidth: integer;
ratio: double;
xdif, ydif: integer;
implementation
uses Main, Registry, Global;
{$R *.DFM}
procedure TSizeTool.FormShow(Sender: TObject);
var
Registry: TRegistry;
begin
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('Software\' + APP_NAME + '\Forms\SizeTool', False) then
begin
if Registry.ValueExists('Left') then
SizeTool.Left := Registry.ReadInteger('Left');
if Registry.ValueExists('Top') then
SizeTool.Top := Registry.ReadInteger('Top');
end;
Registry.CloseKey;
finally
Registry.Free;
end;
txtWidth.text := IntToStr(MainForm.Image.Width);
txtHeight.text := IntToStr(MainForm.Image.Height);
end;
procedure AdjustWindow;
var
xtot, ytot: integer;
begin
xtot := ImageWidth + xdif;
ytot := ImageHeight + ydif;
if xtot > Screen.Width then
begin
MainForm.Left := 0;
xtot := Screen.width;
end;
if ytot > Screen.height then
begin
MainForm.Top := 0;
ytot := Screen.height;
end;
MainForm.Width := xtot;
MainForm.Height := ytot;
end;
procedure TSizeTool.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\SizeTool', True) then
begin
Registry.WriteInteger('Top', SizeTool.Top);
Registry.WriteInteger('Left', SizeTool.Left);
end;
finally
Registry.Free;
end;
end;
procedure TSizeTool.FormActivate(Sender: TObject);
begin
xdif := MainForm.Width - MainForm.Image.Width;
ydif := MainForm.Height - MainForm.Image.Height;
end;
procedure TSizeTool.txtHeightKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
begin
key := #0;
AdjustWindow;
end;
end;
procedure TSizeTool.txtWidthKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
begin
key := #0;
AdjustWindow;
end;
end;
procedure TSizeTool.chkMaintainClick(Sender: TObject);
begin
Ratio := ImageWidth / ImageHeight;
end;
procedure TSizeTool.txtWidthChange(Sender: TObject);
begin
try
ImageWidth := StrToInt(txtWidth.Text);
if chkMaintain.checked and txtWidth.Focused then
begin
ImageHeight := Round(ImageWidth / ratio);
txtHeight.Text := IntToStr(ImageHeight)
end;
except
end;
end;
procedure TSizeTool.txtHeightChange(Sender: TObject);
begin
try
ImageHeight := StrToInt(txtHeight.Text);
if chkMaintain.checked and txtHeight.Focused then
begin
ImageWidth := Round(ImageHeight * ratio);
txtWidth.Text := IntToStr(ImageWidth)
end;
except
end;
end;
end.