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

begin fractalization

Browse Source
This commit is contained in:
ronaldhordijk 2005-03-20 18:34:15 +00:00
parent 665af685f9
commit 2834a2a458
3 changed files with 515 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
2.02g/Source/GradientHlpr.pas Normal file
View File

@ -0,0 +1,62 @@
unit GradientHlpr;
interface
uses
windows, Graphics;
const
PixelCountMax = 32768;
type
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..PixelCountMax - 1] of TRGBTriple;
type
TGradientHelper = class
private
public
function GetGradientBitmap(Index: integer; const hue_rotation: double): TBitmap;
end;
var
GradientHelper: TGradientHelper;
implementation
uses
Cmap;
{ TGradientHelper }
function TGradientHelper.GetGradientBitmap(Index: integer; const hue_rotation: double): TBitmap;
var
BitMap: TBitMap;
i, j: integer;
Row: pRGBTripleArray;
pal: TColorMap;
begin
GetCMap(index, hue_rotation, pal);
BitMap := TBitMap.create;
Bitmap.PixelFormat := pf24bit;
BitMap.Width := 256;
BitMap.Height := 2;
for j := 0 to Bitmap.Height - 1 do begin
Row := Bitmap.Scanline[j];
for i := 0 to Bitmap.Width - 1 do begin
Row[i].rgbtRed := Pal[i][0];
Row[i].rgbtGreen := Pal[i][1];
Row[i].rgbtBlue := Pal[i][2];
end
end;
Result := BitMap;
end;
initialization
GradientHelper := TGradientHelper.create;
finalization
GradientHelper.Free;
end.

315
2.02g/Source/ImageColoring.dfm Normal file
View File

@ -0,0 +1,315 @@
object frmImageColoring: TfrmImageColoring
Left = 0
Top = 0
Width = 581
Height = 401
Caption = 'Image coloring'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 16
Top = 40
Width = 56
Height = 13
Caption = 'First Pallete'
end
object Label2: TLabel
Left = 16
Top = 168
Width = 74
Height = 13
Caption = 'Second pallette'
end
object Label3: TLabel
Left = 296
Top = 36
Width = 30
Height = 13
Caption = 'Image'
end
object Label4: TLabel
Left = 16
Top = 107
Width = 57
Height = 13
Alignment = taCenter
AutoSize = False
Caption = 'Preset'
end
object Label5: TLabel
Left = 16
Top = 235
Width = 57
Height = 13
Alignment = taCenter
AutoSize = False
Caption = 'Preset'
end
object cbEnable: TCheckBox
Left = 16
Top = 8
Width = 133
Height = 17
Caption = 'Enable image coloring'
TabOrder = 0
end
object Panel1: TPanel
Left = 16
Top = 56
Width = 258
Height = 40
BevelOuter = bvLowered
TabOrder = 1
object imgPal1: TImage
Left = 1
Top = 1
Width = 256
Height = 38
Align = alClient
Stretch = True
end
end
object Panel2: TPanel
Left = 16
Top = 188
Width = 258
Height = 40
BevelOuter = bvLowered
TabOrder = 2
object imgpal2: TImage
Left = 1
Top = 1
Width = 256
Height = 38
Align = alClient
Stretch = True
end
end
object Panel3: TPanel
Left = 292
Top = 60
Width = 258
Height = 258
BevelOuter = bvLowered
TabOrder = 3
end
object cmbPalette1: TComboBox
Left = 80
Top = 106
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 = 4
OnChange = cmbPalette1Change
OnDrawItem = cmbPalette1DrawItem
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 cmbPalette2: TComboBox
Left = 80
Top = 234
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 = 5
OnChange = cmbPalette2Change
OnDrawItem = cmbPalette1DrawItem
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
end

138
2.02g/Source/ImageColoring.pas Normal file
View File

@ -0,0 +1,138 @@
unit ImageColoring;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, cmap;
type
TfrmImageColoring = class(TForm)
cbEnable: TCheckBox;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
cmbPalette1: TComboBox;
Label4: TLabel;
imgPal1: TImage;
imgpal2: TImage;
Label5: TLabel;
cmbPalette2: TComboBox;
procedure cmbPalette2Change(Sender: TObject);
procedure cmbPalette1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
procedure cmbPalette1Change(Sender: TObject);
private
FPal1: TColorMap;
FPal2: TColorMap;
FBkuPal1: TColorMap;
FBkuPal2: TColorMap;
Index1: integer;
Index2: integer;
procedure DrawPalette1;
procedure DrawPalette2;
procedure Apply;
public
procedure Update;
end;
var
frmImageColoring: TfrmImageColoring;
implementation
{$R *.dfm}
uses
Main, Editor, Mutate, GradientHlpr;
{ TfrmImageColoring }
procedure TfrmImageColoring.Update;
begin
// FPal1 := MainCP.Pal;
FBkuPal1 := FPal1;
end;
procedure TfrmImageColoring.cmbPalette1Change(Sender: TObject);
begin
Index1 := cmbPalette1.ItemIndex;
GetCmap(Index1, 1, FPal1);
FBkuPal1 := FPal1;
// ScrollBar.Position := 0;
DrawPalette1;
Apply;
end;
procedure TfrmImageColoring.Apply;
begin
MainForm.StopThread;
MainForm.UpdateUndo;
MainCp.CmapIndex := cmbPalette1.ItemIndex;
MainCp.cmap := FPal1;
if EditForm.visible then EditForm.UpdateDisplay;
if MutateForm.Visible then MutateForm.UpdateDisplay;
MainForm.RedrawTimer.enabled := true;
end;
procedure TfrmImageColoring.cmbPalette1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
Bitmap: TBitmap;
PalName: string;
begin
BitMap := GradientHelper.GetGradientBitmap(Index, 1);
GetCmapName(index, PalName);
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 TfrmImageColoring.DrawPalette1;
var
Bitmap: TBitmap;
begin
BitMap := GradientHelper.GetGradientBitmap(Index1, 1);
imgPal1.Picture.Graphic := Bitmap;
imgPal1.Refresh;
BitMap.Free;
end;
procedure TfrmImageColoring.DrawPalette2;
var
Bitmap: TBitmap;
begin
BitMap := GradientHelper.GetGradientBitmap(Index2, 1);
imgPal2.Picture.Graphic := Bitmap;
imgPal2.Refresh;
BitMap.Free;
end;
procedure TfrmImageColoring.cmbPalette2Change(Sender: TObject);
begin
Index2 := cmbPalette2.ItemIndex;
GetCmap(Index2, 1, FPal2);
FBkuPal2 := FPal2;
// ScrollBar.Position := 0;
DrawPalette2;
Apply;
end;
end.